diff --git a/cabal.project b/cabal.project index e7dd1f8023..b8dc02455b 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,8 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2024-12-24T12:56:48Z - , cardano-haskell-packages 2025-02-15T18:39:38Z + , cardano-haskell-packages 2025-02-28T13:16:07Z + packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 62584176b7..0cd823eece 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -235,7 +235,7 @@ library binary, bytestring, canonical-json, - cardano-api ^>=10.9, + cardano-api ^>=10.10, cardano-binary, cardano-crypto, cardano-crypto-class ^>=2.1.2, diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs index ce8a250f55..65eb5abc87 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -12,6 +13,7 @@ where import Cardano.Api import Cardano.Api.Compatible +import Cardano.Api.Ledger qualified as L import Cardano.Api.Shelley hiding (VotingProcedures) import Cardano.CLI.Compatible.Exception @@ -25,14 +27,21 @@ import Cardano.CLI.EraBased.Script.Vote.Type import Cardano.CLI.EraBased.Transaction.Run import Cardano.CLI.Read import Cardano.CLI.Type.Common -import Cardano.CLI.Type.Error.TxCmdError -import Cardano.CLI.Type.TxFeature import Control.Monad -import Data.Function -import Data.Map.Strict qualified as Map -import Data.Maybe -import GHC.Exts (toList) +import Lens.Micro + +data CompatibleTransactionError + = forall err. Error err => CompatibleFileError (FileError err) + | CompatibleProposalError !ProposalError + +instance Show CompatibleTransactionError where + show = show . prettyError + +instance Error CompatibleTransactionError where + prettyError = \case + CompatibleFileError e -> prettyError e + CompatibleProposalError e -> pshow e runCompatibleTransactionCmd :: forall era e @@ -51,108 +60,67 @@ runCompatibleTransactionCmd fee certificates outputFp - ) = do - shelleyBasedEraConstraints sbe $ do - sks <- mapM (fromEitherIOCli . readWitnessSigningData) witnesses - - allOuts <- fromExceptTCli $ mapM (toTxOutInAnyEra sbe) outs - - certFilesAndMaybeScriptWits <- - fromExceptTCli $ - readCertificateScriptWitnesses sbe certificates - - certsAndMaybeScriptWits <- - liftIO $ - sequenceA - [ fmap (,cswScriptWitness <$> mSwit) $ - fromEitherIOCli $ - readFileTextEnvelope AsCertificate $ - File certFile - | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits - ] - - (protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <- - caseShelleyToBabbageOrConwayEraOnwards - ( const $ do - case mUpdateProposal of - Nothing -> return (NoPParamsUpdate sbe, NoVotes) - Just p -> do - pparamUpdate <- readUpdateProposalFile p - return (pparamUpdate, NoVotes) - ) - ( \w -> - case mProposalProcedure of - Nothing -> return (NoPParamsUpdate sbe, NoVotes) - Just prop -> do - pparamUpdate <- readProposalProcedureFile prop - votesAndWits <- fromEitherIOCli $ readVotingProceduresFiles w mVotes - votingProcedures <- - fromEitherCli $ mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votesAndWits] - return (pparamUpdate, VotingProcedures w votingProcedures) - ) - sbe - - let certsRefInputs = - [ refInput - | (_, Just sWit) <- certsAndMaybeScriptWits - , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit - ] - - votesRefInputs = - [ refInput - | VotingProcedures _ (TxVotingProcedures _ (BuildTxWith voteMap)) <- [votes] - , sWit <- Map.elems voteMap - , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit - ] - - proposalsRefInputs = - [ refInput - | ProposalProcedures _ (TxProposalProcedures proposalMap) <- [protocolUpdates] - , BuildTxWith (Just sWit) <- map snd $ toList proposalMap - , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit - ] - - validatedRefInputs <- - fromEitherCli . validateTxInsReference $ - certsRefInputs <> votesRefInputs <> proposalsRefInputs - let txCerts = mkTxCertificates sbe certsAndMaybeScriptWits - - -- this body is only for witnesses - apiTxBody <- - fromEitherCli $ - createTransactionBody sbe $ - defaultTxBodyContent sbe - & setTxIns (map (,BuildTxWith (KeyWitness KeyWitnessForSpending)) ins) - & setTxOuts allOuts - & setTxFee (TxFeeExplicit sbe fee) - & setTxCertificates txCerts - & setTxInsReference validatedRefInputs - - let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks - - byronWitnesses <- - fromEitherCli $ - mkShelleyBootstrapWitnesses sbe mNetworkId apiTxBody sksByron - - let newShelleyKeyWits = map (makeShelleyKeyWitness sbe apiTxBody) sksShelley - allKeyWits = newShelleyKeyWits ++ byronWitnesses - - signedTx <- - fromEitherCli $ - createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes txCerts - - fromEitherIOCli $ - writeTxFileTextEnvelopeCddl sbe outputFp signedTx - where - validateTxInsReference - :: [TxIn] - -> Either TxCmdError (TxInsReference era) - validateTxInsReference [] = return TxInsReferenceNone - validateTxInsReference allRefIns = do - let era = toCardanoEra era - eraMismatchError = Left $ TxCmdTxFeatureMismatch (anyCardanoEra era) TxFeatureReferenceInputs - w <- maybe eraMismatchError Right $ forEraMaybeEon era - pure $ TxInsReference w allRefIns + ) = shelleyBasedEraConstraints sbe $ do + sks <- mapM (fromEitherIOCli . readWitnessSigningData) witnesses + + allOuts <- fromEitherIOCli . runExceptT $ mapM (toTxOutInAnyEra sbe) outs + + certFilesAndMaybeScriptWits <- + fromExceptTCli $ + readCertificateScriptWitnesses sbe certificates + + certsAndMaybeScriptWits <- + liftIO $ + sequenceA + [ fmap (,cswScriptWitness <$> mSwit) $ + fromEitherIOCli $ + readFileTextEnvelope AsCertificate $ + File certFile + | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits + ] + + (protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <- + caseShelleyToBabbageOrConwayEraOnwards + ( const $ do + case mUpdateProposal of + Nothing -> return (NoPParamsUpdate sbe, NoVotes) + Just p -> do + pparamUpdate <- readUpdateProposalFile p + return (pparamUpdate, NoVotes) + ) + ( \w -> + case mProposalProcedure of + Nothing -> return (NoPParamsUpdate sbe, NoVotes) + Just prop -> do + pparamUpdate <- readProposalProcedureFile prop + votesAndWits <- fromEitherIOCli (readVotingProceduresFiles w mVotes) + votingProcedures <- + fromEitherCli $ mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votesAndWits] + return (pparamUpdate, VotingProcedures w votingProcedures) + ) + sbe + + let txCerts = mkTxCertificates sbe certsAndMaybeScriptWits + + transaction@(ShelleyTx _ ledgerTx) <- + fromEitherCli $ + createCompatibleTx sbe ins allOuts fee protocolUpdates votes txCerts + + let txBody = ledgerTx ^. L.bodyTxL + + let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks + + byronWitnesses <- + forM sksByron $ + fromEitherCli + . mkShelleyBootstrapWitness sbe mNetworkId txBody + + let newShelleyKeyWits = makeShelleyKeyWitness' sbe txBody <$> sksShelley + allKeyWits = newShelleyKeyWits ++ byronWitnesses + signedTx = addWitnesses allKeyWits transaction + + fromEitherIOCli $ + writeTxFileTextEnvelopeCddl sbe outputFp signedTx readUpdateProposalFile :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index 9f5efe7327..a1d26bdc8d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -18,8 +18,7 @@ {- HLINT ignore "Avoid lambda using `infix`" -} module Cardano.CLI.EraBased.Transaction.Run - ( mkShelleyBootstrapWitnesses - , partitionSomeWitnesses + ( partitionSomeWitnesses , runTransactionCmds , runTransactionBuildCmd , runTransactionBuildRawCmd @@ -70,7 +69,6 @@ import Cardano.CLI.EraBased.Transaction.Internal.HashCheck import Cardano.CLI.Orphan () import Cardano.CLI.Read import Cardano.CLI.Type.Common -import Cardano.CLI.Type.Error.BootstrapWitnessError import Cardano.CLI.Type.Error.NodeEraMismatchError import Cardano.CLI.Type.Error.TxCmdError import Cardano.CLI.Type.Error.TxValidationError @@ -1449,9 +1447,9 @@ runTransactionSignCmd runTransactionSignCmd Cmd.TransactionSignCmdArgs { txOrTxBodyFile = txOrTxBody - , witnessSigningData = witnessSigningData - , mNetworkId = mNetworkId - , outTxFile = outTxFile + , witnessSigningData + , mNetworkId + , outTxFile } = do sks <- forM witnessSigningData $ \d -> lift (readWitnessSigningData d) @@ -1464,17 +1462,19 @@ runTransactionSignCmd inputTxFile <- liftIO $ fileOrPipe inputTxFilePath anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdTextEnvCddlError) - InAnyShelleyBasedEra sbe tx <- pure anyTx + InAnyShelleyBasedEra sbe tx@(ShelleyTx _ ledgerTx) <- pure anyTx - let (txbody, existingTxKeyWits) = getTxBodyAndWitnesses tx + let (apiTxBody, existingTxKeyWits) = getTxBodyAndWitnesses tx byronWitnesses <- - pure (mkShelleyBootstrapWitnesses sbe mNetworkId txbody sksByron) - & onLeft (left . TxCmdBootstrapWitnessError) + firstExceptT TxCmdBootstrapWitnessError . liftEither $ + forM sksByron $ + shelleyBasedEraConstraints sbe $ + mkShelleyBootstrapWitness sbe mNetworkId (ledgerTx ^. L.bodyTxL) - let newShelleyKeyWits = map (makeShelleyKeyWitness sbe txbody) sksShelley + let newShelleyKeyWits = map (makeShelleyKeyWitness sbe apiTxBody) sksShelley allKeyWits = existingTxKeyWits ++ newShelleyKeyWits ++ byronWitnesses - signedTx = makeSignedTransaction allKeyWits txbody + signedTx = makeSignedTransaction allKeyWits apiTxBody lift (writeTxFileTextEnvelopeCddl sbe outTxFile signedTx) & onLeft (left . TxCmdWriteFileError) @@ -1486,14 +1486,14 @@ runTransactionSignCmd case unwitnessed of IncompleteCddlTxBody anyTxBody -> do - InAnyShelleyBasedEra sbe txbody <- pure anyTxBody + InAnyShelleyBasedEra sbe txbody@(ShelleyTxBody _ ledgerTxBody _ _ _ _) <- pure 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 sbe mNetworkId txbody sksByron + firstExceptT TxCmdBootstrapWitnessError . liftEither $ + forM sksByron $ + mkShelleyBootstrapWitness sbe mNetworkId ledgerTxBody let shelleyKeyWitnesses = map (makeShelleyKeyWitness sbe txbody) sksShelley tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody @@ -1764,34 +1764,6 @@ partitionSomeWitnesses = reversePartitionedWits . Foldable.foldl' go mempty AShelleyKeyWitness shelleyKeyWit -> (byronAcc, shelleyKeyWit : shelleyKeyAcc) --- | Construct a Shelley bootstrap witness (i.e. a Byron key witness in the --- Shelley era). -mkShelleyBootstrapWitness - :: () - => ShelleyBasedEra era - -> Maybe NetworkId - -> TxBody era - -> ShelleyBootstrapWitnessSigningKeyData - -> Either BootstrapWitnessError (KeyWitness era) -mkShelleyBootstrapWitness _ Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = - Left MissingNetworkIdOrByronAddressError -mkShelleyBootstrapWitness sbe (Just nw) txBody (ShelleyBootstrapWitnessSigningKeyData skey Nothing) = - Right $ makeShelleyBootstrapWitness sbe (Byron.WitnessNetworkId nw) txBody skey -mkShelleyBootstrapWitness sbe _ txBody (ShelleyBootstrapWitnessSigningKeyData skey (Just addr)) = - Right $ makeShelleyBootstrapWitness sbe (Byron.WitnessByronAddress addr) txBody skey - --- | Attempt to construct Shelley bootstrap witnesses until an error is --- encountered. -mkShelleyBootstrapWitnesses - :: () - => ShelleyBasedEra era - -> Maybe NetworkId - -> TxBody era - -> [ShelleyBootstrapWitnessSigningKeyData] - -> Either BootstrapWitnessError [KeyWitness era] -mkShelleyBootstrapWitnesses sbe mnw txBody = - mapM (mkShelleyBootstrapWitness sbe mnw txBody) - -- ---------------------------------------------------------------------------- -- Other misc small commands -- @@ -1857,7 +1829,7 @@ runTransactionWitnessCmd readFileTxBody txbodyFile case unwitnessed of IncompleteCddlTxBody anyTxBody -> do - InAnyShelleyBasedEra sbe txbody <- pure anyTxBody + InAnyShelleyBasedEra sbe txbody@(ShelleyTxBody _ ledgerTxBody _ _ _ _) <- pure anyTxBody someWit <- firstExceptT TxCmdReadWitnessSigningDataError . newExceptT @@ -1867,9 +1839,8 @@ runTransactionWitnessCmd -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. AByronWitness bootstrapWitData -> - firstExceptT TxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitness sbe mNetworkId txbody bootstrapWitData + firstExceptT TxCmdBootstrapWitnessError . liftEither $ + mkShelleyBootstrapWitness sbe mNetworkId ledgerTxBody bootstrapWitData AShelleyKeyWitness skShelley -> pure $ makeShelleyKeyWitness sbe txbody skShelley diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 18af459324..5936bbdb03 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -40,6 +40,7 @@ module Cardano.CLI.Read , renderReadWitnessSigningDataError , SomeSigningWitness (..) , ByronOrShelleyWitness (..) + , mkShelleyBootstrapWitness , ShelleyBootstrapWitnessSigningKeyData (..) , CddlWitnessError (..) , readFileTxKeyWitness @@ -95,6 +96,7 @@ module Cardano.CLI.Read where import Cardano.Api as Api +import Cardano.Api.Byron qualified as Byron import Cardano.Api.Ledger qualified as L import Cardano.Api.Shelley as Api @@ -108,6 +110,7 @@ import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.EraBased.Script.Vote.Read import Cardano.CLI.EraBased.Script.Vote.Type import Cardano.CLI.Type.Common +import Cardano.CLI.Type.Error.BootstrapWitnessError import Cardano.CLI.Type.Error.DelegationError import Cardano.CLI.Type.Error.PlutusScriptDecodeError import Cardano.CLI.Type.Error.ScriptDataError @@ -116,6 +119,7 @@ import Cardano.CLI.Type.Error.StakeCredentialError import Cardano.CLI.Type.Governance import Cardano.CLI.Type.Key import Cardano.Crypto.Hash qualified as Crypto +import Cardano.Ledger.Api qualified as L import Prelude @@ -520,6 +524,22 @@ data ShelleyBootstrapWitnessSigningKeyData -- If specified, both the network ID and derivation path are extracted -- from the address and used in the construction of the Byron witness. +-- | Construct a Shelley bootstrap witness (i.e. a Byron key witness in the +-- Shelley era). +mkShelleyBootstrapWitness + :: () + => ShelleyBasedEra era + -> Maybe NetworkId + -> L.TxBody (ShelleyLedgerEra era) + -> ShelleyBootstrapWitnessSigningKeyData + -> Either BootstrapWitnessError (KeyWitness era) +mkShelleyBootstrapWitness _ Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = + Left MissingNetworkIdOrByronAddressError +mkShelleyBootstrapWitness sbe (Just nw) txBody (ShelleyBootstrapWitnessSigningKeyData skey Nothing) = + Right $ makeShelleyBasedBootstrapWitness sbe (Byron.WitnessNetworkId nw) txBody skey +mkShelleyBootstrapWitness sbe _ txBody (ShelleyBootstrapWitnessSigningKeyData skey (Just addr)) = + Right $ makeShelleyBasedBootstrapWitness sbe (Byron.WitnessByronAddress addr) txBody skey + -- | Some kind of Byron or Shelley witness. data ByronOrShelleyWitness = AByronWitness !ShelleyBootstrapWitnessSigningKeyData diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/Transaction/Build.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/Transaction/Build.hs index 2667e7c7ae..d49730dc7c 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/Transaction/Build.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Compatible/Transaction/Build.hs @@ -5,6 +5,7 @@ module Test.Cli.Compatible.Transaction.Build where import Cardano.Api.Internal.Eras import Cardano.Api.Internal.Pretty +import Control.Monad import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class import Data.Aeson (Value) @@ -17,13 +18,17 @@ import Test.Cardano.CLI.Util import Hedgehog import Hedgehog.Extras qualified as H +import Hedgehog.Extras.Test.Golden qualified as H + +inputDir :: FilePath +inputDir = "test/cardano-cli-test/files/input/" -- | Execute me with: -- @cabal test cardano-cli-test --test-options '-p "/conway transaction build one voter many votes/"'@ hprop_compatible_conway_transaction_build_one_voter_many_votes :: Property hprop_compatible_conway_transaction_build_one_voter_many_votes = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do - refOutFile <- H.noteTempFile tempDir "reference_tx.traw" - outFile <- H.noteTempFile tempDir "tx.traw" + refOutFile <- H.noteTempFile tempDir "reference.tx.json" + outFile <- H.noteTempFile tempDir "txbody.tx.json" let eraName = map toLower . docToString $ pretty ConwayEra let args = @@ -34,9 +39,9 @@ hprop_compatible_conway_transaction_build_one_voter_many_votes = watchdogProp . , "--fee" , "178569" , "--certificate-file" - , "test/cardano-cli-test/files/input/certificate/stake-address-registration.json" + , inputDir <> "certificate/stake-address-registration.json" , "--certificate-script-file" - , "test/cardano-cli-test/files/input/plutus/v1-always-succeeds.plutus" + , inputDir <> "plutus/v1-always-succeeds.plutus" , "--certificate-redeemer-value" , "0" , "--certificate-execution-units" @@ -70,6 +75,160 @@ hprop_compatible_conway_transaction_build_one_voter_many_votes = watchdogProp . assertTxFilesEqual refOutFile outFile +hprop_compatible_shelley_create_update_proposal :: Property +hprop_compatible_shelley_create_update_proposal = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + refOutFile <- H.noteTempFile tempDir "ref_update-proposal_allegra.proposal" + outFile <- H.noteTempFile tempDir "update_proposal_allegra.proposal" + let eraName = map toLower . docToString $ pretty ShelleyEra + + let args = + [ "--epoch" + , "1" + , "--genesis-verification-key-file" + , inputDir <> "genesis1.vkey" + , "--protocol-major-version" + , "3" + , "--protocol-minor-version" + , "0" + ] + + -- reference transaction + _ <- + execCardanoCLI $ + [ "legacy" + , "governance" + , "create-update-proposal" + ] + <> args + <> [ "--out-file" + , refOutFile + ] + + -- tested compatible transaction + _ <- + execCardanoCLI $ + [ "compatible" + , eraName + , "governance" + , "action" + , "create-protocol-parameters-update" + ] + <> args + <> [ "--out-file" + , outFile + ] + + H.diffFileVsGoldenFile outFile refOutFile + +hprop_compatible_shelley_transaction :: Property +hprop_compatible_shelley_transaction = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + refOutFile <- H.noteTempFile tempDir "reference_tx.tx.json" + outFile <- H.noteTempFile tempDir "tx.tx.json" + let eraName = map toLower . docToString $ pretty ShelleyEra + + let args = + [ "--fee" + , "5000000" + , "--tx-in" + , "596e9836a4f42661d66deb7993e4e5da310b688e85facc50fee2462e611a0c94#0" + , "--tx-out" + , "2657WMsDfac7RXyZU5nkYxPvZAh7u96FN4cp6w6581zJUR4vKUr3kofjd8MuFghFS+35999999995000000" + , "--update-proposal-file" + , inputDir <> "shelley/update-proposal.json" + ] + + -- reference transaction + void . execCardanoCLI $ + [ eraName + , "transaction" + , "build-raw" + ] + <> args + <> [ "--out-file" + , refOutFile + ] + + -- tested compatible transaction + void . execCardanoCLI $ + [ "compatible" + , eraName + , "transaction" + , "signed-transaction" + ] + <> args + <> [ "--out-file" + , outFile + ] + + assertTxFilesEqual refOutFile outFile + +hprop_compatible_shelley_signed_transaction :: Property +hprop_compatible_shelley_signed_transaction = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + refOutFile <- H.noteTempFile tempDir "reference_tx.tx.json" + refTxBody <- H.noteTempFile tempDir "reference_tx.txbody.json" + outFile <- H.noteTempFile tempDir "tx.tx.json" + let eraName = map toLower . docToString $ pretty ShelleyEra + + let args = + [ "--fee" + , "5000000" + , "--tx-in" + , "596e9836a4f42661d66deb7993e4e5da310b688e85facc50fee2462e611a0c94#0" + , "--tx-out" + , "2657WMsDfac7RXyZU5nkYxPvZAh7u96FN4cp6w6581zJUR4vKUr3kofjd8MuFghFS+35999999995000000" + , "--update-proposal-file" + , inputDir <> "shelley/update-proposal.json" + ] + signArgs = + [ "--signing-key-file" + , inputDir <> "delegate1.skey" + , "--signing-key-file" + , inputDir <> "genesis1.skey" + , "--signing-key-file" + , inputDir <> "byron/payment.skey" + , "--testnet-magic" + , "42" + ] + + -- reference transaction + void . execCardanoCLI $ + [ eraName + , "transaction" + , "build-raw" + ] + <> args + <> [ "--out-file" + , refTxBody + ] + + -- sign reference transaction + void . execCardanoCLI $ + [ eraName + , "transaction" + , "sign" + ] + <> signArgs + <> [ "--tx-body-file" + , refTxBody + , "--out-file" + , refOutFile + ] + + -- tested compatible transaction + void . execCardanoCLI $ + [ "compatible" + , eraName + , "transaction" + , "signed-transaction" + ] + <> args + <> signArgs + <> [ "--out-file" + , outFile + ] + + assertTxFilesEqual refOutFile outFile + assertTxFilesEqual :: forall m . (HasCallStack, MonadIO m, MonadTest m, MonadCatch m) @@ -94,6 +253,6 @@ assertTxFilesEqual f1 f2 = withFrozenCallStack $ do [ "debug" , "transaction" , "view" - , "--tx-body-file" + , "--tx-file" , f ] diff --git a/cardano-cli/test/cardano-cli-test/files/input/byron/payment.skey b/cardano-cli/test/cardano-cli-test/files/input/byron/payment.skey new file mode 100644 index 0000000000..84784ca2a2 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/files/input/byron/payment.skey @@ -0,0 +1,5 @@ +{ + "type": "PaymentSigningKeyByron_ed25519_bip32", + "description": "", + "cborHex": "588070806d8da0a77c8a1cd139bddf3d52c361c4c9d554433ca04491d8f69ef6ef4856a061841d5ca8e0aab6aac6eed0e004a65adc21f1df36836fb8d02a60784eee294e3192b8ecdd9b8d3a74c182171accaffa4e059b31be6a781aab34d0c912e26cec5da9274e8b6a970f740a30d571d66d2b28a57c7266294b663d72e4c7fc0f" +} diff --git a/cardano-cli/test/cardano-cli-test/files/input/delegate1.skey b/cardano-cli/test/cardano-cli-test/files/input/delegate1.skey new file mode 100644 index 0000000000..1cb6338794 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/files/input/delegate1.skey @@ -0,0 +1,5 @@ +{ + "type": "GenesisDelegateSigningKey_ed25519", + "description": "Genesis delegate operator key", + "cborHex": "5820423d671214097da94e309969f6847bd9d3134b8f45cee3c3d77a175f67a7e2ab" +} diff --git a/cardano-cli/test/cardano-cli-test/files/input/genesis1.skey b/cardano-cli/test/cardano-cli-test/files/input/genesis1.skey new file mode 100644 index 0000000000..af079b7e96 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/files/input/genesis1.skey @@ -0,0 +1,5 @@ +{ + "type": "GenesisSigningKey_ed25519", + "description": "Genesis Signing Key", + "cborHex": "5820e657de1f4f98d87c64e2eedef8b2b590342b8f16d77ab043faec2cfb16420a50" +} diff --git a/cardano-cli/test/cardano-cli-test/files/input/genesis1.vkey b/cardano-cli/test/cardano-cli-test/files/input/genesis1.vkey new file mode 100644 index 0000000000..1c8aa8eb0d --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/files/input/genesis1.vkey @@ -0,0 +1,5 @@ +{ + "type": "GenesisVerificationKey_ed25519", + "description": "Genesis Verification Key", + "cborHex": "5820da706def2349274e5ccaac07b7ab4d8aa807ef22a3971a6775a65b6cfd4717f7" +} diff --git a/cardano-cli/test/cardano-cli-test/files/input/shelley/update-proposal.json b/cardano-cli/test/cardano-cli-test/files/input/shelley/update-proposal.json new file mode 100644 index 0000000000..5333c5f335 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/files/input/shelley/update-proposal.json @@ -0,0 +1,5 @@ +{ + "type": "UpdateProposalShelley", + "description": "", + "cborHex": "82a1581c29a791a82b48398c90acedc363c1588590d787e94c32fa82db89d681981a8182030080808080808080808080808080808080a08080808080808001" +} diff --git a/flake.lock b/flake.lock index 117daf4222..59fce8df94 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1739645821, - "narHash": "sha256-HjAchUMLsiScm8Jyd+I/5YJKUjDp1r+XFzr05d+o+r4=", + "lastModified": 1740749460, + "narHash": "sha256-7QyqzhhQMkj5DA3WnCC9yMjhFJLx0GMlBhFbqYjbwrs=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "48b941c5729384f38b79c6f473ddbf920cb310ea", + "rev": "831721789ac7881a774d9e0028ff290a99995043", "type": "github" }, "original": {