diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs index 07af5c06af..01d1f1e4ef 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs @@ -1,9 +1,16 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Governance.DRep - ( GovernanceDRepCmds (..), - renderGovernanceDRepCmds, + ( GovernanceDRepCmds (..) + , renderGovernanceDRepCmds + + , GovernanceDRepKeyGenCmdArgs(..) + , GovernanceDRepIdCmdArgs(..) + , GovernanceDRepRegistrationCertificateCmdArgs(..) + , GovernanceDRepRetirementCertificateCmdArgs(..) + , GovernanceDRepMetadataHashCmdArgs(..) ) where @@ -17,30 +24,50 @@ import Cardano.CLI.Types.Key import Data.Text (Text) data GovernanceDRepCmds era - = GovernanceDRepKeyGenCmd - (ConwayEraOnwards era) - (File (VerificationKey ()) Out) - (File (SigningKey ()) Out) - | GovernanceDRepIdCmd - (ConwayEraOnwards era) - (VerificationKeyOrFile DRepKey) - IdOutputFormat - (Maybe (File () Out)) - | GovernanceDRepRegistrationCertificateCmd - (ConwayEraOnwards era) - (VerificationKeyOrHashOrFile DRepKey) - Lovelace - (Maybe (Ledger.Anchor (Ledger.EraCrypto (ShelleyLedgerEra era)))) - (File () Out) - | GovernanceDRepRetirementCertificateCmd - (ConwayEraOnwards era) - (VerificationKeyOrHashOrFile DRepKey) - Lovelace - (File () Out) - | GovernanceDRepMetadataHashCmd - (ConwayEraOnwards era) - (DRepMetadataFile In) - (Maybe (File () Out)) + = GovernanceDRepKeyGenCmd !(GovernanceDRepKeyGenCmdArgs era) + | GovernanceDRepIdCmd !(GovernanceDRepIdCmdArgs era) + | GovernanceDRepRegistrationCertificateCmd !(GovernanceDRepRegistrationCertificateCmdArgs era) + | GovernanceDRepRetirementCertificateCmd !(GovernanceDRepRetirementCertificateCmdArgs era) + | GovernanceDRepMetadataHashCmd !(GovernanceDRepMetadataHashCmdArgs era) + +data GovernanceDRepKeyGenCmdArgs era = + GovernanceDRepKeyGenCmdArgs + { eon :: !(ConwayEraOnwards era) + , vkeyFile :: !(File (VerificationKey ()) Out) + , skeyFile :: !(File (SigningKey ()) Out) + } + +data GovernanceDRepIdCmdArgs era = + GovernanceDRepIdCmdArgs + { eon :: !(ConwayEraOnwards era) + , vkeySource :: !(VerificationKeyOrFile DRepKey) + , idOutputFormat :: !IdOutputFormat + , mOutFile :: !(Maybe (File () Out)) + } + +data GovernanceDRepRegistrationCertificateCmdArgs era = + GovernanceDRepRegistrationCertificateCmdArgs + { eon :: !(ConwayEraOnwards era) + , drepVkeyHashSource :: !(VerificationKeyOrHashOrFile DRepKey) + , deposit :: !Lovelace + , mAnchor :: !(Maybe (Ledger.Anchor (Ledger.EraCrypto (ShelleyLedgerEra era)))) + , outFile :: !(File () Out) + } + +data GovernanceDRepRetirementCertificateCmdArgs era = + GovernanceDRepRetirementCertificateCmdArgs + { eon :: !(ConwayEraOnwards era) + , vkeyHashSource :: !(VerificationKeyOrHashOrFile DRepKey) + , deposit :: !Lovelace + , outFile :: !(File () Out) + } + +data GovernanceDRepMetadataHashCmdArgs era = + GovernanceDRepMetadataHashCmdArgs + { eon :: !(ConwayEraOnwards era) + , metadataFile :: !(DRepMetadataFile In) + , mOutFile :: !(Maybe (File () Out)) + } renderGovernanceDRepCmds :: () => GovernanceDRepCmds era diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs index ff3095b6ea..3891b7a8c6 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs @@ -52,9 +52,10 @@ pGovernanceDRepKeyGenCmd era = do pure $ subParser "key-gen" $ Opt.info - ( GovernanceDRepKeyGenCmd w - <$> pVerificationKeyFileOut - <*> pSigningKeyFileOut + ( fmap GovernanceDRepKeyGenCmd $ + GovernanceDRepKeyGenCmdArgs w + <$> pVerificationKeyFileOut + <*> pSigningKeyFileOut ) $ Opt.progDesc "Generate Delegate Representative verification and signing keys." @@ -66,10 +67,11 @@ pGovernanceDRepKeyIdCmd era = do pure $ subParser "id" $ Opt.info - ( GovernanceDRepIdCmd w - <$> pDRepVerificationKeyOrFile - <*> pDRepIdOutputFormat - <*> optional pOutputFile + ( fmap GovernanceDRepIdCmd $ + GovernanceDRepIdCmdArgs w + <$> pDRepVerificationKeyOrFile + <*> pDRepIdOutputFormat + <*> optional pOutputFile ) $ Opt.progDesc "Generate a drep id." @@ -97,7 +99,9 @@ pRegistrationCertificateCmd era = do $ Opt.info (conwayEraOnwardsConstraints w $ mkParser w) $ Opt.progDesc "Create a registration certificate." where - mkParser w = GovernanceDRepRegistrationCertificateCmd w + mkParser w = + fmap GovernanceDRepRegistrationCertificateCmd $ + GovernanceDRepRegistrationCertificateCmdArgs w <$> pDRepVerificationKeyOrHashOrFile <*> pKeyRegistDeposit <*> pDRepMetadata @@ -131,10 +135,11 @@ pRetirementCertificateCmd era = do pure $ subParser "retirement-certificate" $ Opt.info - ( GovernanceDRepRetirementCertificateCmd w - <$> pDRepVerificationKeyOrHashOrFile - <*> pDrepDeposit - <*> pOutputFile + ( fmap GovernanceDRepRetirementCertificateCmd $ + GovernanceDRepRetirementCertificateCmdArgs w + <$> pDRepVerificationKeyOrHashOrFile + <*> pDrepDeposit + <*> pOutputFile ) $ Opt.progDesc "Create a DRep retirement certificate." @@ -146,10 +151,11 @@ pGovernanceDrepMetadataHashCmd era = do pure $ subParser "metadata-hash" $ Opt.info - ( GovernanceDRepMetadataHashCmd w - <$> pFileInDirection "drep-metadata-file" "JSON Metadata file to hash." - <*> pMaybeOutputFile - ) + ( fmap GovernanceDRepMetadataHashCmd $ + GovernanceDRepMetadataHashCmdArgs w + <$> pFileInDirection "drep-metadata-file" "JSON Metadata file to hash." + <*> pMaybeOutputFile + ) $ Opt.progDesc "Calculate the hash of a metadata file." -------------------------------------------------------------------------------- diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs index 9233b198d3..9029aae85e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -16,7 +18,7 @@ import Cardano.Api.Ledger (Credential (KeyHashObj)) import qualified Cardano.Api.Ledger as Ledger import Cardano.Api.Shelley -import Cardano.CLI.EraBased.Commands.Governance.DRep +import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd import qualified Cardano.CLI.EraBased.Run.Key as Key import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CmdError @@ -32,53 +34,58 @@ import Data.Function import qualified Data.Text.Encoding as Text runGovernanceDRepCmds :: () - => GovernanceDRepCmds era + => Cmd.GovernanceDRepCmds era -> ExceptT CmdError IO () runGovernanceDRepCmds = \case - GovernanceDRepKeyGenCmd w vrf sgn -> - runGovernanceDRepKeyGenCmd w vrf sgn + Cmd.GovernanceDRepKeyGenCmd args -> + runGovernanceDRepKeyGenCmd args & firstExceptT CmdGovernanceCmdError - GovernanceDRepIdCmd w vkey idOutputFormat mOutFp -> - runGovernanceDRepIdCmd w vkey idOutputFormat mOutFp + Cmd.GovernanceDRepIdCmd args -> + runGovernanceDRepIdCmd args & firstExceptT CmdGovernanceCmdError - GovernanceDRepRegistrationCertificateCmd w vkey lovelace anchor outFp -> - conwayEraOnwardsConstraints w $ do - runGovernanceDRepRegistrationCertificateCmd w vkey lovelace anchor outFp - & firstExceptT CmdRegistrationError + Cmd.GovernanceDRepRegistrationCertificateCmd args -> + runGovernanceDRepRegistrationCertificateCmd args + & firstExceptT CmdRegistrationError - GovernanceDRepRetirementCertificateCmd w vkeyOrHashOrFile deposit outFp -> - runGovernanceDRepRetirementCertificateCmd w vkeyOrHashOrFile deposit outFp + Cmd.GovernanceDRepRetirementCertificateCmd args -> + runGovernanceDRepRetirementCertificateCmd args & firstExceptT CmdGovernanceCmdError - GovernanceDRepMetadataHashCmd _ inFp mOutFp -> - runGovernanceDRepMetadataHashCmd inFp mOutFp + Cmd.GovernanceDRepMetadataHashCmd args -> + runGovernanceDRepMetadataHashCmd args & firstExceptT CmdGovernanceCmdError runGovernanceDRepKeyGenCmd :: () - => ConwayEraOnwards era - -> VerificationKeyFile Out - -> SigningKeyFile Out + => Cmd.GovernanceDRepKeyGenCmdArgs era -> ExceptT GovernanceCmdError IO () -runGovernanceDRepKeyGenCmd _w vkeyPath skeyPath = firstExceptT GovernanceCmdWriteFileError $ do +runGovernanceDRepKeyGenCmd + Cmd.GovernanceDRepKeyGenCmdArgs + { eon = _ + , vkeyFile + , skeyFile + } = firstExceptT GovernanceCmdWriteFileError $ do skey <- liftIO $ generateSigningKey AsDRepKey let vkey = getVerificationKey skey - newExceptT $ writeLazyByteStringFile skeyPath (textEnvelopeToJSON (Just skeyDesc) skey) - newExceptT $ writeLazyByteStringFile vkeyPath (textEnvelopeToJSON (Just Key.drepKeyEnvelopeDescr) vkey) + newExceptT $ writeLazyByteStringFile skeyFile (textEnvelopeToJSON (Just skeyDesc) skey) + newExceptT $ writeLazyByteStringFile vkeyFile (textEnvelopeToJSON (Just Key.drepKeyEnvelopeDescr) vkey) where skeyDesc :: TextEnvelopeDescr skeyDesc = "Delegate Representative Signing Key" runGovernanceDRepIdCmd :: () - => ConwayEraOnwards era - -> VerificationKeyOrFile DRepKey - -> IdOutputFormat - -> Maybe (File () Out) + => Cmd.GovernanceDRepIdCmdArgs era -> ExceptT GovernanceCmdError IO () -runGovernanceDRepIdCmd _ vkOrFp idOutputFormat mOutFile = do +runGovernanceDRepIdCmd + Cmd.GovernanceDRepIdCmdArgs + { eon = _ + , vkeySource + , idOutputFormat + , mOutFile + } = do drepVerKey <- - lift (readVerificationKeyOrTextEnvFile AsDRepKey vkOrFp) + lift (readVerificationKeyOrTextEnvFile AsDRepKey vkeySource) & onLeft (left . ReadFileError) content <- @@ -94,40 +101,46 @@ runGovernanceDRepIdCmd _ vkOrFp idOutputFormat mOutFile = do -- Registration Certificate related runGovernanceDRepRegistrationCertificateCmd :: () - => ConwayEraOnwards era - -> VerificationKeyOrHashOrFile DRepKey - -> Lovelace - -> Maybe (Ledger.Anchor (Ledger.EraCrypto (ShelleyLedgerEra era))) - -> File () Out + => Cmd.GovernanceDRepRegistrationCertificateCmdArgs era -> ExceptT RegistrationError IO () -runGovernanceDRepRegistrationCertificateCmd cOnwards drepKOrHOrF deposit anchor outfp = do - DRepKeyHash drepKeyHash <- firstExceptT RegistrationReadError - . newExceptT - $ readVerificationKeyOrHashOrFile AsDRepKey drepKOrHOrF - let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints cOnwards drepKeyHash - votingCredential = VotingCredential drepCred - req = DRepRegistrationRequirements cOnwards votingCredential deposit - registrationCert = makeDrepRegistrationCertificate req anchor - description = Just @TextEnvelopeDescr "DRep Key Registration Certificate" - - firstExceptT RegistrationWriteFileError - . newExceptT - . writeLazyByteStringFile outfp - $ conwayEraOnwardsConstraints cOnwards - $ textEnvelopeToJSON description registrationCert +runGovernanceDRepRegistrationCertificateCmd + Cmd.GovernanceDRepRegistrationCertificateCmdArgs + { eon = w + , drepVkeyHashSource + , deposit + , mAnchor + , outFile + } = do + DRepKeyHash drepKeyHash <- firstExceptT RegistrationReadError + . newExceptT + $ readVerificationKeyOrHashOrFile AsDRepKey drepVkeyHashSource + let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints w drepKeyHash + votingCredential = VotingCredential drepCred + req = DRepRegistrationRequirements w votingCredential deposit + registrationCert = makeDrepRegistrationCertificate req mAnchor + description = Just @TextEnvelopeDescr "DRep Key Registration Certificate" + + firstExceptT RegistrationWriteFileError + . newExceptT + . writeLazyByteStringFile outFile + $ conwayEraOnwardsConstraints w + $ textEnvelopeToJSON description registrationCert runGovernanceDRepRetirementCertificateCmd :: () - => ConwayEraOnwards era - -> VerificationKeyOrHashOrFile DRepKey - -> Lovelace - -> File () 'Out + => Cmd.GovernanceDRepRetirementCertificateCmdArgs era -> ExceptT GovernanceCmdError IO () -runGovernanceDRepRetirementCertificateCmd w vKeyOrHashOrFile deposit outFile = - conwayEraOnwardsConstraints w $ do - DRepKeyHash drepKeyHash <- firstExceptT GovernanceCmdKeyReadError - . newExceptT - $ readVerificationKeyOrHashOrFile AsDRepKey vKeyOrHashOrFile - makeDrepUnregistrationCertificate (DRepUnregistrationRequirements w (VotingCredential $ KeyHashObj drepKeyHash) deposit) +runGovernanceDRepRetirementCertificateCmd + Cmd.GovernanceDRepRetirementCertificateCmdArgs + { eon = w + , vkeyHashSource + , deposit + , outFile + } = + conwayEraOnwardsConstraints w $ do + DRepKeyHash drepKeyHash <- firstExceptT GovernanceCmdKeyReadError + . newExceptT + $ readVerificationKeyOrHashOrFile AsDRepKey vkeyHashSource + makeDrepUnregistrationCertificate (DRepUnregistrationRequirements w (VotingCredential $ KeyHashObj drepKeyHash) deposit) & writeFileTextEnvelope outFile (Just genKeyDelegCertDesc) & firstExceptT GovernanceCmdTextEnvWriteError . newExceptT @@ -136,11 +149,15 @@ runGovernanceDRepRetirementCertificateCmd w vKeyOrHashOrFile deposit outFile = genKeyDelegCertDesc = "DRep Retirement Certificate" runGovernanceDRepMetadataHashCmd :: () - => DRepMetadataFile In - -> Maybe (File () Out) + => Cmd.GovernanceDRepMetadataHashCmdArgs era -> ExceptT GovernanceCmdError IO () -runGovernanceDRepMetadataHashCmd drepMDPath mOutFile = do - metadataBytes <- firstExceptT ReadFileError $ newExceptT (readByteStringFile drepMDPath) +runGovernanceDRepMetadataHashCmd + Cmd.GovernanceDRepMetadataHashCmdArgs + { eon = _ + , metadataFile + , mOutFile + } = do + metadataBytes <- firstExceptT ReadFileError $ newExceptT (readByteStringFile metadataFile) (_metadata, metadataHash) <- firstExceptT GovernanceCmdDRepMetadataValidationError . hoistEither