diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/ResolvedTx.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/ResolvedTx.hs index 3146b40f18a..546defa170a 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/ResolvedTx.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/ResolvedTx.hs @@ -5,6 +5,7 @@ module Internal.Cardano.Write.Tx.ResolvedTx ( type ResolvedTx , pattern ResolvedTx + , isValid ) where @@ -16,18 +17,29 @@ import Cardano.Ledger.Api ) import Control.Lens ( over + , view + ) +import Data.Set + ( Set ) import Internal.Cardano.Write.Tx ( IsRecentEra , Tx + , TxIn , UTxO (UTxO) ) import qualified Data.Map.Strict as Map import qualified Data.Set as Set +-- | A transaction whose inputs can all be resolved by the associated UTxO set. +-- +-- The UTxO set may also contain additional UTxOs that are not referenced by +-- the transaction. +-- data ResolvedTx era = UnsafeResolvedTx (UTxO era) (Tx era) +{-# COMPLETE ResolvedTx #-} pattern ResolvedTx :: IsRecentEra era => UTxO era -> Tx era -> ResolvedTx era pattern ResolvedTx utxo tx <- UnsafeResolvedTx utxo tx where @@ -42,3 +54,12 @@ construct utxo@(UTxO utxoMap) tx0 = UnsafeResolvedTx utxo tx where tx :: Tx era tx = over (bodyTxL . inputsTxBodyL) (Set.filter (`Map.member` utxoMap)) tx0 + +isValid :: IsRecentEra era => ResolvedTx era -> Bool +isValid = (== Set.empty) . unresolvedInputs + +unresolvedInputs :: IsRecentEra era => ResolvedTx era -> Set TxIn +unresolvedInputs (ResolvedTx (UTxO utxoMap) tx) = + Set.filter + (`Map.notMember` utxoMap) + (view (bodyTxL . inputsTxBodyL) tx) diff --git a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs index af2f63a933c..0450e91e753 100644 --- a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs +++ b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs @@ -33,10 +33,6 @@ module Internal.Cardano.Write.Tx.BalanceSpec import Prelude -import Internal.Cardano.Write.Tx.ResolvedTx - ( type ResolvedTx - , pattern ResolvedTx - ) import Cardano.Api.Ledger ( EpochInterval (..) ) @@ -320,6 +316,10 @@ import Internal.Cardano.Write.Tx.Balance , splitSignedValue , updateTx ) +import Internal.Cardano.Write.Tx.ResolvedTx + ( pattern ResolvedTx + , type ResolvedTx + ) import Internal.Cardano.Write.Tx.Sign ( KeyWitnessCounts (..) , estimateKeyWitnessCounts @@ -2712,6 +2712,28 @@ instance forall era. IsRecentEra era => Arbitrary (PartialTx era) where RecentEraBabbage -> shrinkTxBabbage RecentEraConway -> \_ -> [] -- no shrinker implemented yet +instance forall era. IsRecentEra era => Arbitrary (ResolvedTx era) where + arbitrary = do + tx <- CardanoApi.genTxForBalancing $ cardanoEra @era + utxoForTx <- genUTxOForTx tx + utxoExtra <- genUTxOExtra + let utxoCombined = utxoForTx <> utxoExtra + pure $ ResolvedTx + (fromCardanoApiUTxO utxoCombined) + (fromCardanoApiTx tx) + where + genUTxOExtra = undefined + where + genTxIn = CardanoApi.genTxIn + genUTxOForTx tx = + CardanoApi.UTxO . Map.fromList <$> + mapM (\i -> (i,) <$> genTxOut) (txInputs tx) + genTxOut = + CardanoApi.genTxOut (cardanoEra @era) + txInputs tx = fst <$> CardanoApi.txIns content + where + CardanoApi.Tx (CardanoApi.TxBody content) _ = tx + instance Arbitrary StdGenSeed where arbitrary = StdGenSeed . fromIntegral @Int <$> arbitrary