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

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

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

import qualified Cardano.CLI.Commands.Hash as Cmd
import           Cardano.CLI.EraBased.Commands.StakePool
import qualified Cardano.CLI.EraBased.Commands.StakePool as Cmd
import           Cardano.CLI.Run.Hash (allSchemes, getByteStringFromURL, httpsAndIpfsSchemes)
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError (..))
import           Cardano.CLI.Types.Errors.StakePoolCmdError
import           Cardano.CLI.Types.Key (readVerificationKeyOrFile)

import           Control.Monad (when)
import qualified Data.ByteString.Char8 as BS

runStakePoolCmds
  :: ()
  => StakePoolCmds era
  -> ExceptT StakePoolCmdError IO ()
runStakePoolCmds :: forall era. StakePoolCmds era -> ExceptT StakePoolCmdError IO ()
runStakePoolCmds = \case
  StakePoolDeregistrationCertificateCmd StakePoolDeregistrationCertificateCmdArgs era
args -> StakePoolDeregistrationCertificateCmdArgs era
-> ExceptT StakePoolCmdError IO ()
forall era.
StakePoolDeregistrationCertificateCmdArgs era
-> ExceptT StakePoolCmdError IO ()
runStakePoolDeregistrationCertificateCmd StakePoolDeregistrationCertificateCmdArgs era
args
  StakePoolIdCmd StakePoolIdCmdArgs era
args -> StakePoolIdCmdArgs era -> ExceptT StakePoolCmdError IO ()
forall era.
StakePoolIdCmdArgs era -> ExceptT StakePoolCmdError IO ()
runStakePoolIdCmd StakePoolIdCmdArgs era
args
  StakePoolMetadataHashCmd StakePoolMetadataHashCmdArgs era
args -> StakePoolMetadataHashCmdArgs era -> ExceptT StakePoolCmdError IO ()
forall era.
StakePoolMetadataHashCmdArgs era -> ExceptT StakePoolCmdError IO ()
runStakePoolMetadataHashCmd StakePoolMetadataHashCmdArgs era
args
  StakePoolRegistrationCertificateCmd StakePoolRegistrationCertificateCmdArgs era
args -> StakePoolRegistrationCertificateCmdArgs era
-> ExceptT StakePoolCmdError IO ()
forall era.
StakePoolRegistrationCertificateCmdArgs era
-> ExceptT StakePoolCmdError IO ()
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
  :: ()
  => StakePoolRegistrationCertificateCmdArgs era
  -> ExceptT StakePoolCmdError IO ()
runStakePoolRegistrationCertificateCmd :: forall era.
StakePoolRegistrationCertificateCmdArgs era
-> ExceptT StakePoolCmdError IO ()
runStakePoolRegistrationCertificateCmd
  Cmd.StakePoolRegistrationCertificateCmdArgs
    { ShelleyBasedEra era
sbe :: ShelleyBasedEra era
sbe :: forall era.
StakePoolRegistrationCertificateCmdArgs era -> ShelleyBasedEra era
sbe
    , VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile :: VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile :: forall era.
StakePoolRegistrationCertificateCmdArgs era
-> VerificationKeyOrFile StakePoolKey
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
    } =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ExceptT StakePoolCmdError IO ())
-> ExceptT StakePoolCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ExceptT StakePoolCmdError IO ())
 -> ExceptT StakePoolCmdError IO ())
-> (ShelleyBasedEraConstraints era =>
    ExceptT StakePoolCmdError IO ())
-> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
      -- Pool verification key
      VerificationKey StakePoolKey
stakePoolVerKey <-
        (FileError InputDecodeError -> StakePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> StakePoolCmdError
StakePoolCmdReadKeyFileError (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$
          AsType StakePoolKey
-> VerificationKeyOrFile StakePoolKey
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile
      let stakePoolId' :: Hash StakePoolKey
stakePoolId' = VerificationKey StakePoolKey -> Hash StakePoolKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey

      -- VRF verification key
      VerificationKey VrfKey
vrfVerKey <-
        (FileError InputDecodeError -> StakePoolCmdError)
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT StakePoolCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> StakePoolCmdError
StakePoolCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
 -> ExceptT StakePoolCmdError IO (VerificationKey VrfKey))
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT StakePoolCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$
          AsType VrfKey
-> VerificationKeyOrFile VrfKey
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType VrfKey
AsVrfKey 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 <-
        (FileError InputDecodeError -> StakePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> StakePoolCmdError
StakePoolCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (VerificationKey StakeKey)
 -> ExceptT StakePoolCmdError IO (VerificationKey StakeKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$
          AsType StakeKey
-> VerificationKeyOrFile StakeKey
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType StakeKey
AsStakeKey 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
 -> ExceptT StakePoolCmdError IO (VerificationKey StakeKey))
-> [VerificationKeyOrFile StakeKey]
-> ExceptT StakePoolCmdError IO [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
          ( (FileError InputDecodeError -> StakePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> StakePoolCmdError
StakePoolCmdReadKeyFileError
              (ExceptT (FileError InputDecodeError) IO (VerificationKey StakeKey)
 -> ExceptT StakePoolCmdError IO (VerificationKey StakeKey))
-> (VerificationKeyOrFile StakeKey
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakeKey))
-> VerificationKeyOrFile StakeKey
-> ExceptT StakePoolCmdError IO (VerificationKey StakeKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType StakeKey
-> VerificationKeyOrFile StakeKey
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType StakeKey
AsStakeKey
          )
          [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 StandardCrypto
ledgerStakePoolParams = StakePoolParameters -> PoolParams StandardCrypto
toShelleyPoolParams StakePoolParameters
stakePoolParams
          req :: StakePoolRegistrationRequirements era
req =
            ShelleyBasedEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall era.
ShelleyBasedEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
createStakePoolRegistrationRequirements ShelleyBasedEra era
sbe (PoolParams (EraCrypto (ShelleyLedgerEra era))
 -> StakePoolRegistrationRequirements era)
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall a b. (a -> b) -> a -> b
$
              ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => PoolParams StandardCrypto)
-> PoolParams StandardCrypto
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe PoolParams StandardCrypto
ShelleyBasedEraConstraints era => PoolParams StandardCrypto
ledgerStakePoolParams
          registrationCert :: Certificate era
registrationCert = StakePoolRegistrationRequirements era -> Certificate era
forall era.
StakePoolRegistrationRequirements era -> Certificate era
makeStakePoolRegistrationCertificate StakePoolRegistrationRequirements era
req

      (PotentiallyCheckedAnchor
   StakePoolMetadataReference StakePoolMetadataReference
 -> ExceptT StakePoolCmdError IO ())
-> Maybe
     (PotentiallyCheckedAnchor
        StakePoolMetadataReference StakePoolMetadataReference)
-> ExceptT StakePoolCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PotentiallyCheckedAnchor
  StakePoolMetadataReference StakePoolMetadataReference
-> ExceptT StakePoolCmdError IO ()
carryHashChecks Maybe
  (PotentiallyCheckedAnchor
     StakePoolMetadataReference StakePoolMetadataReference)
mMetadata

      (FileError () -> StakePoolCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakePoolCmdError
StakePoolCmdWriteFileError
        (ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakePoolCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        (IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ()
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
  :: ()
  => ShelleyBasedEra era
  -> L.PoolParams (L.EraCrypto (ShelleyLedgerEra era))
  -> StakePoolRegistrationRequirements era
createStakePoolRegistrationRequirements :: forall era.
ShelleyBasedEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
createStakePoolRegistrationRequirements ShelleyBasedEra era
sbe PoolParams (EraCrypto (ShelleyLedgerEra era))
pparams =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall era.
ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra ShelleyEra
ShelleyToBabbageEraShelley PoolParams (EraCrypto (ShelleyLedgerEra era))
pparams
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall era.
ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra AllegraEra
ShelleyToBabbageEraAllegra PoolParams (EraCrypto (ShelleyLedgerEra era))
pparams
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall era.
ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra MaryEra
ShelleyToBabbageEraMary PoolParams (EraCrypto (ShelleyLedgerEra era))
pparams
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall era.
ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra AlonzoEra
ShelleyToBabbageEraAlonzo PoolParams (EraCrypto (ShelleyLedgerEra era))
pparams
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall era.
ShelleyToBabbageEra era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
StakePoolRegistrationRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra BabbageEra
ShelleyToBabbageEraBabbage PoolParams (EraCrypto (ShelleyLedgerEra era))
pparams
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      ConwayEraOnwards era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
forall era.
ConwayEraOnwards era
-> PoolParams (EraCrypto (ShelleyLedgerEra era))
-> StakePoolRegistrationRequirements era
StakePoolRegistrationRequirementsConwayOnwards ConwayEraOnwards era
ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway PoolParams (EraCrypto (ShelleyLedgerEra era))
pparams

runStakePoolDeregistrationCertificateCmd
  :: ()
  => StakePoolDeregistrationCertificateCmdArgs era
  -> ExceptT StakePoolCmdError IO ()
runStakePoolDeregistrationCertificateCmd :: forall era.
StakePoolDeregistrationCertificateCmdArgs era
-> ExceptT StakePoolCmdError IO ()
runStakePoolDeregistrationCertificateCmd
  Cmd.StakePoolDeregistrationCertificateCmdArgs
    { ShelleyBasedEra era
sbe :: ShelleyBasedEra era
sbe :: forall era.
StakePoolDeregistrationCertificateCmdArgs era
-> ShelleyBasedEra era
sbe
    , VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile :: VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile :: forall era.
StakePoolDeregistrationCertificateCmdArgs era
-> VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile
    , EpochNo
retireEpoch :: EpochNo
retireEpoch :: forall era.
StakePoolDeregistrationCertificateCmdArgs era -> EpochNo
retireEpoch
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
StakePoolDeregistrationCertificateCmdArgs era -> File () 'Out
outFile
    } =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ExceptT StakePoolCmdError IO ())
-> ExceptT StakePoolCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ExceptT StakePoolCmdError IO ())
 -> ExceptT StakePoolCmdError IO ())
-> (ShelleyBasedEraConstraints era =>
    ExceptT StakePoolCmdError IO ())
-> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
      -- Pool verification key
      VerificationKey StakePoolKey
stakePoolVerKey <-
        (FileError InputDecodeError -> StakePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> StakePoolCmdError
StakePoolCmdReadKeyFileError (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$
          AsType StakePoolKey
-> VerificationKeyOrFile StakePoolKey
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile

      let stakePoolId' :: Hash StakePoolKey
stakePoolId' = VerificationKey StakePoolKey -> Hash StakePoolKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey
          req :: StakePoolRetirementRequirements era
req = ShelleyBasedEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ShelleyBasedEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
createStakePoolRetirementRequirements ShelleyBasedEra era
sbe Hash StakePoolKey
stakePoolId' EpochNo
retireEpoch
          retireCert :: Certificate era
retireCert = StakePoolRetirementRequirements era -> Certificate era
forall era. StakePoolRetirementRequirements era -> Certificate era
makeStakePoolRetirementCertificate StakePoolRetirementRequirements era
req

      (FileError () -> StakePoolCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakePoolCmdError
StakePoolCmdWriteFileError
        (ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakePoolCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        (IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ()
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
  :: ()
  => ShelleyBasedEra era
  -> PoolId
  -> L.EpochNo
  -> StakePoolRetirementRequirements era
createStakePoolRetirementRequirements :: forall era.
ShelleyBasedEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
createStakePoolRetirementRequirements ShelleyBasedEra era
sbe Hash StakePoolKey
pid EpochNo
epoch =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
StakePoolRetirementRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra ShelleyEra
ShelleyToBabbageEraShelley Hash StakePoolKey
pid EpochNo
epoch
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
StakePoolRetirementRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra AllegraEra
ShelleyToBabbageEraAllegra Hash StakePoolKey
pid EpochNo
epoch
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
StakePoolRetirementRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra MaryEra
ShelleyToBabbageEraMary Hash StakePoolKey
pid EpochNo
epoch
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
StakePoolRetirementRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra AlonzoEra
ShelleyToBabbageEraAlonzo Hash StakePoolKey
pid EpochNo
epoch
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ShelleyToBabbageEra era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
StakePoolRetirementRequirementsPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra BabbageEra
ShelleyToBabbageEraBabbage Hash StakePoolKey
pid EpochNo
epoch
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      ConwayEraOnwards era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
forall era.
ConwayEraOnwards era
-> Hash StakePoolKey
-> EpochNo
-> StakePoolRetirementRequirements era
StakePoolRetirementRequirementsConwayOnwards ConwayEraOnwards era
ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway Hash StakePoolKey
pid EpochNo
epoch

runStakePoolIdCmd
  :: ()
  => StakePoolIdCmdArgs era
  -> ExceptT StakePoolCmdError IO ()
runStakePoolIdCmd :: forall era.
StakePoolIdCmdArgs era -> ExceptT StakePoolCmdError IO ()
runStakePoolIdCmd
  Cmd.StakePoolIdCmdArgs
    { VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile :: VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile :: forall era.
StakePoolIdCmdArgs era -> VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile
    , IdOutputFormat
outputFormat :: IdOutputFormat
outputFormat :: forall era. StakePoolIdCmdArgs era -> IdOutputFormat
outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. StakePoolIdCmdArgs era -> Maybe (File () 'Out)
mOutFile
    } = do
    VerificationKey StakePoolKey
stakePoolVerKey <-
      (FileError InputDecodeError -> StakePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> StakePoolCmdError
StakePoolCmdReadKeyFileError (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT StakePoolCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$
        AsType StakePoolKey
-> VerificationKeyOrFile StakePoolKey
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
poolVerificationKeyOrFile

    case IdOutputFormat
outputFormat of
      IdOutputFormat
IdOutputFormatHex ->
        (FileError () -> StakePoolCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakePoolCmdError
StakePoolCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakePoolCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ()
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 -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Hash StakePoolKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (VerificationKey StakePoolKey -> Hash StakePoolKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey)
      IdOutputFormat
IdOutputFormatBech32 ->
        (FileError () -> StakePoolCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakePoolCmdError
StakePoolCmdWriteFileError
          (ExceptT (FileError ()) IO () -> ExceptT StakePoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakePoolCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out) -> Text -> m (Either (FileError e) ())
writeTextOutput Maybe (File () 'Out)
mOutFile
          (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Hash StakePoolKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 (VerificationKey StakePoolKey -> Hash StakePoolKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey)

runStakePoolMetadataHashCmd
  :: ()
  => StakePoolMetadataHashCmdArgs era
  -> ExceptT StakePoolCmdError IO ()
runStakePoolMetadataHashCmd :: forall era.
StakePoolMetadataHashCmdArgs era -> ExceptT StakePoolCmdError IO ()
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 ->
          (FileError TextEnvelopeError -> StakePoolCmdError)
-> ExceptT (FileError TextEnvelopeError) IO ByteString
-> ExceptT StakePoolCmdError IO ByteString
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> StakePoolCmdError
StakePoolCmdReadFileError
            (ExceptT (FileError TextEnvelopeError) IO ByteString
 -> ExceptT StakePoolCmdError IO ByteString)
-> (IO (Either (FileError TextEnvelopeError) ByteString)
    -> ExceptT (FileError TextEnvelopeError) IO ByteString)
-> IO (Either (FileError TextEnvelopeError) ByteString)
-> ExceptT StakePoolCmdError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeError) ByteString)
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
            (IO (Either (FileError TextEnvelopeError) ByteString)
 -> ExceptT StakePoolCmdError IO ByteString)
-> IO (Either (FileError TextEnvelopeError) ByteString)
-> ExceptT StakePoolCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ StakePoolMetadataFile 'In
-> IO (Either (FileError TextEnvelopeError) ByteString)
forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) ByteString)
readByteStringFile StakePoolMetadataFile 'In
poolMetadataFile
        StakePoolMetadataURL Url
urlText ->
          ExceptT FetchURLError IO ByteString
-> ExceptT StakePoolCmdError IO ByteString
fetchURLToStakePoolCmdError (ExceptT FetchURLError IO ByteString
 -> ExceptT StakePoolCmdError IO ByteString)
-> ExceptT FetchURLError IO ByteString
-> ExceptT StakePoolCmdError IO 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) <-
      (StakePoolMetadataValidationError -> StakePoolCmdError)
-> ExceptT
     StakePoolMetadataValidationError
     IO
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     StakePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y 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

    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 -> 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
        | Bool
otherwise -> IO () -> ExceptT StakePoolCmdError IO ()
forall a. IO a -> ExceptT StakePoolCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StakePoolCmdError IO ())
-> IO () -> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Hashes match!"
      Cmd.HashToFile File () 'Out
outFile -> Maybe (File () 'Out)
-> Hash StakePoolMetadata -> ExceptT StakePoolCmdError IO ()
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 -> ExceptT StakePoolCmdError IO ()
writeOutput Maybe (File () 'Out)
forall a. Maybe a
Nothing Hash StakePoolMetadata
metadataHash
   where
    writeOutput :: Maybe (File () Out) -> Hash StakePoolMetadata -> ExceptT StakePoolCmdError IO ()
    writeOutput :: Maybe (File () 'Out)
-> Hash StakePoolMetadata -> ExceptT StakePoolCmdError IO ()
writeOutput Maybe (File () 'Out)
mOutFile Hash StakePoolMetadata
metadataHash =
      case Maybe (File () 'Out)
mOutFile of
        Maybe (File () 'Out)
Nothing -> IO () -> ExceptT StakePoolCmdError IO ()
forall a. IO a -> ExceptT StakePoolCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StakePoolCmdError IO ())
-> IO () -> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (Hash StakePoolMetadata -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex Hash StakePoolMetadata
metadataHash)
        Just (File String
fpath) ->
          (IOException -> StakePoolCmdError)
-> IO () -> ExceptT StakePoolCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> StakePoolCmdError
StakePoolCmdWriteFileError (FileError () -> StakePoolCmdError)
-> (IOException -> FileError ())
-> IOException
-> StakePoolCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO () -> ExceptT StakePoolCmdError IO ())
-> IO () -> ExceptT StakePoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$
            String -> ByteString -> IO ()
BS.writeFile String
fpath (Hash StakePoolMetadata -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex Hash StakePoolMetadata
metadataHash)

    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 :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT FetchURLError -> StakePoolCmdError
StakePoolCmdFetchURLError

-- | 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 :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y 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 :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y 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