Merge #3277

3277: Account for collateral outputs within `Primitive.Model`. r=jonathanknowles a=jonathanknowles

## Issue Number

ADP-1718

## Summary

This PR updates the wallet primitive model to correctly account for collateral outputs.

Co-authored-by: Jonathan Knowles <jonathan.knowles@iohk.io>

lib/core/src/Cardano/Wallet/Primitive/Model.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -58,6 +59,8 @@ module Cardano.Wallet.Primitive.Model
     -- ** Exported for testing
     , spendTx
     , utxoFromTx
+    , utxoFromTxOutputs
+    , utxoFromTxCollateralOutputs
     , applyTxToUTxO
     , applyOurTxToUTxO
     , changeUTxO
@@ -103,9 +106,9 @@ import Cardano.Wallet.Primitive.Types.Tx
     , TxMeta (..)
     , TxStatus (..)
     , collateralInputs
-    , failedScriptValidation
     , inputs
     , txOutCoin
+    , txScriptInvalid
     )
 import Cardano.Wallet.Primitive.Types.UTxO
     ( DeltaUTxO, UTxO (..), balance, excluding, excludingD, receiveD )
@@ -484,7 +487,7 @@ changeUTxO
     -> UTxO
 changeUTxO pending = evalState $
     mconcat <$> mapM
-        (UTxO.filterByAddressM isOursState . utxoFromUnvalidatedTx)
+        (UTxO.filterByAddressM isOursState . utxoFromTx)
         (Set.toList pending)
 
 {-------------------------------------------------------------------------------
@@ -535,30 +538,50 @@ spendTxD tx !u =
     u `excludingD` Set.fromList inputsToExclude
   where
     inputsToExclude =
-        if failedScriptValidation tx
+        if txScriptInvalid tx
         then collateralInputs tx
         else inputs tx
 
--- | Construct a 'UTxO' corresponding to a given transaction.
+-- | Generates a UTxO set from a transaction.
 --
--- It is important for the transaction outputs to be ordered correctly,
--- as their index within this ordering determines how
--- they are referenced as transaction inputs in subsequent blocks.
+-- The generated UTxO set corresponds to the value provided by the transaction.
+--
+-- It is important for transaction outputs to be ordered correctly, as their
+-- indices within this ordering will determine how they are referenced as
+-- transaction inputs in subsequent blocks.
+--
+-- Assuming the transaction is not marked as having an invalid script, the
+-- following property should hold:
+--
+-- prop> balance (utxoFromTx tx) = foldMap tokens (outputs tx)
+--
+-- However, if the transaction is marked as having an invalid script, then the
+-- following property should hold:
+--
+-- prop> balance (utxoFromTx tx) = foldMap tokens (collateralOutput tx)
 --
--- > balance (utxoFromTx tx) = foldMap tokens (outputs tx)
--- > utxoFromTx tx `excluding` Set.fromList (inputs tx) = utxoFrom tx
 utxoFromTx :: Tx -> UTxO
 utxoFromTx tx =
-    if failedScriptValidation tx
-    then mempty
-    else utxoFromUnvalidatedTx tx
+    if txScriptInvalid tx
+    then utxoFromTxCollateralOutputs tx
+    else utxoFromTxOutputs tx
 
--- | Similar to 'utxoFromTx', but does not check the validation status.
+-- | Generates a UTxO set from the ordinary outputs of a transaction.
 --
-utxoFromUnvalidatedTx :: Tx -> UTxO
-utxoFromUnvalidatedTx Tx {txId, outputs} =
+-- This function ignores the transaction's script validity.
+--
+utxoFromTxOutputs :: Tx -> UTxO
+utxoFromTxOutputs Tx {txId, outputs} =
     UTxO $ Map.fromList $ zip (TxIn txId <$> [0..]) outputs
 
+-- | Generates a UTxO set from the collateral outputs of a transaction.
+--
+-- This function ignores the transaction's script validity.
+--
+utxoFromTxCollateralOutputs :: Tx -> UTxO
+utxoFromTxCollateralOutputs Tx {txId, collateralOutput} =
+    UTxO $ Map.fromList $ F.toList $ (TxIn txId 0,) <$> collateralOutput
+
 {-------------------------------------------------------------------------------
                         Address ownership and discovery
 -------------------------------------------------------------------------------}
@@ -773,7 +796,7 @@ ourWithdrawalSumFromTx s tx
     -- Therefore, any reward withdrawals included in such a transaction should
     -- also have no effect.
     --
-    | failedScriptValidation tx = Coin 0
+    | txScriptInvalid tx = Coin 0
     | otherwise = Map.foldlWithKey' add (Coin 0) (tx ^. #withdrawals)
   where
     add total account coin

lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs

@@ -68,7 +68,7 @@ module Cardano.Wallet.Primitive.Types.Tx
     , txOutCoin
     , txOutAddCoin
     , txOutSubtractCoin
-    , failedScriptValidation
+    , txScriptInvalid
 
     -- * Constants
     , txOutMinCoin
@@ -744,24 +744,32 @@ data TransactionInfo = TransactionInfo
 
 instance NFData TransactionInfo
 
--- | Indicates whether the script associated with a transaction has passed or
--- failed validation. Pre-Alonzo era, scripts were not supported.
+-- | Indicates whether or not a transaction is marked as having an invalid
+--   script.
+--
+-- Pre-Alonzo era, scripts were not supported.
+--
 data TxScriptValidity
     = TxScriptValid
-    -- ^ Indicates that the script passed validation.
+    -- ^ The transaction is not marked as having an invalid script.
     | TxScriptInvalid
-    -- ^ Indicates that the script failed validation.
+    -- ^ The transaction is marked as having an invalid script.
   deriving (Generic, Show, Eq, Ord)
 
 instance NFData TxScriptValidity
 
--- | Returns 'True' if and only if a transaction has failed script validation.
-failedScriptValidation :: Tx -> Bool
-failedScriptValidation Tx {scriptValidity} = case scriptValidity of
-    Just TxScriptInvalid -> True
-    Just TxScriptValid -> False
-    -- Script validation always passes in eras that don't support scripts
-    Nothing -> False
+-- | Returns 'True' if (and only if) the given transaction is marked as having
+--   an invalid script.
+--
+-- This function does not actually verify the validity of scripts; it merely
+-- checks for the presence or absence of the 'TxScriptInvalid' marker.
+--
+txScriptInvalid :: Tx -> Bool
+txScriptInvalid Tx {scriptValidity} = case scriptValidity of
+  Just TxScriptInvalid -> True
+  Just TxScriptValid -> False
+  -- Script validation always passes in eras that don't support scripts
+  Nothing -> False
 
 -- | Reconstruct a transaction info from a transaction.
 fromTransactionInfo :: TransactionInfo -> Tx