From bd338c95cd95cc42ab172ee3858924a56e0b0992 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 11 Oct 2024 09:04:21 -0400 Subject: [PATCH 1/6] Parameterize pStakeAddressCmds on ShelleyBasedEra era --- .../src/Cardano/CLI/EraBased/Commands.hs | 2 +- .../CLI/EraBased/Commands/StakeAddress.hs | 3 - .../CLI/EraBased/Options/StakeAddress.hs | 184 ++++++++---------- .../Cardano/CLI/EraBased/Run/StakeAddress.hs | 6 +- 4 files changed, 90 insertions(+), 105 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index 6c6fae6f24..35d257740c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -123,7 +123,7 @@ pCmds sbe' envCli = do , fmap GovernanceCmds <$> pGovernanceCmds cEra , Just (NodeCmds <$> pNodeCmds) , fmap QueryCmds <$> pQueryCmds cEra envCli - , fmap StakeAddressCmds <$> pStakeAddressCmds cEra envCli + , fmap StakeAddressCmds <$> pStakeAddressCmds sbe' envCli , fmap StakePoolCmds <$> pStakePoolCmds cEra envCli , fmap TextViewCmds <$> pTextViewCmds , fmap TransactionCmds <$> pTransactionCmds sbe' envCli diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/StakeAddress.hs index f5c9ad1a63..1f634398af 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/StakeAddress.hs @@ -20,16 +20,13 @@ import Data.Text (Text) data StakeAddressCmds era = StakeAddressKeyGenCmd - (ShelleyBasedEra era) KeyOutputFormat (VerificationKeyFile Out) (SigningKeyFile Out) | StakeAddressKeyHashCmd - (ShelleyBasedEra era) (VerificationKeyOrFile StakeKey) (Maybe (File () Out)) | StakeAddressBuildCmd - (ShelleyBasedEra era) StakeVerifier NetworkId (Maybe (File () Out)) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs index a68aa0e68b..01e1877415 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs @@ -17,7 +17,7 @@ import qualified Options.Applicative as Opt pStakeAddressCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressCmds era envCli = @@ -28,12 +28,12 @@ pStakeAddressCmds era envCli = [ "Stake address commands." ] ) - [ pStakeAddressKeyGenCmd era - , pStakeAddressKeyHashCmd era - , pStakeAddressBuildCmd era envCli - , pStakeAddressRegistrationCertificateCmd era - , pStakeAddressDeregistrationCertificateCmd era - , pStakeAddressStakeDelegationCertificateCmd era + [ Just pStakeAddressKeyGenCmd + , Just pStakeAddressKeyHashCmd + , Just (pStakeAddressBuildCmd envCli) + , Just (pStakeAddressRegistrationCertificateCmd era) + , Just (pStakeAddressDeregistrationCertificateCmd era) + , Just (pStakeAddressStakeDelegationCertificateCmd era) , pStakeAddressStakeAndVoteDelegationCertificateCmd era , pStakeAddressVoteDelegationCertificateCmd era , pStakeAddressRegistrationAndDelegationCertificateCmd era @@ -43,14 +43,11 @@ pStakeAddressCmds era envCli = pStakeAddressKeyGenCmd :: () - => CardanoEra era - -> Maybe (Parser (StakeAddressCmds era)) -pStakeAddressKeyGenCmd era = do - w <- forEraMaybeEon era - pure - $ subParser "key-gen" + => Parser (StakeAddressCmds era) +pStakeAddressKeyGenCmd = do + subParser "key-gen" $ Opt.info - ( StakeAddressKeyGenCmd w + ( StakeAddressKeyGenCmd <$> pKeyOutputFormat <*> pVerificationKeyFileOut <*> pSigningKeyFileOut @@ -59,14 +56,12 @@ pStakeAddressKeyGenCmd era = do pStakeAddressKeyHashCmd :: () - => CardanoEra era - -> Maybe (Parser (StakeAddressCmds era)) -pStakeAddressKeyHashCmd era = do - w <- forEraMaybeEon era - pure - $ subParser "key-hash" + => Parser (StakeAddressCmds era) +pStakeAddressKeyHashCmd = + do + subParser "key-hash" $ Opt.info - ( StakeAddressKeyHashCmd w + ( StakeAddressKeyHashCmd <$> pStakeVerificationKeyOrFile Nothing <*> pMaybeOutputFile ) @@ -74,15 +69,12 @@ pStakeAddressKeyHashCmd era = do pStakeAddressBuildCmd :: () - => CardanoEra era - -> EnvCli - -> Maybe (Parser (StakeAddressCmds era)) -pStakeAddressBuildCmd era envCli = do - w <- forEraMaybeEon era - pure - $ subParser "build" + => EnvCli + -> Parser (StakeAddressCmds era) +pStakeAddressBuildCmd envCli = do + subParser "build" $ Opt.info - ( StakeAddressBuildCmd w + ( StakeAddressBuildCmd <$> pStakeVerifier Nothing <*> pNetworkId envCli <*> pMaybeOutputFile @@ -91,74 +83,70 @@ pStakeAddressBuildCmd era envCli = do pStakeAddressRegistrationCertificateCmd :: () - => CardanoEra era - -> Maybe (Parser (StakeAddressCmds era)) -pStakeAddressRegistrationCertificateCmd era = do - forEraInEonMaybe era $ \sbe -> - caseShelleyToBabbageOrConwayEraOnwards - ( const $ - subParser "registration-certificate" $ - Opt.info - ( StakeAddressRegistrationCertificateCmd sbe - <$> pStakeIdentifier Nothing - <*> pure Nothing - <*> pOutputFile - ) - desc - ) - ( const $ - subParser "registration-certificate" $ - Opt.info - ( StakeAddressRegistrationCertificateCmd sbe - <$> pStakeIdentifier Nothing - <*> fmap Just pKeyRegistDeposit - <*> pOutputFile - ) - desc - ) - sbe + => ShelleyBasedEra era + -> Parser (StakeAddressCmds era) +pStakeAddressRegistrationCertificateCmd sbe = do + caseShelleyToBabbageOrConwayEraOnwards + ( const $ + subParser "registration-certificate" $ + Opt.info + ( StakeAddressRegistrationCertificateCmd sbe + <$> pStakeIdentifier Nothing + <*> pure Nothing + <*> pOutputFile + ) + desc + ) + ( const $ + subParser "registration-certificate" $ + Opt.info + ( StakeAddressRegistrationCertificateCmd sbe + <$> pStakeIdentifier Nothing + <*> fmap Just pKeyRegistDeposit + <*> pOutputFile + ) + desc + ) + sbe where desc = Opt.progDesc "Create a stake address registration certificate" pStakeAddressDeregistrationCertificateCmd :: () - => CardanoEra era - -> Maybe (Parser (StakeAddressCmds era)) -pStakeAddressDeregistrationCertificateCmd era = do - forEraInEonMaybe era $ \sbe -> - caseShelleyToBabbageOrConwayEraOnwards - ( \shelleyToBabbage -> - subParser "deregistration-certificate" - $ Opt.info - ( StakeAddressDeregistrationCertificateCmd (shelleyToBabbageEraToShelleyBasedEra shelleyToBabbage) - <$> pStakeIdentifier Nothing - <*> pure Nothing - <*> pOutputFile - ) - $ Opt.progDesc "Create a stake address deregistration certificate" - ) - ( \conwayOnwards -> - subParser "deregistration-certificate" - $ Opt.info - ( StakeAddressDeregistrationCertificateCmd (conwayEraOnwardsToShelleyBasedEra conwayOnwards) - <$> pStakeIdentifier Nothing - <*> fmap Just pKeyRegistDeposit - <*> pOutputFile - ) - $ Opt.progDesc "Create a stake address deregistration certificate" - ) - sbe + => ShelleyBasedEra era + -> Parser (StakeAddressCmds era) +pStakeAddressDeregistrationCertificateCmd sbe = do + caseShelleyToBabbageOrConwayEraOnwards + ( \shelleyToBabbage -> + subParser "deregistration-certificate" + $ Opt.info + ( StakeAddressDeregistrationCertificateCmd (shelleyToBabbageEraToShelleyBasedEra shelleyToBabbage) + <$> pStakeIdentifier Nothing + <*> pure Nothing + <*> pOutputFile + ) + $ Opt.progDesc "Create a stake address deregistration certificate" + ) + ( \conwayOnwards -> + subParser "deregistration-certificate" + $ Opt.info + ( StakeAddressDeregistrationCertificateCmd (conwayEraOnwardsToShelleyBasedEra conwayOnwards) + <$> pStakeIdentifier Nothing + <*> fmap Just pKeyRegistDeposit + <*> pOutputFile + ) + $ Opt.progDesc "Create a stake address deregistration certificate" + ) + sbe pStakeAddressStakeDelegationCertificateCmd :: () - => CardanoEra era - -> Maybe (Parser (StakeAddressCmds era)) -pStakeAddressStakeDelegationCertificateCmd era = do - w <- forEraMaybeEon era - pure - $ subParser "stake-delegation-certificate" + => ShelleyBasedEra era + -> Parser (StakeAddressCmds era) +pStakeAddressStakeDelegationCertificateCmd sbe = do + subParser "stake-delegation-certificate" $ Opt.info - ( StakeAddressStakeDelegationCertificateCmd w + ( StakeAddressStakeDelegationCertificateCmd sbe <$> pStakeIdentifier Nothing <*> pStakePoolVerificationKeyOrHashOrFile Nothing <*> pOutputFile @@ -171,10 +159,10 @@ pStakeAddressStakeDelegationCertificateCmd era = do pStakeAddressStakeAndVoteDelegationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressStakeAndVoteDelegationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "stake-and-vote-delegation-certificate" $ Opt.info @@ -192,10 +180,10 @@ pStakeAddressStakeAndVoteDelegationCertificateCmd era = do pStakeAddressVoteDelegationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressVoteDelegationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "vote-delegation-certificate" $ Opt.info @@ -212,10 +200,10 @@ pStakeAddressVoteDelegationCertificateCmd era = do pStakeAddressRegistrationAndDelegationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressRegistrationAndDelegationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "registration-and-delegation-certificate" $ Opt.info @@ -233,10 +221,10 @@ pStakeAddressRegistrationAndDelegationCertificateCmd era = do pStakeAddressRegistrationAndVoteDelegationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressRegistrationAndVoteDelegationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "registration-and-vote-delegation-certificate" $ Opt.info @@ -254,10 +242,10 @@ pStakeAddressRegistrationAndVoteDelegationCertificateCmd era = do pStakeAddressRegistrationStakeAndVoteDelegationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressRegistrationStakeAndVoteDelegationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "registration-stake-and-vote-delegation-certificate" $ Opt.info diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs index 6676dcf67a..7534533050 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs @@ -43,11 +43,11 @@ runStakeAddressCmds => StakeAddressCmds era -> ExceptT StakeAddressCmdError IO () runStakeAddressCmds = \case - StakeAddressKeyGenCmd _ fmt vk sk -> + StakeAddressKeyGenCmd fmt vk sk -> void $ runStakeAddressKeyGenCmd fmt vk sk - StakeAddressKeyHashCmd _ vk mOutputFp -> + StakeAddressKeyHashCmd vk mOutputFp -> runStakeAddressKeyHashCmd vk mOutputFp - StakeAddressBuildCmd _ stakeVerifier nw mOutputFp -> + StakeAddressBuildCmd stakeVerifier nw mOutputFp -> runStakeAddressBuildCmd stakeVerifier nw mOutputFp StakeAddressRegistrationCertificateCmd sbe stakeIdentifier mDeposit outputFp -> runStakeAddressRegistrationCertificateCmd sbe stakeIdentifier mDeposit outputFp From 382b74423f3b09d02be7d713c135f4d4c9bbc950 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 11 Oct 2024 09:36:34 -0400 Subject: [PATCH 2/6] Parameterize pStakePoolCmds on ShelleyBasedEra era --- cardano-cli/src/Cardano/CLI/EraBased/Commands.hs | 2 +- .../src/Cardano/CLI/EraBased/Options/StakePool.hs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index 35d257740c..eb4662accb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -124,7 +124,7 @@ pCmds sbe' envCli = do , Just (NodeCmds <$> pNodeCmds) , fmap QueryCmds <$> pQueryCmds cEra envCli , fmap StakeAddressCmds <$> pStakeAddressCmds sbe' envCli - , fmap StakePoolCmds <$> pStakePoolCmds cEra envCli + , fmap StakePoolCmds <$> pStakePoolCmds sbe' envCli , fmap TextViewCmds <$> pTextViewCmds , fmap TransactionCmds <$> pTransactionCmds sbe' envCli ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs index c2e8e912bd..b59ccee70b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs @@ -27,7 +27,7 @@ import qualified Options.Applicative as Opt pStakePoolCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (Cmd.StakePoolCmds era)) pStakePoolCmds era envCli = @@ -94,11 +94,11 @@ pExpectedStakePoolMetadataHash = pStakePoolRegistrationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (Cmd.StakePoolCmds era)) pStakePoolRegistrationCertificateCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "registration-certificate" $ Opt.info @@ -124,10 +124,10 @@ pStakePoolRegistrationCertificateCmd era envCli = do pStakePoolDeregistrationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (Cmd.StakePoolCmds era)) pStakePoolDeregistrationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "deregistration-certificate" $ Opt.info From dc869a1bbe434d972b962bdd401f0ea472e344bd Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 11 Oct 2024 09:53:36 -0400 Subject: [PATCH 3/6] Parameterize pQueryCmds on ShelleyBasedEra era and propagate --- .../src/Cardano/CLI/EraBased/Commands.hs | 2 +- .../Cardano/CLI/EraBased/Options/Common.hs | 5 +- .../src/Cardano/CLI/EraBased/Options/Query.hs | 65 +++++++++---------- 3 files changed, 36 insertions(+), 36 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index eb4662accb..6edf498554 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -122,7 +122,7 @@ pCmds sbe' envCli = do , fmap GenesisCmds <$> pGenesisCmds cEra envCli , fmap GovernanceCmds <$> pGovernanceCmds cEra , Just (NodeCmds <$> pNodeCmds) - , fmap QueryCmds <$> pQueryCmds cEra envCli + , fmap QueryCmds <$> pQueryCmds sbe' envCli , fmap StakeAddressCmds <$> pStakeAddressCmds sbe' envCli , fmap StakePoolCmds <$> pStakePoolCmds sbe' envCli , fmap TextViewCmds <$> pTextViewCmds diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 8a06224ba2..6e3c9494c7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -135,8 +135,9 @@ pNetworkId envCli = pure <$> maybeToList (envCliNetworkId envCli) ] -pTarget :: CardanoEra era -> Parser (Consensus.Target ChainPoint) -pTarget = inEonForEra (pure Consensus.VolatileTip) pTargetFromConway +pTarget :: ShelleyBasedEra era -> Parser (Consensus.Target ChainPoint) +pTarget sbe = + maybe (pure Consensus.VolatileTip) pTargetFromConway (forShelleyBasedEraMaybeEon sbe) where pTargetFromConway :: ConwayEraOnwards era -> Parser (Consensus.Target ChainPoint) pTargetFromConway _ = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs index 784b5a72d8..50852e34c3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs @@ -28,7 +28,7 @@ import qualified Options.Applicative as Opt pQueryCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQueryCmds era envCli = @@ -141,7 +141,7 @@ pQueryProtocolParametersCmd envCli = <*> pNetworkId envCli <*> pMaybeOutputFile -pQueryTipCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryTipCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryTipCmd era envCli = fmap QueryTipCmd $ QueryTipCmdArgs @@ -151,7 +151,7 @@ pQueryTipCmd era envCli = <*> pTarget era <*> pMaybeOutputFile -pQueryUTxOCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryUTxOCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryUTxOCmd era envCli = fmap QueryUTxOCmd $ QueryUTxOCmdArgs @@ -163,7 +163,7 @@ pQueryUTxOCmd era envCli = <*> (optional $ pOutputFormatJsonOrText "utxo") <*> pMaybeOutputFile -pQueryStakePoolsCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryStakePoolsCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryStakePoolsCmd era envCli = fmap QueryStakePoolsCmd $ QueryStakePoolsCmdArgs @@ -174,7 +174,7 @@ pQueryStakePoolsCmd era envCli = <*> (optional $ pOutputFormatJsonOrText "stake-pools") <*> pMaybeOutputFile -pQueryStakeDistributionCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryStakeDistributionCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryStakeDistributionCmd era envCli = fmap QueryStakeDistributionCmd $ QueryStakeDistributionCmdArgs @@ -185,7 +185,7 @@ pQueryStakeDistributionCmd era envCli = <*> (optional $ pOutputFormatJsonOrText "stake-distribution") <*> pMaybeOutputFile -pQueryStakeAddressInfoCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryStakeAddressInfoCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryStakeAddressInfoCmd era envCli = fmap QueryStakeAddressInfoCmd $ QueryStakeAddressInfoCmdArgs @@ -196,7 +196,7 @@ pQueryStakeAddressInfoCmd era envCli = <*> pTarget era <*> pMaybeOutputFile -pQueryLedgerStateCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryLedgerStateCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryLedgerStateCmd era envCli = fmap QueryLedgerStateCmd $ QueryLedgerStateCmdArgs @@ -206,7 +206,7 @@ pQueryLedgerStateCmd era envCli = <*> pTarget era <*> pMaybeOutputFile -pQueryProtocolStateCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryProtocolStateCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryProtocolStateCmd era envCli = fmap QueryProtocolStateCmd $ QueryProtocolStateCmdArgs @@ -229,7 +229,7 @@ pAllStakePoolsOrSome = pAll <|> pOnly pOnly :: Parser (AllOrOnly (Hash StakePoolKey)) pOnly = Only <$> some (pStakePoolVerificationKeyHash Nothing) -pQueryStakeSnapshotCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryStakeSnapshotCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryStakeSnapshotCmd era envCli = fmap QueryStakeSnapshotCmd $ QueryStakeSnapshotCmdArgs @@ -240,7 +240,7 @@ pQueryStakeSnapshotCmd era envCli = <*> pTarget era <*> pMaybeOutputFile -pQueryPoolStateCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryPoolStateCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryPoolStateCmd era envCli = fmap QueryPoolStateCmd $ QueryPoolStateCmdArgs @@ -275,7 +275,7 @@ pQueryTxMempoolCmd envCli = Opt.progDesc "Query if a particular transaction exists in the mempool" ] -pLeadershipScheduleCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pLeadershipScheduleCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pLeadershipScheduleCmd era envCli = fmap QueryLeadershipScheduleCmd $ QueryLeadershipScheduleCmdArgs @@ -290,7 +290,7 @@ pLeadershipScheduleCmd era envCli = <*> (optional $ pOutputFormatJsonOrText "leadership-schedule") <*> pMaybeOutputFile -pKesPeriodInfoCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pKesPeriodInfoCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pKesPeriodInfoCmd era envCli = fmap QueryKesPeriodInfoCmd $ QueryKesPeriodInfoCmdArgs @@ -301,7 +301,7 @@ pKesPeriodInfoCmd era envCli = <*> pTarget era <*> pMaybeOutputFile -pQuerySlotNumberCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQuerySlotNumberCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQuerySlotNumberCmd era envCli = fmap QuerySlotNumberCmd $ QuerySlotNumberCmdArgs @@ -318,7 +318,7 @@ pQuerySlotNumberCmd era envCli = , Opt.help "UTC timestamp in YYYY-MM-DDThh:mm:ssZ format" ] -pQueryRefScriptSizeCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era) +pQueryRefScriptSizeCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era) pQueryRefScriptSizeCmd era envCli = fmap QueryRefScriptSizeCmd $ QueryRefScriptSizeCmdArgs @@ -341,26 +341,26 @@ pQueryRefScriptSizeCmd era envCli = pQueryGetConstitutionCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQueryGetConstitutionCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "constitution" $ - Opt.info (QueryConstitutionCmd <$> pQueryNoArgCmdArgs w era envCli) $ + Opt.info (QueryConstitutionCmd <$> pQueryNoArgCmdArgs w envCli) $ Opt.progDesc "Get the constitution" pQueryGetGovStateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQueryGetGovStateCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "gov-state" $ - Opt.info (QueryGovStateCmd <$> pQueryNoArgCmdArgs w era envCli) $ + Opt.info (QueryGovStateCmd <$> pQueryNoArgCmdArgs w envCli) $ Opt.progDesc "Get the governance state" -- TODO Conway: DRep State and DRep Stake Distribution parsers use DRep keys to obtain DRep credentials. This only @@ -370,11 +370,11 @@ pQueryGetGovStateCmd era envCli = do pQueryDRepStateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQueryDRepStateCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "drep-state" $ Opt.info (QueryDRepStateCmd <$> pQueryDRepStateCmdArgs w) $ @@ -406,11 +406,11 @@ pQueryDRepStateCmd era envCli = do pQueryDRepStakeDistributionCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQueryDRepStakeDistributionCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "drep-stake-distribution" $ Opt.info (QueryDRepStakeDistributionCmd <$> pQueryDRepStakeDistributionCmdArgs w) $ @@ -429,11 +429,11 @@ pQueryDRepStakeDistributionCmd era envCli = do pQuerySPOStakeDistributionCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQuerySPOStakeDistributionCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "spo-stake-distribution" $ Opt.info (QuerySPOStakeDistributionCmd <$> pQuerySPOStakeDistributionCmdArgs w) $ @@ -452,11 +452,11 @@ pQuerySPOStakeDistributionCmd era envCli = do pQueryGetCommitteeStateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQueryGetCommitteeStateCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "committee-state" $ Opt.info (QueryCommitteeMembersStateCmd <$> pQueryCommitteeMembersStateArgs w) $ @@ -519,11 +519,11 @@ pQueryGetCommitteeStateCmd era envCli = do pQueryTreasuryValueCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (QueryCmds era)) pQueryTreasuryValueCmd era envCli = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "treasury" $ Opt.info (QueryTreasuryValueCmd <$> pQueryTreasuryValueArgs w) $ @@ -542,13 +542,12 @@ pQueryTreasuryValueCmd era envCli = do pQueryNoArgCmdArgs :: () => ConwayEraOnwards era - -> CardanoEra era -> EnvCli -> Parser (QueryNoArgCmdArgs era) -pQueryNoArgCmdArgs w era envCli = +pQueryNoArgCmdArgs w envCli = QueryNoArgCmdArgs w <$> pSocketPath envCli <*> pConsensusModeParams <*> pNetworkId envCli - <*> pTarget era + <*> pTarget (conwayEraOnwardsToShelleyBasedEra w) <*> optional pOutputFile From a6f523e2042eadde423511c1a8bc4e6f1c04a105 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 11 Oct 2024 10:06:06 -0400 Subject: [PATCH 4/6] Parameterize pGovernanceCmds on ShelleyBasedEra era --- .../src/Cardano/CLI/EraBased/Commands.hs | 2 +- .../CLI/EraBased/Options/Governance.hs | 10 +++--- .../EraBased/Options/Governance/Actions.hs | 34 +++++++++---------- .../EraBased/Options/Governance/Committee.hs | 22 ++++++------ .../CLI/EraBased/Options/Governance/DRep.hs | 26 +++++++------- .../CLI/EraBased/Options/Governance/Poll.hs | 14 ++++---- .../CLI/EraBased/Options/Governance/Vote.hs | 10 +++--- 7 files changed, 59 insertions(+), 59 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index 6edf498554..f2280e6a9f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -120,7 +120,7 @@ pCmds sbe' envCli = do [ Just (AddressCmds <$> pAddressCmds envCli) , Just (KeyCmds <$> pKeyCmds) , fmap GenesisCmds <$> pGenesisCmds cEra envCli - , fmap GovernanceCmds <$> pGovernanceCmds cEra + , fmap GovernanceCmds <$> pGovernanceCmds sbe' , Just (NodeCmds <$> pNodeCmds) , fmap QueryCmds <$> pQueryCmds sbe' envCli , fmap StakeAddressCmds <$> pStakeAddressCmds sbe' envCli diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs index 782492cf16..58992a3bb2 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs @@ -24,7 +24,7 @@ import qualified Options.Applicative as Opt pGovernanceCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCmds era)) pGovernanceCmds era = subInfoParser @@ -43,9 +43,9 @@ pGovernanceCmds era = , fmap GovernanceVoteCmds <$> pGovernanceVoteCmds era ] -pCreateMirCertificatesCmds :: CardanoEra era -> Maybe (Parser (GovernanceCmds era)) +pCreateMirCertificatesCmds :: ShelleyBasedEra era -> Maybe (Parser (GovernanceCmds era)) pCreateMirCertificatesCmds era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "create-mir-certificate" $ Opt.info (pMIRPayStakeAddresses w <|> mirCertParsers w) $ @@ -99,10 +99,10 @@ pGovernanceCreateMirCertificateTransferToReservesCmd w = pGovernanceGenesisKeyDelegationCertificate :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCmds era)) pGovernanceGenesisKeyDelegationCertificate era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "create-genesis-key-delegation-certificate" $ Opt.info (parser w) $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs index 26c0196328..69efca1e4d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs @@ -23,7 +23,7 @@ import qualified Options.Applicative as Opt pGovernanceActionCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionCmds era = subInfoParser @@ -44,10 +44,10 @@ pGovernanceActionCmds era = ] pGovernanceActionViewCmd - :: CardanoEra era + :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionViewCmd era = do - eon <- forEraMaybeEon era + eon <- forShelleyBasedEraMaybeEon era return $ subParser "view" $ Opt.info @@ -60,10 +60,10 @@ pGovernanceActionViewCmd era = do $ Opt.progDesc "View a governance action." pGovernanceActionNewInfoCmd - :: CardanoEra era + :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionNewInfoCmd era = do - eon <- forEraMaybeEon era + eon <- forShelleyBasedEraMaybeEon era pure $ subParser "create-info" $ Opt.info @@ -80,10 +80,10 @@ pGovernanceActionNewInfoCmd era = do $ Opt.progDesc "Create an info action." pGovernanceActionNewConstitutionCmd - :: CardanoEra era + :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionNewConstitutionCmd era = do - eon <- forEraMaybeEon era + eon <- forShelleyBasedEraMaybeEon era pure $ subParser "create-constitution" $ Opt.info @@ -105,10 +105,10 @@ pGovernanceActionNewConstitutionCmd era = do $ Opt.progDesc "Create a constitution." pGovernanceActionUpdateCommitteeCmd - :: CardanoEra era + :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionUpdateCommitteeCmd era = do - eon <- forEraMaybeEon era + eon <- forShelleyBasedEraMaybeEon era pure $ subParser "update-committee" $ Opt.info @@ -140,10 +140,10 @@ pUpdateCommitteeCmd eon = <*> pOutputFile pGovernanceActionNoConfidenceCmd - :: CardanoEra era + :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionNoConfidenceCmd era = do - eon <- forEraMaybeEon era + eon <- forShelleyBasedEraMaybeEon era pure $ subParser "create-no-confidence" $ Opt.info @@ -226,10 +226,10 @@ pCostModelsFile = pGovernanceActionProtocolParametersUpdateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionProtocolParametersUpdateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ Cmd.GovernanceActionProtocolParametersUpdateCmd <$> pUpdateProtocolParametersCmd w @@ -371,9 +371,9 @@ dpGovActionProtocolParametersUpdate = \case <*> pIntroducedInConwayPParams pGovernanceActionTreasuryWithdrawalCmd - :: CardanoEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) + :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionTreasuryWithdrawalCmd era = do - eon <- forEraMaybeEon era + eon <- forShelleyBasedEraMaybeEon era pure $ subParser "create-treasury-withdrawal" $ Opt.info @@ -413,10 +413,10 @@ pPV :: Parser L.ProtVer pPV = mkProtocolVersionOrErr <$> pProtocolVersion pGovernanceActionHardforkInitCmd - :: CardanoEra era + :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernanceActionCmds era)) pGovernanceActionHardforkInitCmd era = do - eon <- forEraMaybeEon era + eon <- forShelleyBasedEraMaybeEon era pure $ subParser "create-hardfork" $ Opt.info diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs index 8b17c5a3fa..68a21f507e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs @@ -20,7 +20,7 @@ import qualified Options.Applicative as Opt pGovernanceCommitteeCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeCmds era = subInfoParser @@ -39,10 +39,10 @@ pGovernanceCommitteeCmds era = pGovernanceCommitteeKeyGenColdCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeKeyGenColdCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "key-gen-cold" $ Opt.info (pCmd w) $ @@ -63,10 +63,10 @@ pGovernanceCommitteeKeyGenColdCmd era = do pGovernanceCommitteeKeyGenHotCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeKeyGenHotCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "key-gen-hot" $ Opt.info (pCmd w) $ @@ -87,10 +87,10 @@ pGovernanceCommitteeKeyGenHotCmd era = do pGovernanceCommitteeKeyHashCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeKeyHashCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "key-hash" $ Opt.info @@ -105,10 +105,10 @@ pGovernanceCommitteeKeyHashCmd era = do pGovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "create-hot-key-authorization-certificate" $ Opt.info @@ -125,10 +125,10 @@ pGovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd era = do pGovernanceCommitteeCreateColdKeyResignationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeCreateColdKeyResignationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "create-cold-key-resignation-certificate" $ Opt.info (conwayEraOnwardsConstraints w $ mkParser w) $ 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 1297536d7c..e343be5486 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs @@ -32,7 +32,7 @@ import qualified Options.Applicative as Opt pGovernanceDRepCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era)) pGovernanceDRepCmds era = subInfoParser @@ -52,10 +52,10 @@ pGovernanceDRepCmds era = pGovernanceDRepKeyGenCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era)) pGovernanceDRepKeyGenCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "key-gen" $ Opt.info @@ -68,10 +68,10 @@ pGovernanceDRepKeyGenCmd era = do pGovernanceDRepKeyIdCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era)) pGovernanceDRepKeyIdCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "id" $ Opt.info @@ -101,10 +101,10 @@ pDRepIdOutputFormat = pRegistrationCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era)) pRegistrationCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "registration-certificate" $ Opt.info (conwayEraOnwardsConstraints w $ mkParser w) $ @@ -148,10 +148,10 @@ pDrepMetadataHash = pRetirementCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era)) pRetirementCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "retirement-certificate" $ Opt.info @@ -165,10 +165,10 @@ pRetirementCertificateCmd era = do pUpdateCertificateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era)) pUpdateCertificateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "update-certificate" $ Opt.info @@ -187,10 +187,10 @@ pUpdateCertificateCmd era = do pGovernanceDrepMetadataHashCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceDRepCmds era)) pGovernanceDrepMetadataHashCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "metadata-hash" $ Opt.info diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Poll.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Poll.hs index 7566b893dd..7791d43741 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Poll.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Poll.hs @@ -16,7 +16,7 @@ import qualified Options.Applicative as Opt pGovernancePollCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernancePollCmds era)) pGovernancePollCmds era = case parsers of @@ -42,9 +42,9 @@ pGovernancePollCmds era = ) ] -pGovernanceCreatePoll :: CardanoEra era -> Maybe (Parser (Cmd.GovernancePollCmds era)) +pGovernanceCreatePoll :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernancePollCmds era)) pGovernanceCreatePoll era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing pure $ fmap Cmd.GovernanceCreatePoll $ @@ -54,9 +54,9 @@ pGovernanceCreatePoll era = do <*> optional pPollNonce <*> pOutputFile -pGovernanceAnswerPoll :: CardanoEra era -> Maybe (Parser (Cmd.GovernancePollCmds era)) +pGovernanceAnswerPoll :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernancePollCmds era)) pGovernanceAnswerPoll era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing pure $ fmap Cmd.GovernanceAnswerPoll $ @@ -65,9 +65,9 @@ pGovernanceAnswerPoll era = do <*> optional pPollAnswerIndex <*> optional pOutputFile -pGovernanceVerifyPoll :: CardanoEra era -> Maybe (Parser (Cmd.GovernancePollCmds era)) +pGovernanceVerifyPoll :: ShelleyBasedEra era -> Maybe (Parser (Cmd.GovernancePollCmds era)) pGovernanceVerifyPoll era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era when ("BabbageEraOnwardsConway" `isInfixOf` show w) Nothing pure $ fmap Cmd.GovernanceVerifyPoll $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs index f896d36fd0..8c0dcdafe5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -19,7 +19,7 @@ import qualified Options.Applicative as Opt pGovernanceVoteCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceVoteCmds era)) pGovernanceVoteCmds era = subInfoParser @@ -31,10 +31,10 @@ pGovernanceVoteCmds era = pGovernanceVoteCreateCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceVoteCmds era)) pGovernanceVoteCreateCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "create" $ Opt.info @@ -65,10 +65,10 @@ pAnyVotingStakeVerificationKeyOrHashOrFile = pGovernanceVoteViewCmd :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe (Parser (GovernanceVoteCmds era)) pGovernanceVoteViewCmd era = do - w <- forEraMaybeEon era + w <- forShelleyBasedEraMaybeEon era pure $ subParser "view" $ Opt.info From 4a84aa17d0a3a69db449d989d470381f1c82f81b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 11 Oct 2024 10:22:13 -0400 Subject: [PATCH 5/6] Parameterize pGenesisCmds on ShelleyBasedEra era --- .../src/Cardano/CLI/EraBased/Commands.hs | 5 ++-- .../Cardano/CLI/EraBased/Options/Genesis.hs | 27 ++++++++++--------- 2 files changed, 17 insertions(+), 15 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index f2280e6a9f..225fca494f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -11,7 +11,7 @@ module Cardano.CLI.EraBased.Commands ) where -import Cardano.Api (ShelleyBasedEra (..), toCardanoEra) +import Cardano.Api (ShelleyBasedEra (..)) import Cardano.CLI.Commands.Address import Cardano.CLI.Commands.Key @@ -114,12 +114,11 @@ pAnyEraCommand envCli = pCmds :: ShelleyBasedEra era -> EnvCli -> Parser (Cmds era) pCmds sbe' envCli = do - let cEra = toCardanoEra sbe' asum $ catMaybes [ Just (AddressCmds <$> pAddressCmds envCli) , Just (KeyCmds <$> pKeyCmds) - , fmap GenesisCmds <$> pGenesisCmds cEra envCli + , fmap GenesisCmds <$> pGenesisCmds sbe' envCli , fmap GovernanceCmds <$> pGovernanceCmds sbe' , Just (NodeCmds <$> pNodeCmds) , fmap QueryCmds <$> pQueryCmds sbe' envCli diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 559d3e001f..18c64d6913 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -26,7 +26,7 @@ import qualified Options.Applicative as Opt pGenesisCmds :: () - => CardanoEra era + => ShelleyBasedEra era -> EnvCli -> Maybe (Parser (GenesisCmds era)) pGenesisCmds era envCli = @@ -65,15 +65,18 @@ pGenesisCmds era envCli = subParser "initial-txin" $ Opt.info (pGenesisTxIn envCli) $ Opt.progDesc "Get the TxIn for an initial UTxO based on the verification key" - , forEraInEonMaybe era $ \sbe -> - subParser "create-cardano" $ - Opt.info (pGenesisCreateCardano sbe envCli) $ - Opt.progDesc $ - mconcat - [ "Create a Byron and Shelley genesis file from a genesis " - , "template and genesis/delegation/spending keys." - ] - , forEraInEonMaybe era $ \sbe -> + , forShelleyBasedEraInEonMaybe + era + ( \sbe -> + subParser "create-cardano" $ + Opt.info (pGenesisCreateCardano sbe envCli) $ + Opt.progDesc $ + mconcat + [ "Create a Byron and Shelley genesis file from a genesis " + , "template and genesis/delegation/spending keys." + ] + ) + , forShelleyBasedEraInEonMaybe era $ \sbe -> subParser "create" $ Opt.info (pGenesisCreate sbe envCli) $ Opt.progDesc $ @@ -81,7 +84,7 @@ pGenesisCmds era envCli = [ "Create a Shelley genesis file from a genesis " , "template and genesis/delegation/spending keys." ] - , forEraInEonMaybe era $ \sbe -> + , forShelleyBasedEraInEonMaybe era $ \sbe -> subParser "create-staked" $ Opt.info (pGenesisCreateStaked sbe envCli) $ Opt.progDesc $ @@ -89,7 +92,7 @@ pGenesisCmds era envCli = [ "Create a staked Shelley genesis file from a genesis " , "template and genesis/delegation/spending keys." ] - , forEraInEonMaybe era $ \sbe -> + , forShelleyBasedEraInEonMaybe era $ \sbe -> subParser "create-testnet-data" $ Opt.info (pGenesisCreateTestNetData sbe envCli) $ Opt.progDesc $ From 5574be211e95b9ac79be8e9e53deec43fae7fba5 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 15 Oct 2024 14:28:44 -0400 Subject: [PATCH 6/6] Minor refactors --- .../src/Cardano/CLI/EraBased/Commands.hs | 19 ++++++++++--------- .../CLI/EraBased/Options/StakeAddress.hs | 3 +-- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index 225fca494f..45e2d29b3f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -20,12 +20,13 @@ import Cardano.CLI.Environment import Cardano.CLI.EraBased.Commands.Genesis import Cardano.CLI.EraBased.Commands.Query import Cardano.CLI.EraBased.Commands.StakeAddress -import Cardano.CLI.EraBased.Commands.StakePool hiding (sbe) +import Cardano.CLI.EraBased.Commands.StakePool import Cardano.CLI.EraBased.Commands.TextView import Cardano.CLI.EraBased.Commands.Transaction import Cardano.CLI.EraBased.Options.Common import Cardano.CLI.EraBased.Options.Genesis -import Cardano.CLI.EraBased.Options.Governance +import Cardano.CLI.EraBased.Options.Governance (GovernanceCmds, pGovernanceCmds, + renderGovernanceCmds) import Cardano.CLI.EraBased.Options.Query import Cardano.CLI.EraBased.Options.StakeAddress import Cardano.CLI.EraBased.Options.StakePool @@ -113,17 +114,17 @@ pAnyEraCommand envCli = ] pCmds :: ShelleyBasedEra era -> EnvCli -> Parser (Cmds era) -pCmds sbe' envCli = do +pCmds era envCli = do asum $ catMaybes [ Just (AddressCmds <$> pAddressCmds envCli) , Just (KeyCmds <$> pKeyCmds) - , fmap GenesisCmds <$> pGenesisCmds sbe' envCli - , fmap GovernanceCmds <$> pGovernanceCmds sbe' + , fmap GenesisCmds <$> pGenesisCmds era envCli + , fmap GovernanceCmds <$> pGovernanceCmds era , Just (NodeCmds <$> pNodeCmds) - , fmap QueryCmds <$> pQueryCmds sbe' envCli - , fmap StakeAddressCmds <$> pStakeAddressCmds sbe' envCli - , fmap StakePoolCmds <$> pStakePoolCmds sbe' envCli + , fmap QueryCmds <$> pQueryCmds era envCli + , fmap StakeAddressCmds <$> pStakeAddressCmds era envCli + , fmap StakePoolCmds <$> pStakePoolCmds era envCli , fmap TextViewCmds <$> pTextViewCmds - , fmap TransactionCmds <$> pTransactionCmds sbe' envCli + , fmap TransactionCmds <$> pTransactionCmds era envCli ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs index 01e1877415..e29608b6fc 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs @@ -115,7 +115,7 @@ pStakeAddressDeregistrationCertificateCmd :: () => ShelleyBasedEra era -> Parser (StakeAddressCmds era) -pStakeAddressDeregistrationCertificateCmd sbe = do +pStakeAddressDeregistrationCertificateCmd = caseShelleyToBabbageOrConwayEraOnwards ( \shelleyToBabbage -> subParser "deregistration-certificate" @@ -137,7 +137,6 @@ pStakeAddressDeregistrationCertificateCmd sbe = do ) $ Opt.progDesc "Create a stake address deregistration certificate" ) - sbe pStakeAddressStakeDelegationCertificateCmd :: ()