Implement return and total collateral in cardano-api

bench/tx-generator/src/Cardano/Benchmarking/FundSet.hs

@@ -120,6 +120,7 @@ liftAnyEra f x = case x of
   InAnyCardanoEra AllegraEra a ->   InAnyCardanoEra AllegraEra $ f a
   InAnyCardanoEra MaryEra a    ->   InAnyCardanoEra MaryEra $ f a
   InAnyCardanoEra AlonzoEra a  ->   InAnyCardanoEra AlonzoEra $ f a
+  InAnyCardanoEra BabbageEra a  ->  InAnyCardanoEra BabbageEra $ f a  
 
 type FundSelector = FundSet -> Either String [Fund]
 type FundSource = IO (Either String [Fund])

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs

@@ -116,6 +116,8 @@ dummyTxSizeInEra metadata = case makeTransactionBody dummyTx of
     , txUpdateProposal = TxUpdateProposalNone
     , txMintValue = TxMintNone
     , txScriptValidity = TxScriptValidityNone
+    , txReturnCollateral = TxReturnCollateralNone
+    , txTotalCollateral = TxTotalCollateralNone
     }
 
 dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs

@@ -73,6 +73,8 @@ mkGenesisTransaction key _payloadSize ttl fee txins txouts
     , txUpdateProposal = TxUpdateProposalNone
     , txMintValue = TxMintNone
     , txScriptValidity = TxScriptValidityNone
+    , txReturnCollateral = TxReturnCollateralNone
+    , txTotalCollateral = TxTotalCollateralNone
     }
   fees = case shelleyBasedEra @ era of
     ShelleyBasedEraShelley -> TxFeeExplicit TxFeesExplicitInShelleyEra fee

bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs

@@ -164,6 +164,8 @@ genTx protocolParameters (collateral, collFunds) fee metadata witness inFunds ou
     , txUpdateProposal = TxUpdateProposalNone
     , txMintValue = TxMintNone
     , txScriptValidity = TxScriptValidityNone
+    , txReturnCollateral = TxReturnCollateralNone
+    , txTotalCollateral = TxTotalCollateralNone
     }
 
   upperBound :: TxValidityUpperBound era

cardano-api/gen/Gen/Cardano/Api/Typed.hs

@@ -519,6 +519,8 @@ genTxBodyContent era = do
   txIns <- map (, BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
   txInsCollateral <- genTxInsCollateral era
   txOuts <- Gen.list (Range.constant 1 10) (genTxOutTxContext era)
+  txTotalCollateral <- genTxTotalCollateral era
+  txReturnCollateral <- genTxReturnCollateral era
   txFee <- genTxFee era
   txValidityRange <- genTxValidityRange era
   txMetadata <- genTxMetadataInEra era
@@ -535,6 +537,8 @@ genTxBodyContent era = do
     { Api.txIns
     , Api.txInsCollateral
     , Api.txOuts
+    , Api.txTotalCollateral
+    , Api.txReturnCollateral
     , Api.txFee
     , Api.txValidityRange
     , Api.txMetadata
@@ -557,6 +561,20 @@ genTxInsCollateral era =
                           , TxInsCollateral supported <$> Gen.list (Range.linear 0 10) genTxIn
                           ]
 
+genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral CtxTx era)
+genTxReturnCollateral era =
+  case totalAndReturnCollateralSupportedInEra  era of
+    Nothing -> return TxReturnCollateralNone
+    Just supp ->
+      TxReturnCollateral supp <$>  genTxOutTxContext era
+
+genTxTotalCollateral :: CardanoEra era -> Gen (TxTotalCollateral era)
+genTxTotalCollateral era =
+  case totalAndReturnCollateralSupportedInEra  era of
+    Nothing -> return TxTotalCollateralNone
+    Just supp ->
+      TxTotalCollateral supp <$> genLovelace
+
 genTxFee :: CardanoEra era -> Gen (TxFee era)
 genTxFee era =
   case txFeesExplicitInEra era of

cardano-api/src/Cardano/Api.hs

@@ -184,6 +184,8 @@ module Cardano.Api (
 
     -- ** Other transaction body types
     TxInsCollateral(..),
+    TxTotalCollateral(..),
+    TxReturnCollateral(..),
     TxFee(..),
     TxValidityLowerBound(..),
     TxValidityUpperBound(..),
@@ -234,6 +236,7 @@ module Cardano.Api (
     certificatesSupportedInEra,
     updateProposalSupportedInEra,
     scriptDataSupportedInEra,
+    totalAndReturnCollateralSupportedInEra,
 
     -- ** Fee calculation
     transactionFee,

cardano-api/src/Cardano/Api/TxBody.hs

@@ -63,6 +63,8 @@ module Cardano.Api.TxBody (
 
     -- * Other transaction body types
     TxInsCollateral(..),
+    TxReturnCollateral(..),
+    TxTotalCollateral(..),
     TxFee(..),
     TxValidityLowerBound(..),
     TxValidityUpperBound(..),
@@ -96,6 +98,7 @@ module Cardano.Api.TxBody (
     CertificatesSupportedInEra(..),
     UpdateProposalSupportedInEra(..),
     InlineDatumSupportedInEra(..),
+    TxTotalAndReturnCollateralSupportedInEra(..),
 
     -- ** Feature availability functions
     collateralSupportedInEra,
@@ -114,6 +117,7 @@ module Cardano.Api.TxBody (
     txScriptValiditySupportedInShelleyBasedEra,
     txScriptValiditySupportedInCardanoEra,
     inlineDatumSupportedInEra,
+    totalAndReturnCollateralSupportedInEra,
 
     -- * Inspecting 'ScriptWitness'es
     AnyScriptWitness(..),
@@ -174,6 +178,7 @@ import qualified Data.Text as Text
 import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
 import           Data.Word (Word16, Word32, Word64)
 import           GHC.Generics
+import           GHC.Records (HasField (..))
 import qualified Text.Parsec as Parsec
 import qualified Text.Parsec.Language as Parsec
 import qualified Text.Parsec.String as Parsec
@@ -193,6 +198,7 @@ import qualified Cardano.Ledger.Address as Shelley
 import qualified Cardano.Ledger.AuxiliaryData as Ledger (hashAuxiliaryData)
 import           Cardano.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe)
 import qualified Cardano.Ledger.BaseTypes as Ledger
+import qualified Cardano.Ledger.Coin as Ledger
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Credential as Shelley
@@ -1352,6 +1358,44 @@ prettyRenderTxOut (TxOutInAnyEra _ (TxOut (AddressInEra _ addr) txOutVal _ _)) =
      serialiseAddress (toAddressAny addr) <> " + "
   <> renderValue (txOutValueToValue txOutVal)
 
+data TxReturnCollateral ctx era where
+
+     TxReturnCollateralNone :: TxReturnCollateral ctx era
+
+     TxReturnCollateral     :: TxTotalAndReturnCollateralSupportedInEra era
+                            -> TxOut ctx era
+                            -> TxReturnCollateral ctx era
+
+deriving instance Eq   (TxReturnCollateral ctx era)
+deriving instance Show (TxReturnCollateral ctx era)
+
+data TxTotalCollateral era where
+
+     TxTotalCollateralNone :: TxTotalCollateral era
+
+     TxTotalCollateral     :: TxTotalAndReturnCollateralSupportedInEra era
+                           -> Lovelace
+                           -> TxTotalCollateral era
+
+deriving instance Eq   (TxTotalCollateral era)
+deriving instance Show (TxTotalCollateral era)
+
+data TxTotalAndReturnCollateralSupportedInEra era where
+
+     TxTotalAndReturnCollateralInBabbageEra :: TxTotalAndReturnCollateralSupportedInEra BabbageEra
+
+deriving instance Eq   (TxTotalAndReturnCollateralSupportedInEra era)
+deriving instance Show (TxTotalAndReturnCollateralSupportedInEra era)
+
+totalAndReturnCollateralSupportedInEra
+  :: CardanoEra era -> Maybe (TxTotalAndReturnCollateralSupportedInEra era)
+totalAndReturnCollateralSupportedInEra ByronEra = Nothing
+totalAndReturnCollateralSupportedInEra ShelleyEra = Nothing
+totalAndReturnCollateralSupportedInEra AllegraEra = Nothing
+totalAndReturnCollateralSupportedInEra MaryEra = Nothing
+totalAndReturnCollateralSupportedInEra AlonzoEra = Nothing
+totalAndReturnCollateralSupportedInEra BabbageEra = Just TxTotalAndReturnCollateralInBabbageEra
+
 -- ----------------------------------------------------------------------------
 -- Transaction output datum (era-dependent)
 --
@@ -1587,21 +1631,23 @@ deriving instance Show (TxMintValue build era)
 
 data TxBodyContent build era =
      TxBodyContent {
-       txIns            :: TxIns build era,
-       txInsCollateral  :: TxInsCollateral era,
-       txOuts           :: [TxOut CtxTx era],
-       txFee            :: TxFee era,
-       txValidityRange  :: (TxValidityLowerBound era,
-                            TxValidityUpperBound era),
-       txMetadata       :: TxMetadataInEra era,
-       txAuxScripts     :: TxAuxScripts era,
-       txExtraKeyWits   :: TxExtraKeyWitnesses era,
-       txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters),
-       txWithdrawals    :: TxWithdrawals  build era,
-       txCertificates   :: TxCertificates build era,
-       txUpdateProposal :: TxUpdateProposal era,
-       txMintValue      :: TxMintValue    build era,
-       txScriptValidity :: TxScriptValidity era
+       txIns              :: TxIns build era,
+       txInsCollateral    :: TxInsCollateral era,
+       txOuts             :: [TxOut CtxTx era],
+       txTotalCollateral  :: TxTotalCollateral era,
+       txReturnCollateral :: TxReturnCollateral CtxTx era,
+       txFee              :: TxFee era,
+       txValidityRange    :: (TxValidityLowerBound era,
+                              TxValidityUpperBound era),
+       txMetadata         :: TxMetadataInEra era,
+       txAuxScripts       :: TxAuxScripts era,
+       txExtraKeyWits     :: TxExtraKeyWitnesses era,
+       txProtocolParams   :: BuildTxWith build (Maybe ProtocolParameters),
+       txWithdrawals      :: TxWithdrawals  build era,
+       txCertificates     :: TxCertificates build era,
+       txUpdateProposal   :: TxUpdateProposal era,
+       txMintValue        :: TxMintValue    build era,
+       txScriptValidity   :: TxScriptValidity era
      }
      deriving (Eq, Show)
 
@@ -2070,20 +2116,22 @@ fromLedgerTxBody
   -> TxBodyContent ViewTx era
 fromLedgerTxBody era scriptValidity body scriptdata mAux =
     TxBodyContent
-      { txIns            = fromLedgerTxIns            era body
-      , txInsCollateral  = fromLedgerTxInsCollateral  era body
-      , txOuts           = fromLedgerTxOuts           era body scriptdata
-      , txFee            = fromLedgerTxFee            era body
-      , txValidityRange  = fromLedgerTxValidityRange  era body
-      , txWithdrawals    = fromLedgerTxWithdrawals    era body
-      , txCertificates   = fromLedgerTxCertificates   era body
-      , txUpdateProposal = fromLedgerTxUpdateProposal era body
-      , txMintValue      = fromLedgerTxMintValue      era body
-      , txExtraKeyWits   = fromLedgerTxExtraKeyWitnesses era body
-      , txProtocolParams = ViewTx
+      { txIns              = fromLedgerTxIns               era body
+      , txInsCollateral    = fromLedgerTxInsCollateral     era body
+      , txOuts             = fromLedgerTxOuts              era body scriptdata
+      , txTotalCollateral  = fromLedgerTxTotalCollateral   era body
+      , txReturnCollateral = fromLedgerTxReturnCollateral  era body
+      , txFee              = fromLedgerTxFee               era body
+      , txValidityRange    = fromLedgerTxValidityRange     era body
+      , txWithdrawals      = fromLedgerTxWithdrawals       era body
+      , txCertificates     = fromLedgerTxCertificates      era body
+      , txUpdateProposal   = fromLedgerTxUpdateProposal    era body
+      , txMintValue        = fromLedgerTxMintValue         era body
+      , txExtraKeyWits     = fromLedgerTxExtraKeyWitnesses era body
+      , txProtocolParams   = ViewTx
       , txMetadata
       , txAuxScripts
-      , txScriptValidity = scriptValidity
+      , txScriptValidity   = scriptValidity
       }
   where
     (txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData era mAux
@@ -2187,6 +2235,46 @@ fromAlonzoTxOut multiAssetInEra scriptDataInEra txdatums
                                               (fromAlonzoData d)
       | otherwise = TxOutDatumHash supported (ScriptDataHash dh)
 
+
+fromLedgerTxTotalCollateral
+  :: ShelleyBasedEra era
+  -> Ledger.TxBody (ShelleyLedgerEra era)
+  -> TxTotalCollateral era
+fromLedgerTxTotalCollateral era txbody =
+  case totalAndReturnCollateralSupportedInEra $ shelleyBasedToCardanoEra era of
+    Nothing -> TxTotalCollateralNone
+    Just supp ->
+      let totColl = obtainTotalCollateralHasFieldConstraint supp $ getField @"totalCollateral" txbody
+      in TxTotalCollateral supp $ fromShelleyLovelace totColl
+ where
+  obtainTotalCollateralHasFieldConstraint
+    :: TxTotalAndReturnCollateralSupportedInEra era
+    -> (HasField "totalCollateral" (Ledger.TxBody (ShelleyLedgerEra era)) Ledger.Coin => a)
+    -> a
+  obtainTotalCollateralHasFieldConstraint TxTotalAndReturnCollateralInBabbageEra f = f
+
+fromLedgerTxReturnCollateral
+  :: ShelleyBasedEra era
+  -> Ledger.TxBody (ShelleyLedgerEra era)
+  -> TxReturnCollateral CtxTx era
+fromLedgerTxReturnCollateral era txbody =
+  case totalAndReturnCollateralSupportedInEra $ shelleyBasedToCardanoEra era of
+    Nothing -> TxReturnCollateralNone
+    Just supp ->
+      case obtainCollateralReturnHasFieldConstraint supp $ getField @"collateralReturn" txbody of
+        SNothing -> TxReturnCollateralNone
+        SJust collReturnOut ->
+          TxReturnCollateral supp $ fromShelleyTxOut era collReturnOut
+ where
+  obtainCollateralReturnHasFieldConstraint
+    :: TxTotalAndReturnCollateralSupportedInEra era
+    -> (HasField "collateralReturn"
+          (Ledger.TxBody (ShelleyLedgerEra era))
+          (StrictMaybe (Ledger.TxOut (ShelleyLedgerEra era))) => a)
+    -> a
+  obtainCollateralReturnHasFieldConstraint TxTotalAndReturnCollateralInBabbageEra f = f
+
+
 fromLedgerTxFee
   :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxFee era
 fromLedgerTxFee era body =
@@ -2578,23 +2666,25 @@ getByronTxBodyContent :: Annotated Byron.Tx ByteString
                       -> TxBodyContent ViewTx ByronEra
 getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) =
     TxBodyContent {
-      txIns            = [ (fromByronTxIn input, ViewTx)
-                         | input <- toList txInputs],
-      txInsCollateral  = TxInsCollateralNone,
-      txOuts           = fromByronTxOut <$> toList txOutputs,
-      txFee            = TxFeeImplicit TxFeesImplicitInByronEra,
-      txValidityRange  = (TxValidityNoLowerBound,
-                          TxValidityNoUpperBound
-                            ValidityNoUpperBoundInByronEra),
-      txMetadata       = TxMetadataNone,
-      txAuxScripts     = TxAuxScriptsNone,
-      txExtraKeyWits   = TxExtraKeyWitnessesNone,
-      txProtocolParams = ViewTx,
-      txWithdrawals    = TxWithdrawalsNone,
-      txCertificates   = TxCertificatesNone,
-      txUpdateProposal = TxUpdateProposalNone,
-      txMintValue      = TxMintNone,
-      txScriptValidity = TxScriptValidityNone
+      txIns              = [ (fromByronTxIn input, ViewTx)
+                           | input <- toList txInputs],
+      txInsCollateral    = TxInsCollateralNone,
+      txOuts             = fromByronTxOut <$> toList txOutputs,
+      txReturnCollateral = TxReturnCollateralNone,
+      txTotalCollateral  = TxTotalCollateralNone,
+      txFee              = TxFeeImplicit TxFeesImplicitInByronEra,
+      txValidityRange    = (TxValidityNoLowerBound,
+                            TxValidityNoUpperBound
+                              ValidityNoUpperBoundInByronEra),
+      txMetadata         = TxMetadataNone,
+      txAuxScripts       = TxAuxScriptsNone,
+      txExtraKeyWits     = TxExtraKeyWitnessesNone,
+      txProtocolParams   = ViewTx,
+      txWithdrawals      = TxWithdrawalsNone,
+      txCertificates     = TxCertificatesNone,
+      txUpdateProposal   = TxUpdateProposalNone,
+      txMintValue        = TxMintNone,
+      txScriptValidity   = TxScriptValidityNone
     }
 
 makeShelleyTransactionBody :: ()

cardano-cli/src/Cardano/CLI/Byron/Tx.hs

@@ -151,6 +151,8 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do
             ]
             TxInsCollateralNone
             outs
+            TxTotalCollateralNone
+            TxReturnCollateralNone
             (TxFeeImplicit TxFeesImplicitInByronEra)
             ( TxValidityNoLowerBound
             , TxValidityNoUpperBound ValidityNoUpperBoundInByronEra
@@ -190,6 +192,8 @@ txSpendUTxOByronPBFT nId sk txIns outs = do
                      ]
                      TxInsCollateralNone
                      outs
+                     TxTotalCollateralNone
+                     TxReturnCollateralNone
                      (TxFeeImplicit TxFeesImplicitInByronEra)
                      ( TxValidityNoLowerBound
                      , TxValidityNoUpperBound ValidityNoUpperBoundInByronEra

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

@@ -378,6 +378,8 @@ runTxBuildRaw (AnyCardanoEra era)
         <*> validateTxInsCollateral
                            era inputsCollateral
         <*> validateTxOuts era txouts
+        <*> pure TxTotalCollateralNone
+        <*> pure TxReturnCollateralNone
         <*> validateTxFee  era mFee
         <*> ((,) <$> validateTxValidityLowerBound era mLowerBound
                  <*> validateTxValidityUpperBound era mUpperBound)
@@ -455,6 +457,8 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
           <$> validateTxIns               era txins
           <*> validateTxInsCollateral     era txinsc
           <*> validateTxOuts              era txouts
+          <*> pure TxTotalCollateralNone -- TODO: Babbage era
+          <*> pure TxReturnCollateralNone -- TODO: Babbage era
           <*> validateTxFee               era dummyFee
           <*> ((,) <$> validateTxValidityLowerBound era mLowerBound
                    <*> validateTxValidityUpperBound era mUpperBound)