From d93346efd2a05d188fb4915a29c90a7beccf26db Mon Sep 17 00:00:00 2001 From: John Ky Date: Wed, 27 Sep 2023 22:04:26 +1000 Subject: [PATCH] Upgrade to cardano-api-8.21.0.0 --- cabal.project | 2 +- cardano-cli/cardano-cli.cabal | 2 +- cardano-cli/src/Cardano/CLI/Byron/Parsers.hs | 4 +- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 4 +- .../EraBased/Commands/Governance/Actions.hs | 4 +- .../Cardano/CLI/EraBased/Options/Common.hs | 107 ++++++++++ .../CLI/EraBased/Options/Governance.hs | 2 +- .../EraBased/Options/Governance/Actions.hs | 19 +- .../EraBased/Options/Governance/Committee.hs | 10 +- .../CLI/EraBased/Options/Governance/DRep.hs | 10 +- .../CLI/EraBased/Options/Governance/Query.hs | 10 +- .../CLI/EraBased/Options/Governance/Vote.hs | 2 +- .../CLI/EraBased/Options/StakeAddress.hs | 16 +- .../Cardano/CLI/EraBased/Options/StakePool.hs | 4 +- .../CLI/EraBased/Run/Governance/Actions.hs | 12 +- .../Cardano/CLI/EraBased/Run/Transaction.hs | 183 ++++++++++-------- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 30 ++- cardano-cli/src/Cardano/CLI/Read.hs | 87 +++++---- .../CLI/Types/Errors/TxValidationError.hs | 27 +-- .../cardano-cli-golden/files/golden/help.cli | 14 +- ...governance_action_create-new-committee.cli | 50 ++--- flake.lock | 6 +- 22 files changed, 362 insertions(+), 243 deletions(-) diff --git a/cabal.project b/cabal.project index e85650893d..78521bc27c 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2023-08-08T19:56:09Z - , cardano-haskell-packages 2023-09-19T21:43:40Z + , cardano-haskell-packages 2023-09-26T01:42:03Z packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index bb2c8f5a41..469bb84f38 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -200,7 +200,7 @@ library , binary , bytestring , canonical-json - , cardano-api ^>= 8.20.2 + , cardano-api ^>= 8.21 , cardano-binary , cardano-crypto , cardano-crypto-class ^>= 2.1.2 diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs index 02d0453177..40b2d96f59 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs @@ -305,8 +305,8 @@ parseTxOut = pLovelaceTxOut :: Word64 -> TxOutValue ByronEra pLovelaceTxOut l = if l > (maxBound :: Word64) - then error $ show l <> " lovelace exceeds the Word64 upper bound" - else TxOutAdaOnly AdaOnlyInByronEra . Lovelace $ toInteger l + then error $ show l <> " lovelace exceeds the Word64 upper bound" + else TxOutAdaOnly ByronToAllegraEraByron . Lovelace $ toInteger l readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a readerFromAttoParser p = diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 3dce8cdc43..843f4cf8a9 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -157,7 +157,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do , txOuts = outs , txTotalCollateral = TxTotalCollateralNone , txReturnCollateral = TxReturnCollateralNone - , txFee = TxFeeImplicit TxFeesImplicitInByronEra + , txFee = TxFeeImplicit ByronEraOnlyByron , txValidityRange = ( TxValidityNoLowerBound , TxValidityNoUpperBound ValidityNoUpperBoundInByronEra @@ -206,7 +206,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do , txOuts = outs , txTotalCollateral = TxTotalCollateralNone , txReturnCollateral = TxReturnCollateralNone - , txFee = TxFeeImplicit TxFeesImplicitInByronEra + , txFee = TxFeeImplicit ByronEraOnlyByron , txValidityRange = ( TxValidityNoLowerBound , TxValidityNoUpperBound ValidityNoUpperBoundInByronEra diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs index 162022d770..617f106d8d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs @@ -54,8 +54,8 @@ data NewCommitteeCmd , ebReturnAddress :: AnyStakeIdentifier , ebProposalUrl :: ProposalUrl , ebProposalHashSource :: ProposalHashSource - , ebOldCommittee :: [AnyStakeIdentifier] - , ebNewCommittee :: [(AnyStakeIdentifier, EpochNo)] + , ebOldCommittee :: [VerificationKeyOrHashOrFile CommitteeColdKey] + , ebNewCommittee :: [(VerificationKeyOrHashOrFile CommitteeColdKey, EpochNo)] , ebRequiredQuorum :: Rational , ebPreviousGovActionId :: Maybe (TxId, Word32) , ebFilePath :: File () Out diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index cc131b06d8..9e0c3fa266 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -613,6 +613,113 @@ pOperatorCertIssueCounterFile = ] ] +--- + +pAddCommitteeColdVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile CommitteeColdKey) +pAddCommitteeColdVerificationKeyOrHashOrFile = + asum + [ VerificationKeyOrFile <$> pAddCommitteeColdVerificationKeyOrFile + , VerificationKeyHash <$> pAddCommitteeColdVerificationKeyHash + ] + +pAddCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey) +pAddCommitteeColdVerificationKeyHash = + Opt.option (Opt.eitherReader deserialiseFromHex) $ mconcat + [ Opt.long "add-cc-cold-verification-key-hash" + , Opt.metavar "STRING" + , Opt.help "Constitutional Committee key hash (hex-encoded)." + ] + where + deserialiseFromHex :: String -> Either String (Hash CommitteeColdKey) + deserialiseFromHex = + first (\e -> "Invalid Consitutional Committee cold key hash: " ++ displayError e) + . deserialiseFromRawBytesHex (AsHash AsCommitteeColdKey) + . BSC.pack + +pAddCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey) +pAddCommitteeColdVerificationKeyOrFile = + asum + [ VerificationKeyValue <$> pAddCommitteeColdVerificationKey + , VerificationKeyFilePath <$> pAddCommitteeColdVerificationKeyFile + ] + +pAddCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey) +pAddCommitteeColdVerificationKey = + Opt.option (Opt.eitherReader deserialiseFromHex) $ mconcat + [ Opt.long "add-cc-cold-verification-key" + , Opt.metavar "STRING" + , Opt.help "Constitutional Committee cold key (hex-encoded)." + ] + where + deserialiseFromHex :: String -> Either String (VerificationKey CommitteeColdKey) + deserialiseFromHex = + first (\e -> "Invalid Constitutional Committee cold key: " ++ displayError e) + . deserialiseFromRawBytesHex (AsVerificationKey AsCommitteeColdKey) + . BSC.pack + +pAddCommitteeColdVerificationKeyFile :: Parser (File (VerificationKey keyrole) In) +pAddCommitteeColdVerificationKeyFile = + fmap File $ Opt.strOption $ mconcat + [ Opt.long "add-cc-cold-verification-key-file" + , Opt.metavar "FILE" + , Opt.help "Filepath of the Consitutional Committee cold key." + , Opt.completer (Opt.bashCompleter "file") + ] + +--- +pRemoveCommitteeColdVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile CommitteeColdKey) +pRemoveCommitteeColdVerificationKeyOrHashOrFile = + asum + [ VerificationKeyOrFile <$> pRemoveCommitteeColdVerificationKeyOrFile + , VerificationKeyHash <$> pRemoveCommitteeColdVerificationKeyHash + ] + +pRemoveCommitteeColdVerificationKeyHash :: Parser (Hash CommitteeColdKey) +pRemoveCommitteeColdVerificationKeyHash = + Opt.option (Opt.eitherReader deserialiseFromHex) $ mconcat + [ Opt.long "remove-cc-cold-verification-key-hash" + , Opt.metavar "STRING" + , Opt.help "Constitutional Committee key hash (hex-encoded)." + ] + where + deserialiseFromHex :: String -> Either String (Hash CommitteeColdKey) + deserialiseFromHex = + first (\e -> "Invalid Consitutional Committee cold key hash: " ++ displayError e) + . deserialiseFromRawBytesHex (AsHash AsCommitteeColdKey) + . BSC.pack + +pRemoveCommitteeColdVerificationKeyOrFile :: Parser (VerificationKeyOrFile CommitteeColdKey) +pRemoveCommitteeColdVerificationKeyOrFile = + asum + [ VerificationKeyValue <$> pRemoveCommitteeColdVerificationKey + , VerificationKeyFilePath <$> pRemoveCommitteeColdVerificationKeyFile + ] + +pRemoveCommitteeColdVerificationKey :: Parser (VerificationKey CommitteeColdKey) +pRemoveCommitteeColdVerificationKey = + Opt.option (Opt.eitherReader deserialiseFromHex) $ mconcat + [ Opt.long "remove-cc-cold-verification-key" + , Opt.metavar "STRING" + , Opt.help "Constitutional Committee cold key (hex-encoded)." + ] + where + deserialiseFromHex :: String -> Either String (VerificationKey CommitteeColdKey) + deserialiseFromHex = + first (\e -> "Invalid Constitutional Committee cold key: " ++ displayError e) + . deserialiseFromRawBytesHex (AsVerificationKey AsCommitteeColdKey) + . BSC.pack + +pRemoveCommitteeColdVerificationKeyFile :: Parser (File (VerificationKey keyrole) In) +pRemoveCommitteeColdVerificationKeyFile = + fmap File $ Opt.strOption $ mconcat + [ Opt.long "remove-cc-cold-verification-key-file" + , Opt.metavar "FILE" + , Opt.help "Filepath of the Consitutional Committee cold key." + , Opt.completer (Opt.bashCompleter "file") + ] + +--- + pCommitteeColdVerificationKeyOrHashOrFile :: Parser (VerificationKeyOrHashOrFile CommitteeColdKey) pCommitteeColdVerificationKeyOrHashOrFile = asum diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs index 2f9b1aeb9d..25454a86ec 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs @@ -44,7 +44,7 @@ pGovernanceCmds era envCli = pCreateMirCertificatesCmds :: CardanoEra era -> Maybe (Parser (GovernanceCmds era)) pCreateMirCertificatesCmds era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "create-mir-certificate" $ Opt.info (pMIRPayStakeAddresses w <|> mirCertParsers 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 efa0c7546e..9627cbeef4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs @@ -43,7 +43,7 @@ pGovernanceActionNewInfoCmd :: CardanoEra era -> Maybe (Parser (GovernanceActionCmds era)) pGovernanceActionNewInfoCmd era = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "create-info" $ Opt.info @@ -63,7 +63,7 @@ pGovernanceActionNewConstitutionCmd :: CardanoEra era -> Maybe (Parser (GovernanceActionCmds era)) pGovernanceActionNewConstitutionCmd era = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "create-constitution" $ Opt.info @@ -85,7 +85,7 @@ pGovernanceActionNewCommitteeCmd :: CardanoEra era -> Maybe (Parser (GovernanceActionCmds era)) pGovernanceActionNewCommitteeCmd era = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "create-new-committee" $ Opt.info @@ -102,8 +102,11 @@ pNewCommitteeCmd = <*> pAnyStakeIdentifier Nothing <*> pProposalUrl <*> pProposalHashSource - <*> many (pAnyStakeIdentifier (Just "remove-cc")) - <*> many ((,) <$> pAnyStakeIdentifier (Just "add-cc") <*> pEpochNo "Committee member expiry epoch") + <*> many pRemoveCommitteeColdVerificationKeyOrHashOrFile + <*> many + ( (,) + <$> pAddCommitteeColdVerificationKeyOrHashOrFile + <*> pEpochNo "Committee member expiry epoch") <*> pRational "quorum" "Quorum of the committee that is necessary for a successful vote." <*> pPreviousGovernanceAction <*> pOutputFile @@ -113,7 +116,7 @@ pGovernanceActionNoConfidenceCmd :: CardanoEra era -> Maybe (Parser (GovernanceActionCmds era)) pGovernanceActionNoConfidenceCmd era = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "create-no-confidence" $ Opt.info @@ -142,7 +145,7 @@ pGovernanceActionProtocolParametersUpdateCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceActionCmds era)) pGovernanceActionProtocolParametersUpdateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "create-protocol-parameters-update" $ Opt.info @@ -277,7 +280,7 @@ dpGovActionProtocolParametersUpdate = \case pGovernanceActionTreasuryWithdrawalCmd :: CardanoEra era -> Maybe (Parser (GovernanceActionCmds era)) pGovernanceActionTreasuryWithdrawalCmd era = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "create-treasury-withdrawal" $ 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 019399d6a7..8ab2f8212a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Committee.hs @@ -33,7 +33,7 @@ pGovernanceCommitteeKeyGenColdCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeKeyGenColdCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "key-gen-cold" $ Opt.info (pCmd w) @@ -54,7 +54,7 @@ pGovernanceCommitteeKeyGenHotCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeKeyGenHotCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "key-gen-hot" $ Opt.info (pCmd w) @@ -75,7 +75,7 @@ pGovernanceCommitteeKeyHashCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeKeyHashCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "key-hash" $ Opt.info @@ -91,7 +91,7 @@ pGovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "create-hot-key-authorization-certificate" $ Opt.info @@ -109,7 +109,7 @@ pGovernanceCommitteeCreateColdKeyResignationCertificateCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceCommitteeCmds era)) pGovernanceCommitteeCreateColdKeyResignationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "create-cold-key-resignation-certificate" $ Opt.info 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 24301da729..3eb4734b2e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs @@ -43,7 +43,7 @@ pGovernanceDRepKeyGenCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceDRepCmds era)) pGovernanceDRepKeyGenCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "key-gen" $ Opt.info @@ -57,7 +57,7 @@ pGovernanceDRepKeyIdCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceDRepCmds era)) pGovernanceDRepKeyIdCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "id" $ Opt.info @@ -87,7 +87,7 @@ pRegistrationCertificateCmd :: () -> EnvCli -> Maybe (Parser (GovernanceDRepCmds era)) pRegistrationCertificateCmd era envCli = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "registration-certificate" $ Opt.info (pEraCmd envCli w) @@ -123,8 +123,8 @@ data AnyEraDecider era where AnyEraDeciderShelleyToBabbage :: ShelleyToBabbageEra era -> AnyEraDecider era AnyEraDeciderConwayOnwards :: ConwayEraOnwards era -> AnyEraDecider era -instance FeatureInEra AnyEraDecider where - featureInEra no yes = \case +instance Eon AnyEraDecider where + inEonForEra no yes = \case ByronEra -> no ShelleyEra -> yes $ AnyEraDeciderShelleyToBabbage ShelleyToBabbageEraShelley AllegraEra -> yes $ AnyEraDeciderShelleyToBabbage ShelleyToBabbageEraAllegra diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Query.hs index 23d11636e1..941b3397cb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Query.hs @@ -33,7 +33,7 @@ pGovernanceQueryGetConstitutionCmd :: () -> EnvCli -> Maybe (Parser (GovernanceQueryCmds era)) pGovernanceQueryGetConstitutionCmd era env = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "constitution" $ Opt.info (GovernanceQueryConstitutionCmd cOn <$> pNoArgQueryCmd env) @@ -44,7 +44,7 @@ pGovernanceQueryGetGovStateCmd :: () -> EnvCli -> Maybe (Parser (GovernanceQueryCmds era)) pGovernanceQueryGetGovStateCmd era env = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "gov-state" $ Opt.info (GovernanceQueryGovStateCmd cOn <$> pNoArgQueryCmd env) @@ -60,7 +60,7 @@ pGovernanceQueryDRepStateCmd :: () -> EnvCli -> Maybe (Parser (GovernanceQueryCmds era)) pGovernanceQueryDRepStateCmd era env = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "drep-state" $ Opt.info (GovernanceQueryDRepStateCmd cOn <$> pDRepStateQueryCmd) @@ -79,7 +79,7 @@ pGovernanceQueryDRepStakeDistributionCmd :: () -> EnvCli -> Maybe (Parser (GovernanceQueryCmds era)) pGovernanceQueryDRepStakeDistributionCmd era env = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "drep-stake-distribution" $ Opt.info (GovernanceQueryDRepStakeDistributionCmd cOn <$> pDRepStakeDistributionQueryCmd) @@ -98,7 +98,7 @@ pGovernanceQueryGetCommitteeStateCmd :: () -> EnvCli -> Maybe (Parser (GovernanceQueryCmds era)) pGovernanceQueryGetCommitteeStateCmd era env = do - cOn <- maybeFeatureInEra era + cOn <- maybeEonInEra era pure $ subParser "committee-state" $ Opt.info (GovernanceQueryCommitteeStateCmd cOn <$> pNoArgQueryCmd env) 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 1295d87c8b..a3c8b54658 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Vote.hs @@ -32,7 +32,7 @@ pGovernanceVoteCreateCmd :: () => CardanoEra era -> Maybe (Parser (GovernanceVoteCmds era)) pGovernanceVoteCreateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "create" $ Opt.info diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs index a2c4447b28..309a243029 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs @@ -39,7 +39,7 @@ pStakeAddressKeyGenCmd :: () => CardanoEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressKeyGenCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "key-gen" $ Opt.info @@ -54,7 +54,7 @@ pStakeAddressKeyHashCmd :: () => CardanoEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressKeyHashCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "key-hash" $ Opt.info @@ -69,7 +69,7 @@ pStakeAddressBuildCmd :: () -> EnvCli -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressBuildCmd era envCli = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "build" $ Opt.info @@ -84,7 +84,7 @@ pStakeAddressRegistrationCertificateCmd :: () => CardanoEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressRegistrationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "registration-certificate" $ Opt.info @@ -99,7 +99,7 @@ pStakeAddressDeregistrationCertificateCmd :: () => CardanoEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressDeregistrationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "deregistration-certificate" $ Opt.info @@ -114,7 +114,7 @@ pStakeAddressStakeDelegationCertificateCmd :: () => CardanoEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressStakeDelegationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "stake-delegation-certificate" $ Opt.info @@ -133,7 +133,7 @@ pStakeAddressStakeAndVoteDelegationCertificateCmd :: () => CardanoEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressStakeAndVoteDelegationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "stake-and-vote-delegation-certificate" $ Opt.info @@ -153,7 +153,7 @@ pStakeAddressVoteDelegationCertificateCmd :: () => CardanoEra era -> Maybe (Parser (StakeAddressCmds era)) pStakeAddressVoteDelegationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "vote-delegation-certificate" $ Opt.info diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs index 2adb44b69a..2a019776ce 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakePool.hs @@ -57,7 +57,7 @@ pStakePoolMetadataHashCmd = pStakePoolRegistrationCertificateCmd :: CardanoEra era -> EnvCli -> Maybe (Parser (StakePoolCmds era)) pStakePoolRegistrationCertificateCmd era envCli = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "registration-certificate" $ Opt.info @@ -78,7 +78,7 @@ pStakePoolRegistrationCertificateCmd era envCli = do pStakePoolDeregistrationCertificateCmd :: CardanoEra era -> Maybe (Parser (StakePoolCmds era)) pStakePoolDeregistrationCertificateCmd era = do - w <- maybeFeatureInEra era + w <- maybeEonInEra era pure $ subParser "deregistration-certificate" $ Opt.info diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs index 241db28f0d..f99b6815fb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs @@ -21,7 +21,9 @@ import Cardano.CLI.Types.Errors.GovernanceActionsError import Cardano.CLI.Types.Key import qualified Cardano.Ledger.Conway.Governance as Ledger +import Control.Monad import Control.Monad.Except (ExceptT) +import Control.Monad.Trans (MonadTrans (..)) import Control.Monad.Trans.Except.Extra import Data.Function import qualified Data.Map.Strict as Map @@ -151,8 +153,14 @@ runGovernanceActionCreateNewCommitteeCmd cOn (NewCommitteeCmd network deposit re , Ledger.anchorDataHash = proposalHash } - oldCommitteeKeyHashes <- mapM readStakeKeyHash old - newCommitteeKeyHashes <- mapM (\(stakeKey, expEpoch) -> (,expEpoch) <$> readStakeKeyHash stakeKey) new + oldCommitteeKeyHashes <- forM old $ \vkeyOrHashOrTextFile -> + lift (readVerificationKeyOrHashOrTextEnvFile AsCommitteeColdKey vkeyOrHashOrTextFile) + & onLeft (left . GovernanceActionsCmdReadFileError) + + newCommitteeKeyHashes <- forM new $ \(vkeyOrHashOrTextFile, expEpoch) -> do + kh <- lift (readVerificationKeyOrHashOrTextEnvFile AsCommitteeColdKey vkeyOrHashOrTextFile) + & onLeft (left . GovernanceActionsCmdReadFileError) + pure (kh, expEpoch) returnKeyHash <- readStakeKeyHash retAddr diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 84287b9aba..397c2ca0e9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -191,7 +191,7 @@ runTxBuildCmd -- Conway related votes <- - featureInEra + inEonForEra (pure emptyVotingProcedures) (\w -> firstExceptT TxCmdVoteError $ ExceptT (readVotingProceduresFiles w conwayVotes)) era @@ -595,8 +595,8 @@ runTxBuild , txUpdateProposal = validatedTxUpProp , txMintValue = validatedMintValue , txScriptValidity = validatedTxScriptValidity - , txProposalProcedures = inEraFeatureMaybe era (`Featured` validatedTxProposalProcedures) - , txVotingProcedures = inEraFeatureMaybe era (`Featured` validatedTxVotes) + , txProposalProcedures = inEraEonMaybe era (`Featured` validatedTxProposalProcedures) + , txVotingProcedures = inEraEonMaybe era (`Featured` validatedTxVotes) } firstExceptT TxCmdTxInsDoNotExist @@ -672,10 +672,10 @@ validateTxInsReference -> Either TxCmdError (TxInsReference BuildTx era) validateTxInsReference _ [] = return TxInsReferenceNone validateTxInsReference era allRefIns = - case refInsScriptsAndInlineDatsSupportedInEra era of - Nothing -> txFeatureMismatchPure era TxFeatureReferenceInputs - Just supp -> return $ TxInsReference supp allRefIns - + caseByronToAlonzoOrBabbageEraOnwards + (const $ txFeatureMismatchPure era TxFeatureReferenceInputs) + (\w -> return $ TxInsReference w allRefIns) + era getAllReferenceInputs :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] @@ -724,12 +724,32 @@ toTxOutValueInAnyEra -> Value -> Either TxCmdError (TxOutValue era) toTxOutValueInAnyEra era val = - case multiAssetSupportedInEra era of - Left adaOnlyInEra -> + caseByronToAllegraOrMaryEraOnwards + (\w -> case valueToLovelace val of - Just l -> return (TxOutAdaOnly adaOnlyInEra l) + Just l -> return (TxOutAdaOnly w l) Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs - Right multiAssetInEra -> return (TxOutValue multiAssetInEra val) + ) + (\w -> return (TxOutValue w val)) + era + +-- TODO move this to cardano-api +caseAlonzoOnlyOrBabbageEraOnwards :: () + => (AlonzoEraOnly era -> a) + -> (BabbageEraOnwards era -> a) + -> AlonzoEraOnwards era + -> a +caseAlonzoOnlyOrBabbageEraOnwards l r = \case + AlonzoEraOnwardsAlonzo -> l AlonzoEraOnlyAlonzo + AlonzoEraOnwardsBabbage -> r BabbageEraOnwardsBabbage + AlonzoEraOnwardsConway -> r BabbageEraOnwardsConway + +-- TODO move this to cardano-api +alonzoEraOnlyToAlonzoEraOnwards :: () + => AlonzoEraOnly era + -> AlonzoEraOnwards era +alonzoEraOnlyToAlonzoEraOnwards = \case + AlonzoEraOnlyAlonzo -> AlonzoEraOnwardsAlonzo toTxOutInAnyEra :: CardanoEra era -> TxOutAnyEra @@ -738,70 +758,75 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do addr <- hoistEither $ toAddressInAnyEra era addr' val <- hoistEither $ toTxOutValueInAnyEra era val' (datum, refScript) - <- case (scriptDataSupportedInEra era, refInsScriptsAndInlineDatsSupportedInEra era) of - (Nothing, Nothing) -> pure (TxOutDatumNone, ReferenceScriptNone) - (Just sup, Nothing)-> - (,) <$> toTxAlonzoDatum sup mDatumHash <*> pure ReferenceScriptNone - (Just sup, Just inlineDatumRefScriptSupp) -> - toTxDatumReferenceScriptBabbage sup inlineDatumRefScriptSupp mDatumHash refScriptFp - (Nothing, Just _) -> - -- TODO: Figure out how to make this state unrepresentable - error "toTxOutInAnyEra: Should not be possible that inline datums are allowed but datums are not" + <- caseByronToMaryOrAlonzoEraOnwards + (const $ pure (TxOutDatumNone, ReferenceScriptNone)) + (\w -> + caseAlonzoOnlyOrBabbageEraOnwards + (\wa -> + (,) + <$> toTxAlonzoDatum (alonzoEraOnlyToAlonzoEraOnwards wa) mDatumHash + <*> pure ReferenceScriptNone + ) + (\wbo -> toTxDatumReferenceScriptBabbage w wbo mDatumHash refScriptFp) + w + ) + era + pure $ TxOut addr val datum refScript - where - getReferenceScript - :: ReferenceScriptAnyEra - -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era - -> ExceptT TxCmdError IO (ReferenceScript era) - getReferenceScript ReferenceScriptAnyEraNone _ = return ReferenceScriptNone - getReferenceScript (ReferenceScriptAnyEra fp) supp = do - ReferenceScript supp - <$> firstExceptT TxCmdScriptFileError (readFileScriptInAnyLang fp) - - toTxDatumReferenceScriptBabbage - :: ScriptDataSupportedInEra era - -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era - -> TxOutDatumAnyEra - -> ReferenceScriptAnyEra - -> ExceptT TxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era) - toTxDatumReferenceScriptBabbage sDataSupp inlineRefSupp cliDatum refScriptFp' = do - refScript <- getReferenceScript refScriptFp' inlineRefSupp - case cliDatum of - TxOutDatumByNone -> do - pure (TxOutDatumNone, refScript) - TxOutDatumByHashOnly dh -> do - pure (TxOutDatumHash sDataSupp dh, refScript) - TxOutDatumByHashOf fileOrSdata -> do - sData <- firstExceptT TxCmdScriptDataError - $ readScriptDataOrFile fileOrSdata - pure (TxOutDatumHash sDataSupp $ hashScriptDataBytes sData, refScript) - TxOutDatumByValue fileOrSdata -> do - sData <- firstExceptT TxCmdScriptDataError - $ readScriptDataOrFile fileOrSdata - pure (TxOutDatumInTx sDataSupp sData, refScript) - TxOutInlineDatumByValue fileOrSdata -> do - sData <- firstExceptT TxCmdScriptDataError - $ readScriptDataOrFile fileOrSdata - pure (TxOutDatumInline inlineRefSupp sData, refScript) - - toTxAlonzoDatum - :: ScriptDataSupportedInEra era - -> TxOutDatumAnyEra - -> ExceptT TxCmdError IO (TxOutDatum CtxTx era) - toTxAlonzoDatum supp cliDatum = - case cliDatum of - TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h) - TxOutDatumByHashOf sDataOrFile -> do - sData <- firstExceptT TxCmdScriptDataError - $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumHash supp $ hashScriptDataBytes sData) - TxOutDatumByValue sDataOrFile -> do - sData <- firstExceptT TxCmdScriptDataError - $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumInTx supp sData) - TxOutInlineDatumByValue _ -> - txFeatureMismatch era TxFeatureInlineDatums - TxOutDatumByNone -> pure TxOutDatumNone + where + getReferenceScript :: () + => ReferenceScriptAnyEra + -> BabbageEraOnwards era + -> ExceptT TxCmdError IO (ReferenceScript era) + getReferenceScript ReferenceScriptAnyEraNone _ = return ReferenceScriptNone + getReferenceScript (ReferenceScriptAnyEra fp) supp = do + ReferenceScript supp + <$> firstExceptT TxCmdScriptFileError (readFileScriptInAnyLang fp) + + toTxDatumReferenceScriptBabbage :: () + => AlonzoEraOnwards era + -> BabbageEraOnwards era + -> TxOutDatumAnyEra + -> ReferenceScriptAnyEra + -> ExceptT TxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era) + toTxDatumReferenceScriptBabbage sDataSupp inlineRefSupp cliDatum refScriptFp' = do + refScript <- getReferenceScript refScriptFp' inlineRefSupp + case cliDatum of + TxOutDatumByNone -> do + pure (TxOutDatumNone, refScript) + TxOutDatumByHashOnly dh -> do + pure (TxOutDatumHash sDataSupp dh, refScript) + TxOutDatumByHashOf fileOrSdata -> do + sData <- firstExceptT TxCmdScriptDataError + $ readScriptDataOrFile fileOrSdata + pure (TxOutDatumHash sDataSupp $ hashScriptDataBytes sData, refScript) + TxOutDatumByValue fileOrSdata -> do + sData <- firstExceptT TxCmdScriptDataError + $ readScriptDataOrFile fileOrSdata + pure (TxOutDatumInTx sDataSupp sData, refScript) + TxOutInlineDatumByValue fileOrSdata -> do + sData <- firstExceptT TxCmdScriptDataError + $ readScriptDataOrFile fileOrSdata + pure (TxOutDatumInline inlineRefSupp sData, refScript) + + toTxAlonzoDatum :: () + => AlonzoEraOnwards era + -> TxOutDatumAnyEra + -> ExceptT TxCmdError IO (TxOutDatum CtxTx era) + toTxAlonzoDatum supp cliDatum = + case cliDatum of + TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h) + TxOutDatumByHashOf sDataOrFile -> do + sData <- firstExceptT TxCmdScriptDataError + $ readScriptDataOrFile sDataOrFile + pure (TxOutDatumHash supp $ hashScriptDataBytes sData) + TxOutDatumByValue sDataOrFile -> do + sData <- firstExceptT TxCmdScriptDataError + $ readScriptDataOrFile sDataOrFile + pure (TxOutDatumInTx supp sData) + TxOutInlineDatumByValue _ -> + txFeatureMismatch era TxFeatureInlineDatums + TxOutDatumByNone -> pure TxOutDatumNone -- TODO: Currently we specify the policyId with the '--mint' option on the cli @@ -816,9 +841,9 @@ createTxMintValue era (val, scriptWitnesses) = if List.null (valueToList val) && List.null scriptWitnesses then return TxMintNone else do - case multiAssetSupportedInEra era of - Left _ -> txFeatureMismatchPure era TxFeatureMintValue - Right supported -> do + caseByronToAllegraOrMaryEraOnwards + (const (txFeatureMismatchPure era TxFeatureMintValue)) + (\w -> do -- The set of policy ids for which we need witnesses: let witnessesNeededSet :: Set PolicyId witnessesNeededSet = @@ -833,7 +858,9 @@ createTxMintValue era (val, scriptWitnesses) = validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet - return (TxMintValue supported val (BuildTxWith witnessesProvidedMap)) + return (TxMintValue w val (BuildTxWith witnessesProvidedMap)) + ) + era where gatherMintingWitnesses :: [ScriptWitness WitCtxMint era] diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 9e3e721fe5..4036bb1084 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -35,7 +35,7 @@ import Data.Char (isAscii) import Data.Function ((&)) import Data.Functor ((<&>)) import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, isJust) +import Data.Maybe (catMaybes, isJust, maybeToList) import Data.Ratio (numerator) import qualified Data.Text as Text import Data.Yaml (array) @@ -90,7 +90,7 @@ friendlyTxBody , txWithdrawals }) = [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts - , "certificates" .= inEraFeature era Null (`friendlyCertificates` txCertificates) + , "certificates" .= forEraInEon era Null (`friendlyCertificates` txCertificates) , "collateral inputs" .= friendlyCollateralInputs txInsCollateral , "era" .= era , "fee" .= friendlyFee txFee @@ -180,31 +180,25 @@ friendlyTxOut (TxOut addr amount mdatum script) = , "address" .= serialiseAddress byronAdr , "amount" .= friendlyTxOutValue amount ] - AddressInEra (ShelleyAddressInEra sbe) saddr@(ShelleyAddress net cred stake) -> + AddressInEra (ShelleyAddressInEra _) saddr@(ShelleyAddress net cred stake) -> let preAlonzo = friendlyPaymentCredential (fromShelleyPaymentCredential cred) : [ "address era" .= Aeson.String "Shelley" , "network" .= net , "address" .= serialiseAddress saddr , "amount" .= friendlyTxOutValue amount - , "stake reference" .= - friendlyStakeReference (fromShelleyStakeReference stake) - ] - datum = - [ "datum" .= renderDatum mdatum - | isJust $ scriptDataSupportedInEra $ shelleyBasedToCardanoEra sbe + , "stake reference" .= friendlyStakeReference (fromShelleyStakeReference stake) ] + datum = ["datum" .= d | d <- maybeToList $ renderDatum mdatum] sinceAlonzo = ["reference script" .= script] in preAlonzo ++ datum ++ sinceAlonzo - where - renderDatum :: TxOutDatum CtxTx era -> Aeson.Value - renderDatum TxOutDatumNone = Aeson.Null - renderDatum (TxOutDatumHash _ h) = toJSON h - renderDatum (TxOutDatumInTx _ sData) = - scriptDataToJson ScriptDataJsonDetailedSchema sData - renderDatum (TxOutDatumInline _ sData) = - scriptDataToJson ScriptDataJsonDetailedSchema sData - + where + renderDatum :: TxOutDatum CtxTx era -> Maybe Aeson.Value + renderDatum = \case + TxOutDatumNone -> Nothing + TxOutDatumHash _ h -> Just $ toJSON h + TxOutDatumInTx _ sData -> Just $ scriptDataToJson ScriptDataJsonDetailedSchema sData + TxOutDatumInline _ sData -> Just $ scriptDataToJson ScriptDataJsonDetailedSchema sData friendlyStakeReference :: StakeAddressReference -> Aeson.Value friendlyStakeReference = \case diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index a65d66ee2f..501d55f1d5 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -315,46 +315,53 @@ readScriptWitness era (PlutusScriptWitnessFiles readScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn anyScrLang@(AnyScriptLanguage anyScriptLanguage) datumOrFile redeemerOrFile execUnits mPid) = do - case refInsScriptsAndInlineDatsSupportedInEra era of - Nothing -> left $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - $ getIsCardanoEraConstraint era (AnyCardanoEra era) - Just _ -> do - - case scriptLanguageSupportedInEra era anyScriptLanguage of - Just sLangInEra -> - case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage -> - -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang - -- in order to make this branch unrepresentable. - error "readScriptWitness: Should not be possible to specify a simple script" - PlutusScriptLanguage version -> do - datum <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptDatumOrFile datumOrFile - redeemer <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptRedeemerOrFile redeemerOrFile - return $ PlutusScriptWitness - sLangInEra - version - (PReferenceScript refTxIn (unPolicyId <$> mPid)) - datum redeemer execUnits - Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) + caseByronToAlonzoOrBabbageEraOnwards + ( const $ left + $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra + $ getIsCardanoEraConstraint era (AnyCardanoEra era) + ) + ( const $ + case scriptLanguageSupportedInEra era anyScriptLanguage of + Just sLangInEra -> + case languageOfScriptLanguageInEra sLangInEra of + SimpleScriptLanguage -> + -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang + -- in order to make this branch unrepresentable. + error "readScriptWitness: Should not be possible to specify a simple script" + PlutusScriptLanguage version -> do + datum <- firstExceptT ScriptWitnessErrorScriptData + $ readScriptDatumOrFile datumOrFile + redeemer <- firstExceptT ScriptWitnessErrorScriptData + $ readScriptRedeemerOrFile redeemerOrFile + return $ PlutusScriptWitness + sLangInEra + version + (PReferenceScript refTxIn (unPolicyId <$> mPid)) + datum redeemer execUnits + Nothing -> + left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) + ) + era readScriptWitness era (SimpleReferenceScriptWitnessFiles refTxIn anyScrLang@(AnyScriptLanguage anyScriptLanguage) mPid) = do - case refInsScriptsAndInlineDatsSupportedInEra era of - Nothing -> left $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - $ getIsCardanoEraConstraint era (AnyCardanoEra era) - Just _ -> do - case scriptLanguageSupportedInEra era anyScriptLanguage of - Just sLangInEra -> - case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage -> - return . SimpleScriptWitness sLangInEra - $ SReferenceScript refTxIn (unPolicyId <$> mPid) - PlutusScriptLanguage{} -> - error "readScriptWitness: Should not be possible to specify a plutus script" - Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) + caseByronToAlonzoOrBabbageEraOnwards + ( const $ left + $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra + $ getIsCardanoEraConstraint era (AnyCardanoEra era) + ) + ( const $ + case scriptLanguageSupportedInEra era anyScriptLanguage of + Just sLangInEra -> + case languageOfScriptLanguageInEra sLangInEra of + SimpleScriptLanguage -> + return . SimpleScriptWitness sLangInEra + $ SReferenceScript refTxIn (unPolicyId <$> mPid) + PlutusScriptLanguage{} -> + error "readScriptWitness: Should not be possible to specify a plutus script" + Nothing -> + left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) + ) + era validateScriptSupportedInEra :: CardanoEra era -> ScriptInAnyLang @@ -796,8 +803,8 @@ readTxGovernanceActions -> IO (Either ConstitutionError [Proposal era]) readTxGovernanceActions _ [] = return $ Right [] readTxGovernanceActions era files = runExceptT $ do - w <- maybeFeatureInEra era - & hoistMaybe (ConstitutionNotSupportedInEra $ cardanoEraConstraints era $ AnyCardanoEra era) + w <- maybeEonInEra era + & hoistMaybe (ConstitutionNotSupportedInEra $ cardanoEraConstraints era $ AnyCardanoEra era) newExceptT $ sequence <$> mapM (readProposal w) files readProposal diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index 97d125cb48..e560dc7a4f 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -1,11 +1,12 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - module Cardano.CLI.Types.Errors.TxValidationError ( TxAuxScriptsValidationError(..) , TxCertificatesValidationError(..) @@ -78,17 +79,17 @@ instance Error TxFeeValidationError where validateTxFee :: CardanoEra era -> Maybe Lovelace -> Either TxFeeValidationError (TxFee era) -validateTxFee era mfee = - case (txFeesExplicitInEra era, mfee) of - (Left implicit, Nothing) -> return (TxFeeImplicit implicit) - (Right explicit, Just fee) -> return (TxFeeExplicit explicit fee) - - (Right _, Nothing) -> Left . TxFeatureImplicitFeesE - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era - (Left _, Just _) -> Left . TxFeatureExplicitFeesE - $ getIsCardanoEraConstraint era - $ AnyCardanoEra era +validateTxFee era = \case + Nothing -> + caseByronOrShelleyBasedEra + (pure . TxFeeImplicit) + (const $ Left . TxFeatureImplicitFeesE $ getIsCardanoEraConstraint era $ AnyCardanoEra era) + era + Just fee -> + caseByronOrShelleyBasedEra + (const $ Left . TxFeatureExplicitFeesE $ getIsCardanoEraConstraint era $ AnyCardanoEra era) + (\w -> pure (TxFeeExplicit w fee)) + era newtype TxTotalCollateralValidationError = TxTotalCollateralNotSupported AnyCardanoEra diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 3ac26141bb..2baf84196c 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -6512,20 +6512,14 @@ Usage: cardano-cli conway governance action create-new-committee | --proposal-file FILE | --proposal-hash HASH ) - [ --remove-cc-stake-pool-verification-key STRING + [ --remove-cc-cold-verification-key STRING | --remove-cc-cold-verification-key-file FILE - | --remove-cc-stake-pool-id STAKE_POOL_ID - | --remove-cc-stake-verification-key STRING - | --remove-cc-stake-verification-key-file FILE - | --remove-cc-stake-key-hash HASH + | --remove-cc-cold-verification-key-hash STRING ] [ - ( --add-cc-stake-pool-verification-key STRING + ( --add-cc-cold-verification-key STRING | --add-cc-cold-verification-key-file FILE - | --add-cc-stake-pool-id STAKE_POOL_ID - | --add-cc-stake-verification-key STRING - | --add-cc-stake-verification-key-file FILE - | --add-cc-stake-key-hash HASH + | --add-cc-cold-verification-key-hash STRING ) --epoch NATURAL] --quorum RATIONAL diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-new-committee.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-new-committee.cli index db546fdb6a..bdc5408e79 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-new-committee.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_governance_action_create-new-committee.cli @@ -15,20 +15,14 @@ Usage: cardano-cli conway governance action create-new-committee | --proposal-file FILE | --proposal-hash HASH ) - [ --remove-cc-stake-pool-verification-key STRING + [ --remove-cc-cold-verification-key STRING | --remove-cc-cold-verification-key-file FILE - | --remove-cc-stake-pool-id STAKE_POOL_ID - | --remove-cc-stake-verification-key STRING - | --remove-cc-stake-verification-key-file FILE - | --remove-cc-stake-key-hash HASH + | --remove-cc-cold-verification-key-hash STRING ] [ - ( --add-cc-stake-pool-verification-key STRING + ( --add-cc-cold-verification-key STRING | --add-cc-cold-verification-key-file FILE - | --add-cc-stake-pool-id STAKE_POOL_ID - | --add-cc-stake-verification-key STRING - | --add-cc-stake-verification-key-file FILE - | --add-cc-stake-key-hash HASH + | --add-cc-cold-verification-key-hash STRING ) --epoch NATURAL] --quorum RATIONAL @@ -60,34 +54,18 @@ Available options: --proposal-text TEXT Input proposal as UTF-8 encoded text. --proposal-file FILE Input proposal as a text file. --proposal-hash HASH Proposal anchor data hash. - --remove-cc-stake-pool-verification-key STRING - Stake pool verification key (Bech32 or hex-encoded). + --remove-cc-cold-verification-key STRING + Constitutional Committee cold key (hex-encoded). --remove-cc-cold-verification-key-file FILE - Filepath of the stake pool verification key. - --remove-cc-stake-pool-id STAKE_POOL_ID - Stake pool ID/verification key hash (either - Bech32-encoded or hex-encoded). Zero or more - occurences of this option is allowed. - --remove-cc-stake-verification-key STRING - Stake verification key (Bech32 or hex-encoded). - --remove-cc-stake-verification-key-file FILE - Filepath of the staking verification key. - --remove-cc-stake-key-hash HASH - Stake verification key hash (hex-encoded). - --add-cc-stake-pool-verification-key STRING - Stake pool verification key (Bech32 or hex-encoded). + Filepath of the Consitutional Committee cold key. + --remove-cc-cold-verification-key-hash STRING + Constitutional Committee key hash (hex-encoded). + --add-cc-cold-verification-key STRING + Constitutional Committee cold key (hex-encoded). --add-cc-cold-verification-key-file FILE - Filepath of the stake pool verification key. - --add-cc-stake-pool-id STAKE_POOL_ID - Stake pool ID/verification key hash (either - Bech32-encoded or hex-encoded). Zero or more - occurences of this option is allowed. - --add-cc-stake-verification-key STRING - Stake verification key (Bech32 or hex-encoded). - --add-cc-stake-verification-key-file FILE - Filepath of the staking verification key. - --add-cc-stake-key-hash HASH - Stake verification key hash (hex-encoded). + Filepath of the Consitutional Committee cold key. + --add-cc-cold-verification-key-hash STRING + Constitutional Committee key hash (hex-encoded). --epoch NATURAL Committee member expiry epoch --quorum RATIONAL Quorum of the committee that is necessary for a successful vote. diff --git a/flake.lock b/flake.lock index 494ff9f5b6..4b76f703fa 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1695160702, - "narHash": "sha256-+Mfc6eGA1ZwQ/ZjKzMoMWkHzd+sgR1JbxY0i849HjEU=", + "lastModified": 1695701948, + "narHash": "sha256-YUrtWWa+DponzzFg46oDCEMMnF2tQG/+WwK+auHeCsE=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "9932690af3713ef034c928850252eb1b88450ee6", + "rev": "4c55186c53103fee3e3973d70a9ce8a3a55a8486", "type": "github" }, "original": {