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

import Cardano.Api

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
      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 = StakePoolMetadataReference -> Hash StakePoolMetadata
stakePoolMetadataHash StakePoolMetadataReference
anchor

      (_metadata, metadataHash) <-
        firstExceptT StakePoolCmdMetadataValidationError
          . hoistEither
          $ validateAndHashStakePoolMetadata metadataBytes

      when (metadataHash /= expectedHash) $
        left $
          StakePoolCmdHashMismatchError expectedHash 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