module Cardano.CLI.EraBased.StakePool.Internal.Metadata
  ( carryHashChecks
  )
where

import Cardano.Api.Shelley

import Cardano.CLI.EraIndependent.Hash.Internal.Common hiding (carryHashChecks)
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.StakePoolCmdError

import Control.Monad

-- | Check the hash of the anchor data against the hash in the anchor if
-- checkHash is set to CheckHash.
carryHashChecks
  :: PotentiallyCheckedAnchor StakePoolMetadataReference StakePoolMetadataReference
  -- ^ The information about anchor data and whether to check the hash (see 'PotentiallyCheckedAnchor')
  -> ExceptT StakePoolCmdError IO ()
carryHashChecks :: PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
-> ExceptT StakePoolCmdError IO ()
carryHashChecks PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
potentiallyCheckedAnchor =
  case PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
-> MustCheckHash StakePoolMetadataReference
forall anchorType anchor.
PotentiallyCheckedAnchor anchorType anchor
-> MustCheckHash anchorType
pcaMustCheck PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
potentiallyCheckedAnchor of
    MustCheckHash StakePoolMetadataReference
CheckHash -> do
      let urlText :: Text
urlText = StakePoolMetadataReference -> Text
stakePoolMetadataURL StakePoolMetadataReference
anchor
      ByteString
metadataBytes <-
        (FetchURLError -> StakePoolCmdError)
-> ExceptT FetchURLError IO ByteString
-> ExceptT StakePoolCmdError IO ByteString
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT
          FetchURLError -> StakePoolCmdError
StakePoolCmdFetchURLError
          ( SupportedSchemes -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL
              SupportedSchemes
httpsAndIpfsSchemes
              Text
urlText
          )

      let expectedHash :: Hash StakePoolMetadata
expectedHash = StakePoolMetadataReference -> Hash StakePoolMetadata
stakePoolMetadataHash StakePoolMetadataReference
anchor

      (StakePoolMetadata
_metadata, Hash StakePoolMetadata
metadataHash) <-
        (StakePoolMetadataValidationError -> StakePoolCmdError)
-> ExceptT
     StakePoolMetadataValidationError
     IO
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     StakePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
firstExceptT StakePoolMetadataValidationError -> StakePoolCmdError
StakePoolCmdMetadataValidationError
          (ExceptT
   StakePoolMetadataValidationError
   IO
   (StakePoolMetadata, Hash StakePoolMetadata)
 -> ExceptT
      StakePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata))
-> (Either
      StakePoolMetadataValidationError
      (StakePoolMetadata, Hash StakePoolMetadata)
    -> ExceptT
         StakePoolMetadataValidationError
         IO
         (StakePoolMetadata, Hash StakePoolMetadata))
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     StakePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  StakePoolMetadataValidationError
  (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     StakePoolMetadataValidationError
     IO
     (StakePoolMetadata, Hash StakePoolMetadata)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
          (Either
   StakePoolMetadataValidationError
   (StakePoolMetadata, Hash StakePoolMetadata)
 -> ExceptT
      StakePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata))
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     StakePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
validateAndHashStakePoolMetadata ByteString
metadataBytes

      Bool
-> ExceptT StakePoolCmdError IO ()
-> ExceptT StakePoolCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Hash StakePoolMetadata
metadataHash Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash StakePoolMetadata
expectedHash) (ExceptT StakePoolCmdError IO ()
 -> ExceptT StakePoolCmdError IO ())
-> ExceptT StakePoolCmdError IO ()
-> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$
        StakePoolCmdError -> ExceptT StakePoolCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (StakePoolCmdError -> ExceptT StakePoolCmdError IO ())
-> StakePoolCmdError -> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$
          Hash StakePoolMetadata
-> Hash StakePoolMetadata -> StakePoolCmdError
StakePoolCmdHashMismatchError Hash StakePoolMetadata
expectedHash Hash StakePoolMetadata
metadataHash
    MustCheckHash StakePoolMetadataReference
TrustHash -> () -> ExceptT StakePoolCmdError IO ()
forall a. a -> ExceptT StakePoolCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  anchor :: StakePoolMetadataReference
anchor = PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
-> StakePoolMetadataReference
forall anchorType anchor.
PotentiallyCheckedAnchor anchorType anchor -> anchor
pcaAnchor PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
potentiallyCheckedAnchor