Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Simplify stake-address stake-delegation-certificate command across eras #256

Merged
merged 1 commit into from
Sep 8, 2023
Merged

Simplify stake-address stake-delegation-certificate command across eras #256

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
81 changes: 35 additions & 46 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{- HLINT ignore "Monad law, left identity" -}
Expand All @@ -25,7 +26,6 @@ import Cardano.CLI.EraBased.Commands.StakeAddress
import Cardano.CLI.Read
import Cardano.CLI.Types.Common
import Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError
import Cardano.CLI.Types.Errors.StakeAddressDelegationError
import Cardano.CLI.Types.Errors.StakeAddressRegistrationError
import Cardano.CLI.Types.Key

Expand Down Expand Up @@ -172,62 +172,51 @@ runStakeAddressStakeDelegationCertificateCmd :: ()
-> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressStakeDelegationCertificateCmd sbe stakeVerifier poolVKeyOrHashOrFile outFp =
shelleyBasedEraConstraints sbe $ do
StakePoolKeyHash poolStakeVKeyHash <-
poolStakeVKeyHash <-
lift (readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
& onLeft (left . ShelleyStakeAddressCmdReadKeyFileError)

let delegatee = Ledger.DelegStake poolStakeVKeyHash

stakeCred <-
getStakeCredentialFromIdentifier stakeVerifier
& firstExceptT ShelleyStakeAddressCmdStakeCredentialError

req <- firstExceptT StakeDelegationError . hoistEither
$ createDelegationCertRequirements sbe stakeCred delegatee

let delegCert = makeStakeAddressDelegationCertificate req
let certificate = createStakeDelegationCertificate stakeCred poolStakeVKeyHash sbe

firstExceptT ShelleyStakeAddressCmdWriteFileError
. newExceptT
$ writeLazyByteStringFile outFp
$ textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Address Delegation Certificate") delegCert

createDelegationCertRequirements :: ()
=> ShelleyBasedEra era
-> StakeCredential
-> Ledger.Delegatee Ledger.StandardCrypto
-> Either StakeAddressDelegationError (StakeDelegationRequirements era)
createDelegationCertRequirements sbe stakeCred delegatee =
case sbe of
ShelleyBasedEraShelley -> do
pId <- onlySpoDelegatee ShelleyToBabbageEraShelley delegatee
return $ StakeDelegationRequirementsPreConway ShelleyToBabbageEraShelley stakeCred pId
ShelleyBasedEraAllegra -> do
pId <- onlySpoDelegatee ShelleyToBabbageEraAllegra delegatee
return $ StakeDelegationRequirementsPreConway ShelleyToBabbageEraAllegra stakeCred pId
ShelleyBasedEraMary -> do
pId <- onlySpoDelegatee ShelleyToBabbageEraMary delegatee
return $ StakeDelegationRequirementsPreConway ShelleyToBabbageEraMary stakeCred pId
ShelleyBasedEraAlonzo -> do
pId <- onlySpoDelegatee ShelleyToBabbageEraAlonzo delegatee
return $ StakeDelegationRequirementsPreConway ShelleyToBabbageEraAlonzo stakeCred pId
ShelleyBasedEraBabbage -> do
pId <- onlySpoDelegatee ShelleyToBabbageEraBabbage delegatee
return $ StakeDelegationRequirementsPreConway ShelleyToBabbageEraBabbage stakeCred pId
ShelleyBasedEraConway ->
return $ StakeDelegationRequirementsConwayOnwards ConwayEraOnwardsConway stakeCred delegatee

onlySpoDelegatee
:: ShelleyToBabbageEra era
-> Ledger.Delegatee (Ledger.EraCrypto (ShelleyLedgerEra era))
-> Either StakeAddressDelegationError PoolId
onlySpoDelegatee w = \case
Ledger.DelegStake stakePoolKeyHash ->
Right $ StakePoolKeyHash $ shelleyToBabbageEraConstraints w stakePoolKeyHash
Ledger.DelegVote{} ->
Left . VoteDelegationNotSupported $ AnyShelleyToBabbageEra w
Ledger.DelegStakeVote{} ->
Left . VoteDelegationNotSupported $ AnyShelleyToBabbageEra w
$ textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Address Delegation Certificate") certificate

-- TODO use the version in cardano-api
caseShelleyToBabbageAndConwayEraOnwards :: forall a era. ()
=> (ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageAndConwayEraOnwards l r = \case
ShelleyBasedEraShelley -> l ShelleyToBabbageEraShelley
ShelleyBasedEraAllegra -> l ShelleyToBabbageEraAllegra
ShelleyBasedEraMary -> l ShelleyToBabbageEraMary
ShelleyBasedEraAlonzo -> l ShelleyToBabbageEraAlonzo
ShelleyBasedEraBabbage -> l ShelleyToBabbageEraBabbage
ShelleyBasedEraConway -> r ConwayEraOnwardsConway
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

To be moved to cardano-api.


createStakeDelegationCertificate :: forall era. ()
=> StakeCredential
-> Hash StakePoolKey
-> ShelleyBasedEra era
-> Certificate era
createStakeDelegationCertificate stakeCredential (StakePoolKeyHash poolStakeVKeyHash) = do
caseShelleyToBabbageAndConwayEraOnwards
(\w ->
shelleyToBabbageEraConstraints w
$ ShelleyRelatedCertificate w
$ Ledger.mkDelegStakeTxCert (toShelleyStakeCredential stakeCredential) poolStakeVKeyHash)
(\w ->
conwayEraOnwardsConstraints w
$ ConwayCertificate w
$ Ledger.mkDelegTxCert (toShelleyStakeCredential stakeCredential) (Ledger.DelegStake poolStakeVKeyHash)
)

runStakeAddressDeregistrationCertificateCmd :: ()
=> ShelleyBasedEra era
Expand Down
3 changes: 0 additions & 3 deletions cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyStakeAddressCmdError.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@ module Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError
import Cardano.Api

import Cardano.CLI.Types.Errors.ScriptDecodeError
import Cardano.CLI.Types.Errors.StakeAddressDelegationError
import Cardano.CLI.Types.Errors.StakeAddressRegistrationError
import Cardano.CLI.Types.Errors.StakeCredentialError

Expand All @@ -17,7 +16,6 @@ data ShelleyStakeAddressCmdError
| ShelleyStakeAddressCmdStakeCredentialError !StakeCredentialError
| ShelleyStakeAddressCmdWriteFileError !(FileError ())
| StakeRegistrationError !StakeAddressRegistrationError
| StakeDelegationError !StakeAddressDelegationError
deriving Show

instance Error ShelleyStakeAddressCmdError where
Expand All @@ -26,5 +24,4 @@ instance Error ShelleyStakeAddressCmdError where
ShelleyStakeAddressCmdReadScriptFileError e -> displayError e
ShelleyStakeAddressCmdStakeCredentialError e -> displayError e
ShelleyStakeAddressCmdWriteFileError e -> displayError e
StakeDelegationError e -> displayError e
StakeRegistrationError e -> displayError e