Fix witness error in compatible transaction transaction-sign in shell…

…ey era Add test: compatible shelley transaction signed-transaction results in different witnesses than legacy command
IntersectMBO · Feb 11, 2025 · 1897e91 · 1897e91
1 parent b0fa19d
commit 1897e91
Show file tree

Hide file tree

Showing 12 changed files with 203 additions and 72 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -324,7 +324,7 @@ test-suite cardano-cli-test
     base16-bytestring,
     bech32 >=1.1.0,
     bytestring,
-    cardano-api:{cardano-api, gen, internal},
+    cardano-api:{cardano-api, gen},
     cardano-cli,
     cardano-cli:cardano-cli-test-lib,
     cardano-slotting,

diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
+-- TODO split this into separate modules
 module Cardano.CLI.Compatible.Transaction
   ( CompatibleTransactionCmds (..)
   , CompatibleTransactionError (..)
@@ -15,7 +16,7 @@ module Cardano.CLI.Compatible.Transaction
 where
 
 import           Cardano.Api
-import           Cardano.Api.Compatible
+import           Cardano.Api.Compatible as Compatible
 import           Cardano.Api.Ledger hiding (TxIn, VotingProcedures)
 import           Cardano.Api.Shelley hiding (VotingProcedures)
 
@@ -34,13 +35,8 @@ import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.BootstrapWitnessError
 import           Cardano.CLI.Types.Errors.TxCmdError
 import           Cardano.CLI.Types.Governance
-import           Cardano.CLI.Types.TxFeature
 
-import           Data.Bifunctor (first)
 import           Data.Foldable
-import           Data.Function
-import qualified Data.Map.Strict as Map
-import           Data.Maybe
 import           Data.Text (Text)
 import           Options.Applicative
 import qualified Options.Applicative as Opt
@@ -279,69 +275,28 @@ runCompatibleTransactionCmd
         )
         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 _ (BuildTxWith proposalMap)) <- [protocolUpdates]
-          , sWit <- Map.elems proposalMap
-          , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit
-          ]
-
-    validatedRefInputs <-
-      liftEither . first CompatibleTxCmdError . validateTxInsReference $
-        certsRefInputs <> votesRefInputs <> proposalsRefInputs
     let txCerts = mkTxCertificates sbe certsAndMaybeScriptWits
 
-    -- this body is only for witnesses
-    apiTxBody <-
-      firstExceptT CompatibleTxBodyError $
-        hoistEither $
-          createTransactionBody sbe $
-            defaultTxBodyContent sbe
-              & setTxIns (map (,BuildTxWith (KeyWitness KeyWitnessForSpending)) ins)
-              & setTxOuts allOuts
-              & setTxFee (TxFeeExplicit sbe fee)
-              & setTxCertificates txCerts
-              & setTxInsReference validatedRefInputs
+    transaction <-
+      firstExceptT CompatiblePParamsConversionError . hoistEither $
+        createCompatibleTx sbe ins allOuts fee protocolUpdates votes txCerts
+
+    let apiTxBody = getTxBody transaction
 
     let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks
 
     byronWitnesses <-
       firstExceptT CompatibleBootstrapWitnessError . hoistEither $
         mkShelleyBootstrapWitnesses sbe mNetworkId apiTxBody sksByron
 
-    let newShelleyKeyWits = map (makeShelleyKeyWitness sbe apiTxBody) sksShelley
+    let newShelleyKeyWits = makeShelleyKeyWitness sbe apiTxBody <$> sksShelley
         allKeyWits = newShelleyKeyWits ++ byronWitnesses
 
-    signedTx <-
-      firstExceptT CompatiblePParamsConversionError . hoistEither $
-        createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes txCerts
+    let signedTx = Compatible.makeSignedTransaction allKeyWits apiTxBody
 
     firstExceptT CompatibleFileError $
       newExceptT $
         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
 
 readUpdateProposalFile
   :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -1426,9 +1426,9 @@ runTransactionSignCmd
 runTransactionSignCmd
   Cmd.TransactionSignCmdArgs
     { txOrTxBodyFile = txOrTxBody
-    , witnessSigningData = witnessSigningData
-    , mNetworkId = mNetworkId
-    , outTxFile = outTxFile
+    , witnessSigningData
+    , mNetworkId
+    , outTxFile
     } = do
     sks <- forM witnessSigningData $ \d ->
       lift (readWitnessSigningData d)

diff --git a/cardano-cli/src/Cardano/CLI/Orphans.hs b/cardano-cli/src/Cardano/CLI/Orphans.hs
@@ -32,6 +32,3 @@ instance ToJSON HashableScriptData where
       [ "hash" .= hashScriptDataBytes hsd
       , "json" .= scriptDataToJsonDetailedSchema hsd
       ]
-
--- TODO move LocalNodeConnectInfo instances to cardano-api
-deriving instance Show LocalNodeConnectInfo
diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/AddCostModels.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/AddCostModels.hs
@@ -3,9 +3,9 @@
 module Test.Cli.AddCostModels where
 
 import           Cardano.Api
+import           Cardano.Api.Internal.ProtocolParameters
 import           Cardano.Api.Ledger (StrictMaybe (..))
 import qualified Cardano.Api.Ledger as L
-import           Cardano.Api.ProtocolParameters
 
 import           Cardano.CLI.EraBased.Run.Governance.Actions
 

diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/FilePermissions.hs
@@ -6,7 +6,7 @@ module Test.Cli.FilePermissions
 where
 
 import           Cardano.Api
-import           Cardano.Api.IO (checkVrfFilePermissions)
+import           Cardano.Api.Internal.IO (checkVrfFilePermissions)
 
 import           Control.Monad (void)
 

diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs
@@ -2,31 +2,31 @@
 
 module Test.Cli.Shelley.Transaction.Compatible.Build where
 
-import           Cardano.Api.Eras
-import           Cardano.Api.Pretty
+import           Cardano.Api hiding (Value)
 
 import           Control.Monad.Catch (MonadCatch)
-import           Control.Monad.IO.Class
 import           Data.Aeson (Value)
 import qualified Data.Aeson as A
 import           Data.Char (toLower)
+import           Data.Functor
 import           Data.String (IsString (..))
 import           GHC.Stack
 
 import           Test.Cardano.CLI.Util
 
 import           Hedgehog
 import qualified Hedgehog.Extras as H
+import qualified Hedgehog.Extras.Test.Golden as H
 
 inputDir :: FilePath
-inputDir = "test/cardano-cli-test/files/input/shelley/transaction"
+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 = 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.txbody.json"
+  outFile <- H.noteTempFile tempDir "txbody.tx.json"
   let eraName = map toLower . docToString $ pretty ConwayEra
 
   let args =
@@ -37,9 +37,9 @@ hprop_compatible_conway_transaction_build_one_voter_many_votes = propertyOnce $
         , "--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"
@@ -73,6 +73,160 @@ hprop_compatible_conway_transaction_build_one_voter_many_votes = propertyOnce $
 
   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)
@@ -97,6 +251,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
@@ -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
@@ -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
@@ -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
@@ -0,0 +1,5 @@
+{
+    "type": "GenesisVerificationKey_ed25519",
+    "description": "Genesis Verification Key",
+    "cborHex": "5820da706def2349274e5ccaac07b7ab4d8aa807ef22a3971a6775a65b6cfd4717f7"
+}