diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 3576583f27c..ff7e8692054 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -364,7 +364,7 @@ module Cardano.Api ( -- choice for a stake address. makeStakeAddressRegistrationCertificate, makeStakeAddressDeregistrationCertificate, - makeStakeAddressDelegationCertificate, + makeStakeAddressPoolDelegationCertificate, -- ** Registering stake pools -- | Certificates that are embedded in transactions for registering and diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index b7a4df8f08e..88a46aaf55e 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -12,7 +12,7 @@ module Cardano.Api.Certificate ( -- * Registering stake address and delegating makeStakeAddressRegistrationCertificate, makeStakeAddressDeregistrationCertificate, - makeStakeAddressDelegationCertificate, + makeStakeAddressPoolDelegationCertificate, PoolId, -- * Registering stake pools @@ -83,7 +83,7 @@ data Certificate = -- Stake address certificates StakeAddressRegistrationCertificate StakeCredential | StakeAddressDeregistrationCertificate StakeCredential - | StakeAddressDelegationCertificate StakeCredential PoolId + | StakeAddressPoolDelegationCertificate StakeCredential PoolId -- Stake pool certificates | StakePoolRegistrationCertificate StakePoolParameters @@ -113,7 +113,7 @@ instance HasTextEnvelope Certificate where textEnvelopeDefaultDescr cert = case cert of StakeAddressRegistrationCertificate{} -> "Stake address registration" StakeAddressDeregistrationCertificate{} -> "Stake address de-registration" - StakeAddressDelegationCertificate{} -> "Stake address delegation" + StakeAddressPoolDelegationCertificate{} -> "Stake address stake pool delegation" StakePoolRegistrationCertificate{} -> "Pool registration" StakePoolRetirementCertificate{} -> "Pool retirement" GenesisKeyDelegationCertificate{} -> "Genesis key delegation" @@ -191,8 +191,8 @@ makeStakeAddressRegistrationCertificate = StakeAddressRegistrationCertificate makeStakeAddressDeregistrationCertificate :: StakeCredential -> Certificate makeStakeAddressDeregistrationCertificate = StakeAddressDeregistrationCertificate -makeStakeAddressDelegationCertificate :: StakeCredential -> PoolId -> Certificate -makeStakeAddressDelegationCertificate = StakeAddressDelegationCertificate +makeStakeAddressPoolDelegationCertificate :: StakeCredential -> PoolId -> Certificate +makeStakeAddressPoolDelegationCertificate = StakeAddressPoolDelegationCertificate makeStakePoolRegistrationCertificate :: StakePoolParameters -> Certificate makeStakePoolRegistrationCertificate = StakePoolRegistrationCertificate @@ -225,7 +225,7 @@ toShelleyCertificate (StakeAddressDeregistrationCertificate stakecred) = Shelley.DeRegKey (toShelleyStakeCredential stakecred) -toShelleyCertificate (StakeAddressDelegationCertificate +toShelleyCertificate (StakeAddressPoolDelegationCertificate stakecred (StakePoolKeyHash poolid)) = Shelley.DCertDeleg $ Shelley.Delegate $ @@ -295,7 +295,7 @@ fromShelleyCertificate (Shelley.DCertDeleg (Shelley.DeRegKey stakecred)) = fromShelleyCertificate (Shelley.DCertDeleg (Shelley.Delegate (Shelley.Delegation stakecred poolid))) = - StakeAddressDelegationCertificate + StakeAddressPoolDelegationCertificate (fromShelleyStakeCredential stakecred) (StakePoolKeyHash poolid) diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs index ad9bae1ec8c..0fca1bc36e6 100644 --- a/cardano-api/src/Cardano/Api/Fees.hs +++ b/cardano-api/src/Cardano/Api/Fees.hs @@ -1293,7 +1293,7 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent { selectStakeCredential cert = case cert of StakeAddressDeregistrationCertificate stakecred -> Just stakecred - StakeAddressDelegationCertificate stakecred _ -> Just stakecred + StakeAddressPoolDelegationCertificate stakecred _ -> Just stakecred _ -> Nothing mapScriptWitnessesMinting diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 8cd0f4de783..85c1610953d 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -4208,7 +4208,7 @@ collectTxBodyScriptWitnesses TxBodyContent { selectStakeCredential cert = case cert of StakeAddressDeregistrationCertificate stakecred -> Just stakecred - StakeAddressDelegationCertificate stakecred _ -> Just stakecred + StakeAddressPoolDelegationCertificate stakecred _ -> Just stakecred _ -> Nothing scriptWitnessesMinting diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs index d2b36e88b08..70c02f8353a 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -315,7 +315,7 @@ friendlyCertificate = StakeAddressDeregistrationCertificate credential -> "stake address deregistration" .= object [friendlyStakeCredential credential] - StakeAddressDelegationCertificate credential poolId -> + StakeAddressPoolDelegationCertificate credential poolId -> "stake address delegation" .= object [friendlyStakeCredential credential, "pool" .= poolId] diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index 974fffea6b8..ebffd0494b0 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -50,8 +50,9 @@ import Cardano.Api.Shelley import Data.Text (Text) -import Cardano.CLI.Shelley.Key (PaymentVerifier, StakeIdentifier, StakeVerifier, - VerificationKeyOrFile, VerificationKeyOrHashOrFile, VerificationKeyTextOrFile) +import Cardano.CLI.Shelley.Key (DelegationTarget, PaymentVerifier, StakeIdentifier, + StakeVerifier, VerificationKeyOrFile, VerificationKeyOrHashOrFile, + VerificationKeyTextOrFile) import Cardano.CLI.Types import Cardano.Chain.Common (BlockCount) @@ -115,7 +116,7 @@ data StakeAddressCmd | StakeRegistrationCert StakeIdentifier OutputFile | StakeCredentialDelegationCert StakeIdentifier - (VerificationKeyOrHashOrFile StakePoolKey) + DelegationTarget OutputFile | StakeCredentialDeRegistrationCert StakeIdentifier OutputFile deriving Show diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Key.hs b/cardano-cli/src/Cardano/CLI/Shelley/Key.hs index a72edf9c9aa..b7e25401caf 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Key.hs @@ -24,6 +24,8 @@ module Cardano.CLI.Shelley.Key , StakeVerifier(..) , generateKeyPair + + , DelegationTarget(..) ) where import Cardano.Api @@ -36,6 +38,7 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text +import Cardano.Api.Shelley (StakePoolKey) import Cardano.CLI.Types @@ -110,6 +113,12 @@ data StakeIdentifier | StakeIdentifierAddress StakeAddress deriving (Eq, Show) +-- | A resource that identifies the delegation target. At the moment a delegation +-- target can only be a stake pool. +newtype DelegationTarget + = StakePoolDelegationTarget (VerificationKeyOrHashOrFile StakePoolKey) + deriving Show + -- | Either an unvalidated text representation of a verification key or a path -- to a verification key file. data VerificationKeyTextOrFile diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index b1e4d9ac503..4cf17725393 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -60,9 +60,9 @@ import Cardano.Chain.Common (BlockCount (BlockCount)) import Cardano.CLI.Common.Parsers (pConsensusModeParams, pNetworkId) import Cardano.CLI.Shelley.Commands -import Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeIdentifier (..), - StakeVerifier (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..), - VerificationKeyTextOrFile (..)) +import Cardano.CLI.Shelley.Key (DelegationTarget (..), PaymentVerifier (..), + StakeIdentifier (..), StakeVerifier (..), VerificationKeyOrFile (..), + VerificationKeyOrHashOrFile (..), VerificationKeyTextOrFile (..)) import Cardano.CLI.Types {- HLINT ignore "Use <$>" -} @@ -379,7 +379,7 @@ pStakeAddressCmd = , subParser "deregistration-certificate" (Opt.info pStakeAddressDeregistrationCert $ Opt.progDesc "Create a stake address deregistration certificate") , subParser "delegation-certificate" - (Opt.info pStakeAddressDelegationCert $ Opt.progDesc "Create a stake address delegation certificate") + (Opt.info pStakeAddressPoolDelegationCert $ Opt.progDesc "Create a stake address pool delegation certificate") ] where pStakeAddressKeyGen :: Parser StakeAddressCmd @@ -409,11 +409,11 @@ pStakeAddressCmd = <$> pStakeIdentifier <*> pOutputFile - pStakeAddressDelegationCert :: Parser StakeAddressCmd - pStakeAddressDelegationCert = + pStakeAddressPoolDelegationCert :: Parser StakeAddressCmd + pStakeAddressPoolDelegationCert = StakeCredentialDelegationCert <$> pStakeIdentifier - <*> pStakePoolVerificationKeyOrHashOrFile + <*> pDelegationTarget <*> pOutputFile pKeyCmd :: Parser KeyCmd @@ -2737,6 +2737,10 @@ pStakePoolVerificationKeyOrFile = VerificationKeyValue <$> pStakePoolVerificationKey <|> VerificationKeyFilePath <$> pStakePoolVerificationKeyFile +pDelegationTarget + :: Parser DelegationTarget +pDelegationTarget = StakePoolDelegationTarget <$> pStakePoolVerificationKeyOrHashOrFile + pStakePoolVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile StakePoolKey) pStakePoolVerificationKeyOrHashOrFile = diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs index 8254871371a..b98590af36c 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} module Cardano.CLI.Shelley.Run.StakeAddress ( ShelleyStakeAddressCmdError(ShelleyStakeAddressCmdReadKeyFileError) @@ -9,7 +10,7 @@ module Cardano.CLI.Shelley.Run.StakeAddress import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT) +import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExceptT, onLeft) import qualified Data.ByteString.Char8 as BS import Data.Text (Text) import qualified Data.Text as Text @@ -18,12 +19,14 @@ import qualified Data.Text.IO as Text import Cardano.Api import Cardano.Api.Shelley -import Cardano.CLI.Shelley.Key (StakeIdentifier (..), StakeVerifier (..), - VerificationKeyOrFile, VerificationKeyOrHashOrFile, readVerificationKeyOrFile, +import Cardano.CLI.Shelley.Key (DelegationTarget (..), StakeIdentifier (..), + StakeVerifier (..), VerificationKeyOrFile, readVerificationKeyOrFile, readVerificationKeyOrHashOrFile) import Cardano.CLI.Shelley.Parsers import Cardano.CLI.Shelley.Run.Read import Cardano.CLI.Types +import Control.Monad.Trans (lift) +import Data.Function ((&)) data ShelleyStakeAddressCmdError = ShelleyStakeAddressCmdReadKeyFileError !(FileError InputDecodeError) @@ -126,34 +129,22 @@ runStakeCredentialRegistrationCert stakeIdentifier (OutputFile oFp) = do runStakeCredentialDelegationCert :: StakeIdentifier -- ^ Delegator stake verification key, verification key file or script file. - -> VerificationKeyOrHashOrFile StakePoolKey + -> DelegationTarget -- ^ Delegatee stake pool verification key or verification key file or -- verification key hash. -> OutputFile -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile outFp) = do - poolStakeVKeyHash <- - firstExceptT - ShelleyStakeAddressCmdReadKeyFileError - (newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile) - stakeCred <- getStakeCredentialFromIdentifier stakeVerifier - writeDelegationCert stakeCred poolStakeVKeyHash - - where - writeDelegationCert - :: StakeCredential - -> Hash StakePoolKey - -> ExceptT ShelleyStakeAddressCmdError IO () - writeDelegationCert sCred poolStakeVKeyHash = do - let delegCert = makeStakeAddressDelegationCertificate sCred poolStakeVKeyHash +runStakeCredentialDelegationCert stakeVerifier delegationTarget (OutputFile outFp) = + case delegationTarget of + StakePoolDelegationTarget poolVKeyOrHashOrFile -> do + poolStakeVKeyHash <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile) + & onLeft (left . ShelleyStakeAddressCmdReadKeyFileError) + stakeCred <- getStakeCredentialFromIdentifier stakeVerifier + let delegCert = makeStakeAddressPoolDelegationCertificate stakeCred poolStakeVKeyHash firstExceptT ShelleyStakeAddressCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFp - $ textEnvelopeToJSON (Just delegCertDesc) delegCert - - delegCertDesc :: TextEnvelopeDescr - delegCertDesc = "Stake Address Delegation Certificate" - + $ textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Address Delegation Certificate") delegCert runStakeCredentialDeRegistrationCert :: StakeIdentifier diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs index 91cfa64cea3..ec9c47a2357 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Validate.hs @@ -283,7 +283,7 @@ validateTxCertificates era certsAndScriptWitnesses = deriveStakeCredentialWitness cert = do case cert of StakeAddressDeregistrationCertificate sCred -> Just sCred - StakeAddressDelegationCertificate sCred _ -> Just sCred + StakeAddressPoolDelegationCertificate sCred _ -> Just sCred _ -> Nothing convert diff --git a/cardano-client-demo/StakeCredentialHistory.hs b/cardano-client-demo/StakeCredentialHistory.hs index 39ba88f0cd1..0afeb905651 100644 --- a/cardano-client-demo/StakeCredentialHistory.hs +++ b/cardano-client-demo/StakeCredentialHistory.hs @@ -346,7 +346,7 @@ main = do if t == cred then Just (StakeRegistrationEvent epochNo slotNo) else Nothing targetedCert t epochNo slotNo (StakeAddressDeregistrationCertificate cred) = if t == cred then Just (StakeDeRegistrationEvent epochNo slotNo) else Nothing - targetedCert t _epochNo slotNo (StakeAddressDelegationCertificate cred pool) = + targetedCert t _epochNo slotNo (StakeAddressPoolDelegationCertificate cred pool) = if t == cred then Just (DelegationEvent slotNo pool) else Nothing targetedCert t _epochNo slotNo (StakePoolRegistrationCertificate pool) = inPoolCert t slotNo pool