From 0d018ecf3b12be9f9c4eaf1593158f4329549efb Mon Sep 17 00:00:00 2001 From: John Ky Date: Sun, 15 Oct 2023 01:38:11 +1100 Subject: [PATCH] Rely on IsShelleyBasedEra and IsCardanoEra less --- cabal.project | 2 +- cardano-cli/cardano-cli.cabal | 2 +- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 8 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 6 +- .../Cardano/CLI/EraBased/Run/Transaction.hs | 112 +++++++++--------- 5 files changed, 66 insertions(+), 64 deletions(-) diff --git a/cabal.project b/cabal.project index 6e6c50035a..6a97c15ccf 100644 --- a/cabal.project +++ b/cabal.project @@ -47,5 +47,5 @@ write-ghc-environment-files: always source-repository-package type: git location: git@github.com:input-output-hk/cardano-api.git - tag: b8c8e75928a45a8b27762f574f2c83373332f33b + tag: 6dd0cce4de094ff0d0a5a2962844f3b3c1d4ae39 subdir: cardano-api diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index a7d5dc2f57..865116686e 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -202,7 +202,7 @@ library , binary , bytestring , canonical-json - , cardano-api ^>= 8.26.0.0 + , cardano-api ^>= 8.25.2.0 , cardano-binary , cardano-crypto , cardano-crypto-class ^>= 2.1.2 diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 1f4788ddcb..d52085a918 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -160,7 +160,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do , txFee = TxFeeImplicit ByronEraOnlyByron , txValidityRange = ( TxValidityNoLowerBound - , defaultTxValidityUpperBound + , defaultTxValidityUpperBound ByronEra ) , txMetadata = TxMetadataNone , txAuxScripts = TxAuxScriptsNone @@ -175,7 +175,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do , txVotingProcedures = Nothing } - case createAndValidateTransactionBody txBodyCont of + case createAndValidateTransactionBody ByronEra txBodyCont of Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> let bWit = fromByronWitness sk nId txBody in makeSignedTransaction [bWit] txBody @@ -209,7 +209,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do , txFee = TxFeeImplicit ByronEraOnlyByron , txValidityRange = ( TxValidityNoLowerBound - , defaultTxValidityUpperBound + , defaultTxValidityUpperBound ByronEra ) , txMetadata = TxMetadataNone , txAuxScripts = TxAuxScriptsNone @@ -224,7 +224,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do , txVotingProcedures = Nothing } - case createAndValidateTransactionBody txBodyCont of + case createAndValidateTransactionBody ByronEra txBodyCont of Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> let bWit = fromByronWitness sk nId txBody in makeSignedTransaction [bWit] txBody diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 6a7cf7318e..fa5fa6f50b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -761,7 +761,7 @@ runGenesisCreateStakedCmd genStuffedAddress :: IO (AddressInEra ShelleyEra) genStuffedAddress = - shelleyAddressInEra <$> + shelleyAddressInEra ShelleyBasedEraShelley <$> (ShelleyAddress <$> pure Ledger.Testnet <*> (Ledger.KeyHashObj . mkKeyHash . read64BitInt @@ -946,7 +946,7 @@ computeInsecureDelegation g0 nw pool = do let initialUtxoAddr = makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash paymentVK)) stakeAddressReference delegation <- pure $ force Delegation - { dInitialUtxoAddr = shelleyAddressInEra initialUtxoAddr + { dInitialUtxoAddr = shelleyAddressInEra ShelleyBasedEraShelley initialUtxoAddr , dDelegStaking = Ledger.hashKey (unStakeVerificationKey stakeVK) , dPoolParams = pool } @@ -1290,7 +1290,7 @@ readInitialFundAddresses utxodir nw = do , takeExtension file == ".vkey" ] return [ addr | vkey <- vkeys , let vkh = verificationKeyHash (castVerificationKey vkey) - addr = makeShelleyAddressInEra nw (PaymentCredentialByKey vkh) + addr = makeShelleyAddressInEra ShelleyBasedEraShelley nw (PaymentCredentialByKey vkh) NoStakeAddress ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 2c9feabdff..5d0bcb69b5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -143,12 +143,13 @@ runTransactionBuildCmd certsAndMaybeScriptWits <- case cardanoEraStyle eon of LegacyByronEra -> return [] - ShelleyBasedEra{} -> - sequence - [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ - readFileTextEnvelope AsCertificate (File certFile)) - | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits - ] + ShelleyBasedEra sbe -> + shelleyBasedEraConstraints sbe $ + sequence + [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ + readFileTextEnvelope AsCertificate (File certFile)) + | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits + ] withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFilesThruple eon withdrawals txMetadata <- firstExceptT TxCmdMetadataError . newExceptT $ @@ -242,7 +243,7 @@ runTransactionBuildCmd OutputTxBodyOnly fpath -> let noWitTx = makeSignedTransaction [] balancedTxBody - in lift (cardanoEraConstraints eon $ writeTxFileTextEnvelopeCddl fpath noWitTx) + in lift (cardanoEraConstraints eon $ writeTxFileTextEnvelopeCddl eon fpath noWitTx) & onLeft (left . TxCmdWriteFileError) getExecutionUnitPrices :: CardanoEra era -> LedgerProtocolParameters era -> Maybe Ledger.Prices @@ -294,12 +295,13 @@ runTransactionBuildRawCmd certsAndMaybeScriptWits <- case cardanoEraStyle eon of LegacyByronEra -> return [] - ShelleyBasedEra{} -> - sequence - [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ - readFileTextEnvelope AsCertificate (File certFile)) - | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits - ] + ShelleyBasedEra sbe -> + shelleyBasedEraConstraints sbe $ + sequence + [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ + readFileTextEnvelope AsCertificate (File certFile)) + | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits + ] withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFilesThruple eon withdrawals @@ -350,7 +352,7 @@ runTransactionBuildRawCmd txMetadata mLedgerPParams mProp votingProcedures proposals let noWitTx = makeSignedTransaction [] txBody - lift (cardanoEraConstraints eon $ writeTxFileTextEnvelopeCddl txBodyOutFile noWitTx) + lift (cardanoEraConstraints eon $ writeTxFileTextEnvelopeCddl eon txBodyOutFile noWitTx) & onLeft (left . TxCmdWriteFileError) @@ -455,7 +457,7 @@ runTxBuildRaw era } first TxCmdTxBodyError $ - cardanoEraConstraints era $ createAndValidateTransactionBody txBodyContent + cardanoEraConstraints era $ createAndValidateTransactionBody era txBodyContent runTxBuild :: () => CardanoEra era @@ -502,7 +504,7 @@ runTxBuild inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts (TxOutChangeAddress changeAddr) valuesWithScriptWits mLowerBound mUpperBound certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata - mUpdatePropF mOverrideWits votingProcedures proposals outputOptions = do + mUpdatePropF mOverrideWits votingProcedures proposals outputOptions = cardanoEraConstraints era $ do let consensusMode = consensusModeOnly cModeParams dummyFee = Just $ Lovelace 0 @@ -532,7 +534,7 @@ runTxBuild validatedTxScriptValidity <- hoistEither (first TxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity) case (consensusMode, cardanoEraStyle era) of - (CardanoMode, ShelleyBasedEra _) -> do + (CardanoMode, ShelleyBasedEra sbe) -> do _ <- toEraInMode era CardanoMode & hoistMaybe (TxCmdEraConsensusModeMismatchTxBalance outputOptions (AnyConsensusMode CardanoMode) (AnyCardanoEra era)) @@ -599,7 +601,7 @@ runTxBuild balancedTxBody@(BalancedTxBody _ _ _ fee) <- firstExceptT TxCmdBalanceTxBody . hoistEither - $ makeTransactionBodyAutoBalance systemStart (toLedgerEpochInfo eraHistory) + $ makeTransactionBodyAutoBalance sbe systemStart (toLedgerEpochInfo eraHistory) pparams stakePools stakeDelegDeposits drepDelegDeposits txEraUtxo txBodyContent cAddr mOverrideWits @@ -897,20 +899,20 @@ runTransactionSignCmd inputTxFile <- liftIO $ fileOrPipe inputTxFilePath anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdCddlError) - InAnyShelleyBasedEra _era tx <- + InAnyShelleyBasedEra sbe tx <- onlyInShelleyBasedEras "sign for Byron era transactions" anyTx let (txbody, existingTxKeyWits) = getTxBodyAndWitnesses tx byronWitnesses <- - pure (mkShelleyBootstrapWitnesses mNetworkId txbody sksByron) + pure (mkShelleyBootstrapWitnesses sbe mNetworkId txbody sksByron) & onLeft (left . TxCmdBootstrapWitnessError) - let newShelleyKeyWits = map (makeShelleyKeyWitness txbody) sksShelley + let newShelleyKeyWits = map (makeShelleyKeyWitness sbe txbody) sksShelley allKeyWits = existingTxKeyWits ++ newShelleyKeyWits ++ byronWitnesses signedTx = makeSignedTransaction allKeyWits txbody - lift (writeTxFileTextEnvelopeCddl outTxFile signedTx) + lift (writeTxFileTextEnvelopeCddl (shelleyBasedToCardanoEra sbe) outTxFile signedTx) & onLeft (left . TxCmdWriteFileError) InputTxBodyFile (File txbodyFilePath) -> do @@ -920,7 +922,7 @@ runTransactionSignCmd case unwitnessed of IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra _era unwitTx <- + InAnyShelleyBasedEra sbe unwitTx <- onlyInShelleyBasedEras "sign for Byron era transactions" anyTx let txbody = getTxBody unwitTx @@ -928,25 +930,25 @@ runTransactionSignCmd -- directly or derived from a provided Byron address. byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError . hoistEither - $ mkShelleyBootstrapWitnesses mNetworkId txbody sksByron + $ mkShelleyBootstrapWitnesses sbe mNetworkId txbody sksByron - let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley + let shelleyKeyWitnesses = map (makeShelleyKeyWitness sbe txbody) sksShelley tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody - lift (writeTxFileTextEnvelopeCddl outTxFile tx) + lift (writeTxFileTextEnvelopeCddl (shelleyBasedToCardanoEra sbe) outTxFile tx) & onLeft (left . TxCmdWriteFileError) UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra _era txbody <- + InAnyShelleyBasedEra sbe txbody <- --TODO: in principle we should be able to support Byron era txs too onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError . hoistEither - $ mkShelleyBootstrapWitnesses mNetworkId txbody sksByron + $ mkShelleyBootstrapWitnesses sbe mNetworkId txbody sksByron - let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley + let shelleyKeyWitnesses = map (makeShelleyKeyWitness sbe txbody) sksShelley tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody firstExceptT TxCmdWriteFileError . newExceptT @@ -1011,11 +1013,11 @@ runTransactionCalculateMinFeeCmd pparams <- firstExceptT TxCmdProtocolParamsError $ readProtocolParameters protocolParamsFile case unwitnessed of IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra _era unwitTx <- + InAnyShelleyBasedEra sbe unwitTx <- onlyInShelleyBasedEras "sign for Byron era transactions" anyTx let txbody = getTxBody unwitTx let tx = makeSignedTransaction [] txbody - Lovelace fee = estimateTransactionFee + Lovelace fee = estimateTransactionFee sbe networkId (protocolParamTxFeeFixed pparams) (protocolParamTxFeePerByte pparams) @@ -1026,12 +1028,12 @@ runTransactionCalculateMinFeeCmd liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" UnwitnessedCliFormattedTxBody anyTxBody -> do - InAnyShelleyBasedEra _era txbody <- + InAnyShelleyBasedEra sbe txbody <- --TODO: in principle we should be able to support Byron era txs too onlyInShelleyBasedEras "calculate-min-fee for Byron era transactions" anyTxBody let tx = makeSignedTransaction [] txbody - Lovelace fee = estimateTransactionFee + Lovelace fee = estimateTransactionFee sbe networkId (protocolParamTxFeeFixed pparams) (protocolParamTxFeePerByte pparams) @@ -1095,29 +1097,29 @@ partitionSomeWitnesses = reversePartitionedWits . foldl' go mempty -- | Construct a Shelley bootstrap witness (i.e. a Byron key witness in the -- Shelley era). -mkShelleyBootstrapWitness - :: IsShelleyBasedEra era - => Maybe NetworkId +mkShelleyBootstrapWitness :: () + => ShelleyBasedEra era + -> Maybe NetworkId -> TxBody era -> ShelleyBootstrapWitnessSigningKeyData -> Either BootstrapWitnessError (KeyWitness era) -mkShelleyBootstrapWitness Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = +mkShelleyBootstrapWitness _ Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = Left MissingNetworkIdOrByronAddressError -mkShelleyBootstrapWitness (Just nw) txBody (ShelleyBootstrapWitnessSigningKeyData skey Nothing) = - Right $ makeShelleyBootstrapWitness (WitnessNetworkId nw) txBody skey -mkShelleyBootstrapWitness _ txBody (ShelleyBootstrapWitnessSigningKeyData skey (Just addr)) = - Right $ makeShelleyBootstrapWitness (WitnessByronAddress addr) txBody skey +mkShelleyBootstrapWitness sbe (Just nw) txBody (ShelleyBootstrapWitnessSigningKeyData skey Nothing) = + Right $ makeShelleyBootstrapWitness sbe (WitnessNetworkId nw) txBody skey +mkShelleyBootstrapWitness sbe _ txBody (ShelleyBootstrapWitnessSigningKeyData skey (Just addr)) = + Right $ makeShelleyBootstrapWitness sbe (WitnessByronAddress addr) txBody skey -- | Attempt to construct Shelley bootstrap witnesses until an error is -- encountered. -mkShelleyBootstrapWitnesses - :: IsShelleyBasedEra era - => Maybe NetworkId +mkShelleyBootstrapWitnesses :: () + => ShelleyBasedEra era + -> Maybe NetworkId -> TxBody era -> [ShelleyBootstrapWitnessSigningKeyData] -> Either BootstrapWitnessError [KeyWitness era] -mkShelleyBootstrapWitnesses mnw txBody = - mapM (mkShelleyBootstrapWitness mnw txBody) +mkShelleyBootstrapWitnesses sbe mnw txBody = + mapM (mkShelleyBootstrapWitness sbe mnw txBody) -- ---------------------------------------------------------------------------- @@ -1228,15 +1230,15 @@ runTransactionWitnessCmd AByronWitness bootstrapWitData -> firstExceptT TxCmdBootstrapWitnessError . hoistEither - $ mkShelleyBootstrapWitness mNetworkId txbody bootstrapWitData + $ mkShelleyBootstrapWitness sbe mNetworkId txbody bootstrapWitData AShelleyKeyWitness skShelley -> - pure $ makeShelleyKeyWitness txbody skShelley + pure $ makeShelleyKeyWitness sbe txbody skShelley firstExceptT TxCmdWriteFileError . newExceptT $ writeTxWitnessFileTextEnvelopeCddl sbe outFile witness UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra _era txbody <- + InAnyShelleyBasedEra sbe txbody <- onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody someWit <- firstExceptT TxCmdReadWitnessSigningDataError @@ -1249,9 +1251,9 @@ runTransactionWitnessCmd AByronWitness bootstrapWitData -> firstExceptT TxCmdBootstrapWitnessError . hoistEither - $ mkShelleyBootstrapWitness mNetworkId txbody bootstrapWitData + $ mkShelleyBootstrapWitness sbe mNetworkId txbody bootstrapWitData AShelleyKeyWitness skShelley -> - pure $ makeShelleyKeyWitness txbody skShelley + pure $ makeShelleyKeyWitness sbe txbody skShelley firstExceptT TxCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFile @@ -1269,7 +1271,7 @@ runTransactionSignWitnessCmd txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- lift (readFileTxBody txbodyFile) & onLeft (left . TxCmdCddlError) case unwitnessed of - UnwitnessedCliFormattedTxBody (InAnyCardanoEra era txbody) -> do + UnwitnessedCliFormattedTxBody (InAnyCardanoEra era txbody) -> cardanoEraConstraints era $ do witnesses <- sequence [ do @@ -1277,7 +1279,7 @@ runTransactionSignWitnessCmd lift (readFileTxKeyWitness file) & onLeft (left . TxCmdCddlWitnessError) case testEquality era era' of - Nothing -> left $ TxCmdWitnessEraMismatch (AnyCardanoEra era) (AnyCardanoEra era') witnessFile + Nothing -> cardanoEraConstraints era' $ left $ TxCmdWitnessEraMismatch (AnyCardanoEra era) (AnyCardanoEra era') witnessFile Just Refl -> return witness | witnessFile@(WitnessFile file) <- witnessFiles ] @@ -1303,7 +1305,7 @@ runTransactionSignWitnessCmd let tx = makeSignedTransaction witnesses txbody - lift (writeTxFileTextEnvelopeCddl outFile tx) & onLeft (left . TxCmdWriteFileError) + lift (writeTxFileTextEnvelopeCddl era outFile tx) & onLeft (left . TxCmdWriteFileError) -- | Constrain the era to be Shelley based. Fail for the Byron era. onlyInShelleyBasedEras :: () @@ -1313,4 +1315,4 @@ onlyInShelleyBasedEras :: () onlyInShelleyBasedEras notImplMsg (InAnyCardanoEra era x) = case cardanoEraStyle era of LegacyByronEra -> left (TxCmdNotImplemented notImplMsg) - ShelleyBasedEra sbe -> return (InAnyShelleyBasedEra sbe x) + ShelleyBasedEra sbe -> shelleyBasedEraConstraints sbe $ return (InAnyShelleyBasedEra sbe x)