Merge pull request #2716 from input-output-hk/jc/maybe-collateral-total

The total collateral field should be a Maybe Coin

eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs

@@ -183,7 +183,7 @@ feesOK ::
     HasField "collateralReturn" (Core.TxBody era) (StrictMaybe (TxOut era)),
     HasField "_prices" (Core.PParams era) Prices,
     HasField "txrdmrs" (Core.Witnesses era) (Redeemers era),
-    HasField "totalCollateral" (Core.TxBody era) Coin
+    HasField "totalCollateral" (Core.TxBody era) (StrictMaybe Coin)
   ) =>
   Core.PParams era ->
   Core.Tx era ->
@@ -210,7 +210,7 @@ validateTotalCollateral ::
   forall era.
   ( Era era,
     HasField "_collateralPercentage" (Core.PParams era) Natural,
-    HasField "totalCollateral" (Core.TxBody era) Coin
+    HasField "totalCollateral" (Core.TxBody era) (StrictMaybe Coin)
   ) =>
   Core.PParams era ->
   Core.TxBody era ->
@@ -226,21 +226,19 @@ validateTotalCollateral pp txb utxoCollateral bal =
       -- Part 5: balance ≥ ⌈txfee txb ∗ (collateralPercent pp) / 100⌉
       fromAlonzoValidation $ validateInsufficientCollateral pp txb bal,
       -- Part 6: (txcoll tx ≠ ◇) ⇒ balance = txcoll tx
-      unless (totalCollateral'' == mempty) $ validateCollateralEqBalance bal totalCollateral'',
+      validateCollateralEqBalance (Val.coin bal) (getField @"totalCollateral" txb),
       -- Part 7: (∀(a,_,_) ∈ range (collateral txb ◁ utxo), a ∈ Addrvkey)
       fromAlonzoValidation $ failureIf (null utxoCollateral) (NoCollateralInputs @era)
     ]
   where
-    totalCollateral'' = Val.inject $ getField @"totalCollateral" txb
     fromAlonzoValidation x = first (fmap inject) x
 
 -- > (txcoll tx ≠ ◇) => balance == txcoll tx
-validateCollateralEqBalance :: Val.Val t => t -> t -> Validation (NonEmpty (BabbageUtxoPred era)) ()
+validateCollateralEqBalance :: Coin -> StrictMaybe Coin -> Validation (NonEmpty (BabbageUtxoPred era)) ()
 validateCollateralEqBalance bal txcoll =
-  failureUnless (bal == txcoll) $
-    UnequalCollateralReturn
-      (Val.coin bal)
-      (Val.coin txcoll)
+  case txcoll of
+    SNothing -> pure ()
+    SJust tc -> failureUnless (bal == tc) (UnequalCollateralReturn bal tc)
 
 -- | The UTxO transition rule for the Babbage eras.
 utxoTransition ::

eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs

@@ -368,7 +368,7 @@ data TxBodyRaw era = TxBodyRaw
     _referenceInputs :: !(Set (TxIn (Crypto era))),
     _outputs :: !(StrictSeq (TxOut era)),
     _collateralReturn :: !(StrictMaybe (TxOut era)),
-    _totalCollateral :: !Coin,
+    _totalCollateral :: !(StrictMaybe Coin),
     _certs :: !(StrictSeq (DCert (Crypto era))),
     _wdrls :: !(Wdrl (Crypto era)),
     _txfee :: !Coin,
@@ -475,7 +475,7 @@ pattern TxBody ::
   Set (TxIn (Crypto era)) ->
   StrictSeq (TxOut era) ->
   StrictMaybe (TxOut era) ->
-  Coin ->
+  StrictMaybe Coin ->
   StrictSeq (DCert (Crypto era)) ->
   Wdrl (Crypto era) ->
   Coin ->
@@ -582,7 +582,7 @@ collateralInputs' :: TxBody era -> Set (TxIn (Crypto era))
 referenceInputs' :: TxBody era -> Set (TxIn (Crypto era))
 outputs' :: TxBody era -> StrictSeq (TxOut era)
 collateralReturn' :: TxBody era -> StrictMaybe (TxOut era)
-totalCollateral' :: TxBody era -> Coin
+totalCollateral' :: TxBody era -> StrictMaybe Coin
 certs' :: TxBody era -> StrictSeq (DCert (Crypto era))
 txfee' :: TxBody era -> Coin
 wdrls' :: TxBody era -> Wdrl (Crypto era)
@@ -806,7 +806,7 @@ encodeTxBodyRaw
       !> Key 18 (E encodeFoldable _referenceInputs)
       !> Key 1 (E encodeFoldable _outputs)
       !> encodeKeyedStrictMaybe 16 _collateralReturn
-      !> Key 17 (To _totalCollateral)
+      !> encodeKeyedStrictMaybe 17 _totalCollateral
       !> Key 2 (To _txfee)
       !> encodeKeyedStrictMaybe 3 top
       !> Omit null (Key 4 (E encodeFoldable _certs))
@@ -860,7 +860,7 @@ instance
           mempty
           StrictSeq.empty
           SNothing
-          mempty
+          SNothing
           StrictSeq.empty
           (Wdrl mempty)
           mempty
@@ -895,7 +895,7 @@ instance
       bodyFields 17 =
         field
           (\x tx -> tx {_totalCollateral = x})
-          (D fromCBOR)
+          (D (SJust <$> fromCBOR))
       bodyFields 2 = field (\x tx -> tx {_txfee = x}) From
       bodyFields 3 =
         field
@@ -962,7 +962,7 @@ instance (Crypto era ~ c) => HasField "referenceInputs" (TxBody era) (Set (TxIn
 instance HasField "collateralReturn" (TxBody era) (StrictMaybe (TxOut era)) where
   getField (TxBodyConstr (Memo m _)) = _collateralReturn m
 
-instance HasField "totalCollateral" (TxBody era) Coin where
+instance HasField "totalCollateral" (TxBody era) (StrictMaybe Coin) where
   getField (TxBodyConstr (Memo m _)) = _totalCollateral m
 
 instance (Crypto era ~ c) => HasField "minted" (TxBody era) (Set (ScriptHash c)) where

eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Examples/Consensus.hs

@@ -117,7 +117,7 @@ exampleTxBodyBabbage =
         ]
     )
     (SJust collateralOutput) -- collateral return
-    (Coin 8675309) -- collateral tot
+    (SJust $ Coin 8675309) -- collateral tot
     SLE.exampleCerts -- txcerts
     ( Wdrl $
         Map.singleton

eras/babbage/test-suite/test/Test/Cardano/Ledger/Babbage/TxInfo.hs

@@ -107,7 +107,7 @@ txb i mRefInp o =
         Just ri -> Set.singleton ri,
       outputs = StrictSeq.singleton o,
       collateralReturn = SNothing,
-      totalCollateral = Coin 0,
+      totalCollateral = SNothing,
       txcerts = mempty,
       txwdrls = Wdrl mempty,
       txfee = Coin 2,

libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Babbage.hs

@@ -219,7 +219,7 @@ ppTxBody x =
       ("reference inputs", ppSet ppTxIn (referenceInputs' x)),
       ("outputs", ppStrictSeq ppTxOut (outputs' x)),
       ("collateral return", ppStrictMaybe ppTxOut (collateralReturn' x)),
-      ("total collateral", ppCoin (totalCollateral' x)),
+      ("total collateral", ppStrictMaybe ppCoin (totalCollateral' x)),
       ("certificates", ppStrictSeq ppDCert (certs' x)),
       ("withdrawals", ppWdrl (wdrls' x)),
       ("txfee", ppCoin (txfee' x)),

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs

@@ -585,7 +585,7 @@ collateralOutputTxBody pf =
     [ Inputs' [failsEUTxOInput],
       Collateral' [collateralInput17],
       CollateralReturn' [collateralReturn pf],
-      TotalCol (Coin 5),
+      TotalCol (SJust $ Coin 5),
       Outputs' [outEx1 pf],
       Txfee (Coin 5),
       WppHash (newScriptIntegrityHash pf (pp pf) [PlutusV1] validatingRedeemersEx1 txDatsExample2)
@@ -638,7 +638,7 @@ incorrectCollateralTotalTxBody pf =
     [ Inputs' [inlineDatumInput],
       Collateral' [collateralInput11],
       CollateralReturn' [collateralReturn pf],
-      TotalCol (Coin 6),
+      TotalCol (SJust $ Coin 6),
       Outputs' [outEx1 pf],
       Txfee (Coin 5),
       WppHash (newScriptIntegrityHash pf (pp pf) [PlutusV2] validatingRedeemersEx1 mempty)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Fields.hs

@@ -108,7 +108,7 @@ data TxBodyField era
   | RefInputs (Set (TxIn (Crypto era)))
   | Outputs (StrictSeq (Core.TxOut era))
   | CollateralReturn (StrictMaybe (Core.TxOut era))
-  | TotalCol Coin
+  | TotalCol (StrictMaybe Coin)
   | Certs (StrictSeq (DCert (Crypto era)))
   | Wdrls (Wdrl (Crypto era))
   | Txfee Coin
@@ -259,7 +259,7 @@ initialTxBody (Babbage _) =
     Set.empty
     Seq.empty
     SNothing
-    (Coin 0)
+    SNothing
     Seq.empty
     initWdrl
     (Coin 0)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs

@@ -713,7 +713,7 @@ txBodyFieldSummary txb = case txb of
   (RefInputs s) -> [("RefInputs", ppInt (Set.size s))]
   (Outputs xs) -> [("Outputs", ppInt (length xs))]
   (CollateralReturn (SJust _)) -> [("Collateral Return", ppString "?")]
-  (TotalCol c) -> [("TotalCollateral", ppCoin c)]
+  (TotalCol (SJust c)) -> [("TotalCollateral", ppCoin c)]
   (Certs xs) -> [("Certs", ppInt (length xs))]
   (Wdrls x) -> [("Withdrawals", ppInt (Map.size (unWdrl x)))]
   (Vldt x) -> [("Validity interval", ppValidityInterval x)]

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs

@@ -707,7 +707,6 @@ genValidatedTx proof = do
           [ Inputs (Map.keysSet toSpendNoCollateral),
             Collateral bogusCollateralTxIns,
             RefInputs (Map.keysSet refInputsUtxo),
-            TotalCol (Coin 0), -- Add a bogus Coin, fill it in later
             Outputs' (rewardsWithdrawalTxOut : recipients),
             Certs' dcerts,
             Wdrls wdrls,
@@ -769,7 +768,7 @@ genValidatedTx proof = do
           txBodyNoFee
           [ Txfee fee,
             Collateral (Map.keysSet collMap),
-            TotalCol (txInBalance (Map.keysSet collMap) utxo),
+            TotalCol (SJust $ txInBalance (Map.keysSet collMap) utxo),
             WppHash mIntegrityHash
           ]
       txBodyHash = hashAnnotated txBody