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

{- HLINT ignore "Monad law, left identity" -}

module Cardano.CLI.EraBased.Run.StakeAddress
  ( runStakeAddressCmds
  , runStakeAddressBuildCmd
  , runStakeAddressKeyGenCmd
  , runStakeAddressKeyHashCmd
  , runStakeAddressStakeDelegationCertificateCmd
  , runStakeAddressDeregistrationCertificateCmd
  , runStakeAddressRegistrationCertificateCmd
  , runStakeAddressRegistrationAndDelegationCertificateCmd
  , runStakeAddressRegistrationStakeAndVoteDelegationCertificateCmd
  )
where

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

import           Cardano.CLI.EraBased.Commands.StakeAddress
import           Cardano.CLI.Read
import qualified Cardano.CLI.Run.Key as Key
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.StakeAddressCmdError
import           Cardano.CLI.Types.Errors.StakeAddressRegistrationError
import           Cardano.CLI.Types.Governance
import           Cardano.CLI.Types.Key

import           Control.Monad (void)
import qualified Data.ByteString.Char8 as BS
import           Data.Function ((&))
import qualified Data.Text.IO as Text

runStakeAddressCmds
  :: ()
  => StakeAddressCmds era
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressCmds :: forall era.
StakeAddressCmds era -> ExceptT StakeAddressCmdError IO ()
runStakeAddressCmds = \case
  StakeAddressKeyGenCmd KeyOutputFormat
fmt VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk ->
    ExceptT
  StakeAddressCmdError
  IO
  (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   StakeAddressCmdError
   IO
   (VerificationKey StakeKey, SigningKey StakeKey)
 -> ExceptT StakeAddressCmdError IO ())
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd KeyOutputFormat
fmt VerificationKeyFile 'Out
vk SigningKeyFile 'Out
sk
  StakeAddressKeyHashCmd VerificationKeyOrFile StakeKey
vk Maybe (File () 'Out)
mOutputFp ->
    VerificationKeyOrFile StakeKey
-> Maybe (File () 'Out) -> ExceptT StakeAddressCmdError IO ()
runStakeAddressKeyHashCmd VerificationKeyOrFile StakeKey
vk Maybe (File () 'Out)
mOutputFp
  StakeAddressBuildCmd StakeVerifier
stakeVerifier NetworkId
nw Maybe (File () 'Out)
mOutputFp ->
    StakeVerifier
-> NetworkId
-> Maybe (File () 'Out)
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressBuildCmd StakeVerifier
stakeVerifier NetworkId
nw Maybe (File () 'Out)
mOutputFp
  StakeAddressRegistrationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeIdentifier Maybe Coin
mDeposit File () 'Out
outputFp ->
    ShelleyBasedEra era
-> StakeIdentifier
-> Maybe Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ShelleyBasedEra era
-> StakeIdentifier
-> Maybe Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeIdentifier Maybe Coin
mDeposit File () 'Out
outputFp
  StakeAddressStakeDelegationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeIdentifier VerificationKeyOrHashOrFile StakePoolKey
stkPoolVerKeyHashOrFp File () 'Out
outputFp ->
    ShelleyBasedEra era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ShelleyBasedEra era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressStakeDelegationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeIdentifier VerificationKeyOrHashOrFile StakePoolKey
stkPoolVerKeyHashOrFp File () 'Out
outputFp
  StakeAddressStakeAndVoteDelegationCertificateCmd
    ConwayEraOnwards era
w
    StakeIdentifier
stakeIdentifier
    VerificationKeyOrHashOrFile StakePoolKey
stakePoolVerificationKeyHashSource
    VoteDelegationTarget
voteDelegationTarget
    File () 'Out
outputFp ->
      ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> VoteDelegationTarget
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> VoteDelegationTarget
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressStakeAndVoteDelegationCertificateCmd
        ConwayEraOnwards era
w
        StakeIdentifier
stakeIdentifier
        VerificationKeyOrHashOrFile StakePoolKey
stakePoolVerificationKeyHashSource
        VoteDelegationTarget
voteDelegationTarget
        File () 'Out
outputFp
  StakeAddressVoteDelegationCertificateCmd ConwayEraOnwards era
w StakeIdentifier
stakeIdentifier VoteDelegationTarget
voteDelegationTarget File () 'Out
outputFp ->
    ConwayEraOnwards era
-> StakeIdentifier
-> VoteDelegationTarget
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VoteDelegationTarget
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressVoteDelegationCertificateCmd ConwayEraOnwards era
w StakeIdentifier
stakeIdentifier VoteDelegationTarget
voteDelegationTarget File () 'Out
outputFp
  StakeAddressDeregistrationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeIdentifier Maybe Coin
mDeposit File () 'Out
outputFp ->
    ShelleyBasedEra era
-> StakeIdentifier
-> Maybe Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ShelleyBasedEra era
-> StakeIdentifier
-> Maybe Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressDeregistrationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeIdentifier Maybe Coin
mDeposit File () 'Out
outputFp
  StakeAddressRegistrationAndDelegationCertificateCmd
    ConwayEraOnwards era
w
    StakeIdentifier
stakeIdentifier
    VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile
    Coin
deposit
    File () 'Out
outFp ->
      ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationAndDelegationCertificateCmd
        ConwayEraOnwards era
w
        StakeIdentifier
stakeIdentifier
        VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile
        Coin
deposit
        File () 'Out
outFp
  StakeAddressRegistrationAndVoteDelegationCertificateCmd
    ConwayEraOnwards era
w
    StakeIdentifier
stakeIdentifier
    VoteDelegationTarget
voteDelegationTarget
    Coin
keydeposit
    File () 'Out
outFp ->
      ConwayEraOnwards era
-> StakeIdentifier
-> VoteDelegationTarget
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VoteDelegationTarget
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationAndVoteDelegationCertificateCmd
        ConwayEraOnwards era
w
        StakeIdentifier
stakeIdentifier
        VoteDelegationTarget
voteDelegationTarget
        Coin
keydeposit
        File () 'Out
outFp
  StakeAddressRegistrationStakeAndVoteDelegationCertificateCmd
    ConwayEraOnwards era
w
    StakeIdentifier
stakeIdentifier
    VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile
    VoteDelegationTarget
voteDelegationTarget
    Coin
keydeposit
    File () 'Out
outFp ->
      ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> VoteDelegationTarget
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> VoteDelegationTarget
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationStakeAndVoteDelegationCertificateCmd
        ConwayEraOnwards era
w
        StakeIdentifier
stakeIdentifier
        VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile
        VoteDelegationTarget
voteDelegationTarget
        Coin
keydeposit
        File () 'Out
outFp

runStakeAddressKeyGenCmd
  :: ()
  => KeyOutputFormat
  -> VerificationKeyFile Out
  -> SigningKeyFile Out
  -> ExceptT StakeAddressCmdError IO (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd :: KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd KeyOutputFormat
fmt VerificationKeyFile 'Out
vkFp SigningKeyFile 'Out
skFp = do
  let skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Stake Signing Key"

  SigningKey StakeKey
skey <- AsType StakeKey
-> ExceptT StakeAddressCmdError IO (SigningKey StakeKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType StakeKey
AsStakeKey

  let vkey :: VerificationKey StakeKey
vkey = SigningKey StakeKey -> VerificationKey StakeKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey StakeKey
skey

  (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    case KeyOutputFormat
fmt of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
skFp (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey StakeKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey StakeKey
skey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile SigningKeyFile 'Out
skFp (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ SigningKey StakeKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey StakeKey
skey

    case KeyOutputFormat
fmt of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkFp (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey StakeKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.stakeVkeyDesc) VerificationKey StakeKey
vkey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile VerificationKeyFile 'Out
vkFp (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 VerificationKey StakeKey
vkey
  (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
forall a. a -> ExceptT StakeAddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey StakeKey
vkey, SigningKey StakeKey
skey)

runStakeAddressKeyHashCmd
  :: ()
  => VerificationKeyOrFile StakeKey
  -> Maybe (File () Out)
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressKeyHashCmd :: VerificationKeyOrFile StakeKey
-> Maybe (File () 'Out) -> ExceptT StakeAddressCmdError IO ()
runStakeAddressKeyHashCmd VerificationKeyOrFile StakeKey
stakeVerKeyOrFile Maybe (File () 'Out)
mOutputFp = do
  VerificationKey StakeKey
vkey <-
    (FileError InputDecodeError -> StakeAddressCmdError)
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT StakeAddressCmdError IO (VerificationKey StakeKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> StakeAddressCmdError
StakeAddressCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (VerificationKey StakeKey)
 -> ExceptT StakeAddressCmdError IO (VerificationKey StakeKey))
-> ExceptT
     (FileError InputDecodeError) IO (VerificationKey StakeKey)
-> ExceptT StakeAddressCmdError 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
stakeVerKeyOrFile

  let hexKeyHash :: ByteString
hexKeyHash = Hash StakeKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
vkey)

  case Maybe (File () 'Out)
mOutputFp of
    Just (File FilePath
fpath) -> IO () -> ExceptT StakeAddressCmdError IO ()
forall a. IO a -> ExceptT StakeAddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StakeAddressCmdError IO ())
-> IO () -> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fpath ByteString
hexKeyHash
    Maybe (File () 'Out)
Nothing -> IO () -> ExceptT StakeAddressCmdError IO ()
forall a. IO a -> ExceptT StakeAddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StakeAddressCmdError IO ())
-> IO () -> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn ByteString
hexKeyHash

runStakeAddressBuildCmd
  :: ()
  => StakeVerifier
  -> NetworkId
  -> Maybe (File () Out)
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressBuildCmd :: StakeVerifier
-> NetworkId
-> Maybe (File () 'Out)
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressBuildCmd StakeVerifier
stakeVerifier NetworkId
network Maybe (File () 'Out)
mOutputFp = do
  StakeAddress
stakeAddr <-
    NetworkId
-> StakeVerifier -> ExceptT StakeCredentialError IO StakeAddress
getStakeAddressFromVerifier NetworkId
network StakeVerifier
stakeVerifier
      ExceptT StakeCredentialError IO StakeAddress
-> (ExceptT StakeCredentialError IO StakeAddress
    -> ExceptT StakeAddressCmdError IO StakeAddress)
-> ExceptT StakeAddressCmdError IO StakeAddress
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeAddress
-> ExceptT StakeAddressCmdError IO StakeAddress
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError
  let stakeAddrText :: Text
stakeAddrText = StakeAddress -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress StakeAddress
stakeAddr
  IO () -> ExceptT StakeAddressCmdError IO ()
forall a. IO a -> ExceptT StakeAddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StakeAddressCmdError IO ())
-> IO () -> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    case Maybe (File () 'Out)
mOutputFp of
      Just (File FilePath
fpath) -> FilePath -> Text -> IO ()
Text.writeFile FilePath
fpath Text
stakeAddrText
      Maybe (File () 'Out)
Nothing -> Text -> IO ()
Text.putStrLn Text
stakeAddrText

runStakeAddressRegistrationCertificateCmd
  :: ()
  => ShelleyBasedEra era
  -> StakeIdentifier
  -> Maybe Lovelace
  -- ^ Deposit required in conway era
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationCertificateCmd :: forall era.
ShelleyBasedEra era
-> StakeIdentifier
-> Maybe Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeIdentifier Maybe Coin
mDeposit File () 'Out
oFp = do
  StakeCredential
stakeCred <-
    StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeIdentifier
      ExceptT StakeCredentialError IO StakeCredential
-> (ExceptT StakeCredentialError IO StakeCredential
    -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError

  StakeAddressRequirements era
req <-
    (StakeAddressRegistrationError -> StakeAddressCmdError)
-> ExceptT
     StakeAddressRegistrationError IO (StakeAddressRequirements era)
-> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeAddressRegistrationError -> StakeAddressCmdError
StakeAddressCmdRegistrationError
      (ExceptT
   StakeAddressRegistrationError IO (StakeAddressRequirements era)
 -> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era))
-> (Either
      StakeAddressRegistrationError (StakeAddressRequirements era)
    -> ExceptT
         StakeAddressRegistrationError IO (StakeAddressRequirements era))
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
-> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either StakeAddressRegistrationError (StakeAddressRequirements era)
-> ExceptT
     StakeAddressRegistrationError IO (StakeAddressRequirements era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
      (Either
   StakeAddressRegistrationError (StakeAddressRequirements era)
 -> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era))
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
-> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> StakeCredential
-> Maybe Coin
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall era.
ShelleyBasedEra era
-> StakeCredential
-> Maybe Coin
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
createRegistrationCertRequirements ShelleyBasedEra era
sbe StakeCredential
stakeCred Maybe Coin
mDeposit

  let regCert :: Certificate era
regCert = StakeAddressRequirements era -> Certificate era
forall era. StakeAddressRequirements era -> Certificate era
makeStakeAddressRegistrationCertificate StakeAddressRequirements era
req

  (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
    (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
oFp
    (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe
    ((ShelleyBasedEraConstraints era => ByteString) -> ByteString)
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
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
regCertDesc) Certificate era
regCert
 where
  regCertDesc :: TextEnvelopeDescr
  regCertDesc :: TextEnvelopeDescr
regCertDesc = TextEnvelopeDescr
"Stake Address Registration Certificate"

createRegistrationCertRequirements
  :: ()
  => ShelleyBasedEra era
  -> StakeCredential
  -> Maybe Lovelace
  -- ^ Deposit required in conway era
  -> Either StakeAddressRegistrationError (StakeAddressRequirements era)
createRegistrationCertRequirements :: forall era.
ShelleyBasedEra era
-> StakeCredential
-> Maybe Coin
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
createRegistrationCertRequirements ShelleyBasedEra era
sbe StakeCredential
stakeCred Maybe Coin
mdeposit =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a. a -> Either StakeAddressRegistrationError a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddressRequirements era
 -> Either
      StakeAddressRegistrationError (StakeAddressRequirements era))
-> StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
forall era.
ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
StakeAddrRegistrationPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra ShelleyEra
ShelleyToBabbageEraShelley StakeCredential
stakeCred
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a. a -> Either StakeAddressRegistrationError a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddressRequirements era
 -> Either
      StakeAddressRegistrationError (StakeAddressRequirements era))
-> StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
forall era.
ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
StakeAddrRegistrationPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra AllegraEra
ShelleyToBabbageEraAllegra StakeCredential
stakeCred
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a. a -> Either StakeAddressRegistrationError a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddressRequirements era
 -> Either
      StakeAddressRegistrationError (StakeAddressRequirements era))
-> StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
forall era.
ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
StakeAddrRegistrationPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra MaryEra
ShelleyToBabbageEraMary StakeCredential
stakeCred
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a. a -> Either StakeAddressRegistrationError a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddressRequirements era
 -> Either
      StakeAddressRegistrationError (StakeAddressRequirements era))
-> StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
forall era.
ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
StakeAddrRegistrationPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra AlonzoEra
ShelleyToBabbageEraAlonzo StakeCredential
stakeCred
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a. a -> Either StakeAddressRegistrationError a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddressRequirements era
 -> Either
      StakeAddressRegistrationError (StakeAddressRequirements era))
-> StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
forall era.
ShelleyToBabbageEra era
-> StakeCredential -> StakeAddressRequirements era
StakeAddrRegistrationPreConway ShelleyToBabbageEra era
ShelleyToBabbageEra BabbageEra
ShelleyToBabbageEraBabbage StakeCredential
stakeCred
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      case Maybe Coin
mdeposit of
        Maybe Coin
Nothing ->
          -- This case is made impossible by the parser, that distinguishes between Conway
          -- and pre-Conway.
          StakeAddressRegistrationError
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a b. a -> Either a b
Left StakeAddressRegistrationError
StakeAddressRegistrationDepositRequired
        Just Coin
dep ->
          StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a. a -> Either StakeAddressRegistrationError a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddressRequirements era
 -> Either
      StakeAddressRegistrationError (StakeAddressRequirements era))
-> StakeAddressRequirements era
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era
-> Coin -> StakeCredential -> StakeAddressRequirements era
forall era.
ConwayEraOnwards era
-> Coin -> StakeCredential -> StakeAddressRequirements era
StakeAddrRegistrationConway ConwayEraOnwards era
ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway Coin
dep StakeCredential
stakeCred

runStakeAddressStakeDelegationCertificateCmd
  :: ()
  => ShelleyBasedEra era
  -> StakeIdentifier
  -- ^ Delegator stake verification key, verification key file or script file.
  -> VerificationKeyOrHashOrFile StakePoolKey
  -- ^ Delegatee stake pool verification key or verification key file or
  -- verification key hash.
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressStakeDelegationCertificateCmd :: forall era.
ShelleyBasedEra era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressStakeDelegationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeVerifier VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile File () 'Out
outFp =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  ExceptT StakeAddressCmdError IO ())
 -> ExceptT StakeAddressCmdError IO ())
-> (ShelleyBasedEraConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    Hash StakePoolKey
poolStakeVKeyHash <-
      (FileError InputDecodeError -> StakeAddressCmdError)
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> StakeAddressCmdError
StakeAddressCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
 -> ExceptT StakeAddressCmdError IO (Hash StakePoolKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$
        AsType StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m, Key keyrole,
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile

    StakeCredential
stakeCred <-
      StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeVerifier
        ExceptT StakeCredentialError IO StakeCredential
-> (ExceptT StakeCredentialError IO StakeCredential
    -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError

    let certificate :: Certificate era
certificate = StakeCredential
-> Hash StakePoolKey -> ShelleyBasedEra era -> Certificate era
forall era.
StakeCredential
-> Hash StakePoolKey -> ShelleyBasedEra era -> Certificate era
createStakeDelegationCertificate StakeCredential
stakeCred Hash StakePoolKey
poolStakeVKeyHash ShelleyBasedEra era
sbe

    (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
outFp
      (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 (forall a. a -> Maybe a
Just @TextEnvelopeDescr TextEnvelopeDescr
"Stake Delegation Certificate") Certificate era
certificate

runStakeAddressStakeAndVoteDelegationCertificateCmd
  :: ()
  => ConwayEraOnwards era
  -> StakeIdentifier
  -- ^ Delegator stake verification key, verification key file or script file.
  -> VerificationKeyOrHashOrFile StakePoolKey
  -- ^ Delegatee stake pool verification key or verification key file or
  -> VoteDelegationTarget
  -- verification key hash.
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressStakeAndVoteDelegationCertificateCmd :: forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> VoteDelegationTarget
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressStakeAndVoteDelegationCertificateCmd ConwayEraOnwards era
w StakeIdentifier
stakeVerifier VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile VoteDelegationTarget
voteDelegationTarget File () 'Out
outFp =
  ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  ExceptT StakeAddressCmdError IO ())
 -> ExceptT StakeAddressCmdError IO ())
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash <-
      (FileError InputDecodeError -> StakeAddressCmdError)
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> StakeAddressCmdError
StakeAddressCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
 -> ExceptT StakeAddressCmdError IO (Hash StakePoolKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$
        AsType StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m, Key keyrole,
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile

    StakeCredential
stakeCredential <-
      (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError (ExceptT StakeCredentialError IO StakeCredential
 -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
        StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeVerifier

    DRep StandardCrypto
drep <-
      VoteDelegationTarget
-> ExceptT DelegationError IO (DRep StandardCrypto)
readVoteDelegationTarget VoteDelegationTarget
voteDelegationTarget
        ExceptT DelegationError IO (DRep StandardCrypto)
-> (ExceptT DelegationError IO (DRep StandardCrypto)
    -> ExceptT StakeAddressCmdError IO (DRep StandardCrypto))
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall a b. a -> (a -> b) -> b
& (DelegationError -> StakeAddressCmdError)
-> ExceptT DelegationError IO (DRep StandardCrypto)
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT DelegationError -> StakeAddressCmdError
StakeAddressCmdDelegationError

    let delegatee :: Delegatee StandardCrypto
delegatee = KeyHash 'StakePool StandardCrypto
-> DRep StandardCrypto -> Delegatee StandardCrypto
forall c. KeyHash 'StakePool c -> DRep c -> Delegatee c
L.DelegStakeVote KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash DRep StandardCrypto
drep

    let certificate :: Certificate era
certificate =
          ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
w (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
            StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era)
-> Delegatee (EraCrypto era) -> TxCert era
L.mkDelegTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
stakeCredential) Delegatee (EraCrypto (ShelleyLedgerEra era))
Delegatee StandardCrypto
delegatee

    (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
outFp
      (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 (forall a. a -> Maybe a
Just @TextEnvelopeDescr TextEnvelopeDescr
"Stake and Vote Delegation Certificate") Certificate era
certificate

runStakeAddressVoteDelegationCertificateCmd
  :: ()
  => ConwayEraOnwards era
  -> StakeIdentifier
  -- ^ Delegatee stake pool verification key or verification key file or
  -> VoteDelegationTarget
  -- ^ Delegatee stake pool verification key or verification key file or verification key hash.
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressVoteDelegationCertificateCmd :: forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VoteDelegationTarget
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressVoteDelegationCertificateCmd ConwayEraOnwards era
w StakeIdentifier
stakeVerifier VoteDelegationTarget
voteDelegationTarget File () 'Out
outFp =
  ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  ExceptT StakeAddressCmdError IO ())
 -> ExceptT StakeAddressCmdError IO ())
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    StakeCredential
stakeCredential <-
      StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeVerifier
        ExceptT StakeCredentialError IO StakeCredential
-> (ExceptT StakeCredentialError IO StakeCredential
    -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError

    DRep StandardCrypto
drep <-
      VoteDelegationTarget
-> ExceptT DelegationError IO (DRep StandardCrypto)
readVoteDelegationTarget VoteDelegationTarget
voteDelegationTarget
        ExceptT DelegationError IO (DRep StandardCrypto)
-> (ExceptT DelegationError IO (DRep StandardCrypto)
    -> ExceptT StakeAddressCmdError IO (DRep StandardCrypto))
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall a b. a -> (a -> b) -> b
& (DelegationError -> StakeAddressCmdError)
-> ExceptT DelegationError IO (DRep StandardCrypto)
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT DelegationError -> StakeAddressCmdError
StakeAddressCmdDelegationError

    let delegatee :: Delegatee StandardCrypto
delegatee = DRep StandardCrypto -> Delegatee StandardCrypto
forall c. DRep c -> Delegatee c
L.DelegVote DRep StandardCrypto
drep

    let certificate :: Certificate era
certificate =
          ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
w (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
            StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era)
-> Delegatee (EraCrypto era) -> TxCert era
L.mkDelegTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
stakeCredential) Delegatee (EraCrypto (ShelleyLedgerEra era))
Delegatee StandardCrypto
delegatee

    (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
outFp
      (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 (forall a. a -> Maybe a
Just @TextEnvelopeDescr TextEnvelopeDescr
"Vote Delegation Certificate") Certificate era
certificate

createStakeDelegationCertificate
  :: forall era
   . ()
  => StakeCredential
  -> Hash StakePoolKey
  -> ShelleyBasedEra era
  -> Certificate era
createStakeDelegationCertificate :: forall era.
StakeCredential
-> Hash StakePoolKey -> ShelleyBasedEra era -> Certificate era
createStakeDelegationCertificate StakeCredential
stakeCredential (StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash) = do
  (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> Certificate era)
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era -> Certificate era)
-> ShelleyBasedEra era
-> Certificate era
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
    ( \ShelleyToBabbageEra era
w ->
        ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
w ((ShelleyToBabbageEraConstraints era => Certificate era)
 -> Certificate era)
-> (ShelleyToBabbageEraConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
          ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ShelleyToBabbageEra era
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
ShelleyRelatedCertificate ShelleyToBabbageEra era
w (ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ShelleyTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
            StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
L.mkDelegStakeTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
stakeCredential) KeyHash 'StakePool (EraCrypto (ShelleyLedgerEra era))
KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash
    )
    ( \ConwayEraOnwards era
w ->
        ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era => Certificate era)
 -> Certificate era)
-> (ConwayEraOnwardsConstraints era => Certificate era)
-> Certificate era
forall a b. (a -> b) -> a -> b
$
          ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall era.
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
ConwayCertificate ConwayEraOnwards era
w (ConwayTxCert (ShelleyLedgerEra era) -> Certificate era)
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
forall a b. (a -> b) -> a -> b
$
            StakeCredential (EraCrypto (ShelleyLedgerEra era))
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> TxCert (ShelleyLedgerEra era)
forall era.
ConwayEraTxCert era =>
StakeCredential (EraCrypto era)
-> Delegatee (EraCrypto era) -> TxCert era
L.mkDelegTxCert (StakeCredential -> StakeCredential StandardCrypto
toShelleyStakeCredential StakeCredential
stakeCredential) (KeyHash 'StakePool StandardCrypto -> Delegatee StandardCrypto
forall c. KeyHash 'StakePool c -> Delegatee c
L.DelegStake KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash)
    )

runStakeAddressDeregistrationCertificateCmd
  :: ()
  => ShelleyBasedEra era
  -> StakeIdentifier
  -> Maybe Lovelace
  -- ^ Deposit required in conway era
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressDeregistrationCertificateCmd :: forall era.
ShelleyBasedEra era
-> StakeIdentifier
-> Maybe Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressDeregistrationCertificateCmd ShelleyBasedEra era
sbe StakeIdentifier
stakeVerifier Maybe Coin
mDeposit File () 'Out
oFp = do
  StakeCredential
stakeCred <-
    StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeVerifier
      ExceptT StakeCredentialError IO StakeCredential
-> (ExceptT StakeCredentialError IO StakeCredential
    -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError

  StakeAddressRequirements era
req <-
    (StakeAddressRegistrationError -> StakeAddressCmdError)
-> ExceptT
     StakeAddressRegistrationError IO (StakeAddressRequirements era)
-> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeAddressRegistrationError -> StakeAddressCmdError
StakeAddressCmdRegistrationError
      (ExceptT
   StakeAddressRegistrationError IO (StakeAddressRequirements era)
 -> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era))
-> (Either
      StakeAddressRegistrationError (StakeAddressRequirements era)
    -> ExceptT
         StakeAddressRegistrationError IO (StakeAddressRequirements era))
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
-> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either StakeAddressRegistrationError (StakeAddressRequirements era)
-> ExceptT
     StakeAddressRegistrationError IO (StakeAddressRequirements era)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
      (Either
   StakeAddressRegistrationError (StakeAddressRequirements era)
 -> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era))
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
-> ExceptT StakeAddressCmdError IO (StakeAddressRequirements era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> StakeCredential
-> Maybe Coin
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
forall era.
ShelleyBasedEra era
-> StakeCredential
-> Maybe Coin
-> Either
     StakeAddressRegistrationError (StakeAddressRequirements era)
createRegistrationCertRequirements ShelleyBasedEra era
sbe StakeCredential
stakeCred Maybe Coin
mDeposit

  let deRegCert :: Certificate era
deRegCert = StakeAddressRequirements era -> Certificate era
forall era. StakeAddressRequirements era -> Certificate era
makeStakeAddressUnregistrationCertificate StakeAddressRequirements era
req

  (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
    (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
oFp
    (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe
    ((ShelleyBasedEraConstraints era => ByteString) -> ByteString)
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
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
deregCertDesc) Certificate era
deRegCert
 where
  deregCertDesc :: TextEnvelopeDescr
  deregCertDesc :: TextEnvelopeDescr
deregCertDesc = TextEnvelopeDescr
"Stake Address Deregistration Certificate"

runStakeAddressRegistrationAndDelegationCertificateCmd
  :: ()
  => ConwayEraOnwards era
  -> StakeIdentifier
  -> VerificationKeyOrHashOrFile StakePoolKey
  -- ^ Delegatee stake pool verification key or verification key file or id
  -> Lovelace
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationAndDelegationCertificateCmd :: forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationAndDelegationCertificateCmd ConwayEraOnwards era
w StakeIdentifier
stakeVerifier VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile Coin
deposit File () 'Out
outFp =
  ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  ExceptT StakeAddressCmdError IO ())
 -> ExceptT StakeAddressCmdError IO ())
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash <-
      (FileError InputDecodeError -> StakeAddressCmdError)
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> StakeAddressCmdError
StakeAddressCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
 -> ExceptT StakeAddressCmdError IO (Hash StakePoolKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$
        AsType StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m, Key keyrole,
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile

    StakeCredential
stakeCred <-
      StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeVerifier
        ExceptT StakeCredentialError IO StakeCredential
-> (ExceptT StakeCredentialError IO StakeCredential
    -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError

    let delegatee :: Delegatee StandardCrypto
delegatee = KeyHash 'StakePool StandardCrypto -> Delegatee StandardCrypto
forall c. KeyHash 'StakePool c -> Delegatee c
L.DelegStake KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash

    let certificate :: Certificate era
certificate = ConwayEraOnwards era
-> StakeCredential
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> Certificate era
forall era.
ConwayEraOnwards era
-> StakeCredential
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> Certificate era
makeStakeAddressAndDRepDelegationCertificate ConwayEraOnwards era
w StakeCredential
stakeCred Delegatee (EraCrypto (ShelleyLedgerEra era))
Delegatee StandardCrypto
delegatee Coin
deposit

    (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
outFp
      (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
        (forall a. a -> Maybe a
Just @TextEnvelopeDescr TextEnvelopeDescr
"Stake address registration and stake delegation certificate")
        Certificate era
certificate

runStakeAddressRegistrationAndVoteDelegationCertificateCmd
  :: ()
  => ConwayEraOnwards era
  -> StakeIdentifier
  -> VoteDelegationTarget
  -> Lovelace
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationAndVoteDelegationCertificateCmd :: forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VoteDelegationTarget
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationAndVoteDelegationCertificateCmd ConwayEraOnwards era
w StakeIdentifier
stakeVerifier VoteDelegationTarget
voteDelegationTarget Coin
keydeposit File () 'Out
outFp =
  ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  ExceptT StakeAddressCmdError IO ())
 -> ExceptT StakeAddressCmdError IO ())
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    StakeCredential
stakeCred <-
      StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeVerifier
        ExceptT StakeCredentialError IO StakeCredential
-> (ExceptT StakeCredentialError IO StakeCredential
    -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError

    DRep StandardCrypto
drep <-
      VoteDelegationTarget
-> ExceptT DelegationError IO (DRep StandardCrypto)
readVoteDelegationTarget VoteDelegationTarget
voteDelegationTarget
        ExceptT DelegationError IO (DRep StandardCrypto)
-> (ExceptT DelegationError IO (DRep StandardCrypto)
    -> ExceptT StakeAddressCmdError IO (DRep StandardCrypto))
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall a b. a -> (a -> b) -> b
& (DelegationError -> StakeAddressCmdError)
-> ExceptT DelegationError IO (DRep StandardCrypto)
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT DelegationError -> StakeAddressCmdError
StakeAddressCmdDelegationError

    let delegatee :: Delegatee StandardCrypto
delegatee = DRep StandardCrypto -> Delegatee StandardCrypto
forall c. DRep c -> Delegatee c
L.DelegVote DRep StandardCrypto
drep

    let certificate :: Certificate era
certificate = ConwayEraOnwards era
-> StakeCredential
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> Certificate era
forall era.
ConwayEraOnwards era
-> StakeCredential
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> Certificate era
makeStakeAddressAndDRepDelegationCertificate ConwayEraOnwards era
w StakeCredential
stakeCred Delegatee (EraCrypto (ShelleyLedgerEra era))
Delegatee StandardCrypto
delegatee Coin
keydeposit

    (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
outFp
      (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
        (forall a. a -> Maybe a
Just @TextEnvelopeDescr TextEnvelopeDescr
"Stake address registration and vote delegation certificate")
        Certificate era
certificate

runStakeAddressRegistrationStakeAndVoteDelegationCertificateCmd
  :: ()
  => ConwayEraOnwards era
  -> StakeIdentifier
  -> VerificationKeyOrHashOrFile StakePoolKey
  -> VoteDelegationTarget
  -> Lovelace
  -> File () Out
  -> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationStakeAndVoteDelegationCertificateCmd :: forall era.
ConwayEraOnwards era
-> StakeIdentifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> VoteDelegationTarget
-> Coin
-> File () 'Out
-> ExceptT StakeAddressCmdError IO ()
runStakeAddressRegistrationStakeAndVoteDelegationCertificateCmd ConwayEraOnwards era
w StakeIdentifier
stakeVerifier VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile VoteDelegationTarget
voteDelegationTarget Coin
keydeposit File () 'Out
outFp =
  ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  ExceptT StakeAddressCmdError IO ())
 -> ExceptT StakeAddressCmdError IO ())
-> (ConwayEraOnwardsConstraints era =>
    ExceptT StakeAddressCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    StakePoolKeyHash KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash <-
      (FileError InputDecodeError -> StakeAddressCmdError)
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> StakeAddressCmdError
StakeAddressCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
 -> ExceptT StakeAddressCmdError IO (Hash StakePoolKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
-> ExceptT StakeAddressCmdError IO (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$
        AsType StakePoolKey
-> VerificationKeyOrHashOrFile StakePoolKey
-> ExceptT (FileError InputDecodeError) IO (Hash StakePoolKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m, Key keyrole,
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile

    StakeCredential
stakeCred <-
      StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeVerifier
        ExceptT StakeCredentialError IO StakeCredential
-> (ExceptT StakeCredentialError IO StakeCredential
    -> ExceptT StakeAddressCmdError IO StakeCredential)
-> ExceptT StakeAddressCmdError IO StakeCredential
forall a b. a -> (a -> b) -> b
& (StakeCredentialError -> StakeAddressCmdError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeAddressCmdError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> StakeAddressCmdError
StakeAddressCmdStakeCredentialError

    DRep StandardCrypto
drep <-
      VoteDelegationTarget
-> ExceptT DelegationError IO (DRep StandardCrypto)
readVoteDelegationTarget VoteDelegationTarget
voteDelegationTarget
        ExceptT DelegationError IO (DRep StandardCrypto)
-> (ExceptT DelegationError IO (DRep StandardCrypto)
    -> ExceptT StakeAddressCmdError IO (DRep StandardCrypto))
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall a b. a -> (a -> b) -> b
& (DelegationError -> StakeAddressCmdError)
-> ExceptT DelegationError IO (DRep StandardCrypto)
-> ExceptT StakeAddressCmdError IO (DRep StandardCrypto)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT DelegationError -> StakeAddressCmdError
StakeAddressCmdDelegationError

    let delegatee :: Delegatee StandardCrypto
delegatee = KeyHash 'StakePool StandardCrypto
-> DRep StandardCrypto -> Delegatee StandardCrypto
forall c. KeyHash 'StakePool c -> DRep c -> Delegatee c
L.DelegStakeVote KeyHash 'StakePool StandardCrypto
poolStakeVKeyHash DRep StandardCrypto
drep

    let certificate :: Certificate era
certificate = ConwayEraOnwards era
-> StakeCredential
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> Certificate era
forall era.
ConwayEraOnwards era
-> StakeCredential
-> Delegatee (EraCrypto (ShelleyLedgerEra era))
-> Coin
-> Certificate era
makeStakeAddressAndDRepDelegationCertificate ConwayEraOnwards era
w StakeCredential
stakeCred Delegatee (EraCrypto (ShelleyLedgerEra era))
Delegatee StandardCrypto
delegatee Coin
keydeposit

    (FileError () -> StakeAddressCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT StakeAddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> StakeAddressCmdError
StakeAddressCmdWriteFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT StakeAddressCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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 StakeAddressCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT StakeAddressCmdError 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
outFp
      (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
        (forall a. a -> Maybe a
Just @TextEnvelopeDescr TextEnvelopeDescr
"Stake address registration and vote delegation certificate")
        Certificate era
certificate