Add CIP-159 account balance intervals to builders and debug views

.changes/20261023_account_balance_intervals.yml

@@ -0,0 +1,5 @@
+project: cardano-cli
+pr: 1483
+kind:
+  - feature
+description: Add CIP-159 `--account-balance-interval` and `--starting-account-balance-interval` to Dijkstra `transaction build`, `build-raw`, and `build-estimate`; `sub-transaction build-raw` supports only the former. Values use `STAKE_ADDRESS{=N|>=L|<U|>=L,<U}` in lovelace, with inclusive lower bounds, exclusive upper bounds, and `L < U`. Add matching builder argument fields and always display intervals and sub-transactions in JSON/YAML views, with interval amounts in Lovelace.

cardano-cli/cardano-cli.cabal

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

cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs

@@ -46,8 +46,10 @@ import Cardano.CLI.Type.MonadWarning (MonadWarning, runWarningIO)
 import Cardano.Crypto.Hash (hashToTextAsHex)
 import Cardano.Ledger.Address qualified as L
 import Cardano.Ledger.Api.Tx qualified as L
+import Cardano.Ledger.BaseTypes (Exclusive (..), Inclusive (..))
 import Cardano.Ledger.Core qualified as C
 import Cardano.Ledger.Credential (credKeyHash, credScriptHash)
+import Cardano.Ledger.Dijkstra.TxBody qualified as L
 import Cardano.Ledger.Keys (coerceKeyRole)
 
 import Control.Applicative ((<|>))
@@ -198,7 +200,63 @@ dijkstraBodyPairs
 dijkstraBodyPairs era body = case era of
   Exp.ConwayEra -> []
   Exp.DijkstraEra ->
-    ["direct deposits" .= friendlyAccountAmounts (L.unDirectDeposits $ body ^. L.directDepositsTxBodyL)]
+    [ "direct deposits" .= friendlyAccountAmounts (L.unDirectDeposits $ body ^. L.directDepositsTxBodyL)
+    , "account balance intervals"
+        .= friendlyAccountBalanceIntervals (body ^. L.accountBalanceIntervalsTxBodyL)
+    , "starting account balance intervals"
+        .= friendlyAccountBalanceIntervals (body ^. L.startingAccountBalanceIntervalsTxBodyL)
+    , "sub-transactions" .= case toList (body ^. L.subTransactionsTxBodyL) of
+        [] -> Null
+        subTransactions -> array $ map renderSubTransaction subTransactions
+    ]
+
+renderSubTransaction
+  :: L.Tx C.SubTx (Exp.LedgerEra Exp.DijkstraEra)
+  -> Aeson.Value
+renderSubTransaction subTx =
+  object
+    [ "id" .= serialiseToRawBytesHexText (Exp.getSignedSubTxId (Exp.SignedSubTx subTx))
+    , "account balance intervals"
+        .= friendlyAccountBalanceIntervals (subTx ^. L.bodyTxL . L.accountBalanceIntervalsTxBodyL)
+    ]
+
+friendlyAccountBalanceIntervals :: L.AccountBalanceIntervals era -> Aeson.Value
+friendlyAccountBalanceIntervals (L.AccountBalanceIntervals intervals)
+  | Map.null intervals = Null
+  | otherwise =
+      array
+        [ object $
+            [ "address" .= serialiseAddress addr
+            , "interval" .= friendlyAccountBalanceInterval interval
+            ]
+              <> friendlyStakeAddress addr
+        | (account, interval) <- Map.toList intervals
+        , let addr = fromShelleyStakeAddr account
+        ]
+
+friendlyAccountBalanceInterval :: L.AccountBalanceInterval era -> Aeson.Value
+friendlyAccountBalanceInterval = \case
+  L.AccountBalanceLowerBound (Inclusive lower) ->
+    object
+      [ "kind" .= String "lowerBound"
+      , "lower" .= friendlyLovelace lower
+      ]
+  L.AccountBalanceUpperBound (Exclusive upper) ->
+    object
+      [ "kind" .= String "upperBound"
+      , "upper" .= friendlyLovelace upper
+      ]
+  L.AccountBalanceBothBounds (Inclusive lower) (Exclusive upper) ->
+    object
+      [ "kind" .= String "bothBounds"
+      , "lower" .= friendlyLovelace lower
+      , "upper" .= friendlyLovelace upper
+      ]
+  L.AccountBalanceExact coin ->
+    object
+      [ "kind" .= String "exact"
+      , "coin" .= friendlyLovelace coin
+      ]
 
 renderCollateralInputs
   :: L.AlonzoEraTxBody (Exp.LedgerEra era)

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

@@ -30,7 +30,11 @@ import Cardano.CLI.EraBased.Script.Type
 import Cardano.CLI.EraBased.Script.Type qualified as ScriptT
 import Cardano.CLI.EraBased.Script.Vote.Type qualified as Voting
 import Cardano.CLI.EraBased.Script.Withdrawal.Type qualified as Withdrawal
-import Cardano.CLI.EraBased.Transaction.Command (IncludeCurrentTreasuryValue (..))
+import Cardano.CLI.EraBased.Transaction.Command
+  ( IncludeCurrentTreasuryValue (..)
+  , accountBalanceIntervalOptionName
+  , startingAccountBalanceIntervalOptionName
+  )
 import Cardano.CLI.Option.Flag
 import Cardano.CLI.Option.Flag.Type qualified as Z
 import Cardano.CLI.Orphan ()
@@ -40,7 +44,8 @@ import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Governance
 import Cardano.CLI.Type.Key
 import Cardano.CLI.Type.Key.VerificationKey
-import Cardano.Ledger.BaseTypes (NonZero, nonZero)
+import Cardano.Ledger.BaseTypes (Exclusive (..), Inclusive (..), NonZero, nonZero)
+import Cardano.Ledger.Dijkstra.Scripts qualified as L
 import Cardano.Ledger.Plutus.Language qualified as L
 
 import Control.Monad (void, when)
@@ -1516,6 +1521,66 @@ pDirectDeposits era = case era of
           <> Opt.help
             "Deposit ADA into a registered account. Amount in lovelace; each account may occur once."
 
+-- | Comparison syntax deliberately follows the ledger's inclusive lower and
+-- exclusive upper bounds. Exact assertions retain their distinct constructor.
+parseAccountBalanceInterval :: P.Parser (StakeAddress, L.AccountBalanceInterval era)
+parseAccountBalanceInterval = do
+  address <- parseAddressAny
+  interval <-
+    (L.AccountBalanceExact <$> parseExact)
+      <|> (L.AccountBalanceUpperBound . Exclusive <$> parseUpperBound)
+      <|> do
+        lower <- parseLowerBound
+        upper <- optional (P.char ',' *> parseUpperBound)
+        case upper of
+          Nothing -> pure $ L.AccountBalanceLowerBound (Inclusive lower)
+          Just upperBound
+            | lower < upperBound ->
+                pure $ L.AccountBalanceBothBounds (Inclusive lower) (Exclusive upperBound)
+            | otherwise -> fail "The lower bound must be strictly less than the upper bound"
+  pure (address, interval)
+ where
+  parseExact = P.char '=' *> parseLovelace
+  parseLowerBound = P.string ">=" *> parseLovelace
+  parseUpperBound = P.char '<' *> parseLovelace
+
+pAccountBalanceIntervals
+  :: Exp.Era era
+  -> Parser [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
+pAccountBalanceIntervals era =
+  pBalanceIntervals
+    era
+    accountBalanceIntervalOptionName
+    "Require the account balance to satisfy this interval before applying this transaction's withdrawals, certificates, or direct deposits. Top-level transactions check the balance after all sub-transactions; each sub-transaction checks the balance after any preceding sub-transactions."
+
+pStartingAccountBalanceIntervals
+  :: Exp.Era era
+  -> Parser [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
+pStartingAccountBalanceIntervals era =
+  pBalanceIntervals
+    era
+    startingAccountBalanceIntervalOptionName
+    "Check the account balance before the entire transaction, including all sub-transactions. Top-level only."
+
+pBalanceIntervals
+  :: Exp.Era era
+  -> String
+  -> String
+  -> Parser [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
+pBalanceIntervals era optionName timing = case era of
+  Exp.ConwayEra -> pure []
+  Exp.DijkstraEra ->
+    many $
+      Opt.option (readerFromParsecParser parseAccountBalanceInterval) $
+        Opt.long optionName
+          <> Opt.metavar "STAKE_ADDRESS{=LOVELACE|>=LOWER|<UPPER|>=LOWER,<UPPER}"
+          <> Opt.help
+            ( timing
+                <> " Amounts in lovelace; lower bounds inclusive, upper bounds exclusive."
+                <> " Quote the argument so the shell treats < and > as literal characters, e.g. 'stake_test1...>=100,<200'."
+                <> " Each account may occur once per option."
+            )
+
 pWithdrawalForEra
   :: Exp.Era era
   -> BalanceTxExecUnits

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

@@ -25,6 +25,8 @@ module Cardano.CLI.EraBased.Transaction.Command
   , TransactionWitnessCmdArgs (..)
   , TxCborFormat (..)
   , IncludeCurrentTreasuryValue (..)
+  , accountBalanceIntervalOptionName
+  , startingAccountBalanceIntervalOptionName
   , renderTransactionCmds
   )
 where
@@ -37,10 +39,17 @@ import Cardano.CLI.EraBased.Script.Type
 import Cardano.CLI.Orphan ()
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Governance
+import Cardano.Ledger.Dijkstra.Scripts qualified as L
 
 import Data.Universe (Some)
 import Vary (Vary)
 
+accountBalanceIntervalOptionName :: String
+accountBalanceIntervalOptionName = "account-balance-interval"
+
+startingAccountBalanceIntervalOptionName :: String
+startingAccountBalanceIntervalOptionName = "starting-account-balance-interval"
+
 data TransactionCmds era
   = TransactionBuildRawCmd !(TransactionBuildRawCmdArgs era)
   | TransactionBuildCmd !(TransactionBuildCmdArgs era)
@@ -86,6 +95,8 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   , withdrawals :: ![(StakeAddress, Coin, Maybe AnyNonAssetScript)]
   , directDeposits :: ![(StakeAddress, Coin)]
   -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
+  , accountBalanceIntervals :: ![(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
+  , startingAccountBalanceIntervals :: ![(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
   , metadataSchema :: !TxMetadataJsonSchema
   , scriptFiles :: ![ScriptFile]
   -- ^ Auxiliary scripts
@@ -154,6 +165,8 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   -- ^ Withdrawals with potential script witness
   , directDeposits :: ![(StakeAddress, Coin)]
   -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
+  , accountBalanceIntervals :: ![(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
+  , startingAccountBalanceIntervals :: ![(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
   , metadataSchema :: !TxMetadataJsonSchema
   , scriptFiles :: ![ScriptFile]
   -- ^ Auxiliary scripts
@@ -203,6 +216,8 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   -- ^ Withdrawals with potential script witness
   , directDeposits :: ![(StakeAddress, Coin)]
   -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace.
+  , accountBalanceIntervals :: ![(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
+  , startingAccountBalanceIntervals :: ![(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))]
   , plutusCollateral :: !(Maybe Coin)
   -- ^ Total collateral
   , totalReferenceScriptSize :: !(Maybe ReferenceScriptSize)

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

@@ -10,6 +10,8 @@ module Cardano.CLI.EraBased.Transaction.Internal.Common
   , createTxMintValue
   , convertWithdrawals
   , convertDirectDeposits
+  , convertAccountBalanceIntervals
+  , findDuplicates
   , convertVotingProcedures
   , scriptInEraToSimpleScript
   , partitionSomeWitnesses
@@ -29,6 +31,7 @@ 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.Dijkstra.Scripts qualified as L
 import Cardano.Ledger.Hashes (DataHash)
 
 import RIO hiding (toList)
@@ -181,12 +184,30 @@ partitionSomeWitnesses = reversePartitionedWits . Foldable.foldl' go mempty
       AShelleyKeyWitness shelleyKeyWit ->
         (byronAcc, shelleyKeyWit : shelleyKeyAcc)
 
+-- | Return repeated values in ascending order, with each value included only once.
+findDuplicates :: Ord a => [a] -> [a]
+findDuplicates values = [value | value : _ : _ <- List.group (List.sort values)]
+
 -- | 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
+  case findDuplicates (map fst deposits) of
     [] ->
       Right $
         L.DirectDeposits $
           Map.fromList [(toShelleyStakeAddr address, amount) | (address, amount) <- deposits]
     duplicates -> Left $ TxCmdDuplicateDirectDeposits duplicates
+
+-- | An account may occur once in each interval field. Never silently discard
+-- assertions by constructing a map before checking for duplicate addresses.
+convertAccountBalanceIntervals
+  :: String
+  -> [(StakeAddress, L.AccountBalanceInterval era)]
+  -> Either TxCmdError (L.AccountBalanceIntervals era)
+convertAccountBalanceIntervals option intervals =
+  case findDuplicates (map fst intervals) of
+    [] ->
+      Right $
+        L.AccountBalanceIntervals $
+          Map.fromList [(toShelleyStakeAddr address, interval) | (address, interval) <- intervals]
+    duplicates -> Left $ TxCmdDuplicateAccountBalanceIntervals option duplicates

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

@@ -216,6 +216,8 @@ pTransactionBuildCmd envCli = do
         <*> many (pCertificateFileForEra (Exp.useEra @era) AutoBalance)
         <*> many (pWithdrawalForEra (Exp.useEra @era) AutoBalance)
         <*> pDirectDeposits (Exp.useEra @era)
+        <*> pAccountBalanceIntervals (Exp.useEra @era)
+        <*> pStartingAccountBalanceIntervals (Exp.useEra @era)
         <*> pTxMetadataJsonSchema
         <*> many
           ( pScriptFor
@@ -279,6 +281,8 @@ pTransactionBuildEstimateCmd _envCli = do
         <*> many (pCertificateFileForEra (Exp.useEra @era) ManualBalance)
         <*> many (pWithdrawalForEra (Exp.useEra @era) ManualBalance)
         <*> pDirectDeposits (Exp.useEra @era)
+        <*> pAccountBalanceIntervals (Exp.useEra @era)
+        <*> pStartingAccountBalanceIntervals (Exp.useEra @era)
         <*> optional pTotalCollateral
         <*> optional pReferenceScriptSize
         <*> pTxMetadataJsonSchema
@@ -325,6 +329,8 @@ pTransactionBuildRaw =
       <*> many (pCertificateFileForEra (Exp.useEra @era) ManualBalance)
       <*> many (pWithdrawalForEra (Exp.useEra @era) ManualBalance)
       <*> pDirectDeposits (Exp.useEra @era)
+      <*> pAccountBalanceIntervals (Exp.useEra @era)
+      <*> pStartingAccountBalanceIntervals (Exp.useEra @era)
       <*> pTxMetadataJsonSchema
       <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)")
       <*> many pMetadataFile