Expose direct ADA deposits in Dijkstra transaction builders

.changes/20261015_cip159_account_build_flags.yml

@@ -0,0 +1,5 @@
+project: cardano-cli
+pr: 1469
+kind:
+  - feature
+description: Add --direct-deposit STAKE_ADDRESS+LOVELACE to Dijkstra transaction build, build-raw and build-estimate, and sub-transaction build-raw, to deposit ADA into registered accounts. Reject duplicate recipients and include deposits in automatic fee balancing.

cardano-cli/cardano-cli.cabal

@@ -431,6 +431,7 @@ test-suite cardano-cli-test
     Test.Cli.Run.Query
     Test.Cli.Shelley.Genesis.Create
     Test.Cli.Transaction.Build
+    Test.Cli.Transaction.DirectDeposit
     Test.Cli.Transaction.SubTransaction
     Test.Cli.VerificationKey
 

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

@@ -380,6 +380,9 @@ parseLovelace = do
     then fail $ show i <> " lovelace exceeds the Word64 upper bound"
     else return $ L.Coin i
 
+parseStakeAddressAndLovelace :: P.Parser (StakeAddress, Lovelace)
+parseStakeAddressAndLovelace = (,) <$> parseAddressAny <* P.char '+' <*> parseLovelace
+
 parseCoinPerByte :: P.Parser L.CoinPerByte
 parseCoinPerByte = do
   i <- P.parseDecimal
@@ -1500,6 +1503,19 @@ pMetadataFile =
         File <$> parseFilePath "metadata-cbor-file" "Filepath of the metadata, in raw CBOR format."
     ]
 
+-- | Parse repeatable @--direct-deposit STAKE_ADDRESS+LOVELACE@ options for
+-- ADA deposits into registered accounts. Available only in Dijkstra.
+pDirectDeposits :: Exp.Era era -> Parser [(StakeAddress, Lovelace)]
+pDirectDeposits era = case era of
+  Exp.ConwayEra -> pure []
+  Exp.DijkstraEra ->
+    many $
+      Opt.option (readerFromParsecParser parseStakeAddressAndLovelace) $
+        Opt.long "direct-deposit"
+          <> Opt.metavar "STAKE_ADDRESS+LOVELACE"
+          <> Opt.help
+            "Deposit ADA into a registered account. Amount in lovelace; each account may occur once."
+
 pWithdrawalForEra
   :: Exp.Era era
   -> BalanceTxExecUnits
@@ -1522,7 +1538,7 @@ pWithdrawalWithPlutusReferenceLanguage
 pWithdrawalWithPlutusReferenceLanguage pLanguage scriptFileHelp balance =
   (\(stakeAddr, lovelace) maybeScriptFp -> (stakeAddr, lovelace, maybeScriptFp))
     <$> Opt.option
-      (readerFromParsecParser parseWithdrawal)
+      (readerFromParsecParser parseStakeAddressAndLovelace)
       ( Opt.long "withdrawal"
           <> Opt.metavar "WITHDRAWAL"
           <> Opt.help helpText
@@ -1546,10 +1562,6 @@ pWithdrawalWithPlutusReferenceLanguage pLanguage scriptFileHelp balance =
       , "a script witness."
       ]
 
-  parseWithdrawal :: P.Parser (StakeAddress, Lovelace)
-  parseWithdrawal =
-    (,) <$> parseAddressAny <* P.char '+' <*> parseLovelace
-
 pWithdrawalScriptWitness
   :: BalanceTxExecUnits
   -> String

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

@@ -84,6 +84,8 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   , certificates :: ![(CertificateFile, Maybe AnyNonAssetScript)]
   -- ^ Certificates with potential script witness
   , withdrawals :: ![(StakeAddress, Coin, Maybe AnyNonAssetScript)]
+  , directDeposits :: ![(StakeAddress, Coin)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   , metadataSchema :: !TxMetadataJsonSchema
   , scriptFiles :: ![ScriptFile]
   -- ^ Auxiliary scripts
@@ -150,6 +152,8 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   -- ^ Certificates with potential script witness
   , withdrawals :: ![(StakeAddress, Coin, Maybe AnyNonAssetScript)]
   -- ^ Withdrawals with potential script witness
+  , directDeposits :: ![(StakeAddress, Coin)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   , metadataSchema :: !TxMetadataJsonSchema
   , scriptFiles :: ![ScriptFile]
   -- ^ Auxiliary scripts
@@ -197,6 +201,8 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   -- ^ Certificates with potential script witness
   , withdrawals :: ![(StakeAddress, Coin, Maybe AnyNonAssetScript)]
   -- ^ Withdrawals with potential script witness
+  , directDeposits :: ![(StakeAddress, Coin)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   , plutusCollateral :: !(Maybe Coin)
   -- ^ Total collateral
   , totalReferenceScriptSize :: !(Maybe ReferenceScriptSize)

cardano-cli/src/Cardano/CLI/EraBased/Transaction/Internal/Common.hs

@@ -9,6 +9,7 @@ module Cardano.CLI.EraBased.Transaction.Internal.Common
   , getAllReferenceInputs
   , createTxMintValue
   , convertWithdrawals
+  , convertDirectDeposits
   , convertVotingProcedures
   , scriptInEraToSimpleScript
   , partitionSomeWitnesses
@@ -27,6 +28,7 @@ import Cardano.CLI.Compatible.Transaction.TxOut
 import Cardano.CLI.Read
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Error.TxCmdError
+import Cardano.Ledger.Address qualified as L
 import Cardano.Ledger.Hashes (DataHash)
 
 import RIO hiding (toList)
@@ -178,3 +180,13 @@ partitionSomeWitnesses = reversePartitionedWits . Foldable.foldl' go mempty
         (byronWit : byronAcc, shelleyKeyAcc)
       AShelleyKeyWitness shelleyKeyWit ->
         (byronAcc, shelleyKeyWit : shelleyKeyAcc)
+
+-- | Reject duplicate recipients before converting deposits to the ledger map.
+convertDirectDeposits :: [(StakeAddress, Lovelace)] -> Either TxCmdError L.DirectDeposits
+convertDirectDeposits deposits =
+  case [address | address : _ : _ <- List.group (List.sort $ map fst deposits)] of
+    [] ->
+      Right $
+        L.DirectDeposits $
+          Map.fromList [(toShelleyStakeAddr address, amount) | (address, amount) <- deposits]
+    duplicates -> Left $ TxCmdDuplicateDirectDeposits duplicates

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

@@ -210,6 +210,7 @@ pTransactionBuildCmd envCli = do
         <*> pInvalidHereafter era'
         <*> many (pCertificateFileForEra (Exp.useEra @era) AutoBalance)
         <*> many (pWithdrawalForEra (Exp.useEra @era) AutoBalance)
+        <*> pDirectDeposits (Exp.useEra @era)
         <*> pTxMetadataJsonSchema
         <*> many
           ( pScriptFor
@@ -272,6 +273,7 @@ pTransactionBuildEstimateCmd _envCli = do
         <*> pInvalidHereafter Exp.useEra
         <*> many (pCertificateFileForEra (Exp.useEra @era) ManualBalance)
         <*> many (pWithdrawalForEra (Exp.useEra @era) ManualBalance)
+        <*> pDirectDeposits (Exp.useEra @era)
         <*> optional pTotalCollateral
         <*> optional pReferenceScriptSize
         <*> pTxMetadataJsonSchema
@@ -317,6 +319,7 @@ pTransactionBuildRaw =
       <*> pTxFee
       <*> many (pCertificateFileForEra (Exp.useEra @era) ManualBalance)
       <*> many (pWithdrawalForEra (Exp.useEra @era) ManualBalance)
+      <*> pDirectDeposits (Exp.useEra @era)
       <*> pTxMetadataJsonSchema
       <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)")
       <*> many pMetadataFile

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

@@ -148,6 +148,7 @@ runTransactionBuildCmd
     , mValidityUpperBound
     , certificates
     , withdrawals
+    , directDeposits
     , metadataSchema
     , scriptFiles
     , metadataFiles
@@ -158,6 +159,8 @@ runTransactionBuildCmd
     , isCborOutCanonical
     , buildOutputOptions
     } = do
+    -- Reject invalid deposits before any node queries, including the network check.
+    void $ fromEitherCli $ convertDirectDeposits directDeposits
     checkNodeNetworkId nodeConnInfo
 
     let eon = convert currentEra
@@ -308,6 +311,7 @@ runTransactionBuildCmd
           mValidityUpperBound
           certsAndMaybeScriptWits
           withdrawalsAndMaybeScriptWits
+          directDeposits
           requiredSigners
           txAuxScripts
           txMetadata
@@ -393,6 +397,7 @@ runTransactionBuildEstimateCmd -- TODO change type
     , mValidityUpperBound
     , certificates
     , withdrawals
+    , directDeposits
     , metadataSchema
     , scriptFiles
     , metadataFiles
@@ -485,6 +490,7 @@ runTransactionBuildEstimateCmd -- TODO change type
           valuesWithScriptWits
           certsAndMaybeScriptWits
           withdrawalsAndMaybeScriptWits
+          directDeposits
           requiredSigners
           0
           txAuxScripts
@@ -599,6 +605,7 @@ runTransactionBuildRawCmd
     , fee
     , certificates
     , withdrawals
+    , directDeposits
     , metadataSchema
     , scriptFiles
     , metadataFiles
@@ -688,6 +695,7 @@ runTransactionBuildRawCmd
           valuesWithScriptWits
           certsAndMaybeScriptWits
           withdrawalsAndMaybeScriptWits
+          directDeposits
           requiredSigners
           txAuxScripts
           txMetadata
@@ -733,6 +741,8 @@ runTxBuildRaw
   -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
   -- ^ Certificate with potential script witness
   -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))]
+  -> [(StakeAddress, Lovelace)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   -> [Hash PaymentKey]
   -- ^ Required signers
   -> TxAuxScripts era
@@ -760,6 +770,7 @@ runTxBuildRaw
   valuesWithScriptWits
   certsAndMaybeSriptWits
   withdrawals
+  directDeposits
   reqSigners
   txAuxScripts
   txMetadata
@@ -785,6 +796,7 @@ runTxBuildRaw
         valuesWithScriptWits
         certsAndMaybeSriptWits
         withdrawals
+        directDeposits
         reqSigners
         fee
         txAuxScripts
@@ -826,6 +838,8 @@ constructTxBodyContent
   -- ^ Certificate with potential script witness
   -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))]
   -- ^ Withdrawals
+  -> [(StakeAddress, Lovelace)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   -> [Hash PaymentKey]
   -- ^ Required signers
   -> Lovelace
@@ -857,6 +871,7 @@ constructTxBodyContent
   valuesWithScriptWits
   certsAndMaybeScriptWits
   withdrawals
+  directDeposits
   reqSigners
   fee
   txAuxScripts
@@ -904,6 +919,7 @@ constructTxBodyContent
             Exp.mkTxProposalProcedures txProposals
       let validatedCurrentTreasuryValue = unTxCurrentTreasuryValue <$> mCurrentTreasury
           validatedTreasuryDonation = unTxTreasuryDonation <$> mTreasuryDonation
+      validatedDirectDeposits <- convertDirectDeposits directDeposits
       let validatedWithdrawals = convertWithdrawals withdrawals
       return
         ( Exp.defaultTxBodyContent
@@ -919,6 +935,7 @@ constructTxBodyContent
             & Exp.setTxMetadata expTxMetadata
             & Exp.setTxAuxScripts auxScripts
             & Exp.setTxWithdrawals validatedWithdrawals
+            & Exp.setTxDirectDeposits validatedDirectDeposits
             & Exp.setTxExtraKeyWits (Exp.TxExtraKeyWitnesses reqSigners)
             & maybe id (Exp.setTxProtocolParams . Exp.obtainCommonConstraints (Exp.useEra @era)) mPparams
             & Exp.setTxCertificates
@@ -972,6 +989,8 @@ runTxBuild
   -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))]
   -- ^ Certificate with potential script witness
   -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))]
+  -> [(StakeAddress, Lovelace)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   -> [Hash PaymentKey]
   -- ^ Required signers
   -> TxAuxScripts era
@@ -1001,6 +1020,7 @@ runTxBuild
   mUpperBound
   certsAndMaybeScriptWits
   withdrawals
+  directDeposits
   reqSigners
   txAuxScripts
   txMetadata
@@ -1069,6 +1089,7 @@ runTxBuild
             mintValueWithScriptWits
             certsAndMaybeScriptWits
             withdrawals
+            directDeposits
             reqSigners
             0
             txAuxScripts

cardano-cli/src/Cardano/CLI/EraBased/Transaction/SubTransaction/Command.hs

@@ -50,6 +50,8 @@ data SubTransactionBuildRawCmdArgs = SubTransactionBuildRawCmdArgs
   , certificates :: ![(CertificateFile, Maybe AnyNonAssetScript)]
   -- ^ Certificates with potential script witness
   , withdrawals :: ![(StakeAddress, Coin, Maybe AnyNonAssetScript)]
+  , directDeposits :: ![(StakeAddress, Coin)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   , metadataSchema :: !TxMetadataJsonSchema
   , scriptFiles :: ![ScriptFile]
   -- ^ Auxiliary scripts

cardano-cli/src/Cardano/CLI/EraBased/Transaction/SubTransaction/Option.hs

@@ -112,6 +112,7 @@ pSubTransactionBuildRaw =
             "the withdrawal of rewards. Only native scripts or Plutus V4 scripts are supported."
             ManualBalance
         )
+      <*> pDirectDeposits Exp.DijkstraEra
       <*> pTxMetadataJsonSchema
       <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)")
       <*> many pMetadataFile

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

@@ -98,6 +98,7 @@ runSubTransactionBuildRawCmd
     , mValidityUpperBound
     , certificates
     , withdrawals
+    , directDeposits
     , metadataSchema
     , scriptFiles
     , metadataFiles
@@ -180,6 +181,7 @@ runSubTransactionBuildRawCmd
           valuesWithScriptWits
           certsAndMaybeScriptWits
           withdrawalsAndMaybeScriptWits
+          directDeposits
           txAuxScripts
           txMetadata
           votingProceduresAndMaybeScriptWits
@@ -349,6 +351,8 @@ constructSubTx
   -- ^ Certificate with potential script witness
   -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))]
   -- ^ Withdrawals
+  -> [(StakeAddress, Lovelace)]
+  -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
   -> TxAuxScripts era
   -> TxMetadataInEra era
   -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
@@ -372,6 +376,7 @@ constructSubTx
   valuesWithScriptWits
   certsAndMaybeScriptWits
   withdrawals
+  directDeposits
   txAuxScripts
   txMetadata
   votingProcedures
@@ -417,6 +422,7 @@ constructSubTx
             TxMetadataNone -> TxMetadata mempty
             TxMetadataInEra _ mDat -> mDat
 
+      validatedDirectDeposits <- convertDirectDeposits directDeposits
       validatedMintValue <- createTxMintValue valuesWithScriptWits
       validatedVotingProcedures <-
         first (TxCmdVotingError . TxVotingError) $
@@ -432,14 +438,15 @@ constructSubTx
             & Exp.setTxMetadata expTxMetadata
             & Exp.setTxAuxScripts auxScripts
             & Exp.setTxWithdrawals (convertWithdrawals withdrawals)
+            & Exp.setTxDirectDeposits validatedDirectDeposits
             & maybe id (Exp.setTxProtocolParams . Exp.obtainCommonConstraints (Exp.useEra @era)) mPparams
             & Exp.setTxCertificates
               (Exp.mkTxCertificates Exp.useEra certsAndMaybeScriptWits)
             & Exp.setTxMintValue validatedMintValue
             & Exp.setTxVotingProcedures validatedVotingProcedures
             & Exp.setTxProposalProcedures (Exp.mkTxProposalProcedures txProposals)
-            & maybe id Exp.setTxCurrentTreasuryValue (unTxCurrentTreasuryValue <$> mCurrentTreasury)
-            & maybe id Exp.setTxTreasuryDonation (unTxTreasuryDonation <$> mTreasuryDonation)
+            & maybe id (Exp.setTxCurrentTreasuryValue . unTxCurrentTreasuryValue) mCurrentTreasury
+            & maybe id (Exp.setTxTreasuryDonation . unTxTreasuryDonation) mTreasuryDonation
             & Exp.setTxSupplementalDatums suppDatums
             & Exp.setTxGuards guards
             & Exp.setTxRequiredTopLevelGuards requiredTopLevelGuards

cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs

@@ -86,6 +86,7 @@ data TxCmdError
   | TxCmdSubTxCborError !DecoderError
   | TxCmdSubTxUnsupportedPlutusLanguage !L.Language
   | TxCmdSubTxByronWitnessUnsupported
+  | TxCmdDuplicateDirectDeposits ![StakeAddress]
   | TxCmdDuplicateGuards ![L.Credential L.Guard]
   | TxCmdPlutusGuardMissingRedeemer !(L.Credential L.Guard)
   | TxCmdNativeGuardWithRedeemer !(L.Credential L.Guard)
@@ -219,6 +220,9 @@ renderTxCmdError = \case
     "Sub-transactions require Plutus V4 for script execution; found " <> pshow language <> "."
   TxCmdSubTxByronWitnessUnsupported ->
     "Byron (bootstrap) witnesses are not supported for sub-transactions."
+  TxCmdDuplicateDirectDeposits addresses ->
+    "Duplicate direct-deposit accounts: "
+      <> hsep (map (pretty . serialiseAddress) addresses)
   TxCmdDuplicateGuards credentials ->
     "Duplicate guards: " <> hsep (map (pretty . L.credToText) credentials)
   TxCmdPlutusGuardMissingRedeemer credential ->