Update build command to automatically calculate the total and return collateral values

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

@@ -50,7 +50,8 @@ import qualified Data.ByteString as BS
 import           Data.ByteString.Short (ShortByteString)
 import           Data.Map (Map)
 import qualified Data.Map as Map
-import           Data.Maybe (fromMaybe, maybeToList)
+import           Data.Maybe (catMaybes, fromMaybe, maybeToList)
+import           Data.Ratio
 import           Data.Sequence.Strict (StrictSeq (..))
 import           Data.Set (Set)
 import qualified Data.Set as Set
@@ -970,28 +971,38 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams
     -- output and fee. Yes this means this current code will only work for
     -- final fee of less than around 4000 ada (2^32-1 lovelace) and change output
     -- of less than around 18 trillion ada  (2^64-1 lovelace).
+
+    let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr
     txbody1 <- first TxBodyError $ -- TODO: impossible to fail now
                makeTransactionBody txbodycontent1 {
                  txFee  = TxFeeExplicit explicitTxFees $ Lovelace (2^(32 :: Integer) - 1),
                  txOuts = TxOut changeaddr
                                 (lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1)
                                 TxOutDatumNone ReferenceScriptNone
-                        : txOuts txbodycontent
+                        : txOuts txbodycontent,
+                 txReturnCollateral = dummyCollRet,
+                 txTotalCollateral = dummyTotColl
+
                }
 
     let nkeys = fromMaybe (estimateTransactionKeyWitnessCount txbodycontent1)
                           mnkeys
         fee   = evaluateTransactionFee pparams txbody1 nkeys 0 --TODO: byron keys
+        (retColl, reqCol) = calcReturnAndTotalCollateral
+                              fee pparams (txInsCollateral txbodycontent)
+                              (txReturnCollateral txbodycontent)
+                              (txTotalCollateral txbodycontent) changeaddr utxo
 
     -- Make a txbody for calculating the balance. For this the size of the tx
     -- does not matter, instead it's just the values of the fee and outputs.
     -- Here we do not want to start with any change output, since that's what
     -- we need to calculate.
     txbody2 <- first TxBodyError $ -- TODO: impossible to fail now
                makeTransactionBody txbodycontent1 {
-                 txFee = TxFeeExplicit explicitTxFees fee
+                 txFee = TxFeeExplicit explicitTxFees fee,
+                 txReturnCollateral = retColl,
+                 txTotalCollateral = reqCol
                }
-
     let balance = evaluateTransactionBalance pparams poolids utxo txbody2
 
     mapM_ (`checkMinUTxOValue` pparams) $ txOuts txbodycontent1
@@ -1005,6 +1016,7 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams
           Nothing -> Left $ TxBodyErrorNonAdaAssetsUnbalanced v
           Just _ -> balanceCheck balance
 
+
     --TODO: we could add the extra fee for the CBOR encoding of the change,
     -- now that we know the magnitude of the change: i.e. 1-8 bytes extra.
 
@@ -1019,10 +1031,89 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams
           txFee  = TxFeeExplicit explicitTxFees fee,
           txOuts = accountForNoChange
                      (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone)
-                     (txOuts txbodycontent)
+                     (txOuts txbodycontent),
+          txReturnCollateral = retColl,
+          txTotalCollateral = reqCol
         }
     return (BalancedTxBody txbody3 (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) fee)
  where
+   -- Essentially we check for the existence of collateral inputs. If they exist we
+   -- create a fictitious collateral return output. Why? Because we need to put dummy values
+   -- to get a fee estimate (i.e we overestimate the fee.)
+   maybeDummyTotalCollAndCollReturnOutput
+     :: TxBodyContent BuildTx era -> AddressInEra era -> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
+   maybeDummyTotalCollAndCollReturnOutput TxBodyContent{txInsCollateral, txReturnCollateral, txTotalCollateral} cAddr =
+     case txInsCollateral of
+       TxInsCollateralNone -> (TxReturnCollateralNone, TxTotalCollateralNone)
+       TxInsCollateral{} ->
+         case totalAndReturnCollateralSupportedInEra era' of
+           Nothing -> (TxReturnCollateralNone, TxTotalCollateralNone)
+           Just retColSup ->
+             let dummyRetCol = TxReturnCollateral
+                                 retColSup
+                                 (TxOut cAddr (lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1)
+                                 TxOutDatumNone ReferenceScriptNone)
+                 dummyTotCol = TxTotalCollateral retColSup (Lovelace (2^(32 :: Integer) - 1))
+             in case (txReturnCollateral, txTotalCollateral) of
+                  (rc@TxReturnCollateral{}, tc@TxTotalCollateral{}) -> (rc, tc)
+                  (rc@TxReturnCollateral{},TxTotalCollateralNone) -> (rc, dummyTotCol)
+                  (TxReturnCollateralNone,tc@TxTotalCollateral{}) -> (dummyRetCol, tc)
+                  (TxReturnCollateralNone, TxTotalCollateralNone) -> (dummyRetCol, dummyTotCol)
+   -- Calculation taken from validateInsufficientCollateral: https://github.com/input-output-hk/cardano-ledger/blob/389b266d6226dedf3d2aec7af640b3ca4984c5ea/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs#L335
+   -- TODO: Bug Jared to expose a function from the ledger that returns total and return collateral.
+   calcReturnAndTotalCollateral
+     :: Lovelace -- ^ Fee
+     -> ProtocolParameters
+     -> TxInsCollateral era -- ^ From the initial TxBodyContent
+     -> TxReturnCollateral CtxTx era -- ^ From the initial TxBodyContent
+     -> TxTotalCollateral era -- ^ From the initial TxBodyContent
+     -> AddressInEra era -- ^ Change address
+     -> UTxO era
+     -> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
+   calcReturnAndTotalCollateral _ _ TxInsCollateralNone _ _ _ _= (TxReturnCollateralNone, TxTotalCollateralNone)
+   calcReturnAndTotalCollateral _ _ _ rc@TxReturnCollateral{} tc@TxTotalCollateral{} _ _ = (rc,tc)
+   calcReturnAndTotalCollateral fee pp (TxInsCollateral _ collIns) txReturnCollateral txTotalCollateral cAddr (UTxO utxo') = do
+
+    case totalAndReturnCollateralSupportedInEra era' of
+      Nothing -> (TxReturnCollateralNone, TxTotalCollateralNone)
+      Just retColSup ->
+        case protocolParamCollateralPercent pp of
+          Nothing -> (TxReturnCollateralNone, TxTotalCollateralNone)
+          Just colPerc -> do
+            -- We must first figure out how much lovelace we have committed
+            -- as collateral and we must determine if we have enough lovelace at our
+            -- collateral tx inputs to cover the tx
+            let txOuts = catMaybes [ Map.lookup txin utxo' | txin <- collIns]
+                totalCollateralLovelace = mconcat $ map (\(TxOut _ txOutVal _ _) -> txOutValueToLovelace txOutVal) txOuts
+                requiredCollateral@(Lovelace reqAmt) = fromIntegral colPerc * fee
+                totalCollateral = TxTotalCollateral retColSup . fromShelleyLovelace
+                                                              . Ledger.rationalToCoinViaCeiling
+                                                              $ reqAmt % 100
+                -- Why * 100? requiredCollateral is the product of the collateral percentage and the tx fee
+                -- We choose to multiply 100 rather than divide by 100 to make the calculation
+                -- easier to manage. At the end of the calculation we then use % 100 to perform our division
+                -- and round up.
+                enoughCollateral = totalCollateralLovelace * 100 >= requiredCollateral
+                Lovelace amt = totalCollateralLovelace * 100 - requiredCollateral
+                returnCollateral = fromShelleyLovelace . Ledger.rationalToCoinViaFloor $ amt % 100
+
+            case (txReturnCollateral, txTotalCollateral) of
+              (rc@TxReturnCollateral{}, tc@TxTotalCollateral{}) ->
+                (rc, tc)
+              (rc@TxReturnCollateral{}, TxTotalCollateralNone) ->
+                (rc, TxTotalCollateralNone)
+              (TxReturnCollateralNone, tc@TxTotalCollateral{}) ->
+                (TxReturnCollateralNone, tc)
+              (TxReturnCollateralNone, TxTotalCollateralNone) ->
+                if enoughCollateral
+                then
+                  ( TxReturnCollateral
+                      retColSup
+                      (TxOut cAddr (lovelaceToTxOutValue returnCollateral) TxOutDatumNone ReferenceScriptNone)
+                  , totalCollateral
+                  )
+                else (TxReturnCollateralNone, TxTotalCollateralNone)
+
    era :: ShelleyBasedEra era
    era = shelleyBasedEra
 

cardano-cli/src/Cardano/CLI/Run/Friendly.hs

@@ -72,6 +72,8 @@ friendlyTxBody
       , txMetadata
       , txMintValue
       , txOuts
+      , txTotalCollateral
+      , txReturnCollateral
       , txInsReference
       , txUpdateProposal
       , txValidityRange
@@ -87,13 +89,24 @@ friendlyTxBody
     , "mint" .= friendlyMintValue txMintValue
     , "outputs" .= map friendlyTxOut txOuts
     , "reference inputs" .= friendlyReferenceInputs txInsReference
+    , "total collateral" .= friendlyTotalCollateral txTotalCollateral
+    , "return collateral" .= friendlyReturnCollateral txReturnCollateral
     , "required signers (payment key hashes needed for scripts)" .=
         friendlyExtraKeyWits txExtraKeyWits
     , "update proposal" .= friendlyUpdateProposal txUpdateProposal
     , "validity range" .= friendlyValidityRange era txValidityRange
     , "withdrawals" .= friendlyWithdrawals txWithdrawals
     ]
 
+friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value
+friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null
+friendlyTotalCollateral (TxTotalCollateral _ coll) = toJSON coll
+
+friendlyReturnCollateral
+  :: IsCardanoEra era => TxReturnCollateral CtxTx era -> Aeson.Value
+friendlyReturnCollateral TxReturnCollateralNone = Aeson.Null
+friendlyReturnCollateral (TxReturnCollateral _ collOut) = friendlyTxOut collOut
+
 friendlyExtraKeyWits :: TxExtraKeyWitnesses era -> Aeson.Value
 friendlyExtraKeyWits = \case
   TxExtraKeyWitnessesNone -> Null
@@ -185,8 +198,6 @@ friendlyTxOut (TxOut addr amount mdatum script) =
     scriptDataToJson ScriptDataJsonDetailedSchema sData
 
 
-          -- datum ShelleyBasedEraBabbage = panic "TODO: Babbage"
-
 friendlyStakeReference :: StakeAddressReference -> Aeson.Value
 friendlyStakeReference = \case
   NoStakeAddress -> Null

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

@@ -542,22 +542,14 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
           Just qeInMode -> do
             newExceptT . fmap (join . first ShelleyTxCmdAcquireFailure) $
               executeLocalStateQueryExpr localNodeConnInfo Nothing $ \_ntcVersion -> runExceptT $ do
-                unless (null txinsc) $ do
-                  -- TODO: Question, why do we not need the collateralUtxo to be included in
-                  -- the utxo?
-                  collateralUtxo <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . newExceptT . queryExpr
-                    $ QueryInEra qeInMode
-                    $ QueryInShelleyBasedEra qSbe (QueryUTxO . QueryUTxOByTxIn $ Set.fromList txinsc)
-                  txinsExist txinsc collateralUtxo
-                  notScriptLockedTxIns collateralUtxo
-
                 qUtxo <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . newExceptT . queryExpr
                   $ QueryInEra qeInMode $ QueryInShelleyBasedEra qSbe
-                  $ QueryUTxO (QueryUTxOByTxIn (Set.fromList $ inputsThatRequireWitnessing ++ allReferenceInputs))
+                  $ QueryUTxO (QueryUTxOByTxIn (Set.fromList $ inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc))
 
                 utxo <- case first ShelleyTxCmdTxEraCastErr (eraCast era qUtxo) of { Right a -> pure a; Left e -> left e }
 
-                txinsExist inputsThatRequireWitnessing utxo
+                txinsExist (inputsThatRequireWitnessing ++ txinsc) utxo
+                notScriptLockedTxIns txinsc utxo
 
                 pparams <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . newExceptT . queryExpr
                   $ QueryInEra qeInMode $ QueryInShelleyBasedEra qSbe QueryProtocolParameters
@@ -582,7 +574,6 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
           $ makeTransactionBodyAutoBalance eInMode systemStart eraHistory
                                            pparams stakePools utxo txBodyContent
                                            cAddr mOverrideWits
-
       putStrLn $ "Estimated transaction fee: " <> (show fee :: String)
 
       case outputOptions of
@@ -625,10 +616,11 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
           then return ()
           else left . ShelleyTxCmdTxInsDoNotExist $ ins \\ ins `intersect` occursInUtxo
 
-    notScriptLockedTxIns :: Monad m => UTxO era -> ExceptT ShelleyTxCmdError m ()
-    notScriptLockedTxIns (UTxO utxo) = do
-      let scriptLockedTxIns =
-            filter (\(_, TxOut aInEra _ _ _) -> not $ isKeyAddress aInEra ) $ Map.assocs utxo
+    notScriptLockedTxIns :: Monad m => [TxIn] -> UTxO era -> ExceptT ShelleyTxCmdError m ()
+    notScriptLockedTxIns collTxIns (UTxO utxo) = do
+      let onlyCollateralUTxOs = Map.restrictKeys utxo $ Set.fromList collTxIns
+          scriptLockedTxIns =
+            filter (\(_, TxOut aInEra _ _ _) -> not $ isKeyAddress aInEra ) $ Map.assocs onlyCollateralUTxOs
       if null scriptLockedTxIns
       then return ()
       else left . ShelleyTxCmdExpectedKeyLockedTxIn $ map fst scriptLockedTxIns

cardano-cli/test/data/golden/allegra/transaction-view.out

@@ -18,6 +18,8 @@ outputs:
     stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
 reference inputs: null
 required signers (payment key hashes needed for scripts): null
+return collateral: null
+total collateral: null
 update proposal: null
 validity range:
   lower bound: null

cardano-cli/test/data/golden/alonzo/signed-transaction-view.out

@@ -13,6 +13,8 @@ reference inputs: null
 required signers (payment key hashes needed for scripts):
 - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27
 - fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4
+return collateral: null
+total collateral: null
 update proposal: null
 validity range:
   lower bound: null

cardano-cli/test/data/golden/alonzo/transaction-view.out

@@ -13,6 +13,8 @@ reference inputs: null
 required signers (payment key hashes needed for scripts):
 - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27
 - fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4
+return collateral: null
+total collateral: null
 update proposal:
   epoch: 190
   updates:

cardano-cli/test/data/golden/byron/transaction-view.out

@@ -13,6 +13,8 @@ outputs:
   amount: 68 Lovelace
 reference inputs: null
 required signers (payment key hashes needed for scripts): null
+return collateral: null
+total collateral: null
 update proposal: null
 validity range: null
 withdrawals: null

cardano-cli/test/data/golden/mary/transaction-view.out

@@ -35,6 +35,8 @@ outputs:
     stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0
 reference inputs: null
 required signers (payment key hashes needed for scripts): null
+return collateral: null
+total collateral: null
 update proposal: null
 validity range:
   lower bound: 140

cardano-cli/test/data/golden/shelley/transaction-view.out

@@ -46,6 +46,8 @@ outputs:
   stake reference: null
 reference inputs: null
 required signers (payment key hashes needed for scripts): null
+return collateral: null
+total collateral: null
 update proposal:
   epoch: 64
   updates:

scripts/babbage/example-babbage-script-usage.sh

@@ -157,9 +157,10 @@ echo "$mintpolicyid"
 #  --fee "1000000" \
 #  --protocol-params-file "$WORK/pparams.json"
 #   --tx-out-return-collateral
-#
 returncollateral=$(expr $suppliedCollateral - 529503)
 
+echo "Return collateral amount"
+echo "$returncollateral"
 
 $CARDANO_CLI transaction build \
   --babbage-era \