module Bcc.CLI.Sophie.Run.Pool
  ( SophiePoolCmdError(SophiePoolCmdReadFileError)
  , renderSophiePoolCmdError
  , runPoolCmd
  ) where

import           Bcc.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           Bcc.Api
import           Bcc.Api.Sophie
import           Bcc.CLI.Sophie.Commands
import           Bcc.CLI.Sophie.Key (InputDecodeError, VerificationKeyOrFile,
                     readVerificationKeyOrFile)
import           Bcc.CLI.Types (OutputFormat (..))

import qualified Bcc.Ledger.Slot as Sophie

data SophiePoolCmdError
  = SophiePoolCmdReadFileError !(FileError TextEnvelopeError)
  | SophiePoolCmdReadKeyFileError !(FileError InputDecodeError)
  | SophiePoolCmdWriteFileError !(FileError ())
  | SophiePoolCmdMetadataValidationError !StakePoolMetadataValidationError
  deriving Int -> SophiePoolCmdError -> ShowS
[SophiePoolCmdError] -> ShowS
SophiePoolCmdError -> String
(Int -> SophiePoolCmdError -> ShowS)
-> (SophiePoolCmdError -> String)
-> ([SophiePoolCmdError] -> ShowS)
-> Show SophiePoolCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SophiePoolCmdError] -> ShowS
$cshowList :: [SophiePoolCmdError] -> ShowS
show :: SophiePoolCmdError -> String
$cshow :: SophiePoolCmdError -> String
showsPrec :: Int -> SophiePoolCmdError -> ShowS
$cshowsPrec :: Int -> SophiePoolCmdError -> ShowS
Show

renderSophiePoolCmdError :: SophiePoolCmdError -> Text
renderSophiePoolCmdError :: SophiePoolCmdError -> Text
renderSophiePoolCmdError SophiePoolCmdError
err =
  case SophiePoolCmdError
err of
    SophiePoolCmdReadFileError FileError TextEnvelopeError
fileErr -> String -> Text
Text.pack (FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr)
    SophiePoolCmdReadKeyFileError FileError InputDecodeError
fileErr -> String -> Text
Text.pack (FileError InputDecodeError -> String
forall e. Error e => e -> String
displayError FileError InputDecodeError
fileErr)
    SophiePoolCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fileErr)
    SophiePoolCmdMetadataValidationError 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 SophiePoolCmdError IO ()
runPoolCmd :: PoolCmd -> ExceptT SophiePoolCmdError IO ()
runPoolCmd (PoolRegistrationCert VerificationKeyOrFile StakePoolKey
sPvkey VerificationKeyOrFile VrfKey
vrfVkey Entropic
pldg Entropic
pCost Rational
pMrgn VerificationKeyOrFile StakeKey
rwdVerFp [VerificationKeyOrFile StakeKey]
ownerVerFps [StakePoolRelay]
relays Maybe StakePoolMetadataReference
mbMetadata NetworkId
network OutputFile
outfp) =
  VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Entropic
-> Entropic
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> NetworkId
-> OutputFile
-> ExceptT SophiePoolCmdError IO ()
runStakePoolRegistrationCert VerificationKeyOrFile StakePoolKey
sPvkey VerificationKeyOrFile VrfKey
vrfVkey Entropic
pldg Entropic
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 SophiePoolCmdError IO ()
runStakePoolRetirementCert VerificationKeyOrFile StakePoolKey
sPvkeyFp EpochNo
retireEpoch OutputFile
outfp
runPoolCmd (PoolGetId VerificationKeyOrFile StakePoolKey
sPvkey OutputFormat
outputFormat) = VerificationKeyOrFile StakePoolKey
-> OutputFormat -> ExceptT SophiePoolCmdError IO ()
runPoolId VerificationKeyOrFile StakePoolKey
sPvkey OutputFormat
outputFormat
runPoolCmd (PoolMetadataHash PoolMetadataFile
poolMdFile Maybe OutputFile
mOutFile) = PoolMetadataFile
-> Maybe OutputFile -> ExceptT SophiePoolCmdError 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.
  -> Entropic
  -- ^ Pool pledge.
  -> Entropic
  -- ^ 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 SophiePoolCmdError IO ()
runStakePoolRegistrationCert :: VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Entropic
-> Entropic
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> NetworkId
-> OutputFile
-> ExceptT SophiePoolCmdError IO ()
runStakePoolRegistrationCert
  VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile
  VerificationKeyOrFile VrfKey
vrfVerKeyOrFile
  Entropic
pldg
  Entropic
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 -> SophiePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT SophiePoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> SophiePoolCmdError
SophiePoolCmdReadKeyFileError
      (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT SophiePoolCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError InputDecodeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT SophiePoolCmdError 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 -> SophiePoolCmdError)
-> ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
-> ExceptT SophiePoolCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> SophiePoolCmdError
SophiePoolCmdReadKeyFileError
      (ExceptT (FileError InputDecodeError) IO (VerificationKey VrfKey)
 -> ExceptT SophiePoolCmdError IO (VerificationKey VrfKey))
-> (IO
      (Either (FileError InputDecodeError) (VerificationKey VrfKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey VrfKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO (VerificationKey VrfKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey VrfKey))
-> ExceptT SophiePoolCmdError 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 -> SophiePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT SophiePoolCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> SophiePoolCmdError
SophiePoolCmdReadKeyFileError
      (ExceptT (FileError InputDecodeError) IO (VerificationKey StakeKey)
 -> ExceptT SophiePoolCmdError IO (VerificationKey StakeKey))
-> (IO
      (Either (FileError InputDecodeError) (VerificationKey StakeKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakeKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey StakeKey))
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO (VerificationKey StakeKey))
-> IO
     (Either (FileError InputDecodeError) (VerificationKey StakeKey))
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO (VerificationKey StakeKey))
-> [VerificationKeyOrFile StakeKey]
-> ExceptT SophiePoolCmdError IO [VerificationKey StakeKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
        ((FileError InputDecodeError -> SophiePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT SophiePoolCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> SophiePoolCmdError
SophiePoolCmdReadKeyFileError
          (ExceptT (FileError InputDecodeError) IO (VerificationKey StakeKey)
 -> ExceptT SophiePoolCmdError IO (VerificationKey StakeKey))
-> (VerificationKeyOrFile StakeKey
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakeKey))
-> VerificationKeyOrFile StakeKey
-> ExceptT SophiePoolCmdError 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
-> Entropic
-> Rational
-> StakeAddress
-> Entropic
-> [Hash StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> StakePoolParameters
StakePoolParameters
            { stakePoolId :: Hash StakePoolKey
stakePoolId = Hash StakePoolKey
stakePoolId'
            , stakePoolVRF :: Hash VrfKey
stakePoolVRF = Hash VrfKey
vrfKeyHash'
            , stakePoolCost :: Entropic
stakePoolCost = Entropic
pCost
            , stakePoolMargin :: Rational
stakePoolMargin = Rational
pMrgn
            , stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount = StakeAddress
rewardAccountAddr
            , stakePoolPledge :: Entropic
stakePoolPledge = Entropic
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 () -> SophiePoolCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT SophiePoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophiePoolCmdError
SophiePoolCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT SophiePoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophiePoolCmdError 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
  -> Sophie.EpochNo
  -> OutputFile
  -> ExceptT SophiePoolCmdError IO ()
runStakePoolRetirementCert :: VerificationKeyOrFile StakePoolKey
-> EpochNo -> OutputFile -> ExceptT SophiePoolCmdError IO ()
runStakePoolRetirementCert VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile EpochNo
retireEpoch (OutputFile String
outfp) = do
    -- Pool verification key
    VerificationKey StakePoolKey
stakePoolVerKey <- (FileError InputDecodeError -> SophiePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT SophiePoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> SophiePoolCmdError
SophiePoolCmdReadKeyFileError
      (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT SophiePoolCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError InputDecodeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT SophiePoolCmdError 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 () -> SophiePoolCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT SophiePoolCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophiePoolCmdError
SophiePoolCmdWriteFileError
      (ExceptT (FileError ()) IO () -> ExceptT SophiePoolCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO ()
runPoolId :: VerificationKeyOrFile StakePoolKey
-> OutputFormat -> ExceptT SophiePoolCmdError IO ()
runPoolId VerificationKeyOrFile StakePoolKey
verKeyOrFile OutputFormat
outputFormat = do
    VerificationKey StakePoolKey
stakePoolVerKey <- (FileError InputDecodeError -> SophiePoolCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
-> ExceptT SophiePoolCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> SophiePoolCmdError
SophiePoolCmdReadKeyFileError
      (ExceptT
   (FileError InputDecodeError) IO (VerificationKey StakePoolKey)
 -> ExceptT SophiePoolCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError InputDecodeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError InputDecodeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError InputDecodeError) (VerificationKey StakePoolKey))
-> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophiePoolCmdError IO ())
-> IO () -> ExceptT SophiePoolCmdError 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 SophiePoolCmdError IO ()
runPoolMetadataHash :: PoolMetadataFile
-> Maybe OutputFile -> ExceptT SophiePoolCmdError IO ()
runPoolMetadataHash (PoolMetadataFile String
poolMDPath) Maybe OutputFile
mOutFile = do
  ByteString
metadataBytes <- (IOException -> SophiePoolCmdError)
-> IO ByteString -> ExceptT SophiePoolCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError TextEnvelopeError -> SophiePoolCmdError
SophiePoolCmdReadFileError (FileError TextEnvelopeError -> SophiePoolCmdError)
-> (IOException -> FileError TextEnvelopeError)
-> IOException
-> SophiePoolCmdError
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 SophiePoolCmdError IO ByteString)
-> IO ByteString -> ExceptT SophiePoolCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
    String -> IO ByteString
BS.readFile String
poolMDPath
  (StakePoolMetadata
_metadata, Hash StakePoolMetadata
metadataHash) <-
      (StakePoolMetadataValidationError -> SophiePoolCmdError)
-> ExceptT
     StakePoolMetadataValidationError
     IO
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     SophiePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakePoolMetadataValidationError -> SophiePoolCmdError
SophiePoolCmdMetadataValidationError
    (ExceptT
   StakePoolMetadataValidationError
   IO
   (StakePoolMetadata, Hash StakePoolMetadata)
 -> ExceptT
      SophiePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata))
-> (Either
      StakePoolMetadataValidationError
      (StakePoolMetadata, Hash StakePoolMetadata)
    -> ExceptT
         StakePoolMetadataValidationError
         IO
         (StakePoolMetadata, Hash StakePoolMetadata))
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     SophiePoolCmdError 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
      SophiePoolCmdError IO (StakePoolMetadata, Hash StakePoolMetadata))
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
-> ExceptT
     SophiePoolCmdError 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 SophiePoolCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophiePoolCmdError IO ())
-> IO () -> ExceptT SophiePoolCmdError 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 -> SophiePoolCmdError)
-> IO () -> ExceptT SophiePoolCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophiePoolCmdError
SophiePoolCmdWriteFileError (FileError () -> SophiePoolCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophiePoolCmdError
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 SophiePoolCmdError IO ())
-> IO () -> ExceptT SophiePoolCmdError 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)