module Cardano.CLI.Shelley.Run.Pool
  ( ShelleyPoolCmdError(ShelleyPoolCmdReadFileError)
  , renderShelleyPoolCmdError
  , runPoolCmd
  ) where

import           Cardano.Prelude

import qualified Data.Text as Text
import qualified Data.Text.IO as Text

import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither,
                     newExceptT)

import qualified Data.ByteString.Char8 as BS

import           Cardano.Api
import           Cardano.Api.Shelley
import           Cardano.CLI.Shelley.Commands
import           Cardano.CLI.Shelley.Key (InputDecodeError, VerificationKeyOrFile,
                     readVerificationKeyOrFile)
import           Cardano.CLI.Types (OutputFormat (..))

import qualified Cardano.Ledger.Slot as Shelley

data ShelleyPoolCmdError
  = ShelleyPoolCmdReadFileError !(FileError TextEnvelopeError)
  | ShelleyPoolCmdReadKeyFileError !(FileError InputDecodeError)
  | ShelleyPoolCmdWriteFileError !(FileError ())
  | ShelleyPoolCmdMetadataValidationError !StakePoolMetadataValidationError
  deriving Int -> ShelleyPoolCmdError -> ShowS
[ShelleyPoolCmdError] -> ShowS
ShelleyPoolCmdError -> String
(Int -> ShelleyPoolCmdError -> ShowS)
-> (ShelleyPoolCmdError -> String)
-> ([ShelleyPoolCmdError] -> ShowS)
-> Show ShelleyPoolCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyPoolCmdError] -> ShowS
$cshowList :: [ShelleyPoolCmdError] -> ShowS
show :: ShelleyPoolCmdError -> String
$cshow :: ShelleyPoolCmdError -> String
showsPrec :: Int -> ShelleyPoolCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyPoolCmdError -> ShowS
Show

renderShelleyPoolCmdError :: ShelleyPoolCmdError -> Text
renderShelleyPoolCmdError :: ShelleyPoolCmdError -> Text
renderShelleyPoolCmdError ShelleyPoolCmdError
err =
  case ShelleyPoolCmdError
err of
    ShelleyPoolCmdReadFileError FileError TextEnvelopeError
fileErr -> String -> Text
Text.pack (FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr)
    ShelleyPoolCmdReadKeyFileError FileError InputDecodeError
fileErr -> String -> Text
Text.pack (FileError InputDecodeError -> String
forall e. Error e => e -> String
displayError FileError InputDecodeError
fileErr)
    ShelleyPoolCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    ShelleyPoolCmdMetadataValidationError StakePoolMetadataValidationError
validationErr ->
      Text
"Error validating stake pool metadata: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (StakePoolMetadataValidationError -> String
forall e. Error e => e -> String
displayError StakePoolMetadataValidationError
validationErr)



runPoolCmd :: PoolCmd -> ExceptT ShelleyPoolCmdError IO ()
runPoolCmd :: PoolCmd -> ExceptT ShelleyPoolCmdError IO ()
runPoolCmd (PoolRegistrationCert VerificationKeyOrFile StakePoolKey
sPvkey VerificationKeyOrFile VrfKey
vrfVkey Lovelace
pldg Lovelace
pCost Rational
pMrgn VerificationKeyOrFile StakeKey
rwdVerFp [VerificationKeyOrFile StakeKey]
ownerVerFps [StakePoolRelay]
relays Maybe StakePoolMetadataReference
mbMetadata NetworkId
network OutputFile
outfp) =
  VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Lovelace
-> Lovelace
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> NetworkId
-> OutputFile
-> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRegistrationCert VerificationKeyOrFile StakePoolKey
sPvkey VerificationKeyOrFile VrfKey
vrfVkey Lovelace
pldg Lovelace
pCost Rational
pMrgn VerificationKeyOrFile StakeKey
rwdVerFp [VerificationKeyOrFile StakeKey]
ownerVerFps [StakePoolRelay]
relays Maybe StakePoolMetadataReference
mbMetadata NetworkId
network OutputFile
outfp
runPoolCmd (PoolRetirementCert VerificationKeyOrFile StakePoolKey
sPvkeyFp EpochNo
retireEpoch OutputFile
outfp) =
  VerificationKeyOrFile StakePoolKey
-> EpochNo -> OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRetirementCert VerificationKeyOrFile StakePoolKey
sPvkeyFp EpochNo
retireEpoch OutputFile
outfp
runPoolCmd (PoolGetId VerificationKeyOrFile StakePoolKey
sPvkey OutputFormat
outputFormat) = VerificationKeyOrFile StakePoolKey
-> OutputFormat -> ExceptT ShelleyPoolCmdError IO ()
runPoolId VerificationKeyOrFile StakePoolKey
sPvkey OutputFormat
outputFormat
runPoolCmd (PoolMetadataHash PoolMetadataFile
poolMdFile Maybe OutputFile
mOutFile) = PoolMetadataFile
-> Maybe OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runPoolMetadataHash PoolMetadataFile
poolMdFile Maybe OutputFile
mOutFile


--
-- Stake pool command implementations
--

-- | Create a stake pool registration cert.
-- TODO: Metadata and more stake pool relay support to be
-- added in the future.
runStakePoolRegistrationCert
  :: VerificationKeyOrFile StakePoolKey
  -- ^ Stake pool verification key.
  -> VerificationKeyOrFile VrfKey
  -- ^ VRF Verification key.
  -> Lovelace
  -- ^ Pool pledge.
  -> Lovelace
  -- ^ Pool cost.
  -> Rational
  -- ^ Pool margin.
  -> VerificationKeyOrFile StakeKey
  -- ^ Stake verification key for reward account.
  -> [VerificationKeyOrFile StakeKey]
  -- ^ Pool owner stake verification key(s).
  -> [StakePoolRelay]
  -- ^ Stake pool relays.
  -> Maybe StakePoolMetadataReference
  -- ^ Stake pool metadata.
  -> NetworkId
  -> OutputFile
  -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRegistrationCert :: VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Lovelace
-> Lovelace
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> NetworkId
-> OutputFile
-> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRegistrationCert
  VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile
  VerificationKeyOrFile VrfKey
vrfVerKeyOrFile
  Lovelace
pldg
  Lovelace
pCost
  Rational
pMrgn
  VerificationKeyOrFile StakeKey
rwdStakeVerKeyOrFile
  [VerificationKeyOrFile StakeKey]
ownerStakeVerKeyOrFiles
  [StakePoolRelay]
relays
  Maybe StakePoolMetadataReference
mbMetadata
  NetworkId
network
  (OutputFile String
outfp) = do
    -- Pool verification key
    VerificationKey StakePoolKey
stakePoolVerKey <- (FileError InputDecodeError -> ShelleyPoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError InputDecodeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either
      (FileError InputDecodeError) (VerificationKey StakePoolKey))
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType StakePoolKey
-> VerificationKeyOrFile StakePoolKey
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile
    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 -> ShelleyPoolCmdError)
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT ShelleyPoolCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      (ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey VrfKey))
-> (IO
      (Either (FileError InputDecodeError) (VerificationKey VrfKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey VrfKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError InputDecodeError) (VerificationKey VrfKey))
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey VrfKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType VrfKey
-> VerificationKeyOrFile VrfKey
-> IO
     (Either (FileError InputDecodeError) (VerificationKey VrfKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType VrfKey
AsVrfKey VerificationKeyOrFile VrfKey
vrfVerKeyOrFile
    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 -> ShelleyPoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      (ExceptT (FileError InputDecodeError) IO (VerificationKey StakeKey)
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey))
-> (IO
      (Either (FileError InputDecodeError) (VerificationKey StakeKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakeKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey StakeKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError InputDecodeError) (VerificationKey StakeKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either (FileError InputDecodeError) (VerificationKey StakeKey))
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey StakeKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType StakeKey
-> VerificationKeyOrFile StakeKey
-> IO
     (Either (FileError InputDecodeError) (VerificationKey StakeKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakeKey
AsStakeKey VerificationKeyOrFile StakeKey
rwdStakeVerKeyOrFile
    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 ShelleyPoolCmdError IO (VerificationKey StakeKey))
-> [VerificationKeyOrFile StakeKey]
-> ExceptT ShelleyPoolCmdError IO [VerificationKey StakeKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
        ((FileError InputDecodeError -> ShelleyPoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
          (ExceptT (FileError InputDecodeError) IO (VerificationKey StakeKey)
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey))
-> (VerificationKeyOrFile StakeKey
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakeKey))
-> VerificationKeyOrFile StakeKey
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakeKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError InputDecodeError) (VerificationKey StakeKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          (IO
   (Either (FileError InputDecodeError) (VerificationKey StakeKey))
 -> ExceptT
      (FileError InputDecodeError) IO (VerificationKey StakeKey))
-> (VerificationKeyOrFile StakeKey
    -> IO
         (Either (FileError InputDecodeError) (VerificationKey StakeKey)))
-> VerificationKeyOrFile StakeKey
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType StakeKey
-> VerificationKeyOrFile StakeKey
-> IO
     (Either (FileError InputDecodeError) (VerificationKey StakeKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakeKey
AsStakeKey
        )
        [VerificationKeyOrFile StakeKey]
ownerStakeVerKeyOrFiles
    let stakePoolOwners' :: [Hash StakeKey]
stakePoolOwners' = (VerificationKey StakeKey -> Hash StakeKey)
-> [VerificationKey StakeKey] -> [Hash StakeKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash [VerificationKey StakeKey]
sPoolOwnerVkeys

    let stakePoolParams :: StakePoolParameters
stakePoolParams =
          StakePoolParameters :: Hash StakePoolKey
-> Hash VrfKey
-> Lovelace
-> Rational
-> StakeAddress
-> Lovelace
-> [Hash StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> StakePoolParameters
StakePoolParameters
            { stakePoolId :: Hash StakePoolKey
stakePoolId = Hash StakePoolKey
stakePoolId'
            , stakePoolVRF :: Hash VrfKey
stakePoolVRF = Hash VrfKey
vrfKeyHash'
            , stakePoolCost :: Lovelace
stakePoolCost = Lovelace
pCost
            , stakePoolMargin :: Rational
stakePoolMargin = Rational
pMrgn
            , stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount = StakeAddress
rewardAccountAddr
            , stakePoolPledge :: Lovelace
stakePoolPledge = Lovelace
pldg
            , stakePoolOwners :: [Hash StakeKey]
stakePoolOwners = [Hash StakeKey]
stakePoolOwners'
            , stakePoolRelays :: [StakePoolRelay]
stakePoolRelays = [StakePoolRelay]
relays
            , stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata = Maybe StakePoolMetadataReference
mbMetadata
            }

    let registrationCert :: Certificate
registrationCert = StakePoolParameters -> Certificate
makeStakePoolRegistrationCertificate StakePoolParameters
stakePoolParams

    (FileError () -> ShelleyPoolCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyPoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyPoolCmdError
ShelleyPoolCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT ShelleyPoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyPoolCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyPoolCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyPoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> Certificate
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
outfp (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
registrationCertDesc) Certificate
registrationCert
  where
    registrationCertDesc :: TextEnvelopeDescr
    registrationCertDesc :: TextEnvelopeDescr
registrationCertDesc = TextEnvelopeDescr
"Stake Pool Registration Certificate"

runStakePoolRetirementCert
  :: VerificationKeyOrFile StakePoolKey
  -> Shelley.EpochNo
  -> OutputFile
  -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRetirementCert :: VerificationKeyOrFile StakePoolKey
-> EpochNo -> OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRetirementCert VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile EpochNo
retireEpoch (OutputFile String
outfp) = do
    -- Pool verification key
    VerificationKey StakePoolKey
stakePoolVerKey <- (FileError InputDecodeError -> ShelleyPoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError InputDecodeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either
      (FileError InputDecodeError) (VerificationKey StakePoolKey))
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType StakePoolKey
-> VerificationKeyOrFile StakePoolKey
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile

    let stakePoolId' :: Hash StakePoolKey
stakePoolId' = VerificationKey StakePoolKey -> Hash StakePoolKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey
        retireCert :: Certificate
retireCert = Hash StakePoolKey -> EpochNo -> Certificate
makeStakePoolRetirementCertificate Hash StakePoolKey
stakePoolId' EpochNo
retireEpoch

    (FileError () -> ShelleyPoolCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT ShelleyPoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyPoolCmdError
ShelleyPoolCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT ShelleyPoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyPoolCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyPoolCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT ShelleyPoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> Certificate
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
outfp (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
retireCertDesc) Certificate
retireCert
  where
    retireCertDesc :: TextEnvelopeDescr
    retireCertDesc :: TextEnvelopeDescr
retireCertDesc = TextEnvelopeDescr
"Stake Pool Retirement Certificate"

runPoolId
  :: VerificationKeyOrFile StakePoolKey
  -> OutputFormat
  -> ExceptT ShelleyPoolCmdError IO ()
runPoolId :: VerificationKeyOrFile StakePoolKey
-> OutputFormat -> ExceptT ShelleyPoolCmdError IO ()
runPoolId VerificationKeyOrFile StakePoolKey
verKeyOrFile OutputFormat
outputFormat = do
    VerificationKey StakePoolKey
stakePoolVerKey <- (FileError InputDecodeError -> ShelleyPoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError InputDecodeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either
      (FileError InputDecodeError) (VerificationKey StakePoolKey))
 -> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyPoolCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType StakePoolKey
-> VerificationKeyOrFile StakePoolKey
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
verKeyOrFile
    IO () -> ExceptT ShelleyPoolCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyPoolCmdError IO ())
-> IO () -> ExceptT ShelleyPoolCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      case OutputFormat
outputFormat of
        OutputFormat
OutputFormatHex ->
          ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
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)
        OutputFormat
OutputFormatBech32 ->
          Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
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)

runPoolMetadataHash :: PoolMetadataFile -> Maybe OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runPoolMetadataHash :: PoolMetadataFile
-> Maybe OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runPoolMetadataHash (PoolMetadataFile String
poolMDPath) Maybe OutputFile
mOutFile = do
  ByteString
metadataBytes <- (IOException -> ShelleyPoolCmdError)
-> IO ByteString -> ExceptT ShelleyPoolCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError TextEnvelopeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadFileError (FileError TextEnvelopeError -> ShelleyPoolCmdError)
-> (IOException -> FileError TextEnvelopeError)
-> IOException
-> ShelleyPoolCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError TextEnvelopeError
forall e. String -> IOException -> FileError e
FileIOError String
poolMDPath) (IO ByteString -> ExceptT ShelleyPoolCmdError IO ByteString)
-> IO ByteString -> ExceptT ShelleyPoolCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
    String -> IO ByteString
BS.readFile String
poolMDPath
  (StakePoolMetadata
_metadata, Hash StakePoolMetadata
metadataHash) <-
      (StakePoolMetadataValidationError -> ShelleyPoolCmdError)
-> ExceptT
     StakePoolMetadataValidationError
     IO
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     ShelleyPoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakePoolMetadataValidationError -> ShelleyPoolCmdError
ShelleyPoolCmdMetadataValidationError
    (ExceptT
   StakePoolMetadataValidationError
   IO
   (StakePoolMetadata, Hash StakePoolMetadata)
 -> ExceptT
      ShelleyPoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata))
-> (Either
      StakePoolMetadataValidationError
      (StakePoolMetadata, Hash StakePoolMetadata)
    -> ExceptT
         StakePoolMetadataValidationError
         IO
         (StakePoolMetadata, Hash StakePoolMetadata))
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     ShelleyPoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
      ShelleyPoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata))
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     ShelleyPoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
validateAndHashStakePoolMetadata ByteString
metadataBytes
  case Maybe OutputFile
mOutFile of
    Maybe OutputFile
Nothing -> IO () -> ExceptT ShelleyPoolCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyPoolCmdError IO ())
-> IO () -> ExceptT ShelleyPoolCmdError 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 (OutputFile String
fpath) ->
      (IOException -> ShelleyPoolCmdError)
-> IO () -> ExceptT ShelleyPoolCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyPoolCmdError
ShelleyPoolCmdWriteFileError (FileError () -> ShelleyPoolCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyPoolCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath)
        (IO () -> ExceptT ShelleyPoolCmdError IO ())
-> IO () -> ExceptT ShelleyPoolCmdError 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)