{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraBased.StakePool.Run
  ( runStakePoolCmds
  , runStakePoolIdCmd
  , runStakePoolMetadataHashCmd
  , runStakePoolRegistrationCertificateCmd
  , runStakePoolDeregistrationCertificateCmd
  )
where

import Cardano.Api
import Cardano.Api.Experimental
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.StakePool.Command
import Cardano.CLI.EraBased.StakePool.Command qualified as Cmd
import Cardano.CLI.EraBased.StakePool.Internal.Metadata (carryHashChecks)
import Cardano.CLI.EraIndependent.Hash.Command qualified as Cmd
import Cardano.CLI.EraIndependent.Hash.Internal.Common
  ( allSchemes
  , getByteStringFromURL
  )
import Cardano.CLI.Orphan ()
import Cardano.CLI.Read (getVerificationKeyFromStakePoolVerificationKeySource)
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.HashCmdError (FetchURLError (..))
import Cardano.CLI.Type.Error.StakePoolCmdError
import Cardano.CLI.Type.Key (readVerificationKeyOrFile)

import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Function ((&))
import Data.Text.Encoding qualified as Text
import Vary qualified

runStakePoolCmds
  :: IsEra era
  => StakePoolCmds era
  -> CIO e ()
runStakePoolCmds :: forall era e. IsEra era => StakePoolCmds era -> CIO e ()
runStakePoolCmds = \case
  StakePoolDeregistrationCertificateCmd StakePoolDeregistrationCertificateCmdArgs era
args -> StakePoolDeregistrationCertificateCmdArgs era -> CIO e ()
forall era e.
IsEra era =>
StakePoolDeregistrationCertificateCmdArgs era -> CIO e ()
runStakePoolDeregistrationCertificateCmd StakePoolDeregistrationCertificateCmdArgs era
args
  StakePoolIdCmd StakePoolIdCmdArgs era
args -> StakePoolIdCmdArgs era -> CIO e ()
forall era e. StakePoolIdCmdArgs era -> CIO e ()
runStakePoolIdCmd StakePoolIdCmdArgs era
args
  StakePoolMetadataHashCmd StakePoolMetadataHashCmdArgs era
args -> StakePoolMetadataHashCmdArgs era -> CIO e ()
forall era e. StakePoolMetadataHashCmdArgs era -> CIO e ()
runStakePoolMetadataHashCmd StakePoolMetadataHashCmdArgs era
args
  StakePoolRegistrationCertificateCmd StakePoolRegistrationCertificateCmdArgs era
args -> StakePoolRegistrationCertificateCmdArgs era -> CIO e ()
forall era e.
IsEra era =>
StakePoolRegistrationCertificateCmdArgs era -> CIO e ()
runStakePoolRegistrationCertificateCmd StakePoolRegistrationCertificateCmdArgs era
args

--
-- Stake pool command implementations
--

-- | Create a stake pool registration cert.
-- TODO: Metadata and more stake pool relay support to be
-- added in the future.
runStakePoolRegistrationCertificateCmd
  :: forall era e
   . IsEra era
  => StakePoolRegistrationCertificateCmdArgs era
  -> CIO e ()
runStakePoolRegistrationCertificateCmd :: forall era e.
IsEra era =>
StakePoolRegistrationCertificateCmdArgs era -> CIO e ()
runStakePoolRegistrationCertificateCmd
  Cmd.StakePoolRegistrationCertificateCmdArgs
    { Era era
era :: Era era
era :: forall era. StakePoolRegistrationCertificateCmdArgs era -> Era era
era
    , StakePoolVerificationKeySource
poolVerificationKeyOrFile :: StakePoolVerificationKeySource
poolVerificationKeyOrFile :: forall era.
StakePoolRegistrationCertificateCmdArgs era
-> StakePoolVerificationKeySource
poolVerificationKeyOrFile
    , VerificationKeyOrFile VrfKey
vrfVerificationKeyOrFile :: VerificationKeyOrFile VrfKey
vrfVerificationKeyOrFile :: forall era.
StakePoolRegistrationCertificateCmdArgs era
-> VerificationKeyOrFile VrfKey
vrfVerificationKeyOrFile
    , Coin
poolPledge :: Coin
poolPledge :: forall era. StakePoolRegistrationCertificateCmdArgs era -> Coin
poolPledge
    , Coin
poolCost :: Coin
poolCost :: forall era. StakePoolRegistrationCertificateCmdArgs era -> Coin
poolCost
    , Rational
poolMargin :: Rational
poolMargin :: forall era. StakePoolRegistrationCertificateCmdArgs era -> Rational
poolMargin
    , VerificationKeyOrFile StakeKey
rewardStakeVerificationKeyOrFile :: VerificationKeyOrFile StakeKey
rewardStakeVerificationKeyOrFile :: forall era.
StakePoolRegistrationCertificateCmdArgs era
-> VerificationKeyOrFile StakeKey
rewardStakeVerificationKeyOrFile
    , [VerificationKeyOrFile StakeKey]
ownerStakeVerificationKeyOrFiles :: [VerificationKeyOrFile StakeKey]
ownerStakeVerificationKeyOrFiles :: forall era.
StakePoolRegistrationCertificateCmdArgs era
-> [VerificationKeyOrFile StakeKey]
ownerStakeVerificationKeyOrFiles
    , [StakePoolRelay]
relays :: [StakePoolRelay]
relays :: forall era.
StakePoolRegistrationCertificateCmdArgs era -> [StakePoolRelay]
relays
    , Maybe
  (PotentiallyCheckedAnchor
     StakePoolMetadataReference StakePoolMetadataReference)
mMetadata :: Maybe
  (PotentiallyCheckedAnchor
     StakePoolMetadataReference StakePoolMetadataReference)
mMetadata :: forall era.
StakePoolRegistrationCertificateCmdArgs era
-> Maybe
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
mMetadata
    , NetworkId
network :: NetworkId
network :: forall era.
StakePoolRegistrationCertificateCmdArgs era -> NetworkId
network
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
StakePoolRegistrationCertificateCmdArgs era -> File () 'Out
outFile
    } =
    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
      -- Pool verification key
      AnyStakePoolVerificationKey
stakePoolVerKey <- StakePoolVerificationKeySource -> RIO e AnyStakePoolVerificationKey
forall (m :: * -> *).
MonadIO m =>
StakePoolVerificationKeySource -> m AnyStakePoolVerificationKey
getVerificationKeyFromStakePoolVerificationKeySource StakePoolVerificationKeySource
poolVerificationKeyOrFile
      let stakePoolId' :: Hash StakePoolKey
stakePoolId' = AnyStakePoolVerificationKey -> Hash StakePoolKey
anyStakePoolVerificationKeyHash AnyStakePoolVerificationKey
stakePoolVerKey

      -- VRF verification key
      VerificationKey VrfKey
vrfVerKey <-
        VerificationKeyOrFile VrfKey -> CIO e (VerificationKey VrfKey)
forall keyrole e.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
VerificationKeyOrFile keyrole -> CIO e (VerificationKey keyrole)
readVerificationKeyOrFile VerificationKeyOrFile VrfKey
vrfVerificationKeyOrFile
      let vrfKeyHash' :: Hash VrfKey
vrfKeyHash' = VerificationKey VrfKey -> Hash VrfKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
vrfVerKey

      -- Pool reward account
      VerificationKey StakeKey
rwdStakeVerKey <-
        VerificationKeyOrFile StakeKey -> CIO e (VerificationKey StakeKey)
forall keyrole e.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
VerificationKeyOrFile keyrole -> CIO e (VerificationKey keyrole)
readVerificationKeyOrFile VerificationKeyOrFile StakeKey
rewardStakeVerificationKeyOrFile
      let stakeCred :: StakeCredential
stakeCred = Hash StakeKey -> StakeCredential
StakeCredentialByKey (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
rwdStakeVerKey)
          rewardAccountAddr :: StakeAddress
rewardAccountAddr = NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
network StakeCredential
stakeCred

      -- Pool owner(s)
      [VerificationKey StakeKey]
sPoolOwnerVkeys <-
        (VerificationKeyOrFile StakeKey
 -> RIO e (VerificationKey StakeKey))
-> [VerificationKeyOrFile StakeKey]
-> RIO e [VerificationKey StakeKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
          VerificationKeyOrFile StakeKey -> RIO e (VerificationKey StakeKey)
VerificationKeyOrFile StakeKey -> CIO e (VerificationKey StakeKey)
forall keyrole e.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
VerificationKeyOrFile keyrole -> CIO e (VerificationKey keyrole)
readVerificationKeyOrFile
          [VerificationKeyOrFile StakeKey]
ownerStakeVerificationKeyOrFiles
      let stakePoolOwners' :: [Hash StakeKey]
stakePoolOwners' = (VerificationKey StakeKey -> Hash StakeKey)
-> [VerificationKey StakeKey] -> [Hash StakeKey]
forall a b. (a -> b) -> [a] -> [b]
map VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash [VerificationKey StakeKey]
sPoolOwnerVkeys

      let stakePoolParams :: StakePoolParameters
stakePoolParams =
            StakePoolParameters
              { stakePoolId :: Hash StakePoolKey
stakePoolId = Hash StakePoolKey
stakePoolId'
              , stakePoolVRF :: Hash VrfKey
stakePoolVRF = Hash VrfKey
vrfKeyHash'
              , stakePoolCost :: Coin
stakePoolCost = Coin
poolCost
              , stakePoolMargin :: Rational
stakePoolMargin = Rational
poolMargin
              , stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount = StakeAddress
rewardAccountAddr
              , stakePoolPledge :: Coin
stakePoolPledge = Coin
poolPledge
              , stakePoolOwners :: [Hash StakeKey]
stakePoolOwners = [Hash StakeKey]
stakePoolOwners'
              , stakePoolRelays :: [StakePoolRelay]
stakePoolRelays = [StakePoolRelay]
relays
              , stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata = PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
-> StakePoolMetadataReference
forall anchorType anchor.
PotentiallyCheckedAnchor anchorType anchor -> anchor
pcaAnchor (PotentiallyCheckedAnchor
   StakePoolMetadataReference StakePoolMetadataReference
 -> StakePoolMetadataReference)
-> Maybe
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
-> Maybe StakePoolMetadataReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (PotentiallyCheckedAnchor
     StakePoolMetadataReference StakePoolMetadataReference)
mMetadata
              }

      let ledgerStakePoolParams :: PoolParams
ledgerStakePoolParams = StakePoolParameters -> PoolParams
toShelleyPoolParams StakePoolParameters
stakePoolParams
          req :: StakePoolRegistrationRequirements era
req =
            PoolParams -> StakePoolRegistrationRequirements era
forall era.
IsEra era =>
PoolParams -> StakePoolRegistrationRequirements era
createStakePoolRegistrationRequirements PoolParams
ledgerStakePoolParams
              :: StakePoolRegistrationRequirements era
          registrationCert :: Certificate era
registrationCert = StakePoolRegistrationRequirements era -> Certificate era
forall era.
StakePoolRegistrationRequirements era -> Certificate era
makeStakePoolRegistrationCertificate StakePoolRegistrationRequirements era
req

      (PotentiallyCheckedAnchor
   StakePoolMetadataReference StakePoolMetadataReference
 -> RIO e ())
-> Maybe
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ExceptT StakePoolCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT StakePoolCmdError IO () -> RIO e ())
-> (PotentiallyCheckedAnchor
      StakePoolMetadataReference StakePoolMetadataReference
    -> ExceptT StakePoolCmdError IO ())
-> PotentiallyCheckedAnchor
     StakePoolMetadataReference StakePoolMetadataReference
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
-> ExceptT StakePoolCmdError IO ()
carryHashChecks) Maybe
  (PotentiallyCheckedAnchor
     StakePoolMetadataReference StakePoolMetadataReference)
mMetadata
      forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
        File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
outFile (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
          Maybe TextEnvelopeDescr -> Certificate era -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
registrationCertDesc) Certificate era
registrationCert
   where
    registrationCertDesc :: TextEnvelopeDescr
    registrationCertDesc :: TextEnvelopeDescr
registrationCertDesc = TextEnvelopeDescr
"Stake Pool Registration Certificate"

createStakePoolRegistrationRequirements
  :: forall era
   . IsEra era
  => L.PoolParams
  -> StakePoolRegistrationRequirements era
createStakePoolRegistrationRequirements :: forall era.
IsEra era =>
PoolParams -> StakePoolRegistrationRequirements era
createStakePoolRegistrationRequirements =
  ConwayEraOnwards era
-> PoolParams -> StakePoolRegistrationRequirements era
forall era.
ConwayEraOnwards era
-> PoolParams -> StakePoolRegistrationRequirements era
StakePoolRegistrationRequirementsConwayOnwards (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
useEra)

runStakePoolDeregistrationCertificateCmd
  :: forall era e
   . IsEra era
  => StakePoolDeregistrationCertificateCmdArgs era
  -> CIO e ()
runStakePoolDeregistrationCertificateCmd :: forall era e.
IsEra era =>
StakePoolDeregistrationCertificateCmdArgs era -> CIO e ()
runStakePoolDeregistrationCertificateCmd
  Cmd.StakePoolDeregistrationCertificateCmdArgs
    { Era era
era :: Era era
era :: forall era.
StakePoolDeregistrationCertificateCmdArgs era -> Era era
era
    , StakePoolVerificationKeySource
poolVerificationKeyOrFile :: StakePoolVerificationKeySource
poolVerificationKeyOrFile :: forall era.
StakePoolDeregistrationCertificateCmdArgs era
-> StakePoolVerificationKeySource
poolVerificationKeyOrFile
    , EpochNo
retireEpoch :: EpochNo
retireEpoch :: forall era.
StakePoolDeregistrationCertificateCmdArgs era -> EpochNo
retireEpoch
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
StakePoolDeregistrationCertificateCmdArgs era -> File () 'Out
outFile
    } =
    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
      -- Pool verification key
      AnyStakePoolVerificationKey
stakePoolVerKey <- StakePoolVerificationKeySource -> RIO e AnyStakePoolVerificationKey
forall (m :: * -> *).
MonadIO m =>
StakePoolVerificationKeySource -> m AnyStakePoolVerificationKey
getVerificationKeyFromStakePoolVerificationKeySource StakePoolVerificationKeySource
poolVerificationKeyOrFile

      let stakePoolId' :: Hash StakePoolKey
stakePoolId' = AnyStakePoolVerificationKey -> Hash StakePoolKey
anyStakePoolVerificationKeyHash AnyStakePoolVerificationKey
stakePoolVerKey
          StakePoolRetirementRequirements era
req :: StakePoolRetirementRequirements era = Hash StakePoolKey -> EpochNo -> StakePoolRetirementRequirements era
forall era.
IsEra era =>
Hash StakePoolKey -> EpochNo -> StakePoolRetirementRequirements era
createStakePoolRetirementRequirements Hash StakePoolKey
stakePoolId' EpochNo
retireEpoch
          retireCert :: Certificate era
retireCert = StakePoolRetirementRequirements era -> Certificate era
forall era. StakePoolRetirementRequirements era -> Certificate era
makeStakePoolRetirementCertificate StakePoolRetirementRequirements era
req

      forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
        File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
outFile (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
          Maybe TextEnvelopeDescr -> Certificate era -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
retireCertDesc) Certificate era
retireCert
   where
    retireCertDesc :: TextEnvelopeDescr
    retireCertDesc :: TextEnvelopeDescr
retireCertDesc = TextEnvelopeDescr
"Stake Pool Retirement Certificate"

createStakePoolRetirementRequirements
  :: IsEra era
  => PoolId
  -> L.EpochNo
  -> StakePoolRetirementRequirements era
createStakePoolRetirementRequirements :: forall era.
IsEra era =>
Hash StakePoolKey -> EpochNo -> StakePoolRetirementRequirements era
createStakePoolRetirementRequirements =
  ConwayEraOnwards era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ConwayEraOnwards era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
StakePoolRetirementRequirementsConwayOnwards (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
forall era. IsEra era => Era era
useEra)

runStakePoolIdCmd
  :: ()
  => StakePoolIdCmdArgs era
  -> CIO e ()
runStakePoolIdCmd :: forall era e. StakePoolIdCmdArgs era -> CIO e ()
runStakePoolIdCmd
  Cmd.StakePoolIdCmdArgs
    { StakePoolVerificationKeySource
poolVerificationKeyOrFile :: StakePoolVerificationKeySource
poolVerificationKeyOrFile :: forall era.
StakePoolIdCmdArgs era -> StakePoolVerificationKeySource
poolVerificationKeyOrFile
    , Vary '[FormatBech32, FormatHex]
outputFormat :: Vary '[FormatBech32, FormatHex]
outputFormat :: forall era.
StakePoolIdCmdArgs era -> Vary '[FormatBech32, FormatHex]
outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. StakePoolIdCmdArgs era -> Maybe (File () 'Out)
mOutFile
    } = do
    AnyStakePoolVerificationKey
stakePoolVerKey <- StakePoolVerificationKeySource -> RIO e AnyStakePoolVerificationKey
forall (m :: * -> *).
MonadIO m =>
StakePoolVerificationKeySource -> m AnyStakePoolVerificationKey
getVerificationKeyFromStakePoolVerificationKeySource StakePoolVerificationKeySource
poolVerificationKeyOrFile
    let stakePoolKeyHash :: Hash StakePoolKey
stakePoolKeyHash = AnyStakePoolVerificationKey -> Hash StakePoolKey
anyStakePoolVerificationKeyHash AnyStakePoolVerificationKey
stakePoolVerKey

    let output :: ByteString
output =
          Vary '[FormatBech32, FormatHex]
outputFormat
            Vary '[FormatBech32, FormatHex]
-> (Vary '[FormatBech32, FormatHex]
    -> Hash StakePoolKey -> ByteString)
-> Hash StakePoolKey
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatHex]
 -> Hash StakePoolKey -> ByteString)
-> Vary '[FormatBech32, FormatHex]
-> Hash StakePoolKey
-> ByteString
forall a. a -> a
id
                  ((Vary '[FormatBech32, FormatHex]
  -> Hash StakePoolKey -> ByteString)
 -> Vary '[FormatBech32, FormatHex]
 -> Hash StakePoolKey
 -> ByteString)
-> ((Vary '[] -> Hash StakePoolKey -> ByteString)
    -> Vary '[FormatBech32, FormatHex]
    -> Hash StakePoolKey
    -> ByteString)
-> (Vary '[] -> Hash StakePoolKey -> ByteString)
-> Vary '[FormatBech32, FormatHex]
-> Hash StakePoolKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> Hash StakePoolKey -> ByteString)
-> (Vary '[FormatHex] -> Hash StakePoolKey -> ByteString)
-> Vary '[FormatBech32, FormatHex]
-> Hash StakePoolKey
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatBech32
FormatBech32 -> Text -> ByteString
Text.encodeUtf8 (Text -> ByteString)
-> (Hash StakePoolKey -> Text) -> Hash StakePoolKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32)
                  ((Vary '[FormatHex] -> Hash StakePoolKey -> ByteString)
 -> Vary '[FormatBech32, FormatHex]
 -> Hash StakePoolKey
 -> ByteString)
-> ((Vary '[] -> Hash StakePoolKey -> ByteString)
    -> Vary '[FormatHex] -> Hash StakePoolKey -> ByteString)
-> (Vary '[] -> Hash StakePoolKey -> ByteString)
-> Vary '[FormatBech32, FormatHex]
-> Hash StakePoolKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatHex -> Hash StakePoolKey -> ByteString)
-> (Vary '[] -> Hash StakePoolKey -> ByteString)
-> Vary '[FormatHex]
-> Hash StakePoolKey
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatHex
FormatHex -> Hash StakePoolKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex)
                  ((Vary '[] -> Hash StakePoolKey -> ByteString)
 -> Vary '[FormatBech32, FormatHex]
 -> Hash StakePoolKey
 -> ByteString)
-> (Vary '[] -> Hash StakePoolKey -> ByteString)
-> Vary '[FormatBech32, FormatHex]
-> Hash StakePoolKey
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> Hash StakePoolKey -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
              )
            (Hash StakePoolKey -> ByteString)
-> Hash StakePoolKey -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash StakePoolKey
stakePoolKeyHash

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

runStakePoolMetadataHashCmd
  :: ()
  => StakePoolMetadataHashCmdArgs era
  -> CIO e ()
runStakePoolMetadataHashCmd :: forall era e. StakePoolMetadataHashCmdArgs era -> CIO e ()
runStakePoolMetadataHashCmd
  Cmd.StakePoolMetadataHashCmdArgs
    { StakePoolMetadataSource
poolMetadataSource :: StakePoolMetadataSource
poolMetadataSource :: forall era.
StakePoolMetadataHashCmdArgs era -> StakePoolMetadataSource
poolMetadataSource
    , HashGoal (Hash StakePoolMetadata)
hashGoal :: HashGoal (Hash StakePoolMetadata)
hashGoal :: forall era.
StakePoolMetadataHashCmdArgs era
-> HashGoal (Hash StakePoolMetadata)
hashGoal
    } = do
    ByteString
metadataBytes <-
      case StakePoolMetadataSource
poolMetadataSource of
        StakePoolMetadataFileIn StakePoolMetadataFile 'In
poolMetadataFile ->
          forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ByteString) -> RIO e ByteString)
-> IO (Either (FileError ()) ByteString) -> RIO e ByteString
forall a b. (a -> b) -> a -> b
$
            StakePoolMetadataFile 'In -> IO (Either (FileError ()) ByteString)
forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) ByteString)
readByteStringFile StakePoolMetadataFile 'In
poolMetadataFile
        StakePoolMetadataURL Url
urlText ->
          ExceptT StakePoolCmdError IO ByteString -> RIO e ByteString
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT StakePoolCmdError IO ByteString -> RIO e ByteString)
-> (ExceptT FetchURLError IO ByteString
    -> ExceptT StakePoolCmdError IO ByteString)
-> ExceptT FetchURLError IO ByteString
-> RIO e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT FetchURLError IO ByteString
-> ExceptT StakePoolCmdError IO ByteString
fetchURLToStakePoolCmdError (ExceptT FetchURLError IO ByteString -> RIO e ByteString)
-> ExceptT FetchURLError IO ByteString -> RIO e ByteString
forall a b. (a -> b) -> a -> b
$ SupportedSchemes -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL SupportedSchemes
allSchemes (Text -> ExceptT FetchURLError IO ByteString)
-> Text -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ Url -> Text
L.urlToText Url
urlText

    (StakePoolMetadata
_metadata, Hash StakePoolMetadata
metadataHash) <-
      Either
  StakePoolMetadataValidationError
  (StakePoolMetadata, Hash StakePoolMetadata)
-> RIO e (StakePoolMetadata, Hash StakePoolMetadata)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either
   StakePoolMetadataValidationError
   (StakePoolMetadata, Hash StakePoolMetadata)
 -> RIO e (StakePoolMetadata, Hash StakePoolMetadata))
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
-> RIO e (StakePoolMetadata, Hash StakePoolMetadata)
forall a b. (a -> b) -> a -> b
$
        ByteString
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
validateAndHashStakePoolMetadata ByteString
metadataBytes

    case HashGoal (Hash StakePoolMetadata)
hashGoal of
      Cmd.CheckHash Hash StakePoolMetadata
expectedHash
        | Hash StakePoolMetadata
metadataHash Hash StakePoolMetadata -> Hash StakePoolMetadata -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash StakePoolMetadata
expectedHash ->
            StakePoolCmdError -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (StakePoolCmdError -> RIO e ()) -> StakePoolCmdError -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Hash StakePoolMetadata
-> Hash StakePoolMetadata -> StakePoolCmdError
StakePoolCmdHashMismatchError Hash StakePoolMetadata
expectedHash Hash StakePoolMetadata
metadataHash
        | Bool
otherwise -> IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Hashes match!"
      Cmd.HashToFile File () 'Out
outFile -> Maybe (File () 'Out) -> Hash StakePoolMetadata -> CIO e ()
forall e.
Maybe (File () 'Out) -> Hash StakePoolMetadata -> CIO e ()
writeOutput (File () 'Out -> Maybe (File () 'Out)
forall a. a -> Maybe a
Just File () 'Out
outFile) Hash StakePoolMetadata
metadataHash
      HashGoal (Hash StakePoolMetadata)
Cmd.HashToStdout -> Maybe (File () 'Out) -> Hash StakePoolMetadata -> CIO e ()
forall e.
Maybe (File () 'Out) -> Hash StakePoolMetadata -> CIO e ()
writeOutput Maybe (File () 'Out)
forall a. Maybe a
Nothing Hash StakePoolMetadata
metadataHash
   where
    writeOutput :: Maybe (File () Out) -> Hash StakePoolMetadata -> CIO e ()
    writeOutput :: forall e.
Maybe (File () 'Out) -> Hash StakePoolMetadata -> CIO e ()
writeOutput Maybe (File () 'Out)
mOutFile Hash StakePoolMetadata
metadataHash = do
      let output :: ByteString
output = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash StakePoolMetadata -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex Hash StakePoolMetadata
metadataHash

      forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
        Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
output

    fetchURLToStakePoolCmdError
      :: ExceptT FetchURLError IO BS.ByteString -> ExceptT StakePoolCmdError IO BS.ByteString
    fetchURLToStakePoolCmdError :: ExceptT FetchURLError IO ByteString
-> ExceptT StakePoolCmdError IO ByteString
fetchURLToStakePoolCmdError = (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