Merge pull request #826 from IntersectMBO/smelc/tx-build-no-donation-…

…then-no-current-treasury-value

transaction-build and build-estimate: include current treasury value only if a donation is being done

cardano-cli/cardano-cli.cabal

@@ -388,6 +388,7 @@ test-suite cardano-cli-golden
                         Test.Golden.CreateStaked
                         Test.Golden.CreateTestnetData
                         Test.Golden.Conway.Transaction.Assemble
+                        Test.Golden.Conway.Transaction.BuildRaw
                         Test.Golden.EraBased.Governance.AnswerPoll
                         Test.Golden.EraBased.Governance.CreatePoll
                         Test.Golden.EraBased.Governance.VerifyPoll

cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs

@@ -80,8 +80,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   , mUpdateProprosalFile  :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
   , voteFiles             :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , proposalFiles         :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
-  , currentTreasuryValue  :: !(Maybe TxCurrentTreasuryValue)
-  , treasuryDonation      :: !(Maybe TxTreasuryDonation)
+  , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
   , txBodyOutFile         :: !(TxBodyFile Out)
   } deriving Show
 
@@ -177,8 +176,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   , mUpdateProposalFile      :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
   , voteFiles                :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   , proposalFiles            :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
-  , currentTreasuryValue     :: !(Maybe TxCurrentTreasuryValue)
-  , treasuryDonation         :: !(Maybe TxTreasuryDonation)
+  , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
   , txBodyOutFile            :: !(TxBodyFile Out)
   }
 

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -1208,31 +1208,34 @@ pProposalFile balExUnits =
        Nothing
        "a proposal"
 
-pCurrentTreasuryValue :: ShelleyBasedEra era -> Parser (Maybe TxCurrentTreasuryValue)
-pCurrentTreasuryValue =
+pCurrentTreasuryValueAndDonation :: ShelleyBasedEra era -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
+pCurrentTreasuryValueAndDonation sbe =
   caseShelleyToBabbageOrConwayEraOnwards
     (const $ pure Nothing)
-    (const $ optional $ TxCurrentTreasuryValue <$> coinParser)
-  where
-    coinParser :: Parser L.Coin =
-      Opt.option (readerFromParsecParser parseLovelace) $ mconcat
-        [ Opt.long "current-treasury-value"
-        , Opt.metavar "LOVELACE"
-        , Opt.help "The current treasury value."
-        ]
+    (const $ optional ((,) <$> pCurrentTreasuryValue' <*> pTreasuryDonation'))
+    sbe
+
+pCurrentTreasuryValue' :: Parser TxCurrentTreasuryValue
+pCurrentTreasuryValue' =
+  TxCurrentTreasuryValue <$> (Opt.option (readerFromParsecParser parseLovelace) $ mconcat
+    [ Opt.long "current-treasury-value"
+    , Opt.metavar "LOVELACE"
+    , Opt.help "The current treasury value."
+    ])
 
 pTreasuryDonation :: ShelleyBasedEra era -> Parser (Maybe TxTreasuryDonation)
 pTreasuryDonation =
   caseShelleyToBabbageOrConwayEraOnwards
     (const $ pure Nothing)
-    (const $ optional $ TxTreasuryDonation <$> coinParser)
-  where
-    coinParser :: Parser L.Coin =
-      Opt.option (readerFromParsecParser parseLovelace) $ mconcat
-        [ Opt.long "treasury-donation"
-        , Opt.metavar "LOVELACE"
-        , Opt.help "The donation to the treasury to perform."
-        ]
+    (const $ optional pTreasuryDonation')
+
+pTreasuryDonation' :: Parser TxTreasuryDonation
+pTreasuryDonation' =
+  TxTreasuryDonation <$> (Opt.option (readerFromParsecParser parseLovelace) $ mconcat
+    [ Opt.long "treasury-donation"
+    , Opt.metavar "LOVELACE"
+    , Opt.help "The donation to the treasury to perform."
+    ])
 
 --------------------------------------------------------------------------------
 

cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs

@@ -238,8 +238,7 @@ pTransactionBuildEstimateCmd era _envCli = do
           <*> pFeatured (toCardanoEra sbe) (optional pUpdateProposalFile)
           <*> pVoteFiles sbe ManualBalance
           <*> pProposalFiles sbe ManualBalance
-          <*> pCurrentTreasuryValue sbe
-          <*> pTreasuryDonation sbe
+          <*> pCurrentTreasuryValueAndDonation sbe
           <*> pTxBodyFileOut
 
 pChangeAddress :: Parser TxOutChangeAddress
@@ -275,8 +274,7 @@ pTransactionBuildRaw era =
       <*> pFeatured era (optional pUpdateProposalFile)
       <*> pVoteFiles era ManualBalance
       <*> pProposalFiles era ManualBalance
-      <*> pCurrentTreasuryValue era
-      <*> pTreasuryDonation era
+      <*> pCurrentTreasuryValueAndDonation era
       <*> pTxBodyFileOut
 
 pTransactionSign  :: EnvCli -> Parser (TransactionCmds era)

cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs

@@ -128,7 +128,7 @@ runTransactionBuildCmd
       , mUpdateProposalFile
       , voteFiles
       , proposalFiles
-      , treasuryDonation
+      , treasuryDonation -- Maybe TxTreasuryDonation
       , buildOutputOptions
       } = shelleyBasedEraConstraints eon $ do
   let era = toCardanoEra eon
@@ -206,6 +206,12 @@ runTransactionBuildCmd
       & onLeft (left . TxCmdQueryConvenienceError . AcqFailure)
       & onLeft (left . TxCmdQueryConvenienceError)
 
+  let currentTreasuryValueAndDonation =
+        case (treasuryDonation, unFeatured <$> featuredCurrentTreasuryValueM) of
+          (Nothing, _) -> Nothing -- We shouldn't specify the treasury value when no donation is being done
+          (Just _td, Nothing) -> Nothing -- TODO: Current treasury value couldn't be obtained but is required: we should fail suggesting that the node's version is too old
+          (Just td, Just ctv) -> Just (ctv, td)
+
   -- We need to construct the txBodycontent outside of runTxBuild
   BalancedTxBody txBodyContent balancedTxBody _ _ <-
     runTxBuild
@@ -214,7 +220,7 @@ runTransactionBuildCmd
       mValidityLowerBound mValidityUpperBound certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits
       requiredSigners txAuxScripts txMetadata mProp mOverrideWitnesses votingProceduresAndMaybeScriptWits
       proposals
-      (unFeatured <$> featuredCurrentTreasuryValueM) treasuryDonation
+      currentTreasuryValueAndDonation
 
   -- TODO: Calculating the script cost should live as a different command.
   -- Why? Because then we can simply read a txbody and figure out
@@ -255,7 +261,7 @@ runTransactionBuildEstimateCmd
   :: ()
   => Cmd.TransactionBuildEstimateCmdArgs era
   -> ExceptT TxCmdError IO ()
-runTransactionBuildEstimateCmd
+runTransactionBuildEstimateCmd -- TODO change type
   Cmd.TransactionBuildEstimateCmdArgs
     { eon
     , mScriptValidity
@@ -283,8 +289,7 @@ runTransactionBuildEstimateCmd
     , proposalFiles
     , plutusCollateral
     , totalReferenceScriptSize
-    , currentTreasuryValue
-    , treasuryDonation
+    , currentTreasuryValueAndDonation
     , txBodyOutFile
     } = do
   let sbe = maryEraOnwardsToShelleyBasedEra eon
@@ -358,8 +363,7 @@ runTransactionBuildEstimateCmd
                      txUpdateProposal
                      votingProceduresAndMaybeScriptWits
                      proposals
-                     currentTreasuryValue
-                     treasuryDonation
+                     currentTreasuryValueAndDonation
   let stakeCredentialsToDeregisterMap = Map.fromList $ catMaybes [getStakeDeregistrationInfo cert | (cert,_) <- certsAndMaybeScriptWits]
       drepsToDeregisterMap = Map.fromList $ catMaybes [getDRepDeregistrationInfo cert | (cert,_) <- certsAndMaybeScriptWits]
       poolsToDeregister = Set.fromList $ catMaybes [getPoolDeregistrationInfo cert | (cert,_) <- certsAndMaybeScriptWits]
@@ -492,9 +496,8 @@ runTransactionBuildRawCmd
       , mUpdateProprosalFile
       , voteFiles
       , proposalFiles
+      , currentTreasuryValueAndDonation
       , txBodyOutFile
-      , currentTreasuryValue
-      , treasuryDonation
       } = do
   inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError
                                 $ readScriptWitnessFiles eon txIns
@@ -553,7 +556,7 @@ runTransactionBuildRawCmd
       mReturnCollateral mTotalCollateral txOuts mValidityLowerBound mValidityUpperBound fee valuesWithScriptWits
       certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits requiredSigners txAuxScripts
       txMetadata mLedgerPParams txUpdateProposal votingProceduresAndMaybeScriptWits proposals
-      currentTreasuryValue treasuryDonation
+      currentTreasuryValueAndDonation
 
   let noWitTx = makeSignedTransaction [] txBody
   lift (writeTxFileTextEnvelopeCddl eon txBodyOutFile noWitTx)
@@ -594,8 +597,7 @@ runTxBuildRaw :: ()
   -> TxUpdateProposal era
   -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
   -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-  -> Maybe TxCurrentTreasuryValue
-  -> Maybe TxTreasuryDonation
+  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
   -> Either TxCmdError (TxBody era)
 runTxBuildRaw sbe
               mScriptValidity inputsAndMaybeScriptWits
@@ -605,12 +607,12 @@ runTxBuildRaw sbe
               fee valuesWithScriptWits
               certsAndMaybeSriptWits withdrawals reqSigners
               txAuxScripts txMetadata mpparams txUpdateProposal votingProcedures proposals
-              mCurrentTreasuryValue mTreasuryDonation = do
+              mCurrentTreasuryValueAndDonation = do
 
     txBodyContent <- constructTxBodyContent sbe mScriptValidity (unLedgerProtocolParameters <$> mpparams) inputsAndMaybeScriptWits readOnlyRefIns txinsc
                       mReturnCollateral mTotCollateral txouts mLowerBound mUpperBound valuesWithScriptWits
                       certsAndMaybeSriptWits withdrawals reqSigners fee txAuxScripts txMetadata txUpdateProposal
-                      votingProcedures proposals mCurrentTreasuryValue mTreasuryDonation
+                      votingProcedures proposals mCurrentTreasuryValueAndDonation
 
     first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent
 
@@ -649,14 +651,16 @@ constructTxBodyContent
   -> TxUpdateProposal era
   -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
   -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-  -> Maybe TxCurrentTreasuryValue
-  -> Maybe TxTreasuryDonation
+  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
+  -- ^ The current treasury value and the donation. This is a stop gap as the
+  -- semantics of the donation and treasury value depend on the script languages
+  -- being used.
   -> Either TxCmdError (TxBodyContent BuildTx era)
 constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits readOnlyRefIns txinsc
                        mReturnCollateral mTotCollateral txouts mLowerBound mUpperBound
                        valuesWithScriptWits certsAndMaybeScriptWits withdrawals
                        reqSigners fee txAuxScripts txMetadata txUpdateProposal
-                       votingProcedures proposals mCurrentTreasuryValue mTreasuryDonation
+                       votingProcedures proposals mCurrentTreasuryValueAndDonation
                        = do
   let allReferenceInputs = getAllReferenceInputs
                              inputsAndMaybeScriptWits
@@ -677,8 +681,8 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea
   validatedMintValue <- createTxMintValue sbe valuesWithScriptWits
   validatedTxScriptValidity <- first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity sbe mScriptValidity
   validatedVotingProcedures <- first TxCmdTxGovDuplicateVotes $ convertToTxVotingProcedures votingProcedures
-  validatedCurrentTreasuryValue <- first TxCmdNotSupportedInEraValidationError (validateTxCurrentTreasuryValue sbe mCurrentTreasuryValue)
-  validatedTreasuryDonation <- first TxCmdNotSupportedInEraValidationError (validateTxTreasuryDonation sbe mTreasuryDonation)
+  validatedCurrentTreasuryValue <- first TxCmdNotSupportedInEraValidationError (validateTxCurrentTreasuryValue sbe (fst <$> mCurrentTreasuryValueAndDonation))
+  validatedTreasuryDonation <- first TxCmdNotSupportedInEraValidationError (validateTxTreasuryDonation sbe (snd <$> mCurrentTreasuryValueAndDonation))
   return $ shelleyBasedEraConstraints sbe $ (defaultTxBodyContent sbe
              & setTxIns (validateTxIns inputsAndMaybeScriptWits)
              & setTxInsCollateral validatedCollateralTxIns
@@ -750,16 +754,16 @@ runTxBuild :: ()
   -> Maybe Word
   -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
   -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-  -> Maybe TxCurrentTreasuryValue
-  -> Maybe TxTreasuryDonation
+  -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)
+  -- ^ The current treasury value and the donation.
   -> ExceptT TxCmdError IO (BalancedTxBody era)
 runTxBuild
     sbe socketPath networkId mScriptValidity
     inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts
     (TxOutChangeAddress changeAddr) valuesWithScriptWits mLowerBound mUpperBound
     certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata
     txUpdateProposal mOverrideWits votingProcedures proposals
-    mCurrentTreasuryValue mTreasuryDonation =
+    mCurrentTreasuryValueAndDonation =
     shelleyBasedEraConstraints sbe $ do
 
   -- TODO: All functions should be parameterized by ShelleyBasedEra
@@ -821,7 +825,7 @@ runTxBuild
                      txMetadata
                      txUpdateProposal
                      votingProcedures proposals
-                     mCurrentTreasuryValue mTreasuryDonation
+                     mCurrentTreasuryValueAndDonation
 
   firstExceptT TxCmdTxInsDoNotExist
     . hoistEither $ txInsExistInUTxO allTxInputs txEraUtxo

cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs

@@ -180,7 +180,7 @@ runLegacyTransactionBuildRawCmd
              sbe mScriptValidity txins readOnlyRefIns txinsc mReturnColl
              mTotColl reqSigners txouts mValue mLowBound upperBound fee certs wdrls
              metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpdateProposalFile [] []
-             Nothing Nothing
+             Nothing
              outFile
          )
          )

cardano-cli/test/cardano-cli-golden/Test/Golden/Conway/Transaction/BuildRaw.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.Golden.Conway.Transaction.BuildRaw where
+
+import           Control.Monad (void)
+
+import           Test.Cardano.CLI.Util
+
+import           Hedgehog (Property)
+import qualified Hedgehog.Extras.Test.Base as H
+import qualified Hedgehog.Extras.Test.Golden as H
+
+{- HLINT ignore "Use camelCase" -}
+
+-- | Execute me with:
+-- @cabal test cardano-cli-golden --test-options '-p "/golden conway build raw treasury donation/"'@
+hprop_golden_conway_build_raw_treasury_donation :: Property
+hprop_golden_conway_build_raw_treasury_donation = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
+  let goldenFile = "test/cardano-cli-golden/files/golden/conway/build-raw-out.tx"
+
+  -- Key filepaths
+  outFile <- noteTempFile tempDir "out.json"
+
+  void $ execCardanoCLI
+    [ "conway", "transaction", "build-raw"
+    , "--tx-in", "f62cd7bc15d8c6d2c8519fb8d13c57c0157ab6bab50af62bc63706feb966393d#0"
+    , "--tx-out", "addr_test1qpmxr8d8jcl25kyz2tz9a9sxv7jxglhddyf475045y8j3zxjcg9vquzkljyfn3rasfwwlkwu7hhm59gzxmsyxf3w9dps8832xh+1199989833223"
+    , "--tx-out", "addr_test1vpqgspvmh6m2m5pwangvdg499srfzre2dd96qq57nlnw6yctpasy4+10000000"
+    , "--current-treasury-value", "543"
+    , "--treasury-donation", "1000343"
+    , "--fee", "166777"
+    , "--out-file", outFile
+    ]
+
+  H.diffFileVsGoldenFile outFile goldenFile
+

cardano-cli/test/cardano-cli-golden/files/golden/conway/build-raw-out.tx

@@ -0,0 +1,5 @@
+{
+    "type": "Unwitnessed Tx ConwayEra",
+    "description": "Ledger Cddl Format",
+    "cborHex": "84a500d9010281825820f62cd7bc15d8c6d2c8519fb8d13c57c0157ab6bab50af62bc63706feb966393d0001828258390076619da7963eaa588252c45e960667a4647eed69135f51f5a10f2888d2c20ac07056fc8899c47d825cefd9dcf5efba150236e043262e2b431b0000011764f7be0782581d604088059bbeb6add02eecd0c6a2a52c06910f2a6b4ba0029e9fe6ed131a00989680021a00028b791519021f161a000f4397a0f5f6"
+}

cardano-cli/test/cardano-cli-golden/files/golden/help.cli

@@ -7816,8 +7816,8 @@ Usage: cardano-cli conway transaction build-raw
                                                         | --proposal-redeemer-value JSON_VALUE
                                                         )
                                                         --proposal-execution-units (INT, INT)]]]
-                                                  [--current-treasury-value LOVELACE]
-                                                  [--treasury-donation LOVELACE]
+                                                  [--current-treasury-value LOVELACE
+                                                    --treasury-donation LOVELACE]
                                                   --out-file FILE
 
   Build a transaction (low-level, inconvenient)
@@ -8101,8 +8101,8 @@ Usage: cardano-cli conway transaction build-estimate
                                                              | --proposal-redeemer-value JSON_VALUE
                                                              )
                                                              --proposal-execution-units (INT, INT)]]]
-                                                       [--current-treasury-value LOVELACE]
-                                                       [--treasury-donation LOVELACE]
+                                                       [--current-treasury-value LOVELACE
+                                                         --treasury-donation LOVELACE]
                                                        --out-file FILE
 
   Build a balanced transaction without access to a live node (automatically estimates fees)

cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-estimate.cli

@@ -139,8 +139,8 @@ Usage: cardano-cli conway transaction build-estimate
                                                              | --proposal-redeemer-value JSON_VALUE
                                                              )
                                                              --proposal-execution-units (INT, INT)]]]
-                                                       [--current-treasury-value LOVELACE]
-                                                       [--treasury-donation LOVELACE]
+                                                       [--current-treasury-value LOVELACE
+                                                         --treasury-donation LOVELACE]
                                                        --out-file FILE
 
   Build a balanced transaction without access to a live node (automatically estimates fees)

cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli

@@ -135,8 +135,8 @@ Usage: cardano-cli conway transaction build-raw
                                                         | --proposal-redeemer-value JSON_VALUE
                                                         )
                                                         --proposal-execution-units (INT, INT)]]]
-                                                  [--current-treasury-value LOVELACE]
-                                                  [--treasury-donation LOVELACE]
+                                                  [--current-treasury-value LOVELACE
+                                                    --treasury-donation LOVELACE]
                                                   --out-file FILE
 
   Build a transaction (low-level, inconvenient)