From 70d439f409aa1ce080819ab317c528f7ff9bdfe1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Fri, 29 Apr 2022 11:54:11 -0400
Subject: [PATCH 01/11] Optinally store validator and redeemer in
 ValidatorUTXOs

---
 .../plutus-context-builder.cabal              |  5 +-
 .../src/Test/Plutus/ContextBuilder.hs         | 12 +++-
 .../Test/Plutus/ContextBuilder/Internal.hs    | 59 +++++++++++++++++--
 .../Test/Tasty/Plutus/Internal/TestScript.hs  | 48 ++++++---------
 4 files changed, 84 insertions(+), 40 deletions(-)

diff --git a/plutus-context-builder/plutus-context-builder.cabal b/plutus-context-builder/plutus-context-builder.cabal
index 8f5e135e..7ce4d4cd 100644
--- a/plutus-context-builder/plutus-context-builder.cabal
+++ b/plutus-context-builder/plutus-context-builder.cabal
@@ -44,9 +44,10 @@ common lang
 
 library
   import:          lang
-  exposed-modules: Test.Plutus.ContextBuilder
+  exposed-modules:
+      Test.Plutus.ContextBuilder
+    , Test.Plutus.ContextBuilder.Internal
   other-modules:
-    Test.Plutus.ContextBuilder.Internal
     Test.Plutus.ContextBuilder.Minting
 
   build-depends:
diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
index f9290af4..81ebbde5 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
@@ -182,7 +182,11 @@ validatorInput ::
   ValidatorUTXO d ->
   ContextBuilder ( 'ForSpending d r) 'Anonymous
 validatorInput name x =
-  NoNames $ mempty {cfValidatorInputs = ValidatorUTXOs $ Map.singleton name x}
+  NoNames $
+    mempty
+      { cfValidatorInputs =
+          ValidatorUTXOs $ Map.singleton name (x, Nothing)
+      }
 
 {- | Anonymous context from a single 'SideUTXO' output.
 
@@ -205,7 +209,11 @@ validatorOutput ::
   ValidatorUTXO d ->
   ContextBuilder ( 'ForSpending d r) 'Anonymous
 validatorOutput name x =
-  NoNames $ mempty {cfValidatorOutputs = ValidatorUTXOs $ Map.singleton name x}
+  NoNames $
+    mempty
+      { cfValidatorOutputs =
+          ValidatorUTXOs $ Map.singleton name (x, Nothing)
+      }
 
 {- | Anonymous context signed with one signature.
 
diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
index 215f9b6f..fe37e50c 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
@@ -1,5 +1,13 @@
 module Test.Plutus.ContextBuilder.Internal (
   -- * Types
+  TestScript (
+    TestValidator,
+    getTestValidator,
+    getTestValidatorCode,
+    TestMintingPolicy,
+    getTestMintingPolicy,
+    getTestMintingPolicyCode
+  ),
   TransactionConfig (..),
   InputPosition (..),
   Purpose (..),
@@ -37,6 +45,7 @@ import Data.Sequence (Seq)
 import Data.Sequence qualified as Seq
 import Data.Text (Text)
 import GHC.Exts (toList)
+import Ledger (scriptAddress)
 import Ledger.Scripts (datumHash)
 import Plutus.V1.Ledger.Address (pubKeyHashAddress, scriptHashAddress)
 import Plutus.V1.Ledger.Api (
@@ -45,6 +54,7 @@ import Plutus.V1.Ledger.Api (
   Datum (Datum),
   DatumHash,
   FromData,
+  MintingPolicy,
   PubKeyHash,
   ScriptContext (ScriptContext),
   ScriptPurpose (Minting, Spending),
@@ -76,6 +86,7 @@ import Plutus.V1.Ledger.Api (
     txOutValue
   ),
   TxOutRef (TxOutRef),
+  Validator,
   ValidatorHash,
   Value,
  )
@@ -83,6 +94,7 @@ import Plutus.V1.Ledger.Interval (Interval, always)
 import Plutus.V1.Ledger.Time (POSIXTime)
 import Plutus.V1.Ledger.Value qualified as Value
 import Plutus.V1.Ledger.Value.Extra (filterValue)
+import PlutusTx (CompiledCode)
 import PlutusTx.Positive (Positive, getPositive)
 import Test.Plutus.ContextBuilder.Minting (
   MintingPolicyAction (BurnAction, MintAction),
@@ -93,6 +105,33 @@ import Test.Plutus.ContextBuilder.Minting (
 import PlutusTx.Prelude (length)
 import Prelude hiding (length)
 
+{- | Typed wrapper for the 'Validator' and 'MintingPolicy' used to match
+ the datum and redeemer types of the 'Validator' and the data passed to it.
+
+ We don't expose constructors. To create a 'TestScript', use helper functions,
+ such as 'mkTestValidator' and 'mkTestMintingPolicy'. In case you intend
+ to test something tricky, you can use 'mkTestValidatorUnsafe'
+ and 'mkTestMintingPolicyUnsafe' to create a 'TestScript'
+ that accepts a datum and/or redeemer inconsistent with its internal type.
+
+ @since 6.0
+-}
+data TestScript (p :: Purpose) where
+  -- | since 6.0
+  TestValidator ::
+    forall (d :: Type) (r :: Type) (code :: Type).
+    { getTestValidatorCode :: CompiledCode code
+    , getTestValidator :: Validator
+    } ->
+    TestScript ( 'ForSpending d r)
+  -- | since 6.0
+  TestMintingPolicy ::
+    forall (r :: Type) (code :: Type).
+    { getTestMintingPolicyCode :: CompiledCode code
+    , getTestMintingPolicy :: MintingPolicy
+    } ->
+    TestScript ( 'ForMinting r)
+
 {- Config with the parameters necessary to build the context.
 
  @since 1.0
@@ -261,11 +300,13 @@ data ValidatorUTXOs (p :: Purpose) where
   ValidatorUTXOs ::
     forall (datum :: Type) (redeemer :: Type).
     (FromData datum, ToData datum, Show datum) =>
-    Map.Map Text (ValidatorUTXO datum) ->
+    Map.Map Text (ValidatorUTXO datum, Maybe (TestScript ( 'ForSpending datum redeemer), redeemer)) ->
     ValidatorUTXOs ( 'ForSpending datum redeemer)
 
 -- | @since 1.0
-deriving stock instance Show (ValidatorUTXOs p)
+instance Show (ValidatorUTXOs p) where
+  show NoValidatorUTXOs = "NoValidatorUTXOs"
+  show (ValidatorUTXOs utxos) = "ValidatorUTXOs " <> show (fst <$> utxos)
 
 -- | @since 1.0
 instance Semigroup (ValidatorUTXOs p) where
@@ -600,7 +641,7 @@ validatorUtxosToDatum ::
 validatorUtxosToDatum = \case
   NoValidatorUTXOs -> []
   ValidatorUTXOs m ->
-    map (\(ValidatorUTXO dt _) -> datumWithHash . toBuiltinData $ dt) $ Map.elems m
+    map (\(ValidatorUTXO dt _, _) -> datumWithHash . toBuiltinData $ dt) $ Map.elems m
 
 datumWithHash :: BuiltinData -> (DatumHash, Datum)
 datumWithHash dt = (datumHash dt', dt')
@@ -617,17 +658,23 @@ sideUtxoToTxOut conf (SideUTXO typ valType) =
           TxOut (scriptHashAddress hash) val . justDatumHash $ dat
 
 validatorUtxoToTxOut ::
-  forall (d :: Type).
+  forall (d :: Type) (r :: Type).
   (ToData d) =>
   TransactionConfig ->
-  ValidatorUTXO d ->
+  (ValidatorUTXO d, Maybe (TestScript ( 'ForSpending d r), r)) ->
   TxOut
-validatorUtxoToTxOut conf (ValidatorUTXO dat val) =
+validatorUtxoToTxOut conf (ValidatorUTXO dat val, Nothing) =
   TxOut
     { txOutAddress = scriptHashAddress $ testValidatorHash conf
     , txOutValue = val
     , txOutDatumHash = justDatumHash $ toBuiltinData dat
     }
+validatorUtxoToTxOut _conf (ValidatorUTXO dat val, Just (validator, _red)) =
+  TxOut
+    { txOutAddress = scriptAddress $ getTestValidator validator
+    , txOutValue = val
+    , txOutDatumHash = justDatumHash $ toBuiltinData dat
+    }
 
 createTxInInfos ::
   forall (p :: Purpose).
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Internal/TestScript.hs b/tasty-plutus/src/Test/Tasty/Plutus/Internal/TestScript.hs
index 1f91128e..944b80fb 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Internal/TestScript.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Internal/TestScript.hs
@@ -2,7 +2,14 @@
 
 module Test.Tasty.Plutus.Internal.TestScript (
   -- * Types
-  TestScript (..),
+  TestScript (
+    TestValidator,
+    getTestValidator,
+    getTestValidatorCode,
+    TestMintingPolicy,
+    getTestMintingPolicy,
+    getTestMintingPolicyCode
+  ),
   WrappedValidator (..),
   WrappedMintingPolicy (..),
 
@@ -16,9 +23,7 @@ module Test.Tasty.Plutus.Internal.TestScript (
 ) where
 
 import Data.Kind (Type)
-import Ledger.Typed.Scripts (Validator)
 import Plutus.V1.Ledger.Api (
-  MintingPolicy,
   mkMintingPolicyScript,
   mkValidatorScript,
  )
@@ -28,33 +33,16 @@ import PlutusTx.IsData.Class (FromData (fromBuiltinData))
 import PlutusTx.TH (compile)
 import PlutusTx.Trace (traceError)
 import Test.Plutus.ContextBuilder (Purpose (ForMinting, ForSpending))
-
-{- | Typed wrapper for the 'Validator' and 'MintingPolicy' used to match
- the datum and redeemer types of the 'Validator' and the data passed to it.
-
- We don't expose constructors. To create a 'TestScript', use helper functions,
- such as 'mkTestValidator' and 'mkTestMintingPolicy'. In case you intend
- to test something tricky, you can use 'mkTestValidatorUnsafe'
- and 'mkTestMintingPolicyUnsafe' to create a 'TestScript'
- that accepts a datum and/or redeemer inconsistent with its internal type.
-
- @since 6.0
--}
-data TestScript (p :: Purpose) where
-  -- | since 6.0
-  TestValidator ::
-    forall (d :: Type) (r :: Type) (code :: Type).
-    { getTestValidatorCode :: CompiledCode code
-    , getTestValidator :: Validator
-    } ->
-    TestScript ( 'ForSpending d r)
-  -- | since 6.0
-  TestMintingPolicy ::
-    forall (r :: Type) (code :: Type).
-    { getTestMintingPolicyCode :: CompiledCode code
-    , getTestMintingPolicy :: MintingPolicy
-    } ->
-    TestScript ( 'ForMinting r)
+import Test.Plutus.ContextBuilder.Internal (
+  TestScript (
+    TestMintingPolicy,
+    TestValidator,
+    getTestMintingPolicy,
+    getTestMintingPolicyCode,
+    getTestValidator,
+    getTestValidatorCode
+  ),
+ )
 
 {- | A wrapper for an untyped 'Validator'. This is similar
  to 'WrappedValidatorType' from the Plutus 'Ledger.Typed.Scripts' module.

From f8a7c6cb3a3c32d6ee802cf7c36e7039b4d48ae3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Fri, 29 Apr 2022 13:32:09 -0400
Subject: [PATCH 02/11] Introduced the ForTransaction purpose

---
 .../src/Test/Plutus/ContextBuilder.hs         | 48 +++++++++++--
 .../Test/Plutus/ContextBuilder/Internal.hs    | 71 +++++++++++++++----
 2 files changed, 100 insertions(+), 19 deletions(-)

diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
index 81ebbde5..b675add1 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
@@ -25,6 +25,7 @@ module Test.Plutus.ContextBuilder (
   ValueType (..),
   SideUTXO (..),
   ValidatorUTXO (..),
+  SomeValidatedUTXO (..),
   TestUTXO (..),
   ValidatorUTXOs (..),
   Minting (..),
@@ -42,8 +43,10 @@ module Test.Plutus.ContextBuilder (
   -- ** Basic construction
   input,
   validatorInput,
+  validatedInput,
   output,
   validatorOutput,
+  validatedOutput,
   signedWith,
   datum,
   addDatum,
@@ -123,8 +126,9 @@ import Test.Plutus.ContextBuilder.Internal (
   InputPosition (Head, Tail),
   Minting (Mint),
   Naming (Anonymous, Named),
-  Purpose (ForMinting, ForSpending),
+  Purpose (ForMinting, ForSpending, ForTransaction),
   SideUTXO (SideUTXO, sUtxoType, sUtxoValue),
+  SomeValidatedUTXO (SomeValidatedUTXO, someRedeemer, someSpendingScript, someUTxO),
   TestUTXO (TestUTXO, tUtxoDatum, tUtxoValue),
   TransactionConfig (
     TransactionConfig,
@@ -137,7 +141,7 @@ import Test.Plutus.ContextBuilder.Internal (
   ),
   UTXOType (PubKeyUTXO, ScriptUTXO),
   ValidatorUTXO (ValidatorUTXO, vUtxoDatum, vUtxoValue),
-  ValidatorUTXOs (NoValidatorUTXOs, ValidatorUTXOs),
+  ValidatorUTXOs (MultiValidatorUTXOs, NoValidatorUTXOs, ValidatorUTXOs),
   ValueType (GeneralValue, TokensValue),
   defTransactionConfig,
   makeIncompleteContexts,
@@ -185,7 +189,28 @@ validatorInput name x =
   NoNames $
     mempty
       { cfValidatorInputs =
-          ValidatorUTXOs $ Map.singleton name (x, Nothing)
+          ValidatorUTXOs $ Map.singleton name x
+      }
+
+{- | Anonymous context from a single 'SomeValidatedUTXO' input.
+
+ = Note
+
+ This input won't be used for spending in any 'ScriptPurpose' of any
+ 'ScriptContext' built from this.
+
+ @since 2.1
+-}
+validatedInput ::
+  -- | Name of the input
+  Text ->
+  SomeValidatedUTXO ->
+  ContextBuilder 'ForTransaction 'Anonymous
+validatedInput name x =
+  NoNames $
+    mempty
+      { cfValidatorInputs =
+          MultiValidatorUTXOs $ Map.singleton name x
       }
 
 {- | Anonymous context from a single 'SideUTXO' output.
@@ -212,7 +237,22 @@ validatorOutput name x =
   NoNames $
     mempty
       { cfValidatorOutputs =
-          ValidatorUTXOs $ Map.singleton name (x, Nothing)
+          ValidatorUTXOs $ Map.singleton name x
+      }
+
+{- | Anonymous context from a single 'SomeValidatedUTXO' output.
+
+ @since 2.1
+-}
+validatedOutput ::
+  Text ->
+  SomeValidatedUTXO ->
+  ContextBuilder 'ForTransaction 'Anonymous
+validatedOutput name x =
+  NoNames $
+    mempty
+      { cfValidatorOutputs =
+          MultiValidatorUTXOs $ Map.singleton name x
       }
 
 {- | Anonymous context signed with one signature.
diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
index fe37e50c..f239f800 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
 module Test.Plutus.ContextBuilder.Internal (
   -- * Types
   TestScript (
@@ -14,6 +16,7 @@ module Test.Plutus.ContextBuilder.Internal (
   UTXOType (..),
   ValueType (..),
   SideUTXO (..),
+  SomeValidatedUTXO (..),
   ValidatorUTXO (..),
   ValidatorUTXOs (..),
   TestUTXO (..),
@@ -200,6 +203,10 @@ data Purpose where
     -- | @since 1.0
     redeemer ->
     Purpose
+  -- | This tag applies to whole-transaction testing.
+  --
+  -- @since 2.1
+  ForTransaction :: Purpose
 
 {- | Represents metadata of UTxO at different types of address.
 
@@ -260,7 +267,7 @@ data SideUTXO = SideUTXO
 
 {- | An UTxO at the tested validator address.
 This UTxO won't be used as 'Spending' in the 'ScriptPurpose'
-of the builded 'ScriptContext'. For the representation of a 'Spending' UTxO
+of the built 'ScriptContext'. For the representation of a 'Spending' UTxO
 use 'TestUTXO'.
 
  @since 2.0
@@ -275,7 +282,7 @@ data ValidatorUTXO (datum :: Type) = ValidatorUTXO
     )
 
 {- | UTxO at the tested validator address. It will be used as 'Spending'
- in the 'ScriptPurpose' of the builded 'ScriptContext'.
+ in the 'ScriptPurpose' of the built 'ScriptContext'.
 
  @since 2.0
 -}
@@ -300,19 +307,41 @@ data ValidatorUTXOs (p :: Purpose) where
   ValidatorUTXOs ::
     forall (datum :: Type) (redeemer :: Type).
     (FromData datum, ToData datum, Show datum) =>
-    Map.Map Text (ValidatorUTXO datum, Maybe (TestScript ( 'ForSpending datum redeemer), redeemer)) ->
+    Map.Map Text (ValidatorUTXO datum) ->
     ValidatorUTXOs ( 'ForSpending datum redeemer)
+  -- | @since 2.1
+  MultiValidatorUTXOs ::
+    Map.Map Text SomeValidatedUTXO ->
+    ValidatorUTXOs 'ForTransaction
+
+{- | An UTxO at a specified validator address. It will be used as 'Spending'
+ in the 'ScriptPurpose' of the built 'ScriptContext'.
+
+ @since 2.1
+-}
+data SomeValidatedUTXO where
+  SomeValidatedUTXO ::
+    forall (datum :: Type) (redeemer :: Type).
+    (FromData datum, ToData datum, Show datum, Show redeemer) =>
+    { someUTxO :: ValidatorUTXO datum
+    , someSpendingScript :: TestScript ( 'ForSpending datum redeemer)
+    , someRedeemer :: redeemer
+    } ->
+    SomeValidatedUTXO
 
 -- | @since 1.0
-instance Show (ValidatorUTXOs p) where
-  show NoValidatorUTXOs = "NoValidatorUTXOs"
-  show (ValidatorUTXOs utxos) = "ValidatorUTXOs " <> show (fst <$> utxos)
+deriving stock instance Show (ValidatorUTXOs p)
+
+instance Show SomeValidatedUTXO where
+  show SomeValidatedUTXO {someUTxO, someRedeemer} =
+    "SomeValidatedUTXO{someUTxO= " <> shows someUTxO (", someRedeemer= " <> shows someRedeemer "}")
 
 -- | @since 1.0
 instance Semigroup (ValidatorUTXOs p) where
   NoValidatorUTXOs <> x = x
   x <> NoValidatorUTXOs = x
   (ValidatorUTXOs m1) <> (ValidatorUTXOs m2) = ValidatorUTXOs $ m1 <> m2
+  MultiValidatorUTXOs m1 <> MultiValidatorUTXOs m2 = MultiValidatorUTXOs $ m1 <> m2
 
 -- | @since 1.0
 instance Monoid (ValidatorUTXOs p) where
@@ -641,7 +670,13 @@ validatorUtxosToDatum ::
 validatorUtxosToDatum = \case
   NoValidatorUTXOs -> []
   ValidatorUTXOs m ->
-    map (\(ValidatorUTXO dt _, _) -> datumWithHash . toBuiltinData $ dt) $ Map.elems m
+    map (\(ValidatorUTXO dt _) -> datumWithHash . toBuiltinData $ dt) $ Map.elems m
+  MultiValidatorUTXOs m ->
+    map
+      ( \SomeValidatedUTXO {someUTxO = ValidatorUTXO dt _} ->
+          datumWithHash . toBuiltinData $ dt
+      )
+      $ Map.elems m
 
 datumWithHash :: BuiltinData -> (DatumHash, Datum)
 datumWithHash dt = (datumHash dt', dt')
@@ -658,23 +693,28 @@ sideUtxoToTxOut conf (SideUTXO typ valType) =
           TxOut (scriptHashAddress hash) val . justDatumHash $ dat
 
 validatorUtxoToTxOut ::
-  forall (d :: Type) (r :: Type).
+  forall (d :: Type).
   (ToData d) =>
   TransactionConfig ->
-  (ValidatorUTXO d, Maybe (TestScript ( 'ForSpending d r), r)) ->
+  ValidatorUTXO d ->
   TxOut
-validatorUtxoToTxOut conf (ValidatorUTXO dat val, Nothing) =
+validatorUtxoToTxOut conf (ValidatorUTXO dat val) =
   TxOut
     { txOutAddress = scriptHashAddress $ testValidatorHash conf
     , txOutValue = val
     , txOutDatumHash = justDatumHash $ toBuiltinData dat
     }
-validatorUtxoToTxOut _conf (ValidatorUTXO dat val, Just (validator, _red)) =
+
+someValidatedUtxoToTxOut ::
+  SomeValidatedUTXO ->
   TxOut
-    { txOutAddress = scriptAddress $ getTestValidator validator
-    , txOutValue = val
-    , txOutDatumHash = justDatumHash $ toBuiltinData dat
-    }
+someValidatedUtxoToTxOut
+  SomeValidatedUTXO {someUTxO = ValidatorUTXO dat val, someSpendingScript = validator} =
+    TxOut
+      { txOutAddress = scriptAddress $ getTestValidator validator
+      , txOutValue = val
+      , txOutDatumHash = justDatumHash $ toBuiltinData dat
+      }
 
 createTxInInfos ::
   forall (p :: Purpose).
@@ -698,6 +738,7 @@ createTxOuts conf sideUtxos valUtxos =
       valTxOuts = case valUtxos of
         NoValidatorUTXOs -> []
         ValidatorUTXOs m -> fmap (validatorUtxoToTxOut conf) $ Map.elems m
+        MultiValidatorUTXOs m -> fmap someValidatedUtxoToTxOut $ Map.elems m
    in valTxOuts <> sideTxOuts
 
 createOwnTxInInfo :: TransactionConfig -> BuiltinData -> Value -> TxInInfo

From fdb174ab833f6cf350a55cd782b757008153b180 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Fri, 29 Apr 2022 13:52:43 -0400
Subject: [PATCH 03/11] Added foldBuilt

---
 .../src/Test/Plutus/ContextBuilder.hs         |  2 ++
 .../Test/Plutus/ContextBuilder/Internal.hs    | 19 ++++++++++++++++---
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
index b675add1..4788fcb0 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
@@ -88,6 +88,7 @@ module Test.Plutus.ContextBuilder (
   -- ** Direct
   liftContextFragment,
   liftNamedContextFragment,
+  foldBuilt,
 
   -- ** Build finished context
   spendingScriptContext,
@@ -144,6 +145,7 @@ import Test.Plutus.ContextBuilder.Internal (
   ValidatorUTXOs (MultiValidatorUTXOs, NoValidatorUTXOs, ValidatorUTXOs),
   ValueType (GeneralValue, TokensValue),
   defTransactionConfig,
+  foldBuilt,
   makeIncompleteContexts,
   mintingScriptContext,
   mintingScriptContextDef,
diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
index f239f800..569d3cec 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
@@ -32,6 +32,7 @@ module Test.Plutus.ContextBuilder.Internal (
   spendingScriptContextDef,
   mintingScriptContextDef,
   makeIncompleteContexts,
+  foldBuilt,
 ) where
 
 import Control.Arrow ((***))
@@ -608,9 +609,7 @@ baseTxInfo ::
   TransactionConfig ->
   ContextBuilder p n ->
   TxInfo
-baseTxInfo conf = \case
-  NoNames cf -> go cf
-  WithNames cfs -> go . fold $ cfs
+baseTxInfo conf = go . foldBuilt
   where
     go :: ContextFragment p -> TxInfo
     go cf =
@@ -651,6 +650,20 @@ baseTxInfo conf = \case
         , txInfoId = TxId "testTx"
         }
 
+{- | Turns an arbitrary 'ContextBuilder' into a 'ContextFragment'.
+
+= Note
+
+ This is a low-level operation designed for maximum control. If possible, use
+ the other, higher-level, operations in this module instead.
+
+   @since 2.1
+-}
+foldBuilt :: ContextBuilder p n -> ContextFragment p
+foldBuilt = \case
+  NoNames cf -> cf
+  WithNames cfs -> fold cfs
+
 checkSideUtxoAddress :: TransactionConfig -> SideUTXO -> Bool
 checkSideUtxoAddress conf (SideUTXO typ _) =
   let sideAddress = case typ of

From d33ffa3a686d8db77eb390e99fd2ae4656718e8b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Mon, 2 May 2022 11:33:11 -0400
Subject: [PATCH 04/11] Added TransactionTester

---
 .../src/Test/Plutus/ContextBuilder.hs         |   4 +
 .../Test/Plutus/ContextBuilder/Internal.hs    |  99 ++++++++++++--
 .../src/Test/Tasty/Plutus/Instances.hs        |  43 ++++++
 .../src/Test/Tasty/Plutus/Script/Unit.hs      | 128 +++++++++++++++++-
 tasty-plutus/tasty-plutus.cabal               |   1 +
 5 files changed, 263 insertions(+), 12 deletions(-)
 create mode 100644 tasty-plutus/src/Test/Tasty/Plutus/Instances.hs

diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
index 4788fcb0..0f188e6d 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
@@ -95,6 +95,8 @@ module Test.Plutus.ContextBuilder (
   mintingScriptContext,
   spendingScriptContextDef,
   mintingScriptContextDef,
+  transactionSpending,
+  transactionMinting,
 
   -- ** Utilities
   defTransactionConfig,
@@ -151,6 +153,8 @@ import Test.Plutus.ContextBuilder.Internal (
   mintingScriptContextDef,
   spendingScriptContext,
   spendingScriptContextDef,
+  transactionMinting,
+  transactionSpending,
  )
 import Test.Plutus.ContextBuilder.Minting (
   MintingPolicyAction (BurnAction, MintAction),
diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
index 569d3cec..19c1ac92 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
@@ -33,6 +33,8 @@ module Test.Plutus.ContextBuilder.Internal (
   mintingScriptContextDef,
   makeIncompleteContexts,
   foldBuilt,
+  transactionSpending,
+  transactionMinting,
 ) where
 
 import Control.Arrow ((***))
@@ -48,9 +50,10 @@ import Data.Semigroup (sconcat)
 import Data.Sequence (Seq)
 import Data.Sequence qualified as Seq
 import Data.Text (Text)
+import Data.Typeable (Typeable)
 import GHC.Exts (toList)
 import Ledger (scriptAddress)
-import Ledger.Scripts (datumHash)
+import Ledger.Scripts (datumHash, mintingPolicyHash, validatorHash)
 import Plutus.V1.Ledger.Address (pubKeyHashAddress, scriptHashAddress)
 import Plutus.V1.Ledger.Api (
   BuiltinData,
@@ -278,7 +281,9 @@ data ValidatorUTXO (datum :: Type) = ValidatorUTXO
   , vUtxoValue :: Value
   }
   deriving stock
-    ( -- | @since 1.0
+    ( -- | @since 2.1
+      Eq
+    , -- | @since 1.0
       Show
     )
 
@@ -315,6 +320,9 @@ data ValidatorUTXOs (p :: Purpose) where
     Map.Map Text SomeValidatedUTXO ->
     ValidatorUTXOs 'ForTransaction
 
+-- | @since 1.0
+deriving stock instance Show (ValidatorUTXOs p)
+
 {- | An UTxO at a specified validator address. It will be used as 'Spending'
  in the 'ScriptPurpose' of the built 'ScriptContext'.
 
@@ -323,16 +331,14 @@ data ValidatorUTXOs (p :: Purpose) where
 data SomeValidatedUTXO where
   SomeValidatedUTXO ::
     forall (datum :: Type) (redeemer :: Type).
-    (FromData datum, ToData datum, Show datum, Show redeemer) =>
+    (FromData datum, ToData datum, Show datum, Typeable datum,
+     FromData redeemer, ToData redeemer, Show redeemer, Typeable redeemer) =>
     { someUTxO :: ValidatorUTXO datum
     , someSpendingScript :: TestScript ( 'ForSpending datum redeemer)
     , someRedeemer :: redeemer
     } ->
     SomeValidatedUTXO
 
--- | @since 1.0
-deriving stock instance Show (ValidatorUTXOs p)
-
 instance Show SomeValidatedUTXO where
   show SomeValidatedUTXO {someUTxO, someRedeemer} =
     "SomeValidatedUTXO{someUTxO= " <> shows someUTxO (", someRedeemer= " <> shows someRedeemer "}")
@@ -358,12 +364,16 @@ instance Monoid (ValidatorUTXOs p) where
 
  @since 1.0
 -}
-data Minting
+newtype Minting
   = -- | @since 1.0
     Mint Value
   deriving stock
     ( -- | @since 1.0
-      Show
+      Eq, Show
+    )
+  deriving newtype
+    ( -- | @since 2.1
+      Semigroup, Monoid
     )
 
 {- | Indicates whether a 'ContextBuilder' has named components or not.
@@ -562,6 +572,79 @@ mintingScriptContext conf cb toks =
             BurnAction -> negate $ getPositive pos
        in (tn, i)
 
+transactionSpending ::
+  (FromData d, ToData d, Show d) =>
+  TestScript ( 'ForSpending d r) ->
+  ValidatorUTXO d ->
+  ContextBuilder 'ForTransaction n ->
+  ContextBuilder ( 'ForSpending d r) n
+transactionSpending script input (NoNames cf) =
+  NoNames (transactionSpendingFragment script input cf)
+transactionSpending script input (WithNames cfs) =
+  WithNames (transactionSpendingFragment script input <$> cfs)
+
+transactionSpendingFragment ::
+  forall d r. (FromData d, ToData d, Show d) =>
+  TestScript ( 'ForSpending d r) ->
+  ValidatorUTXO d ->
+  ContextFragment 'ForTransaction -> ContextFragment ( 'ForSpending d r)
+transactionSpendingFragment
+  spendingScript utxoToSpend
+  ContextFragment{cfInputs, cfOutputs, cfSignatures, cfDatums, cfMinting, cfValidatorInputs, cfValidatorOutputs} =
+  ContextFragment{cfInputs = cfInputs <> Seq.fromList (Map.elems otherValidatorInputs),
+                  cfOutputs = cfOutputs <> Seq.fromList (Map.elems otherValidatorOutputs),
+                  cfSignatures, cfDatums, cfMinting,
+                  cfValidatorInputs = ValidatorUTXOs theValidatorInputs,
+                  cfValidatorOutputs = ValidatorUTXOs theValidatorOutputs}
+  where
+    otherValidatorInputs, otherValidatorOutputs :: Map Text SideUTXO
+    (otherValidatorInputs, theValidatorInputs) = Map.mapEither transactionSpendingUTxO (getUTxOs cfValidatorInputs)
+    (otherValidatorOutputs, theValidatorOutputs) = Map.mapEither transactionSpendingUTxO (getUTxOs cfValidatorOutputs)
+    transactionSpendingUTxO :: SomeValidatedUTXO -> Either SideUTXO (ValidatorUTXO d)
+    transactionSpendingUTxO SomeValidatedUTXO{someUTxO, someSpendingScript}
+      | encoded someUTxO == encoded utxoToSpend && getTestValidator someSpendingScript == getTestValidator spendingScript = Right utxoToSpend
+      | otherwise = Left SideUTXO{sUtxoType = ScriptUTXO (validatorHash $ getTestValidator someSpendingScript) $ toBuiltinData $ vUtxoDatum someUTxO,
+                                  sUtxoValue = GeneralValue $ vUtxoValue someUTxO}
+    encoded :: forall datum. ToData datum => ValidatorUTXO datum -> ValidatorUTXO BuiltinData
+    encoded (ValidatorUTXO d v) = ValidatorUTXO (toBuiltinData d) v
+
+transactionMinting ::
+  TestScript ( 'ForMinting r) ->
+  ContextBuilder 'ForTransaction n ->
+  ContextBuilder ( 'ForMinting r) n
+transactionMinting script (NoNames cf) =
+  NoNames (transactionMintingFragment script cf)
+transactionMinting script (WithNames cfs) =
+  WithNames (transactionMintingFragment script <$> cfs)
+
+transactionMintingFragment ::
+  TestScript ( 'ForMinting r) ->
+  ContextFragment 'ForTransaction -> ContextFragment ( 'ForMinting r)
+transactionMintingFragment
+  mintingPolicy
+  ContextFragment{cfInputs, cfOutputs, cfSignatures, cfDatums, cfMinting, cfValidatorInputs, cfValidatorOutputs} =
+  ContextFragment{cfInputs = cfInputs <> Seq.fromList (Map.elems otherValidatorInputs),
+                  cfOutputs = cfOutputs <> Seq.fromList (Map.elems otherValidatorOutputs),
+                  cfSignatures, cfDatums,
+                  cfMinting = Seq.filter (/= mempty) (otherMint <$> cfMinting),
+                  cfValidatorInputs = mempty,
+                  cfValidatorOutputs = mempty}
+  where
+    otherMint :: Minting -> Minting
+    otherMint (Mint val) = Mint (filterValue otherSymbol val)
+    otherSymbol symbol _ _ = symbol /= Value.mpsSymbol (mintingPolicyHash $ getTestMintingPolicy mintingPolicy)
+    otherValidatorInputs, otherValidatorOutputs :: Map Text SideUTXO
+    otherValidatorInputs =  transactionUTxO <$> getUTxOs cfValidatorInputs
+    otherValidatorOutputs = transactionUTxO <$> getUTxOs cfValidatorOutputs
+    transactionUTxO :: SomeValidatedUTXO -> SideUTXO
+    transactionUTxO SomeValidatedUTXO{someUTxO, someSpendingScript} =
+      SideUTXO{sUtxoType = ScriptUTXO (validatorHash $ getTestValidator someSpendingScript) $ toBuiltinData $ vUtxoDatum someUTxO,
+               sUtxoValue = GeneralValue $ vUtxoValue someUTxO}
+
+getUTxOs :: ValidatorUTXOs 'ForTransaction -> Map.Map Text SomeValidatedUTXO
+getUTxOs NoValidatorUTXOs = mempty
+getUTxOs (MultiValidatorUTXOs m) = m
+
 {- | Combine a list of partial contexts that should,
      when combined, validate, but fail when any one
      partial context is missing. The input is a list
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs b/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
new file mode 100644
index 00000000..78fbf2ee
--- /dev/null
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
@@ -0,0 +1,43 @@
+module Test.Tasty.Plutus.Instances (
+  ResultJoin (ResultJoin, getResultJoin)
+  )
+where
+
+import Data.Char qualified as Char
+import Test.Tasty.Providers (
+  testPassed,
+ )
+import Test.Tasty.Providers.ConsoleFormat (
+  ResultDetailsPrinter(ResultDetailsPrinter),
+  )
+import Test.Tasty.Runners (
+  Outcome(..),
+  Result(..),
+  )
+
+newtype ResultJoin = ResultJoin{getResultJoin :: Result}
+
+instance Semigroup ResultJoin where
+  ResultJoin r1 <> ResultJoin r2 = ResultJoin $
+    Result{
+    resultOutcome = case (resultOutcome r1, resultOutcome r2) of
+        (Success, Success) -> Success
+        (Success, failure) -> failure
+        (failure, _) -> failure,
+    resultDescription = resultDescription r1 <+> resultDescription r2,
+    resultShortDescription = resultShortDescription r1 <+> resultShortDescription r2,
+    resultTime = resultTime r1 + resultTime r2,
+    resultDetailsPrinter = ResultDetailsPrinter $ \indent printer ->
+        let run Result{resultDetailsPrinter= ResultDetailsPrinter r} = r indent printer in run r1 *> run r2
+    }
+
+(<+>) :: String -> String -> String
+a <+> b
+  | all Char.isSpace a = b
+  | all Char.isSpace b = a
+  | a == b = a
+  | '\n' `elem` (a <> b) = a <> "\n" <> b
+  | otherwise = a <> " " <> b
+
+instance Monoid ResultJoin where
+  mempty = ResultJoin (testPassed "No tests to run")
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
index 2bc8beab..6a9151ab 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE Trustworthy #-}
 
 {- |
@@ -28,12 +30,16 @@ module Test.Tasty.Plutus.Script.Unit (
   shouldn'tValidate,
   shouldValidateTracing,
   shouldn'tValidateTracing,
+  SomeMintingPolicy (SomeMintingPolicy)
 ) where
 
 import Control.Arrow ((>>>))
 import Control.Monad.Reader (Reader, asks, runReader)
 import Control.Monad.Writer (tell)
 import Data.Kind (Type)
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Monoid (Ap (Ap, getAp))
 import Data.Proxy (Proxy (Proxy))
 import Data.Sequence qualified as Seq
 import Data.Tagged (Tagged (Tagged))
@@ -41,11 +47,17 @@ import Data.Text (Text)
 import Data.Vector (Vector)
 import Data.Vector qualified as Vector
 import Plutus.V1.Ledger.Api (
+  CurrencySymbol,
   ExBudget (ExBudget),
   ExCPU (ExCPU),
   ExMemory (ExMemory),
   ScriptContext,
+  FromData,
+  ToData,
+  toBuiltinData,
+  unsafeFromBuiltinData,
  )
+import Plutus.V1.Ledger.Value (TokenName, Value, getValue)
 import Plutus.V1.Ledger.Scripts (
   ScriptError (
     EvaluationError,
@@ -53,17 +65,30 @@ import Plutus.V1.Ledger.Scripts (
     MalformedScript
   ),
  )
+import PlutusTx.AssocMap qualified as AssocMap
+import PlutusTx.Positive (Positive)
 import Test.Plutus.ContextBuilder (
   ContextBuilder,
+  ContextFragment (cfValidatorInputs, cfValidatorOutputs),
+  MintingPolicyTask (MPTask),
+  MintingPolicyAction (BurnAction, MintAction),
   Naming,
-  Purpose (ForMinting, ForSpending),
+  Purpose (ForMinting, ForSpending, ForTransaction),
+  SomeValidatedUTXO (SomeValidatedUTXO, someRedeemer, someSpendingScript, someUTxO),
+  Tokens (Tokens),
   TransactionConfig,
+  ValidatorUTXO (vUtxoDatum, vUtxoValue),
+  ValidatorUTXOs (MultiValidatorUTXOs, NoValidatorUTXOs),
+  foldBuilt,
+  transactionMinting,
+  transactionSpending,
  )
 import Test.Tasty.Options (
   OptionDescription (Option),
   OptionSet,
   lookupOption,
  )
+import Test.Tasty.Plutus.Instances (ResultJoin (ResultJoin, getResultJoin))
 import Test.Tasty.Plutus.Internal.Env (
   SomeScript (SomeMinter, SomeSpender),
   getContext,
@@ -126,6 +151,9 @@ import Test.Tasty.Providers (
 import Text.PrettyPrint (Doc)
 import Type.Reflection (Typeable)
 
+import PlutusTx.Prelude ((-))
+import Prelude hiding ((-))
+
 {- | Specify that, given this test data and context, the validation should
  succeed.
 
@@ -225,6 +253,18 @@ data ScriptTest (p :: Purpose) (n :: Naming) where
     ContextBuilder ( 'ForMinting r) n ->
     TestScript ( 'ForMinting r) ->
     ScriptTest ( 'ForMinting r) n
+  TransactionTester ::
+    forall (n :: Naming).
+    Outcome ->
+    Maybe (Vector Text -> Bool) ->
+    Map CurrencySymbol SomeMintingPolicy ->
+    ContextBuilder 'ForTransaction n ->
+    ScriptTest 'ForTransaction n
+
+data SomeMintingPolicy where
+  SomeMintingPolicy ::
+    (FromData r, ToData r, Show r, Typeable r) =>
+    TestScript ( 'ForMinting r) -> r -> SomeMintingPolicy
 
 getOutcome ::
   forall (p :: Purpose) (n :: Naming).
@@ -233,6 +273,7 @@ getOutcome ::
 getOutcome = \case
   Spender out _ _ _ _ -> out
   Minter out _ _ _ _ -> out
+  TransactionTester out _ _ _ -> out
 
 data UnitEnv (p :: Purpose) (n :: Naming) = UnitEnv
   { envOpts :: OptionSet
@@ -259,6 +300,7 @@ getCB =
   envScriptTest >>> \case
     Spender _ _ _ cb _ -> cb
     Minter _ _ _ cb _ -> cb
+    TransactionTester _ _ _ cb -> cb
 
 getTestData ::
   forall (p :: Purpose) (n :: Naming).
@@ -268,6 +310,7 @@ getTestData =
   envScriptTest >>> \case
     Spender _ _ td _ _ -> td
     Minter _ _ td _ _ -> td
+    TransactionTester{} -> error "There's no test data in TransactionTester"
 
 getScript ::
   forall (p :: Purpose) (n :: Naming).
@@ -277,6 +320,7 @@ getScript =
   envScriptTest >>> \case
     Spender _ _ _ _ val -> SomeSpender . getTestValidator $ val
     Minter _ _ _ _ mp -> SomeMinter . getTestMintingPolicy $ mp
+    TransactionTester{} -> error "There's more than one script in TransactionTester"
 
 getMPred ::
   forall (p :: Purpose) (n :: Naming).
@@ -286,15 +330,14 @@ getMPred =
   envScriptTest >>> \case
     Spender _ mPred _ _ _ -> mPred
     Minter _ mPred _ _ _ -> mPred
+    TransactionTester _ mPred _ _ -> mPred
 
 getExpected ::
   forall (p :: Purpose) (n :: Naming).
   UnitEnv p n ->
   Outcome
 getExpected =
-  envScriptTest >>> \case
-    Spender expected _ _ _ _ -> expected
-    Minter expected _ _ _ _ -> expected
+  envScriptTest >>> getOutcome
 
 getSC ::
   forall (p :: Purpose) (n :: Naming).
@@ -310,6 +353,8 @@ getDumpedState ::
 getDumpedState = dumpState getConf getCB getTestData
 
 instance (Typeable p, Typeable n) => IsTest (ScriptTest p n) where
+  run opts tt@TransactionTester{} x =
+    getResultJoin <$> getAp (foldTransactionTests (\t-> Ap $ ResultJoin <$> run opts t x) tt)
   run opts vt _ = pure $ case lookupOption opts of
     EstimateOnly -> case getOutcome vt of
       Fail -> testPassed explainFailureEstimation
@@ -332,6 +377,32 @@ instance (Typeable p, Typeable n) => IsTest (ScriptTest p n) where
           MintingTest red tasks ->
             let ti = ItemsForMinting red tasks cb out
              in minterEstimate opts ts ti
+        TransactionTester{} -> error "Should have been eliminated above"
+{-
+          | let context :: ContextFragment 'ForTransaction
+                context = foldBuilt cb
+                validatedInputs :: Map Text SomeValidatedUTXO
+                validatedInputs = case cfValidatorInputs context of
+                  MultiValidatorUTXOs inputs -> inputs
+                  NoValidatorUTXOs -> mempty
+                utxosTotalValue :: ValidatorUTXOs 'ForTransaction -> Value
+                utxosTotalValue NoValidatorUTXOs = mempty
+                utxosTotalValue (MultiValidatorUTXOs utxos) = foldMap theValue utxos
+                  where
+                    theValue SomeValidatedUTXO {someUTxO = x} = vUtxoValue x
+                utxoSpenderEstimate :: SomeValidatedUTXO -> Ap (Either ScriptError) ExBudget
+                utxoSpenderEstimate = undefined
+                utxoMinterEstimate :: Value -> Ap (Either ScriptError) ExBudget
+                utxoMinterEstimate = undefined
+            ->
+            getAp
+              ( foldMap utxoSpenderEstimate validatedInputs
+                  <> utxoMinterEstimate
+                    ( utxosTotalValue (cfValidatorOutputs context)
+                        - utxosTotalValue (cfValidatorInputs context)
+                    )
+              )
+-}
       go :: Reader (UnitEnv p n) Result
       go = case getScriptResult getScript getTestData (getContext getSC) env of
         Left err -> handleError err
@@ -354,6 +425,55 @@ instance (Typeable p, Typeable n) => IsTest (ScriptTest p n) where
       , Option @PlutusEstimate Proxy
       ]
 
+foldTransactionTests ::
+  forall a (n :: Naming). Monoid a =>
+  (forall (p :: Purpose). Typeable p => ScriptTest p n -> a) ->
+  ScriptTest 'ForTransaction n ->
+  a
+foldTransactionTests test (TransactionTester outcome mPred mintScripts cb) =
+  foldMap testSpending validatedInputs
+  <>
+  foldMap testMinting (AssocMap.toList $ getValue valueDifference)
+  where
+    context :: ContextFragment 'ForTransaction
+    context = foldBuilt cb
+    valueDifference :: Value
+    valueDifference = utxosTotalValue (cfValidatorOutputs context) - utxosTotalValue (cfValidatorInputs context)
+    testMinting :: (CurrencySymbol, AssocMap.Map TokenName Integer) -> a
+    testMinting (symbol, tokenAmounts) =
+      case Map.lookup symbol mintScripts of
+        Nothing -> mempty
+        Just (SomeMintingPolicy mp redeemer)
+          | let testPair (name, amount)
+                  | amount < 0 = testPositive BurnAction name (toPositive $ negate amount)
+                  | amount > 0 = testPositive MintAction name (toPositive amount)
+                  | otherwise = mempty
+                testPositive action name amount =
+                  test $
+                    Minter outcome mPred (MintingTest redeemer $ pure $ MPTask action $ Tokens name amount)
+                      (transactionMinting mp cb)
+                      mp
+                toPositive :: Integer -> Positive
+                toPositive = unsafeFromBuiltinData . toBuiltinData
+            ->
+            foldMap testPair (AssocMap.toList tokenAmounts)
+    testSpending :: SomeValidatedUTXO -> a
+    testSpending SomeValidatedUTXO{someUTxO, someRedeemer, someSpendingScript} =
+      test $
+        Spender outcome mPred (SpendingTest (vUtxoDatum someUTxO) someRedeemer (vUtxoValue someUTxO))
+          (transactionSpending someSpendingScript someUTxO cb)
+          someSpendingScript
+    validatedInputs :: Map Text SomeValidatedUTXO
+    validatedInputs = case cfValidatorInputs context of
+      MultiValidatorUTXOs inputs -> inputs
+      NoValidatorUTXOs -> mempty
+    utxosTotalValue :: ValidatorUTXOs 'ForTransaction -> Value
+    utxosTotalValue NoValidatorUTXOs = mempty
+    utxosTotalValue (MultiValidatorUTXOs utxos) = foldMap theValue utxos
+      where
+        theValue SomeValidatedUTXO {someUTxO = x} = vUtxoValue x
+  
+
 handleError ::
   forall (p :: Purpose) (n :: Naming).
   ScriptResult ->
diff --git a/tasty-plutus/tasty-plutus.cabal b/tasty-plutus/tasty-plutus.cabal
index a618b026..b6246ef3 100644
--- a/tasty-plutus/tasty-plutus.cabal
+++ b/tasty-plutus/tasty-plutus.cabal
@@ -54,6 +54,7 @@ library
     Test.Tasty.Plutus.WithScript
 
   other-modules:
+    Test.Tasty.Plutus.Instances
     Test.Tasty.Plutus.Internal.DumpScript
     Test.Tasty.Plutus.Internal.Env
     Test.Tasty.Plutus.Internal.Estimate

From 8f80b8c46b501d5b2326d29ac307584b1be92be1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Tue, 17 May 2022 15:44:13 -0400
Subject: [PATCH 05/11] Updated the plutus-context-builder version to 2.0.1

---
 plutus-context-builder/CHANGELOG.md            |  9 +++++++++
 .../plutus-context-builder.cabal               |  2 +-
 .../src/Test/Plutus/ContextBuilder.hs          |  4 ++--
 .../src/Test/Plutus/ContextBuilder/Internal.hs | 18 +++++++++---------
 4 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/plutus-context-builder/CHANGELOG.md b/plutus-context-builder/CHANGELOG.md
index 427b45fd..7c121164 100644
--- a/plutus-context-builder/CHANGELOG.md
+++ b/plutus-context-builder/CHANGELOG.md
@@ -4,6 +4,15 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
 
 ## Unreleased
 
+## 2.0.1 -- 2022-05-17
+
+### Added
+
+* module `Test.Plutus.ContextBuilder.Internal`, not recommended for end users,
+* the `foldBuilt` utility function, and
+* `transactionSpending` and `transactionMinting` for testing of whole
+  transactions.
+
 ## 2.0 -- 2022-03-09
 
 ### Added
diff --git a/plutus-context-builder/plutus-context-builder.cabal b/plutus-context-builder/plutus-context-builder.cabal
index 7ce4d4cd..b13b4f3f 100644
--- a/plutus-context-builder/plutus-context-builder.cabal
+++ b/plutus-context-builder/plutus-context-builder.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               plutus-context-builder
-version:            2.0
+version:            2.0.1
 extra-source-files: CHANGELOG.md
 
 common lang
diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
index 0f188e6d..72652dcd 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder.hs
@@ -205,7 +205,7 @@ validatorInput name x =
  This input won't be used for spending in any 'ScriptPurpose' of any
  'ScriptContext' built from this.
 
- @since 2.1
+ @since 2.0.1
 -}
 validatedInput ::
   -- | Name of the input
@@ -248,7 +248,7 @@ validatorOutput name x =
 
 {- | Anonymous context from a single 'SomeValidatedUTXO' output.
 
- @since 2.1
+ @since 2.0.1
 -}
 validatedOutput ::
   Text ->
diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
index 19c1ac92..5a3e892f 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
@@ -121,17 +121,17 @@ import Prelude hiding (length)
  and 'mkTestMintingPolicyUnsafe' to create a 'TestScript'
  that accepts a datum and/or redeemer inconsistent with its internal type.
 
- @since 6.0
+ @since 2.0.1
 -}
 data TestScript (p :: Purpose) where
-  -- | since 6.0
+  -- | since 2.0.1
   TestValidator ::
     forall (d :: Type) (r :: Type) (code :: Type).
     { getTestValidatorCode :: CompiledCode code
     , getTestValidator :: Validator
     } ->
     TestScript ( 'ForSpending d r)
-  -- | since 6.0
+  -- | since 2.0.1
   TestMintingPolicy ::
     forall (r :: Type) (code :: Type).
     { getTestMintingPolicyCode :: CompiledCode code
@@ -209,7 +209,7 @@ data Purpose where
     Purpose
   -- | This tag applies to whole-transaction testing.
   --
-  -- @since 2.1
+  -- @since 2.0.1
   ForTransaction :: Purpose
 
 {- | Represents metadata of UTxO at different types of address.
@@ -281,7 +281,7 @@ data ValidatorUTXO (datum :: Type) = ValidatorUTXO
   , vUtxoValue :: Value
   }
   deriving stock
-    ( -- | @since 2.1
+    ( -- | @since 2.0.1
       Eq
     , -- | @since 1.0
       Show
@@ -315,7 +315,7 @@ data ValidatorUTXOs (p :: Purpose) where
     (FromData datum, ToData datum, Show datum) =>
     Map.Map Text (ValidatorUTXO datum) ->
     ValidatorUTXOs ( 'ForSpending datum redeemer)
-  -- | @since 2.1
+  -- | @since 2.0.1
   MultiValidatorUTXOs ::
     Map.Map Text SomeValidatedUTXO ->
     ValidatorUTXOs 'ForTransaction
@@ -326,7 +326,7 @@ deriving stock instance Show (ValidatorUTXOs p)
 {- | An UTxO at a specified validator address. It will be used as 'Spending'
  in the 'ScriptPurpose' of the built 'ScriptContext'.
 
- @since 2.1
+ @since 2.0.1
 -}
 data SomeValidatedUTXO where
   SomeValidatedUTXO ::
@@ -372,7 +372,7 @@ newtype Minting
       Eq, Show
     )
   deriving newtype
-    ( -- | @since 2.1
+    ( -- | @since 2.0.1
       Semigroup, Monoid
     )
 
@@ -740,7 +740,7 @@ baseTxInfo conf = go . foldBuilt
  This is a low-level operation designed for maximum control. If possible, use
  the other, higher-level, operations in this module instead.
 
-   @since 2.1
+   @since 2.0.1
 -}
 foldBuilt :: ContextBuilder p n -> ContextFragment p
 foldBuilt = \case

From a24efc77ddd55eb53031db1e2b607f52f0e4e7eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Wed, 18 May 2022 09:36:43 -0400
Subject: [PATCH 06/11] Formatting

---
 .../Test/Plutus/ContextBuilder/Internal.hs    | 112 +++++++++++-------
 .../src/Test/Tasty/Plutus/Instances.hs        |  42 +++----
 .../src/Test/Tasty/Plutus/Script/Unit.hs      |  92 +++++++-------
 3 files changed, 139 insertions(+), 107 deletions(-)

diff --git a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
index 5a3e892f..172d80bd 100644
--- a/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
+++ b/plutus-context-builder/src/Test/Plutus/ContextBuilder/Internal.hs
@@ -331,8 +331,15 @@ deriving stock instance Show (ValidatorUTXOs p)
 data SomeValidatedUTXO where
   SomeValidatedUTXO ::
     forall (datum :: Type) (redeemer :: Type).
-    (FromData datum, ToData datum, Show datum, Typeable datum,
-     FromData redeemer, ToData redeemer, Show redeemer, Typeable redeemer) =>
+    ( FromData datum
+    , ToData datum
+    , Show datum
+    , Typeable datum
+    , FromData redeemer
+    , ToData redeemer
+    , Show redeemer
+    , Typeable redeemer
+    ) =>
     { someUTxO :: ValidatorUTXO datum
     , someSpendingScript :: TestScript ( 'ForSpending datum redeemer)
     , someRedeemer :: redeemer
@@ -369,11 +376,13 @@ newtype Minting
     Mint Value
   deriving stock
     ( -- | @since 1.0
-      Eq, Show
+      Eq
+    , Show
     )
   deriving newtype
     ( -- | @since 2.0.1
-      Semigroup, Monoid
+      Semigroup
+    , Monoid
     )
 
 {- | Indicates whether a 'ContextBuilder' has named components or not.
@@ -584,29 +593,40 @@ transactionSpending script input (WithNames cfs) =
   WithNames (transactionSpendingFragment script input <$> cfs)
 
 transactionSpendingFragment ::
-  forall d r. (FromData d, ToData d, Show d) =>
+  forall d r.
+  (FromData d, ToData d, Show d) =>
   TestScript ( 'ForSpending d r) ->
   ValidatorUTXO d ->
-  ContextFragment 'ForTransaction -> ContextFragment ( 'ForSpending d r)
+  ContextFragment 'ForTransaction ->
+  ContextFragment ( 'ForSpending d r)
 transactionSpendingFragment
-  spendingScript utxoToSpend
-  ContextFragment{cfInputs, cfOutputs, cfSignatures, cfDatums, cfMinting, cfValidatorInputs, cfValidatorOutputs} =
-  ContextFragment{cfInputs = cfInputs <> Seq.fromList (Map.elems otherValidatorInputs),
-                  cfOutputs = cfOutputs <> Seq.fromList (Map.elems otherValidatorOutputs),
-                  cfSignatures, cfDatums, cfMinting,
-                  cfValidatorInputs = ValidatorUTXOs theValidatorInputs,
-                  cfValidatorOutputs = ValidatorUTXOs theValidatorOutputs}
-  where
-    otherValidatorInputs, otherValidatorOutputs :: Map Text SideUTXO
-    (otherValidatorInputs, theValidatorInputs) = Map.mapEither transactionSpendingUTxO (getUTxOs cfValidatorInputs)
-    (otherValidatorOutputs, theValidatorOutputs) = Map.mapEither transactionSpendingUTxO (getUTxOs cfValidatorOutputs)
-    transactionSpendingUTxO :: SomeValidatedUTXO -> Either SideUTXO (ValidatorUTXO d)
-    transactionSpendingUTxO SomeValidatedUTXO{someUTxO, someSpendingScript}
-      | encoded someUTxO == encoded utxoToSpend && getTestValidator someSpendingScript == getTestValidator spendingScript = Right utxoToSpend
-      | otherwise = Left SideUTXO{sUtxoType = ScriptUTXO (validatorHash $ getTestValidator someSpendingScript) $ toBuiltinData $ vUtxoDatum someUTxO,
-                                  sUtxoValue = GeneralValue $ vUtxoValue someUTxO}
-    encoded :: forall datum. ToData datum => ValidatorUTXO datum -> ValidatorUTXO BuiltinData
-    encoded (ValidatorUTXO d v) = ValidatorUTXO (toBuiltinData d) v
+  spendingScript
+  utxoToSpend
+  ContextFragment {cfInputs, cfOutputs, cfSignatures, cfDatums, cfMinting, cfValidatorInputs, cfValidatorOutputs} =
+    ContextFragment
+      { cfInputs = cfInputs <> Seq.fromList (Map.elems otherValidatorInputs)
+      , cfOutputs = cfOutputs <> Seq.fromList (Map.elems otherValidatorOutputs)
+      , cfSignatures
+      , cfDatums
+      , cfMinting
+      , cfValidatorInputs = ValidatorUTXOs theValidatorInputs
+      , cfValidatorOutputs = ValidatorUTXOs theValidatorOutputs
+      }
+    where
+      otherValidatorInputs, otherValidatorOutputs :: Map Text SideUTXO
+      (otherValidatorInputs, theValidatorInputs) = Map.mapEither transactionSpendingUTxO (getUTxOs cfValidatorInputs)
+      (otherValidatorOutputs, theValidatorOutputs) = Map.mapEither transactionSpendingUTxO (getUTxOs cfValidatorOutputs)
+      transactionSpendingUTxO :: SomeValidatedUTXO -> Either SideUTXO (ValidatorUTXO d)
+      transactionSpendingUTxO SomeValidatedUTXO {someUTxO, someSpendingScript}
+        | encoded someUTxO == encoded utxoToSpend && getTestValidator someSpendingScript == getTestValidator spendingScript = Right utxoToSpend
+        | otherwise =
+          Left
+            SideUTXO
+              { sUtxoType = ScriptUTXO (validatorHash $ getTestValidator someSpendingScript) $ toBuiltinData $ vUtxoDatum someUTxO
+              , sUtxoValue = GeneralValue $ vUtxoValue someUTxO
+              }
+      encoded :: forall datum. ToData datum => ValidatorUTXO datum -> ValidatorUTXO BuiltinData
+      encoded (ValidatorUTXO d v) = ValidatorUTXO (toBuiltinData d) v
 
 transactionMinting ::
   TestScript ( 'ForMinting r) ->
@@ -619,27 +639,33 @@ transactionMinting script (WithNames cfs) =
 
 transactionMintingFragment ::
   TestScript ( 'ForMinting r) ->
-  ContextFragment 'ForTransaction -> ContextFragment ( 'ForMinting r)
+  ContextFragment 'ForTransaction ->
+  ContextFragment ( 'ForMinting r)
 transactionMintingFragment
   mintingPolicy
-  ContextFragment{cfInputs, cfOutputs, cfSignatures, cfDatums, cfMinting, cfValidatorInputs, cfValidatorOutputs} =
-  ContextFragment{cfInputs = cfInputs <> Seq.fromList (Map.elems otherValidatorInputs),
-                  cfOutputs = cfOutputs <> Seq.fromList (Map.elems otherValidatorOutputs),
-                  cfSignatures, cfDatums,
-                  cfMinting = Seq.filter (/= mempty) (otherMint <$> cfMinting),
-                  cfValidatorInputs = mempty,
-                  cfValidatorOutputs = mempty}
-  where
-    otherMint :: Minting -> Minting
-    otherMint (Mint val) = Mint (filterValue otherSymbol val)
-    otherSymbol symbol _ _ = symbol /= Value.mpsSymbol (mintingPolicyHash $ getTestMintingPolicy mintingPolicy)
-    otherValidatorInputs, otherValidatorOutputs :: Map Text SideUTXO
-    otherValidatorInputs =  transactionUTxO <$> getUTxOs cfValidatorInputs
-    otherValidatorOutputs = transactionUTxO <$> getUTxOs cfValidatorOutputs
-    transactionUTxO :: SomeValidatedUTXO -> SideUTXO
-    transactionUTxO SomeValidatedUTXO{someUTxO, someSpendingScript} =
-      SideUTXO{sUtxoType = ScriptUTXO (validatorHash $ getTestValidator someSpendingScript) $ toBuiltinData $ vUtxoDatum someUTxO,
-               sUtxoValue = GeneralValue $ vUtxoValue someUTxO}
+  ContextFragment {cfInputs, cfOutputs, cfSignatures, cfDatums, cfMinting, cfValidatorInputs, cfValidatorOutputs} =
+    ContextFragment
+      { cfInputs = cfInputs <> Seq.fromList (Map.elems otherValidatorInputs)
+      , cfOutputs = cfOutputs <> Seq.fromList (Map.elems otherValidatorOutputs)
+      , cfSignatures
+      , cfDatums
+      , cfMinting = Seq.filter (/= mempty) (otherMint <$> cfMinting)
+      , cfValidatorInputs = mempty
+      , cfValidatorOutputs = mempty
+      }
+    where
+      otherMint :: Minting -> Minting
+      otherMint (Mint val) = Mint (filterValue otherSymbol val)
+      otherSymbol symbol _ _ = symbol /= Value.mpsSymbol (mintingPolicyHash $ getTestMintingPolicy mintingPolicy)
+      otherValidatorInputs, otherValidatorOutputs :: Map Text SideUTXO
+      otherValidatorInputs = transactionUTxO <$> getUTxOs cfValidatorInputs
+      otherValidatorOutputs = transactionUTxO <$> getUTxOs cfValidatorOutputs
+      transactionUTxO :: SomeValidatedUTXO -> SideUTXO
+      transactionUTxO SomeValidatedUTXO {someUTxO, someSpendingScript} =
+        SideUTXO
+          { sUtxoType = ScriptUTXO (validatorHash $ getTestValidator someSpendingScript) $ toBuiltinData $ vUtxoDatum someUTxO
+          , sUtxoValue = GeneralValue $ vUtxoValue someUTxO
+          }
 
 getUTxOs :: ValidatorUTXOs 'ForTransaction -> Map.Map Text SomeValidatedUTXO
 getUTxOs NoValidatorUTXOs = mempty
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs b/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
index 78fbf2ee..04a31bb4 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
@@ -1,35 +1,35 @@
 module Test.Tasty.Plutus.Instances (
-  ResultJoin (ResultJoin, getResultJoin)
-  )
-where
+  ResultJoin (ResultJoin, getResultJoin),
+) where
 
 import Data.Char qualified as Char
 import Test.Tasty.Providers (
   testPassed,
  )
 import Test.Tasty.Providers.ConsoleFormat (
-  ResultDetailsPrinter(ResultDetailsPrinter),
-  )
+  ResultDetailsPrinter (ResultDetailsPrinter),
+ )
 import Test.Tasty.Runners (
-  Outcome(..),
-  Result(..),
-  )
+  Outcome (..),
+  Result (..),
+ )
 
-newtype ResultJoin = ResultJoin{getResultJoin :: Result}
+newtype ResultJoin = ResultJoin {getResultJoin :: Result}
 
 instance Semigroup ResultJoin where
-  ResultJoin r1 <> ResultJoin r2 = ResultJoin $
-    Result{
-    resultOutcome = case (resultOutcome r1, resultOutcome r2) of
-        (Success, Success) -> Success
-        (Success, failure) -> failure
-        (failure, _) -> failure,
-    resultDescription = resultDescription r1 <+> resultDescription r2,
-    resultShortDescription = resultShortDescription r1 <+> resultShortDescription r2,
-    resultTime = resultTime r1 + resultTime r2,
-    resultDetailsPrinter = ResultDetailsPrinter $ \indent printer ->
-        let run Result{resultDetailsPrinter= ResultDetailsPrinter r} = r indent printer in run r1 *> run r2
-    }
+  ResultJoin r1 <> ResultJoin r2 =
+    ResultJoin $
+      Result
+        { resultOutcome = case (resultOutcome r1, resultOutcome r2) of
+            (Success, Success) -> Success
+            (Success, failure) -> failure
+            (failure, _) -> failure
+        , resultDescription = resultDescription r1 <+> resultDescription r2
+        , resultShortDescription = resultShortDescription r1 <+> resultShortDescription r2
+        , resultTime = resultTime r1 + resultTime r2
+        , resultDetailsPrinter = ResultDetailsPrinter $ \indent printer ->
+            let run Result {resultDetailsPrinter = ResultDetailsPrinter r} = r indent printer in run r1 *> run r2
+        }
 
 (<+>) :: String -> String -> String
 a <+> b
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
index 6a9151ab..c7bf9fe0 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
@@ -30,7 +30,7 @@ module Test.Tasty.Plutus.Script.Unit (
   shouldn'tValidate,
   shouldValidateTracing,
   shouldn'tValidateTracing,
-  SomeMintingPolicy (SomeMintingPolicy)
+  SomeMintingPolicy (SomeMintingPolicy),
 ) where
 
 import Control.Arrow ((>>>))
@@ -51,13 +51,12 @@ import Plutus.V1.Ledger.Api (
   ExBudget (ExBudget),
   ExCPU (ExCPU),
   ExMemory (ExMemory),
-  ScriptContext,
   FromData,
+  ScriptContext,
   ToData,
   toBuiltinData,
   unsafeFromBuiltinData,
  )
-import Plutus.V1.Ledger.Value (TokenName, Value, getValue)
 import Plutus.V1.Ledger.Scripts (
   ScriptError (
     EvaluationError,
@@ -65,13 +64,14 @@ import Plutus.V1.Ledger.Scripts (
     MalformedScript
   ),
  )
+import Plutus.V1.Ledger.Value (TokenName, Value, getValue)
 import PlutusTx.AssocMap qualified as AssocMap
 import PlutusTx.Positive (Positive)
 import Test.Plutus.ContextBuilder (
   ContextBuilder,
   ContextFragment (cfValidatorInputs, cfValidatorOutputs),
-  MintingPolicyTask (MPTask),
   MintingPolicyAction (BurnAction, MintAction),
+  MintingPolicyTask (MPTask),
   Naming,
   Purpose (ForMinting, ForSpending, ForTransaction),
   SomeValidatedUTXO (SomeValidatedUTXO, someRedeemer, someSpendingScript, someUTxO),
@@ -264,7 +264,9 @@ data ScriptTest (p :: Purpose) (n :: Naming) where
 data SomeMintingPolicy where
   SomeMintingPolicy ::
     (FromData r, ToData r, Show r, Typeable r) =>
-    TestScript ( 'ForMinting r) -> r -> SomeMintingPolicy
+    TestScript ( 'ForMinting r) ->
+    r ->
+    SomeMintingPolicy
 
 getOutcome ::
   forall (p :: Purpose) (n :: Naming).
@@ -310,7 +312,7 @@ getTestData =
   envScriptTest >>> \case
     Spender _ _ td _ _ -> td
     Minter _ _ td _ _ -> td
-    TransactionTester{} -> error "There's no test data in TransactionTester"
+    TransactionTester {} -> error "There's no test data in TransactionTester"
 
 getScript ::
   forall (p :: Purpose) (n :: Naming).
@@ -320,7 +322,7 @@ getScript =
   envScriptTest >>> \case
     Spender _ _ _ _ val -> SomeSpender . getTestValidator $ val
     Minter _ _ _ _ mp -> SomeMinter . getTestMintingPolicy $ mp
-    TransactionTester{} -> error "There's more than one script in TransactionTester"
+    TransactionTester {} -> error "There's more than one script in TransactionTester"
 
 getMPred ::
   forall (p :: Purpose) (n :: Naming).
@@ -353,8 +355,8 @@ getDumpedState ::
 getDumpedState = dumpState getConf getCB getTestData
 
 instance (Typeable p, Typeable n) => IsTest (ScriptTest p n) where
-  run opts tt@TransactionTester{} x =
-    getResultJoin <$> getAp (foldTransactionTests (\t-> Ap $ ResultJoin <$> run opts t x) tt)
+  run opts tt@TransactionTester {} x =
+    getResultJoin <$> getAp (foldTransactionTests (\t -> Ap $ ResultJoin <$> run opts t x) tt)
   run opts vt _ = pure $ case lookupOption opts of
     EstimateOnly -> case getOutcome vt of
       Fail -> testPassed explainFailureEstimation
@@ -377,32 +379,32 @@ instance (Typeable p, Typeable n) => IsTest (ScriptTest p n) where
           MintingTest red tasks ->
             let ti = ItemsForMinting red tasks cb out
              in minterEstimate opts ts ti
-        TransactionTester{} -> error "Should have been eliminated above"
-{-
-          | let context :: ContextFragment 'ForTransaction
-                context = foldBuilt cb
-                validatedInputs :: Map Text SomeValidatedUTXO
-                validatedInputs = case cfValidatorInputs context of
-                  MultiValidatorUTXOs inputs -> inputs
-                  NoValidatorUTXOs -> mempty
-                utxosTotalValue :: ValidatorUTXOs 'ForTransaction -> Value
-                utxosTotalValue NoValidatorUTXOs = mempty
-                utxosTotalValue (MultiValidatorUTXOs utxos) = foldMap theValue utxos
-                  where
-                    theValue SomeValidatedUTXO {someUTxO = x} = vUtxoValue x
-                utxoSpenderEstimate :: SomeValidatedUTXO -> Ap (Either ScriptError) ExBudget
-                utxoSpenderEstimate = undefined
-                utxoMinterEstimate :: Value -> Ap (Either ScriptError) ExBudget
-                utxoMinterEstimate = undefined
-            ->
-            getAp
-              ( foldMap utxoSpenderEstimate validatedInputs
-                  <> utxoMinterEstimate
-                    ( utxosTotalValue (cfValidatorOutputs context)
-                        - utxosTotalValue (cfValidatorInputs context)
+        TransactionTester {} -> error "Should have been eliminated above"
+      {-
+                | let context :: ContextFragment 'ForTransaction
+                      context = foldBuilt cb
+                      validatedInputs :: Map Text SomeValidatedUTXO
+                      validatedInputs = case cfValidatorInputs context of
+                        MultiValidatorUTXOs inputs -> inputs
+                        NoValidatorUTXOs -> mempty
+                      utxosTotalValue :: ValidatorUTXOs 'ForTransaction -> Value
+                      utxosTotalValue NoValidatorUTXOs = mempty
+                      utxosTotalValue (MultiValidatorUTXOs utxos) = foldMap theValue utxos
+                        where
+                          theValue SomeValidatedUTXO {someUTxO = x} = vUtxoValue x
+                      utxoSpenderEstimate :: SomeValidatedUTXO -> Ap (Either ScriptError) ExBudget
+                      utxoSpenderEstimate = undefined
+                      utxoMinterEstimate :: Value -> Ap (Either ScriptError) ExBudget
+                      utxoMinterEstimate = undefined
+                  ->
+                  getAp
+                    ( foldMap utxoSpenderEstimate validatedInputs
+                        <> utxoMinterEstimate
+                          ( utxosTotalValue (cfValidatorOutputs context)
+                              - utxosTotalValue (cfValidatorInputs context)
+                          )
                     )
-              )
--}
+      -}
       go :: Reader (UnitEnv p n) Result
       go = case getScriptResult getScript getTestData (getContext getSC) env of
         Left err -> handleError err
@@ -426,14 +428,14 @@ instance (Typeable p, Typeable n) => IsTest (ScriptTest p n) where
       ]
 
 foldTransactionTests ::
-  forall a (n :: Naming). Monoid a =>
+  forall a (n :: Naming).
+  Monoid a =>
   (forall (p :: Purpose). Typeable p => ScriptTest p n -> a) ->
   ScriptTest 'ForTransaction n ->
   a
 foldTransactionTests test (TransactionTester outcome mPred mintScripts cb) =
   foldMap testSpending validatedInputs
-  <>
-  foldMap testMinting (AssocMap.toList $ getValue valueDifference)
+    <> foldMap testMinting (AssocMap.toList $ getValue valueDifference)
   where
     context :: ContextFragment 'ForTransaction
     context = foldBuilt cb
@@ -450,17 +452,22 @@ foldTransactionTests test (TransactionTester outcome mPred mintScripts cb) =
                   | otherwise = mempty
                 testPositive action name amount =
                   test $
-                    Minter outcome mPred (MintingTest redeemer $ pure $ MPTask action $ Tokens name amount)
+                    Minter
+                      outcome
+                      mPred
+                      (MintingTest redeemer $ pure $ MPTask action $ Tokens name amount)
                       (transactionMinting mp cb)
                       mp
                 toPositive :: Integer -> Positive
-                toPositive = unsafeFromBuiltinData . toBuiltinData
-            ->
+                toPositive = unsafeFromBuiltinData . toBuiltinData ->
             foldMap testPair (AssocMap.toList tokenAmounts)
     testSpending :: SomeValidatedUTXO -> a
-    testSpending SomeValidatedUTXO{someUTxO, someRedeemer, someSpendingScript} =
+    testSpending SomeValidatedUTXO {someUTxO, someRedeemer, someSpendingScript} =
       test $
-        Spender outcome mPred (SpendingTest (vUtxoDatum someUTxO) someRedeemer (vUtxoValue someUTxO))
+        Spender
+          outcome
+          mPred
+          (SpendingTest (vUtxoDatum someUTxO) someRedeemer (vUtxoValue someUTxO))
           (transactionSpending someSpendingScript someUTxO cb)
           someSpendingScript
     validatedInputs :: Map Text SomeValidatedUTXO
@@ -472,7 +479,6 @@ foldTransactionTests test (TransactionTester outcome mPred mintScripts cb) =
     utxosTotalValue (MultiValidatorUTXOs utxos) = foldMap theValue utxos
       where
         theValue SomeValidatedUTXO {someUTxO = x} = vUtxoValue x
-  
 
 handleError ::
   forall (p :: Purpose) (n :: Naming).

From fc34e22cd5ea5929d8866f52b0053496b7eb5852 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Wed, 18 May 2022 10:57:54 -0400
Subject: [PATCH 07/11] Added shouldValidateTransaction[Tracing] and a test

---
 .../src/Test/Tasty/Plutus/Instances.hs        |  2 +-
 .../src/Test/Tasty/Plutus/Script/Unit.hs      | 39 +++++++++++++++++++
 tasty-plutus/test/Properties/Validator.hs     |  7 ++++
 3 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs b/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
index 04a31bb4..23931c80 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Instances.hs
@@ -40,4 +40,4 @@ a <+> b
   | otherwise = a <> " " <> b
 
 instance Monoid ResultJoin where
-  mempty = ResultJoin (testPassed "No tests to run")
+  mempty = ResultJoin (testPassed mempty)
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
index c7bf9fe0..e9893109 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
@@ -30,6 +30,10 @@ module Test.Tasty.Plutus.Script.Unit (
   shouldn'tValidate,
   shouldValidateTracing,
   shouldn'tValidateTracing,
+
+  -- ** Whole-transaction testing
+  shouldValidateTransaction,
+  shouldValidateTransactionTracing,
   SomeMintingPolicy (SomeMintingPolicy),
 ) where
 
@@ -144,6 +148,7 @@ import Test.Tasty.Plutus.TestData (
 import Test.Tasty.Providers (
   IsTest (run, testOptions),
   Result,
+  TestTree,
   singleTest,
   testFailed,
   testPassed,
@@ -186,6 +191,40 @@ shouldValidateTracing ::
   WithScript p ()
 shouldValidateTracing name f = addUnitTest Pass (Just f) name
 
+{- | Specify that, given these minting policies and context, the whole
+   transaction should succeed.
+
+ @since 9.1.1
+-}
+shouldValidateTransaction ::
+  forall (n :: Naming).
+  Typeable n =>
+  String ->
+  Map CurrencySymbol SomeMintingPolicy ->
+  ContextBuilder 'ForTransaction n ->
+  TestTree
+shouldValidateTransaction name mintingPolicies cb =
+  singleTest name (TransactionTester Pass Nothing mintingPolicies cb)
+
+{- | Specify that, given these minting policies and context, as well as a
+ predicate on the entire trace:
+
+ * The transaction should succeed; and
+ * The trace that results should satisfy the predicate.
+
+ @since 9.1.1
+-}
+shouldValidateTransactionTracing ::
+  forall (n :: Naming).
+  Typeable n =>
+  String ->
+  (Vector Text -> Bool) ->
+  Map CurrencySymbol SomeMintingPolicy ->
+  ContextBuilder 'ForTransaction n ->
+  TestTree
+shouldValidateTransactionTracing name f mintingPolicies cb =
+  singleTest name (TransactionTester Pass (Just f) mintingPolicies cb)
+
 {- | Specify that, given this test data and context, the validation should fail.
 
  @since 9.0
diff --git a/tasty-plutus/test/Properties/Validator.hs b/tasty-plutus/test/Properties/Validator.hs
index 143c0b5f..0c2659e8 100644
--- a/tasty-plutus/test/Properties/Validator.hs
+++ b/tasty-plutus/test/Properties/Validator.hs
@@ -14,7 +14,10 @@ import Test.Plutus.ContextBuilder (
   ContextBuilder,
   Naming (Anonymous),
   Purpose (ForSpending),
+  SomeValidatedUTXO (SomeValidatedUTXO),
+  ValidatorUTXO (ValidatorUTXO),
   outToPubKey,
+  validatedInput,
  )
 import Test.QuickCheck.Plutus.Instances ()
 import Test.Tasty (TestTree, testGroup)
@@ -23,6 +26,7 @@ import Test.Tasty.Plutus.Script.Property (
   scriptProperty,
   scriptPropertyPass,
  )
+import Test.Tasty.Plutus.Script.Unit (shouldValidateTransaction)
 import Test.Tasty.Plutus.TestData (
   Generator (GenForSpending),
   Methodology (Methodology),
@@ -77,6 +81,9 @@ tests =
         "Validator checks secret key"
         (\(secret, _, _) -> paramTestValidator secret)
         $ GenForSpending genForParam transformForParam
+    , shouldValidateTransaction "Unit transaction test" mempty $
+        validatedInput "input" $
+          SomeValidatedUTXO (ValidatorUTXO (1, 2) mempty) simpleTestValidator (3, 2)
     ]
 
 genForSimple :: Methodology (Integer, Integer, Integer, Integer, Value)

From 9de8c7ccd4890efcbb0b8d2d5cd24ec53c7ef895 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Thu, 19 May 2022 17:34:19 -0400
Subject: [PATCH 08/11] Haddock for new exports

---
 .../src/Test/Tasty/Plutus/Script/Unit.hs      | 24 ++++++++++++++++---
 1 file changed, 21 insertions(+), 3 deletions(-)

diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
index e9893109..c9925a16 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
@@ -23,6 +23,15 @@
  >    shouldValidateTracing "Gotta get good messages" tracePred validData validContext
  >    shouldn'tValidateTracing "Oh damn" tracePred invalidData validContext
  >    ...
+
+ = Example with whole-transaction testing
+
+ > validatorTests :: TestTree
+ > validatorTests = do
+ >    shouldValidateTransaction "Valid transaction" validData mintingPolicies validTransactionContext
+ >    shouldValidateTransaction "Valid inputs" validData mempty validTransactionContext
+ >    shouldn'tValidateTransaction "Invalid transaction" validData mintingPolicies invalidTransactionContext
+ >    ...
 -}
 module Test.Tasty.Plutus.Script.Unit (
   -- * Testing API
@@ -192,7 +201,9 @@ shouldValidateTracing ::
 shouldValidateTracing name f = addUnitTest Pass (Just f) name
 
 {- | Specify that, given these minting policies and context, the whole
-   transaction should succeed.
+   transaction should succeed. Note that, if the transaction mints a currency
+   whose minting policy is /not/ provided by the @mintingPolicies@ map, it is
+   assumed to be passing.
 
  @since 9.1.1
 -}
@@ -209,8 +220,10 @@ shouldValidateTransaction name mintingPolicies cb =
 {- | Specify that, given these minting policies and context, as well as a
  predicate on the entire trace:
 
- * The transaction should succeed; and
- * The trace that results should satisfy the predicate.
+ * validation of every consumed input should succeed;
+ * every policy specified in @mintingPolicies@ whose currency was minted or
+   burned by the transaction should succeed; and
+ * the trace that results should satisfy the predicate.
 
  @since 9.1.1
 -}
@@ -300,6 +313,11 @@ data ScriptTest (p :: Purpose) (n :: Naming) where
     ContextBuilder 'ForTransaction n ->
     ScriptTest 'ForTransaction n
 
+{- | A wrapper for a @TestScript 'ForMinting@, meant to be stored in a map and
+   passed to functions like 'shouldValidateTransaction'.
+
+  @since 9.1.1
+-}
 data SomeMintingPolicy where
   SomeMintingPolicy ::
     (FromData r, ToData r, Show r, Typeable r) =>

From fbeceaf0cc60f97f3cb26b4d10eb245131e349c6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Thu, 19 May 2022 17:43:10 -0400
Subject: [PATCH 09/11] Added shouldn'tValidateTransction[Tracing] and a test

---
 tasty-plutus/CHANGELOG.md                     | 11 +++++
 .../src/Test/Tasty/Plutus/Script/Unit.hs      | 40 +++++++++++++++++++
 tasty-plutus/test/Properties/Validator.hs     |  8 +++-
 3 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/tasty-plutus/CHANGELOG.md b/tasty-plutus/CHANGELOG.md
index 0612a0c5..a2f9bbd5 100644
--- a/tasty-plutus/CHANGELOG.md
+++ b/tasty-plutus/CHANGELOG.md
@@ -4,6 +4,17 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
 
 ## Unreleased
 
+## 9.1.1 - 2022-05-19
+
+### Added
+
+Whoole transaction test functions, namely:
+
+* `shouldValidateTransaction`,
+* `shouldValidateTransactionTracing`,
+* `shouldn'tValidateTransaction`, and
+* `shouldn'tValidateTransactionTracing`.
+
 ## 9.1 - 2022-03-22
 
 ### Added
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
index c9925a16..bf628eef 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
@@ -42,7 +42,9 @@ module Test.Tasty.Plutus.Script.Unit (
 
   -- ** Whole-transaction testing
   shouldValidateTransaction,
+  shouldn'tValidateTransaction,
   shouldValidateTransactionTracing,
+  shouldn'tValidateTransactionTracing,
   SomeMintingPolicy (SomeMintingPolicy),
 ) where
 
@@ -217,6 +219,23 @@ shouldValidateTransaction ::
 shouldValidateTransaction name mintingPolicies cb =
   singleTest name (TransactionTester Pass Nothing mintingPolicies cb)
 
+{- | Specify that, given these minting policies and context, the whole
+   transaction should /not/ succeed. Note that, if the transaction mints a
+   currency whose minting policy is /not/ provided by the @mintingPolicies@
+   map, the policy is assumed to be passing.
+
+ @since 9.1.1
+-}
+shouldn'tValidateTransaction ::
+  forall (n :: Naming).
+  Typeable n =>
+  String ->
+  Map CurrencySymbol SomeMintingPolicy ->
+  ContextBuilder 'ForTransaction n ->
+  TestTree
+shouldn'tValidateTransaction name mintingPolicies cb =
+  singleTest name (TransactionTester Fail Nothing mintingPolicies cb)
+
 {- | Specify that, given these minting policies and context, as well as a
  predicate on the entire trace:
 
@@ -238,6 +257,27 @@ shouldValidateTransactionTracing ::
 shouldValidateTransactionTracing name f mintingPolicies cb =
   singleTest name (TransactionTester Pass (Just f) mintingPolicies cb)
 
+{- | Specify that, given these minting policies and context, as well as a
+ predicate on the entire trace, at least one of these criteria fails:
+
+ * validation of an input consumed by the transaction;
+ * a policy specified in @mintingPolicies@ whose currency was minted or
+   burned by the transaction; or
+ * the trace predicate.
+
+ @since 9.1.1
+-}
+shouldn'tValidateTransactionTracing ::
+  forall (n :: Naming).
+  Typeable n =>
+  String ->
+  (Vector Text -> Bool) ->
+  Map CurrencySymbol SomeMintingPolicy ->
+  ContextBuilder 'ForTransaction n ->
+  TestTree
+shouldn'tValidateTransactionTracing name f mintingPolicies cb =
+  singleTest name (TransactionTester Fail (Just f) mintingPolicies cb)
+
 {- | Specify that, given this test data and context, the validation should fail.
 
  @since 9.0
diff --git a/tasty-plutus/test/Properties/Validator.hs b/tasty-plutus/test/Properties/Validator.hs
index 0c2659e8..a5a50116 100644
--- a/tasty-plutus/test/Properties/Validator.hs
+++ b/tasty-plutus/test/Properties/Validator.hs
@@ -26,7 +26,10 @@ import Test.Tasty.Plutus.Script.Property (
   scriptProperty,
   scriptPropertyPass,
  )
-import Test.Tasty.Plutus.Script.Unit (shouldValidateTransaction)
+import Test.Tasty.Plutus.Script.Unit (
+  shouldValidateTransaction,
+  shouldn'tValidateTransaction,
+ )
 import Test.Tasty.Plutus.TestData (
   Generator (GenForSpending),
   Methodology (Methodology),
@@ -84,6 +87,9 @@ tests =
     , shouldValidateTransaction "Unit transaction test" mempty $
         validatedInput "input" $
           SomeValidatedUTXO (ValidatorUTXO (1, 2) mempty) simpleTestValidator (3, 2)
+    , shouldn'tValidateTransaction "Negative unit transaction test" mempty $
+        validatedInput "input" $
+          SomeValidatedUTXO (ValidatorUTXO (1, 2) mempty) simpleTestValidator (3, 4)
     ]
 
 genForSimple :: Methodology (Integer, Integer, Integer, Integer, Value)

From 7ee66a68492e801dae468eeac1cc756143c071ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Thu, 19 May 2022 18:20:01 -0400
Subject: [PATCH 10/11] Moved SomeMintingPolicy to the TestData module

---
 .../src/Test/Tasty/Plutus/Script/Unit.hs      | 15 +------------
 .../src/Test/Tasty/Plutus/TestData.hs         | 21 ++++++++++++++++++-
 2 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
index bf628eef..7a2503b4 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
@@ -66,9 +66,7 @@ import Plutus.V1.Ledger.Api (
   ExBudget (ExBudget),
   ExCPU (ExCPU),
   ExMemory (ExMemory),
-  FromData,
   ScriptContext,
-  ToData,
   toBuiltinData,
   unsafeFromBuiltinData,
  )
@@ -153,6 +151,7 @@ import Test.Tasty.Plutus.Options (
  )
 import Test.Tasty.Plutus.TestData (
   Outcome (Fail, Pass),
+  SomeMintingPolicy (SomeMintingPolicy),
   TestData (MintingTest, SpendingTest),
   TestItems (ItemsForMinting, ItemsForSpending),
  )
@@ -353,18 +352,6 @@ data ScriptTest (p :: Purpose) (n :: Naming) where
     ContextBuilder 'ForTransaction n ->
     ScriptTest 'ForTransaction n
 
-{- | A wrapper for a @TestScript 'ForMinting@, meant to be stored in a map and
-   passed to functions like 'shouldValidateTransaction'.
-
-  @since 9.1.1
--}
-data SomeMintingPolicy where
-  SomeMintingPolicy ::
-    (FromData r, ToData r, Show r, Typeable r) =>
-    TestScript ( 'ForMinting r) ->
-    r ->
-    SomeMintingPolicy
-
 getOutcome ::
   forall (p :: Purpose) (n :: Naming).
   ScriptTest p n ->
diff --git a/tasty-plutus/src/Test/Tasty/Plutus/TestData.hs b/tasty-plutus/src/Test/Tasty/Plutus/TestData.hs
index e0f74d9f..24760027 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/TestData.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/TestData.hs
@@ -15,6 +15,7 @@ module Test.Tasty.Plutus.TestData (
   Outcome (..),
   MintingPolicyAction (..),
   MintingPolicyTask (..),
+  SomeMintingPolicy (SomeMintingPolicy),
 
   -- * Helper functions
   passIf,
@@ -33,7 +34,7 @@ import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Semigroup (stimes, stimesIdempotent)
 import Plutus.V1.Ledger.Value (Value)
-import PlutusTx
+import PlutusTx (FromData, ToData)
 import Test.Plutus.ContextBuilder (
   ContextBuilder,
   MintingPolicyAction (BurnAction, MintAction),
@@ -44,8 +45,10 @@ import Test.Plutus.ContextBuilder (
   burnTokens,
   mintTokens,
  )
+import Test.Tasty.Plutus.Internal.TestScript (TestScript)
 import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary, shrink))
 import Test.QuickCheck.Gen (Gen)
+import Type.Reflection (Typeable)
 import Prelude
 
 {- | All the data needed to test a validator or minting policy.
@@ -235,3 +238,19 @@ data TestItems (p :: Purpose) (n :: Naming) where
 
 -- | @since 9.0
 deriving stock instance Show (TestItems p n)
+
+{- | A wrapper for a @TestScript 'ForMinting@, meant to be stored in a map and
+   passed to functions like 'shouldValidateTransaction'.
+
+  @since 9.1.1
+-}
+data SomeMintingPolicy where
+  SomeMintingPolicy ::
+    (FromData r, ToData r, Show r, Typeable r) =>
+    TestScript ( 'ForMinting r) ->
+    r ->
+    SomeMintingPolicy
+
+-- | @since 9.1.1
+instance Show SomeMintingPolicy where
+  show = const "SomeMintingPolicy{}"

From f6df7c1c4f10811140a84c47c4ae5ef9a48d8a8b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Thu, 19 May 2022 18:37:57 -0400
Subject: [PATCH 11/11] Removed commented-out code

---
 .../src/Test/Tasty/Plutus/Script/Unit.hs      | 25 -------------------
 1 file changed, 25 deletions(-)

diff --git a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
index 7a2503b4..58193763 100644
--- a/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
+++ b/tasty-plutus/src/Test/Tasty/Plutus/Script/Unit.hs
@@ -464,31 +464,6 @@ instance (Typeable p, Typeable n) => IsTest (ScriptTest p n) where
             let ti = ItemsForMinting red tasks cb out
              in minterEstimate opts ts ti
         TransactionTester {} -> error "Should have been eliminated above"
-      {-
-                | let context :: ContextFragment 'ForTransaction
-                      context = foldBuilt cb
-                      validatedInputs :: Map Text SomeValidatedUTXO
-                      validatedInputs = case cfValidatorInputs context of
-                        MultiValidatorUTXOs inputs -> inputs
-                        NoValidatorUTXOs -> mempty
-                      utxosTotalValue :: ValidatorUTXOs 'ForTransaction -> Value
-                      utxosTotalValue NoValidatorUTXOs = mempty
-                      utxosTotalValue (MultiValidatorUTXOs utxos) = foldMap theValue utxos
-                        where
-                          theValue SomeValidatedUTXO {someUTxO = x} = vUtxoValue x
-                      utxoSpenderEstimate :: SomeValidatedUTXO -> Ap (Either ScriptError) ExBudget
-                      utxoSpenderEstimate = undefined
-                      utxoMinterEstimate :: Value -> Ap (Either ScriptError) ExBudget
-                      utxoMinterEstimate = undefined
-                  ->
-                  getAp
-                    ( foldMap utxoSpenderEstimate validatedInputs
-                        <> utxoMinterEstimate
-                          ( utxosTotalValue (cfValidatorOutputs context)
-                              - utxosTotalValue (cfValidatorInputs context)
-                          )
-                    )
-      -}
       go :: Reader (UnitEnv p n) Result
       go = case getScriptResult getScript getTestData (getContext getSC) env of
         Left err -> handleError err