From 7ee51bba444d244b48f0adfdca44079fd48a2aef Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sun, 21 Dec 2025 03:19:31 +0100
Subject: [PATCH 01/96] doc ltl

---
 README.md         |  3 --
 src/Cooked/Ltl.hs | 71 ++++++++++++++++++++++-------------------------
 2 files changed, 33 insertions(+), 41 deletions(-)

diff --git a/README.md b/README.md
index 675a9a628..8d861363b 100644
--- a/README.md
+++ b/README.md
@@ -112,9 +112,6 @@ the `packages` stanza.
   automated balancing mechanism and associated options (including options
   revolving around fees and collaterals).
 
-- The [CONWAY](doc/CONWAY.md) file describes the Conway features that are
-  currently supported by `cooked-validators`.
-
 - The [OPTICS](doc/OPTICS.md) file describes our usage of optics to navigate our
   data structures.
 
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 8678c90c6..986429a5a 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE DeriveFunctor #-}
 
 -- | This modules provides the infrastructure to modify sequences of
--- transactions using LTL formulaes with atomic modifications. This idea is to
--- describe when to apply certain modifications within a trace. This is to be
--- replaced later on with a dependency to https://github.com/tweag/graft.
+-- transactions using pseudo-LTL formulaes with atomic modifications. This idea
+-- is to describe when to apply certain modifications within a trace. This is to
+-- be replaced later on with a dependency to https://github.com/tweag/graft.
 module Cooked.Ltl
   ( Ltl (..),
     nowLater,
@@ -25,16 +25,15 @@ import Data.Kind
 
 -- | Type of LTL formulas with atomic formulas of type @a@. Think of @a@ as a
 -- type of "modifications", then a value of type @Ltl a@ describes where to
--- apply modifications. Since it does not make (obvious) sense to talk of a
--- negated modification or of one modification (possibly in the future) to imply
--- another modification, implication and negation are absent.
+-- apply modifications. Since there is no (obvious) semantics for a negated
+-- modification or of one modification (possibly in the future) implying another
+-- modification, implication and negation are currently absent.
 data Ltl a
-  = -- | The "do nothing" modification that never fails
+  = -- | The modification that always applies but does noting
     LtlTruth
   | -- | The modification that never applies (i.e. always fails)
     LtlFalsity
-  | -- | The modification that applies a given atomic modification at the
-    -- | current time step
+  | -- | The atomic modification, applying at the current time step
     LtlAtom a
   | -- | Disjunction will be interpreted in an "intuitionistic" way, i.e. as
     -- branching into the "timeline" where the left disjunct holds and the one
@@ -49,24 +48,16 @@ data Ltl a
   | -- | Assert that the given formula holds at the next time step.
     LtlNext (Ltl a)
   | -- | Assert that the first formula holds at least until the second one
-    -- begins to hold, which must happen eventually. The formulas
+    -- begins to hold, which must happen eventually. The following holds:
     --
-    -- > a `LtlUntil` b
-    -- and
-    -- > b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
-    --
-    -- are equivalent.
+    -- > a `LtlUntil` b <=> b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
     LtlUntil (Ltl a) (Ltl a)
-  | -- | Assert that the second formula has to be true up to and including the
-    -- point when the first one becomes true; if that never happens, the second
+  | -- | Assert that the second formula has to hold up to and including the
+    -- point when the first begins to hold; if that never happens, the second
     -- formula has to remain true forever. View this as dual to 'LtlUntil'. The
-    -- formulas
-    --
-    -- > a `LtlRelease` b
-    -- and
-    -- > b `LtlAnd` (a `LtlOr` LtlNext (a `LtlRelease` b))
+    -- following holds:
     --
-    -- are equivalent.
+    -- > a `LtlRelease` b <=> b `LtlAnd` (a `LtlOr` LtlNext (a `LtlRelease` b))
     LtlRelease (Ltl a) (Ltl a)
   deriving (Show, Eq, Functor)
 
@@ -263,18 +254,17 @@ interpLtl ::
   (InterpLtl modification builtin m) =>
   Staged (LtlOp modification builtin) a ->
   StateT [Ltl modification] m a
-interpLtl (Return a) = return a
-interpLtl (Instr (StartLtl x) f) = get >>= put . (x :) >>= interpLtl . f
-interpLtl (Instr StopLtl f) = do
-  xs <- get
-  case xs of
+interpLtl (Return res) = return res
+interpLtl (Instr (StartLtl formula) computation) = do
+  modify' (formula :)
+  interpLtl $ computation ()
+interpLtl (Instr StopLtl f) =
+  get >>= \case
+    formula : formulas -> do
+      guard $ finished formula
+      put formulas
+      interpLtl $ f ()
     [] -> error "You called 'StopLtl' before 'StartLtl'. This is only possible if you're using internals."
-    x : rest ->
-      if finished x
-        then do
-          put rest
-          interpLtl $ f ()
-        else mzero
 interpLtl (Instr (Builtin b) f) = interpBuiltin b >>= interpLtl . f
 
 -- | Interpret a 'Staged' computation into a suitable domain, using the function
@@ -286,10 +276,11 @@ interpLtlAndPruneUnfinished ::
   (InterpLtl modification builtin m) =>
   Staged (LtlOp modification builtin) a ->
   StateT [Ltl modification] m a
-interpLtlAndPruneUnfinished f = do
-  res <- interpLtl f
+interpLtlAndPruneUnfinished computation = do
+  res <- interpLtl computation
   mods <- get
-  if all finished mods then return res else mzero
+  guard $ all finished mods
+  return res
 
 -- * Convenience functions
 
@@ -306,4 +297,8 @@ class (Monad m) => MonadModal m where
 
 instance MonadModal (Staged (LtlOp modification builtin)) where
   type Modification (Staged (LtlOp modification builtin)) = modification
-  modifyLtl x tr = Instr (StartLtl x) Return >> tr >>= \res -> Instr StopLtl Return >> return res
+  modifyLtl formula trace = do
+    Instr (StartLtl formula) Return
+    res <- trace
+    Instr StopLtl Return
+    return res

From 8fb4fd8697f283e9431babe3fc3fb936467ee0fa Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sat, 27 Dec 2025 23:59:51 +0100
Subject: [PATCH 02/96] this works !

---
 src/Cooked/Ltl.hs              |  94 ++++++-----
 src/Cooked/Ltl/Combinators.hs  |  35 +++-
 src/Cooked/MockChain/Staged.hs |  16 +-
 src/Cooked/Tweak/Common.hs     |  11 +-
 tests/Spec/Ltl.hs              | 293 ++++++++++++++++-----------------
 5 files changed, 243 insertions(+), 206 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 986429a5a..53aba6554 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -6,7 +6,6 @@
 -- be replaced later on with a dependency to https://github.com/tweag/graft.
 module Cooked.Ltl
   ( Ltl (..),
-    nowLater,
     nowLaterList,
     LtlOp (..),
     Staged (..),
@@ -59,6 +58,10 @@ data Ltl a
     --
     -- > a `LtlRelease` b <=> b `LtlAnd` (a `LtlOr` LtlNext (a `LtlRelease` b))
     LtlRelease (Ltl a) (Ltl a)
+  | -- | Assert that the given formula must not hold at the current time
+    -- step. This will be interpreted as ensuring the appropriate modifications
+    -- fail.
+    LtlNot (Ltl a)
   deriving (Show, Eq, Functor)
 
 -- | Split an LTL formula that describes a modification of a computation into a
@@ -80,21 +83,42 @@ data Ltl a
 -- <> b@ as the modification that first applies @b@ and then @a@. Attention:
 -- Since we use '<>' to define conjunction, if '<>' is not commutative,
 -- conjunction will also fail to be commutative!
-nowLater :: (Monoid a) => Ltl a -> [(a, Ltl a)]
-nowLater LtlTruth = [(mempty, LtlTruth)]
-nowLater LtlFalsity = []
-nowLater (LtlAtom g) = [(g, LtlTruth)]
-nowLater (a `LtlOr` b) = nowLater a ++ nowLater b
-nowLater (a `LtlAnd` b) =
-  [ (f <> g, ltlSimpl $ c `LtlAnd` d)
-  | (f, c) <- nowLater a,
-    (g, d) <- nowLater b
-  ]
-nowLater (LtlNext a) = [(mempty, a)]
-nowLater (a `LtlUntil` b) =
-  nowLater $ b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
-nowLater (a `LtlRelease` b) =
-  nowLater $ b `LtlAnd` (a `LtlOr` LtlNext (a `LtlRelease` b))
+
+-- | Say we're passing around more than one formula from each time step to the
+-- next, where the intended meaning of a list of formulas is the modification
+-- that applies the first formula in the list first, then the second formula,
+-- then the third and so on. We'd still like to compute a list of @(doNow,
+-- doLater)@ pairs as in 'nowLater', only that the @doLater@ should again be a
+-- list of formulas.
+nowLaterList :: [Ltl a] -> [([a], [a], [Ltl a])]
+nowLaterList =
+  foldr
+    ( \el acc -> do
+        (toApply, toFail, next) <- nowLater $ ltlSimpl el
+        (toApply', toFail', nexts) <- acc
+        return (toApply <> toApply', toFail <> toFail', next : nexts)
+    )
+    [([], [], [])]
+  where
+    nowLater :: Ltl a -> [([a], [a], Ltl a)]
+    nowLater LtlTruth = [([], [], LtlTruth)]
+    nowLater LtlFalsity = [([], [], LtlFalsity)]
+    nowLater (LtlAtom now) = [([now], [], LtlTruth)]
+    nowLater (f1 `LtlOr` f2) = nowLater f1 ++ nowLater f2
+    nowLater (f1 `LtlAnd` f2) = do
+      (toApply1, toFail1, next1) <- nowLater f1
+      (toApply2, toFail2, next2) <- nowLater f2
+      return (toApply1 <> toApply2, toFail1 <> toFail2, ltlSimpl $ next1 `LtlAnd` next2)
+    nowLater (LtlNext f) = [([], [], f)]
+    nowLater (LtlNot f) = do
+      (toApplys, toFails, next) <- nowLater f
+      [([], [toApply], LtlTruth) | toApply <- toApplys]
+        <> [([], [], ltlSimpl $ LtlNot next)]
+        <> [([toFail], [], LtlTruth) | toFail <- toFails]
+    nowLater (a `LtlUntil` b) =
+      nowLater $ ltlSimpl $ b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
+    nowLater (a `LtlRelease` b) =
+      nowLater $ ltlSimpl $ b `LtlAnd` (a `LtlOr` LtlNext (a `LtlRelease` b))
 
 -- | If there are no more steps and the next step should satisfy the given
 -- formula: Are we finished, i.e. was the initial formula satisfied by now?
@@ -102,33 +126,18 @@ finished :: Ltl a -> Bool
 finished LtlTruth = True
 finished LtlFalsity = False --  we want falsity to fail always, even on the empty computation
 finished (LtlAtom _) = False
-finished (a `LtlAnd` b) = finished a && finished b
-finished (a `LtlOr` b) = finished a || finished b
+finished (f1 `LtlAnd` f2) = finished f1 && finished f2
+finished (f1 `LtlOr` f2) = finished f1 || finished f2
 finished (LtlNext _) = False
 finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
-
--- | Say we're passing around more than one formula from each time step to the
--- next, where the intended meaning of a list of formulas is the modification
--- that applies the first formula in the list first, then the second formula,
--- then the third and so on. We'd still like to compute a list of @(doNow,
--- doLater)@ pairs as in 'nowLater', only that the @doLater@ should again be a
--- list of formulas.
-nowLaterList :: (Monoid a) => [Ltl a] -> [(a, [Ltl a])]
-nowLaterList = joinNowLaters . map nowLater
-  where
-    joinNowLaters [] = [(mempty, [])]
-    joinNowLaters (l : ls) =
-      [ (g <> f, c : cs)
-      | (f, c) <- l,
-        (g, cs) <- joinNowLaters ls
-      ]
+finished (LtlNot f) = not $ finished f
 
 -- | Straightforward simplification procedure for LTL formulas. This function
--- knows how 'LtlTruth' and 'LtlFalsity' play with conjunction and disjunction
--- and recursively applies this knowledge; it does not do anything "fancy" like
--- computing a normal form and is only used to keep the formulas 'nowLater'
--- generates from growing too wildly.
+-- knows how 'LtlTruth' and 'LtlFalsity' play with negation, conjunction and
+-- disjunction and recursively applies this knowledge; it does not do anything
+-- "fancy" like computing a normal form and is only used to keep the formulas
+-- 'nowLater' generates from growing too wildly.
 ltlSimpl :: Ltl a -> Ltl a
 ltlSimpl expr =
   let (expr', progress) = simpl expr
@@ -144,8 +153,17 @@ ltlSimpl expr =
             else (LtlNext a, False)
     simpl (LtlUntil a b) = recurse2 LtlUntil a b
     simpl (LtlRelease a b) = recurse2 LtlRelease a b
+    simpl (LtlNot f) = simplNot f
     simpl x = (x, False)
 
+    simplNot :: Ltl a -> (Ltl a, Bool)
+    simplNot (simpl -> (LtlTruth, _)) = (LtlFalsity, True)
+    simplNot (simpl -> (LtlFalsity, _)) = (LtlTruth, True)
+    simplNot (simpl -> (LtlAnd a b, _)) | (r, _) <- simplOr (LtlNot a) (LtlNot b) = (r, True)
+    simplNot (simpl -> (LtlOr a b, _)) | (r, _) <- simplAnd (LtlNot a) (LtlNot b) = (r, True)
+    simplNot (simpl -> (LtlNot a, _)) = (a, True)
+    simplNot (simpl -> (a, pa)) = (LtlNot a, pa)
+
     simplAnd :: Ltl a -> Ltl a -> (Ltl a, Bool)
     simplAnd a b =
       let (a', pa) = simpl a
diff --git a/src/Cooked/Ltl/Combinators.hs b/src/Cooked/Ltl/Combinators.hs
index 5f7aa8475..201187a8f 100644
--- a/src/Cooked/Ltl/Combinators.hs
+++ b/src/Cooked/Ltl/Combinators.hs
@@ -10,6 +10,12 @@ module Cooked.Ltl.Combinators
     eventually',
     always,
     always',
+    wheneverPossible',
+    wheneverPossible,
+    ifPossible',
+    ifPossible,
+    ltlImplies',
+    ltlImplies,
   )
 where
 
@@ -57,7 +63,7 @@ eventually = eventually' . LtlAtom
 eventually' :: Ltl a -> Ltl a
 eventually' = LtlUntil LtlTruth
 
--- |  Same as `always'`, but first wraps the elements in the input list in
+-- | Same as `always'`, but first wraps the elements in the input list in
 -- atomic formulas.
 always :: a -> Ltl a
 always = always' . LtlAtom
@@ -65,3 +71,30 @@ always = always' . LtlAtom
 -- | Produces an Ltl formula which ensures the input formula always holds
 always' :: Ltl a -> Ltl a
 always' = LtlRelease LtlFalsity
+
+-- | Same as `ifPossible'`, but first wraps the input in an atomic formula
+ifPossible :: a -> Ltl a
+ifPossible = ifPossible' . LtlAtom
+
+-- | Produces an Ltl formula which attempts to apply a certain formula but does
+-- not fail in case it fails.
+ifPossible' :: Ltl a -> Ltl a
+ifPossible' f = f `LtlOr` LtlNot f
+
+-- | Same as `wheneverPossible'`, but first wraps the input in an atomic formula
+wheneverPossible :: a -> Ltl a
+wheneverPossible = wheneverPossible' . LtlAtom
+
+-- | Produces an Ltl formula which attempts to apply a certain formula whenever
+-- possible, while ignoring steps when it is not.
+wheneverPossible' :: Ltl a -> Ltl a
+wheneverPossible' = always' . ifPossible'
+
+-- | Same as `ltlImplies'` but first wraps the inputs in atoms
+ltlImplies :: a -> a -> Ltl a
+ltlImplies a1 a2 = ltlImplies' (LtlAtom a1) (LtlAtom a2)
+
+-- | Produces a formula that succeeds if the first formula fails, or if both
+-- formulas hold
+ltlImplies' :: Ltl a -> Ltl a -> Ltl a
+ltlImplies' f1 f2 = (f1 `LtlAnd` f2) `LtlOr` LtlNot f1
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index e3bff05ed..77b83bdf9 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -24,7 +24,7 @@ where
 
 import Cardano.Node.Emulator qualified as Emulator
 import Control.Applicative
-import Control.Monad (MonadPlus (..), msum)
+import Control.Monad (MonadPlus (..), guard, msum)
 import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.State
@@ -118,17 +118,15 @@ instance InterpLtl (UntypedTweak InterpMockChain) MockChainBuiltin InterpMockCha
   interpBuiltin GetParams = getParams
   interpBuiltin (SetParams params) = setParams params
   interpBuiltin (ValidateTxSkel skel) =
-    get
-      >>= msum
-        . map (uncurry interpretNow)
-        . nowLaterList
+    get >>= msum . map interpretNow . nowLaterList
     where
       interpretNow ::
-        UntypedTweak InterpMockChain ->
-        [Ltl (UntypedTweak InterpMockChain)] ->
+        ([UntypedTweak InterpMockChain], [UntypedTweak InterpMockChain], [Ltl (UntypedTweak InterpMockChain)]) ->
         StateT [Ltl (UntypedTweak InterpMockChain)] InterpMockChain Ledger.CardanoTx
-      interpretNow (UntypedTweak now) later = do
-        (_, skel') <- lift $ runTweakInChain now skel
+      interpretNow (now, notNow, later) = do
+        mcst <- lift get
+        guard $ all (\(UntypedTweak tweak) -> null $ runMockChainTFromConf (mockChainStateConf mcst) $ runTweakInChain tweak skel) notNow
+        (_, skel') <- lift $ runTweakInChain (foldl (\acc (UntypedTweak tweak) -> tweak >> acc) (return ()) now) skel
         put later
         validateTxSkel skel'
   interpBuiltin (TxSkelOutByRef o) = txSkelOutByRef o
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index 5b1e94802..d2d15216e 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -5,7 +5,7 @@ module Cooked.Tweak.Common
   ( runTweakInChain,
     runTweakInChain',
     Tweak,
-    UntypedTweak (UntypedTweak),
+    UntypedTweak (..),
 
     -- * User API
     MonadTweak (..),
@@ -92,14 +92,7 @@ runTweakInChain' tweak skel = ListT.toList $ runStateT tweak skel
 -- | This is a wrapper type used in the implementation of the Staged monad. You
 -- will probably never use it while you're building 'Tweak's.
 data UntypedTweak m where
-  UntypedTweak :: Tweak m a -> UntypedTweak m
-
-instance (Monad m) => Semigroup (UntypedTweak m) where
-  -- The right tweak is applied first
-  UntypedTweak f <> UntypedTweak g = UntypedTweak $ g >> f
-
-instance (Monad m) => Monoid (UntypedTweak m) where
-  mempty = UntypedTweak $ return ()
+  UntypedTweak :: {getTypedTweak :: Tweak m a} -> UntypedTweak m
 
 -- * A few fundamental tweaks
 
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index 13f947f60..2f7a730e2 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -7,65 +7,37 @@ import Control.Monad.State
 import Control.Monad.Writer
 import Cooked.Ltl
 import Cooked.Ltl.Combinators
-import Data.Set (fromList)
+import Cooked.MockChain.Testing
+import Data.Maybe (isNothing)
 import Test.Tasty
 import Test.Tasty.HUnit
 
 data TestBuiltin a where
   EmitInteger :: Integer -> TestBuiltin ()
   GetInteger :: TestBuiltin Integer
-  EmitUnmodified :: Integer -> TestBuiltin ()
 
-type TestModification = Integer -> Integer
+data TestModification
+  = Add Integer
+  | Mul Integer
+  | Fail
+  deriving (Show, Eq)
 
-instance {-# OVERLAPS #-} Semigroup TestModification where
-  a <> b = b . a
-
-instance {-# OVERLAPS #-} Monoid TestModification where
-  mempty = id
+applyMod :: Integer -> TestModification -> Maybe Integer
+applyMod _ Fail = Nothing
+applyMod i (Add i') = if i == i' then Nothing else Just $ i + i'
+applyMod i (Mul i') = if i == i' then Nothing else Just $ i * i'
 
 instance (MonadPlus m) => InterpLtl TestModification TestBuiltin (WriterT [Integer] m) where
   interpBuiltin GetInteger = return 42
-  interpBuiltin (EmitInteger i) =
-    get
-      >>= msum
-        . map (\(now, later) -> tell [now i] <* put later)
-        . nowLaterList
-  interpBuiltin (EmitUnmodified i) = do
-    get
+  interpBuiltin (EmitInteger i) = do
+    gets nowLaterList
       >>= msum
-        . map (\(now, later) -> guard (now i == i) >> tell [now i] <* put later)
-        . nowLaterList
-
-{- Remark: Why are we re-defining 'somewhere' and 'everywhere' here?
-
-In some sense, the following two definitions of 'somewhere' and
-'everywhere' are the correct ones, because they work in an arbitrary
-'MonadModal'. The definitions in "Cooked.MockChain.Monad.Staged" are
-necessary because we want functions with those names that we can
-directly apply to 'Attack's: Since the 'Modification's of any
-'MonadModal' (including 'MonadModalMockChain') have to be a constant
-type, but 'Attack' isn't, we use the definitions there to hide the
-'UntypedAttack' wrapper from the user.
-
-With the definitions below, one would have to write
-
-> somewhere (UntypedAttack a) trace
-
-instead of
-
-> somewhere a trace
-
-in the only use-case outside of tests. This justifies the
-re-definition here, in my opinion.
-
--}
-
-somewhere :: (MonadModal m) => Modification m -> m a -> m a
-somewhere = modifyLtl . eventually
-
-everywhere :: (MonadModal m) => Modification m -> m a -> m a
-everywhere = modifyLtl . always
+        . map
+          ( \(now, notNow, later) -> do
+              guard $ all (isNothing . applyMod i) notNow
+              maybe mzero ((put later >>) . tell . (: [])) $
+                foldl (\acc el -> acc >>= (`applyMod` el)) (Just i) now
+          )
 
 emitInteger :: Integer -> Staged (LtlOp TestModification TestBuiltin) ()
 emitInteger i = Instr (Builtin (EmitInteger i)) Return
@@ -73,9 +45,6 @@ emitInteger i = Instr (Builtin (EmitInteger i)) Return
 getInteger :: Staged (LtlOp TestModification TestBuiltin) Integer
 getInteger = Instr (Builtin GetInteger) Return
 
-emitUnmodified :: Integer -> Staged (LtlOp TestModification TestBuiltin) ()
-emitUnmodified i = Instr (Builtin (EmitUnmodified i)) Return
-
 go :: Staged (LtlOp TestModification TestBuiltin) a -> [[Integer]]
 go = execWriterT . flip execStateT [] . interpLtl
 
@@ -92,48 +61,75 @@ emptyTraces = [return (), void getInteger]
 testTraces :: [Staged (LtlOp TestModification TestBuiltin) ()]
 testTraces = nonemptyTraces ++ emptyTraces
 
-assertAll :: [a] -> (a -> Assertion) -> Assertion
-assertAll space f = mapM_ f space
-
-assertEqualSets :: (Show a, Ord a) => [a] -> [a] -> Assertion
-assertEqualSets l r =
-  assertBool
-    ( "unequal sets:\n"
-        ++ "expected: "
-        ++ show r
-        ++ "\n"
-        ++ " but got: "
-        ++ show l
-    )
-    (fromList l == fromList r)
-
 tests :: TestTree
 tests =
   testGroup
     "LTL"
-    [ testGroup
-        "simple laws"
-        [ testCase "LtlFalsity fails on every computation" $
-            assertAll testTraces (\tr -> go (modifyLtl LtlFalsity tr) @?= []),
-          testCase "LtlTruth leaves every computation unchanged" $
-            assertAll testTraces (\tr -> go (modifyLtl LtlTruth tr) @?= go tr),
-          testCase "x `LtlUntil` y == y `LtlOr` (x `LtlAnd` LtlNext (x `LtlUntil` y))" $
-            let x = LtlAtom (1 +)
-                y = LtlAtom (2 +)
-                a = x `LtlUntil` y
-                b = y `LtlOr` (x `LtlAnd` LtlNext (x `LtlUntil` y))
-             in assertAll
-                  testTraces
-                  (\tr -> assertEqualSets (go $ modifyLtl a tr) (go $ modifyLtl b tr)),
-          testCase "x `LtlRelease` y == y `LtlAnd` (x `LtlOr` LtlNext (x `LtlRelease` y)) for nonempty traces" $
-            let x = LtlAtom (1 +)
-                y = LtlAtom (2 +)
-                a = x `LtlRelease` y
-                b = y `LtlAnd` (x `LtlOr` LtlNext (x `LtlRelease` y))
-             in assertAll
-                  nonemptyTraces
-                  (\tr -> assertEqualSets (go $ modifyLtl a tr) (go $ modifyLtl b tr))
-        ],
+    [ let add1 = LtlAtom $ Add 1
+          add2 = LtlAtom $ Add 2
+          add3 = LtlAtom $ Add 3
+          failMod = LtlAtom Fail
+          untilDirect = add1 `LtlUntil` add2
+          untilIndirect = add2 `LtlOr` (add1 `LtlAnd` LtlNext (add1 `LtlUntil` add2))
+          releaseDirect = add1 `LtlRelease` add2
+          releaseIndirect = add2 `LtlAnd` (add1 `LtlOr` LtlNext (add1 `LtlRelease` add2))
+       in testGroup
+            "simple laws"
+            [ testCase "LtlFalsity fails on every computation" $
+                testAll (\tr -> go (modifyLtl LtlFalsity tr) @?= []) testTraces,
+              testCase "LtlTruth leaves every computation unchanged" $
+                testAll (\tr -> go (modifyLtl LtlTruth tr) @?= go tr) testTraces,
+              testCase "x `LtlUntil` y == y `LtlOr` (x `LtlAnd` LtlNext (x `LtlUntil` y))" $
+                testAll
+                  (\tr -> assertSameSets (go $ modifyLtl untilDirect tr) (go $ modifyLtl untilIndirect tr))
+                  testTraces,
+              testCase "x `LtlRelease` y == y `LtlAnd` (x `LtlOr` LtlNext (x `LtlRelease` y)) for nonempty traces" $
+                testAll
+                  (\tr -> assertSameSets (go $ modifyLtl releaseDirect tr) (go $ modifyLtl releaseIndirect tr))
+                  nonemptyTraces,
+              testCase "Negation of a failing atom" $
+                go (modifyLtl (LtlNot failMod) (emitInteger 3)) @?= [[3]],
+              testCase "Negation of a successful atom" $
+                go (modifyLtl (LtlNot add2) (emitInteger 3)) @?= [],
+              testCase "Negation of the conjunction of atoms" $
+                go . modifyLtl (LtlNot (add2 `LtlAnd` add3)) . emitInteger
+                  <$> [ 2, -- add2 will fail, thus it will succeed, unmodified
+                        3, -- add3 will fail, thus it will succeed, unmodified
+                        4 -- both would succeed, thus it fails
+                      ]
+                  @?= [ [[2]],
+                        [[3]],
+                        []
+                      ],
+              testCase "Negation of the disjunction of atoms" $
+                go . modifyLtl (LtlNot (add2 `LtlOr` failMod)) . emitInteger
+                  <$> [ 2, -- add2 will fail, and failMod too, thus it succeeds
+                        3 -- failMod fails, but not add2, thus it fails
+                      ]
+                  @?= [ [[2]],
+                        []
+                      ],
+              testCase "Conjunction" $
+                go (modifyLtl (add1 `LtlAnd` add2) (emitInteger 3)) @?= [[3 + 1 + 2]],
+              testCase "Implication when the first modification does not apply" $
+                go (modifyLtl (add1 `ltlImplies'` add2) (emitInteger 1)) @?= [[1]],
+              testCase "Implication when both modifications apply" $
+                go (modifyLtl (add1 `ltlImplies'` add2) (emitInteger 3)) @?= [[3 + 1 + 2]],
+              testCase "Implication when the first modification applies, but not the second" $
+                go (modifyLtl (add1 `ltlImplies'` add3) (emitInteger 2)) @?= [],
+              testCase "Implication backwards in time" $
+                go . modifyLtl (LtlNext add1 `ltlImplies'` add3) . mapM_ emitInteger
+                  <$> [ [2, 4], -- add1 applies to 4, and add3 to 2, thus they are both performed
+                        [2, 1], -- add1 does not apply to 1, thus add3 is not applied to 2, even though it could
+                        [3, 1], -- add1 does not apply to 1, thus it does not matter that add3 does not apply to 3
+                        [3, 2] -- add1 applies to 2, but add3 does not apply to 3, which is forbidden
+                      ]
+                  @?= [ [[2 + 3, 4 + 1]],
+                        [[2, 1]],
+                        [[3, 1]],
+                        []
+                      ]
+            ],
       testGroup
         "unit tests"
         [ testCase "LtlNext changes the second step" $
@@ -143,20 +139,20 @@ tests =
                   where
                     incSecond (a : b : cs) = a : b + n : cs
                     incSecond _ = []
-             in assertAll
-                  testTraces
+             in testAll
                   ( \tr ->
-                      assertEqualSets
-                        (go $ modifyLtl (LtlNext $ LtlAtom (n +)) tr)
+                      assertSameSets
+                        (go $ modifyLtl (LtlNext $ LtlAtom $ Add n) tr)
                         (incSeconds $ go tr)
-                  ),
+                  )
+                  testTraces,
           testCase "everywhere changes everything" $
             let n = 3
                 incAll :: [[Integer]] -> [[Integer]]
                 incAll = map (map (+ n))
-             in assertAll
-                  testTraces
-                  (\tr -> assertEqualSets (go $ everywhere (n +) tr) (incAll $ go tr)),
+             in testAll
+                  (\tr -> assertSameSets (go $ modifyLtl (always (Add n)) tr) (incAll $ go tr))
+                  testTraces,
           testCase "somewhere case-splits" $
             let n = 3
                 caseSplit :: [[Integer]] -> [[Integer]]
@@ -164,66 +160,57 @@ tests =
                   where
                     alternatives [] = []
                     alternatives (x : xs) = (x + n : xs) : map (x :) (alternatives xs)
-             in assertAll
-                  testTraces
-                  (\tr -> assertEqualSets (go $ somewhere (n +) tr) (caseSplit $ go tr)),
+             in testAll
+                  (\tr -> assertSameSets (go $ modifyLtl (eventually (Add n)) tr) (caseSplit $ go tr))
+                  testTraces,
           testCase "somewhere is exponential in branch number" $
-            -- If we have @tr = a >> b@, we expect
-            --
-            -- > somewhere f $ somewhere g tr
-            --
-            -- to describe the following four traces:
-            --
-            -- > 1. f (g a) >> b
-            -- > 2. f a >> g b
-            -- > 3. g a >> f b
-            -- > 4. a >> f (g b)
-            --
             let tr = emitInteger 42 >> emitInteger 3
-             in assertEqualSets
-                  (go $ somewhere (1 +) $ somewhere (2 +) tr)
+             in assertSameSets
+                  (go $ modifyLtl (eventually (Add 1)) $ modifyLtl (eventually (Add 2)) tr)
                   [ [42 + 1 + 2, 3],
                     [42, 3 + 1 + 2],
                     [42 + 1, 3 + 2],
                     [42 + 2, 3 + 1]
                   ],
-          testCase "modality order is respected" $
-            assertEqualSets (go $ everywhere (1 +) $ everywhere (const 2) $ emitInteger 1) [[2]],
+          testCase "Modification order using 'LtlAnd' is respected (left to right)" $
+            assertSameSets (go $ modifyLtl (LtlAtom (Add 1) `LtlAnd` LtlAtom (Mul 4)) $ emitInteger 2) [[12]],
+          testCase "Modification order using modalities is respected (inner to outer)" $
+            assertSameSets (go $ modifyLtl (LtlAtom (Add 1)) $ modifyLtl (LtlAtom (Mul 4)) $ emitInteger 2) [[9]],
           testCase "nested everywhere combines modifications" $
-            assertEqualSets
-              ( go $
-                  everywhere (1 +) $
+            assertSameSets
+              ( go $ do
+                  modifyLtl (always (Add 1)) $ do
                     emitInteger 42
-                      >> everywhere
-                        (2 +)
-                        ( emitInteger 43
-                            >> everywhere (3 *) (emitInteger 44)
-                        )
-                      >> emitInteger 45
+                    modifyLtl (always (Add 2)) $ do
+                      emitInteger 43
+                      modifyLtl (always (Add 3)) $ do
+                        emitInteger 44
+                      emitInteger 45
+                    emitInteger 46
+                  emitInteger 47
               )
-              [[42 + 1, 43 + 1 + 2, (44 + 1 + 2) * 3, 45 + 1]]
+              [[42 + 1, 43 + 1 + 2, 44 + 1 + 2 + 3, 45 + 1 + 2, 46 + 1, 47]]
         ],
       testGroup
         "LTL Combinators"
         $ let traceSolo = emitInteger 24
               traceDuo = emitInteger 24 >> emitInteger 13
-              traceFail = traceSolo >> emitUnmodified 35 >> traceSolo
            in [ testCase "anyOf" $
-                  assertEqualSets
-                    (go $ modifyLtl (anyOf [(+ 5), (* 5)]) traceSolo)
+                  assertSameSets
+                    (go $ modifyLtl (anyOf [Add 5, Mul 5]) traceSolo)
                     [ [24 + 5],
                       [24 * 5]
                     ],
                 testCase "anyOf [always, eventually]" $
-                  assertEqualSets
-                    (go $ modifyLtl (anyOf' [always (+ 5), eventually (* 5)]) traceDuo)
+                  assertSameSets
+                    (go $ modifyLtl (anyOf' [always (Add 5), eventually (Mul 5)]) traceDuo)
                     [ [24 + 5, 13 + 5],
                       [24 * 5, 13],
                       [24, 13 * 5]
                     ],
                 testCase "anyOf [always anyOf, eventually anyOf]" $
-                  assertEqualSets
-                    (go $ modifyLtl (anyOf' [always' (anyOf [(+ 5), (* 5)]), eventually' (anyOf [(+ 5), (* 5)])]) traceDuo)
+                  assertSameSets
+                    (go $ modifyLtl (anyOf' [always' (anyOf [Add 5, Mul 5]), eventually' (anyOf [Add 5, Mul 5])]) traceDuo)
                     [ [24 + 5, 13 + 5],
                       [24 + 5, 13 * 5],
                       [24 * 5, 13 * 5],
@@ -234,42 +221,50 @@ tests =
                       [24, 13 * 5]
                     ],
                 testCase "allOf" $
-                  assertEqualSets
-                    (go $ modifyLtl (allOf [(+ 5), (* 5)]) traceSolo)
+                  assertSameSets
+                    (go $ modifyLtl (allOf [Add 5, Mul 5]) traceSolo)
                     [[(24 + 5) * 5]],
                 testCase "allOf [anyOf, anyOf]" $
-                  assertEqualSets
-                    (go $ modifyLtl (allOf' [anyOf [(+ 5), (* 5)], anyOf [(+ 5), (* 5)]]) traceSolo)
+                  assertSameSets
+                    (go $ modifyLtl (allOf' [anyOf [Add 5, Mul 5], anyOf [Add 5, Mul 5]]) traceSolo)
                     [ [24 + 5 + 5],
                       [24 * 5 + 5],
                       [24 * 5 * 5],
                       [(24 + 5) * 5]
                     ],
                 testCase "delay (neg)" $
-                  assertEqualSets
-                    (go $ modifyLtl (delay 0 (+ 5)) traceDuo)
-                    (go $ modifyLtl (delay (-10) (+ 5)) traceDuo),
+                  assertSameSets
+                    (go $ modifyLtl (delay 0 (Add 5)) traceDuo)
+                    (go $ modifyLtl (delay (-10) (Add 5)) traceDuo),
                 testCase "delay (pos)" $
-                  assertEqualSets
-                    (go $ modifyLtl (delay 1 (+ 5)) traceDuo)
+                  assertSameSets
+                    (go $ modifyLtl (delay 1 (Add 5)) traceDuo)
                     [[24, 13 + 5]],
                 testCase "delay (anyOf [eventually, always])" $
-                  assertEqualSets
-                    (go $ modifyLtl (delay' 3 (anyOf' [eventually (+ 5), always (* 5)])) (traceDuo >> traceDuo >> traceDuo))
+                  assertSameSets
+                    (go $ modifyLtl (delay' 3 (anyOf' [eventually (Add 5), always (Mul 5)])) (traceDuo >> traceDuo >> traceDuo))
                     [ [24, 13, 24, 13 + 5, 24, 13],
                       [24, 13, 24, 13, 24 + 5, 13],
                       [24, 13, 24, 13, 24, 13 + 5],
                       [24, 13, 24, 13 * 5, 24 * 5, 13 * 5]
                     ],
                 testCase "always fails if a step cannot be modified" $
-                  assertEqualSets
-                    (go $ modifyLtl (always (+ 5)) traceFail)
+                  assertSameSets
+                    (go $ modifyLtl (always (Add 5)) (traceDuo >> emitInteger 5))
                     [],
                 testCase "eventually succeeds if a step cannot be modified" $
-                  assertEqualSets
-                    (go $ modifyLtl (eventually (+ 5)) traceFail)
-                    [ [24 + 5, 35, 24],
-                      [24, 35, 24 + 5]
-                    ]
+                  assertSameSets
+                    (go $ modifyLtl (eventually (Add 5)) (traceDuo >> emitInteger 5))
+                    [ [24 + 5, 13, 5],
+                      [24, 13 + 5, 5]
+                    ],
+                testCase "wherever possible succeeds if a few steps cannot be modified" $
+                  assertSameSets
+                    ( go $
+                        modifyLtl
+                          (wheneverPossible (Add 5))
+                          (traceDuo >> emitInteger 5 >> emitInteger 5 >> traceDuo >> emitInteger 5 >> traceDuo)
+                    )
+                    [[24 + 5, 13 + 5, 5, 5, 24 + 5, 13 + 5, 5, 24 + 5, 13 + 5]]
               ]
     ]

From db7c5cf6feb5ea6c968295c01c63b507df285d5f Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 29 Dec 2025 01:37:54 +0100
Subject: [PATCH 03/96] better ltlsimpl

---
 src/Cooked/Ltl.hs | 86 +++++++++++++----------------------------------
 1 file changed, 24 insertions(+), 62 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 53aba6554..848f961ff 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -108,12 +108,12 @@ nowLaterList =
     nowLater (f1 `LtlAnd` f2) = do
       (toApply1, toFail1, next1) <- nowLater f1
       (toApply2, toFail2, next2) <- nowLater f2
-      return (toApply1 <> toApply2, toFail1 <> toFail2, ltlSimpl $ next1 `LtlAnd` next2)
+      return (toApply1 <> toApply2, toFail1 <> toFail2, next1 `LtlAnd` next2)
     nowLater (LtlNext f) = [([], [], f)]
     nowLater (LtlNot f) = do
       (toApplys, toFails, next) <- nowLater f
       [([], [toApply], LtlTruth) | toApply <- toApplys]
-        <> [([], [], ltlSimpl $ LtlNot next)]
+        <> [([], [], LtlNot next)]
         <> [([toFail], [], LtlTruth) | toFail <- toFails]
     nowLater (a `LtlUntil` b) =
       nowLater $ ltlSimpl $ b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
@@ -126,8 +126,8 @@ finished :: Ltl a -> Bool
 finished LtlTruth = True
 finished LtlFalsity = False --  we want falsity to fail always, even on the empty computation
 finished (LtlAtom _) = False
-finished (f1 `LtlAnd` f2) = finished f1 && finished f2
-finished (f1 `LtlOr` f2) = finished f1 || finished f2
+finished (LtlAnd f1 f2) = finished f1 && finished f2
+finished (LtlOr f1 f2) = finished f1 || finished f2
 finished (LtlNext _) = False
 finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
@@ -139,64 +139,26 @@ finished (LtlNot f) = not $ finished f
 -- "fancy" like computing a normal form and is only used to keep the formulas
 -- 'nowLater' generates from growing too wildly.
 ltlSimpl :: Ltl a -> Ltl a
-ltlSimpl expr =
-  let (expr', progress) = simpl expr
-   in if progress then expr' else expr
-  where
-    simpl :: Ltl a -> (Ltl a, Bool)
-    simpl (LtlAnd a b) = simplAnd a b
-    simpl (LtlOr a b) = simplOr a b
-    simpl (LtlNext a) =
-      let (a', pa) = simpl a
-       in if pa
-            then (LtlNext a', True)
-            else (LtlNext a, False)
-    simpl (LtlUntil a b) = recurse2 LtlUntil a b
-    simpl (LtlRelease a b) = recurse2 LtlRelease a b
-    simpl (LtlNot f) = simplNot f
-    simpl x = (x, False)
-
-    simplNot :: Ltl a -> (Ltl a, Bool)
-    simplNot (simpl -> (LtlTruth, _)) = (LtlFalsity, True)
-    simplNot (simpl -> (LtlFalsity, _)) = (LtlTruth, True)
-    simplNot (simpl -> (LtlAnd a b, _)) | (r, _) <- simplOr (LtlNot a) (LtlNot b) = (r, True)
-    simplNot (simpl -> (LtlOr a b, _)) | (r, _) <- simplAnd (LtlNot a) (LtlNot b) = (r, True)
-    simplNot (simpl -> (LtlNot a, _)) = (a, True)
-    simplNot (simpl -> (a, pa)) = (LtlNot a, pa)
-
-    simplAnd :: Ltl a -> Ltl a -> (Ltl a, Bool)
-    simplAnd a b =
-      let (a', pa) = simpl a
-          (b', pb) = simpl b
-       in case (a', b') of
-            (LtlTruth, _) -> (b', True)
-            (_, LtlTruth) -> (a', True)
-            (LtlFalsity, _) -> (LtlFalsity, True)
-            (_, LtlFalsity) -> (LtlFalsity, True)
-            _ -> if pa || pb then (LtlAnd a' b', True) else (LtlAnd a b, False)
-
-    simplOr :: Ltl a -> Ltl a -> (Ltl a, Bool)
-    simplOr a b =
-      let (a', pa) = simpl a
-          (b', pb) = simpl b
-       in case (a', b') of
-            (LtlTruth, _) -> (LtlTruth, True)
-            (_, LtlTruth) -> (LtlTruth, True)
-            (LtlFalsity, _) -> (b', True)
-            (_, LtlFalsity) -> (a', True)
-            _ -> if pa || pb then (LtlOr a' b', True) else (LtlOr a b, False)
-
-    recurse2 ::
-      (Ltl a -> Ltl a -> Ltl a) ->
-      Ltl a ->
-      Ltl a ->
-      (Ltl a, Bool)
-    recurse2 f a b =
-      let (a', pa) = simpl a
-          (b', pb) = simpl b
-       in if pa || pb
-            then (f a' b', True)
-            else (f a b, False)
+ltlSimpl (LtlAtom a) = LtlAtom a
+ltlSimpl LtlTruth = LtlTruth
+ltlSimpl LtlFalsity = LtlFalsity
+ltlSimpl (LtlNext f) = LtlNext f
+ltlSimpl (LtlRelease f1 f2) = ltlSimpl $ f2 `LtlAnd` (f1 `LtlOr` LtlNext (f1 `LtlRelease` f2))
+ltlSimpl (LtlUntil f1 f2) = ltlSimpl $ f2 `LtlOr` (f1 `LtlAnd` LtlNext (f1 `LtlUntil` f2))
+ltlSimpl (LtlNot (ltlSimpl -> LtlTruth)) = LtlFalsity
+ltlSimpl (LtlNot (ltlSimpl -> LtlFalsity)) = LtlTruth
+ltlSimpl (LtlNot (ltlSimpl -> LtlNot f)) = f
+ltlSimpl (LtlNot (ltlSimpl -> LtlAnd f1 f2)) = ltlSimpl $ LtlNot f1 `LtlOr` LtlNot f2
+ltlSimpl (LtlNot (ltlSimpl -> LtlOr f1 f2)) = ltlSimpl $ LtlNot f1 `LtlAnd` LtlNot f2
+ltlSimpl (LtlNot (ltlSimpl -> f)) = LtlNot f
+ltlSimpl (LtlAnd (ltlSimpl -> LtlFalsity) _) = LtlFalsity
+ltlSimpl (LtlAnd _ (ltlSimpl -> LtlFalsity)) = LtlFalsity
+ltlSimpl (LtlAnd (ltlSimpl -> LtlTruth) (ltlSimpl -> f2)) = f2
+ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> LtlTruth)) = f1
+ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlAnd f1 f2
+ltlSimpl (LtlOr (ltlSimpl -> LtlFalsity) (ltlSimpl -> f2)) = f2
+ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> LtlFalsity)) = f1
+ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlOr f1 f2
 
 -- * An AST for "reified computations"
 

From 82bed7d7c87f544f77c339d4178643f90053c09c Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 29 Dec 2025 02:50:28 +0100
Subject: [PATCH 04/96] laying out things nicely + commenting

---
 src/Cooked/Ltl.hs | 106 +++++++++++++++++++++++-----------------------
 1 file changed, 52 insertions(+), 54 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 848f961ff..ed9658431 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -50,6 +50,10 @@ data Ltl a
     -- begins to hold, which must happen eventually. The following holds:
     --
     -- > a `LtlUntil` b <=> b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
+    --
+    -- `LtlUntil` could technically be defined as the above formula using
+    -- Haskell's laziness, but is left as a constructor to have a counterpart
+    -- for `LtlRelease`, which cannot.
     LtlUntil (Ltl a) (Ltl a)
   | -- | Assert that the second formula has to hold up to and including the
     -- point when the first begins to hold; if that never happens, the second
@@ -57,6 +61,9 @@ data Ltl a
     -- following holds:
     --
     -- > a `LtlRelease` b <=> b `LtlAnd` (a `LtlOr` LtlNext (a `LtlRelease` b))
+    --
+    -- `LtlRelease` needs it own constructor, as it is considered valid on an
+    -- empty computation, which the above formula is not in most cases.
     LtlRelease (Ltl a) (Ltl a)
   | -- | Assert that the given formula must not hold at the current time
     -- step. This will be interpreted as ensuring the appropriate modifications
@@ -64,32 +71,25 @@ data Ltl a
     LtlNot (Ltl a)
   deriving (Show, Eq, Functor)
 
--- | Split an LTL formula that describes a modification of a computation into a
--- list of @(doNow, doLater)@ pairs, where
+-- | For each LTL formula that describes a modification of a computation in a
+-- list, split it into a list of @(doNow, mustFailNow, doLater)@ triplets, and
+-- then appropriately combine the results. The result of the splitting is bound
+-- to the following semantics:
+--
+-- * @doNow@ is the list of modifications to be consecutively applied to the
+-- * current time step,
 --
--- * @doNow@ is the modification to be applied to the current time step,
+-- * @mustFailNow@ is the list of modifications that each must fail when applied
+-- * to the current time step, and
 --
 -- * @doLater@ is an LTL formula describing the modification that should be
---   applied from the next time step onwards, and
+--   applied from the next time step onwards.
 --
 -- The return value is a list because a formula might be satisfied in different
 -- ways. For example, the modification described by @a `LtlUntil` b@ might be
 -- accomplished by applying the modification @b@ right now, or by applying @a@
 -- right now and @a `LtlUntil` b@ from the next step onwards; the returned list
 -- will contain these two options.
---
--- Modifications should form a 'Monoid', where 'mempty' is the do-nothing
--- modification, and '<>' is the composition of modifications. We interpret @a
--- <> b@ as the modification that first applies @b@ and then @a@. Attention:
--- Since we use '<>' to define conjunction, if '<>' is not commutative,
--- conjunction will also fail to be commutative!
-
--- | Say we're passing around more than one formula from each time step to the
--- next, where the intended meaning of a list of formulas is the modification
--- that applies the first formula in the list first, then the second formula,
--- then the third and so on. We'd still like to compute a list of @(doNow,
--- doLater)@ pairs as in 'nowLater', only that the @doLater@ should again be a
--- list of formulas.
 nowLaterList :: [Ltl a] -> [([a], [a], [Ltl a])]
 nowLaterList =
   foldr
@@ -104,21 +104,46 @@ nowLaterList =
     nowLater LtlTruth = [([], [], LtlTruth)]
     nowLater LtlFalsity = [([], [], LtlFalsity)]
     nowLater (LtlAtom now) = [([now], [], LtlTruth)]
+    nowLater (LtlNext f) = [([], [], f)]
+    nowLater (LtlNot (LtlAtom now)) = [([], [now], LtlTruth)]
     nowLater (f1 `LtlOr` f2) = nowLater f1 ++ nowLater f2
     nowLater (f1 `LtlAnd` f2) = do
       (toApply1, toFail1, next1) <- nowLater f1
       (toApply2, toFail2, next2) <- nowLater f2
       return (toApply1 <> toApply2, toFail1 <> toFail2, next1 `LtlAnd` next2)
-    nowLater (LtlNext f) = [([], [], f)]
-    nowLater (LtlNot f) = do
-      (toApplys, toFails, next) <- nowLater f
-      [([], [toApply], LtlTruth) | toApply <- toApplys]
-        <> [([], [], LtlNot next)]
-        <> [([toFail], [], LtlTruth) | toFail <- toFails]
-    nowLater (a `LtlUntil` b) =
-      nowLater $ ltlSimpl $ b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
-    nowLater (a `LtlRelease` b) =
-      nowLater $ ltlSimpl $ b `LtlAnd` (a `LtlOr` LtlNext (a `LtlRelease` b))
+    nowLater _ = error "nowLater is always called after ltlSimpl which does not yield more cases."
+
+    -- Straightforward simplification procedure for LTL formulas. This function
+    -- knows how 'LtlTruth' and 'LtlFalsity' play with negation, conjunction and
+    -- disjunction and recursively applies this knowledge; it is used to keep
+    -- the formulas 'nowLater' generates from growing too wildly.
+    ltlSimpl :: Ltl a -> Ltl a
+    ltlSimpl (LtlAtom a) = LtlAtom a
+    ltlSimpl LtlTruth = LtlTruth
+    ltlSimpl LtlFalsity = LtlFalsity
+    ltlSimpl (LtlNext f) = LtlNext f
+    ltlSimpl (LtlRelease f1 f2) = ltlSimpl $ f2 `LtlAnd` (f1 `LtlOr` LtlNext (f1 `LtlRelease` f2))
+    ltlSimpl (LtlUntil f1 f2) = ltlSimpl $ f2 `LtlOr` (f1 `LtlAnd` LtlNext (f1 `LtlUntil` f2))
+    ltlSimpl (LtlNot (ltlSimpl -> LtlTruth)) = LtlFalsity
+    ltlSimpl (LtlNot (ltlSimpl -> LtlFalsity)) = LtlTruth
+    ltlSimpl (LtlNot (ltlSimpl -> LtlNot f)) = f
+    ltlSimpl (LtlNot (ltlSimpl -> LtlAnd f1 f2)) = ltlSimpl $ LtlNot f1 `LtlOr` LtlNot f2
+    ltlSimpl (LtlNot (ltlSimpl -> LtlOr f1 f2)) = ltlSimpl $ LtlNot f1 `LtlAnd` LtlNot f2
+    ltlSimpl (LtlNot (ltlSimpl -> LtlNext f)) = LtlNext (LtlNot f)
+    -- The following will never occur, as `ltlSimpl` never returns something of
+    -- the shape `LtlUntil` or `LtlRelease`
+    ltlSimpl (LtlNot (ltlSimpl -> f)) = LtlNot f
+    ltlSimpl (LtlAnd (ltlSimpl -> LtlFalsity) _) = LtlFalsity
+    ltlSimpl (LtlAnd _ (ltlSimpl -> LtlFalsity)) = LtlFalsity
+    ltlSimpl (LtlAnd (ltlSimpl -> LtlTruth) (ltlSimpl -> f2)) = f2
+    ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> LtlTruth)) = f1
+    ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlAnd f1 f2
+    ltlSimpl (LtlOr (ltlSimpl -> LtlFalsity) (ltlSimpl -> f2)) = f2
+    ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> LtlFalsity)) = f1
+    -- We don't perform any reduction when `LtlOr` is applied to `LtlTruth` as
+    -- we still need to keep both branches, and certainly don't want to discard
+    -- the branch were potential meaningful modifications need to be applied.
+    ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlOr f1 f2
 
 -- | If there are no more steps and the next step should satisfy the given
 -- formula: Are we finished, i.e. was the initial formula satisfied by now?
@@ -133,33 +158,6 @@ finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
 finished (LtlNot f) = not $ finished f
 
--- | Straightforward simplification procedure for LTL formulas. This function
--- knows how 'LtlTruth' and 'LtlFalsity' play with negation, conjunction and
--- disjunction and recursively applies this knowledge; it does not do anything
--- "fancy" like computing a normal form and is only used to keep the formulas
--- 'nowLater' generates from growing too wildly.
-ltlSimpl :: Ltl a -> Ltl a
-ltlSimpl (LtlAtom a) = LtlAtom a
-ltlSimpl LtlTruth = LtlTruth
-ltlSimpl LtlFalsity = LtlFalsity
-ltlSimpl (LtlNext f) = LtlNext f
-ltlSimpl (LtlRelease f1 f2) = ltlSimpl $ f2 `LtlAnd` (f1 `LtlOr` LtlNext (f1 `LtlRelease` f2))
-ltlSimpl (LtlUntil f1 f2) = ltlSimpl $ f2 `LtlOr` (f1 `LtlAnd` LtlNext (f1 `LtlUntil` f2))
-ltlSimpl (LtlNot (ltlSimpl -> LtlTruth)) = LtlFalsity
-ltlSimpl (LtlNot (ltlSimpl -> LtlFalsity)) = LtlTruth
-ltlSimpl (LtlNot (ltlSimpl -> LtlNot f)) = f
-ltlSimpl (LtlNot (ltlSimpl -> LtlAnd f1 f2)) = ltlSimpl $ LtlNot f1 `LtlOr` LtlNot f2
-ltlSimpl (LtlNot (ltlSimpl -> LtlOr f1 f2)) = ltlSimpl $ LtlNot f1 `LtlAnd` LtlNot f2
-ltlSimpl (LtlNot (ltlSimpl -> f)) = LtlNot f
-ltlSimpl (LtlAnd (ltlSimpl -> LtlFalsity) _) = LtlFalsity
-ltlSimpl (LtlAnd _ (ltlSimpl -> LtlFalsity)) = LtlFalsity
-ltlSimpl (LtlAnd (ltlSimpl -> LtlTruth) (ltlSimpl -> f2)) = f2
-ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> LtlTruth)) = f1
-ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlAnd f1 f2
-ltlSimpl (LtlOr (ltlSimpl -> LtlFalsity) (ltlSimpl -> f2)) = f2
-ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> LtlFalsity)) = f1
-ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlOr f1 f2
-
 -- * An AST for "reified computations"
 
 -- | The idea is that a value of type @Staged (LtlOp modification builtin) a@

From e6b5cd517101980df11ea1093d3db53731f4c5d6 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sat, 3 Jan 2026 13:33:38 +0100
Subject: [PATCH 05/96] perfecting the new ltl

---
 cooked-validators.cabal             |   1 +
 src/Cooked/Attack/DatumHijacking.hs |  21 ++--
 src/Cooked/Ltl.hs                   | 153 +++++++++++-----------------
 src/Cooked/Ltl/Combinators.hs       |  26 +++--
 src/Cooked/MockChain/Staged.hs      |  61 +++++++----
 src/Cooked/MockChain/Testing.hs     |   2 +-
 src/Cooked/Skeleton/Label.hs        |   4 +-
 src/Cooked/Tweak/Common.hs          |  16 ++-
 src/Cooked/Tweak/Labels.hs          |  35 ++-----
 tests/Spec/Ltl.hs                   |  38 +++++--
 tests/Spec/Tweak.hs                 |   4 +-
 tests/Spec/Tweak/Labels.hs          |  88 ++++++++++++++++
 12 files changed, 277 insertions(+), 172 deletions(-)
 create mode 100644 tests/Spec/Tweak/Labels.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index a4f405713..d7fc83de3 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -184,6 +184,7 @@ test-suite spec
       Spec.Slot
       Spec.Tweak
       Spec.Tweak.Common
+      Spec.Tweak.Labels
       Spec.Tweak.OutPermutations
       Spec.Tweak.TamperDatum
       Spec.Tweak.ValidityRange
diff --git a/src/Cooked/Attack/DatumHijacking.hs b/src/Cooked/Attack/DatumHijacking.hs
index d5f5545a9..a9fd9016f 100644
--- a/src/Cooked/Attack/DatumHijacking.hs
+++ b/src/Cooked/Attack/DatumHijacking.hs
@@ -87,16 +87,18 @@ datumOfDatumHijackingParams = defaultDatumHijackingParams (txSkelOutDatumL % txS
 
 -- | Redirects, in the same transaction, all the outputs targetted by an output
 -- and an index predicates. See 'DatumHijackingParams' for more information on
--- those predicates. Returns a pair of the old outputs before they were
--- redirected, and the new updated list of outputs.
+-- those predicates. Returns the list of outputs that were successfully
+-- modified, before the modification is applied.
 redirectOutputTweakAll ::
   (MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
   (TxSkelOut -> Maybe owner) ->
   (Integer -> Bool) ->
-  m ([TxSkelOut], [TxSkelOut])
+  m [TxSkelOut]
 redirectOutputTweakAll outputPred indexPred = do
   outputs <- viewTweak txSkelOutsL
-  return $ go outputs 0
+  let (redirected, newOutputs) = go outputs 0
+  setTweak txSkelOutsL newOutputs
+  return redirected
   where
     go [] _ = ([], [])
     go (out : l) n =
@@ -112,8 +114,12 @@ redirectOutputTweakAny ::
   (MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
   (TxSkelOut -> Maybe owner) ->
   (Integer -> Bool) ->
-  m ([TxSkelOut], [TxSkelOut])
-redirectOutputTweakAny outputPred indexPred = viewTweak txSkelOutsL >>= go [] 0
+  m [TxSkelOut]
+redirectOutputTweakAny outputPred indexPred = do
+  outputs <- viewTweak txSkelOutsL
+  (redirected, newOutputs) <- go [] 0 outputs
+  setTweak txSkelOutsL newOutputs
+  return redirected
   where
     go _ _ [] = mzero
     go l' n (out : l)
@@ -138,8 +144,7 @@ redirectOutputTweakAny outputPred indexPred = viewTweak txSkelOutsL >>= go [] 0
 -- such outputs have been redirected.
 datumHijackingAttack :: (MonadTweak m) => DatumHijackingParams -> m [TxSkelOut]
 datumHijackingAttack (DatumHijackingParams outputPred indexPred mode) = do
-  (redirected, newOutputs) <- (if mode then redirectOutputTweakAll else redirectOutputTweakAny) outputPred indexPred
+  redirected <- (if mode then redirectOutputTweakAll else redirectOutputTweakAny) outputPred indexPred
   guard $ not $ null redirected
-  setTweak txSkelOutsL newOutputs
   addLabelTweak $ DatumHijackingLabel redirected
   return redirected
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index ed9658431..4ae6b2fd9 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -10,7 +10,6 @@ module Cooked.Ltl
     LtlOp (..),
     Staged (..),
     interpLtl,
-    interpLtlAndPruneUnfinished,
     InterpLtl (..),
     MonadModal (..),
   )
@@ -42,7 +41,9 @@ data Ltl a
   | -- | Conjunction will be interpreted as "apply both modifications".
     -- Attention: The "apply both" operation will be user-defined for atomic
     -- modifications, so that conjunction may for example fail to be commutative
-    -- if the operation on atomic modification is not commutative.
+    -- if the operation on atomic modification is not commutative. In
+    -- particular, this is the case for tweaks, where the second modification
+    -- will be applied first, to be consistent with nested modifications.
     LtlAnd (Ltl a) (Ltl a)
   | -- | Assert that the given formula holds at the next time step.
     LtlNext (Ltl a)
@@ -72,45 +73,47 @@ data Ltl a
   deriving (Show, Eq, Functor)
 
 -- | For each LTL formula that describes a modification of a computation in a
--- list, split it into a list of @(doNow, mustFailNow, doLater)@ triplets, and
--- then appropriately combine the results. The result of the splitting is bound
--- to the following semantics:
+-- list, split it into a list of @(doNow, doLater)@ pairs, and then
+-- appropriately combine the results. The result of the splitting is bound to
+-- the following semantics:
 --
--- * @doNow@ is the list of modifications to be consecutively applied to the
--- * current time step,
---
--- * @mustFailNow@ is the list of modifications that each must fail when applied
--- * to the current time step, and
+-- * @doNow@ is the list of modifications to be consecutively either applied to
+-- the current time step (@Left@), or that should fail at the current time step
+-- (@Right@)
 --
 -- * @doLater@ is an LTL formula describing the modification that should be
---   applied from the next time step onwards.
+-- applied from the next time step onwards.
 --
 -- The return value is a list because a formula might be satisfied in different
 -- ways. For example, the modification described by @a `LtlUntil` b@ might be
 -- accomplished by applying the modification @b@ right now, or by applying @a@
 -- right now and @a `LtlUntil` b@ from the next step onwards; the returned list
 -- will contain these two options.
-nowLaterList :: [Ltl a] -> [([a], [a], [Ltl a])]
+nowLaterList :: [Ltl a] -> [([Either a a], [Ltl a])]
 nowLaterList =
   foldr
     ( \el acc -> do
-        (toApply, toFail, next) <- nowLater $ ltlSimpl el
-        (toApply', toFail', nexts) <- acc
-        return (toApply <> toApply', toFail <> toFail', next : nexts)
+        (now, next) <- nowLater $ ltlSimpl el
+        (now', nexts) <- acc
+        return (now <> now', next : nexts)
     )
-    [([], [], [])]
+    [([], [])]
   where
-    nowLater :: Ltl a -> [([a], [a], Ltl a)]
-    nowLater LtlTruth = [([], [], LtlTruth)]
-    nowLater LtlFalsity = [([], [], LtlFalsity)]
-    nowLater (LtlAtom now) = [([now], [], LtlTruth)]
-    nowLater (LtlNext f) = [([], [], f)]
-    nowLater (LtlNot (LtlAtom now)) = [([], [now], LtlTruth)]
+    nowLater :: Ltl a -> [([Either a a], Ltl a)]
+    nowLater LtlTruth = [([], LtlTruth)]
+    nowLater LtlFalsity = [([], LtlFalsity)]
+    nowLater (LtlAtom now) = [([Left now], LtlTruth)]
+    nowLater (LtlNext f) = [([], f)]
+    nowLater (LtlNot (LtlAtom now)) = [([Right now], LtlTruth)]
     nowLater (f1 `LtlOr` f2) = nowLater f1 ++ nowLater f2
     nowLater (f1 `LtlAnd` f2) = do
-      (toApply1, toFail1, next1) <- nowLater f1
-      (toApply2, toFail2, next2) <- nowLater f2
-      return (toApply1 <> toApply2, toFail1 <> toFail2, next1 `LtlAnd` next2)
+      (now1, next1) <- nowLater f1
+      (now2, next2) <- nowLater f2
+      return (now2 <> now1, next2 `LtlAnd` next1)
+    -- Only the above cases are possible, which are the possible outcomes of
+    -- @ltlSimpl@. This is handy, as the remaining cases would lead to
+    -- complicated interactions and hard to handle growth in the number of
+    -- formulas.
     nowLater _ = error "nowLater is always called after ltlSimpl which does not yield more cases."
 
     -- Straightforward simplification procedure for LTL formulas. This function
@@ -149,7 +152,7 @@ nowLaterList =
 -- formula: Are we finished, i.e. was the initial formula satisfied by now?
 finished :: Ltl a -> Bool
 finished LtlTruth = True
-finished LtlFalsity = False --  we want falsity to fail always, even on the empty computation
+finished LtlFalsity = False
 finished (LtlAtom _) = False
 finished (LtlAnd f1 f2) = finished f1 && finished f2
 finished (LtlOr f1 f2) = finished f1 || finished f2
@@ -158,27 +161,7 @@ finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
 finished (LtlNot f) = not $ finished f
 
--- * An AST for "reified computations"
-
--- | The idea is that a value of type @Staged (LtlOp modification builtin) a@
--- describes a set of (monadic) computations that return an @a@ such that
---
--- * every step of the computations that returns a @b@ is reified as a @builtin
---   b@, and
---
--- * every step can be modified by a @modification@.
-
--- | Operations for computations that can be modified using LTL formulas.
-data LtlOp (modification :: Type) (builtin :: Type -> Type) :: Type -> Type where
-  -- | The operation that introduces a new LTL formula that should be used to
-  -- modify the following computations. Think of this operation as coming
-  -- between time steps and adding a new formula to be applied before all of the
-  -- formulas that should already be applied to the next time step.
-  StartLtl :: Ltl modification -> LtlOp modification builtin ()
-  -- | The operation that removes the last LTL formula that was introduced. If
-  -- the formula is not yet finished, the current time line will fail.
-  StopLtl :: LtlOp modification builtin ()
-  Builtin :: builtin a -> LtlOp modification builtin a
+-- * Freer monad to represent an AST on a set of operations
 
 -- | The freer monad on @op@. We think of this as the AST of a computation with
 -- operations of types @op a@.
@@ -198,6 +181,24 @@ instance Monad (Staged op) where
   (Return x) >>= f = f x
   (Instr i m) >>= f = Instr i (m >=> f)
 
+-- * An AST for "reified computations"
+
+-- | The idea is that a value of type @Staged (LtlOp modification builtin) a@
+-- describes a set of (monadic) computations that return an @a@ such that
+--
+-- * every step of the computations that returns a @b@ is reified as a @builtin
+--   b@, and
+--
+-- * every step can be modified by a @modification@.
+
+-- | Operations for computations that can be modified using LTL formulas.
+data LtlOp (modification :: Type) (builtin :: Type -> Type) :: Type -> Type where
+  -- | The operation consisting of the reification of a builtin
+  Builtin :: builtin a -> LtlOp modification builtin a
+  -- | The operation consisting of wrapping a computation with a Ltl
+  -- formula that should be applied on the computation.
+  WrapLtl :: Ltl modification -> Staged (LtlOp modification builtin) a -> LtlOp modification builtin a
+
 -- * Interpreting the AST
 
 -- | To be a suitable semantic domain for computations modified by LTL formulas,
@@ -211,18 +212,7 @@ instance Monad (Staged op) where
 --
 -- This type class only requires from the user to specify how to interpret the
 -- (modified) builtins. In order to do so, it passes around the formulas that
--- are to be applied to the next time step in a @StateT@. A common idiom to
--- modify an operation should be this:
---
--- > interpBuiltin op =
--- >  get
--- >    >>= msum
--- >      . map (\(now, later) -> applyModification now op <* put later)
--- >      . nowLaterList
---
--- (But to write this, @modification@ has to be a 'Monoid' to make
--- 'nowLaterList' work!) Look at the tests for this module and at
--- "Cooked.MockChain.Monad.Staged" for examples of how to use this type class.
+-- are to be applied to the next time step in a @StateT@
 class (MonadPlus m) => InterpLtl modification builtin m where
   interpBuiltin :: builtin a -> StateT [Ltl modification] m a
 
@@ -233,41 +223,18 @@ interpLtl ::
   Staged (LtlOp modification builtin) a ->
   StateT [Ltl modification] m a
 interpLtl (Return res) = return res
-interpLtl (Instr (StartLtl formula) computation) = do
-  modify' (formula :)
-  interpLtl $ computation ()
-interpLtl (Instr StopLtl f) =
-  get >>= \case
-    formula : formulas -> do
-      guard $ finished formula
-      put formulas
-      interpLtl $ f ()
-    [] -> error "You called 'StopLtl' before 'StartLtl'. This is only possible if you're using internals."
 interpLtl (Instr (Builtin b) f) = interpBuiltin b >>= interpLtl . f
-
--- | Interpret a 'Staged' computation into a suitable domain, using the function
--- 'interpBuiltin' to interpret the builtins. At the end of the computation,
--- prune branches that still have unfinished modifications applied to them.  See
--- the discussion on the regression test case for PRs 110 and 131 in
--- 'StagedSpec.hs' for a discussion on why this function has to exist.
-interpLtlAndPruneUnfinished ::
-  (InterpLtl modification builtin m) =>
-  Staged (LtlOp modification builtin) a ->
-  StateT [Ltl modification] m a
-interpLtlAndPruneUnfinished computation = do
-  res <- interpLtl computation
-  mods <- get
-  guard $ all finished mods
-  return res
+interpLtl (Instr (WrapLtl formula comp) nextComp) = do
+  modify' (formula :)
+  res <- interpLtl comp
+  formulas <- get
+  unless (null formulas) $ do
+    guard $ finished $ head formulas
+    put $ tail formulas
+  interpLtl $ nextComp res
 
 -- * Convenience functions
 
--- Users of this module should never use 'StartLtl' and 'StopLtl' explicitly.
--- Here are some safe-to-use functions that should be used instead. Most
--- functions like the ones below should be defined for the class 'MonadModal'
--- because there might be other possibilities to equip a monad with LTL
--- modifications beside the method above.
-
 -- | Monads that allow modifications with LTL formulas.
 class (Monad m) => MonadModal m where
   type Modification m :: Type
@@ -275,8 +242,4 @@ class (Monad m) => MonadModal m where
 
 instance MonadModal (Staged (LtlOp modification builtin)) where
   type Modification (Staged (LtlOp modification builtin)) = modification
-  modifyLtl formula trace = do
-    Instr (StartLtl formula) Return
-    res <- trace
-    Instr StopLtl Return
-    return res
+  modifyLtl formula trace = Instr (WrapLtl formula trace) Return
diff --git a/src/Cooked/Ltl/Combinators.hs b/src/Cooked/Ltl/Combinators.hs
index 201187a8f..8c99e8722 100644
--- a/src/Cooked/Ltl/Combinators.hs
+++ b/src/Cooked/Ltl/Combinators.hs
@@ -10,12 +10,14 @@ module Cooked.Ltl.Combinators
     eventually',
     always,
     always',
-    wheneverPossible',
-    wheneverPossible,
+    whenPossible',
+    whenPossible,
     ifPossible',
     ifPossible,
     ltlImplies',
     ltlImplies,
+    never',
+    never,
   )
 where
 
@@ -82,19 +84,27 @@ ifPossible' :: Ltl a -> Ltl a
 ifPossible' f = f `LtlOr` LtlNot f
 
 -- | Same as `wheneverPossible'`, but first wraps the input in an atomic formula
-wheneverPossible :: a -> Ltl a
-wheneverPossible = wheneverPossible' . LtlAtom
+whenPossible :: a -> Ltl a
+whenPossible = whenPossible' . LtlAtom
 
 -- | Produces an Ltl formula which attempts to apply a certain formula whenever
 -- possible, while ignoring steps when it is not.
-wheneverPossible' :: Ltl a -> Ltl a
-wheneverPossible' = always' . ifPossible'
+whenPossible' :: Ltl a -> Ltl a
+whenPossible' = always' . ifPossible'
+
+-- | Same as `never'`, but first wraps the input in an atomic formula
+never :: a -> Ltl a
+never = never' . LtlAtom
+
+-- | Produces an Ltl formula ensuring the given formula always fails
+never' :: Ltl a -> Ltl a
+never' = always' . LtlNot
 
 -- | Same as `ltlImplies'` but first wraps the inputs in atoms
 ltlImplies :: a -> a -> Ltl a
-ltlImplies a1 a2 = ltlImplies' (LtlAtom a1) (LtlAtom a2)
+ltlImplies a1 a2 = LtlAtom a1 `ltlImplies'` LtlAtom a2
 
 -- | Produces a formula that succeeds if the first formula fails, or if both
 -- formulas hold
 ltlImplies' :: Ltl a -> Ltl a -> Ltl a
-ltlImplies' f1 f2 = (f1 `LtlAnd` f2) `LtlOr` LtlNot f1
+ltlImplies' f1 f2 = (f2 `LtlAnd` f1) `LtlOr` LtlNot f1
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 77b83bdf9..040f1c9a6 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -19,24 +19,29 @@ module Cooked.MockChain.Staged
     withTweak,
     there,
     there',
+    nowhere',
+    nowhere,
+    whenAble',
+    whenAble,
   )
 where
 
 import Cardano.Node.Emulator qualified as Emulator
 import Control.Applicative
-import Control.Monad (MonadPlus (..), guard, msum)
+import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.State
 import Cooked.InitialDistribution
 import Cooked.Ltl
-import Cooked.Ltl.Combinators (always', delay', eventually')
+import Cooked.Ltl.Combinators
 import Cooked.MockChain.BlockChain
 import Cooked.MockChain.Direct
 import Cooked.Pretty.Hashable
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Data.Default
+import Data.Functor
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
 import Plutus.Script.Utils.Address qualified as Script
@@ -47,11 +52,8 @@ import PlutusLedgerApi.V3 qualified as Api
 -- | Interprets the staged mockchain then runs the resulting computation with a
 -- custom function. This can be used, for example, to supply a custom
 -- 'InitialDistribution' by providing 'runMockChainTFromInitDist'.
-interpretAndRunWith ::
-  (forall m. (Monad m) => MockChainT m a -> m res) ->
-  StagedMockChain a ->
-  [res]
-interpretAndRunWith f smc = f $ interpret smc
+interpretAndRunWith :: (forall m. (Monad m) => MockChainT m a -> m res) -> StagedMockChain a -> [res]
+interpretAndRunWith f = f . interpret
 
 -- | Same as 'interpretAndRunWith' but using 'runMockChainT' as the default way
 -- to run the computation.
@@ -65,7 +67,7 @@ type InterpMockChain = MockChainT []
 -- 'StagedMockChain' computation yields a potential list of 'MockChainT'
 -- computations.
 interpret :: StagedMockChain a -> InterpMockChain a
-interpret = flip evalStateT [] . interpLtlAndPruneUnfinished
+interpret = flip evalStateT [] . interpLtl
 
 -- * 'StagedMockChain': An AST for 'MonadMockChain' computations
 
@@ -117,16 +119,19 @@ instance (MonadPlus m) => MonadPlus (MockChainT m) where
 instance InterpLtl (UntypedTweak InterpMockChain) MockChainBuiltin InterpMockChain where
   interpBuiltin GetParams = getParams
   interpBuiltin (SetParams params) = setParams params
-  interpBuiltin (ValidateTxSkel skel) =
-    get >>= msum . map interpretNow . nowLaterList
-    where
-      interpretNow ::
-        ([UntypedTweak InterpMockChain], [UntypedTweak InterpMockChain], [Ltl (UntypedTweak InterpMockChain)]) ->
-        StateT [Ltl (UntypedTweak InterpMockChain)] InterpMockChain Ledger.CardanoTx
-      interpretNow (now, notNow, later) = do
-        mcst <- lift get
-        guard $ all (\(UntypedTweak tweak) -> null $ runMockChainTFromConf (mockChainStateConf mcst) $ runTweakInChain tweak skel) notNow
-        (_, skel') <- lift $ runTweakInChain (foldl (\acc (UntypedTweak tweak) -> tweak >> acc) (return ()) now) skel
+  interpBuiltin (ValidateTxSkel skel) = do
+    modifications <- gets nowLaterList
+    msum . (modifications <&>) $
+      \(now, later) -> do
+        (_, skel') <-
+          lift . (`runTweakInChain` skel) $
+            foldr
+              ( flip $ \acc -> \case
+                  Left (UntypedTweak tweak) -> tweak >> acc
+                  Right (UntypedTweak tweak) -> ensureFailingTweak tweak >> acc
+              )
+              doNothingTweak
+              now
         put later
         validateTxSkel skel'
   interpBuiltin (TxSkelOutByRef o) = txSkelOutByRef o
@@ -158,7 +163,7 @@ runTweakFrom initDist tweak = runMockChainTFromInitDist initDist . runTweakInCha
 
 -- ** Modalities
 
--- | A modal mock chain is a mock chain that allows us to use LTL modifications
+-- | A modal mockchain is a mockchain that allows us to use LTL modifications
 -- with 'Tweak's
 type MonadModalBlockChain m = (MonadBlockChain m, MonadModal m, Modification m ~ UntypedTweak InterpMockChain)
 
@@ -186,6 +191,24 @@ everywhere = everywhere' . fromTweak
 everywhere' :: (MonadModal m) => Ltl (Modification m) -> m a -> m a
 everywhere' = modifyLtl . always'
 
+-- | Ensures a given 'Tweak' can never successfully be applied in a computation
+nowhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
+nowhere = nowhere' . fromTweak
+
+-- | Ensures a given Ltl modification can never be applied on a computation
+nowhere' :: (MonadModal m) => Ltl (Modification m) -> m a -> m a
+nowhere' = modifyLtl . never'
+
+-- | Apply a given 'Tweak' at every location in a computation where it does not
+-- fail, which might never occur.
+whenAble :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
+whenAble = whenAble' . fromTweak
+
+-- | Apply an Ltl modification at every location in a computation where it is
+-- possible. Does not fail if no such position exists.
+whenAble' :: (MonadModal m) => Ltl (Modification m) -> m a -> m a
+whenAble' = modifyLtl . whenPossible'
+
 -- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
 -- trace. Successful when this transaction exists and can be modified.
 there :: (MonadModalBlockChain m) => Integer -> Tweak InterpMockChain b -> m a -> m a
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index db6399cd4..2df19d739 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -242,7 +242,7 @@ mustSucceedTest trace =
   Test
     { testTrace = trace,
       testInitDist = def,
-      testSizeProp = const testSuccess,
+      testSizeProp = isAtLeastOfSize 1,
       testFailureProp = \_ _ _ _ -> testFailureMsg "💀 Unexpected failure!",
       testSuccessProp = \_ _ _ _ -> testSuccess,
       testPrettyOpts = def
diff --git a/src/Cooked/Skeleton/Label.hs b/src/Cooked/Skeleton/Label.hs
index fc373a3bf..298b7f1c2 100644
--- a/src/Cooked/Skeleton/Label.hs
+++ b/src/Cooked/Skeleton/Label.hs
@@ -15,7 +15,7 @@ where
 
 import Cooked.Pretty.Class
 import Data.String (IsString (..))
-import Data.Text (pack)
+import Data.Text (Text, pack)
 import Data.Typeable (cast)
 import Optics.Core
 import Type.Reflection
@@ -34,7 +34,7 @@ data TxSkelLabel where
   TxSkelLabel :: (LabelConstrs x) => x -> TxSkelLabel
 
 -- | Helper for defining 'TxSkelLabel' values.
-label :: (LabelConstrs x) => x -> TxSkelLabel
+label :: Text -> TxSkelLabel
 label = TxSkelLabel
 
 instance Eq TxSkelLabel where
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index d2d15216e..42425096b 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -20,6 +20,7 @@ module Cooked.Tweak.Common
     selectP,
     combineModsTweak,
     iviewTweak,
+    ensureFailingTweak,
   )
 where
 
@@ -77,7 +78,7 @@ instance (MonadBlockChainWithoutValidation m) => MonadTweak (Tweak m) where
 -- 'Cooked.MockChain.Staged.somewhere', or 'Cooked.MockChain.Staged.everywhere',
 -- you should never have a reason to use this function.
 runTweakInChain :: (MonadPlus m) => Tweak m a -> TxSkel -> m (a, TxSkel)
-runTweakInChain tweak skel = ListT.alternate $ runStateT tweak skel
+runTweakInChain tweak = ListT.alternate . runStateT tweak
 
 -- | Like 'runTweakInChain', but for when you want to explicitly apply a tweak
 -- to a transaction skeleton and get all results as a list.
@@ -86,13 +87,13 @@ runTweakInChain tweak skel = ListT.alternate $ runStateT tweak skel
 -- modified, consider using 'Cooked.MockChain.Staged.MonadModalBlockChain' and
 -- idioms like 'Cooked.MockChain.Staged.withTweak',
 -- 'Cooked.MockChain.Staged.somewhere', or 'Cooked.MockChain.Staged.everywhere'.
-runTweakInChain' :: (MonadBlockChainWithoutValidation m) => Tweak m a -> TxSkel -> m [(a, TxSkel)]
-runTweakInChain' tweak skel = ListT.toList $ runStateT tweak skel
+runTweakInChain' :: (MonadPlus m) => Tweak m a -> TxSkel -> m [(a, TxSkel)]
+runTweakInChain' tweak = ListT.toList . runStateT tweak
 
 -- | This is a wrapper type used in the implementation of the Staged monad. You
 -- will probably never use it while you're building 'Tweak's.
 data UntypedTweak m where
-  UntypedTweak :: {getTypedTweak :: Tweak m a} -> UntypedTweak m
+  UntypedTweak :: Tweak m a -> UntypedTweak m
 
 -- * A few fundamental tweaks
 
@@ -104,6 +105,13 @@ failingTweak = mzero
 doNothingTweak :: (MonadTweak m) => m ()
 doNothingTweak = return ()
 
+-- | The 'Tweak' that ensures a given tweak fails
+ensureFailingTweak :: (MonadPlus m) => Tweak m a -> Tweak m ()
+ensureFailingTweak comp = do
+  skel <- get
+  res <- lift $ lift $ runTweakInChain' comp skel
+  guard $ null res
+
 -- * Constructing Tweaks from Optics
 
 -- | Retrieves some value from the 'TxSkel'
diff --git a/src/Cooked/Tweak/Labels.hs b/src/Cooked/Tweak/Labels.hs
index a9c31ebf5..91d8816f2 100644
--- a/src/Cooked/Tweak/Labels.hs
+++ b/src/Cooked/Tweak/Labels.hs
@@ -1,13 +1,11 @@
 -- | This module provides tweaks operating on transaction labels
 module Cooked.Tweak.Labels
   ( labelled,
-    labelled',
     addLabelTweak,
     removeLabelTweak,
     hasLabelTweak,
     ensureLabelTweak,
-    labelledT,
-    labelledT',
+    labelled',
   )
 where
 
@@ -19,26 +17,25 @@ import Data.Set qualified as Set
 import Data.Text (Text)
 
 -- | Adds a label to a 'TxSkel'.
-addLabelTweak :: (MonadTweak m, LabelConstrs x) => x -> m ()
+addLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m ()
 addLabelTweak = overTweak txSkelLabelL . Set.insert . TxSkelLabel
 
 -- | Checks if a given label is present in the 'TxSkel'
-hasLabelTweak :: (MonadTweak m, LabelConstrs x) => x -> m Bool
+hasLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m Bool
 hasLabelTweak = (viewTweak txSkelLabelL <&>) . Set.member . TxSkelLabel
 
 -- | Ensures a given label is present in the 'TxSkel'
-ensureLabelTweak :: (MonadTweak m, LabelConstrs x) => x -> m ()
+ensureLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m ()
 ensureLabelTweak = hasLabelTweak >=> guard
 
 -- | Removes a label from a 'TxSkel' when possible, fails otherwise
-removeLabelTweak :: (MonadTweak m, LabelConstrs x) => x -> m ()
+removeLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m ()
 removeLabelTweak lbl = do
   ensureLabelTweak lbl
   overTweak txSkelLabelL . Set.delete $ TxSkelLabel lbl
 
 -- | Apply a tweak to a given transaction if it has a specific label. Fails if
--- it does not.This can be useful to apply a tweak to any transaction in a trace
--- using 'Cooked.MockChain.Staged.somewhere'.
+-- it does not.
 --
 -- >
 -- > someEndpoint = do
@@ -52,16 +49,10 @@ removeLabelTweak lbl = do
 -- >
 -- > someTest = someEndpoint & eveywhere (labelled SomeLabelType someTweak)
 -- > anotherTest = someEndpoint & somewhere (labelled SomeLabelType someTweak)
-labelled :: (MonadTweak m, LabelConstrs lbl) => lbl -> m a -> m a
+labelled :: (LabelConstrs lbl, MonadTweak m) => lbl -> m a -> m a
 labelled lbl = (ensureLabelTweak lbl >>)
 
--- | Similar to 'labelled', but does not fail when the label is not present,
--- thus making this tweak suitable to be used with
--- 'Cooked.MockChain.Staged.everywhere'
-labelled' :: (MonadTweak m, LabelConstrs lbl) => lbl -> m a -> m ()
-labelled' lbl tweak = hasLabelTweak lbl >>= (`when` void tweak)
-
--- | `labelled'` specialised to Text labels
+-- | `labelled` specialised to Text labels
 --
 -- >
 -- > someEndpoint = do
@@ -74,10 +65,6 @@ labelled' lbl tweak = hasLabelTweak lbl >>= (`when` void tweak)
 -- >         , label SomeLabelType]
 -- >      }
 -- >
--- > someTest = someEndpoint & somewhere (labelledT "Spending" doubleSatAttack)
-labelledT :: (MonadTweak m) => Text -> m a -> m a
-labelledT = labelled
-
--- | 'labelledT' specialised to Text labels
-labelledT' :: (MonadTweak m) => Text -> m a -> m ()
-labelledT' = labelled'
+-- > someTest = someEndpoint & somewhere (labelled' "Spending" doubleSatAttack)
+labelled' :: (MonadTweak m) => Text -> m a -> m a
+labelled' = labelled
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index 2f7a730e2..de2ee9178 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Spec.Ltl (tests) where
+module Spec.Ltl where
 
 import Control.Monad
 import Control.Monad.State
@@ -8,7 +8,7 @@ import Control.Monad.Writer
 import Cooked.Ltl
 import Cooked.Ltl.Combinators
 import Cooked.MockChain.Testing
-import Data.Maybe (isNothing)
+import Data.Maybe
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -33,10 +33,20 @@ instance (MonadPlus m) => InterpLtl TestModification TestBuiltin (WriterT [Integ
     gets nowLaterList
       >>= msum
         . map
-          ( \(now, notNow, later) -> do
-              guard $ all (isNothing . applyMod i) notNow
-              maybe mzero ((put later >>) . tell . (: [])) $
-                foldl (\acc el -> acc >>= (`applyMod` el)) (Just i) now
+          ( \(now, later) -> do
+              maybe mzero (tell . (: [])) $
+                foldl
+                  ( \acc el -> do
+                      current <- acc
+                      case el of
+                        Left modif -> applyMod current modif
+                        Right modif -> do
+                          guard $ isNothing $ applyMod current modif
+                          return current
+                  )
+                  (Just i)
+                  now
+              put later
           )
 
 emitInteger :: Integer -> Staged (LtlOp TestModification TestBuiltin) ()
@@ -173,7 +183,7 @@ tests =
                     [42 + 2, 3 + 1]
                   ],
           testCase "Modification order using 'LtlAnd' is respected (left to right)" $
-            assertSameSets (go $ modifyLtl (LtlAtom (Add 1) `LtlAnd` LtlAtom (Mul 4)) $ emitInteger 2) [[12]],
+            assertSameSets (go $ modifyLtl (LtlAtom (Add 1) `LtlAnd` LtlAtom (Mul 4)) $ emitInteger 2) [[2 * 4 + 1]],
           testCase "Modification order using modalities is respected (inner to outer)" $
             assertSameSets (go $ modifyLtl (LtlAtom (Add 1)) $ modifyLtl (LtlAtom (Mul 4)) $ emitInteger 2) [[9]],
           testCase "nested everywhere combines modifications" $
@@ -223,7 +233,7 @@ tests =
                 testCase "allOf" $
                   assertSameSets
                     (go $ modifyLtl (allOf [Add 5, Mul 5]) traceSolo)
-                    [[(24 + 5) * 5]],
+                    [[24 * 5 + 5]],
                 testCase "allOf [anyOf, anyOf]" $
                   assertSameSets
                     (go $ modifyLtl (allOf' [anyOf [Add 5, Mul 5], anyOf [Add 5, Mul 5]]) traceSolo)
@@ -262,9 +272,17 @@ tests =
                   assertSameSets
                     ( go $
                         modifyLtl
-                          (wheneverPossible (Add 5))
+                          (whenPossible (Add 5))
                           (traceDuo >> emitInteger 5 >> emitInteger 5 >> traceDuo >> emitInteger 5 >> traceDuo)
                     )
-                    [[24 + 5, 13 + 5, 5, 5, 24 + 5, 13 + 5, 5, 24 + 5, 13 + 5]]
+                    [[24 + 5, 13 + 5, 5, 5, 24 + 5, 13 + 5, 5, 24 + 5, 13 + 5]],
+                testCase "never succeeds when no step can be modified..." $
+                  assertSameSets
+                    (go $ modifyLtl (never (Add 5)) (replicateM 10 (emitInteger 5)))
+                    [replicate 10 5],
+                testCase "... and fails otherwise" $
+                  assertSameSets
+                    (go $ modifyLtl (never (Add 5)) $ modifyLtl (eventually (Add 1)) $ replicateM 10 (emitInteger 5))
+                    []
               ]
     ]
diff --git a/tests/Spec/Tweak.hs b/tests/Spec/Tweak.hs
index c9f03a255..619061266 100644
--- a/tests/Spec/Tweak.hs
+++ b/tests/Spec/Tweak.hs
@@ -1,6 +1,7 @@
 module Spec.Tweak (tests) where
 
 import Spec.Tweak.Common qualified as Common
+import Spec.Tweak.Labels qualified as Labels
 import Spec.Tweak.OutPermutations qualified as OutPermutations
 import Spec.Tweak.TamperDatum qualified as TamperDatum
 import Spec.Tweak.ValidityRange qualified as ValidityRange
@@ -13,5 +14,6 @@ tests =
     [ Common.tests,
       OutPermutations.tests,
       TamperDatum.tests,
-      ValidityRange.tests
+      ValidityRange.tests,
+      Labels.tests
     ]
diff --git a/tests/Spec/Tweak/Labels.hs b/tests/Spec/Tweak/Labels.hs
new file mode 100644
index 000000000..8c2190acd
--- /dev/null
+++ b/tests/Spec/Tweak/Labels.hs
@@ -0,0 +1,88 @@
+module Spec.Tweak.Labels where
+
+import Control.Monad
+import Cooked
+import Data.Set qualified as Set
+import Data.Text (Text)
+import Optics.Core
+import Plutus.Script.Utils.Value qualified as Script
+import PlutusLedgerApi.V1 qualified as Api
+import Test.Tasty
+
+alice, bob, carrie :: Wallet
+alice = wallet 1
+bob = wallet 2
+carrie = wallet 3
+
+payTo :: (MonadBlockChain m) => Wallet -> Integer -> m ()
+payTo target amount = do
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelOuts = [target `receives` Value (Script.ada amount)]
+      }
+
+payments :: (MonadBlockChain m) => m ()
+payments = do
+  payTo alice 10
+  payTo bob 5
+  payTo bob 8
+  payTo alice 25
+  payTo alice 32
+
+labelAmountTweak :: (MonadTweak m) => m ()
+labelAmountTweak = do
+  [target] <- viewAllTweak (txSkelOutsL % _head % txSkelOutValueL % valueLovelaceL)
+  addLabelTweak $ Api.getLovelace target
+
+labelNameTweak :: (MonadTweak m) => m ()
+labelNameTweak = do
+  target <-
+    viewAllTweak
+      ( txSkelOutsL
+          % _head
+          % txSkelOutOwnerL
+          % userEitherPubKeyP
+          % userTypedPubKeyAT @Wallet
+      )
+  case target of
+    [t] | t == alice -> addLabelTweak @Text "Alice"
+    [t] | t == bob -> addLabelTweak @Text "Bob"
+    _ -> mzero
+
+labelNames :: (MonadModalBlockChain m) => m ()
+labelNames = everywhere labelNameTweak payments
+
+tests :: TestTree
+tests =
+  testGroup
+    "Label Tweaks"
+    [ testCooked "Adding labels everywhere" $ mustSucceedTest $ everywhere labelNameTweak payments,
+      testCooked "Adding labels everywhere, but if fails somewhere" $
+        mustFailTest $
+          everywhere labelNameTweak $
+            there
+              0
+              (redirectOutputTweakAll (const (Just carrie)) (== 0))
+              payments,
+      testCooked "Adding labels whenever possible" $
+        mustSucceedTest $
+          whenAble labelNameTweak $
+            there
+              0
+              (redirectOutputTweakAll (const (Just carrie)) (== 0))
+              payments,
+      testCooked "Applying a modification to all transactions with a given exact label" $
+        mustSucceedTest $
+          whenAble (labelled' "Alice" labelAmountTweak) $
+            everywhere labelNameTweak payments,
+      testCooked "Apply a modification to all transactions with a given type of label"
+        $ mustSucceedTest
+        $ everywhere
+          ( do
+              txSkelLabels <- viewAllTweak $ txSkelLabelL % to Set.toList % traversed % txSkelLabelTypedP @Text
+              guard $ not $ null txSkelLabels
+              labelAmountTweak
+          )
+        $ everywhere labelNameTweak payments
+    ]

From b864fd1f59ab387a1c0aa5fb16ca2c7a00ac9968 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sat, 3 Jan 2026 13:51:01 +0100
Subject: [PATCH 06/96] final adjustements before diving into effects

---
 src/Cooked/Ltl.hs              | 27 +++++++++++++++++----------
 src/Cooked/MockChain/Staged.hs |  4 ++--
 tests/Spec/Ltl.hs              |  4 ++--
 3 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 4ae6b2fd9..dc78665d1 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -6,6 +6,7 @@
 -- be replaced later on with a dependency to https://github.com/tweag/graft.
 module Cooked.Ltl
   ( Ltl (..),
+    LtlModAction (..),
     nowLaterList,
     LtlOp (..),
     Staged (..),
@@ -72,14 +73,21 @@ data Ltl a
     LtlNot (Ltl a)
   deriving (Show, Eq, Functor)
 
+-- | How to handle a specific atomic modification
+data LtlModAction a
+  = -- | Apply the modification
+    Apply a
+  | -- | Ensure the modification fails
+    EnsureFailure a
+
 -- | For each LTL formula that describes a modification of a computation in a
 -- list, split it into a list of @(doNow, doLater)@ pairs, and then
 -- appropriately combine the results. The result of the splitting is bound to
 -- the following semantics:
 --
 -- * @doNow@ is the list of modifications to be consecutively either applied to
--- the current time step (@Left@), or that should fail at the current time step
--- (@Right@)
+-- the current time step (@Apply@), or that should fail at the current time step
+-- (@MustFailMod@)
 --
 -- * @doLater@ is an LTL formula describing the modification that should be
 -- applied from the next time step onwards.
@@ -89,7 +97,7 @@ data Ltl a
 -- accomplished by applying the modification @b@ right now, or by applying @a@
 -- right now and @a `LtlUntil` b@ from the next step onwards; the returned list
 -- will contain these two options.
-nowLaterList :: [Ltl a] -> [([Either a a], [Ltl a])]
+nowLaterList :: [Ltl a] -> [([LtlModAction a], [Ltl a])]
 nowLaterList =
   foldr
     ( \el acc -> do
@@ -99,21 +107,20 @@ nowLaterList =
     )
     [([], [])]
   where
-    nowLater :: Ltl a -> [([Either a a], Ltl a)]
+    nowLater :: Ltl a -> [([LtlModAction a], Ltl a)]
     nowLater LtlTruth = [([], LtlTruth)]
     nowLater LtlFalsity = [([], LtlFalsity)]
-    nowLater (LtlAtom now) = [([Left now], LtlTruth)]
+    nowLater (LtlAtom now) = [([Apply now], LtlTruth)]
     nowLater (LtlNext f) = [([], f)]
-    nowLater (LtlNot (LtlAtom now)) = [([Right now], LtlTruth)]
+    nowLater (LtlNot (LtlAtom now)) = [([EnsureFailure now], LtlTruth)]
     nowLater (f1 `LtlOr` f2) = nowLater f1 ++ nowLater f2
     nowLater (f1 `LtlAnd` f2) = do
       (now1, next1) <- nowLater f1
       (now2, next2) <- nowLater f2
       return (now2 <> now1, next2 `LtlAnd` next1)
-    -- Only the above cases are possible, which are the possible outcomes of
-    -- @ltlSimpl@. This is handy, as the remaining cases would lead to
-    -- complicated interactions and hard to handle growth in the number of
-    -- formulas.
+    -- Only the above cases can occur, as they are outcomes of @ltlSimpl@. This
+    -- is handy, as the remaining cases would lead to complicated interactions
+    -- and hard to handle growth in the number of formulas.
     nowLater _ = error "nowLater is always called after ltlSimpl which does not yield more cases."
 
     -- Straightforward simplification procedure for LTL formulas. This function
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 040f1c9a6..d05966063 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -127,8 +127,8 @@ instance InterpLtl (UntypedTweak InterpMockChain) MockChainBuiltin InterpMockCha
           lift . (`runTweakInChain` skel) $
             foldr
               ( flip $ \acc -> \case
-                  Left (UntypedTweak tweak) -> tweak >> acc
-                  Right (UntypedTweak tweak) -> ensureFailingTweak tweak >> acc
+                  Apply (UntypedTweak tweak) -> tweak >> acc
+                  EnsureFailure (UntypedTweak tweak) -> ensureFailingTweak tweak >> acc
               )
               doNothingTweak
               now
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index de2ee9178..5721a936e 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -39,8 +39,8 @@ instance (MonadPlus m) => InterpLtl TestModification TestBuiltin (WriterT [Integ
                   ( \acc el -> do
                       current <- acc
                       case el of
-                        Left modif -> applyMod current modif
-                        Right modif -> do
+                        Apply modif -> applyMod current modif
+                        EnsureFailure modif -> do
                           guard $ isNothing $ applyMod current modif
                           return current
                   )

From 0b29b87d8baed41aa1484667f9357811d46f7a1a Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sat, 3 Jan 2026 15:46:11 +0100
Subject: [PATCH 07/96] back to booleans

---
 src/Cooked/Ltl.hs              | 20 ++++++--------------
 src/Cooked/MockChain/Staged.hs |  5 +----
 tests/Spec/Ltl.hs              |  9 +++++----
 3 files changed, 12 insertions(+), 22 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index dc78665d1..8e0224f7b 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -6,7 +6,6 @@
 -- be replaced later on with a dependency to https://github.com/tweag/graft.
 module Cooked.Ltl
   ( Ltl (..),
-    LtlModAction (..),
     nowLaterList,
     LtlOp (..),
     Staged (..),
@@ -73,21 +72,14 @@ data Ltl a
     LtlNot (Ltl a)
   deriving (Show, Eq, Functor)
 
--- | How to handle a specific atomic modification
-data LtlModAction a
-  = -- | Apply the modification
-    Apply a
-  | -- | Ensure the modification fails
-    EnsureFailure a
-
 -- | For each LTL formula that describes a modification of a computation in a
 -- list, split it into a list of @(doNow, doLater)@ pairs, and then
 -- appropriately combine the results. The result of the splitting is bound to
 -- the following semantics:
 --
 -- * @doNow@ is the list of modifications to be consecutively either applied to
--- the current time step (@Apply@), or that should fail at the current time step
--- (@MustFailMod@)
+-- the current time step (@True@), or that should fail at the current time step
+-- (@False@)
 --
 -- * @doLater@ is an LTL formula describing the modification that should be
 -- applied from the next time step onwards.
@@ -97,7 +89,7 @@ data LtlModAction a
 -- accomplished by applying the modification @b@ right now, or by applying @a@
 -- right now and @a `LtlUntil` b@ from the next step onwards; the returned list
 -- will contain these two options.
-nowLaterList :: [Ltl a] -> [([LtlModAction a], [Ltl a])]
+nowLaterList :: [Ltl a] -> [([(a, Bool)], [Ltl a])]
 nowLaterList =
   foldr
     ( \el acc -> do
@@ -107,12 +99,12 @@ nowLaterList =
     )
     [([], [])]
   where
-    nowLater :: Ltl a -> [([LtlModAction a], Ltl a)]
+    nowLater :: Ltl a -> [([(a, Bool)], Ltl a)]
     nowLater LtlTruth = [([], LtlTruth)]
     nowLater LtlFalsity = [([], LtlFalsity)]
-    nowLater (LtlAtom now) = [([Apply now], LtlTruth)]
+    nowLater (LtlAtom now) = [([(now, True)], LtlTruth)]
     nowLater (LtlNext f) = [([], f)]
-    nowLater (LtlNot (LtlAtom now)) = [([EnsureFailure now], LtlTruth)]
+    nowLater (LtlNot (LtlAtom now)) = [([(now, False)], LtlTruth)]
     nowLater (f1 `LtlOr` f2) = nowLater f1 ++ nowLater f2
     nowLater (f1 `LtlAnd` f2) = do
       (now1, next1) <- nowLater f1
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index d05966063..d5b5f29f9 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -126,10 +126,7 @@ instance InterpLtl (UntypedTweak InterpMockChain) MockChainBuiltin InterpMockCha
         (_, skel') <-
           lift . (`runTweakInChain` skel) $
             foldr
-              ( flip $ \acc -> \case
-                  Apply (UntypedTweak tweak) -> tweak >> acc
-                  EnsureFailure (UntypedTweak tweak) -> ensureFailingTweak tweak >> acc
-              )
+              (\(UntypedTweak tweak, mode) acc -> if mode then tweak >> acc else ensureFailingTweak tweak >> acc)
               doNothingTweak
               now
         put later
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index 5721a936e..8fbb0675f 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -36,11 +36,12 @@ instance (MonadPlus m) => InterpLtl TestModification TestBuiltin (WriterT [Integ
           ( \(now, later) -> do
               maybe mzero (tell . (: [])) $
                 foldl
-                  ( \acc el -> do
+                  ( \acc (modif, el) -> do
                       current <- acc
-                      case el of
-                        Apply modif -> applyMod current modif
-                        EnsureFailure modif -> do
+                      if el
+                        then
+                          applyMod current modif
+                        else do
                           guard $ isNothing $ applyMod current modif
                           return current
                   )

From f2419a2082c55dc2525c30f55cca239faf9c73f5 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sun, 4 Jan 2026 15:08:23 +0100
Subject: [PATCH 08/96] all builtins at the same location

---
 src/Cooked/Ltl.hs              |  96 +---------------
 src/Cooked/Ltl/Combinators.hs  |   2 +-
 src/Cooked/MockChain/Direct.hs |   4 +
 src/Cooked/MockChain/Staged.hs | 201 ++++++++++++++++++++++-----------
 tests/Spec/Ltl.hs              |  79 +++++++------
 5 files changed, 188 insertions(+), 194 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 8e0224f7b..c94777069 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -7,18 +7,11 @@
 module Cooked.Ltl
   ( Ltl (..),
     nowLaterList,
-    LtlOp (..),
-    Staged (..),
-    interpLtl,
-    InterpLtl (..),
-    MonadModal (..),
+    finished,
+    MonadLtl (..),
   )
 where
 
-import Control.Monad
-import Control.Monad.State
-import Data.Kind
-
 -- * LTL formulas and operations on them
 
 -- | Type of LTL formulas with atomic formulas of type @a@. Think of @a@ as a
@@ -160,85 +153,6 @@ finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
 finished (LtlNot f) = not $ finished f
 
--- * Freer monad to represent an AST on a set of operations
-
--- | The freer monad on @op@. We think of this as the AST of a computation with
--- operations of types @op a@.
-data Staged (op :: Type -> Type) :: Type -> Type where
-  Return :: a -> Staged op a
-  Instr :: op a -> (a -> Staged op b) -> Staged op b
-
-instance Functor (Staged op) where
-  fmap f (Return x) = Return $ f x
-  fmap f (Instr op cont) = Instr op (fmap f . cont)
-
-instance Applicative (Staged op) where
-  pure = Return
-  (<*>) = ap
-
-instance Monad (Staged op) where
-  (Return x) >>= f = f x
-  (Instr i m) >>= f = Instr i (m >=> f)
-
--- * An AST for "reified computations"
-
--- | The idea is that a value of type @Staged (LtlOp modification builtin) a@
--- describes a set of (monadic) computations that return an @a@ such that
---
--- * every step of the computations that returns a @b@ is reified as a @builtin
---   b@, and
---
--- * every step can be modified by a @modification@.
-
--- | Operations for computations that can be modified using LTL formulas.
-data LtlOp (modification :: Type) (builtin :: Type -> Type) :: Type -> Type where
-  -- | The operation consisting of the reification of a builtin
-  Builtin :: builtin a -> LtlOp modification builtin a
-  -- | The operation consisting of wrapping a computation with a Ltl
-  -- formula that should be applied on the computation.
-  WrapLtl :: Ltl modification -> Staged (LtlOp modification builtin) a -> LtlOp modification builtin a
-
--- * Interpreting the AST
-
--- | To be a suitable semantic domain for computations modified by LTL formulas,
--- a monad @m@ has to
---
--- * have the right @builtin@ functions, which can be modified by the right
---   @modification@s,
---
--- * be a 'MonadPlus', because one LTL formula might yield different modified
---   versions of the computation, and
---
--- This type class only requires from the user to specify how to interpret the
--- (modified) builtins. In order to do so, it passes around the formulas that
--- are to be applied to the next time step in a @StateT@
-class (MonadPlus m) => InterpLtl modification builtin m where
-  interpBuiltin :: builtin a -> StateT [Ltl modification] m a
-
--- | Interpret a 'Staged' computation into a suitable domain, using the function
--- 'interpBuiltin' to interpret the builtins.
-interpLtl ::
-  (InterpLtl modification builtin m) =>
-  Staged (LtlOp modification builtin) a ->
-  StateT [Ltl modification] m a
-interpLtl (Return res) = return res
-interpLtl (Instr (Builtin b) f) = interpBuiltin b >>= interpLtl . f
-interpLtl (Instr (WrapLtl formula comp) nextComp) = do
-  modify' (formula :)
-  res <- interpLtl comp
-  formulas <- get
-  unless (null formulas) $ do
-    guard $ finished $ head formulas
-    put $ tail formulas
-  interpLtl $ nextComp res
-
--- * Convenience functions
-
--- | Monads that allow modifications with LTL formulas.
-class (Monad m) => MonadModal m where
-  type Modification m :: Type
-  modifyLtl :: Ltl (Modification m) -> m a -> m a
-
-instance MonadModal (Staged (LtlOp modification builtin)) where
-  type Modification (Staged (LtlOp modification builtin)) = modification
-  modifyLtl formula trace = Instr (WrapLtl formula trace) Return
+-- | The effect of being able to modify a computation with an Ltl formula
+class (Monad m) => MonadLtl modification m where
+  modifyLtl :: Ltl modification -> m a -> m a
diff --git a/src/Cooked/Ltl/Combinators.hs b/src/Cooked/Ltl/Combinators.hs
index 8c99e8722..eebea4174 100644
--- a/src/Cooked/Ltl/Combinators.hs
+++ b/src/Cooked/Ltl/Combinators.hs
@@ -83,7 +83,7 @@ ifPossible = ifPossible' . LtlAtom
 ifPossible' :: Ltl a -> Ltl a
 ifPossible' f = f `LtlOr` LtlNot f
 
--- | Same as `wheneverPossible'`, but first wraps the input in an atomic formula
+-- | Same as `whenPossible'`, but first wraps the input in an atomic formula
 whenPossible :: a -> Ltl a
 whenPossible = whenPossible' . LtlAtom
 
diff --git a/src/Cooked/MockChain/Direct.hs b/src/Cooked/MockChain/Direct.hs
index ad2ae5f43..5c5ed3294 100644
--- a/src/Cooked/MockChain/Direct.hs
+++ b/src/Cooked/MockChain/Direct.hs
@@ -112,6 +112,10 @@ instance (Monad m, Alternative m) => Alternative (MockChainT m) where
   empty = MockChainT $ ExceptT $ StateT $ const $ WriterT empty
   (<|>) = combineMockChainT (<|>)
 
+instance (MonadPlus m) => MonadPlus (MockChainT m) where
+  mzero = lift mzero
+  mplus = combineMockChainT mplus
+
 -- | Combines two 'MockChainT' together
 combineMockChainT :: (forall a. m a -> m a -> m a) -> MockChainT m x -> MockChainT m x -> MockChainT m x
 combineMockChainT f ma mb = MockChainT $
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index d5b5f29f9..3b7fd9667 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -23,6 +23,12 @@ module Cooked.MockChain.Staged
     nowhere,
     whenAble',
     whenAble,
+    Staged (..),
+    singletonBuiltin,
+    interpStaged,
+    interpStagedMockChain,
+    MonadLtl (..),
+    MockChainTweak,
   )
 where
 
@@ -42,11 +48,80 @@ import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Data.Default
 import Data.Functor
+import Data.Kind
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
 import Plutus.Script.Utils.Address qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 
+-- * Freer monad to represent an AST on a set of operations
+
+-- | The freer monad on @op@. We think of this as the AST of a computation with
+-- operations of types @op a@. These operation will in turn be instantiated with
+-- mockchain builtins alongside the appropriate effects.
+data Staged (op :: Type -> Type) :: Type -> Type where
+  Return :: a -> Staged op a
+  Instr :: op a -> (a -> Staged op b) -> Staged op b
+
+instance Functor (Staged op) where
+  fmap f (Return x) = Return $ f x
+  fmap f (Instr op cont) = Instr op (fmap f . cont)
+
+instance Applicative (Staged op) where
+  pure = Return
+  (<*>) = ap
+
+instance Monad (Staged op) where
+  (Return x) >>= f = f x
+  (Instr i m) >>= f = Instr i (m >=> f)
+
+-- | Building an singleton instruction in a staged monad
+singletonBuiltin :: builtin a -> Staged builtin a
+singletonBuiltin = (`Instr` Return)
+
+-- | Interprets a staged computation given a interpreter of the builtins
+interpStaged :: forall op m. (Monad m) => (forall a. op a -> m a) -> forall a. Staged op a -> m a
+interpStaged _ (Return a) = return a
+interpStaged interpBuiltin (Instr op cont) = interpBuiltin op >>= interpStaged interpBuiltin . cont
+
+-- | A 'StagedMockChain' is an AST of mockchain builtins. The idea is to keep
+-- the builtins abstract and postpone interpretation, to open up the possibility
+-- of applying tweaks before submitting transaction.
+type StagedMockChain = Staged MockChainBuiltin
+
+instance Alternative StagedMockChain where
+  empty = singletonBuiltin Empty
+  a <|> b = singletonBuiltin $ Alt a b
+
+instance MonadFail StagedMockChain where
+  fail = singletonBuiltin . Fail
+
+instance MonadError MockChainError StagedMockChain where
+  throwError = singletonBuiltin . ThrowError
+  catchError act = singletonBuiltin . CatchError act
+
+instance MonadLtl MockChainTweak StagedMockChain where
+  modifyLtl formula = singletonBuiltin . ModifyLtl formula
+
+instance MonadBlockChainBalancing StagedMockChain where
+  getParams = singletonBuiltin GetParams
+  txSkelOutByRef = singletonBuiltin . TxSkelOutByRef
+  utxosAt = singletonBuiltin . UtxosAt
+  logEvent = singletonBuiltin . LogEvent
+
+instance MonadBlockChainWithoutValidation StagedMockChain where
+  allUtxos = singletonBuiltin AllUtxos
+  setParams = singletonBuiltin . SetParams
+  waitNSlots = singletonBuiltin . WaitNSlots
+  define name = singletonBuiltin . Define name
+  setConstitutionScript = singletonBuiltin . SetConstitutionScript
+  getConstitutionScript = singletonBuiltin GetConstitutionScript
+  getCurrentReward = singletonBuiltin . GetCurrentReward
+
+instance MonadBlockChain StagedMockChain where
+  validateTxSkel = singletonBuiltin . ValidateTxSkel
+  forceOutputs = singletonBuiltin . ForceOutputs
+
 -- * Interpreting and running 'StagedMockChain'
 
 -- | Interprets the staged mockchain then runs the resulting computation with a
@@ -63,11 +138,14 @@ interpretAndRun = interpretAndRunWith runMockChainT
 -- | The semantic domain in which 'StagedMockChain' gets interpreted
 type InterpMockChain = MockChainT []
 
+-- | Tweaks operating within the 'InterpMockChain' domain
+type MockChainTweak = UntypedTweak InterpMockChain
+
 -- | The 'interpret' function gives semantics to our traces. One
 -- 'StagedMockChain' computation yields a potential list of 'MockChainT'
 -- computations.
 interpret :: StagedMockChain a -> InterpMockChain a
-interpret = flip evalStateT [] . interpLtl
+interpret = flip evalStateT [] . interpStagedMockChain
 
 -- * 'StagedMockChain': An AST for 'MonadMockChain' computations
 
@@ -87,6 +165,9 @@ data MockChainBuiltin a where
   GetConstitutionScript :: MockChainBuiltin (Maybe VScript)
   GetCurrentReward :: (Script.ToCredential c) => c -> MockChainBuiltin (Maybe Api.Lovelace)
   ForceOutputs :: [TxSkelOut] -> MockChainBuiltin [Api.TxOutRef]
+  -- TODO the following are effects outside of the mockchain builtins per se. It
+  -- would likely be more precise to use a dedicated library to handle those.
+  --
   -- The empty set of traces
   Empty :: MockChainBuiltin a
   -- The union of two sets of traces
@@ -96,30 +177,32 @@ data MockChainBuiltin a where
   -- for the 'MonadError MockChainError' instance
   ThrowError :: MockChainError -> MockChainBuiltin a
   CatchError :: StagedMockChain a -> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
+  -- for the Ltl modifications
+  ModifyLtl :: Ltl MockChainTweak -> StagedMockChain a -> MockChainBuiltin a
 
--- | A 'StagedMockChain' is a mockchain that can be modified using
--- 'Cooked.Tweak.Common.Tweak's whenever a transaction is being sent for
--- validation. Selecting which transactions should be modified before going to
--- validations is done using 'Cooked.Ltl.Ltl' formulas.
-type StagedMockChain = Staged (LtlOp (UntypedTweak InterpMockChain) MockChainBuiltin)
+-- * Interpreting the AST
 
-instance Alternative StagedMockChain where
-  empty = Instr (Builtin Empty) Return
-  a <|> b = Instr (Builtin (Alt a b)) Return
-
-instance MonadFail StagedMockChain where
-  fail msg = Instr (Builtin (Fail msg)) Return
+-- | To be a suitable semantic domain for computations modified by LTL formulas,
+-- a monad @m@ has to
+--
+-- * have the right @builtin@ functions, which can be modified by the right
+--   @modification@s,
+--
+-- * be a 'MonadPlus', because one LTL formula might yield different modified
+--   versions of the computation, and
+--
+-- This type class only requires from the user to specify how to interpret the
+-- (modified) builtins. In order to do so, it passes around the formulas that
+-- are to be applied to the next time step in a @StateT@
 
 -- * 'InterpLtl' instance
 
-instance (MonadPlus m) => MonadPlus (MockChainT m) where
-  mzero = lift mzero
-  mplus = combineMockChainT mplus
-
-instance InterpLtl (UntypedTweak InterpMockChain) MockChainBuiltin InterpMockChain where
-  interpBuiltin GetParams = getParams
-  interpBuiltin (SetParams params) = setParams params
-  interpBuiltin (ValidateTxSkel skel) = do
+-- | Interpret a 'Staged' computation into a suitable domain
+interpStagedMockChain :: StagedMockChain a -> StateT [Ltl MockChainTweak] InterpMockChain a
+interpStagedMockChain = interpStaged $ \case
+  GetParams -> getParams
+  (SetParams params) -> setParams params
+  (ValidateTxSkel skel) -> do
     modifications <- gets nowLaterList
     msum . (modifications <&>) $
       \(now, later) -> do
@@ -131,21 +214,29 @@ instance InterpLtl (UntypedTweak InterpMockChain) MockChainBuiltin InterpMockCha
               now
         put later
         validateTxSkel skel'
-  interpBuiltin (TxSkelOutByRef o) = txSkelOutByRef o
-  interpBuiltin (WaitNSlots s) = waitNSlots s
-  interpBuiltin AllUtxos = allUtxos
-  interpBuiltin (UtxosAt address) = utxosAt address
-  interpBuiltin Empty = mzero
-  interpBuiltin (Alt l r) = interpLtl l `mplus` interpLtl r
-  interpBuiltin (Fail msg) = fail msg
-  interpBuiltin (ThrowError err) = throwError err
-  interpBuiltin (CatchError act handler) = catchError (interpLtl act) (interpLtl . handler)
-  interpBuiltin (LogEvent entry) = logEvent entry
-  interpBuiltin (Define name hash) = define name hash
-  interpBuiltin (SetConstitutionScript script) = setConstitutionScript script
-  interpBuiltin GetConstitutionScript = getConstitutionScript
-  interpBuiltin (GetCurrentReward cred) = getCurrentReward cred
-  interpBuiltin (ForceOutputs outs) = forceOutputs outs
+  (TxSkelOutByRef o) -> txSkelOutByRef o
+  (WaitNSlots s) -> waitNSlots s
+  AllUtxos -> allUtxos
+  (UtxosAt address) -> utxosAt address
+  Empty -> mzero
+  (Alt l r) -> interpStagedMockChain l `mplus` interpStagedMockChain r
+  (Fail msg) -> fail msg
+  (ThrowError err) -> throwError err
+  (CatchError act handler) -> catchError (interpStagedMockChain act) (interpStagedMockChain . handler)
+  (LogEvent entry) -> logEvent entry
+  (Define name hash) -> define name hash
+  (SetConstitutionScript script) -> setConstitutionScript script
+  GetConstitutionScript -> getConstitutionScript
+  (GetCurrentReward cred) -> getCurrentReward cred
+  (ForceOutputs outs) -> forceOutputs outs
+  (ModifyLtl formula comp) -> do
+    modify' (formula :)
+    res <- interpStagedMockChain comp
+    formulas <- get
+    unless (null formulas) $ do
+      guard $ finished $ head formulas
+      put $ tail formulas
+    return res
 
 -- ** Helpers to run tweaks for use in tests for tweaks
 
@@ -162,7 +253,7 @@ runTweakFrom initDist tweak = runMockChainTFromInitDist initDist . runTweakInCha
 
 -- | A modal mockchain is a mockchain that allows us to use LTL modifications
 -- with 'Tweak's
-type MonadModalBlockChain m = (MonadBlockChain m, MonadModal m, Modification m ~ UntypedTweak InterpMockChain)
+type MonadModalBlockChain m = (MonadBlockChain m, MonadLtl MockChainTweak m)
 
 fromTweak :: Tweak m a -> Ltl (UntypedTweak m)
 fromTweak = LtlAtom . UntypedTweak
@@ -174,7 +265,7 @@ somewhere = somewhere' . fromTweak
 
 -- | Apply an Ltl modification somewhere in the given Trace. The modification
 -- must apply at least once.
-somewhere' :: (MonadModal m) => Ltl (Modification m) -> m a -> m a
+somewhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
 somewhere' = modifyLtl . eventually'
 
 -- | Apply a 'Tweak' to every transaction in a given trace. This is also
@@ -185,7 +276,7 @@ everywhere = everywhere' . fromTweak
 -- | Apply an Ltl modification everywhere it can be (including nowhere if it
 -- does not apply). If the modification branches, this will branch at every
 -- location the modification can be applied.
-everywhere' :: (MonadModal m) => Ltl (Modification m) -> m a -> m a
+everywhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
 everywhere' = modifyLtl . always'
 
 -- | Ensures a given 'Tweak' can never successfully be applied in a computation
@@ -193,7 +284,7 @@ nowhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
 nowhere = nowhere' . fromTweak
 
 -- | Ensures a given Ltl modification can never be applied on a computation
-nowhere' :: (MonadModal m) => Ltl (Modification m) -> m a -> m a
+nowhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
 nowhere' = modifyLtl . never'
 
 -- | Apply a given 'Tweak' at every location in a computation where it does not
@@ -203,7 +294,7 @@ whenAble = whenAble' . fromTweak
 
 -- | Apply an Ltl modification at every location in a computation where it is
 -- possible. Does not fail if no such position exists.
-whenAble' :: (MonadModal m) => Ltl (Modification m) -> m a -> m a
+whenAble' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
 whenAble' = modifyLtl . whenPossible'
 
 -- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
@@ -216,7 +307,7 @@ there n = there' n . fromTweak
 --
 -- See also `Cooked.Tweak.Labels.labelled'` to select transactions based on
 -- labels instead of their order.
-there' :: (MonadModal m) => Integer -> Ltl (Modification m) -> m a -> m a
+there' :: (MonadLtl mod m) => Integer -> Ltl mod -> m a -> m a
 there' n = modifyLtl . delay' n
 
 -- | Apply a 'Tweak' to the next transaction in the given trace. The order of
@@ -232,31 +323,3 @@ there' n = modifyLtl . delay' n
 -- returned by this endpoint in the following way".
 withTweak :: (MonadModalBlockChain m) => m x -> Tweak InterpMockChain a -> m x
 withTweak = flip (there 0)
-
--- * 'MonadBlockChain' and 'MonadMockChain' instances
-
-singletonBuiltin :: builtin a -> Staged (LtlOp modification builtin) a
-singletonBuiltin b = Instr (Builtin b) Return
-
-instance MonadError MockChainError StagedMockChain where
-  throwError = singletonBuiltin . ThrowError
-  catchError act handler = singletonBuiltin $ CatchError act handler
-
-instance MonadBlockChainBalancing StagedMockChain where
-  getParams = singletonBuiltin GetParams
-  txSkelOutByRef = singletonBuiltin . TxSkelOutByRef
-  utxosAt = singletonBuiltin . UtxosAt
-  logEvent = singletonBuiltin . LogEvent
-
-instance MonadBlockChainWithoutValidation StagedMockChain where
-  allUtxos = singletonBuiltin AllUtxos
-  setParams = singletonBuiltin . SetParams
-  waitNSlots = singletonBuiltin . WaitNSlots
-  define name = singletonBuiltin . Define name
-  setConstitutionScript = singletonBuiltin . SetConstitutionScript
-  getConstitutionScript = singletonBuiltin GetConstitutionScript
-  getCurrentReward = singletonBuiltin . GetCurrentReward
-
-instance MonadBlockChain StagedMockChain where
-  validateTxSkel = singletonBuiltin . ValidateTxSkel
-  forceOutputs = singletonBuiltin . ForceOutputs
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index 8fbb0675f..a7c54faa1 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -7,6 +7,7 @@ import Control.Monad.State
 import Control.Monad.Writer
 import Cooked.Ltl
 import Cooked.Ltl.Combinators
+import Cooked.MockChain.Staged
 import Cooked.MockChain.Testing
 import Data.Maybe
 import Test.Tasty
@@ -15,6 +16,10 @@ import Test.Tasty.HUnit
 data TestBuiltin a where
   EmitInteger :: Integer -> TestBuiltin ()
   GetInteger :: TestBuiltin Integer
+  WrapLtl :: Ltl TestModification -> Staged TestBuiltin a -> TestBuiltin a
+
+instance MonadLtl TestModification (Staged TestBuiltin) where
+  modifyLtl formula = singletonBuiltin . WrapLtl formula
 
 data TestModification
   = Add Integer
@@ -27,49 +32,57 @@ applyMod _ Fail = Nothing
 applyMod i (Add i') = if i == i' then Nothing else Just $ i + i'
 applyMod i (Mul i') = if i == i' then Nothing else Just $ i * i'
 
-instance (MonadPlus m) => InterpLtl TestModification TestBuiltin (WriterT [Integer] m) where
-  interpBuiltin GetInteger = return 42
-  interpBuiltin (EmitInteger i) = do
-    gets nowLaterList
-      >>= msum
-        . map
-          ( \(now, later) -> do
-              maybe mzero (tell . (: [])) $
-                foldl
-                  ( \acc (modif, el) -> do
-                      current <- acc
-                      if el
-                        then
-                          applyMod current modif
-                        else do
-                          guard $ isNothing $ applyMod current modif
-                          return current
-                  )
-                  (Just i)
-                  now
-              put later
-          )
+interpBuiltin :: (MonadPlus m) => TestBuiltin a -> StateT [Ltl TestModification] (WriterT [Integer] m) a
+interpBuiltin GetInteger = return 42
+interpBuiltin (EmitInteger i) = do
+  gets nowLaterList
+    >>= msum
+      . map
+        ( \(now, later) -> do
+            maybe mzero (tell . (: [])) $
+              foldl
+                ( \acc (modif, el) -> do
+                    current <- acc
+                    if el
+                      then
+                        applyMod current modif
+                      else do
+                        guard $ isNothing $ applyMod current modif
+                        return current
+                )
+                (Just i)
+                now
+            put later
+        )
+interpBuiltin (WrapLtl formula comp) = do
+  modify' (formula :)
+  res <- interpStaged interpBuiltin comp
+  formulas <- get
+  unless (null formulas) $ do
+    guard $ finished $ head formulas
+    put $ tail formulas
+  return res
 
-emitInteger :: Integer -> Staged (LtlOp TestModification TestBuiltin) ()
-emitInteger i = Instr (Builtin (EmitInteger i)) Return
+emitInteger :: Integer -> Staged TestBuiltin ()
+emitInteger = singletonBuiltin . EmitInteger
 
-getInteger :: Staged (LtlOp TestModification TestBuiltin) Integer
-getInteger = Instr (Builtin GetInteger) Return
+getInteger :: Staged TestBuiltin Integer
+getInteger = singletonBuiltin GetInteger
 
-go :: Staged (LtlOp TestModification TestBuiltin) a -> [[Integer]]
-go = execWriterT . flip execStateT [] . interpLtl
+go :: Staged TestBuiltin a -> [[Integer]]
+go = execWriterT . flip execStateT [] . interpStaged interpBuiltin
 
-nonemptyTraces :: [Staged (LtlOp TestModification TestBuiltin) ()]
+nonemptyTraces :: [Staged TestBuiltin ()]
 nonemptyTraces =
   [ getInteger >>= emitInteger,
     emitInteger 1 >> emitInteger 2,
     emitInteger 1 >> getInteger >>= emitInteger >> emitInteger 2
   ]
 
-emptyTraces :: [Staged (LtlOp TestModification TestBuiltin) ()]
+emptyTraces :: [Staged TestBuiltin ()]
 emptyTraces = [return (), void getInteger]
 
-testTraces :: [Staged (LtlOp TestModification TestBuiltin) ()]
+testTraces :: [Staged TestBuiltin ()]
 testTraces = nonemptyTraces ++ emptyTraces
 
 tests :: TestTree
@@ -87,9 +100,9 @@ tests =
        in testGroup
             "simple laws"
             [ testCase "LtlFalsity fails on every computation" $
-                testAll (\tr -> go (modifyLtl LtlFalsity tr) @?= []) testTraces,
+                testAll (\tr -> go (modifyLtl @TestModification LtlFalsity tr) @?= []) testTraces,
               testCase "LtlTruth leaves every computation unchanged" $
-                testAll (\tr -> go (modifyLtl LtlTruth tr) @?= go tr) testTraces,
+                testAll (\tr -> go (modifyLtl @TestModification LtlTruth tr) @?= go tr) testTraces,
               testCase "x `LtlUntil` y == y `LtlOr` (x `LtlAnd` LtlNext (x `LtlUntil` y))" $
                 testAll
                   (\tr -> assertSameSets (go $ modifyLtl untilDirect tr) (go $ modifyLtl untilIndirect tr))

From cfd30f7acb0846ab1ac83463387115ed6c4da283 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Wed, 7 Jan 2026 00:36:56 +0100
Subject: [PATCH 09/96] before attempting effects

---
 src/Cooked/MockChain/Staged.hs | 6 +++++-
 src/Cooked/Tweak/Common.hs     | 2 +-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 3b7fd9667..5e569fa6a 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -209,7 +209,11 @@ interpStagedMockChain = interpStaged $ \case
         (_, skel') <-
           lift . (`runTweakInChain` skel) $
             foldr
-              (\(UntypedTweak tweak, mode) acc -> if mode then tweak >> acc else ensureFailingTweak tweak >> acc)
+              ( \(UntypedTweak tweak, mode) acc ->
+                  if mode
+                    then tweak >> acc
+                    else ensureFailingTweak tweak >> acc
+              )
               doNothingTweak
               now
         put later
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index 42425096b..db439a1e9 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -41,7 +41,7 @@ import Optics.Core
 -- | A 'MonadTweak' is a 'MonadBlockChainWithoutValidation' where you can also
 -- retrieve and store a 'TxSkel'
 class (MonadPlus m, MonadBlockChainWithoutValidation m) => MonadTweak m where
-  -- | Retrieves the stores 'TxSkel'
+  -- | Retrieves the stored 'TxSkel'
   getTxSkel :: m TxSkel
 
   -- | Stores a 'TxSkel'

From fac0044f63c91de1c66e36a2e9317e1c746da4ae Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 8 Jan 2026 01:27:01 +0100
Subject: [PATCH 10/96] cleaning up, adding proper type classes

---
 src/Cooked/MockChain/Staged.hs | 175 ++++++++++++++++++---------------
 tests/Spec/Ltl.hs              |  65 +++++-------
 2 files changed, 117 insertions(+), 123 deletions(-)

diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 5e569fa6a..69c1007e7 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -26,9 +26,12 @@ module Cooked.MockChain.Staged
     Staged (..),
     singletonBuiltin,
     interpStaged,
-    interpStagedMockChain,
     MonadLtl (..),
     MockChainTweak,
+    LtlOp (..),
+    StagedLtl,
+    interpStagedLtl,
+    ModInterpBuiltin (..),
   )
 where
 
@@ -75,19 +78,68 @@ instance Monad (Staged op) where
   (Return x) >>= f = f x
   (Instr i m) >>= f = Instr i (m >=> f)
 
--- | Building an singleton instruction in a staged monad
-singletonBuiltin :: builtin a -> Staged builtin a
-singletonBuiltin = (`Instr` Return)
-
 -- | Interprets a staged computation given a interpreter of the builtins
 interpStaged :: forall op m. (Monad m) => (forall a. op a -> m a) -> forall a. Staged op a -> m a
 interpStaged _ (Return a) = return a
 interpStaged interpBuiltin (Instr op cont) = interpBuiltin op >>= interpStaged interpBuiltin . cont
 
--- | A 'StagedMockChain' is an AST of mockchain builtins. The idea is to keep
--- the builtins abstract and postpone interpretation, to open up the possibility
--- of applying tweaks before submitting transaction.
-type StagedMockChain = Staged MockChainBuiltin
+-- | An AST of builtins wrapped into an @Ltl@ setting
+type StagedLtl modification builtin = Staged (LtlOp modification builtin)
+
+instance MonadLtl modification (StagedLtl modification builtin) where
+  modifyLtl formula comp = Instr (WrapLtl formula comp) Return
+
+-- | Operations that either allow to wrap a builtin, or to modify a computation
+-- using an @Ltl@ formula.
+data LtlOp modification builtin :: Type -> Type where
+  WrapLtl :: Ltl modification -> StagedLtl modification builtin a -> LtlOp modification builtin a
+  Builtin :: builtin a -> LtlOp modification builtin a
+
+-- | Building an singleton instruction in a staged monad
+singletonBuiltin :: builtin a -> StagedLtl modification builtin a
+singletonBuiltin = (`Instr` Return) . Builtin
+
+-- | The class that depicts the ability to modify certain builtins and interpret
+-- then in a certain domain. Each builtins should either be interpreted directly
+-- through @Left@ or give or way to modify them with @Right@.
+class ModInterpBuiltin modification builtin m where
+  modifyAndInterpBuiltin ::
+    builtin a ->
+    Either
+      (m a) -- directly interpret
+      ([(modification, Bool)] -> m a) -- modify and then interpret
+
+-- | Interpreting a staged computation of @Ltl op@ based on an interpretation of
+-- @builtin@ with respect to possible modifications.
+interpStagedLtl ::
+  forall modification builtin m.
+  (MonadPlus m, ModInterpBuiltin modification builtin m) =>
+  forall a. Staged (LtlOp modification builtin) a -> m a
+interpStagedLtl = flip evalStateT [] . go
+  where
+    go :: forall a. Staged (LtlOp modification builtin) a -> StateT [Ltl modification] m a
+    go = interpStaged $ \case
+      WrapLtl formula comp -> do
+        modify' (formula :)
+        res <- go comp
+        formulas <- get
+        unless (null formulas) $ do
+          guard $ finished $ head formulas
+          put $ tail formulas
+        return res
+      Builtin builtin ->
+        case modifyAndInterpBuiltin builtin of
+          Left comp -> lift comp
+          Right applyMod -> do
+            modifications <- gets nowLaterList
+            msum . (modifications <&>) $
+              \(now, later) -> do
+                put later
+                lift $ applyMod now
+
+-- | A 'StagedMockChain' is an AST of mockchain builtins wrapped into
+-- @LtlOp@ to be subject to @Ltl@ modifications.
+type StagedMockChain = StagedLtl MockChainTweak MockChainBuiltin
 
 instance Alternative StagedMockChain where
   empty = singletonBuiltin Empty
@@ -100,9 +152,6 @@ instance MonadError MockChainError StagedMockChain where
   throwError = singletonBuiltin . ThrowError
   catchError act = singletonBuiltin . CatchError act
 
-instance MonadLtl MockChainTweak StagedMockChain where
-  modifyLtl formula = singletonBuiltin . ModifyLtl formula
-
 instance MonadBlockChainBalancing StagedMockChain where
   getParams = singletonBuiltin GetParams
   txSkelOutByRef = singletonBuiltin . TxSkelOutByRef
@@ -128,7 +177,7 @@ instance MonadBlockChain StagedMockChain where
 -- custom function. This can be used, for example, to supply a custom
 -- 'InitialDistribution' by providing 'runMockChainTFromInitDist'.
 interpretAndRunWith :: (forall m. (Monad m) => MockChainT m a -> m res) -> StagedMockChain a -> [res]
-interpretAndRunWith f = f . interpret
+interpretAndRunWith f = f . interpStagedLtl
 
 -- | Same as 'interpretAndRunWith' but using 'runMockChainT' as the default way
 -- to run the computation.
@@ -141,12 +190,6 @@ type InterpMockChain = MockChainT []
 -- | Tweaks operating within the 'InterpMockChain' domain
 type MockChainTweak = UntypedTweak InterpMockChain
 
--- | The 'interpret' function gives semantics to our traces. One
--- 'StagedMockChain' computation yields a potential list of 'MockChainT'
--- computations.
-interpret :: StagedMockChain a -> InterpMockChain a
-interpret = flip evalStateT [] . interpStagedMockChain
-
 -- * 'StagedMockChain': An AST for 'MonadMockChain' computations
 
 -- | Abstract representation of all the builtin functions of a 'MonadBlockChain'
@@ -177,70 +220,38 @@ data MockChainBuiltin a where
   -- for the 'MonadError MockChainError' instance
   ThrowError :: MockChainError -> MockChainBuiltin a
   CatchError :: StagedMockChain a -> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
-  -- for the Ltl modifications
-  ModifyLtl :: Ltl MockChainTweak -> StagedMockChain a -> MockChainBuiltin a
-
--- * Interpreting the AST
 
--- | To be a suitable semantic domain for computations modified by LTL formulas,
--- a monad @m@ has to
---
--- * have the right @builtin@ functions, which can be modified by the right
---   @modification@s,
---
--- * be a 'MonadPlus', because one LTL formula might yield different modified
---   versions of the computation, and
---
--- This type class only requires from the user to specify how to interpret the
--- (modified) builtins. In order to do so, it passes around the formulas that
--- are to be applied to the next time step in a @StateT@
-
--- * 'InterpLtl' instance
-
--- | Interpret a 'Staged' computation into a suitable domain
-interpStagedMockChain :: StagedMockChain a -> StateT [Ltl MockChainTweak] InterpMockChain a
-interpStagedMockChain = interpStaged $ \case
-  GetParams -> getParams
-  (SetParams params) -> setParams params
-  (ValidateTxSkel skel) -> do
-    modifications <- gets nowLaterList
-    msum . (modifications <&>) $
-      \(now, later) -> do
-        (_, skel') <-
-          lift . (`runTweakInChain` skel) $
-            foldr
-              ( \(UntypedTweak tweak, mode) acc ->
-                  if mode
-                    then tweak >> acc
-                    else ensureFailingTweak tweak >> acc
-              )
-              doNothingTweak
-              now
-        put later
-        validateTxSkel skel'
-  (TxSkelOutByRef o) -> txSkelOutByRef o
-  (WaitNSlots s) -> waitNSlots s
-  AllUtxos -> allUtxos
-  (UtxosAt address) -> utxosAt address
-  Empty -> mzero
-  (Alt l r) -> interpStagedMockChain l `mplus` interpStagedMockChain r
-  (Fail msg) -> fail msg
-  (ThrowError err) -> throwError err
-  (CatchError act handler) -> catchError (interpStagedMockChain act) (interpStagedMockChain . handler)
-  (LogEvent entry) -> logEvent entry
-  (Define name hash) -> define name hash
-  (SetConstitutionScript script) -> setConstitutionScript script
-  GetConstitutionScript -> getConstitutionScript
-  (GetCurrentReward cred) -> getCurrentReward cred
-  (ForceOutputs outs) -> forceOutputs outs
-  (ModifyLtl formula comp) -> do
-    modify' (formula :)
-    res <- interpStagedMockChain comp
-    formulas <- get
-    unless (null formulas) $ do
-      guard $ finished $ head formulas
-      put $ tail formulas
-    return res
+instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
+  modifyAndInterpBuiltin = \case
+    GetParams -> Left getParams
+    (SetParams params) -> Left $ setParams params
+    (ValidateTxSkel skel) -> Right $ \now -> do
+      (_, skel') <-
+        (`runTweakInChain` skel) $
+          foldr
+            ( \(UntypedTweak tweak, mode) acc ->
+                if mode
+                  then tweak >> acc
+                  else ensureFailingTweak tweak >> acc
+            )
+            doNothingTweak
+            now
+      validateTxSkel skel'
+    (TxSkelOutByRef o) -> Left $ txSkelOutByRef o
+    (WaitNSlots s) -> Left $ waitNSlots s
+    AllUtxos -> Left allUtxos
+    (UtxosAt address) -> Left $ utxosAt address
+    Empty -> Left mzero
+    (Alt l r) -> Left $ interpStagedLtl l `mplus` interpStagedLtl r
+    (Fail msg) -> Left $ fail msg
+    (ThrowError err) -> Left $ throwError err
+    (CatchError act handler) -> Left $ catchError (interpStagedLtl act) (interpStagedLtl . handler)
+    (LogEvent entry) -> Left $ logEvent entry
+    (Define name hash) -> Left $ define name hash
+    (SetConstitutionScript script) -> Left $ setConstitutionScript script
+    GetConstitutionScript -> Left getConstitutionScript
+    (GetCurrentReward cred) -> Left $ getCurrentReward cred
+    (ForceOutputs outs) -> Left $ forceOutputs outs
 
 -- ** Helpers to run tweaks for use in tests for tweaks
 
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index a7c54faa1..a92aac8b9 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -3,7 +3,6 @@
 module Spec.Ltl where
 
 import Control.Monad
-import Control.Monad.State
 import Control.Monad.Writer
 import Cooked.Ltl
 import Cooked.Ltl.Combinators
@@ -16,10 +15,6 @@ import Test.Tasty.HUnit
 data TestBuiltin a where
   EmitInteger :: Integer -> TestBuiltin ()
   GetInteger :: TestBuiltin Integer
-  WrapLtl :: Ltl TestModification -> Staged TestBuiltin a -> TestBuiltin a
-
-instance MonadLtl TestModification (Staged TestBuiltin) where
-  modifyLtl formula = singletonBuiltin . WrapLtl formula
 
 data TestModification
   = Add Integer
@@ -32,57 +27,45 @@ applyMod _ Fail = Nothing
 applyMod i (Add i') = if i == i' then Nothing else Just $ i + i'
 applyMod i (Mul i') = if i == i' then Nothing else Just $ i * i'
 
-interpBuiltin :: (MonadPlus m) => TestBuiltin a -> StateT [Ltl TestModification] (WriterT [Integer] m) a
-interpBuiltin GetInteger = return 42
-interpBuiltin (EmitInteger i) = do
-  gets nowLaterList
-    >>= msum
-      . map
-        ( \(now, later) -> do
-            maybe mzero (tell . (: [])) $
-              foldl
-                ( \acc (modif, el) -> do
-                    current <- acc
-                    if el
-                      then
-                        applyMod current modif
-                      else do
-                        guard $ isNothing $ applyMod current modif
-                        return current
-                )
-                (Just i)
-                now
-            put later
+type TestStaged = StagedLtl TestModification TestBuiltin
+
+instance (MonadPlus m, MonadWriter [Integer] m) => ModInterpBuiltin TestModification TestBuiltin m where
+  modifyAndInterpBuiltin GetInteger = Left (return 42)
+  modifyAndInterpBuiltin (EmitInteger i) = Right $ \now ->
+    maybe mzero (tell . (: [])) $
+      foldl
+        ( \acc (modif, el) -> do
+            current <- acc
+            if el
+              then
+                applyMod current modif
+              else do
+                guard $ isNothing $ applyMod current modif
+                return current
         )
-interpBuiltin (WrapLtl formula comp) = do
-  modify' (formula :)
-  res <- interpStaged interpBuiltin comp
-  formulas <- get
-  unless (null formulas) $ do
-    guard $ finished $ head formulas
-    put $ tail formulas
-  return res
+        (Just i)
+        now
 
-emitInteger :: Integer -> Staged TestBuiltin ()
+emitInteger :: Integer -> TestStaged ()
 emitInteger = singletonBuiltin . EmitInteger
 
-getInteger :: Staged TestBuiltin Integer
+getInteger :: TestStaged Integer
 getInteger = singletonBuiltin GetInteger
 
-go :: Staged TestBuiltin a -> [[Integer]]
-go = execWriterT . flip execStateT [] . interpStaged interpBuiltin
+go :: TestStaged a -> [[Integer]]
+go = execWriterT . interpStagedLtl
 
-nonemptyTraces :: [Staged TestBuiltin ()]
+nonemptyTraces :: [TestStaged ()]
 nonemptyTraces =
   [ getInteger >>= emitInteger,
     emitInteger 1 >> emitInteger 2,
     emitInteger 1 >> getInteger >>= emitInteger >> emitInteger 2
   ]
 
-emptyTraces :: [Staged TestBuiltin ()]
+emptyTraces :: [TestStaged ()]
 emptyTraces = [return (), void getInteger]
 
-testTraces :: [Staged TestBuiltin ()]
+testTraces :: [TestStaged ()]
 testTraces = nonemptyTraces ++ emptyTraces
 
 tests :: TestTree

From 77d6137c0a7865a4ec5152adc0f95b71c11c8140 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 8 Jan 2026 03:05:44 +0100
Subject: [PATCH 11/96] Requirment

---
 src/Cooked/Ltl.hs              | 16 ++++++++++++----
 src/Cooked/MockChain/Staged.hs | 23 +++++++++++++----------
 tests/Spec/Ltl.hs              |  9 ++++-----
 3 files changed, 29 insertions(+), 19 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index c94777069..2014943e1 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -9,6 +9,7 @@ module Cooked.Ltl
     nowLaterList,
     finished,
     MonadLtl (..),
+    Requirement (..),
   )
 where
 
@@ -65,6 +66,13 @@ data Ltl a
     LtlNot (Ltl a)
   deriving (Show, Eq, Functor)
 
+-- | Requirements implied by a given formula at a given time step
+data Requirement a
+  = -- | Apply this modification now
+    Apply a
+  | -- | Ensure this modification fails now
+    EnsureFailure a
+
 -- | For each LTL formula that describes a modification of a computation in a
 -- list, split it into a list of @(doNow, doLater)@ pairs, and then
 -- appropriately combine the results. The result of the splitting is bound to
@@ -82,7 +90,7 @@ data Ltl a
 -- accomplished by applying the modification @b@ right now, or by applying @a@
 -- right now and @a `LtlUntil` b@ from the next step onwards; the returned list
 -- will contain these two options.
-nowLaterList :: [Ltl a] -> [([(a, Bool)], [Ltl a])]
+nowLaterList :: [Ltl a] -> [([Requirement a], [Ltl a])]
 nowLaterList =
   foldr
     ( \el acc -> do
@@ -92,12 +100,12 @@ nowLaterList =
     )
     [([], [])]
   where
-    nowLater :: Ltl a -> [([(a, Bool)], Ltl a)]
+    nowLater :: Ltl a -> [([Requirement a], Ltl a)]
     nowLater LtlTruth = [([], LtlTruth)]
     nowLater LtlFalsity = [([], LtlFalsity)]
-    nowLater (LtlAtom now) = [([(now, True)], LtlTruth)]
+    nowLater (LtlAtom now) = [([Apply now], LtlTruth)]
     nowLater (LtlNext f) = [([], f)]
-    nowLater (LtlNot (LtlAtom now)) = [([(now, False)], LtlTruth)]
+    nowLater (LtlNot (LtlAtom now)) = [([EnsureFailure now], LtlTruth)]
     nowLater (f1 `LtlOr` f2) = nowLater f1 ++ nowLater f2
     nowLater (f1 `LtlAnd` f2) = do
       (now1, next1) <- nowLater f1
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 69c1007e7..fa2877a00 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -106,8 +106,8 @@ class ModInterpBuiltin modification builtin m where
   modifyAndInterpBuiltin ::
     builtin a ->
     Either
-      (m a) -- directly interpret
-      ([(modification, Bool)] -> m a) -- modify and then interpret
+      (m a) -- only interpretx
+      ([Requirement modification] -> m a) -- modify and then interpret
 
 -- | Interpreting a staged computation of @Ltl op@ based on an interpretation of
 -- @builtin@ with respect to possible modifications.
@@ -137,14 +137,18 @@ interpStagedLtl = flip evalStateT [] . go
                 put later
                 lift $ applyMod now
 
--- | A 'StagedMockChain' is an AST of mockchain builtins wrapped into
--- @LtlOp@ to be subject to @Ltl@ modifications.
+-- | A 'StagedMockChain' is an AST of mockchain builtins wrapped into @LtlOp@ to
+-- be subject to @Ltl@ modifications.
 type StagedMockChain = StagedLtl MockChainTweak MockChainBuiltin
 
 instance Alternative StagedMockChain where
   empty = singletonBuiltin Empty
   a <|> b = singletonBuiltin $ Alt a b
 
+instance MonadPlus StagedMockChain where
+  mzero = empty
+  mplus = (<|>)
+
 instance MonadFail StagedMockChain where
   fail = singletonBuiltin . Fail
 
@@ -229,10 +233,9 @@ instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
       (_, skel') <-
         (`runTweakInChain` skel) $
           foldr
-            ( \(UntypedTweak tweak, mode) acc ->
-                if mode
-                  then tweak >> acc
-                  else ensureFailingTweak tweak >> acc
+            ( \req acc -> case req of
+                Apply (UntypedTweak tweak) -> tweak >> acc
+                EnsureFailure (UntypedTweak tweak) -> ensureFailingTweak tweak >> acc
             )
             doNothingTweak
             now
@@ -320,8 +323,8 @@ there n = there' n . fromTweak
 -- | Apply an Ltl modification to the (0-indexed) nth transaction in a
 -- given trace. Successful when this transaction exists and can be modified.
 --
--- See also `Cooked.Tweak.Labels.labelled'` to select transactions based on
--- labels instead of their order.
+-- See also `Cooked.Tweak.Labels.labelled` to select transactions based on
+-- labels instead of their index.
 there' :: (MonadLtl mod m) => Integer -> Ltl mod -> m a -> m a
 there' n = modifyLtl . delay' n
 
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index a92aac8b9..3844344a9 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -34,12 +34,11 @@ instance (MonadPlus m, MonadWriter [Integer] m) => ModInterpBuiltin TestModifica
   modifyAndInterpBuiltin (EmitInteger i) = Right $ \now ->
     maybe mzero (tell . (: [])) $
       foldl
-        ( \acc (modif, el) -> do
+        ( \acc el -> do
             current <- acc
-            if el
-              then
-                applyMod current modif
-              else do
+            case el of
+              Apply modif -> applyMod current modif
+              EnsureFailure modif -> do
                 guard $ isNothing $ applyMod current modif
                 return current
         )

From 49c7c59d9dda0703482c83f4b594d0b90a98e462 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 8 Jan 2026 16:29:33 +0100
Subject: [PATCH 12/96] minor cleanup

---
 src/Cooked/MockChain/Staged.hs | 39 ++++++++++++++++------------------
 1 file changed, 18 insertions(+), 21 deletions(-)

diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index fa2877a00..27e3d4992 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -95,7 +95,7 @@ data LtlOp modification builtin :: Type -> Type where
   WrapLtl :: Ltl modification -> StagedLtl modification builtin a -> LtlOp modification builtin a
   Builtin :: builtin a -> LtlOp modification builtin a
 
--- | Building an singleton instruction in a staged monad
+-- | Building a singleton instruction in a `StagedLtl` monad
 singletonBuiltin :: builtin a -> StagedLtl modification builtin a
 singletonBuiltin = (`Instr` Return) . Builtin
 
@@ -106,7 +106,7 @@ class ModInterpBuiltin modification builtin m where
   modifyAndInterpBuiltin ::
     builtin a ->
     Either
-      (m a) -- only interpretx
+      (m a) -- only interpret
       ([Requirement modification] -> m a) -- modify and then interpret
 
 -- | Interpreting a staged computation of @Ltl op@ based on an interpretation of
@@ -212,9 +212,6 @@ data MockChainBuiltin a where
   GetConstitutionScript :: MockChainBuiltin (Maybe VScript)
   GetCurrentReward :: (Script.ToCredential c) => c -> MockChainBuiltin (Maybe Api.Lovelace)
   ForceOutputs :: [TxSkelOut] -> MockChainBuiltin [Api.TxOutRef]
-  -- TODO the following are effects outside of the mockchain builtins per se. It
-  -- would likely be more precise to use a dedicated library to handle those.
-  --
   -- The empty set of traces
   Empty :: MockChainBuiltin a
   -- The union of two sets of traces
@@ -228,8 +225,8 @@ data MockChainBuiltin a where
 instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
   modifyAndInterpBuiltin = \case
     GetParams -> Left getParams
-    (SetParams params) -> Left $ setParams params
-    (ValidateTxSkel skel) -> Right $ \now -> do
+    SetParams params -> Left $ setParams params
+    ValidateTxSkel skel -> Right $ \now -> do
       (_, skel') <-
         (`runTweakInChain` skel) $
           foldr
@@ -240,21 +237,21 @@ instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
             doNothingTweak
             now
       validateTxSkel skel'
-    (TxSkelOutByRef o) -> Left $ txSkelOutByRef o
-    (WaitNSlots s) -> Left $ waitNSlots s
+    TxSkelOutByRef o -> Left $ txSkelOutByRef o
+    WaitNSlots s -> Left $ waitNSlots s
     AllUtxos -> Left allUtxos
-    (UtxosAt address) -> Left $ utxosAt address
-    Empty -> Left mzero
-    (Alt l r) -> Left $ interpStagedLtl l `mplus` interpStagedLtl r
-    (Fail msg) -> Left $ fail msg
-    (ThrowError err) -> Left $ throwError err
-    (CatchError act handler) -> Left $ catchError (interpStagedLtl act) (interpStagedLtl . handler)
-    (LogEvent entry) -> Left $ logEvent entry
-    (Define name hash) -> Left $ define name hash
-    (SetConstitutionScript script) -> Left $ setConstitutionScript script
+    UtxosAt address -> Left $ utxosAt address
+    LogEvent entry -> Left $ logEvent entry
+    Define name hash -> Left $ define name hash
+    SetConstitutionScript script -> Left $ setConstitutionScript script
     GetConstitutionScript -> Left getConstitutionScript
-    (GetCurrentReward cred) -> Left $ getCurrentReward cred
-    (ForceOutputs outs) -> Left $ forceOutputs outs
+    GetCurrentReward cred -> Left $ getCurrentReward cred
+    ForceOutputs outs -> Left $ forceOutputs outs
+    Empty -> Left mzero
+    Alt l r -> Left $ interpStagedLtl l `mplus` interpStagedLtl r
+    Fail msg -> Left $ fail msg
+    ThrowError err -> Left $ throwError err
+    CatchError act handler -> Left $ catchError (interpStagedLtl act) (interpStagedLtl . handler)
 
 -- ** Helpers to run tweaks for use in tests for tweaks
 
@@ -339,5 +336,5 @@ there' n = modifyLtl . delay' n
 -- where @endpoint@ builds and validates a single transaction depending on the
 -- given @arguments@. Then `withTweak` says "I want to modify the transaction
 -- returned by this endpoint in the following way".
-withTweak :: (MonadModalBlockChain m) => m x -> Tweak InterpMockChain a -> m x
+withTweak :: (MonadModalBlockChain m) => m a -> Tweak InterpMockChain b -> m a
 withTweak = flip (there 0)

From 93015ee7b69fb87de8a77b4caf90bd5f804b3260 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Thu, 8 Jan 2026 22:58:26 +0100
Subject: [PATCH 13/96] laying out things in relevant files

---
 cooked-validators.cabal        |   1 +
 src/Cooked.hs                  |   1 +
 src/Cooked/Ltl.hs              | 165 ++++++++++++++++++++++-------
 src/Cooked/Ltl/Combinators.hs  |   6 +-
 src/Cooked/MockChain/Staged.hs | 186 +++++++--------------------------
 src/Cooked/Staged.hs           |  33 ++++++
 src/Cooked/Tweak/Common.hs     |  18 +++-
 tests/Spec/Ltl.hs              |   1 -
 8 files changed, 221 insertions(+), 190 deletions(-)
 create mode 100644 src/Cooked/Staged.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index d7fc83de3..291f43fc2 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -65,6 +65,7 @@ library
       Cooked.Skeleton.User
       Cooked.Skeleton.Value
       Cooked.Skeleton.Withdrawal
+      Cooked.Staged
       Cooked.Tweak
       Cooked.Tweak.Common
       Cooked.Tweak.Inputs
diff --git a/src/Cooked.hs b/src/Cooked.hs
index ff235c952..16c6105fe 100644
--- a/src/Cooked.hs
+++ b/src/Cooked.hs
@@ -10,5 +10,6 @@ import Cooked.MockChain as X
 import Cooked.Pretty as X
 import Cooked.ShowBS as X
 import Cooked.Skeleton as X
+import Cooked.Staged as X
 import Cooked.Tweak as X
 import Cooked.Wallet as X
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 2014943e1..d1397b98d 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -7,12 +7,24 @@
 module Cooked.Ltl
   ( Ltl (..),
     nowLaterList,
+    ltlSimpl,
     finished,
     MonadLtl (..),
     Requirement (..),
+    interpStagedLtl,
+    singletonBuiltin,
+    LtlOp (..),
+    StagedLtl,
+    ModInterpBuiltin (..),
   )
 where
 
+import Control.Monad
+import Control.Monad.State
+import Cooked.Staged
+import Data.Functor
+import Data.Kind
+
 -- * LTL formulas and operations on them
 
 -- | Type of LTL formulas with atomic formulas of type @a@. Think of @a@ as a
@@ -66,6 +78,53 @@ data Ltl a
     LtlNot (Ltl a)
   deriving (Show, Eq, Functor)
 
+-- | Simplification procedure for LTL formulas. This function knows how
+-- 'LtlTruth' and 'LtlFalsity' play with negation, conjunction and disjunction
+-- and recursively applies this knowledge; it is used to keep the formulas
+-- 'nowLater' generates from growing too wildly. While this function does not
+-- compute a normal form per se (as it does not tamper with nested conjunction
+-- and disjunction), it does ensure a few properties:
+--
+-- * `LtlNext` is left unchanged
+--
+-- * `LtlNot` only appears in the resulting formula wrapping up a `LtlAtom`
+--
+-- * `LtlUntil` and `LtlRelease` are interpreted in terms of other constructs,
+--   and thus are never returned.
+--
+-- * Two `LtlNext` appearing in both sides of an `LtlAnd` and `LtlOr` are
+--   merged. Thus a formula of shape @LtlAnd (LtlNext a) (LtlNext b)@ will never
+--   be returned, and similarly with @LtlOr@.
+ltlSimpl :: Ltl a -> Ltl a
+ltlSimpl (LtlAtom a) = LtlAtom a
+ltlSimpl LtlTruth = LtlTruth
+ltlSimpl LtlFalsity = LtlFalsity
+ltlSimpl (LtlNext f) = LtlNext f
+ltlSimpl (LtlRelease f1 f2) = ltlSimpl $ f2 `LtlAnd` (f1 `LtlOr` LtlNext (f1 `LtlRelease` f2))
+ltlSimpl (LtlUntil f1 f2) = ltlSimpl $ f2 `LtlOr` (f1 `LtlAnd` LtlNext (f1 `LtlUntil` f2))
+ltlSimpl (LtlNot (ltlSimpl -> LtlTruth)) = LtlFalsity
+ltlSimpl (LtlNot (ltlSimpl -> LtlFalsity)) = LtlTruth
+ltlSimpl (LtlNot (ltlSimpl -> LtlNot f)) = f
+ltlSimpl (LtlNot (ltlSimpl -> LtlAnd f1 f2)) = ltlSimpl $ LtlNot f1 `LtlOr` LtlNot f2
+ltlSimpl (LtlNot (ltlSimpl -> LtlOr f1 f2)) = ltlSimpl $ LtlNot f1 `LtlAnd` LtlNot f2
+ltlSimpl (LtlNot (ltlSimpl -> LtlNext f)) = LtlNext (LtlNot f)
+-- The following will never occur, as `ltlSimpl` never returns something of
+-- the shape `LtlUntil` or `LtlRelease`
+ltlSimpl (LtlNot (ltlSimpl -> f)) = LtlNot f
+ltlSimpl (LtlAnd (ltlSimpl -> LtlFalsity) _) = LtlFalsity
+ltlSimpl (LtlAnd _ (ltlSimpl -> LtlFalsity)) = LtlFalsity
+ltlSimpl (LtlAnd (ltlSimpl -> LtlTruth) (ltlSimpl -> f2)) = f2
+ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> LtlTruth)) = f1
+ltlSimpl (LtlAnd (ltlSimpl -> LtlNext f1) (ltlSimpl -> LtlNext f2)) = LtlNext $ f1 `LtlAnd` f2
+ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlAnd f1 f2
+ltlSimpl (LtlOr (ltlSimpl -> LtlFalsity) (ltlSimpl -> f2)) = f2
+ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> LtlFalsity)) = f1
+ltlSimpl (LtlOr (ltlSimpl -> LtlNext f1) (ltlSimpl -> LtlNext f2)) = LtlNext $ f1 `LtlOr` f2
+-- We don't perform any reduction when `LtlOr` is applied to `LtlTruth` as
+-- we still need to keep both branches, and certainly don't want to discard
+-- the branch were potential meaningful modifications need to be applied.
+ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlOr f1 f2
+
 -- | Requirements implied by a given formula at a given time step
 data Requirement a
   = -- | Apply this modification now
@@ -79,8 +138,8 @@ data Requirement a
 -- the following semantics:
 --
 -- * @doNow@ is the list of modifications to be consecutively either applied to
--- the current time step (@True@), or that should fail at the current time step
--- (@False@)
+-- the current time step (`Apply`), or that should fail at the current time step
+-- (`EnsureFailure`)
 --
 -- * @doLater@ is an LTL formula describing the modification that should be
 -- applied from the next time step onwards.
@@ -112,42 +171,10 @@ nowLaterList =
       (now2, next2) <- nowLater f2
       return (now2 <> now1, next2 `LtlAnd` next1)
     -- Only the above cases can occur, as they are outcomes of @ltlSimpl@. This
-    -- is handy, as the remaining cases would lead to complicated interactions
-    -- and hard to handle growth in the number of formulas.
+    -- is handy (and intended), as the remaining cases would lead to complicated
+    -- interactions and hard to handle growth in the number of formulas.
     nowLater _ = error "nowLater is always called after ltlSimpl which does not yield more cases."
 
-    -- Straightforward simplification procedure for LTL formulas. This function
-    -- knows how 'LtlTruth' and 'LtlFalsity' play with negation, conjunction and
-    -- disjunction and recursively applies this knowledge; it is used to keep
-    -- the formulas 'nowLater' generates from growing too wildly.
-    ltlSimpl :: Ltl a -> Ltl a
-    ltlSimpl (LtlAtom a) = LtlAtom a
-    ltlSimpl LtlTruth = LtlTruth
-    ltlSimpl LtlFalsity = LtlFalsity
-    ltlSimpl (LtlNext f) = LtlNext f
-    ltlSimpl (LtlRelease f1 f2) = ltlSimpl $ f2 `LtlAnd` (f1 `LtlOr` LtlNext (f1 `LtlRelease` f2))
-    ltlSimpl (LtlUntil f1 f2) = ltlSimpl $ f2 `LtlOr` (f1 `LtlAnd` LtlNext (f1 `LtlUntil` f2))
-    ltlSimpl (LtlNot (ltlSimpl -> LtlTruth)) = LtlFalsity
-    ltlSimpl (LtlNot (ltlSimpl -> LtlFalsity)) = LtlTruth
-    ltlSimpl (LtlNot (ltlSimpl -> LtlNot f)) = f
-    ltlSimpl (LtlNot (ltlSimpl -> LtlAnd f1 f2)) = ltlSimpl $ LtlNot f1 `LtlOr` LtlNot f2
-    ltlSimpl (LtlNot (ltlSimpl -> LtlOr f1 f2)) = ltlSimpl $ LtlNot f1 `LtlAnd` LtlNot f2
-    ltlSimpl (LtlNot (ltlSimpl -> LtlNext f)) = LtlNext (LtlNot f)
-    -- The following will never occur, as `ltlSimpl` never returns something of
-    -- the shape `LtlUntil` or `LtlRelease`
-    ltlSimpl (LtlNot (ltlSimpl -> f)) = LtlNot f
-    ltlSimpl (LtlAnd (ltlSimpl -> LtlFalsity) _) = LtlFalsity
-    ltlSimpl (LtlAnd _ (ltlSimpl -> LtlFalsity)) = LtlFalsity
-    ltlSimpl (LtlAnd (ltlSimpl -> LtlTruth) (ltlSimpl -> f2)) = f2
-    ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> LtlTruth)) = f1
-    ltlSimpl (LtlAnd (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlAnd f1 f2
-    ltlSimpl (LtlOr (ltlSimpl -> LtlFalsity) (ltlSimpl -> f2)) = f2
-    ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> LtlFalsity)) = f1
-    -- We don't perform any reduction when `LtlOr` is applied to `LtlTruth` as
-    -- we still need to keep both branches, and certainly don't want to discard
-    -- the branch were potential meaningful modifications need to be applied.
-    ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlOr f1 f2
-
 -- | If there are no more steps and the next step should satisfy the given
 -- formula: Are we finished, i.e. was the initial formula satisfied by now?
 finished :: Ltl a -> Bool
@@ -161,6 +188,72 @@ finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
 finished (LtlNot f) = not $ finished f
 
+-- * The `MonadLtl` effect and associated functions
+
+-- | Operations that either allow to use a builtin, or to modify a computation
+-- using an @Ltl@ formula.
+data LtlOp modification builtin :: Type -> Type where
+  WrapLtl :: Ltl modification -> StagedLtl modification builtin a -> LtlOp modification builtin a
+  Builtin :: builtin a -> LtlOp modification builtin a
+
+-- | An AST of builtins wrapped into an @Ltl@ setting
+type StagedLtl modification builtin = Staged (LtlOp modification builtin)
+
+-- | Building a singleton instruction in a `StagedLtl` monad
+singletonBuiltin :: builtin a -> StagedLtl modification builtin a
+singletonBuiltin = (`Instr` Return) . Builtin
+
 -- | The effect of being able to modify a computation with an Ltl formula
 class (Monad m) => MonadLtl modification m where
   modifyLtl :: Ltl modification -> m a -> m a
+
+instance MonadLtl modification (StagedLtl modification builtin) where
+  modifyLtl formula comp = Instr (WrapLtl formula comp) Return
+
+-- | The class that depicts the ability to modify certain builtins and interpret
+-- then in a certain domain. Each builtins should either be interpreted directly
+-- through @Apply@ or give or way to modify them with @Right@.
+class ModInterpBuiltin modification builtin m where
+  modifyAndInterpBuiltin ::
+    builtin a ->
+    Either
+      (m a) -- only interpret
+      ([Requirement modification] -> m a) -- modify and then interpret
+
+-- | Interpret a staged computation of @Ltl op@ based on an interpretation of
+-- @builtin@ with respect to possible modifications. This requires an
+-- intermediate interpretation with a state monad, and unfolds as follows:
+--
+-- * When a builtin is met, which is directly interpreted, we return the
+--   associated computation, with no changes to the @Ltl@ state.
+--
+-- * When a builtin is met, which requires a modification, we return the
+--   modified interpretation, and consume the current modification requirements.
+--
+-- * When a wrapped computation is met, we store the new associated formula, and
+--   ensure that when the computation ends, the formula is finished.
+interpStagedLtl ::
+  forall modification builtin m.
+  (MonadPlus m, ModInterpBuiltin modification builtin m) =>
+  forall a. StagedLtl modification builtin a -> m a
+interpStagedLtl = flip evalStateT [] . go
+  where
+    go :: forall a. Staged (LtlOp modification builtin) a -> StateT [Ltl modification] m a
+    go = interpStaged $ \case
+      WrapLtl formula comp -> do
+        modify' (formula :)
+        res <- go comp
+        formulas <- get
+        unless (null formulas) $ do
+          guard $ finished $ head formulas
+          put $ tail formulas
+        return res
+      Builtin builtin ->
+        case modifyAndInterpBuiltin builtin of
+          Left comp -> lift comp
+          Right applyMod -> do
+            modifications <- gets nowLaterList
+            msum . (modifications <&>) $
+              \(now, later) -> do
+                put later
+                lift $ applyMod now
diff --git a/src/Cooked/Ltl/Combinators.hs b/src/Cooked/Ltl/Combinators.hs
index eebea4174..4fcc9fabb 100644
--- a/src/Cooked/Ltl/Combinators.hs
+++ b/src/Cooked/Ltl/Combinators.hs
@@ -31,8 +31,7 @@ anyOf = anyOf' . map LtlAtom
 -- | Produces an Ltl formula which consists of the disjunction of all the
 -- formulas in the input list.
 anyOf' :: [Ltl a] -> Ltl a
-anyOf' [] = LtlFalsity
-anyOf' xs = foldr1 LtlOr xs
+anyOf' = foldr LtlOr LtlFalsity
 
 -- | Same as `allOf'`, but first wraps the elements in the input list in atomic
 -- formulas.
@@ -42,8 +41,7 @@ allOf = allOf' . map LtlAtom
 -- | Produces an Ltl formula which consists of the conjunction of all the
 -- formulas in the input list.
 allOf' :: [Ltl a] -> Ltl a
-allOf' [] = LtlTruth
-allOf' xs = foldr1 LtlAnd xs
+allOf' = foldr LtlAnd LtlTruth
 
 -- | Same as `delay'`, but first wraps the elements in the input list in atomic
 -- formulas.
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 27e3d4992..275ab7762 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -8,12 +8,11 @@ module Cooked.MockChain.Staged
     interpretAndRun,
     StagedMockChain,
     MockChainBuiltin,
-    runTweakFrom,
+    MockChainTweak,
     MonadModalBlockChain,
     InterpMockChain,
     somewhere,
     somewhere',
-    runTweak,
     everywhere,
     everywhere',
     withTweak,
@@ -23,15 +22,6 @@ module Cooked.MockChain.Staged
     nowhere,
     whenAble',
     whenAble,
-    Staged (..),
-    singletonBuiltin,
-    interpStaged,
-    MonadLtl (..),
-    MockChainTweak,
-    LtlOp (..),
-    StagedLtl,
-    interpStagedLtl,
-    ModInterpBuiltin (..),
   )
 where
 
@@ -39,9 +29,6 @@ import Cardano.Node.Emulator qualified as Emulator
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Except
-import Control.Monad.Reader
-import Control.Monad.State
-import Cooked.InitialDistribution
 import Cooked.Ltl
 import Cooked.Ltl.Combinators
 import Cooked.MockChain.BlockChain
@@ -49,93 +36,36 @@ import Cooked.MockChain.Direct
 import Cooked.Pretty.Hashable
 import Cooked.Skeleton
 import Cooked.Tweak.Common
-import Data.Default
-import Data.Functor
-import Data.Kind
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
 import Plutus.Script.Utils.Address qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 
--- * Freer monad to represent an AST on a set of operations
-
--- | The freer monad on @op@. We think of this as the AST of a computation with
--- operations of types @op a@. These operation will in turn be instantiated with
--- mockchain builtins alongside the appropriate effects.
-data Staged (op :: Type -> Type) :: Type -> Type where
-  Return :: a -> Staged op a
-  Instr :: op a -> (a -> Staged op b) -> Staged op b
-
-instance Functor (Staged op) where
-  fmap f (Return x) = Return $ f x
-  fmap f (Instr op cont) = Instr op (fmap f . cont)
-
-instance Applicative (Staged op) where
-  pure = Return
-  (<*>) = ap
-
-instance Monad (Staged op) where
-  (Return x) >>= f = f x
-  (Instr i m) >>= f = Instr i (m >=> f)
-
--- | Interprets a staged computation given a interpreter of the builtins
-interpStaged :: forall op m. (Monad m) => (forall a. op a -> m a) -> forall a. Staged op a -> m a
-interpStaged _ (Return a) = return a
-interpStaged interpBuiltin (Instr op cont) = interpBuiltin op >>= interpStaged interpBuiltin . cont
-
--- | An AST of builtins wrapped into an @Ltl@ setting
-type StagedLtl modification builtin = Staged (LtlOp modification builtin)
-
-instance MonadLtl modification (StagedLtl modification builtin) where
-  modifyLtl formula comp = Instr (WrapLtl formula comp) Return
-
--- | Operations that either allow to wrap a builtin, or to modify a computation
--- using an @Ltl@ formula.
-data LtlOp modification builtin :: Type -> Type where
-  WrapLtl :: Ltl modification -> StagedLtl modification builtin a -> LtlOp modification builtin a
-  Builtin :: builtin a -> LtlOp modification builtin a
-
--- | Building a singleton instruction in a `StagedLtl` monad
-singletonBuiltin :: builtin a -> StagedLtl modification builtin a
-singletonBuiltin = (`Instr` Return) . Builtin
-
--- | The class that depicts the ability to modify certain builtins and interpret
--- then in a certain domain. Each builtins should either be interpreted directly
--- through @Left@ or give or way to modify them with @Right@.
-class ModInterpBuiltin modification builtin m where
-  modifyAndInterpBuiltin ::
-    builtin a ->
-    Either
-      (m a) -- only interpret
-      ([Requirement modification] -> m a) -- modify and then interpret
-
--- | Interpreting a staged computation of @Ltl op@ based on an interpretation of
--- @builtin@ with respect to possible modifications.
-interpStagedLtl ::
-  forall modification builtin m.
-  (MonadPlus m, ModInterpBuiltin modification builtin m) =>
-  forall a. Staged (LtlOp modification builtin) a -> m a
-interpStagedLtl = flip evalStateT [] . go
-  where
-    go :: forall a. Staged (LtlOp modification builtin) a -> StateT [Ltl modification] m a
-    go = interpStaged $ \case
-      WrapLtl formula comp -> do
-        modify' (formula :)
-        res <- go comp
-        formulas <- get
-        unless (null formulas) $ do
-          guard $ finished $ head formulas
-          put $ tail formulas
-        return res
-      Builtin builtin ->
-        case modifyAndInterpBuiltin builtin of
-          Left comp -> lift comp
-          Right applyMod -> do
-            modifications <- gets nowLaterList
-            msum . (modifications <&>) $
-              \(now, later) -> do
-                put later
-                lift $ applyMod now
+-- * 'StagedMockChain': An AST for 'MonadMockChain' computations
+
+-- | Abstract representation of all the builtin functions of a 'MonadBlockChain'
+data MockChainBuiltin a where
+  -- methods of 'MonadBlockChain'
+  GetParams :: MockChainBuiltin Emulator.Params
+  SetParams :: Emulator.Params -> MockChainBuiltin ()
+  ValidateTxSkel :: TxSkel -> MockChainBuiltin Ledger.CardanoTx
+  TxSkelOutByRef :: Api.TxOutRef -> MockChainBuiltin TxSkelOut
+  WaitNSlots :: (Integral i) => i -> MockChainBuiltin Ledger.Slot
+  AllUtxos :: MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
+  UtxosAt :: (Script.ToAddress a) => a -> MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
+  LogEvent :: MockChainLogEntry -> MockChainBuiltin ()
+  Define :: (ToHash a) => String -> a -> MockChainBuiltin a
+  SetConstitutionScript :: (ToVScript s) => s -> MockChainBuiltin ()
+  GetConstitutionScript :: MockChainBuiltin (Maybe VScript)
+  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainBuiltin (Maybe Api.Lovelace)
+  ForceOutputs :: [TxSkelOut] -> MockChainBuiltin [Api.TxOutRef]
+  -- The empty set of traces
+  Empty :: MockChainBuiltin a
+  -- The union of two sets of traces
+  Alt :: StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
+  -- for the 'MonadError MockChainError' instance
+  ThrowError :: MockChainError -> MockChainBuiltin a
+  CatchError :: StagedMockChain a -> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
 
 -- | A 'StagedMockChain' is an AST of mockchain builtins wrapped into @LtlOp@ to
 -- be subject to @Ltl@ modifications.
@@ -150,7 +80,7 @@ instance MonadPlus StagedMockChain where
   mplus = (<|>)
 
 instance MonadFail StagedMockChain where
-  fail = singletonBuiltin . Fail
+  fail = singletonBuiltin . ThrowError . FailWith
 
 instance MonadError MockChainError StagedMockChain where
   throwError = singletonBuiltin . ThrowError
@@ -177,51 +107,12 @@ instance MonadBlockChain StagedMockChain where
 
 -- * Interpreting and running 'StagedMockChain'
 
--- | Interprets the staged mockchain then runs the resulting computation with a
--- custom function. This can be used, for example, to supply a custom
--- 'InitialDistribution' by providing 'runMockChainTFromInitDist'.
-interpretAndRunWith :: (forall m. (Monad m) => MockChainT m a -> m res) -> StagedMockChain a -> [res]
-interpretAndRunWith f = f . interpStagedLtl
-
--- | Same as 'interpretAndRunWith' but using 'runMockChainT' as the default way
--- to run the computation.
-interpretAndRun :: StagedMockChain a -> [MockChainReturn a]
-interpretAndRun = interpretAndRunWith runMockChainT
-
--- | The semantic domain in which 'StagedMockChain' gets interpreted
+-- | The domain in which 'StagedMockChain' gets interpreted
 type InterpMockChain = MockChainT []
 
 -- | Tweaks operating within the 'InterpMockChain' domain
 type MockChainTweak = UntypedTweak InterpMockChain
 
--- * 'StagedMockChain': An AST for 'MonadMockChain' computations
-
--- | Abstract representation of all the builtin functions of a 'MonadBlockChain'
-data MockChainBuiltin a where
-  -- methods of 'MonadBlockChain'
-  GetParams :: MockChainBuiltin Emulator.Params
-  SetParams :: Emulator.Params -> MockChainBuiltin ()
-  ValidateTxSkel :: TxSkel -> MockChainBuiltin Ledger.CardanoTx
-  TxSkelOutByRef :: Api.TxOutRef -> MockChainBuiltin TxSkelOut
-  WaitNSlots :: (Integral i) => i -> MockChainBuiltin Ledger.Slot
-  AllUtxos :: MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
-  UtxosAt :: (Script.ToAddress a) => a -> MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
-  LogEvent :: MockChainLogEntry -> MockChainBuiltin ()
-  Define :: (ToHash a) => String -> a -> MockChainBuiltin a
-  SetConstitutionScript :: (ToVScript s) => s -> MockChainBuiltin ()
-  GetConstitutionScript :: MockChainBuiltin (Maybe VScript)
-  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainBuiltin (Maybe Api.Lovelace)
-  ForceOutputs :: [TxSkelOut] -> MockChainBuiltin [Api.TxOutRef]
-  -- The empty set of traces
-  Empty :: MockChainBuiltin a
-  -- The union of two sets of traces
-  Alt :: StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
-  -- for the 'MonadFail' instance
-  Fail :: String -> MockChainBuiltin a
-  -- for the 'MonadError MockChainError' instance
-  ThrowError :: MockChainError -> MockChainBuiltin a
-  CatchError :: StagedMockChain a -> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
-
 instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
   modifyAndInterpBuiltin = \case
     GetParams -> Left getParams
@@ -249,22 +140,21 @@ instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
     ForceOutputs outs -> Left $ forceOutputs outs
     Empty -> Left mzero
     Alt l r -> Left $ interpStagedLtl l `mplus` interpStagedLtl r
-    Fail msg -> Left $ fail msg
     ThrowError err -> Left $ throwError err
     CatchError act handler -> Left $ catchError (interpStagedLtl act) (interpStagedLtl . handler)
 
--- ** Helpers to run tweaks for use in tests for tweaks
-
--- | Runs a 'Tweak' from a given 'TxSkel' within a mockchain
-runTweak :: Tweak InterpMockChain a -> TxSkel -> [MockChainReturn (a, TxSkel)]
-runTweak = runTweakFrom def
+-- | Interprets the staged mockchain then runs the resulting computation with a
+-- custom function. This can be used, for example, to supply a custom
+-- 'InitialDistribution' by providing 'runMockChainTFromInitDist'.
+interpretAndRunWith :: (forall m. (Monad m) => MockChainT m a -> m res) -> StagedMockChain a -> [res]
+interpretAndRunWith f = f . interpStagedLtl
 
--- | Runs a 'Tweak' from a given 'TxSkel' and 'InitialDistribution' within a
--- mockchain
-runTweakFrom :: InitialDistribution -> Tweak InterpMockChain a -> TxSkel -> [MockChainReturn (a, TxSkel)]
-runTweakFrom initDist tweak = runMockChainTFromInitDist initDist . runTweakInChain tweak
+-- | Same as 'interpretAndRunWith' but using 'runMockChainT' as the default way
+-- to run the computation.
+interpretAndRun :: StagedMockChain a -> [MockChainReturn a]
+interpretAndRun = interpretAndRunWith runMockChainT
 
--- ** Modalities
+-- * Modalities
 
 -- | A modal mockchain is a mockchain that allows us to use LTL modifications
 -- with 'Tweak's
diff --git a/src/Cooked/Staged.hs b/src/Cooked/Staged.hs
new file mode 100644
index 000000000..4ee834764
--- /dev/null
+++ b/src/Cooked/Staged.hs
@@ -0,0 +1,33 @@
+-- | This module exposes a simple notion of a Staged computation (or a freer
+-- monad) to be used when modifying mockchain runs with Ltl formulas.
+module Cooked.Staged
+  ( Staged (..),
+    interpStaged,
+  )
+where
+
+import Control.Monad
+import Data.Kind
+
+-- | The freer monad on @op@. We think of this as the AST of a computation with
+-- operations of types @op a@.
+data Staged (op :: Type -> Type) :: Type -> Type where
+  Return :: a -> Staged op a
+  Instr :: op a -> (a -> Staged op b) -> Staged op b
+
+instance Functor (Staged op) where
+  fmap f (Return x) = Return $ f x
+  fmap f (Instr op cont) = Instr op (fmap f . cont)
+
+instance Applicative (Staged op) where
+  pure = Return
+  (<*>) = ap
+
+instance Monad (Staged op) where
+  (Return x) >>= f = f x
+  (Instr i m) >>= f = Instr i (m >=> f)
+
+-- | Interprets a staged computation given a interpreter of the builtins
+interpStaged :: (Monad m) => (forall a. op a -> m a) -> forall a. Staged op a -> m a
+interpStaged _ (Return a) = return a
+interpStaged interpBuiltin (Instr op cont) = interpBuiltin op >>= interpStaged interpBuiltin . cont
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index db439a1e9..838b56e13 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -2,7 +2,9 @@
 -- our "domain specific language" for attacks. They are essentially skeleton
 -- modifications aware of the mockchain state.
 module Cooked.Tweak.Common
-  ( runTweakInChain,
+  ( runTweak,
+    runTweakFrom,
+    runTweakInChain,
     runTweakInChain',
     Tweak,
     UntypedTweak (..),
@@ -27,8 +29,11 @@ where
 import Control.Arrow (second)
 import Control.Monad
 import Control.Monad.State
+import Cooked.InitialDistribution
 import Cooked.MockChain.BlockChain
+import Cooked.MockChain.Direct
 import Cooked.Skeleton
+import Data.Default
 import Data.Either.Combinators (rightToMaybe)
 import Data.List (mapAccumL)
 import Data.Maybe
@@ -55,6 +60,8 @@ instance (MonadBlockChainWithoutValidation m) => MonadTweak (Tweak m) where
   getTxSkel = get
   putTxSkel = put
 
+-- * Running tweaks
+
 -- | This is the function that gives a meaning to 'Tweak's: A 'Tweak' is a
 -- computation that, depending on the state of the chain, looks at a transaction
 -- and returns zero or more modified transactions, together with some additional
@@ -90,6 +97,15 @@ runTweakInChain tweak = ListT.alternate . runStateT tweak
 runTweakInChain' :: (MonadPlus m) => Tweak m a -> TxSkel -> m [(a, TxSkel)]
 runTweakInChain' tweak = ListT.toList . runStateT tweak
 
+-- | Runs a 'Tweak' from a given 'TxSkel' within a mockchain
+runTweak :: (MonadPlus m) => Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
+runTweak = runTweakFrom def
+
+-- | Runs a 'Tweak' from a given 'TxSkel' and 'InitialDistribution' within a
+-- mockchain
+runTweakFrom :: (MonadPlus m) => InitialDistribution -> Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
+runTweakFrom initDist tweak = runMockChainTFromInitDist initDist . runTweakInChain tweak
+
 -- | This is a wrapper type used in the implementation of the Staged monad. You
 -- will probably never use it while you're building 'Tweak's.
 data UntypedTweak m where
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index 3844344a9..e58a122f2 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -6,7 +6,6 @@ import Control.Monad
 import Control.Monad.Writer
 import Cooked.Ltl
 import Cooked.Ltl.Combinators
-import Cooked.MockChain.Staged
 import Cooked.MockChain.Testing
 import Data.Maybe
 import Test.Tasty

From e9b4626ffdd496db9d1161befa36cf5db0453a32 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 9 Jan 2026 00:40:45 +0100
Subject: [PATCH 14/96] fix haddock warnings

---
 src/Cooked/Ltl.hs              | 6 +++---
 src/Cooked/MockChain/Staged.hs | 3 ++-
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index d1397b98d..b9e1bf93b 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -81,9 +81,9 @@ data Ltl a
 -- | Simplification procedure for LTL formulas. This function knows how
 -- 'LtlTruth' and 'LtlFalsity' play with negation, conjunction and disjunction
 -- and recursively applies this knowledge; it is used to keep the formulas
--- 'nowLater' generates from growing too wildly. While this function does not
--- compute a normal form per se (as it does not tamper with nested conjunction
--- and disjunction), it does ensure a few properties:
+-- 'nowLaterList' generates from growing too wildly. While this function does
+-- not compute a normal form per se (as it does not tamper with nested
+-- conjunction and disjunction), it does ensure a few properties:
 --
 -- * `LtlNext` is left unchanged
 --
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 275ab7762..50d0cf8a0 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -145,7 +145,8 @@ instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
 
 -- | Interprets the staged mockchain then runs the resulting computation with a
 -- custom function. This can be used, for example, to supply a custom
--- 'InitialDistribution' by providing 'runMockChainTFromInitDist'.
+-- 'Cooked.InitialDistribution.InitialDistribution' by providing
+-- 'runMockChainTFromInitDist'.
 interpretAndRunWith :: (forall m. (Monad m) => MockChainT m a -> m res) -> StagedMockChain a -> [res]
 interpretAndRunWith f = f . interpStagedLtl
 

From 00bda782685fb76c5c2f6b26978c029d3102ebc3 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 9 Jan 2026 03:42:53 +0100
Subject: [PATCH 15/96] comment updated

---
 src/Cooked/Ltl.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index b9e1bf93b..bcfd13cf5 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -29,9 +29,7 @@ import Data.Kind
 
 -- | Type of LTL formulas with atomic formulas of type @a@. Think of @a@ as a
 -- type of "modifications", then a value of type @Ltl a@ describes where to
--- apply modifications. Since there is no (obvious) semantics for a negated
--- modification or of one modification (possibly in the future) implying another
--- modification, implication and negation are currently absent.
+-- apply modifications.
 data Ltl a
   = -- | The modification that always applies but does noting
     LtlTruth
@@ -212,7 +210,7 @@ instance MonadLtl modification (StagedLtl modification builtin) where
 
 -- | The class that depicts the ability to modify certain builtins and interpret
 -- then in a certain domain. Each builtins should either be interpreted directly
--- through @Apply@ or give or way to modify them with @Right@.
+-- through @Left@ or give or way to modify them with @Right@.
 class ModInterpBuiltin modification builtin m where
   modifyAndInterpBuiltin ::
     builtin a ->

From 84efc2ea15221047c378d646e580740d8cc6d39e Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 9 Jan 2026 15:48:07 +0100
Subject: [PATCH 16/96] haddock rendering

---
 cooked-validators.cabal |  2 ++
 package.yaml            |  1 +
 src/Cooked/Ltl.hs       | 78 +++++++++++++++++++----------------------
 3 files changed, 39 insertions(+), 42 deletions(-)

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 291f43fc2..0289940fb 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -85,6 +85,7 @@ library
   default-extensions:
       ConstraintKinds
       DataKinds
+      DeriveFunctor
       DerivingStrategies
       DerivingVia
       FlexibleContexts
@@ -198,6 +199,7 @@ test-suite spec
   default-extensions:
       ConstraintKinds
       DataKinds
+      DeriveFunctor
       DerivingStrategies
       DerivingVia
       FlexibleContexts
diff --git a/package.yaml b/package.yaml
index 65265092c..2dbfbd441 100644
--- a/package.yaml
+++ b/package.yaml
@@ -65,6 +65,7 @@ library:
   default-extensions: &default-extensions
     - ConstraintKinds
     - DataKinds
+    - DeriveFunctor
     - DerivingStrategies
     - DerivingVia
     - FlexibleContexts
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index bcfd13cf5..aaecb68cb 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -1,21 +1,19 @@
-{-# LANGUAGE DeriveFunctor #-}
-
 -- | This modules provides the infrastructure to modify sequences of
 -- transactions using pseudo-LTL formulaes with atomic modifications. This idea
 -- is to describe when to apply certain modifications within a trace. This is to
 -- be replaced later on with a dependency to https://github.com/tweag/graft.
 module Cooked.Ltl
-  ( Ltl (..),
-    nowLaterList,
-    ltlSimpl,
-    finished,
-    MonadLtl (..),
+  ( -- * LTL formulas
+    Ltl (..),
     Requirement (..),
-    interpStagedLtl,
-    singletonBuiltin,
+
+    -- * Using `Ltl` formulas to modify computations
     LtlOp (..),
     StagedLtl,
+    singletonBuiltin,
+    MonadLtl (..),
     ModInterpBuiltin (..),
+    interpStagedLtl,
   )
 where
 
@@ -25,18 +23,19 @@ import Cooked.Staged
 import Data.Functor
 import Data.Kind
 
--- * LTL formulas and operations on them
-
 -- | Type of LTL formulas with atomic formulas of type @a@. Think of @a@ as a
 -- type of "modifications", then a value of type @Ltl a@ describes where to
--- apply modifications.
+-- apply `Requirement`s in a trace.
 data Ltl a
-  = -- | The modification that always applies but does noting
+  = -- | The modification that always applies but does nothing.
     LtlTruth
-  | -- | The modification that never applies (i.e. always fails)
+  | -- | The modification that never applies (i.e. always fails).
     LtlFalsity
-  | -- | The atomic modification, applying at the current time step
+  | -- | The atomic modification, applying at the current time step.
     LtlAtom a
+  | -- | Assert that the given formula must not hold at the current time step
+    -- i.e. that the appropriate modifications fail.
+    LtlNot (Ltl a)
   | -- | Disjunction will be interpreted in an "intuitionistic" way, i.e. as
     -- branching into the "timeline" where the left disjunct holds and the one
     -- where the right disjunct holds. In that sense, it is an exclusive or, as
@@ -70,16 +69,12 @@ data Ltl a
     -- `LtlRelease` needs it own constructor, as it is considered valid on an
     -- empty computation, which the above formula is not in most cases.
     LtlRelease (Ltl a) (Ltl a)
-  | -- | Assert that the given formula must not hold at the current time
-    -- step. This will be interpreted as ensuring the appropriate modifications
-    -- fail.
-    LtlNot (Ltl a)
   deriving (Show, Eq, Functor)
 
 -- | Simplification procedure for LTL formulas. This function knows how
--- 'LtlTruth' and 'LtlFalsity' play with negation, conjunction and disjunction
+-- `LtlTruth` and `LtlFalsity` play with negation, conjunction and disjunction
 -- and recursively applies this knowledge; it is used to keep the formulas
--- 'nowLaterList' generates from growing too wildly. While this function does
+-- `nowLaterList` generates from growing too wildly. While this function does
 -- not compute a normal form per se (as it does not tamper with nested
 -- conjunction and disjunction), it does ensure a few properties:
 --
@@ -123,7 +118,7 @@ ltlSimpl (LtlOr (ltlSimpl -> LtlNext f1) (ltlSimpl -> LtlNext f2)) = LtlNext $ f
 -- the branch were potential meaningful modifications need to be applied.
 ltlSimpl (LtlOr (ltlSimpl -> f1) (ltlSimpl -> f2)) = LtlOr f1 f2
 
--- | Requirements implied by a given formula at a given time step
+-- | Requirements implied by a given `Ltl` formula at a given time step
 data Requirement a
   = -- | Apply this modification now
     Apply a
@@ -186,44 +181,37 @@ finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
 finished (LtlNot f) = not $ finished f
 
--- * The `MonadLtl` effect and associated functions
-
 -- | Operations that either allow to use a builtin, or to modify a computation
--- using an @Ltl@ formula.
+-- using an `Ltl` formula.
 data LtlOp modification builtin :: Type -> Type where
   WrapLtl :: Ltl modification -> StagedLtl modification builtin a -> LtlOp modification builtin a
   Builtin :: builtin a -> LtlOp modification builtin a
 
--- | An AST of builtins wrapped into an @Ltl@ setting
+-- | An AST of builtins wrapped into an `Ltl` setting
 type StagedLtl modification builtin = Staged (LtlOp modification builtin)
 
--- | Building a singleton instruction in a `StagedLtl` monad
+-- | Builds a singleton instruction in a `StagedLtl` monad
 singletonBuiltin :: builtin a -> StagedLtl modification builtin a
 singletonBuiltin = (`Instr` Return) . Builtin
 
--- | The effect of being able to modify a computation with an Ltl formula
+-- | Depicts the ability to modify a computation with an `Ltl` formula
 class (Monad m) => MonadLtl modification m where
   modifyLtl :: Ltl modification -> m a -> m a
 
 instance MonadLtl modification (StagedLtl modification builtin) where
   modifyLtl formula comp = Instr (WrapLtl formula comp) Return
 
--- | The class that depicts the ability to modify certain builtins and interpret
--- then in a certain domain. Each builtins should either be interpreted directly
--- through @Left@ or give or way to modify them with @Right@.
+-- | Depicts the ability to modify certain builtins and interpret then in a
+-- given domain. Each builtins should either be interpreted directly through
+-- @Left@ or give or way to modify them with @Right@.
 class ModInterpBuiltin modification builtin m where
-  modifyAndInterpBuiltin ::
-    builtin a ->
-    Either
-      (m a) -- only interpret
-      ([Requirement modification] -> m a) -- modify and then interpret
+  modifyAndInterpBuiltin :: builtin a -> Either (m a) ([Requirement modification] -> m a)
 
--- | Interpret a staged computation of @Ltl op@ based on an interpretation of
--- @builtin@ with respect to possible modifications. This requires an
--- intermediate interpretation with a state monad, and unfolds as follows:
+-- | Interprets a `StagedLtl` computation based on an interpretation of
+-- @builtin@ with respect to possible modifications. This unfolds as follows:
 --
 -- * When a builtin is met, which is directly interpreted, we return the
---   associated computation, with no changes to the @Ltl@ state.
+--   associated computation, with no changes to the `Ltl` state.
 --
 -- * When a builtin is met, which requires a modification, we return the
 --   modified interpretation, and consume the current modification requirements.
@@ -232,8 +220,14 @@ class ModInterpBuiltin modification builtin m where
 --   ensure that when the computation ends, the formula is finished.
 interpStagedLtl ::
   forall modification builtin m.
-  (MonadPlus m, ModInterpBuiltin modification builtin m) =>
-  forall a. StagedLtl modification builtin a -> m a
+  ( MonadPlus m,
+    ModInterpBuiltin modification builtin m
+  ) =>
+  forall a.
+  -- | A staged computation `Ltl` compatible
+  StagedLtl modification builtin a ->
+  -- | Interpretation of the computation
+  m a
 interpStagedLtl = flip evalStateT [] . go
   where
     go :: forall a. Staged (LtlOp modification builtin) a -> StateT [Ltl modification] m a

From 9f692d8d41767927d944f9e18a0e08008ca15c3d Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 9 Jan 2026 19:49:31 +0100
Subject: [PATCH 17/96] restructuring and renaming combinators

---
 cooked-validators.cabal        |   1 -
 src/Cooked.hs                  |   5 +-
 src/Cooked/Ltl.hs              | 145 ++++++++++++++++++++++++++++++---
 src/Cooked/Ltl/Combinators.hs  | 108 ------------------------
 src/Cooked/MockChain/Staged.hs |  13 ++-
 tests/Spec/Ltl.hs              |  75 ++++++++---------
 6 files changed, 178 insertions(+), 169 deletions(-)
 delete mode 100644 src/Cooked/Ltl/Combinators.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 0289940fb..b89a0059d 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -19,7 +19,6 @@ library
       Cooked.Attack.DoubleSat
       Cooked.InitialDistribution
       Cooked.Ltl
-      Cooked.Ltl.Combinators
       Cooked.MockChain
       Cooked.MockChain.AutoFilling
       Cooked.MockChain.Balancing
diff --git a/src/Cooked.hs b/src/Cooked.hs
index 16c6105fe..8562790ed 100644
--- a/src/Cooked.hs
+++ b/src/Cooked.hs
@@ -1,11 +1,10 @@
--- | Re-exports the entirety of the library, which is always eventually necessary
---  when writing large test-suites.
+-- | Re-exports the entirety of the library, which is often necessary when
+--  writing large test-suites.
 module Cooked (module X) where
 
 import Cooked.Attack as X
 import Cooked.InitialDistribution as X
 import Cooked.Ltl as X
-import Cooked.Ltl.Combinators as X
 import Cooked.MockChain as X
 import Cooked.Pretty as X
 import Cooked.ShowBS as X
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index aaecb68cb..125fdbda6 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -1,13 +1,36 @@
 -- | This modules provides the infrastructure to modify sequences of
--- transactions using pseudo-LTL formulaes with atomic modifications. This idea
--- is to describe when to apply certain modifications within a trace. This is to
--- be replaced later on with a dependency to https://github.com/tweag/graft.
+-- transactions using LTL formulaes with atomic modifications. This idea is to
+-- describe when to apply certain modifications within a trace.
 module Cooked.Ltl
   ( -- * LTL formulas
     Ltl (..),
-    Requirement (..),
 
-    -- * Using `Ltl` formulas to modify computations
+    -- * LTL combinators
+    ltlNot',
+    ltlOr',
+    ltlAnd',
+    ltlNext',
+    ltlAny,
+    ltlAny',
+    ltlAll,
+    ltlAll',
+    ltlDelay,
+    ltlDelay',
+    ltlEventually,
+    ltlEventually',
+    ltlAlways,
+    ltlAlways',
+    ltlWhenPossible,
+    ltlWhenPossible',
+    ltlIfPossible,
+    ltlIfPossible',
+    ltlImplies,
+    ltlImplies',
+    ltlNever,
+    ltlNever',
+
+    -- * Using LTL formulas to modify computations
+    Requirement (..),
     LtlOp (..),
     StagedLtl,
     singletonBuiltin,
@@ -51,7 +74,7 @@ data Ltl a
   | -- | Assert that the given formula holds at the next time step.
     LtlNext (Ltl a)
   | -- | Assert that the first formula holds at least until the second one
-    -- begins to hold, which must happen eventually. The following holds:
+    -- begins to hold, which must happen ltlEventually. The following holds:
     --
     -- > a `LtlUntil` b <=> b `LtlOr` (a `LtlAnd` LtlNext (a `LtlUntil` b))
     --
@@ -60,7 +83,7 @@ data Ltl a
     -- for `LtlRelease`, which cannot.
     LtlUntil (Ltl a) (Ltl a)
   | -- | Assert that the second formula has to hold up to and including the
-    -- point when the first begins to hold; if that never happens, the second
+    -- point when the first begins to hold; if that ltlNever happens, the second
     -- formula has to remain true forever. View this as dual to 'LtlUntil'. The
     -- following holds:
     --
@@ -71,6 +94,103 @@ data Ltl a
     LtlRelease (Ltl a) (Ltl a)
   deriving (Show, Eq, Functor)
 
+-- | Same as `LtlNot`, but first wraps the input in an atomic formula.
+ltlNot' :: a -> Ltl a
+ltlNot' = LtlNot . LtlAtom
+
+-- | Same as `LtlOr`, but first wraps the inputs in atomic formulas.
+ltlOr' :: a -> a -> Ltl a
+ltlOr' f1 f2 = LtlOr (LtlAtom f1) (LtlAtom f2)
+
+-- | Same as `LtlAnd`, but first wraps the inputs in atomic formulas.
+ltlAnd' :: a -> a -> Ltl a
+ltlAnd' f1 f2 = LtlAnd (LtlAtom f1) (LtlAtom f2)
+
+-- | Same as `LtlNext`, but first wraps the input in an atomic formula.
+ltlNext' :: a -> Ltl a
+ltlNext' = LtlNext . LtlAtom
+
+-- | Produces an Ltl formula which consists of the disjunction of all the
+-- formulas in the input list.
+ltlAny :: [Ltl a] -> Ltl a
+ltlAny = foldr LtlOr LtlFalsity
+
+-- | Same as `ltlAny`, but first wraps the elements in the input list in atomic
+-- formulas.
+ltlAny' :: [a] -> Ltl a
+ltlAny' = ltlAny . map LtlAtom
+
+-- | Produces an Ltl formula which consists of the conjunction of all the
+-- formulas in the input list.
+ltlAll :: [Ltl a] -> Ltl a
+ltlAll = foldr LtlAnd LtlTruth
+
+-- | Same as `ltlAll`, but first wraps the elements in the input list in atomic
+-- formulas.
+ltlAll' :: [a] -> Ltl a
+ltlAll' = ltlAll . map LtlAtom
+
+-- | Produces an Ltl formula which consists of the delay of the input formula by
+-- @n@ time steps, if @n > 0@.
+ltlDelay :: Integer -> Ltl a -> Ltl a
+ltlDelay n | n <= 0 = id
+ltlDelay n = LtlNext . ltlDelay (n - 1)
+
+-- | Same as `ltlDelay`, but first wraps the input in an atomic formula.
+ltlDelay' :: Integer -> a -> Ltl a
+ltlDelay' n = ltlDelay n . LtlAtom
+
+-- | Produces an Ltl formula which ensures the input formula eventually holds.
+ltlEventually :: Ltl a -> Ltl a
+ltlEventually = LtlUntil LtlTruth
+
+-- | Same as `ltlEventually`, but first wraps the input in an atomic formula.
+ltlEventually' :: a -> Ltl a
+ltlEventually' = ltlEventually . LtlAtom
+
+-- | Produces an Ltl formula which ensures the input formula always holds.
+ltlAlways :: Ltl a -> Ltl a
+ltlAlways = LtlRelease LtlFalsity
+
+-- | Same as `ltlAlways`, but first wraps the input in an atomic formula.
+ltlAlways' :: a -> Ltl a
+ltlAlways' = ltlAlways . LtlAtom
+
+-- | Produces an Ltl formula which either ensure the given formula does not
+-- hold, or apply its modifications.
+ltlIfPossible :: Ltl a -> Ltl a
+ltlIfPossible f = f `LtlOr` LtlNot f
+
+-- | Same as `ltlIfPossible`, but first wraps the input in an atomic formula.
+ltlIfPossible' :: a -> Ltl a
+ltlIfPossible' = ltlIfPossible . LtlAtom
+
+-- | Produces an Ltl formula which applies a formula whenever possible, while
+-- ignoring steps when it is not.
+ltlWhenPossible :: Ltl a -> Ltl a
+ltlWhenPossible = ltlAlways . ltlIfPossible
+
+-- | Same as `ltlWhenPossible`, but first wraps the input in an atomic formula.
+ltlWhenPossible' :: a -> Ltl a
+ltlWhenPossible' = ltlWhenPossible . LtlAtom
+
+-- | Produces an Ltl formula ensuring the given formula always fails.
+ltlNever :: Ltl a -> Ltl a
+ltlNever = ltlAlways . LtlNot
+
+-- | Same as `ltlNever`, but first wraps the input in an atomic formula.
+ltlNever' :: a -> Ltl a
+ltlNever' = ltlNever . LtlAtom
+
+-- | Produces a formula that succeeds if the first formula does not hold, or if
+-- both formulas hold.
+ltlImplies :: Ltl a -> Ltl a -> Ltl a
+ltlImplies f1 f2 = (f2 `LtlAnd` f1) `LtlOr` LtlNot f1
+
+-- | Same as `ltlImplies` but first wraps the inputs in atomic formulas.
+ltlImplies' :: a -> a -> Ltl a
+ltlImplies' a1 a2 = LtlAtom a1 `ltlImplies` LtlAtom a2
+
 -- | Simplification procedure for LTL formulas. This function knows how
 -- `LtlTruth` and `LtlFalsity` play with negation, conjunction and disjunction
 -- and recursively applies this knowledge; it is used to keep the formulas
@@ -201,9 +321,14 @@ class (Monad m) => MonadLtl modification m where
 instance MonadLtl modification (StagedLtl modification builtin) where
   modifyLtl formula comp = Instr (WrapLtl formula comp) Return
 
--- | Depicts the ability to modify certain builtins and interpret then in a
--- given domain. Each builtins should either be interpreted directly through
--- @Left@ or give or way to modify them with @Right@.
+-- | Depicts the ability to modify and interpret builtins in a given
+-- domain. Each builtin can either:
+--
+-- * be interpreted directly through @Left@, in which case it will not be
+--   considered as a timestep in a trace.
+--
+-- * be modified and only then interpreted through @Right@, in which case it
+--   will be considered as a timestep in a trace.
 class ModInterpBuiltin modification builtin m where
   modifyAndInterpBuiltin :: builtin a -> Either (m a) ([Requirement modification] -> m a)
 
diff --git a/src/Cooked/Ltl/Combinators.hs b/src/Cooked/Ltl/Combinators.hs
deleted file mode 100644
index 4fcc9fabb..000000000
--- a/src/Cooked/Ltl/Combinators.hs
+++ /dev/null
@@ -1,108 +0,0 @@
--- | This module provides helpers for writing common LTL expressions.
-module Cooked.Ltl.Combinators
-  ( anyOf,
-    allOf,
-    anyOf',
-    allOf',
-    delay,
-    delay',
-    eventually,
-    eventually',
-    always,
-    always',
-    whenPossible',
-    whenPossible,
-    ifPossible',
-    ifPossible,
-    ltlImplies',
-    ltlImplies,
-    never',
-    never,
-  )
-where
-
-import Cooked.Ltl (Ltl (..))
-
--- | Same as `anyOf'`, but first wraps the elements in the input list in atomic
--- formulas.
-anyOf :: [a] -> Ltl a
-anyOf = anyOf' . map LtlAtom
-
--- | Produces an Ltl formula which consists of the disjunction of all the
--- formulas in the input list.
-anyOf' :: [Ltl a] -> Ltl a
-anyOf' = foldr LtlOr LtlFalsity
-
--- | Same as `allOf'`, but first wraps the elements in the input list in atomic
--- formulas.
-allOf :: [a] -> Ltl a
-allOf = allOf' . map LtlAtom
-
--- | Produces an Ltl formula which consists of the conjunction of all the
--- formulas in the input list.
-allOf' :: [Ltl a] -> Ltl a
-allOf' = foldr LtlAnd LtlTruth
-
--- | Same as `delay'`, but first wraps the elements in the input list in atomic
--- formulas.
-delay :: Integer -> a -> Ltl a
-delay n = delay' n . LtlAtom
-
--- | Produces an Ltl formula which consists of the delay of the input formula by
--- @n@ time steps, if @n > 0@. Otherwise, leaves the formula unchanged.
-delay' :: Integer -> Ltl a -> Ltl a
-delay' n | n <= 0 = id
-delay' n = LtlNext . delay' (n - 1)
-
--- | Same as `eventually'`, but first wraps the elements in the input list in
--- atomic formulas.
-eventually :: a -> Ltl a
-eventually = eventually' . LtlAtom
-
--- | Produces an Ltl formula which ensures the input formula eventually holds
-eventually' :: Ltl a -> Ltl a
-eventually' = LtlUntil LtlTruth
-
--- | Same as `always'`, but first wraps the elements in the input list in
--- atomic formulas.
-always :: a -> Ltl a
-always = always' . LtlAtom
-
--- | Produces an Ltl formula which ensures the input formula always holds
-always' :: Ltl a -> Ltl a
-always' = LtlRelease LtlFalsity
-
--- | Same as `ifPossible'`, but first wraps the input in an atomic formula
-ifPossible :: a -> Ltl a
-ifPossible = ifPossible' . LtlAtom
-
--- | Produces an Ltl formula which attempts to apply a certain formula but does
--- not fail in case it fails.
-ifPossible' :: Ltl a -> Ltl a
-ifPossible' f = f `LtlOr` LtlNot f
-
--- | Same as `whenPossible'`, but first wraps the input in an atomic formula
-whenPossible :: a -> Ltl a
-whenPossible = whenPossible' . LtlAtom
-
--- | Produces an Ltl formula which attempts to apply a certain formula whenever
--- possible, while ignoring steps when it is not.
-whenPossible' :: Ltl a -> Ltl a
-whenPossible' = always' . ifPossible'
-
--- | Same as `never'`, but first wraps the input in an atomic formula
-never :: a -> Ltl a
-never = never' . LtlAtom
-
--- | Produces an Ltl formula ensuring the given formula always fails
-never' :: Ltl a -> Ltl a
-never' = always' . LtlNot
-
--- | Same as `ltlImplies'` but first wraps the inputs in atoms
-ltlImplies :: a -> a -> Ltl a
-ltlImplies a1 a2 = LtlAtom a1 `ltlImplies'` LtlAtom a2
-
--- | Produces a formula that succeeds if the first formula fails, or if both
--- formulas hold
-ltlImplies' :: Ltl a -> Ltl a -> Ltl a
-ltlImplies' f1 f2 = (f2 `LtlAnd` f1) `LtlOr` LtlNot f1
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
index 50d0cf8a0..7e19ed117 100644
--- a/src/Cooked/MockChain/Staged.hs
+++ b/src/Cooked/MockChain/Staged.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-
 -- | This module provides a staged implementation of our `MonadBlockChain`. The
 -- motivation behind this is to be able to modify traces using `Cooked.Ltl` and
 -- `Cooked.Tweak` while they are interpreted.
@@ -30,7 +28,6 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Except
 import Cooked.Ltl
-import Cooked.Ltl.Combinators
 import Cooked.MockChain.BlockChain
 import Cooked.MockChain.Direct
 import Cooked.Pretty.Hashable
@@ -172,7 +169,7 @@ somewhere = somewhere' . fromTweak
 -- | Apply an Ltl modification somewhere in the given Trace. The modification
 -- must apply at least once.
 somewhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-somewhere' = modifyLtl . eventually'
+somewhere' = modifyLtl . ltlEventually
 
 -- | Apply a 'Tweak' to every transaction in a given trace. This is also
 -- successful if there are no transactions at all.
@@ -183,7 +180,7 @@ everywhere = everywhere' . fromTweak
 -- does not apply). If the modification branches, this will branch at every
 -- location the modification can be applied.
 everywhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-everywhere' = modifyLtl . always'
+everywhere' = modifyLtl . ltlAlways
 
 -- | Ensures a given 'Tweak' can never successfully be applied in a computation
 nowhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
@@ -191,7 +188,7 @@ nowhere = nowhere' . fromTweak
 
 -- | Ensures a given Ltl modification can never be applied on a computation
 nowhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-nowhere' = modifyLtl . never'
+nowhere' = modifyLtl . ltlNever
 
 -- | Apply a given 'Tweak' at every location in a computation where it does not
 -- fail, which might never occur.
@@ -201,7 +198,7 @@ whenAble = whenAble' . fromTweak
 -- | Apply an Ltl modification at every location in a computation where it is
 -- possible. Does not fail if no such position exists.
 whenAble' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-whenAble' = modifyLtl . whenPossible'
+whenAble' = modifyLtl . ltlWhenPossible
 
 -- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
 -- trace. Successful when this transaction exists and can be modified.
@@ -214,7 +211,7 @@ there n = there' n . fromTweak
 -- See also `Cooked.Tweak.Labels.labelled` to select transactions based on
 -- labels instead of their index.
 there' :: (MonadLtl mod m) => Integer -> Ltl mod -> m a -> m a
-there' n = modifyLtl . delay' n
+there' n = modifyLtl . ltlDelay n
 
 -- | Apply a 'Tweak' to the next transaction in the given trace. The order of
 -- arguments is reversed compared to 'somewhere' and 'everywhere', because that
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index e58a122f2..486fd34d1 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -1,11 +1,8 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-
 module Spec.Ltl where
 
 import Control.Monad
 import Control.Monad.Writer
 import Cooked.Ltl
-import Cooked.Ltl.Combinators
 import Cooked.MockChain.Testing
 import Data.Maybe
 import Test.Tasty
@@ -117,13 +114,13 @@ tests =
               testCase "Conjunction" $
                 go (modifyLtl (add1 `LtlAnd` add2) (emitInteger 3)) @?= [[3 + 1 + 2]],
               testCase "Implication when the first modification does not apply" $
-                go (modifyLtl (add1 `ltlImplies'` add2) (emitInteger 1)) @?= [[1]],
+                go (modifyLtl (add1 `ltlImplies` add2) (emitInteger 1)) @?= [[1]],
               testCase "Implication when both modifications apply" $
-                go (modifyLtl (add1 `ltlImplies'` add2) (emitInteger 3)) @?= [[3 + 1 + 2]],
+                go (modifyLtl (add1 `ltlImplies` add2) (emitInteger 3)) @?= [[3 + 1 + 2]],
               testCase "Implication when the first modification applies, but not the second" $
-                go (modifyLtl (add1 `ltlImplies'` add3) (emitInteger 2)) @?= [],
+                go (modifyLtl (add1 `ltlImplies` add3) (emitInteger 2)) @?= [],
               testCase "Implication backwards in time" $
-                go . modifyLtl (LtlNext add1 `ltlImplies'` add3) . mapM_ emitInteger
+                go . modifyLtl (LtlNext add1 `ltlImplies` add3) . mapM_ emitInteger
                   <$> [ [2, 4], -- add1 applies to 4, and add3 to 2, thus they are both performed
                         [2, 1], -- add1 does not apply to 1, thus add3 is not applied to 2, even though it could
                         [3, 1], -- add1 does not apply to 1, thus it does not matter that add3 does not apply to 3
@@ -156,7 +153,7 @@ tests =
                 incAll :: [[Integer]] -> [[Integer]]
                 incAll = map (map (+ n))
              in testAll
-                  (\tr -> assertSameSets (go $ modifyLtl (always (Add n)) tr) (incAll $ go tr))
+                  (\tr -> assertSameSets (go $ modifyLtl (ltlAlways' (Add n)) tr) (incAll $ go tr))
                   testTraces,
           testCase "somewhere case-splits" $
             let n = 3
@@ -166,12 +163,12 @@ tests =
                     alternatives [] = []
                     alternatives (x : xs) = (x + n : xs) : map (x :) (alternatives xs)
              in testAll
-                  (\tr -> assertSameSets (go $ modifyLtl (eventually (Add n)) tr) (caseSplit $ go tr))
+                  (\tr -> assertSameSets (go $ modifyLtl (ltlEventually' (Add n)) tr) (caseSplit $ go tr))
                   testTraces,
           testCase "somewhere is exponential in branch number" $
             let tr = emitInteger 42 >> emitInteger 3
              in assertSameSets
-                  (go $ modifyLtl (eventually (Add 1)) $ modifyLtl (eventually (Add 2)) tr)
+                  (go $ modifyLtl (ltlEventually' (Add 1)) $ modifyLtl (ltlEventually' (Add 2)) tr)
                   [ [42 + 1 + 2, 3],
                     [42, 3 + 1 + 2],
                     [42 + 1, 3 + 2],
@@ -184,11 +181,11 @@ tests =
           testCase "nested everywhere combines modifications" $
             assertSameSets
               ( go $ do
-                  modifyLtl (always (Add 1)) $ do
+                  modifyLtl (ltlAlways' (Add 1)) $ do
                     emitInteger 42
-                    modifyLtl (always (Add 2)) $ do
+                    modifyLtl (ltlAlways' (Add 2)) $ do
                       emitInteger 43
-                      modifyLtl (always (Add 3)) $ do
+                      modifyLtl (ltlAlways' (Add 3)) $ do
                         emitInteger 44
                       emitInteger 45
                     emitInteger 46
@@ -200,22 +197,22 @@ tests =
         "LTL Combinators"
         $ let traceSolo = emitInteger 24
               traceDuo = emitInteger 24 >> emitInteger 13
-           in [ testCase "anyOf" $
+           in [ testCase "ltlAny" $
                   assertSameSets
-                    (go $ modifyLtl (anyOf [Add 5, Mul 5]) traceSolo)
+                    (go $ modifyLtl (ltlAny' [Add 5, Mul 5]) traceSolo)
                     [ [24 + 5],
                       [24 * 5]
                     ],
-                testCase "anyOf [always, eventually]" $
+                testCase "ltlAny [ltlAlways, ltlEventually]" $
                   assertSameSets
-                    (go $ modifyLtl (anyOf' [always (Add 5), eventually (Mul 5)]) traceDuo)
+                    (go $ modifyLtl (ltlAny [ltlAlways' (Add 5), ltlEventually' (Mul 5)]) traceDuo)
                     [ [24 + 5, 13 + 5],
                       [24 * 5, 13],
                       [24, 13 * 5]
                     ],
-                testCase "anyOf [always anyOf, eventually anyOf]" $
+                testCase "ltlAny [ltlAlways ltlAny, ltlEventually ltlAny]" $
                   assertSameSets
-                    (go $ modifyLtl (anyOf' [always' (anyOf [Add 5, Mul 5]), eventually' (anyOf [Add 5, Mul 5])]) traceDuo)
+                    (go $ modifyLtl (ltlAny [ltlAlways (ltlAny' [Add 5, Mul 5]), ltlEventually (ltlAny' [Add 5, Mul 5])]) traceDuo)
                     [ [24 + 5, 13 + 5],
                       [24 + 5, 13 * 5],
                       [24 * 5, 13 * 5],
@@ -225,59 +222,59 @@ tests =
                       [24, 13 + 5],
                       [24, 13 * 5]
                     ],
-                testCase "allOf" $
+                testCase "ltlAll" $
                   assertSameSets
-                    (go $ modifyLtl (allOf [Add 5, Mul 5]) traceSolo)
+                    (go $ modifyLtl (ltlAll' [Add 5, Mul 5]) traceSolo)
                     [[24 * 5 + 5]],
-                testCase "allOf [anyOf, anyOf]" $
+                testCase "ltlAall [ltlAny, ltlAny]" $
                   assertSameSets
-                    (go $ modifyLtl (allOf' [anyOf [Add 5, Mul 5], anyOf [Add 5, Mul 5]]) traceSolo)
+                    (go $ modifyLtl (ltlAll [ltlAny' [Add 5, Mul 5], ltlAny' [Add 5, Mul 5]]) traceSolo)
                     [ [24 + 5 + 5],
                       [24 * 5 + 5],
                       [24 * 5 * 5],
                       [(24 + 5) * 5]
                     ],
-                testCase "delay (neg)" $
+                testCase "ltlDelay (neg)" $
                   assertSameSets
-                    (go $ modifyLtl (delay 0 (Add 5)) traceDuo)
-                    (go $ modifyLtl (delay (-10) (Add 5)) traceDuo),
-                testCase "delay (pos)" $
+                    (go $ modifyLtl (ltlDelay' 0 (Add 5)) traceDuo)
+                    (go $ modifyLtl (ltlDelay' (-10) (Add 5)) traceDuo),
+                testCase "ltlDelay' (pos)" $
                   assertSameSets
-                    (go $ modifyLtl (delay 1 (Add 5)) traceDuo)
+                    (go $ modifyLtl (ltlDelay' 1 (Add 5)) traceDuo)
                     [[24, 13 + 5]],
-                testCase "delay (anyOf [eventually, always])" $
+                testCase "ltlDelay (ltlAny [ltlEventually, ltlAlways])" $
                   assertSameSets
-                    (go $ modifyLtl (delay' 3 (anyOf' [eventually (Add 5), always (Mul 5)])) (traceDuo >> traceDuo >> traceDuo))
+                    (go $ modifyLtl (ltlDelay 3 (ltlAny [ltlEventually' (Add 5), ltlAlways' (Mul 5)])) (traceDuo >> traceDuo >> traceDuo))
                     [ [24, 13, 24, 13 + 5, 24, 13],
                       [24, 13, 24, 13, 24 + 5, 13],
                       [24, 13, 24, 13, 24, 13 + 5],
                       [24, 13, 24, 13 * 5, 24 * 5, 13 * 5]
                     ],
-                testCase "always fails if a step cannot be modified" $
+                testCase "ltlAlways fails if a step cannot be modified" $
                   assertSameSets
-                    (go $ modifyLtl (always (Add 5)) (traceDuo >> emitInteger 5))
+                    (go $ modifyLtl (ltlAlways' (Add 5)) (traceDuo >> emitInteger 5))
                     [],
-                testCase "eventually succeeds if a step cannot be modified" $
+                testCase "ltlEventually succeeds if a step cannot be modified" $
                   assertSameSets
-                    (go $ modifyLtl (eventually (Add 5)) (traceDuo >> emitInteger 5))
+                    (go $ modifyLtl (ltlEventually' (Add 5)) (traceDuo >> emitInteger 5))
                     [ [24 + 5, 13, 5],
                       [24, 13 + 5, 5]
                     ],
-                testCase "wherever possible succeeds if a few steps cannot be modified" $
+                testCase "ltlWheneverPossible succeeds if a few steps cannot be modified" $
                   assertSameSets
                     ( go $
                         modifyLtl
-                          (whenPossible (Add 5))
+                          (ltlWhenPossible' (Add 5))
                           (traceDuo >> emitInteger 5 >> emitInteger 5 >> traceDuo >> emitInteger 5 >> traceDuo)
                     )
                     [[24 + 5, 13 + 5, 5, 5, 24 + 5, 13 + 5, 5, 24 + 5, 13 + 5]],
-                testCase "never succeeds when no step can be modified..." $
+                testCase "ltlNever succeeds when no step can be modified..." $
                   assertSameSets
-                    (go $ modifyLtl (never (Add 5)) (replicateM 10 (emitInteger 5)))
+                    (go $ modifyLtl (ltlNever' (Add 5)) (replicateM 10 (emitInteger 5)))
                     [replicate 10 5],
                 testCase "... and fails otherwise" $
                   assertSameSets
-                    (go $ modifyLtl (never (Add 5)) $ modifyLtl (eventually (Add 1)) $ replicateM 10 (emitInteger 5))
+                    (go $ modifyLtl (ltlNever' (Add 5)) $ modifyLtl (ltlEventually' (Add 1)) $ replicateM 10 (emitInteger 5))
                     []
               ]
     ]

From faf0806407c2f161fda38d03867974e0808c0e1c Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sun, 11 Jan 2026 04:02:25 +0100
Subject: [PATCH 18/96] hm

---
 cooked-validators.cabal |   5 +-
 flake.lock              |  22 +++---
 package.yaml            |   1 +
 src/Cooked/Effectful.hs | 144 ++++++++++++++++++++++++++++++++++++++++
 src/Cooked/Ltl.hs       |   5 ++
 5 files changed, 165 insertions(+), 12 deletions(-)
 create mode 100644 src/Cooked/Effectful.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index b89a0059d..6cfec37af 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.4
 
--- This file has been generated from package.yaml by hpack version 0.38.2.
+-- This file has been generated from package.yaml by hpack version 0.38.3.
 --
 -- see: https://github.com/sol/hpack
 
@@ -17,6 +17,7 @@ library
       Cooked.Attack.AddToken
       Cooked.Attack.DatumHijacking
       Cooked.Attack.DoubleSat
+      Cooked.Effectful
       Cooked.InitialDistribution
       Cooked.Ltl
       Cooked.MockChain
@@ -143,6 +144,7 @@ library
     , plutus-script-utils
     , plutus-tx
     , plutus-tx-plugin
+    , polysemy
     , prettyprinter
     , random
     , random-shuffle
@@ -258,6 +260,7 @@ test-suite spec
     , plutus-script-utils
     , plutus-tx
     , plutus-tx-plugin
+    , polysemy
     , prettyprinter
     , random
     , random-shuffle
diff --git a/flake.lock b/flake.lock
index e5a6762f7..26c3b0607 100644
--- a/flake.lock
+++ b/flake.lock
@@ -3,15 +3,15 @@
     "flake-compat": {
       "flake": false,
       "locked": {
-        "lastModified": 1761588595,
-        "narHash": "sha256-XKUZz9zewJNUj46b4AJdiRZJAvSZ0Dqj2BNfXvFlJC4=",
-        "owner": "edolstra",
+        "lastModified": 1767039857,
+        "narHash": "sha256-vNpUSpF5Nuw8xvDLj2KCwwksIbjua2LZCqhV1LNRDns=",
+        "owner": "NixOS",
         "repo": "flake-compat",
-        "rev": "f387cd2afec9419c8ee37694406ca490c3f34ee5",
+        "rev": "5edf11c44bc78a0d334f6334cdaf7d60d732daab",
         "type": "github"
       },
       "original": {
-        "owner": "edolstra",
+        "owner": "NixOS",
         "repo": "flake-compat",
         "type": "github"
       }
@@ -57,11 +57,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1766062740,
-        "narHash": "sha256-U9KVTNs7PvyND7gisDMiluOfwT5hvOlMH2LTYfAYpNk=",
+        "lastModified": 1768098907,
+        "narHash": "sha256-TkfuFJbFtkNEUP1nCGIfxQ9b6DR0dfBuL9qJpjA2Law=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "6dc87b326cef973e51ed3d2ffbdbe6240917a7be",
+        "rev": "a35294706d389e52d1c756bc791cce891d2c7b93",
         "type": "github"
       },
       "original": {
@@ -79,11 +79,11 @@
         ]
       },
       "locked": {
-        "lastModified": 1765911976,
-        "narHash": "sha256-t3T/xm8zstHRLx+pIHxVpQTiySbKqcQbK+r+01XVKc0=",
+        "lastModified": 1767281941,
+        "narHash": "sha256-6MkqajPICgugsuZ92OMoQcgSHnD6sJHwk8AxvMcIgTE=",
         "owner": "cachix",
         "repo": "pre-commit-hooks.nix",
-        "rev": "b68b780b69702a090c8bb1b973bab13756cc7a27",
+        "rev": "f0927703b7b1c8d97511c4116eb9b4ec6645a0fa",
         "type": "github"
       },
       "original": {
diff --git a/package.yaml b/package.yaml
index 2dbfbd441..3e17d39f1 100644
--- a/package.yaml
+++ b/package.yaml
@@ -37,6 +37,7 @@ dependencies:
   - plutus-script-utils
   - plutus-tx
   - plutus-tx-plugin
+  - polysemy
   - prettyprinter
   - random
   - random-shuffle
diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
new file mode 100644
index 000000000..04aca7813
--- /dev/null
+++ b/src/Cooked/Effectful.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Cooked.Effectful where
+
+import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
+import Control.Monad (guard, msum, unless)
+import Cooked.Ltl (Ltl, Requirement, finished, nowLaterList)
+import Cooked.MockChain.BlockChain (MockChainError, MockChainLogEntry)
+import Cooked.MockChain.MockChainState (MockChainState)
+import Cooked.Pretty.Hashable (ToHash)
+import Cooked.Skeleton (ToVScript, TxSkel, TxSkelOut, VScript)
+import Data.Functor ((<&>))
+import Ledger.Slot qualified as Ledger
+import Ledger.Tx.CardanoAPI qualified as Ledger
+import Plutus.Script.Utils.Address qualified as Script
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Final
+import Polysemy.NonDet
+import Polysemy.State
+
+data ModifyGlobally a :: Effect where
+  ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
+
+makeSem ''ModifyGlobally
+
+runModifyGlobally ::
+  forall f r a.
+  (Members '[State [Ltl f], NonDet] r) =>
+  Sem (ModifyGlobally f ': r) a ->
+  Sem r a
+runModifyGlobally =
+  interpretH $ \case
+    ModifyLtl formula comp -> do
+      modify (formula :)
+      res <- runT comp
+      formulas <- get
+      unless (null formulas) $ do
+        guard (finished (head formulas))
+        put (tail formulas)
+      pureT res
+
+-- runModifyGlobally ::
+--   forall f effs a.
+--   ( State [Ltl f] :> effs,
+--     NonDet :> effs
+--   ) =>
+--   Eff (ModifyGlobally f : effs) a ->
+--   Eff effs a
+-- runModifyGlobally =
+--   interpret $
+--     \env (ModifyLtl formula comp) -> localSeqUnlift env $ \unlift -> do
+--       modify (formula :)
+--       res <- unlift comp
+--       formulas :: [Ltl f] <- get
+--       unless (null formulas) $ do
+--         guard $ finished $ head formulas
+--         put $ tail formulas
+--       return res
+
+-- data ModifyLocally a :: Effect where
+--   GetRequirements :: ModifyLocally a m [Requirement a]
+
+-- makeEffect ''ModifyLocally
+
+-- runModifyLocally ::
+--   forall f effs a.
+--   ( State [Ltl f] :> effs,
+--     NonDet :> effs
+--   ) =>
+--   Eff (ModifyLocally f : effs) a ->
+--   Eff effs a
+-- runModifyLocally =
+--   interpret $ \_ GetRequirements -> do
+--     modifications <- gets nowLaterList
+--     msum . (modifications <&>) $
+--       \(now, later) -> do
+--         put later
+--         return now
+
+-- data MockChainRead :: Effect where
+--   GetParams :: MockChainRead m Emulator.Params
+--   TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
+--   GetSlot :: MockChainRead m Ledger.Slot
+--   AllUtxos :: MockChainRead m [(Api.TxOutRef, TxSkelOut)]
+--   UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m [(Api.TxOutRef, TxSkelOut)]
+--   LogEvent :: MockChainLogEntry -> MockChainRead m ()
+--   Define :: (ToHash a) => String -> a -> MockChainRead m a
+--   GetConstitutionScript :: MockChainRead m (Maybe VScript)
+--   GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
+
+-- makeEffect ''MockChainRead
+
+-- data MockChainWrite :: Effect where
+--   WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
+--   SetParams :: Emulator.Params -> MockChainWrite m ()
+--   ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
+--   SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
+--   ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
+
+-- makeEffect ''MockChainWrite
+
+-- data Tweak :: Effect where
+--   GetTxSkel :: Tweak m TxSkel
+--   SetTxSkel :: TxSkel -> Tweak m ()
+
+-- makeEffect ''Tweak
+
+-- runTweak ::
+--   forall effs a.
+--   TxSkel ->
+--   Eff (Tweak : effs) a ->
+--   Eff effs TxSkel
+-- runTweak skel = reinterpret (execStateLocal skel) $ \_ -> \case
+--   GetTxSkel -> get
+--   SetTxSkel skel' -> put skel'
+
+-- data UntypedTweak effs where
+--   UntypedTweak :: Eff (Tweak : effs) a -> UntypedTweak effs
+
+-- runUntypedTweak ::
+--   forall effs.
+--   TxSkel ->
+--   UntypedTweak effs ->
+--   Eff effs TxSkel
+-- runUntypedTweak skel (UntypedTweak tweak) = runTweak skel tweak
+
+-- runMockChain ::
+--   forall effs a.
+--   ( ModifyLocally (UntypedTweak effs) :> effs,
+--     State MockChainState :> effs,
+--     Error MockChainError :> effs,
+--     Writer [MockChainLogEntry] :> effs,
+--     MockChainRead :> effs,
+--     Fail :> effs
+--   ) =>
+--   Eff (MockChainWrite : effs) a ->
+--   Eff effs a
+-- runMockChain = interpret $ \_ -> \case
+--   ValidateTxSkel skel -> do
+--     requirements :: [Requirement (UntypedTweak effs)] <- getRequirements
+--     undefined
+--   ForceOutputs outs -> undefined
+--   builtin -> undefined
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 125fdbda6..151f93d32 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -29,6 +29,10 @@ module Cooked.Ltl
     ltlNever,
     ltlNever',
 
+    -- * Functions on LTL formulas
+    finished,
+    nowLaterList,
+
     -- * Using LTL formulas to modify computations
     Requirement (..),
     LtlOp (..),
@@ -244,6 +248,7 @@ data Requirement a
     Apply a
   | -- | Ensure this modification fails now
     EnsureFailure a
+  deriving (Show, Eq)
 
 -- | For each LTL formula that describes a modification of a computation in a
 -- list, split it into a list of @(doNow, doLater)@ pairs, and then

From 94f605d43c2ec4cb3da6fbe06dc8b7564dce79c7 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sun, 18 Jan 2026 14:24:04 +0100
Subject: [PATCH 19/96] finished sketch

---
 cabal.project                  |   7 +-
 cooked-validators.cabal        |   8 +-
 flake.lock                     |   7 +-
 flake.nix                      |   9 +-
 package.yaml                   |   2 +
 src/Cooked/Effectful.hs        | 397 +++++++++++++++++++++++----------
 src/Cooked/MockChain/Direct.hs |   1 -
 src/Cooked/Tweak/Common.hs     |   9 +-
 8 files changed, 307 insertions(+), 133 deletions(-)

diff --git a/cabal.project b/cabal.project
index a1e1374a9..96f8dcdd0 100644
--- a/cabal.project
+++ b/cabal.project
@@ -46,8 +46,11 @@ package cardano-crypto-praos
   flags: -external-libsodium-vrf
   
 constraints:
-  cardano-api == 10.18.1.0
-  
+  , cardano-api == 10.18.1.0
+  , plutus-ledger-api == 1.45.0.0
+  , polysemy == 1.9.2.0
+  , polysemy-plugin == 0.4.5.3
+
 source-repository-package
     type: git
     location: https://github.com/intersectMBO/cardano-node-emulator
diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 6cfec37af..1ba83ead7 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.4
 
--- This file has been generated from package.yaml by hpack version 0.38.3.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -110,7 +110,7 @@ library
       TypeFamilies
       TypeOperators
       ViewPatterns
-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-missed-extra-shared-lib -fobject-code -fno-ignore-interface-pragmas -fignore-hpc-changes -fno-omit-interface-pragmas -fplugin-opt PlutusTx.Plugin:defer-errors -fplugin-opt PlutusTx.Plugin:conservative-optimisation
+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-missed-extra-shared-lib -fobject-code -fno-ignore-interface-pragmas -fignore-hpc-changes -fno-omit-interface-pragmas -fplugin-opt PlutusTx.Plugin:defer-errors -fplugin-opt PlutusTx.Plugin:conservative-optimisation -fplugin=Polysemy.Plugin
   build-depends:
       QuickCheck
     , base >=4.9 && <5
@@ -145,6 +145,7 @@ library
     , plutus-tx
     , plutus-tx-plugin
     , polysemy
+    , polysemy-plugin
     , prettyprinter
     , random
     , random-shuffle
@@ -225,7 +226,7 @@ test-suite spec
       TypeFamilies
       TypeOperators
       ViewPatterns
-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-missed-extra-shared-lib -fobject-code -fno-ignore-interface-pragmas -fignore-hpc-changes -fno-omit-interface-pragmas -fplugin-opt PlutusTx.Plugin:defer-errors -fplugin-opt PlutusTx.Plugin:conservative-optimisation
+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-missed-extra-shared-lib -fobject-code -fno-ignore-interface-pragmas -fignore-hpc-changes -fno-omit-interface-pragmas -fplugin-opt PlutusTx.Plugin:defer-errors -fplugin-opt PlutusTx.Plugin:conservative-optimisation -fplugin=Polysemy.Plugin
   build-depends:
       QuickCheck
     , base >=4.9 && <5
@@ -261,6 +262,7 @@ test-suite spec
     , plutus-tx
     , plutus-tx-plugin
     , polysemy
+    , polysemy-plugin
     , prettyprinter
     , random
     , random-shuffle
diff --git a/flake.lock b/flake.lock
index 26c3b0607..85ebc3f5a 100644
--- a/flake.lock
+++ b/flake.lock
@@ -57,16 +57,17 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1768098907,
-        "narHash": "sha256-TkfuFJbFtkNEUP1nCGIfxQ9b6DR0dfBuL9qJpjA2Law=",
+        "lastModified": 1750127977,
+        "narHash": "sha256-zD1OwL7YRiurl1NW16Ke88S7JStBfawbiY/DVpS28P4=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "a35294706d389e52d1c756bc791cce891d2c7b93",
+        "rev": "28ace32529a63842e4f8103e4f9b24960cf6c23a",
         "type": "github"
       },
       "original": {
         "owner": "NixOS",
         "repo": "nixpkgs",
+        "rev": "28ace32529a63842e4f8103e4f9b24960cf6c23a",
         "type": "github"
       }
     },
diff --git a/flake.nix b/flake.nix
index 4fa9ba993..e127efd5d 100644
--- a/flake.nix
+++ b/flake.nix
@@ -1,5 +1,6 @@
 {
-  inputs.nixpkgs.url = "github:NixOS/nixpkgs";
+  inputs.nixpkgs.url =
+    "github:NixOS/nixpkgs/28ace32529a63842e4f8103e4f9b24960cf6c23a";
   inputs.flake-utils.url = "github:numtide/flake-utils";
   inputs.pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix";
   inputs.pre-commit-hooks.inputs.nixpkgs.follows = "nixpkgs";
@@ -29,7 +30,7 @@
         pre-commit = pre-commit-hooks.lib.${system}.run {
           src = ./.;
           hooks = {
-            nixfmt-classic.enable = true;
+            nixfmt.enable = true;
             ormolu.enable = true;
             hpack.enable = true;
           };
@@ -46,7 +47,7 @@
           };
         };
       in {
-        formatter = pkgs.nixfmt-classic;
+        formatter = pkgs.nixfmt;
 
         devShells = let
           ## The minimal dependency set to build the project with `cabal`.
@@ -67,7 +68,7 @@
             pkgs.xz
             pkgs.zlib
             pkgs.lmdb
-            pkgs.openssl_3_6
+            pkgs.openssl_3_4
             pkgs.postgresql # For cardano-node-emulator
             pkgs.openldap # For freer-extras‽
             pkgs.libsodium
diff --git a/package.yaml b/package.yaml
index 3e17d39f1..281bba37c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -38,6 +38,7 @@ dependencies:
   - plutus-tx
   - plutus-tx-plugin
   - polysemy
+  - polysemy-plugin
   - prettyprinter
   - random
   - random-shuffle
@@ -63,6 +64,7 @@ library:
     -fno-omit-interface-pragmas
     -fplugin-opt PlutusTx.Plugin:defer-errors
     -fplugin-opt PlutusTx.Plugin:conservative-optimisation
+    -fplugin=Polysemy.Plugin
   default-extensions: &default-extensions
     - ConstraintKinds
     - DataKinds
diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index 04aca7813..86da4f65c 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -2,22 +2,30 @@
 
 module Cooked.Effectful where
 
-import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
+import Cardano.Api qualified as Cardano
+import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad (guard, msum, unless)
-import Cooked.Ltl (Ltl, Requirement, finished, nowLaterList)
-import Cooked.MockChain.BlockChain (MockChainError, MockChainLogEntry)
-import Cooked.MockChain.MockChainState (MockChainState)
-import Cooked.Pretty.Hashable (ToHash)
+import Cooked.Ltl (Ltl, Requirement (..), finished, nowLaterList)
+import Cooked.MockChain.BlockChain (MockChainError (..), MockChainLogEntry)
+import Cooked.MockChain.Direct (MockChainBook (..))
+import Cooked.MockChain.MockChainState (MockChainState (..), mcstConstitutionL, mcstLedgerStateL)
+import Cooked.Pretty.Hashable (ToHash, toHash)
 import Cooked.Skeleton (ToVScript, TxSkel, TxSkelOut, VScript)
-import Data.Functor ((<&>))
+import Data.Default
+import Data.Map qualified as Map
+import Data.Maybe (mapMaybe)
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx.CardanoAPI qualified as Ledger
+import Optics.Core
 import Plutus.Script.Utils.Address qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
-import Polysemy.Final
+import Polysemy.Error (Error, runError, throw)
+import Polysemy.Fail (Fail (Fail))
+import Polysemy.Internal.Combinators (stateful)
 import Polysemy.NonDet
 import Polysemy.State
+import Polysemy.Writer (Writer, runWriter, tell)
 
 data ModifyGlobally a :: Effect where
   ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
@@ -25,120 +33,277 @@ data ModifyGlobally a :: Effect where
 makeSem ''ModifyGlobally
 
 runModifyGlobally ::
-  forall f r a.
-  (Members '[State [Ltl f], NonDet] r) =>
-  Sem (ModifyGlobally f ': r) a ->
-  Sem r a
+  forall modification effs a.
+  (Members '[State [Ltl modification], NonDet] effs) =>
+  Sem (ModifyGlobally modification ': effs) a ->
+  Sem effs a
 runModifyGlobally =
   interpretH $ \case
     ModifyLtl formula comp -> do
       modify (formula :)
-      res <- runT comp
+      -- TODO : this is type-correct, but does it have the right semantics?
+      -- It seems weird to "run it twice" and recursively call the runner
+      -- that is currently being defined, which I assumed was already done
+      -- by "interpretH".
+      comp' <- runT comp
+      res <- raise $ runModifyGlobally comp'
       formulas <- get
       unless (null formulas) $ do
         guard (finished (head formulas))
         put (tail formulas)
-      pureT res
-
--- runModifyGlobally ::
---   forall f effs a.
---   ( State [Ltl f] :> effs,
---     NonDet :> effs
---   ) =>
---   Eff (ModifyGlobally f : effs) a ->
---   Eff effs a
--- runModifyGlobally =
---   interpret $
---     \env (ModifyLtl formula comp) -> localSeqUnlift env $ \unlift -> do
---       modify (formula :)
---       res <- unlift comp
---       formulas :: [Ltl f] <- get
---       unless (null formulas) $ do
---         guard $ finished $ head formulas
---         put $ tail formulas
---       return res
-
--- data ModifyLocally a :: Effect where
---   GetRequirements :: ModifyLocally a m [Requirement a]
-
--- makeEffect ''ModifyLocally
-
--- runModifyLocally ::
---   forall f effs a.
---   ( State [Ltl f] :> effs,
---     NonDet :> effs
---   ) =>
---   Eff (ModifyLocally f : effs) a ->
---   Eff effs a
--- runModifyLocally =
---   interpret $ \_ GetRequirements -> do
---     modifications <- gets nowLaterList
---     msum . (modifications <&>) $
---       \(now, later) -> do
---         put later
---         return now
-
--- data MockChainRead :: Effect where
---   GetParams :: MockChainRead m Emulator.Params
---   TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
---   GetSlot :: MockChainRead m Ledger.Slot
---   AllUtxos :: MockChainRead m [(Api.TxOutRef, TxSkelOut)]
---   UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m [(Api.TxOutRef, TxSkelOut)]
---   LogEvent :: MockChainLogEntry -> MockChainRead m ()
---   Define :: (ToHash a) => String -> a -> MockChainRead m a
---   GetConstitutionScript :: MockChainRead m (Maybe VScript)
---   GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
-
--- makeEffect ''MockChainRead
-
--- data MockChainWrite :: Effect where
---   WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
---   SetParams :: Emulator.Params -> MockChainWrite m ()
---   ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
---   SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
---   ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
-
--- makeEffect ''MockChainWrite
-
--- data Tweak :: Effect where
---   GetTxSkel :: Tweak m TxSkel
---   SetTxSkel :: TxSkel -> Tweak m ()
-
--- makeEffect ''Tweak
-
--- runTweak ::
---   forall effs a.
---   TxSkel ->
---   Eff (Tweak : effs) a ->
---   Eff effs TxSkel
--- runTweak skel = reinterpret (execStateLocal skel) $ \_ -> \case
---   GetTxSkel -> get
---   SetTxSkel skel' -> put skel'
-
--- data UntypedTweak effs where
---   UntypedTweak :: Eff (Tweak : effs) a -> UntypedTweak effs
-
--- runUntypedTweak ::
---   forall effs.
---   TxSkel ->
---   UntypedTweak effs ->
---   Eff effs TxSkel
--- runUntypedTweak skel (UntypedTweak tweak) = runTweak skel tweak
-
--- runMockChain ::
---   forall effs a.
---   ( ModifyLocally (UntypedTweak effs) :> effs,
---     State MockChainState :> effs,
---     Error MockChainError :> effs,
---     Writer [MockChainLogEntry] :> effs,
---     MockChainRead :> effs,
---     Fail :> effs
---   ) =>
---   Eff (MockChainWrite : effs) a ->
---   Eff effs a
--- runMockChain = interpret $ \_ -> \case
---   ValidateTxSkel skel -> do
---     requirements :: [Requirement (UntypedTweak effs)] <- getRequirements
---     undefined
---   ForceOutputs outs -> undefined
---   builtin -> undefined
+      return res
+
+data ModifyLocally a :: Effect where
+  GetRequirements :: ModifyLocally a m [Requirement a]
+
+makeSem ''ModifyLocally
+
+runModifyLocally ::
+  forall modification effs a.
+  ( Members
+      '[ State [Ltl modification],
+         NonDet
+       ]
+      effs
+  ) =>
+  Sem (ModifyLocally modification : effs) a ->
+  Sem effs a
+runModifyLocally =
+  interpret $ \GetRequirements -> do
+    modifications <- gets nowLaterList
+    msum . (modifications <&>) $ \(now, later) -> put later >> return now
+
+data MockChainRead :: Effect where
+  GetParams :: MockChainRead m Emulator.Params
+  TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
+  CurrentSlot :: MockChainRead m Ledger.Slot
+  AllUtxos :: MockChainRead m [(Api.TxOutRef, TxSkelOut)]
+  UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m [(Api.TxOutRef, TxSkelOut)]
+  LogEvent :: MockChainLogEntry -> MockChainRead m ()
+  Define :: (ToHash a) => String -> a -> MockChainRead m a
+  GetConstitutionScript :: MockChainRead m (Maybe VScript)
+  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
+
+makeSem ''MockChainRead
+
+data MockChainWrite :: Effect where
+  WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
+  SetParams :: Emulator.Params -> MockChainWrite m ()
+  ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
+  SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
+  ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
+
+makeSem ''MockChainWrite
+
+data Tweak :: Effect where
+  GetTxSkel :: Tweak m TxSkel
+  SetTxSkel :: TxSkel -> Tweak m ()
+
+makeSem ''Tweak
+
+runTweak ::
+  forall effs a.
+  TxSkel ->
+  Sem (Tweak : effs) a ->
+  Sem effs (TxSkel, a)
+-- TODO : is stateful the right helper? It seems I have to rewrite the state
+-- primitives by hand. Can we have something like reinterpret in effectful
+-- where we can temporarily use another effect like a state?
+runTweak = stateful $ \tweak skel -> return $
+  case tweak of
+    GetTxSkel -> (skel, skel)
+    SetTxSkel skel' -> (skel', ())
+
+data UntypedTweak effs where
+  UntypedTweak :: Sem (Tweak : NonDet : effs) a -> UntypedTweak effs
+
+runFail ::
+  forall effs a.
+  (Member (Error MockChainError) effs) =>
+  Sem (Fail : effs) a ->
+  Sem effs a
+runFail = interpret $ \case
+  Fail s -> throw $ FailWith s
+
+runMockChainRead ::
+  forall effs a.
+  ( Members
+      '[ State MockChainState,
+         Error MockChainError,
+         Writer MockChainBook,
+         Fail
+       ]
+      effs
+  ) =>
+  Sem (MockChainRead : effs) a ->
+  Sem effs a
+runMockChainRead = interpret $ \case
+  GetParams -> gets mcstParams
+  TxSkelOutByRef oRef -> do
+    res <- gets $ Map.lookup oRef . mcstOutputs
+    case res of
+      Just (txSkelOut, True) -> return txSkelOut
+      _ -> throw $ MCEUnknownOutRef oRef
+  AllUtxos ->
+    gets $
+      mapMaybe
+        ( \(oRef, (txSkelOut, isAvailable)) ->
+            if isAvailable
+              then
+                Just (oRef, txSkelOut)
+              else Nothing
+        )
+        . Map.toList
+        . mcstOutputs
+  UtxosAt (Script.toAddress -> addr) ->
+    gets $
+      mapMaybe
+        ( \(oRef, (txSkelOut, isAvailable)) ->
+            if isAvailable && Script.toAddress txSkelOut == addr
+              then
+                Just (oRef, txSkelOut)
+              else Nothing
+        )
+        . Map.toList
+        . mcstOutputs
+  LogEvent event -> tell $ MockChainBook [event] Map.empty
+  CurrentSlot -> gets (Emulator.getSlot . mcstLedgerState)
+  GetConstitutionScript -> gets (view mcstConstitutionL)
+  GetCurrentReward (Script.toCredential -> cred) -> do
+    stakeCredential <- undefined -- TODO [Not a question] I need MonadBlockChainBalancing instance (toStakeCredential cred)
+    gets
+      ( fmap (Api.Lovelace . Cardano.unCoin)
+          . Emulator.getReward stakeCredential
+          . view mcstLedgerStateL
+      )
+  Define name hashable -> tell (MockChainBook [] (Map.singleton (toHash hashable) name)) >> return hashable
+
+interceptMockChainWriteWithTweak ::
+  forall effs a.
+  ( Members
+      '[ ModifyLocally (UntypedTweak effs),
+         MockChainWrite,
+         NonDet
+       ]
+      effs
+  ) =>
+  Sem effs a ->
+  Sem effs a
+interceptMockChainWriteWithTweak = intercept @MockChainWrite $ \case
+  ValidateTxSkel skel -> do
+    requirements <- getRequirements
+    let sumTweak =
+          foldr
+            ( \req acc -> case req of
+                Apply (UntypedTweak tweak) -> tweak >> acc
+                EnsureFailure (UntypedTweak tweak) -> do
+                  txSkel' <- getTxSkel
+                  results <- raise_ $ runNonDet @[] $ runTweak txSkel' tweak
+                  -- TODO : there are 2 NonDet on the stack, which once
+                  -- will be used? I'm assuming the first occurrence, starting
+                  -- from the top of the stack.
+                  guard $ null results
+                  acc
+            )
+            (return ())
+            requirements
+    -- TODO : can we somehow use raise_, or something similar, to distinguish
+    -- between tweakEffs and effs
+    (newSkel, ()) <- subsume $ runTweak skel sumTweak
+    validateTxSkel newSkel
+  -- TODO : can we factor this ??
+  ForceOutputs outs -> forceOutputs outs
+  WaitNSlots n -> waitNSlots n
+  SetConstitutionScript script -> setConstitutionScript script
+  SetParams params -> setParams params
+
+runMockChainWrite ::
+  forall effs a.
+  ( Members
+      '[ State MockChainState,
+         Error MockChainError,
+         Writer MockChainBook,
+         MockChainRead,
+         Fail
+       ]
+      effs
+  ) =>
+  Sem (MockChainWrite : effs) a ->
+  Sem effs a
+runMockChainWrite = interpret $ \case
+  ValidateTxSkel skel -> do
+    undefined
+  ForceOutputs outs -> undefined
+  builtin -> undefined
+
+type MockChainDirect a =
+  Sem
+    '[ MockChainWrite,
+       MockChainRead,
+       Fail,
+       Error MockChainError,
+       State MockChainState,
+       Writer MockChainBook
+     ]
+    a
+
+runMockChainDirect ::
+  MockChainDirect a ->
+  (MockChainBook, (MockChainState, Either MockChainError a))
+runMockChainDirect =
+  run
+    . runWriter
+    . runState def
+    . runError
+    . runFail
+    . runMockChainRead
+    . runMockChainWrite
+
+-- TODO : what I want the users to see are
+
+-- * ModifyGlobally
+
+-- * MockChainWrite
+
+-- * MockChainRead
+
+-- * Fail
+
+-- * NonDet
+
+-- The rest should be hidden and only used for interpretation.
+-- I also want users to be able use their own effects on top
+-- (or at the bottom, what's the best option there?)
+-- of this stacks, such as a new state to manipulate.
+
+type MockChainFull eff a =
+  Sem
+    '[ ModifyGlobally (UntypedTweak eff),
+       MockChainWrite,
+       ModifyLocally (UntypedTweak eff),
+       State [Ltl (UntypedTweak eff)],
+       MockChainRead,
+       Fail,
+       Error MockChainError,
+       State MockChainState,
+       Writer MockChainBook,
+       NonDet
+     ]
+    a
+
+runMockChainFull ::
+  MockChainFull eff a ->
+  [(MockChainBook, (MockChainState, Either MockChainError a))]
+runMockChainFull =
+  run
+    . runNonDet
+    . runWriter
+    . runState def
+    . runError
+    . runFail
+    . runMockChainRead
+    . evalState []
+    . runModifyLocally
+    . runMockChainWrite
+    . interceptMockChainWriteWithTweak
+    . runModifyGlobally
diff --git a/src/Cooked/MockChain/Direct.hs b/src/Cooked/MockChain/Direct.hs
index 5c5ed3294..e7a07531e 100644
--- a/src/Cooked/MockChain/Direct.hs
+++ b/src/Cooked/MockChain/Direct.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveFunctor #-}
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
 -- | This module provides a direct (as opposed to 'Cooked.MockChain.Staged')
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index 838b56e13..c3207de08 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -26,6 +26,7 @@ module Cooked.Tweak.Common
   )
 where
 
+import Control.Applicative
 import Control.Arrow (second)
 import Control.Monad
 import Control.Monad.State
@@ -84,7 +85,7 @@ instance (MonadBlockChainWithoutValidation m) => MonadTweak (Tweak m) where
 -- together with mechanisms like 'Cooked.MockChain.Staged.withTweak',
 -- 'Cooked.MockChain.Staged.somewhere', or 'Cooked.MockChain.Staged.everywhere',
 -- you should never have a reason to use this function.
-runTweakInChain :: (MonadPlus m) => Tweak m a -> TxSkel -> m (a, TxSkel)
+runTweakInChain :: (Monad m, Alternative m) => Tweak m a -> TxSkel -> m (a, TxSkel)
 runTweakInChain tweak = ListT.alternate . runStateT tweak
 
 -- | Like 'runTweakInChain', but for when you want to explicitly apply a tweak
@@ -94,16 +95,16 @@ runTweakInChain tweak = ListT.alternate . runStateT tweak
 -- modified, consider using 'Cooked.MockChain.Staged.MonadModalBlockChain' and
 -- idioms like 'Cooked.MockChain.Staged.withTweak',
 -- 'Cooked.MockChain.Staged.somewhere', or 'Cooked.MockChain.Staged.everywhere'.
-runTweakInChain' :: (MonadPlus m) => Tweak m a -> TxSkel -> m [(a, TxSkel)]
+runTweakInChain' :: (Monad m) => Tweak m a -> TxSkel -> m [(a, TxSkel)]
 runTweakInChain' tweak = ListT.toList . runStateT tweak
 
 -- | Runs a 'Tweak' from a given 'TxSkel' within a mockchain
-runTweak :: (MonadPlus m) => Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
+runTweak :: (Monad m, Alternative m) => Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
 runTweak = runTweakFrom def
 
 -- | Runs a 'Tweak' from a given 'TxSkel' and 'InitialDistribution' within a
 -- mockchain
-runTweakFrom :: (MonadPlus m) => InitialDistribution -> Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
+runTweakFrom :: (Monad m, Alternative m) => InitialDistribution -> Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
 runTweakFrom initDist tweak = runMockChainTFromInitDist initDist . runTweakInChain tweak
 
 -- | This is a wrapper type used in the implementation of the Staged monad. You

From 3f09a58cc05eec81ba7d56d45a522e1a7c12e030 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sun, 18 Jan 2026 15:10:00 +0100
Subject: [PATCH 20/96] a more flexible version of handling tweaks

---
 src/Cooked/Effectful.hs | 71 ++++++++++++++++++++++++-----------------
 1 file changed, 42 insertions(+), 29 deletions(-)

diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index 86da4f65c..d7e44b674 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -11,6 +11,7 @@ import Cooked.MockChain.Direct (MockChainBook (..))
 import Cooked.MockChain.MockChainState (MockChainState (..), mcstConstitutionL, mcstLedgerStateL)
 import Cooked.Pretty.Hashable (ToHash, toHash)
 import Cooked.Skeleton (ToVScript, TxSkel, TxSkelOut, VScript)
+import Cooked.Skeleton.Families (type (++))
 import Data.Default
 import Data.Map qualified as Map
 import Data.Maybe (mapMaybe)
@@ -22,6 +23,7 @@ import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Error (Error, runError, throw)
 import Polysemy.Fail (Fail (Fail))
+import Polysemy.Internal (Raise)
 import Polysemy.Internal.Combinators (stateful)
 import Polysemy.NonDet
 import Polysemy.State
@@ -179,17 +181,27 @@ runMockChainRead = interpret $ \case
   Define name hashable -> tell (MockChainBook [] (Map.singleton (toHash hashable) name)) >> return hashable
 
 interceptMockChainWriteWithTweak ::
-  forall effs a.
+  forall tweakEffs effs a.
   ( Members
-      '[ ModifyLocally (UntypedTweak effs),
-         MockChainWrite,
+      '[ ModifyLocally (UntypedTweak tweakEffs),
          NonDet
        ]
-      effs
+      effs,
+    -- TODO : Ideally, I would want to avoid having a second NonDet in tweakEffs, and instead:
+    -- - Use the top NonDet when ensuring a tweak fails
+    -- - Forward to the NonDet in effs to apply tweaks
+    -- It seems I can't do it because of the limitations of Members and raise_
+    Member NonDet tweakEffs,
+    -- TODO : do we have a more flexible equivalent of raise (Typically Members) that
+    -- can be translated to some concrete transformations, like Raise allows?
+    Raise tweakEffs effs
   ) =>
-  Sem effs a ->
-  Sem effs a
-interceptMockChainWriteWithTweak = intercept @MockChainWrite $ \case
+  Sem (MockChainWrite : effs) a ->
+  Sem (MockChainWrite : effs) a
+-- TODO : I used reinterpret instead of intercept because it does not force
+-- the effect to be on top of the stack, which I do want. Is this the right
+-- way to proceed?
+interceptMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
   ValidateTxSkel skel -> do
     requirements <- getRequirements
     let sumTweak =
@@ -207,10 +219,10 @@ interceptMockChainWriteWithTweak = intercept @MockChainWrite $ \case
             )
             (return ())
             requirements
-    -- TODO : can we somehow use raise_, or something similar, to distinguish
-    -- between tweakEffs and effs
-    (newSkel, ()) <- subsume $ runTweak skel sumTweak
-    validateTxSkel newSkel
+        sumTweakRaised :: Sem effs TxSkel
+        sumTweakRaised = raise_ $ subsume $ fst <$> runTweak skel sumTweak
+    newTxSkel <- raise_ sumTweakRaised
+    validateTxSkel newTxSkel
   -- TODO : can we factor this ??
   ForceOutputs outs -> forceOutputs outs
   WaitNSlots n -> waitNSlots n
@@ -247,9 +259,7 @@ type MockChainDirect a =
      ]
     a
 
-runMockChainDirect ::
-  MockChainDirect a ->
-  (MockChainBook, (MockChainState, Either MockChainError a))
+runMockChainDirect :: MockChainDirect a -> (MockChainBook, (MockChainState, Either MockChainError a))
 runMockChainDirect =
   run
     . runWriter
@@ -276,24 +286,27 @@ runMockChainDirect =
 -- (or at the bottom, what's the best option there?)
 -- of this stacks, such as a new state to manipulate.
 
-type MockChainFull eff a =
+type BottomStack =
+  '[ MockChainRead,
+     Fail,
+     Error MockChainError,
+     State MockChainState,
+     Writer MockChainBook,
+     NonDet
+   ]
+
+type MockChainFull a =
   Sem
-    '[ ModifyGlobally (UntypedTweak eff),
-       MockChainWrite,
-       ModifyLocally (UntypedTweak eff),
-       State [Ltl (UntypedTweak eff)],
-       MockChainRead,
-       Fail,
-       Error MockChainError,
-       State MockChainState,
-       Writer MockChainBook,
-       NonDet
-     ]
+    ( [ ModifyGlobally (UntypedTweak BottomStack),
+        MockChainWrite,
+        ModifyLocally (UntypedTweak BottomStack),
+        State [Ltl (UntypedTweak BottomStack)]
+      ]
+        ++ BottomStack
+    )
     a
 
-runMockChainFull ::
-  MockChainFull eff a ->
-  [(MockChainBook, (MockChainState, Either MockChainError a))]
+runMockChainFull :: MockChainFull a -> [(MockChainBook, (MockChainState, Either MockChainError a))]
 runMockChainFull =
   run
     . runNonDet

From 1dc7f293901e6608dd634b9aa8a7d173065efda4 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 19 Jan 2026 01:16:51 +0100
Subject: [PATCH 21/96] moving families

---
 cooked-validators.cabal               |  2 +-
 src/Cooked/Effectful.hs               | 17 ++++++-----------
 src/Cooked/{Skeleton => }/Families.hs |  2 +-
 src/Cooked/Skeleton/Certificate.hs    |  2 +-
 src/Cooked/Skeleton/Output.hs         |  2 +-
 src/Cooked/Skeleton/User.hs           |  2 +-
 6 files changed, 11 insertions(+), 16 deletions(-)
 rename src/Cooked/{Skeleton => }/Families.hs (98%)

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 1ba83ead7..b068de84e 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -18,6 +18,7 @@ library
       Cooked.Attack.DatumHijacking
       Cooked.Attack.DoubleSat
       Cooked.Effectful
+      Cooked.Families
       Cooked.InitialDistribution
       Cooked.Ltl
       Cooked.MockChain
@@ -54,7 +55,6 @@ library
       Cooked.Skeleton.Anchor
       Cooked.Skeleton.Certificate
       Cooked.Skeleton.Datum
-      Cooked.Skeleton.Families
       Cooked.Skeleton.Label
       Cooked.Skeleton.Mint
       Cooked.Skeleton.Option
diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index d7e44b674..e3dbfa96a 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -5,13 +5,13 @@ module Cooked.Effectful where
 import Cardano.Api qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad (guard, msum, unless)
+import Cooked.Families (type (++))
 import Cooked.Ltl (Ltl, Requirement (..), finished, nowLaterList)
 import Cooked.MockChain.BlockChain (MockChainError (..), MockChainLogEntry)
 import Cooked.MockChain.Direct (MockChainBook (..))
 import Cooked.MockChain.MockChainState (MockChainState (..), mcstConstitutionL, mcstLedgerStateL)
 import Cooked.Pretty.Hashable (ToHash, toHash)
 import Cooked.Skeleton (ToVScript, TxSkel, TxSkelOut, VScript)
-import Cooked.Skeleton.Families (type (++))
 import Data.Default
 import Data.Map qualified as Map
 import Data.Maybe (mapMaybe)
@@ -270,16 +270,11 @@ runMockChainDirect =
     . runMockChainWrite
 
 -- TODO : what I want the users to see are
-
--- * ModifyGlobally
-
--- * MockChainWrite
-
--- * MockChainRead
-
--- * Fail
-
--- * NonDet
+-- - ModifyGlobally
+-- - MockChainWrite
+-- - MockChainRead
+-- - Fail
+-- - NonDet
 
 -- The rest should be hidden and only used for interpretation.
 -- I also want users to be able use their own effects on top
diff --git a/src/Cooked/Skeleton/Families.hs b/src/Cooked/Families.hs
similarity index 98%
rename from src/Cooked/Skeleton/Families.hs
rename to src/Cooked/Families.hs
index 3d3bde63b..0e5e1f4df 100644
--- a/src/Cooked/Skeleton/Families.hs
+++ b/src/Cooked/Families.hs
@@ -3,7 +3,7 @@
 -- | This module exposes some type families used to either directly constraint
 -- values within our skeletons, or constrant inputs of smart constructors for
 -- components of these skeletons.
-module Cooked.Skeleton.Families
+module Cooked.Families
   ( -- * Type-level constraints
     type (∈),
     type (∉),
diff --git a/src/Cooked/Skeleton/Certificate.hs b/src/Cooked/Skeleton/Certificate.hs
index 1ea3800db..21892c3ad 100644
--- a/src/Cooked/Skeleton/Certificate.hs
+++ b/src/Cooked/Skeleton/Certificate.hs
@@ -17,7 +17,7 @@ module Cooked.Skeleton.Certificate
   )
 where
 
-import Cooked.Skeleton.Families
+import Cooked.Families
 import Cooked.Skeleton.Redeemer
 import Cooked.Skeleton.User
 import Data.Kind (Type)
diff --git a/src/Cooked/Skeleton/Output.hs b/src/Cooked/Skeleton/Output.hs
index fe18a1cbf..770f74244 100644
--- a/src/Cooked/Skeleton/Output.hs
+++ b/src/Cooked/Skeleton/Output.hs
@@ -30,8 +30,8 @@ module Cooked.Skeleton.Output
   )
 where
 
+import Cooked.Families
 import Cooked.Skeleton.Datum
-import Cooked.Skeleton.Families
 import Cooked.Skeleton.User
 import Cooked.Skeleton.Value ()
 import Cooked.Wallet
diff --git a/src/Cooked/Skeleton/User.hs b/src/Cooked/Skeleton/User.hs
index e4824e8c1..3bbc70e62 100644
--- a/src/Cooked/Skeleton/User.hs
+++ b/src/Cooked/Skeleton/User.hs
@@ -35,7 +35,7 @@ module Cooked.Skeleton.User
   )
 where
 
-import Cooked.Skeleton.Families
+import Cooked.Families
 import Cooked.Skeleton.Redeemer
 import Data.Kind
 import Data.Typeable

From 7233b614cbe568b30d3d3e9a0c8aca6e1e6fa7bb Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 19 Jan 2026 01:53:16 +0100
Subject: [PATCH 22/96] comments

---
 src/Cooked/Effectful.hs | 120 ++++++++++++++++++++++++++++++----------
 1 file changed, 92 insertions(+), 28 deletions(-)

diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index e3dbfa96a..88de1f3cf 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -29,14 +29,29 @@ import Polysemy.NonDet
 import Polysemy.State
 import Polysemy.Writer (Writer, runWriter, tell)
 
+-- * ModifyGlobally
+
+-- | An effect to modify a computation with a Ltl Formula. The idea is that the
+-- formula pinpoints location where a modification should either be applied or
+-- yield an empty computation (when negated).
 data ModifyGlobally a :: Effect where
   ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
 
 makeSem ''ModifyGlobally
 
+-- | Running the `ModifyGlobally` effect requires to have access of the current
+-- list of Ltl formulas, and to be able to return an empty computation. A new
+-- formula is appended at the head of the current list of formula. Then, the
+-- actual computation is run, after which the newly added formula must be
+-- finished, otherwise the empty computation is returned.
 runModifyGlobally ::
   forall modification effs a.
-  (Members '[State [Ltl modification], NonDet] effs) =>
+  ( Members
+      '[ State [Ltl modification],
+         NonDet
+       ]
+      effs
+  ) =>
   Sem (ModifyGlobally modification ': effs) a ->
   Sem effs a
 runModifyGlobally =
@@ -55,11 +70,20 @@ runModifyGlobally =
         put (tail formulas)
       return res
 
+-- * ModifyLocally
+
+-- | An effect to request and consume the modifications to be applied at the
+-- current time step.
 data ModifyLocally a :: Effect where
   GetRequirements :: ModifyLocally a m [Requirement a]
 
 makeSem ''ModifyLocally
 
+-- | Running the `ModifyLocally` effect requires to have access of the current
+-- list of Ltl formulas, and to be able to branch. The function `nowLaterList`
+-- is invoked to fetch the various paths implied by the current formulas, and a
+-- branching is performed to explore all of them. The new formulas are stored,
+-- and each path is given the requirements to satisfy at the current time step.
 runModifyLocally ::
   forall modification effs a.
   ( Members
@@ -75,34 +99,16 @@ runModifyLocally =
     modifications <- gets nowLaterList
     msum . (modifications <&>) $ \(now, later) -> put later >> return now
 
-data MockChainRead :: Effect where
-  GetParams :: MockChainRead m Emulator.Params
-  TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
-  CurrentSlot :: MockChainRead m Ledger.Slot
-  AllUtxos :: MockChainRead m [(Api.TxOutRef, TxSkelOut)]
-  UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m [(Api.TxOutRef, TxSkelOut)]
-  LogEvent :: MockChainLogEntry -> MockChainRead m ()
-  Define :: (ToHash a) => String -> a -> MockChainRead m a
-  GetConstitutionScript :: MockChainRead m (Maybe VScript)
-  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
-
-makeSem ''MockChainRead
-
-data MockChainWrite :: Effect where
-  WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
-  SetParams :: Emulator.Params -> MockChainWrite m ()
-  ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
-  SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
-  ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
-
-makeSem ''MockChainWrite
+-- * Tweak
 
+-- | An effet that allows to store or retrieve a skeleton from the context
 data Tweak :: Effect where
   GetTxSkel :: Tweak m TxSkel
   SetTxSkel :: TxSkel -> Tweak m ()
 
 makeSem ''Tweak
 
+-- | Running a Tweak should be equivalent to running a state monad
 runTweak ::
   forall effs a.
   TxSkel ->
@@ -116,9 +122,21 @@ runTweak = stateful $ \tweak skel -> return $
     GetTxSkel -> (skel, skel)
     SetTxSkel skel' -> (skel', ())
 
+-- | An UntypedTweak does three things on top of tweaks:
+-- - It erases the return type of the computation
+-- - It stacks up a NonDet effect in the effects stacks
+-- - It makes the underlying effect stack visible in the type
+-- All of these will be useful to use them as modification.
 data UntypedTweak effs where
   UntypedTweak :: Sem (Tweak : NonDet : effs) a -> UntypedTweak effs
 
+-- * Fail
+
+-- | A possible semantics for fail that is interpreted in terms of Error. It
+-- could also technically be run in NonDet but the error message would be lost
+-- if transformed to mzero. This might not be the soundest interpretation, but
+-- this does the job. After all, the only use for this effect will be to allow
+-- partial assignments in our monadic setting.
 runFail ::
   forall effs a.
   (Member (Error MockChainError) effs) =>
@@ -127,13 +145,26 @@ runFail ::
 runFail = interpret $ \case
   Fail s -> throw $ FailWith s
 
+-- * MockChainRead
+
+-- | An effect that corresponds to querying the current state of the mockchain.
+data MockChainRead :: Effect where
+  GetParams :: MockChainRead m Emulator.Params
+  TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
+  CurrentSlot :: MockChainRead m Ledger.Slot
+  AllUtxos :: MockChainRead m [(Api.TxOutRef, TxSkelOut)]
+  UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m [(Api.TxOutRef, TxSkelOut)]
+  GetConstitutionScript :: MockChainRead m (Maybe VScript)
+  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
+
+makeSem ''MockChainRead
+
+-- | This interpretation is fully domain-based
 runMockChainRead ::
   forall effs a.
   ( Members
       '[ State MockChainState,
-         Error MockChainError,
-         Writer MockChainBook,
-         Fail
+         Error MockChainError
        ]
       effs
   ) =>
@@ -157,6 +188,9 @@ runMockChainRead = interpret $ \case
         )
         . Map.toList
         . mcstOutputs
+  -- TODO : I could technically reinterpret UtxosAt in terms of AllUtxos when it
+  -- is available (in the emulator) but I don't want to go through the hassle of
+  -- forwarding by hand all the other constructors.
   UtxosAt (Script.toAddress -> addr) ->
     gets $
       mapMaybe
@@ -168,18 +202,35 @@ runMockChainRead = interpret $ \case
         )
         . Map.toList
         . mcstOutputs
-  LogEvent event -> tell $ MockChainBook [event] Map.empty
   CurrentSlot -> gets (Emulator.getSlot . mcstLedgerState)
   GetConstitutionScript -> gets (view mcstConstitutionL)
   GetCurrentReward (Script.toCredential -> cred) -> do
-    stakeCredential <- undefined -- TODO [Not a question] I need MonadBlockChainBalancing instance (toStakeCredential cred)
+    stakeCredential <- undefined
     gets
       ( fmap (Api.Lovelace . Cardano.unCoin)
           . Emulator.getReward stakeCredential
           . view mcstLedgerStateL
       )
-  Define name hashable -> tell (MockChainBook [] (Map.singleton (toHash hashable) name)) >> return hashable
 
+-- * MockChainWrite
+
+-- | An effect that corresponds to all the primitives that are not
+-- read-only. They range from actual modification of the index state to storage
+-- of logging information.
+data MockChainWrite :: Effect where
+  WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
+  SetParams :: Emulator.Params -> MockChainWrite m ()
+  ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
+  SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
+  ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
+  LogEvent :: MockChainLogEntry -> MockChainWrite m ()
+  Define :: (ToHash a) => String -> a -> MockChainWrite m a
+
+makeSem ''MockChainWrite
+
+-- | 'MockChainWrite' is subject to be modified by UntypedTweak, when the event
+-- is a 'ValidateTxSkel'. To handle that we proposed a reinterpretation of the
+-- effect in itself, when the 'ModifyLocally' effect exists in the stack.
 interceptMockChainWriteWithTweak ::
   forall tweakEffs effs a.
   ( Members
@@ -228,7 +279,10 @@ interceptMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
   WaitNSlots n -> waitNSlots n
   SetConstitutionScript script -> setConstitutionScript script
   SetParams params -> setParams params
+  LogEvent event -> logEvent event
+  Define name hashable -> define name hashable
 
+-- | Interpreting the 'MockChainWrite' effect is purely domain-specific.
 runMockChainWrite ::
   forall effs a.
   ( Members
@@ -246,8 +300,14 @@ runMockChainWrite = interpret $ \case
   ValidateTxSkel skel -> do
     undefined
   ForceOutputs outs -> undefined
+  LogEvent event -> tell $ MockChainBook [event] Map.empty
+  Define name hashable -> tell (MockChainBook [] (Map.singleton (toHash hashable) name)) >> return hashable
   builtin -> undefined
 
+-- * MockChainDirect
+
+-- | A possible stack of effects to handle a direct interpretation of the
+-- mockchain, that is without any tweaks nor branching.
 type MockChainDirect a =
   Sem
     '[ MockChainWrite,
@@ -269,6 +329,8 @@ runMockChainDirect =
     . runMockChainRead
     . runMockChainWrite
 
+-- * MockChainFull
+
 -- TODO : what I want the users to see are
 -- - ModifyGlobally
 -- - MockChainWrite
@@ -290,6 +352,8 @@ type BottomStack =
      NonDet
    ]
 
+-- | A possible stack of effects to handle staged interpretation of the
+-- mockchain, that is with tweaks and branching.
 type MockChainFull a =
   Sem
     ( [ ModifyGlobally (UntypedTweak BottomStack),

From bf73eead9c175e7acdaf27d8bf3293ac826f976d Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 19 Jan 2026 02:01:23 +0100
Subject: [PATCH 23/96] comments

---
 src/Cooked/Effectful.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index 88de1f3cf..8fed09658 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -343,6 +343,9 @@ runMockChainDirect =
 -- (or at the bottom, what's the best option there?)
 -- of this stacks, such as a new state to manipulate.
 
+-- Should I keep a "MonadBlockChain" type class?. With instance
+-- "MockChainDirect" and "MockChainFull"?
+
 type BottomStack =
   '[ MockChainRead,
      Fail,

From cdc88f92336db0254cebb818e9c38d3ae9196918 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 19 Jan 2026 02:17:18 +0100
Subject: [PATCH 24/96] running tweaks

---
 src/Cooked/Effectful.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index 8fed09658..bf4e4567a 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -114,13 +114,13 @@ runTweak ::
   TxSkel ->
   Sem (Tweak : effs) a ->
   Sem effs (TxSkel, a)
--- TODO : is stateful the right helper? It seems I have to rewrite the state
--- primitives by hand. Can we have something like reinterpret in effectful
--- where we can temporarily use another effect like a state?
-runTweak = stateful $ \tweak skel -> return $
-  case tweak of
-    GetTxSkel -> (skel, skel)
-    SetTxSkel skel' -> (skel', ())
+runTweak txSkel =
+  runState txSkel
+    . reinterpret
+      ( \case
+          GetTxSkel -> get
+          SetTxSkel skel -> put skel
+      )
 
 -- | An UntypedTweak does three things on top of tweaks:
 -- - It erases the return type of the computation

From 6bcce61e5dafc0af2fa9557064b81d53ff316129 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 20 Jan 2026 17:53:31 +0100
Subject: [PATCH 25/96] Ltl

---
 src/Cooked/Effectful.hs | 212 +++++++++++++++++++---------------------
 src/Cooked/Ltl.hs       | 146 +++++++++++++--------------
 2 files changed, 168 insertions(+), 190 deletions(-)

diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index bf4e4567a..54782029e 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -5,13 +5,13 @@ module Cooked.Effectful where
 import Cardano.Api qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad (guard, msum, unless)
-import Cooked.Families (type (++))
 import Cooked.Ltl (Ltl, Requirement (..), finished, nowLaterList)
 import Cooked.MockChain.BlockChain (MockChainError (..), MockChainLogEntry)
 import Cooked.MockChain.Direct (MockChainBook (..))
 import Cooked.MockChain.MockChainState (MockChainState (..), mcstConstitutionL, mcstLedgerStateL)
 import Cooked.Pretty.Hashable (ToHash, toHash)
 import Cooked.Skeleton (ToVScript, TxSkel, TxSkelOut, VScript)
+import Data.Coerce
 import Data.Default
 import Data.Map qualified as Map
 import Data.Maybe (mapMaybe)
@@ -21,30 +21,29 @@ import Optics.Core
 import Plutus.Script.Utils.Address qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
-import Polysemy.Error (Error, runError, throw)
+import Polysemy.Error (Error (..), mapError, runError, throw)
 import Polysemy.Fail (Fail (Fail))
-import Polysemy.Internal (Raise)
-import Polysemy.Internal.Combinators (stateful)
+import Polysemy.Internal (Subsume)
 import Polysemy.NonDet
 import Polysemy.State
 import Polysemy.Writer (Writer, runWriter, tell)
 
--- * ModifyGlobally
+-- * ModifyOnTime
 
 -- | An effect to modify a computation with a Ltl Formula. The idea is that the
 -- formula pinpoints location where a modification should either be applied or
 -- yield an empty computation (when negated).
-data ModifyGlobally a :: Effect where
-  ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
+data ModifyOnTime a :: Effect where
+  ModifyLtl :: Ltl a -> m b -> ModifyOnTime a m b
 
-makeSem ''ModifyGlobally
+makeSem ''ModifyOnTime
 
--- | Running the `ModifyGlobally` effect requires to have access of the current
+-- | Running the `ModifyOnTime` effect requires to have access of the current
 -- list of Ltl formulas, and to be able to return an empty computation. A new
 -- formula is appended at the head of the current list of formula. Then, the
 -- actual computation is run, after which the newly added formula must be
 -- finished, otherwise the empty computation is returned.
-runModifyGlobally ::
+runModifyOnTime ::
   forall modification effs a.
   ( Members
       '[ State [Ltl modification],
@@ -52,18 +51,14 @@ runModifyGlobally ::
        ]
       effs
   ) =>
-  Sem (ModifyGlobally modification ': effs) a ->
+  Sem (ModifyOnTime modification ': effs) a ->
   Sem effs a
-runModifyGlobally =
+runModifyOnTime =
   interpretH $ \case
     ModifyLtl formula comp -> do
       modify (formula :)
-      -- TODO : this is type-correct, but does it have the right semantics?
-      -- It seems weird to "run it twice" and recursively call the runner
-      -- that is currently being defined, which I assumed was already done
-      -- by "interpretH".
       comp' <- runT comp
-      res <- raise $ runModifyGlobally comp'
+      res <- raise $ runModifyOnTime comp'
       formulas <- get
       unless (null formulas) $ do
         guard (finished (head formulas))
@@ -130,6 +125,15 @@ runTweak txSkel =
 data UntypedTweak effs where
   UntypedTweak :: Sem (Tweak : NonDet : effs) a -> UntypedTweak effs
 
+-- * ToCardanoError
+
+runToCardanoError ::
+  forall effs a.
+  (Member (Error MockChainError) effs) =>
+  Sem (Error Ledger.ToCardanoError : effs) a ->
+  Sem effs a
+runToCardanoError = mapError (MCEToCardanoError "")
+
 -- * Fail
 
 -- | A possible semantics for fail that is interpreted in terms of Error. It
@@ -137,13 +141,31 @@ data UntypedTweak effs where
 -- if transformed to mzero. This might not be the soundest interpretation, but
 -- this does the job. After all, the only use for this effect will be to allow
 -- partial assignments in our monadic setting.
-runFail ::
+runFailInMockChainError ::
   forall effs a.
   (Member (Error MockChainError) effs) =>
   Sem (Fail : effs) a ->
   Sem effs a
-runFail = interpret $ \case
-  Fail s -> throw $ FailWith s
+runFailInMockChainError = interpret $
+  \(Fail s) -> throw $ FailWith s
+
+-- * MockChainMisc
+
+-- | An effect that corresponds to extra QOL capabilities of the MockChain
+data MockChainMisc :: Effect where
+  Define :: (ToHash a) => String -> a -> MockChainMisc m a
+
+makeSem ''MockChainMisc
+
+runMockChainMisc ::
+  forall effs a.
+  (Member (Writer MockChainBook) effs) =>
+  Sem (MockChainMisc : effs) a ->
+  Sem effs a
+runMockChainMisc = interpret $
+  \(Define name hashable) -> do
+    tell (MockChainBook [] (Map.singleton (toHash hashable) name))
+    return hashable
 
 -- * MockChainRead
 
@@ -159,11 +181,12 @@ data MockChainRead :: Effect where
 
 makeSem ''MockChainRead
 
--- | This interpretation is fully domain-based
+-- | The interpretation for read-only effect in the blockchain state
 runMockChainRead ::
   forall effs a.
   ( Members
       '[ State MockChainState,
+         Error Ledger.ToCardanoError,
          Error MockChainError
        ]
       effs
@@ -177,31 +200,8 @@ runMockChainRead = interpret $ \case
     case res of
       Just (txSkelOut, True) -> return txSkelOut
       _ -> throw $ MCEUnknownOutRef oRef
-  AllUtxos ->
-    gets $
-      mapMaybe
-        ( \(oRef, (txSkelOut, isAvailable)) ->
-            if isAvailable
-              then
-                Just (oRef, txSkelOut)
-              else Nothing
-        )
-        . Map.toList
-        . mcstOutputs
-  -- TODO : I could technically reinterpret UtxosAt in terms of AllUtxos when it
-  -- is available (in the emulator) but I don't want to go through the hassle of
-  -- forwarding by hand all the other constructors.
-  UtxosAt (Script.toAddress -> addr) ->
-    gets $
-      mapMaybe
-        ( \(oRef, (txSkelOut, isAvailable)) ->
-            if isAvailable && Script.toAddress txSkelOut == addr
-              then
-                Just (oRef, txSkelOut)
-              else Nothing
-        )
-        . Map.toList
-        . mcstOutputs
+  AllUtxos -> fetchUtxos (const True)
+  UtxosAt (Script.toAddress -> addr) -> fetchUtxos ((== addr) . Script.toAddress)
   CurrentSlot -> gets (Emulator.getSlot . mcstLedgerState)
   GetConstitutionScript -> gets (view mcstConstitutionL)
   GetCurrentReward (Script.toCredential -> cred) -> do
@@ -211,6 +211,31 @@ runMockChainRead = interpret $ \case
           . Emulator.getReward stakeCredential
           . view mcstLedgerStateL
       )
+  where
+    fetchUtxos decide =
+      gets $
+        mapMaybe
+          ( \(oRef, (txSkelOut, isAvailable)) ->
+              if isAvailable && decide txSkelOut then Just (oRef, txSkelOut) else Nothing
+          )
+          . Map.toList
+          . mcstOutputs
+
+-- * MockChainLog
+
+-- | An effect to allow logging of mockchain events
+data MockChainLog :: Effect where
+  LogEvent :: MockChainLogEntry -> MockChainLog m ()
+
+makeSem ''MockChainLog
+
+runMockChainLog ::
+  forall effs a.
+  (Member (Writer MockChainBook) effs) =>
+  Sem (MockChainLog : effs) a ->
+  Sem effs a
+runMockChainLog = interpret $
+  \(LogEvent event) -> tell $ MockChainBook [event] Map.empty
 
 -- * MockChainWrite
 
@@ -223,8 +248,6 @@ data MockChainWrite :: Effect where
   ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
   SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
   ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
-  LogEvent :: MockChainLogEntry -> MockChainWrite m ()
-  Define :: (ToHash a) => String -> a -> MockChainWrite m a
 
 makeSem ''MockChainWrite
 
@@ -238,57 +261,37 @@ interceptMockChainWriteWithTweak ::
          NonDet
        ]
       effs,
-    -- TODO : Ideally, I would want to avoid having a second NonDet in tweakEffs, and instead:
-    -- - Use the top NonDet when ensuring a tweak fails
-    -- - Forward to the NonDet in effs to apply tweaks
-    -- It seems I can't do it because of the limitations of Members and raise_
-    Member NonDet tweakEffs,
-    -- TODO : do we have a more flexible equivalent of raise (Typically Members) that
-    -- can be translated to some concrete transformations, like Raise allows?
-    Raise tweakEffs effs
+    Subsume tweakEffs effs
   ) =>
   Sem (MockChainWrite : effs) a ->
   Sem (MockChainWrite : effs) a
--- TODO : I used reinterpret instead of intercept because it does not force
--- the effect to be on top of the stack, which I do want. Is this the right
--- way to proceed?
 interceptMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
   ValidateTxSkel skel -> do
     requirements <- getRequirements
-    let sumTweak =
+    let sumTweak :: Sem (Tweak : NonDet : tweakEffs) () =
           foldr
             ( \req acc -> case req of
                 Apply (UntypedTweak tweak) -> tweak >> acc
                 EnsureFailure (UntypedTweak tweak) -> do
                   txSkel' <- getTxSkel
                   results <- raise_ $ runNonDet @[] $ runTweak txSkel' tweak
-                  -- TODO : there are 2 NonDet on the stack, which once
-                  -- will be used? I'm assuming the first occurrence, starting
-                  -- from the top of the stack.
                   guard $ null results
                   acc
             )
             (return ())
             requirements
-        sumTweakRaised :: Sem effs TxSkel
-        sumTweakRaised = raise_ $ subsume $ fst <$> runTweak skel sumTweak
-    newTxSkel <- raise_ sumTweakRaised
+    newTxSkel <- raise $ subsume_ $ fst <$> runTweak skel sumTweak
     validateTxSkel newTxSkel
-  -- TODO : can we factor this ??
-  ForceOutputs outs -> forceOutputs outs
-  WaitNSlots n -> waitNSlots n
-  SetConstitutionScript script -> setConstitutionScript script
-  SetParams params -> setParams params
-  LogEvent event -> logEvent event
-  Define name hashable -> define name hashable
+  a -> send $ coerce a
 
 -- | Interpreting the 'MockChainWrite' effect is purely domain-specific.
 runMockChainWrite ::
   forall effs a.
   ( Members
       '[ State MockChainState,
+         Error Ledger.ToCardanoError,
          Error MockChainError,
-         Writer MockChainBook,
+         MockChainLog,
          MockChainRead,
          Fail
        ]
@@ -300,8 +303,6 @@ runMockChainWrite = interpret $ \case
   ValidateTxSkel skel -> do
     undefined
   ForceOutputs outs -> undefined
-  LogEvent event -> tell $ MockChainBook [event] Map.empty
-  Define name hashable -> tell (MockChainBook [] (Map.singleton (toHash hashable) name)) >> return hashable
   builtin -> undefined
 
 -- * MockChainDirect
@@ -312,10 +313,8 @@ type MockChainDirect a =
   Sem
     '[ MockChainWrite,
        MockChainRead,
-       Fail,
-       Error MockChainError,
-       State MockChainState,
-       Writer MockChainBook
+       MockChainMisc,
+       Fail
      ]
     a
 
@@ -323,49 +322,31 @@ runMockChainDirect :: MockChainDirect a -> (MockChainBook, (MockChainState, Eith
 runMockChainDirect =
   run
     . runWriter
+    . runMockChainLog
     . runState def
     . runError
-    . runFail
+    . runToCardanoError
+    . runFailInMockChainError
+    . runMockChainMisc
     . runMockChainRead
     . runMockChainWrite
+    . insertAt @4 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
 
 -- * MockChainFull
 
--- TODO : what I want the users to see are
--- - ModifyGlobally
--- - MockChainWrite
--- - MockChainRead
--- - Fail
--- - NonDet
-
--- The rest should be hidden and only used for interpretation.
--- I also want users to be able use their own effects on top
--- (or at the bottom, what's the best option there?)
--- of this stacks, such as a new state to manipulate.
-
--- Should I keep a "MonadBlockChain" type class?. With instance
--- "MockChainDirect" and "MockChainFull"?
-
-type BottomStack =
-  '[ MockChainRead,
-     Fail,
-     Error MockChainError,
-     State MockChainState,
-     Writer MockChainBook,
-     NonDet
-   ]
+type TweakStack = '[MockChainRead, Fail, NonDet]
 
 -- | A possible stack of effects to handle staged interpretation of the
 -- mockchain, that is with tweaks and branching.
 type MockChainFull a =
   Sem
-    ( [ ModifyGlobally (UntypedTweak BottomStack),
-        MockChainWrite,
-        ModifyLocally (UntypedTweak BottomStack),
-        State [Ltl (UntypedTweak BottomStack)]
-      ]
-        ++ BottomStack
-    )
+    [ ModifyOnTime (UntypedTweak TweakStack),
+      MockChainWrite,
+      MockChainMisc,
+      MockChainRead,
+      Fail,
+      NonDet
+    ]
     a
 
 runMockChainFull :: MockChainFull a -> [(MockChainBook, (MockChainState, Either MockChainError a))]
@@ -373,12 +354,17 @@ runMockChainFull =
   run
     . runNonDet
     . runWriter
+    . runMockChainLog
     . runState def
     . runError
-    . runFail
+    . runToCardanoError
+    . runFailInMockChainError
     . runMockChainRead
+    . runMockChainMisc
     . evalState []
     . runModifyLocally
     . runMockChainWrite
+    . insertAt @6 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
     . interceptMockChainWriteWithTweak
-    . runModifyGlobally
+    . runModifyOnTime
+    . insertAt @2 @[ModifyLocally (UntypedTweak TweakStack), State [Ltl (UntypedTweak TweakStack)]]
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 151f93d32..b880f7552 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 -- | This modules provides the infrastructure to modify sequences of
 -- transactions using LTL formulaes with atomic modifications. This idea is to
 -- describe when to apply certain modifications within a trace.
@@ -35,20 +37,20 @@ module Cooked.Ltl
 
     -- * Using LTL formulas to modify computations
     Requirement (..),
-    LtlOp (..),
-    StagedLtl,
-    singletonBuiltin,
-    MonadLtl (..),
-    ModInterpBuiltin (..),
-    interpStagedLtl,
+    ModifyGlobally (..),
+    modifyLtl,
+    runModifyGlobally,
+    ModifyLocally,
+    getRequirements,
+    runModifyLocally,
   )
 where
 
 import Control.Monad
-import Control.Monad.State
-import Cooked.Staged
 import Data.Functor
-import Data.Kind
+import Polysemy
+import Polysemy.NonDet
+import Polysemy.State
 
 -- | Type of LTL formulas with atomic formulas of type @a@. Think of @a@ as a
 -- type of "modifications", then a value of type @Ltl a@ describes where to
@@ -306,76 +308,66 @@ finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
 finished (LtlNot f) = not $ finished f
 
--- | Operations that either allow to use a builtin, or to modify a computation
--- using an `Ltl` formula.
-data LtlOp modification builtin :: Type -> Type where
-  WrapLtl :: Ltl modification -> StagedLtl modification builtin a -> LtlOp modification builtin a
-  Builtin :: builtin a -> LtlOp modification builtin a
-
--- | An AST of builtins wrapped into an `Ltl` setting
-type StagedLtl modification builtin = Staged (LtlOp modification builtin)
-
--- | Builds a singleton instruction in a `StagedLtl` monad
-singletonBuiltin :: builtin a -> StagedLtl modification builtin a
-singletonBuiltin = (`Instr` Return) . Builtin
-
--- | Depicts the ability to modify a computation with an `Ltl` formula
-class (Monad m) => MonadLtl modification m where
-  modifyLtl :: Ltl modification -> m a -> m a
-
-instance MonadLtl modification (StagedLtl modification builtin) where
-  modifyLtl formula comp = Instr (WrapLtl formula comp) Return
+-- | An effect to modify a computation with an `Ltl` Formula. The idea is that
+-- the formula pinpoints locations where `Requirement`s should be enforced.
+data ModifyGlobally a :: Effect where
+  ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
 
--- | Depicts the ability to modify and interpret builtins in a given
--- domain. Each builtin can either:
---
--- * be interpreted directly through @Left@, in which case it will not be
---   considered as a timestep in a trace.
---
--- * be modified and only then interpreted through @Right@, in which case it
---   will be considered as a timestep in a trace.
-class ModInterpBuiltin modification builtin m where
-  modifyAndInterpBuiltin :: builtin a -> Either (m a) ([Requirement modification] -> m a)
+makeSem ''ModifyGlobally
 
--- | Interprets a `StagedLtl` computation based on an interpretation of
--- @builtin@ with respect to possible modifications. This unfolds as follows:
---
--- * When a builtin is met, which is directly interpreted, we return the
---   associated computation, with no changes to the `Ltl` state.
+-- | Running the `ModifyGlobally` effect requires to have access of the current
+-- list of `Ltl` formulas, and to have access to an empty computation.
 --
--- * When a builtin is met, which requires a modification, we return the
---   modified interpretation, and consume the current modification requirements.
+-- A new formula is appended at the head of the current list of formula. Then,
+-- the actual computation is run, after which the newly added formula must be
+-- finished, otherwise the empty computation is returned.
+runModifyGlobally ::
+  forall modification effs a.
+  ( Members
+      '[ State [Ltl modification],
+         NonDet
+       ]
+      effs
+  ) =>
+  Sem (ModifyGlobally modification ': effs) a ->
+  Sem effs a
+runModifyGlobally =
+  interpretH $ \case
+    ModifyLtl formula comp -> do
+      modify (formula :)
+      comp' <- runT comp
+      res <- raise $ runModifyGlobally comp'
+      formulas <- get
+      unless (null formulas) $ do
+        guard (finished (head formulas))
+        put (tail formulas)
+      return res
+
+-- | An effect to request and consume the list of requirements that should be
+-- enforced at the current time step.
+data ModifyLocally a :: Effect where
+  GetRequirements :: ModifyLocally a m [Requirement a]
+
+makeSem ''ModifyLocally
+
+-- | Running the `ModifyLocally` effect requires to have access to the current
+-- list of `Ltl` formulas, and to be able to branch.
 --
--- * When a wrapped computation is met, we store the new associated formula, and
---   ensure that when the computation ends, the formula is finished.
-interpStagedLtl ::
-  forall modification builtin m.
-  ( MonadPlus m,
-    ModInterpBuiltin modification builtin m
+-- The function `nowLaterList` is invoked to fetch the various paths implied by
+-- the current formulas, and a branching is performed to explore all of
+-- them. The new formulas for next steps are stored, and each path is given the
+-- requirements to enforce at the current time step.
+runModifyLocally ::
+  forall modification effs a.
+  ( Members
+      '[ State [Ltl modification],
+         NonDet
+       ]
+      effs
   ) =>
-  forall a.
-  -- | A staged computation `Ltl` compatible
-  StagedLtl modification builtin a ->
-  -- | Interpretation of the computation
-  m a
-interpStagedLtl = flip evalStateT [] . go
-  where
-    go :: forall a. Staged (LtlOp modification builtin) a -> StateT [Ltl modification] m a
-    go = interpStaged $ \case
-      WrapLtl formula comp -> do
-        modify' (formula :)
-        res <- go comp
-        formulas <- get
-        unless (null formulas) $ do
-          guard $ finished $ head formulas
-          put $ tail formulas
-        return res
-      Builtin builtin ->
-        case modifyAndInterpBuiltin builtin of
-          Left comp -> lift comp
-          Right applyMod -> do
-            modifications <- gets nowLaterList
-            msum . (modifications <&>) $
-              \(now, later) -> do
-                put later
-                lift $ applyMod now
+  Sem (ModifyLocally modification : effs) a ->
+  Sem effs a
+runModifyLocally =
+  interpret $ \GetRequirements -> do
+    modifications <- gets nowLaterList
+    msum . (modifications <&>) $ \(now, later) -> put later >> return now

From dea340acd4aec1d385e25674503b10475f72e339 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 20 Jan 2026 17:53:48 +0100
Subject: [PATCH 26/96] no more Staged

---
 cooked-validators.cabal |  1 -
 src/Cooked.hs           |  1 -
 src/Cooked/Staged.hs    | 33 ---------------------------------
 3 files changed, 35 deletions(-)
 delete mode 100644 src/Cooked/Staged.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index b068de84e..c8b1c6acb 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -65,7 +65,6 @@ library
       Cooked.Skeleton.User
       Cooked.Skeleton.Value
       Cooked.Skeleton.Withdrawal
-      Cooked.Staged
       Cooked.Tweak
       Cooked.Tweak.Common
       Cooked.Tweak.Inputs
diff --git a/src/Cooked.hs b/src/Cooked.hs
index 8562790ed..6bf1ea897 100644
--- a/src/Cooked.hs
+++ b/src/Cooked.hs
@@ -9,6 +9,5 @@ import Cooked.MockChain as X
 import Cooked.Pretty as X
 import Cooked.ShowBS as X
 import Cooked.Skeleton as X
-import Cooked.Staged as X
 import Cooked.Tweak as X
 import Cooked.Wallet as X
diff --git a/src/Cooked/Staged.hs b/src/Cooked/Staged.hs
deleted file mode 100644
index 4ee834764..000000000
--- a/src/Cooked/Staged.hs
+++ /dev/null
@@ -1,33 +0,0 @@
--- | This module exposes a simple notion of a Staged computation (or a freer
--- monad) to be used when modifying mockchain runs with Ltl formulas.
-module Cooked.Staged
-  ( Staged (..),
-    interpStaged,
-  )
-where
-
-import Control.Monad
-import Data.Kind
-
--- | The freer monad on @op@. We think of this as the AST of a computation with
--- operations of types @op a@.
-data Staged (op :: Type -> Type) :: Type -> Type where
-  Return :: a -> Staged op a
-  Instr :: op a -> (a -> Staged op b) -> Staged op b
-
-instance Functor (Staged op) where
-  fmap f (Return x) = Return $ f x
-  fmap f (Instr op cont) = Instr op (fmap f . cont)
-
-instance Applicative (Staged op) where
-  pure = Return
-  (<*>) = ap
-
-instance Monad (Staged op) where
-  (Return x) >>= f = f x
-  (Instr i m) >>= f = Instr i (m >=> f)
-
--- | Interprets a staged computation given a interpreter of the builtins
-interpStaged :: (Monad m) => (forall a. op a -> m a) -> forall a. Staged op a -> m a
-interpStaged _ (Return a) = return a
-interpStaged interpBuiltin (Instr op cont) = interpBuiltin op >>= interpStaged interpBuiltin . cont

From 5959cfd237423e7b302edc309a9ad48f298bf3ba Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 20 Jan 2026 17:58:53 +0100
Subject: [PATCH 27/96] ltl doc and exports

---
 src/Cooked/Ltl.hs | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index b880f7552..0f46c908c 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -31,11 +31,7 @@ module Cooked.Ltl
     ltlNever,
     ltlNever',
 
-    -- * Functions on LTL formulas
-    finished,
-    nowLaterList,
-
-    -- * Using LTL formulas to modify computations
+    -- * LTL Effects
     Requirement (..),
     ModifyGlobally (..),
     modifyLtl,

From 235513e8179390dec1cff19b8ba1b833c903c638 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 20 Jan 2026 18:56:11 +0100
Subject: [PATCH 28/96] tweaks

---
 src/Cooked/Effectful.hs    |  66 -------------
 src/Cooked/Ltl.hs          |  38 ++++----
 src/Cooked/Tweak/Common.hs | 194 ++++++++++++++-----------------------
 3 files changed, 92 insertions(+), 206 deletions(-)

diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index 54782029e..1127ebd63 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -28,72 +28,6 @@ import Polysemy.NonDet
 import Polysemy.State
 import Polysemy.Writer (Writer, runWriter, tell)
 
--- * ModifyOnTime
-
--- | An effect to modify a computation with a Ltl Formula. The idea is that the
--- formula pinpoints location where a modification should either be applied or
--- yield an empty computation (when negated).
-data ModifyOnTime a :: Effect where
-  ModifyLtl :: Ltl a -> m b -> ModifyOnTime a m b
-
-makeSem ''ModifyOnTime
-
--- | Running the `ModifyOnTime` effect requires to have access of the current
--- list of Ltl formulas, and to be able to return an empty computation. A new
--- formula is appended at the head of the current list of formula. Then, the
--- actual computation is run, after which the newly added formula must be
--- finished, otherwise the empty computation is returned.
-runModifyOnTime ::
-  forall modification effs a.
-  ( Members
-      '[ State [Ltl modification],
-         NonDet
-       ]
-      effs
-  ) =>
-  Sem (ModifyOnTime modification ': effs) a ->
-  Sem effs a
-runModifyOnTime =
-  interpretH $ \case
-    ModifyLtl formula comp -> do
-      modify (formula :)
-      comp' <- runT comp
-      res <- raise $ runModifyOnTime comp'
-      formulas <- get
-      unless (null formulas) $ do
-        guard (finished (head formulas))
-        put (tail formulas)
-      return res
-
--- * ModifyLocally
-
--- | An effect to request and consume the modifications to be applied at the
--- current time step.
-data ModifyLocally a :: Effect where
-  GetRequirements :: ModifyLocally a m [Requirement a]
-
-makeSem ''ModifyLocally
-
--- | Running the `ModifyLocally` effect requires to have access of the current
--- list of Ltl formulas, and to be able to branch. The function `nowLaterList`
--- is invoked to fetch the various paths implied by the current formulas, and a
--- branching is performed to explore all of them. The new formulas are stored,
--- and each path is given the requirements to satisfy at the current time step.
-runModifyLocally ::
-  forall modification effs a.
-  ( Members
-      '[ State [Ltl modification],
-         NonDet
-       ]
-      effs
-  ) =>
-  Sem (ModifyLocally modification : effs) a ->
-  Sem effs a
-runModifyLocally =
-  interpret $ \GetRequirements -> do
-    modifications <- gets nowLaterList
-    msum . (modifications <&>) $ \(now, later) -> put later >> return now
-
 -- * Tweak
 
 -- | An effet that allows to store or retrieve a skeleton from the context
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 0f46c908c..aadc41937 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -33,12 +33,12 @@ module Cooked.Ltl
 
     -- * LTL Effects
     Requirement (..),
-    ModifyGlobally (..),
+    ModifyLtlEff (..),
     modifyLtl,
-    runModifyGlobally,
-    ModifyLocally,
+    runModifyLtl,
+    FetchRequirementsEff,
     getRequirements,
-    runModifyLocally,
+    runFetchRequirements,
   )
 where
 
@@ -306,18 +306,18 @@ finished (LtlNot f) = not $ finished f
 
 -- | An effect to modify a computation with an `Ltl` Formula. The idea is that
 -- the formula pinpoints locations where `Requirement`s should be enforced.
-data ModifyGlobally a :: Effect where
-  ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
+data ModifyLtlEff a :: Effect where
+  ModifyLtl :: Ltl a -> m b -> ModifyLtlEff a m b
 
-makeSem ''ModifyGlobally
+makeSem ''ModifyLtlEff
 
--- | Running the `ModifyGlobally` effect requires to have access of the current
+-- | Running the `ModifyLtlEff` effect requires to have access of the current
 -- list of `Ltl` formulas, and to have access to an empty computation.
 --
 -- A new formula is appended at the head of the current list of formula. Then,
 -- the actual computation is run, after which the newly added formula must be
 -- finished, otherwise the empty computation is returned.
-runModifyGlobally ::
+runModifyLtl ::
   forall modification effs a.
   ( Members
       '[ State [Ltl modification],
@@ -325,14 +325,14 @@ runModifyGlobally ::
        ]
       effs
   ) =>
-  Sem (ModifyGlobally modification ': effs) a ->
+  Sem (ModifyLtlEff modification ': effs) a ->
   Sem effs a
-runModifyGlobally =
+runModifyLtl =
   interpretH $ \case
     ModifyLtl formula comp -> do
       modify (formula :)
       comp' <- runT comp
-      res <- raise $ runModifyGlobally comp'
+      res <- raise $ runModifyLtl comp'
       formulas <- get
       unless (null formulas) $ do
         guard (finished (head formulas))
@@ -341,19 +341,19 @@ runModifyGlobally =
 
 -- | An effect to request and consume the list of requirements that should be
 -- enforced at the current time step.
-data ModifyLocally a :: Effect where
-  GetRequirements :: ModifyLocally a m [Requirement a]
+data FetchRequirementsEff a :: Effect where
+  GetRequirements :: FetchRequirementsEff a m [Requirement a]
 
-makeSem ''ModifyLocally
+makeSem ''FetchRequirementsEff
 
--- | Running the `ModifyLocally` effect requires to have access to the current
+-- | Running the `FetchRequirementsEff` effect requires to have access to the current
 -- list of `Ltl` formulas, and to be able to branch.
 --
 -- The function `nowLaterList` is invoked to fetch the various paths implied by
 -- the current formulas, and a branching is performed to explore all of
 -- them. The new formulas for next steps are stored, and each path is given the
 -- requirements to enforce at the current time step.
-runModifyLocally ::
+runFetchRequirements ::
   forall modification effs a.
   ( Members
       '[ State [Ltl modification],
@@ -361,9 +361,9 @@ runModifyLocally ::
        ]
       effs
   ) =>
-  Sem (ModifyLocally modification : effs) a ->
+  Sem (FetchRequirementsEff modification : effs) a ->
   Sem effs a
-runModifyLocally =
+runFetchRequirements =
   interpret $ \GetRequirements -> do
     modifications <- gets nowLaterList
     msum . (modifications <&>) $ \(now, later) -> put later >> return now
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index c3207de08..d131b92fd 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -1,18 +1,18 @@
--- | This module defines 'Tweak's which are the fundamental building blocks of
--- our "domain specific language" for attacks. They are essentially skeleton
--- modifications aware of the mockchain state.
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | This module defines 'Tweak's which are the building blocks of our DSL for
+-- attacks. They are skeleton modifications aware of the mockchain state.
 module Cooked.Tweak.Common
-  ( runTweak,
-    runTweakFrom,
-    runTweakInChain,
-    runTweakInChain',
-    Tweak,
+  ( -- * Tweak effect
+    TweakEff (..),
+    getTxSkel,
+    putTxSkel,
+    runTweak,
+
+    -- * Untyped tweaks
     UntypedTweak (..),
 
-    -- * User API
-    MonadTweak (..),
-    failingTweak,
-    doNothingTweak,
+    -- * Optics tweaks
     viewTweak,
     viewAllTweak,
     setTweak,
@@ -22,140 +22,94 @@ module Cooked.Tweak.Common
     selectP,
     combineModsTweak,
     iviewTweak,
-    ensureFailingTweak,
   )
 where
 
-import Control.Applicative
 import Control.Arrow (second)
 import Control.Monad
-import Control.Monad.State
-import Cooked.InitialDistribution
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.Direct
 import Cooked.Skeleton
-import Data.Default
 import Data.Either.Combinators (rightToMaybe)
 import Data.List (mapAccumL)
 import Data.Maybe
-import ListT (ListT)
-import ListT qualified
 import Optics.Core
+import Polysemy
+import Polysemy.NonDet
+import Polysemy.State
 
--- * The type of tweaks
-
--- | A 'MonadTweak' is a 'MonadBlockChainWithoutValidation' where you can also
--- retrieve and store a 'TxSkel'
-class (MonadPlus m, MonadBlockChainWithoutValidation m) => MonadTweak m where
-  -- | Retrieves the stored 'TxSkel'
-  getTxSkel :: m TxSkel
-
-  -- | Stores a 'TxSkel'
-  putTxSkel :: TxSkel -> m ()
-
--- | A 'Tweak' is the most natural instance of 'MonadTweak' where the storing
--- and retrieving of the 'TxSkel' is performed through a state monad
-type Tweak m = StateT TxSkel (ListT m)
-
-instance (MonadBlockChainWithoutValidation m) => MonadTweak (Tweak m) where
-  getTxSkel = get
-  putTxSkel = put
-
--- * Running tweaks
+-- | An effet that allows to store or retrieve a `TxSkel` from a context
+data TweakEff :: Effect where
+  -- | Retrieves the `TxSkel` from the context
+  GetTxSkel :: TweakEff m TxSkel
+  -- | Overrides the `TxSkel` in the context
+  PutTxSkel :: TxSkel -> TweakEff m ()
 
--- | This is the function that gives a meaning to 'Tweak's: A 'Tweak' is a
--- computation that, depending on the state of the chain, looks at a transaction
--- and returns zero or more modified transactions, together with some additional
--- values.
---
--- Our intuition (and also the language of the comments pertaining to 'Tweak's)
--- is that a 'Tweak' @t@
---
--- - /fails/ if @runTweakInChain t skel@ is @mzero@.
---
--- - /returns/ the value in the first component of the pair returned by this
---   function (which is also the value it returns in the monad @Tweak m@).
---
--- - /modifies/ a 'TxSkel'. Since it can use every method of
---   'MonadBlockChainWithoutValidation' to do so, this also includes stateful
---   lookups or even things like waiting for a certain amount of time before
---   submitting the transaction.
---
--- If you're using tweaks in a 'Cooked.MockChain.Staged.MonadModalBlockChain'
--- together with mechanisms like 'Cooked.MockChain.Staged.withTweak',
--- 'Cooked.MockChain.Staged.somewhere', or 'Cooked.MockChain.Staged.everywhere',
--- you should never have a reason to use this function.
-runTweakInChain :: (Monad m, Alternative m) => Tweak m a -> TxSkel -> m (a, TxSkel)
-runTweakInChain tweak = ListT.alternate . runStateT tweak
-
--- | Like 'runTweakInChain', but for when you want to explicitly apply a tweak
--- to a transaction skeleton and get all results as a list.
---
--- If you're trying to apply a tweak to a transaction directly before it's
--- modified, consider using 'Cooked.MockChain.Staged.MonadModalBlockChain' and
--- idioms like 'Cooked.MockChain.Staged.withTweak',
--- 'Cooked.MockChain.Staged.somewhere', or 'Cooked.MockChain.Staged.everywhere'.
-runTweakInChain' :: (Monad m) => Tweak m a -> TxSkel -> m [(a, TxSkel)]
-runTweakInChain' tweak = ListT.toList . runStateT tweak
+makeSem ''TweakEff
 
--- | Runs a 'Tweak' from a given 'TxSkel' within a mockchain
-runTweak :: (Monad m, Alternative m) => Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
-runTweak = runTweakFrom def
-
--- | Runs a 'Tweak' from a given 'TxSkel' and 'InitialDistribution' within a
--- mockchain
-runTweakFrom :: (Monad m, Alternative m) => InitialDistribution -> Tweak (MockChainT m) a -> TxSkel -> m (MockChainReturn (a, TxSkel))
-runTweakFrom initDist tweak = runMockChainTFromInitDist initDist . runTweakInChain tweak
-
--- | This is a wrapper type used in the implementation of the Staged monad. You
--- will probably never use it while you're building 'Tweak's.
-data UntypedTweak m where
-  UntypedTweak :: Tweak m a -> UntypedTweak m
-
--- * A few fundamental tweaks
-
--- | The never-applicable 'Tweak'.
-failingTweak :: (MonadTweak m) => m a
-failingTweak = mzero
-
--- | The 'Tweak' that always applies and leaves the transaction unchanged.
-doNothingTweak :: (MonadTweak m) => m ()
-doNothingTweak = return ()
-
--- | The 'Tweak' that ensures a given tweak fails
-ensureFailingTweak :: (MonadPlus m) => Tweak m a -> Tweak m ()
-ensureFailingTweak comp = do
-  skel <- get
-  res <- lift $ lift $ runTweakInChain' comp skel
-  guard $ null res
+-- | Running a Tweak is equivalent to running a state monad storing a `TxSkel`
+runTweak ::
+  TxSkel ->
+  Sem (TweakEff : effs) a ->
+  Sem effs (TxSkel, a)
+runTweak txSkel =
+  runState txSkel
+    . reinterpret
+      ( \case
+          GetTxSkel -> get
+          PutTxSkel skel -> put skel
+      )
 
--- * Constructing Tweaks from Optics
+-- | Untyped tweaks are tweaks that will be deployed in time using
+-- `Cooked.Ltl`. They encompass a computation which can branch and has access to
+-- a `TxSkel` on top of other effects.
+data UntypedTweak effs where
+  UntypedTweak :: Sem (TweakEff : NonDet : effs) a -> UntypedTweak effs
 
 -- | Retrieves some value from the 'TxSkel'
-viewTweak :: (MonadTweak m, Is k A_Getter) => Optic' k is TxSkel a -> m a
+viewTweak ::
+  (Member TweakEff effs, Is k A_Getter) =>
+  Optic' k is TxSkel a ->
+  Sem effs a
 viewTweak optic = getTxSkel <&> view optic
 
 -- | Like 'viewTweak', only for indexed optics.
-iviewTweak :: (MonadTweak m, Is k A_Getter) => Optic' k (WithIx is) TxSkel a -> m (is, a)
+iviewTweak ::
+  (Member TweakEff effs, Is k A_Getter) =>
+  Optic' k (WithIx is) TxSkel a ->
+  Sem effs (is, a)
 iviewTweak optic = getTxSkel <&> iview optic
 
 -- | Like the 'viewTweak', but returns a list of all foci
-viewAllTweak :: (MonadTweak m, Is k A_Fold) => Optic' k is TxSkel a -> m [a]
+viewAllTweak ::
+  (Member TweakEff effs, Is k A_Fold) =>
+  Optic' k is TxSkel a ->
+  Sem effs [a]
 viewAllTweak optic = getTxSkel <&> toListOf optic
 
 -- | The tweak that sets a certain value in the 'TxSkel'.
-setTweak :: (MonadTweak m, Is k A_Setter) => Optic' k is TxSkel a -> a -> m ()
+setTweak ::
+  (Member TweakEff effs, Is k A_Setter) =>
+  Optic' k is TxSkel a ->
+  a ->
+  Sem effs ()
 setTweak optic = overTweak optic . const
 
 -- | The tweak that modifies a certain value in the 'TxSkel'.
-overTweak :: (MonadTweak m, Is k A_Setter) => Optic' k is TxSkel a -> (a -> a) -> m ()
+overTweak ::
+  (Member TweakEff effs, Is k A_Setter) =>
+  Optic' k is TxSkel a ->
+  (a -> a) ->
+  Sem effs ()
 overTweak optic change = getTxSkel >>= putTxSkel . over optic change
 
 -- | Like 'overTweak', but only modifies foci on which the argument function
 -- returns @Just@ the new focus. Returns a list of the foci that were modified,
 -- as they were /before/ the tweak, and in the order in which they occurred on
 -- the original transaction.
-overMaybeTweak :: (MonadTweak m, Is k A_Traversal) => Optic' k is TxSkel a -> (a -> Maybe a) -> m [a]
+overMaybeTweak ::
+  (Member TweakEff effs, Is k A_Traversal) =>
+  Optic' k is TxSkel a ->
+  (a -> Maybe a) ->
+  Sem effs [a]
 overMaybeTweak optic mChange = overMaybeSelectingTweak optic mChange (const True)
 
 -- | Sometimes 'overMaybeTweak' modifies too many foci. This might be the case
@@ -164,16 +118,14 @@ overMaybeTweak optic mChange = overMaybeSelectingTweak optic mChange (const True
 -- argument can be used to select which of the modifiable foci should be
 -- actually modified.
 overMaybeSelectingTweak ::
-  forall a m k is.
-  (MonadTweak m, Is k A_Traversal) =>
+  (Member TweakEff effs, Is k A_Traversal) =>
   Optic' k is TxSkel a ->
   (a -> Maybe a) ->
   (Integer -> Bool) ->
-  m [a]
+  Sem effs [a]
 overMaybeSelectingTweak optic mChange select = do
   allFoci <- viewTweak $ partsOf optic
-  let evaluatedFoci :: [(a, Maybe a)]
-      evaluatedFoci =
+  let evaluatedFoci =
         snd $
           mapAccumL
             ( \i unmodifiedFocus ->
@@ -208,7 +160,7 @@ overMaybeSelectingTweak optic mChange select = do
 -- - Each of the foci of the @Optic k (WithIx is) TxSkel x@ argument is
 --   something in the transaction that we might want to modify.
 --
--- - The @is -> x -> m [(x, l)]@ argument computes a list of possible
+-- - The @is -> x -> Sem effs [(x, l)]@ argument computes a list of possible
 --   modifications for each focus, depending on its index. For each modified
 --   focus, it also returns a "label" of type @l@, which somehow describes the
 --   modification that was made.
@@ -286,11 +238,11 @@ overMaybeSelectingTweak optic mChange select = do
 -- So you see that tweaks constructed like this can branch quite wildly. Use
 -- with caution!
 combineModsTweak ::
-  (Eq is, Is k A_Traversal, MonadTweak m) =>
+  (Eq is, Is k A_Traversal, Members '[TweakEff, NonDet] effs) =>
   ([is] -> [[is]]) ->
   Optic' k (WithIx is) TxSkel x ->
-  (is -> x -> m [(x, l)]) ->
-  m [l]
+  (is -> x -> Sem effs [(x, l)]) ->
+  Sem effs [l]
 combineModsTweak groupings optic changes = do
   (indexes, foci) <- iviewTweak (ipartsOf optic)
   msum $

From e8ba4f671675f6239160cf1110dbfc0a6e05a575 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Wed, 21 Jan 2026 01:31:08 +0100
Subject: [PATCH 29/96] datum hijacking

---
 src/Cooked/Attack/DatumHijacking.hs | 65 +++++++++++++++++++++--------
 src/Cooked/Tweak/Common.hs          |  4 +-
 2 files changed, 51 insertions(+), 18 deletions(-)

diff --git a/src/Cooked/Attack/DatumHijacking.hs b/src/Cooked/Attack/DatumHijacking.hs
index a9fd9016f..ff55a8225 100644
--- a/src/Cooked/Attack/DatumHijacking.hs
+++ b/src/Cooked/Attack/DatumHijacking.hs
@@ -58,7 +58,13 @@ data DatumHijackingParams where
 
 -- | Targets all the outputs for which the focus of a given optic exists, and
 -- redirects each of them in a separate transaction.
-defaultDatumHijackingParams :: (IsTxSkelOutAllowedOwner owner, Is k An_AffineFold) => Optic' k is TxSkelOut x -> owner -> DatumHijackingParams
+defaultDatumHijackingParams ::
+  ( IsTxSkelOutAllowedOwner owner,
+    Is k An_AffineFold
+  ) =>
+  Optic' k is TxSkelOut x ->
+  owner ->
+  DatumHijackingParams
 defaultDatumHijackingParams optic thief =
   DatumHijackingParams
     ((thief <$) . preview optic)
@@ -67,22 +73,41 @@ defaultDatumHijackingParams optic thief =
 
 -- | Targets all the outputs satisfying a given predicate, and redirects each of
 -- them in a separate transaction.
-txSkelOutPredDatumHijackingParams :: (IsTxSkelOutAllowedOwner owner) => (TxSkelOut -> Bool) -> owner -> DatumHijackingParams
-txSkelOutPredDatumHijackingParams predicate = defaultDatumHijackingParams (selectP predicate)
+txSkelOutPredDatumHijackingParams ::
+  (IsTxSkelOutAllowedOwner owner) =>
+  (TxSkelOut -> Bool) ->
+  owner ->
+  DatumHijackingParams
+txSkelOutPredDatumHijackingParams = defaultDatumHijackingParams . filtered
 
 -- | Datum hijacking parameters targetting all the outputs owned by a certain
 -- type of owner, and redirecting each of them in a separate transaction.
-ownedByDatumHijackingParams :: forall (oldOwner :: Type) owner. (IsTxSkelOutAllowedOwner owner, Typeable oldOwner) => owner -> DatumHijackingParams
+ownedByDatumHijackingParams ::
+  forall (oldOwner :: Type) owner.
+  ( IsTxSkelOutAllowedOwner owner,
+    Typeable oldOwner
+  ) =>
+  owner ->
+  DatumHijackingParams
 ownedByDatumHijackingParams = defaultDatumHijackingParams (txSkelOutOwnerL % userTypedAF @oldOwner)
 
 -- | Datum hijacking parameters targetting all the outputs owned by a script,
 -- and redirecting each of them in a separate transaction.
-scriptsDatumHijackingParams :: (IsTxSkelOutAllowedOwner owner) => owner -> DatumHijackingParams
+scriptsDatumHijackingParams ::
+  (IsTxSkelOutAllowedOwner owner) =>
+  owner ->
+  DatumHijackingParams
 scriptsDatumHijackingParams = defaultDatumHijackingParams (txSkelOutOwnerL % userScriptHashAF)
 
 -- | Datum hijacking parameters targetting all the outputs with a certain type
 -- of datum, and redirecting each of them in a separate transaction.
-datumOfDatumHijackingParams :: forall dat owner. (IsTxSkelOutAllowedOwner owner, DatumConstrs dat) => owner -> DatumHijackingParams
+datumOfDatumHijackingParams ::
+  forall dat owner.
+  ( IsTxSkelOutAllowedOwner owner,
+    DatumConstrs dat
+  ) =>
+  owner ->
+  DatumHijackingParams
 datumOfDatumHijackingParams = defaultDatumHijackingParams (txSkelOutDatumL % txSkelOutDatumTypedAT @dat)
 
 -- | Redirects, in the same transaction, all the outputs targetted by an output
@@ -90,10 +115,12 @@ datumOfDatumHijackingParams = defaultDatumHijackingParams (txSkelOutDatumL % txS
 -- those predicates. Returns the list of outputs that were successfully
 -- modified, before the modification is applied.
 redirectOutputTweakAll ::
-  (MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
+  ( Member Tweak effs,
+    IsTxSkelOutAllowedOwner owner
+  ) =>
   (TxSkelOut -> Maybe owner) ->
   (Integer -> Bool) ->
-  m [TxSkelOut]
+  Sem effs [TxSkelOut]
 redirectOutputTweakAll outputPred indexPred = do
   outputs <- viewTweak txSkelOutsL
   let (redirected, newOutputs) = go outputs 0
@@ -111,10 +138,12 @@ redirectOutputTweakAll outputPred indexPred = do
 -- output and an index predicates. See 'DatumHijackingParams' for more
 -- information on those predicates.
 redirectOutputTweakAny ::
-  (MonadTweak m, IsTxSkelOutAllowedOwner owner) =>
+  ( Members '[Tweak, NonDet] effs,
+    IsTxSkelOutAllowedOwner owner
+  ) =>
   (TxSkelOut -> Maybe owner) ->
   (Integer -> Bool) ->
-  m [TxSkelOut]
+  Sem effs [TxSkelOut]
 redirectOutputTweakAny outputPred indexPred = do
   outputs <- viewTweak txSkelOutsL
   (redirected, newOutputs) <- go [] 0 outputs
@@ -135,14 +164,16 @@ redirectOutputTweakAny outputPred indexPred = do
             )
     go l' n (out : l) = go (l' ++ [out]) n l
 
--- | A datum hijacking attack, simplified: This attack tries to substitute a
--- different recipient on certain outputs based on a 'DatumHijackingParams'.
+-- | The datum hijacking tries to substitute a different recipient on certain
+-- outputs based on a 'DatumHijackingParams'.
 --
--- A 'DatumHijackingLabel' is added to the labels of the 'TxSkel' using
--- 'addLabelTweak'. It contains the outputs that have been redirected, which
--- also corresponds to the returned value of this tweak. The tweak fails if no
--- such outputs have been redirected.
-datumHijackingAttack :: (MonadTweak m) => DatumHijackingParams -> m [TxSkelOut]
+-- A 'DatumHijackingLabel' is added to the labels of the 'TxSkel'. It contains
+-- the outputs that have been redirected, which also corresponds to the returned
+-- value of this tweak. The tweak fails if no such outputs have been redirected.
+datumHijackingAttack ::
+  (Members '[Tweak, NonDet] effs) =>
+  DatumHijackingParams ->
+  Sem effs [TxSkelOut]
 datumHijackingAttack (DatumHijackingParams outputPred indexPred mode) = do
   redirected <- (if mode then redirectOutputTweakAll else redirectOutputTweakAny) outputPred indexPred
   guard $ not $ null redirected
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index d131b92fd..7a77b3e39 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -12,6 +12,9 @@ module Cooked.Tweak.Common
     -- * Untyped tweaks
     UntypedTweak (..),
 
+    -- * Optics
+    selectP,
+
     -- * Optics tweaks
     viewTweak,
     viewAllTweak,
@@ -19,7 +22,6 @@ module Cooked.Tweak.Common
     overTweak,
     overMaybeTweak,
     overMaybeSelectingTweak,
-    selectP,
     combineModsTweak,
     iviewTweak,
   )

From 0a7d2433db4d0ba70903627850e377c65cfe78b8 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 22 Jan 2026 01:22:27 +0100
Subject: [PATCH 30/96] all effects spread around properly

---
 cooked-validators.cabal             |   8 +-
 src/Cooked/Attack/DatumHijacking.hs |  22 +-
 src/Cooked/Effectful.hs             | 212 ------------
 src/Cooked/MockChain/BlockChain.hs  | 494 ----------------------------
 src/Cooked/MockChain/Common.hs      |  28 ++
 src/Cooked/MockChain/Direct.hs      |  20 --
 src/Cooked/MockChain/Error.hs       |  60 ++++
 src/Cooked/MockChain/Instances.hs   |   0
 src/Cooked/MockChain/Log.hs         |  66 ++++
 src/Cooked/MockChain/Misc.hs        |  42 +++
 src/Cooked/MockChain/Read.hs        | 407 +++++++++++++++++++++++
 src/Cooked/MockChain/Write.hs       | 145 ++++++++
 src/Cooked/Tweak/Common.hs          |  36 +-
 13 files changed, 785 insertions(+), 755 deletions(-)
 delete mode 100644 src/Cooked/MockChain/BlockChain.hs
 create mode 100644 src/Cooked/MockChain/Common.hs
 create mode 100644 src/Cooked/MockChain/Error.hs
 create mode 100644 src/Cooked/MockChain/Instances.hs
 create mode 100644 src/Cooked/MockChain/Log.hs
 create mode 100644 src/Cooked/MockChain/Misc.hs
 create mode 100644 src/Cooked/MockChain/Read.hs
 create mode 100644 src/Cooked/MockChain/Write.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index c8b1c6acb..cd534bdd8 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -24,8 +24,9 @@ library
       Cooked.MockChain
       Cooked.MockChain.AutoFilling
       Cooked.MockChain.Balancing
-      Cooked.MockChain.BlockChain
+      Cooked.MockChain.Common
       Cooked.MockChain.Direct
+      Cooked.MockChain.Error
       Cooked.MockChain.GenerateTx.Anchor
       Cooked.MockChain.GenerateTx.Body
       Cooked.MockChain.GenerateTx.Certificate
@@ -38,11 +39,16 @@ library
       Cooked.MockChain.GenerateTx.ReferenceInputs
       Cooked.MockChain.GenerateTx.Withdrawals
       Cooked.MockChain.GenerateTx.Witness
+      Cooked.MockChain.Instances
+      Cooked.MockChain.Log
+      Cooked.MockChain.Misc
       Cooked.MockChain.MockChainState
+      Cooked.MockChain.Read
       Cooked.MockChain.Staged
       Cooked.MockChain.Testing
       Cooked.MockChain.UtxoSearch
       Cooked.MockChain.UtxoState
+      Cooked.MockChain.Write
       Cooked.Pretty
       Cooked.Pretty.Class
       Cooked.Pretty.Hashable
diff --git a/src/Cooked/Attack/DatumHijacking.hs b/src/Cooked/Attack/DatumHijacking.hs
index ff55a8225..853e79daf 100644
--- a/src/Cooked/Attack/DatumHijacking.hs
+++ b/src/Cooked/Attack/DatumHijacking.hs
@@ -12,7 +12,7 @@ module Cooked.Attack.DatumHijacking
     scriptsDatumHijackingParams,
     defaultDatumHijackingParams,
     datumOfDatumHijackingParams,
-    txSkelOutPredDatumHijackingParams,
+    outPredDatumHijackingParams,
   )
 where
 
@@ -26,14 +26,6 @@ import Data.Maybe
 import Data.Typeable
 import Optics.Core
 
--- | The 'DatumHijackingLabel' stores the outputs that have been redirected,
--- before their destination were changed.
-newtype DatumHijackingLabel = DatumHijackingLabel [TxSkelOut]
-  deriving (Show, Eq, Ord)
-
-instance PrettyCooked DatumHijackingLabel where
-  prettyCookedOpt opts (DatumHijackingLabel txSkelOuts) = prettyItemize opts "Redirected outputs" "-" txSkelOuts
-
 -- | Parameters of the datum hijacking attacks. They state precisely which
 -- outputs should have their owner changed, wich owner should be assigned, to
 -- each of these outputs, and whether several modified outputs should be
@@ -73,12 +65,12 @@ defaultDatumHijackingParams optic thief =
 
 -- | Targets all the outputs satisfying a given predicate, and redirects each of
 -- them in a separate transaction.
-txSkelOutPredDatumHijackingParams ::
+outPredDatumHijackingParams ::
   (IsTxSkelOutAllowedOwner owner) =>
   (TxSkelOut -> Bool) ->
   owner ->
   DatumHijackingParams
-txSkelOutPredDatumHijackingParams = defaultDatumHijackingParams . filtered
+outPredDatumHijackingParams = defaultDatumHijackingParams . filtered
 
 -- | Datum hijacking parameters targetting all the outputs owned by a certain
 -- type of owner, and redirecting each of them in a separate transaction.
@@ -164,6 +156,14 @@ redirectOutputTweakAny outputPred indexPred = do
             )
     go l' n (out : l) = go (l' ++ [out]) n l
 
+-- | The 'DatumHijackingLabel' stores the outputs that have been redirected,
+-- before their destination were changed.
+newtype DatumHijackingLabel = DatumHijackingLabel [TxSkelOut]
+  deriving (Show, Eq, Ord)
+
+instance PrettyCooked DatumHijackingLabel where
+  prettyCookedOpt opts (DatumHijackingLabel txSkelOuts) = prettyItemize opts "Redirected outputs" "-" txSkelOuts
+
 -- | The datum hijacking tries to substitute a different recipient on certain
 -- outputs based on a 'DatumHijackingParams'.
 --
diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
index 1127ebd63..cec90a228 100644
--- a/src/Cooked/Effectful.hs
+++ b/src/Cooked/Effectful.hs
@@ -5,7 +5,6 @@ module Cooked.Effectful where
 import Cardano.Api qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad (guard, msum, unless)
-import Cooked.Ltl (Ltl, Requirement (..), finished, nowLaterList)
 import Cooked.MockChain.BlockChain (MockChainError (..), MockChainLogEntry)
 import Cooked.MockChain.Direct (MockChainBook (..))
 import Cooked.MockChain.MockChainState (MockChainState (..), mcstConstitutionL, mcstLedgerStateL)
@@ -28,217 +27,6 @@ import Polysemy.NonDet
 import Polysemy.State
 import Polysemy.Writer (Writer, runWriter, tell)
 
--- * Tweak
-
--- | An effet that allows to store or retrieve a skeleton from the context
-data Tweak :: Effect where
-  GetTxSkel :: Tweak m TxSkel
-  SetTxSkel :: TxSkel -> Tweak m ()
-
-makeSem ''Tweak
-
--- | Running a Tweak should be equivalent to running a state monad
-runTweak ::
-  forall effs a.
-  TxSkel ->
-  Sem (Tweak : effs) a ->
-  Sem effs (TxSkel, a)
-runTweak txSkel =
-  runState txSkel
-    . reinterpret
-      ( \case
-          GetTxSkel -> get
-          SetTxSkel skel -> put skel
-      )
-
--- | An UntypedTweak does three things on top of tweaks:
--- - It erases the return type of the computation
--- - It stacks up a NonDet effect in the effects stacks
--- - It makes the underlying effect stack visible in the type
--- All of these will be useful to use them as modification.
-data UntypedTweak effs where
-  UntypedTweak :: Sem (Tweak : NonDet : effs) a -> UntypedTweak effs
-
--- * ToCardanoError
-
-runToCardanoError ::
-  forall effs a.
-  (Member (Error MockChainError) effs) =>
-  Sem (Error Ledger.ToCardanoError : effs) a ->
-  Sem effs a
-runToCardanoError = mapError (MCEToCardanoError "")
-
--- * Fail
-
--- | A possible semantics for fail that is interpreted in terms of Error. It
--- could also technically be run in NonDet but the error message would be lost
--- if transformed to mzero. This might not be the soundest interpretation, but
--- this does the job. After all, the only use for this effect will be to allow
--- partial assignments in our monadic setting.
-runFailInMockChainError ::
-  forall effs a.
-  (Member (Error MockChainError) effs) =>
-  Sem (Fail : effs) a ->
-  Sem effs a
-runFailInMockChainError = interpret $
-  \(Fail s) -> throw $ FailWith s
-
--- * MockChainMisc
-
--- | An effect that corresponds to extra QOL capabilities of the MockChain
-data MockChainMisc :: Effect where
-  Define :: (ToHash a) => String -> a -> MockChainMisc m a
-
-makeSem ''MockChainMisc
-
-runMockChainMisc ::
-  forall effs a.
-  (Member (Writer MockChainBook) effs) =>
-  Sem (MockChainMisc : effs) a ->
-  Sem effs a
-runMockChainMisc = interpret $
-  \(Define name hashable) -> do
-    tell (MockChainBook [] (Map.singleton (toHash hashable) name))
-    return hashable
-
--- * MockChainRead
-
--- | An effect that corresponds to querying the current state of the mockchain.
-data MockChainRead :: Effect where
-  GetParams :: MockChainRead m Emulator.Params
-  TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
-  CurrentSlot :: MockChainRead m Ledger.Slot
-  AllUtxos :: MockChainRead m [(Api.TxOutRef, TxSkelOut)]
-  UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m [(Api.TxOutRef, TxSkelOut)]
-  GetConstitutionScript :: MockChainRead m (Maybe VScript)
-  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
-
-makeSem ''MockChainRead
-
--- | The interpretation for read-only effect in the blockchain state
-runMockChainRead ::
-  forall effs a.
-  ( Members
-      '[ State MockChainState,
-         Error Ledger.ToCardanoError,
-         Error MockChainError
-       ]
-      effs
-  ) =>
-  Sem (MockChainRead : effs) a ->
-  Sem effs a
-runMockChainRead = interpret $ \case
-  GetParams -> gets mcstParams
-  TxSkelOutByRef oRef -> do
-    res <- gets $ Map.lookup oRef . mcstOutputs
-    case res of
-      Just (txSkelOut, True) -> return txSkelOut
-      _ -> throw $ MCEUnknownOutRef oRef
-  AllUtxos -> fetchUtxos (const True)
-  UtxosAt (Script.toAddress -> addr) -> fetchUtxos ((== addr) . Script.toAddress)
-  CurrentSlot -> gets (Emulator.getSlot . mcstLedgerState)
-  GetConstitutionScript -> gets (view mcstConstitutionL)
-  GetCurrentReward (Script.toCredential -> cred) -> do
-    stakeCredential <- undefined
-    gets
-      ( fmap (Api.Lovelace . Cardano.unCoin)
-          . Emulator.getReward stakeCredential
-          . view mcstLedgerStateL
-      )
-  where
-    fetchUtxos decide =
-      gets $
-        mapMaybe
-          ( \(oRef, (txSkelOut, isAvailable)) ->
-              if isAvailable && decide txSkelOut then Just (oRef, txSkelOut) else Nothing
-          )
-          . Map.toList
-          . mcstOutputs
-
--- * MockChainLog
-
--- | An effect to allow logging of mockchain events
-data MockChainLog :: Effect where
-  LogEvent :: MockChainLogEntry -> MockChainLog m ()
-
-makeSem ''MockChainLog
-
-runMockChainLog ::
-  forall effs a.
-  (Member (Writer MockChainBook) effs) =>
-  Sem (MockChainLog : effs) a ->
-  Sem effs a
-runMockChainLog = interpret $
-  \(LogEvent event) -> tell $ MockChainBook [event] Map.empty
-
--- * MockChainWrite
-
--- | An effect that corresponds to all the primitives that are not
--- read-only. They range from actual modification of the index state to storage
--- of logging information.
-data MockChainWrite :: Effect where
-  WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
-  SetParams :: Emulator.Params -> MockChainWrite m ()
-  ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
-  SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
-  ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
-
-makeSem ''MockChainWrite
-
--- | 'MockChainWrite' is subject to be modified by UntypedTweak, when the event
--- is a 'ValidateTxSkel'. To handle that we proposed a reinterpretation of the
--- effect in itself, when the 'ModifyLocally' effect exists in the stack.
-interceptMockChainWriteWithTweak ::
-  forall tweakEffs effs a.
-  ( Members
-      '[ ModifyLocally (UntypedTweak tweakEffs),
-         NonDet
-       ]
-      effs,
-    Subsume tweakEffs effs
-  ) =>
-  Sem (MockChainWrite : effs) a ->
-  Sem (MockChainWrite : effs) a
-interceptMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
-  ValidateTxSkel skel -> do
-    requirements <- getRequirements
-    let sumTweak :: Sem (Tweak : NonDet : tweakEffs) () =
-          foldr
-            ( \req acc -> case req of
-                Apply (UntypedTweak tweak) -> tweak >> acc
-                EnsureFailure (UntypedTweak tweak) -> do
-                  txSkel' <- getTxSkel
-                  results <- raise_ $ runNonDet @[] $ runTweak txSkel' tweak
-                  guard $ null results
-                  acc
-            )
-            (return ())
-            requirements
-    newTxSkel <- raise $ subsume_ $ fst <$> runTweak skel sumTweak
-    validateTxSkel newTxSkel
-  a -> send $ coerce a
-
--- | Interpreting the 'MockChainWrite' effect is purely domain-specific.
-runMockChainWrite ::
-  forall effs a.
-  ( Members
-      '[ State MockChainState,
-         Error Ledger.ToCardanoError,
-         Error MockChainError,
-         MockChainLog,
-         MockChainRead,
-         Fail
-       ]
-      effs
-  ) =>
-  Sem (MockChainWrite : effs) a ->
-  Sem effs a
-runMockChainWrite = interpret $ \case
-  ValidateTxSkel skel -> do
-    undefined
-  ForceOutputs outs -> undefined
-  builtin -> undefined
-
 -- * MockChainDirect
 
 -- | A possible stack of effects to handle a direct interpretation of the
diff --git a/src/Cooked/MockChain/BlockChain.hs b/src/Cooked/MockChain/BlockChain.hs
deleted file mode 100644
index 9264ef7ce..000000000
--- a/src/Cooked/MockChain/BlockChain.hs
+++ /dev/null
@@ -1,494 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-
--- | This modules provides a specification for our blockchain monads, in three
--- layers:
---
--- 1. MonadBlockChainBalancing provides what's needing for balancing purposes
---
--- 2. MonadBlockChainWithoutValidation adds up remaining primitives without
--- transaction validation
---
--- 3. MonadBlockChain concludes with the addition of transaction validation,
--- thus modifying the internal index of outputs
---
--- In addition, you will find here many helpers functions which can be derived
--- from the core definition of our blockchain.
-module Cooked.MockChain.BlockChain
-  ( Fee,
-    CollateralIns,
-    Collaterals,
-    Utxos,
-    MockChainError (..),
-    MockChainLogEntry (..),
-    MonadBlockChainBalancing (..),
-    MonadBlockChainWithoutValidation (..),
-    MonadBlockChain (..),
-    AsTrans (..),
-    currentMSRange,
-    utxosFromCardanoTx,
-    currentSlot,
-    awaitSlot,
-    getEnclosingSlot,
-    awaitEnclosingSlot,
-    waitNMSFromSlotLowerBound,
-    waitNMSFromSlotUpperBound,
-    slotRangeBefore,
-    slotRangeAfter,
-    slotToMSRange,
-    txSkelInputScripts,
-    txSkelInputValue,
-    lookupUtxos,
-    validateTxSkel',
-    validateTxSkel_,
-    txSkelDepositedValueInProposals,
-    govActionDeposit,
-    defineM,
-    txSkelAllScripts,
-    previewByRef,
-    viewByRef,
-    dRepDeposit,
-    stakeAddressDeposit,
-    stakePoolDeposit,
-    txSkelDepositedValueInCertificates,
-  )
-where
-
-import Cardano.Api.Ledger qualified as Cardano
-import Cardano.Ledger.Conway.Core qualified as Conway
-import Cardano.Node.Emulator qualified as Emulator
-import Cardano.Node.Emulator.Internal.Node qualified as Emulator
-import Control.Lens qualified as Lens
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Trans.Control
-import Control.Monad.Writer
-import Cooked.Pretty.Hashable
-import Cooked.Pretty.Plutus ()
-import Cooked.Skeleton
-import Data.Kind
-import Data.Map (Map)
-import Data.Map qualified as Map
-import Data.Maybe
-import Data.Set (Set)
-import Ledger.Index qualified as Ledger
-import Ledger.Slot qualified as Ledger
-import Ledger.Tx qualified as Ledger
-import Ledger.Tx.CardanoAPI qualified as Ledger
-import ListT
-import Optics.Core
-import Plutus.Script.Utils.Address qualified as Script
-import Plutus.Script.Utils.Scripts qualified as Script
-import PlutusLedgerApi.V3 qualified as Api
-
--- * Type aliases
-
--- | An alias for Integers used as fees
-type Fee = Integer
-
--- | An alias for sets of utxos used as collateral inputs
-type CollateralIns = Set Api.TxOutRef
-
--- | An alias for optional pairs of collateral inputs and return collateral peer
-type Collaterals = Maybe (CollateralIns, Peer)
-
--- | An alias for lists of utxos with their associated output
-type Utxos = [(Api.TxOutRef, TxSkelOut)]
-
--- * Mockchain errors
-
--- | Errors that can be produced by the blockchain
-data MockChainError
-  = -- | Validation errors, either in Phase 1 or Phase 2
-    MCEValidationError Ledger.ValidationPhase Ledger.ValidationError
-  | -- | The balancing user does not have enough funds
-    MCEUnbalanceable Peer Api.Value
-  | -- | The balancing user is required but missing
-    MCEMissingBalancingUser String
-  | -- | No suitable collateral could be associated with a skeleton
-    MCENoSuitableCollateral Integer Integer Api.Value
-  | -- | Translating a skeleton element to its Cardano counterpart failed
-    MCEToCardanoError String Ledger.ToCardanoError
-  | -- | The required reference script is missing from a witness utxo
-    MCEWrongReferenceScriptError Api.TxOutRef Api.ScriptHash (Maybe Api.ScriptHash)
-  | -- | A UTxO is missing from the mockchain state
-    MCEUnknownOutRef Api.TxOutRef
-  | -- | A jump in time would result in a past slot
-    MCEPastSlot Ledger.Slot Ledger.Slot
-  | -- | An attempt to invoke an unsupported feature has been made
-    MCEUnsupportedFeature String
-  | -- | Used to provide 'MonadFail' instances.
-    FailWith String
-  deriving (Show, Eq)
-
--- * Mockchain logs
-
--- | This represents the specific events that should be logged when processing
--- transactions. If a new kind of event arises, then a new constructor should be
--- provided here.
-data MockChainLogEntry
-  = -- | Logging a Skeleton as it is submitted by the user.
-    MCLogSubmittedTxSkel TxSkel
-  | -- | Logging a Skeleton as it has been adjusted by the balancing mechanism,
-    -- alongside fee, and possible collateral utxos and return collateral user.
-    MCLogAdjustedTxSkel TxSkel Fee Collaterals
-  | -- | Logging the successful validation of a new transaction, with its id and
-    -- number of produced outputs.
-    MCLogNewTx Api.TxId Integer
-  | -- | Logging the fact that utxos provided by the user for balancing have to be
-    -- discarded for a specific reason.
-    MCLogDiscardedUtxos Integer String
-  | -- | Logging the fact that utxos provided as collaterals will not be used
-    -- because the transaction does not involve scripts. There are 2 cases,
-    -- depending on whether the user has provided an explicit user or a set of
-    -- utxos to be used as collaterals.
-    MCLogUnusedCollaterals (Either Peer CollateralIns)
-  | -- | Logging the automatic addition of a reference script
-    MCLogAddedReferenceScript TxSkelRedeemer Api.TxOutRef Script.ScriptHash
-  | -- | Logging the automatic addition of a withdrawal amount
-    MCLogAutoFilledWithdrawalAmount Api.Credential Api.Lovelace
-  | -- | Logging the automatic addition of the constitution script
-    MCLogAutoFilledConstitution Api.ScriptHash
-  | -- | Logging the automatic adjusment of a min ada amount
-    MCLogAdjustedTxSkelOut TxSkelOut Api.Lovelace
-  deriving (Show)
-
--- * Mockchain layers
-
--- | This is the first layer of our blockchain, which provides the minimal
--- subset of primitives required to perform balancing.
-class (MonadFail m, MonadError MockChainError m) => MonadBlockChainBalancing m where
-  -- | Returns the emulator parameters, including protocol parameters
-  getParams :: m Emulator.Params
-
-  -- | Returns a list of all UTxOs at a certain address.
-  utxosAt :: (Script.ToAddress a) => a -> m Utxos
-
-  -- | Returns an output given a reference to it. If the output does not exist,
-  -- throws a 'MCEUnknownOutRef' error.
-  txSkelOutByRef :: Api.TxOutRef -> m TxSkelOut
-
-  -- | Logs an event that occured during a BlockChain run
-  logEvent :: MockChainLogEntry -> m ()
-
--- | This is the second layer of our blockchain, which provides all the other
--- blockchain primitives not needed for balancing, except transaction
--- validation. This layers is the one where
--- 'Cooked.MockChain.Tweak.Common.Tweak's are plugged to.
-class (MonadBlockChainBalancing m) => MonadBlockChainWithoutValidation m where
-  -- | Returns a list of all currently known outputs.
-  allUtxos :: m Utxos
-
-  -- | Updates parameters
-  setParams :: Emulator.Params -> m ()
-
-  -- | Wait a certain amount of slot. Throws 'MCEPastSlot' if the input integer
-  -- is negative. Returns the slot after jumping in time.
-  waitNSlots :: (Integral i) => i -> m Ledger.Slot
-
-  -- | Binds a hashable quantity of type @a@ to a variable in the mockchain,
-  -- while registering its alias for printing purposes.
-  define :: (ToHash a) => String -> a -> m a
-
-  -- | Sets the current script to act as the official constitution script
-  setConstitutionScript :: (ToVScript s) => s -> m ()
-
-  -- | Gets the current official constitution script
-  getConstitutionScript :: m (Maybe VScript)
-
-  -- | Gets the current reward associated with a credential
-  getCurrentReward :: (Script.ToCredential c) => c -> m (Maybe Api.Lovelace)
-
--- | The final layer of our blockchain, adding transaction validation to the
--- mix. This is the only primitive that actually modifies the ledger state.
-class (MonadBlockChainWithoutValidation m) => MonadBlockChain m where
-  -- | Generates, balances and validates a transaction from a skeleton. It
-  -- returns the validated transaction and updates the state of the
-  -- blockchain.
-  validateTxSkel :: TxSkel -> m Ledger.CardanoTx
-
-  -- | Forces the generation of utxos corresponding to certain 'TxSkelOut'
-  forceOutputs :: [TxSkelOut] -> m [Api.TxOutRef]
-
--- * Mockchain helpers
-
--- | Retrieves an output and views a specific element out of it
-viewByRef :: (MonadBlockChainBalancing m, Is g A_Getter) => Optic' g is TxSkelOut c -> Api.TxOutRef -> m c
-viewByRef optic = (view optic <$>) . txSkelOutByRef
-
--- | Retrieves an output and previews a specific element out of it
-previewByRef :: (MonadBlockChainBalancing m, Is af An_AffineFold) => Optic' af is TxSkelOut c -> Api.TxOutRef -> m (Maybe c)
-previewByRef optic = (preview optic <$>) . txSkelOutByRef
-
--- | Validates a skeleton, and retuns the ordered list of produced output
--- references
-validateTxSkel' :: (MonadBlockChain m) => TxSkel -> m [Api.TxOutRef]
-validateTxSkel' = ((fmap fst <$>) . utxosFromCardanoTx) <=< validateTxSkel
-
--- | Validates a skeleton, and erases the outputs
-validateTxSkel_ :: (MonadBlockChain m) => TxSkel -> m ()
-validateTxSkel_ = void . validateTxSkel
-
--- | Retrieves the ordered list of outputs of the given "CardanoTx".
---
--- This is useful when writing endpoints and/or traces to fetch utxos of
--- interest right from the start and avoid querying the chain for them
--- afterwards using 'allUtxos' or similar functions.
-utxosFromCardanoTx :: (MonadBlockChainBalancing m) => Ledger.CardanoTx -> m [(Api.TxOutRef, TxSkelOut)]
-utxosFromCardanoTx =
-  mapM (\txOutRef -> (txOutRef,) <$> txSkelOutByRef txOutRef)
-    . fmap (Ledger.fromCardanoTxIn . snd)
-    . Ledger.getCardanoTxOutRefs
-
--- | Like 'define', but binds the result of a monadic computation instead
-defineM :: (MonadBlockChainWithoutValidation m, ToHash a) => String -> m a -> m a
-defineM name = (define name =<<)
-
--- | Retrieves the required governance action deposit amount
-govActionDeposit :: (MonadBlockChainBalancing m) => m Api.Lovelace
-govActionDeposit = Api.Lovelace . Cardano.unCoin . Lens.view Conway.ppGovActionDepositL . Emulator.emulatorPParams <$> getParams
-
--- | Retrieves the required drep deposit amount
-dRepDeposit :: (MonadBlockChainBalancing m) => m Api.Lovelace
-dRepDeposit = Api.Lovelace . Cardano.unCoin . Lens.view Conway.ppDRepDepositL . Emulator.emulatorPParams <$> getParams
-
--- | Retrieves the required stake address deposit amount
-stakeAddressDeposit :: (MonadBlockChainBalancing m) => m Api.Lovelace
-stakeAddressDeposit = Api.Lovelace . Cardano.unCoin . Lens.view Conway.ppKeyDepositL . Emulator.emulatorPParams <$> getParams
-
--- | Retrieves the required stake pool deposit amount
-stakePoolDeposit :: (MonadBlockChainBalancing m) => m Api.Lovelace
-stakePoolDeposit = Api.Lovelace . Cardano.unCoin . Lens.view Conway.ppPoolDepositL . Emulator.emulatorPParams <$> getParams
-
--- | Retrieves the total amount of lovelace deposited in proposals in this
--- skeleton (equal to `govActionDeposit` times the number of proposals).
-txSkelDepositedValueInProposals :: (MonadBlockChainBalancing m) => TxSkel -> m Api.Lovelace
-txSkelDepositedValueInProposals TxSkel {txSkelProposals} = Api.Lovelace . (toInteger (length txSkelProposals) *) . Api.getLovelace <$> govActionDeposit
-
--- | Retrieves the total amount of lovelace deposited in certificates in this
--- skeleton. Note that unregistering a staking address or a dRep lead to a
--- negative deposit (a withdrawal, in fact) which means this function can return
--- a negative amount of lovelace, which is intended. The deposited amounts are
--- dictated by the current protocol parameters, and computed as such.
-txSkelDepositedValueInCertificates :: (MonadBlockChainBalancing m) => TxSkel -> m Api.Lovelace
-txSkelDepositedValueInCertificates txSkel = do
-  sDep <- stakeAddressDeposit
-  dDep <- dRepDeposit
-  pDep <- stakePoolDeposit
-  return $
-    foldOf
-      ( txSkelCertificatesL
-          % traversed
-          % to
-            ( \case
-                TxSkelCertificate _ StakingRegister {} -> sDep
-                TxSkelCertificate _ StakingRegisterDelegate {} -> sDep
-                TxSkelCertificate _ StakingUnRegister {} -> -sDep
-                TxSkelCertificate _ DRepRegister {} -> dDep
-                TxSkelCertificate _ DRepUnRegister {} -> -dDep
-                TxSkelCertificate _ PoolRegister {} -> pDep
-                -- There is no special case for 'PoolRetire' because the deposit
-                -- is given back to the reward account.
-                _ -> Api.Lovelace 0
-            )
-      )
-      txSkel
-
--- | Returns all scripts which guard transaction inputs
-txSkelInputScripts :: (MonadBlockChainBalancing m) => TxSkel -> m [VScript]
-txSkelInputScripts = fmap catMaybes . mapM (previewByRef (txSkelOutOwnerL % userVScriptAT)) . Map.keys . txSkelIns
-
--- | Returns all scripts involved in this 'TxSkel'
-txSkelAllScripts :: (MonadBlockChainBalancing m) => TxSkel -> m [VScript]
-txSkelAllScripts txSkel = do
-  txSkelSpendingScripts <- txSkelInputScripts txSkel
-  return
-    ( txSkelMintingScripts txSkel
-        <> txSkelWithdrawingScripts txSkel
-        <> txSkelProposingScripts txSkel
-        <> txSkelCertifyingScripts txSkel
-        <> txSkelSpendingScripts
-    )
-
--- | Go through all of the 'Api.TxOutRef's in the list and look them up in the
--- state of the blockchain, throwing an error if one of them cannot be resolved.
-lookupUtxos :: (MonadBlockChainBalancing m) => [Api.TxOutRef] -> m (Map Api.TxOutRef TxSkelOut)
-lookupUtxos = foldM (\m oRef -> flip (Map.insert oRef) m <$> txSkelOutByRef oRef) Map.empty
-
--- | look up the UTxOs the transaction consumes, and sum their values.
-txSkelInputValue :: (MonadBlockChainBalancing m) => TxSkel -> m Api.Value
-txSkelInputValue = fmap mconcat . mapM (viewByRef txSkelOutValueL) . Map.keys . txSkelIns
-
--- * Slot and Time Management
-
--- $slotandtime
--- #slotandtime#
---
--- Slots are integers that monotonically increase and model the passage of
--- time. By looking at the current slot, a validator gets to know that it is
--- being executed within a certain window of wall-clock time. Things can get
--- annoying pretty fast when trying to mock traces and trying to exercise
--- certain branches of certain validators; make sure you also read the docs on
--- 'autoSlotIncrease' to be able to simulate sending transactions in parallel.
-
--- | Returns the current slot number
-currentSlot :: (MonadBlockChainWithoutValidation m) => m Ledger.Slot
-currentSlot = waitNSlots @_ @Int 0
-
--- | Wait for a certain slot, or throws an error if the slot is already past
-awaitSlot :: (MonadBlockChainWithoutValidation m, Integral i) => i -> m Ledger.Slot
-awaitSlot slot = currentSlot >>= waitNSlots . (slot -) . fromIntegral
-
--- | Returns the closed ms interval corresponding to the current slot
-currentMSRange :: (MonadBlockChainWithoutValidation m) => m (Api.POSIXTime, Api.POSIXTime)
-currentMSRange = slotToMSRange =<< currentSlot
-
--- | Returns the closed ms interval corresponding to the slot with the given
--- number. It holds that
---
--- > slotToMSRange (getEnclosingSlot t) == (a, b)    ==>   a <= t <= b
---
--- and
---
--- > slotToMSRange n == (a, b)   ==>   getEnclosingSlot a == n && getEnclosingSlot b == n
---
--- and
---
--- > slotToMSRange n == (a, b)   ==>   getEnclosingSlot (a-1) == n-1 && getEnclosingSlot (b+1) == n+1
-slotToMSRange :: (MonadBlockChainWithoutValidation m, Integral i) => i -> m (Api.POSIXTime, Api.POSIXTime)
-slotToMSRange (fromIntegral -> slot) = do
-  slotConfig <- Emulator.pSlotConfig <$> getParams
-  case Emulator.slotToPOSIXTimeRange slotConfig slot of
-    Api.Interval
-      (Api.LowerBound (Api.Finite l) leftclosed)
-      (Api.UpperBound (Api.Finite r) rightclosed) ->
-        return
-          ( if leftclosed then l else l + 1,
-            if rightclosed then r else r - 1
-          )
-    _ -> fail "Unexpected unbounded slot: please report a bug at https://github.com/tweag/cooked-validators/issues"
-
--- | Return the slot that contains the given time. See 'slotToMSRange' for
--- some satisfied equational properties.
-getEnclosingSlot :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.Slot
-getEnclosingSlot t = (`Emulator.posixTimeToEnclosingSlot` t) . Emulator.pSlotConfig <$> getParams
-
--- | Waits until the current slot becomes greater or equal to the slot
---  containing the given POSIX time.  Note that that it might not wait for
---  anything if the current slot is large enough.
-awaitEnclosingSlot :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.Slot
-awaitEnclosingSlot = awaitSlot <=< getEnclosingSlot
-
--- | Wait a given number of ms from the lower bound of the current slot and
--- returns the current slot after waiting.
-waitNMSFromSlotLowerBound :: (MonadBlockChainWithoutValidation m, Integral i) => i -> m Ledger.Slot
-waitNMSFromSlotLowerBound duration = currentMSRange >>= awaitEnclosingSlot . (+ fromIntegral duration) . fst
-
--- | Wait a given number of ms from the upper bound of the current slot and
--- returns the current slot after waiting.
-waitNMSFromSlotUpperBound :: (MonadBlockChainWithoutValidation m, Integral i) => i -> m Ledger.Slot
-waitNMSFromSlotUpperBound duration = currentMSRange >>= awaitEnclosingSlot . (+ fromIntegral duration) . snd
-
--- | The infinite range of slots ending before or at the given time
-slotRangeBefore :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.SlotRange
-slotRangeBefore t = do
-  n <- getEnclosingSlot t
-  (_, b) <- slotToMSRange n
-  -- If the given time @t@ happens to be the last ms of its slot, we can include
-  -- the whole slot. Otherwise, the only way to be sure that the returned slot
-  -- range contains no time after @t@ is to go to the preceding slot.
-  return $ Api.to $ if t == b then n else n - 1
-
--- | The infinite range of slots starting after or at the given time
-slotRangeAfter :: (MonadBlockChainWithoutValidation m) => Api.POSIXTime -> m Ledger.SlotRange
-slotRangeAfter t = do
-  n <- getEnclosingSlot t
-  (a, _) <- slotToMSRange n
-  return $ Api.from $ if t == a then n else n + 1
-
--- * Deriving further 'MonadBlockChain' instances
-
--- | A newtype wrapper to be used with '-XDerivingVia' to derive instances of
--- 'MonadBlockChain' for any 'MonadTransControl'.
---
--- For example, to derive 'MonadBlockChain m => MonadBlockChain (ReaderT r m)',
--- you'd write
---
--- > deriving via (AsTrans (ReaderT r) m) instance MonadBlockChain m => MonadBlockChain (ReaderT r m)
---
--- and avoid the trouble of defining all the class methods yourself.
-newtype AsTrans t (m :: Type -> Type) a = AsTrans {getTrans :: t m a}
-  deriving newtype (Functor, Applicative, Monad, MonadTrans, MonadTransControl)
-
-instance (MonadTrans t, MonadFail m, Monad (t m)) => MonadFail (AsTrans t m) where
-  fail = lift . fail
-
-instance (MonadTransControl t, MonadError MockChainError m, Monad (t m)) => MonadError MockChainError (AsTrans t m) where
-  throwError = lift . throwError
-  catchError act f = liftWith (\run -> catchError (run act) (run . f)) >>= restoreT . return
-
-instance (MonadTrans t, MonadBlockChainBalancing m, Monad (t m), MonadError MockChainError (AsTrans t m)) => MonadBlockChainBalancing (AsTrans t m) where
-  getParams = lift getParams
-  utxosAt = lift . utxosAt
-  txSkelOutByRef = lift . txSkelOutByRef
-  logEvent = lift . logEvent
-
-instance (MonadTrans t, MonadBlockChainWithoutValidation m, Monad (t m), MonadError MockChainError (AsTrans t m)) => MonadBlockChainWithoutValidation (AsTrans t m) where
-  allUtxos = lift allUtxos
-  setParams = lift . setParams
-  waitNSlots = lift . waitNSlots
-  define name = lift . define name
-  setConstitutionScript = lift . setConstitutionScript
-  getConstitutionScript = lift getConstitutionScript
-  getCurrentReward = lift . getCurrentReward
-
-instance (MonadTrans t, MonadBlockChain m, MonadBlockChainWithoutValidation (AsTrans t m)) => MonadBlockChain (AsTrans t m) where
-  validateTxSkel = lift . validateTxSkel
-  forceOutputs = lift . forceOutputs
-
-deriving via (AsTrans (WriterT w) m) instance (Monoid w, MonadBlockChainBalancing m) => MonadBlockChainBalancing (WriterT w m)
-
-deriving via (AsTrans (WriterT w) m) instance (Monoid w, MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (WriterT w m)
-
-deriving via (AsTrans (WriterT w) m) instance (Monoid w, MonadBlockChain m) => MonadBlockChain (WriterT w m)
-
-deriving via (AsTrans (ReaderT r) m) instance (MonadBlockChainBalancing m) => MonadBlockChainBalancing (ReaderT r m)
-
-deriving via (AsTrans (ReaderT r) m) instance (MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (ReaderT r m)
-
-deriving via (AsTrans (ReaderT r) m) instance (MonadBlockChain m) => MonadBlockChain (ReaderT r m)
-
-deriving via (AsTrans (StateT s) m) instance (MonadBlockChainBalancing m) => MonadBlockChainBalancing (StateT s m)
-
-deriving via (AsTrans (StateT s) m) instance (MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (StateT s m)
-
-deriving via (AsTrans (StateT s) m) instance (MonadBlockChain m) => MonadBlockChain (StateT s m)
-
--- 'ListT' has no 'MonadTransControl' instance, so the @deriving via ...@
--- machinery is unusable here. However, there is
---
--- > MonadError e m => MonadError e (ListT m)
---
--- so I decided to go with a bit of code duplication to implement the
--- 'MonadBlockChainWithoutValidation' and 'MonadBlockChain' instances for
--- 'ListT', instead of more black magic...
-
-instance (MonadBlockChainBalancing m) => MonadBlockChainBalancing (ListT m) where
-  getParams = lift getParams
-  utxosAt = lift . utxosAt
-  txSkelOutByRef = lift . txSkelOutByRef
-  logEvent = lift . logEvent
-
-instance (MonadBlockChainWithoutValidation m) => MonadBlockChainWithoutValidation (ListT m) where
-  allUtxos = lift allUtxos
-  setParams = lift . setParams
-  waitNSlots = lift . waitNSlots
-  define name = lift . define name
-  setConstitutionScript = lift . setConstitutionScript
-  getConstitutionScript = lift getConstitutionScript
-  getCurrentReward = lift . getCurrentReward
-
-instance (MonadBlockChain m) => MonadBlockChain (ListT m) where
-  validateTxSkel = lift . validateTxSkel
-  forceOutputs = lift . forceOutputs
diff --git a/src/Cooked/MockChain/Common.hs b/src/Cooked/MockChain/Common.hs
new file mode 100644
index 000000000..f7421f882
--- /dev/null
+++ b/src/Cooked/MockChain/Common.hs
@@ -0,0 +1,28 @@
+-- | This module exposes some type aliases common to our MockChain library
+module Cooked.MockChain.Common
+  ( -- * Type aliases
+    Fee,
+    CollateralIns,
+    Collaterals,
+    Utxos,
+  )
+where
+
+import Cooked.Skeleton.Output
+import Cooked.Skeleton.User
+import Data.Set (Set)
+import PlutusLedgerApi.V3 qualified as Api
+
+-- * Type aliases
+
+-- | An alias for Integers used as fees
+type Fee = Integer
+
+-- | An alias for sets of utxos used as collateral inputs
+type CollateralIns = Set Api.TxOutRef
+
+-- | An alias for optional pairs of collateral inputs and return collateral peer
+type Collaterals = Maybe (CollateralIns, Peer)
+
+-- | An alias for lists of utxos with their associated output
+type Utxos = [(Api.TxOutRef, TxSkelOut)]
diff --git a/src/Cooked/MockChain/Direct.hs b/src/Cooked/MockChain/Direct.hs
index e7a07531e..382550aed 100644
--- a/src/Cooked/MockChain/Direct.hs
+++ b/src/Cooked/MockChain/Direct.hs
@@ -59,26 +59,6 @@ import PlutusLedgerApi.V3 qualified as Api
 --
 -- - emits entries in a 'MockChainBook'
 
--- | This represents elements that can be emitted throughout a 'MockChain'
--- run. These elements are either log entries corresponding to internal events
--- worth logging, or aliases for hashables corresponding to elements users
--- wishes to be properly displayed when printed with
--- 'Cooked.Pretty.Class.PrettyCooked'
-data MockChainBook where
-  MockChainBook ::
-    { -- | Log entries generated by cooked-validators
-      mcbJournal :: [MockChainLogEntry],
-      -- | Aliases stored by the user
-      mcbAliases :: Map Api.BuiltinByteString String
-    } ->
-    MockChainBook
-
-instance Semigroup MockChainBook where
-  MockChainBook j a <> MockChainBook j' a' = MockChainBook (j <> j') (a <> a')
-
-instance Monoid MockChainBook where
-  mempty = MockChainBook mempty mempty
-
 -- | A 'MockChainT' builds up a stack of monads on top of a given monad @m@ to
 -- reflect the requirements of the simulation. It writes a 'MockChainBook',
 -- updates and reads from a 'MockChainState' and throws possible
diff --git a/src/Cooked/MockChain/Error.hs b/src/Cooked/MockChain/Error.hs
new file mode 100644
index 000000000..0a93a11a4
--- /dev/null
+++ b/src/Cooked/MockChain/Error.hs
@@ -0,0 +1,60 @@
+-- | This module exposes the errors that can be raised during a mockchain run
+module Cooked.MockChain.Error
+  ( -- * Mockchain errors
+    MockChainError (..),
+
+    -- * Interpretating effects into `Error MockChainError`
+    runToCardanoErrorInMockChainError,
+    runFailInMockChainError,
+  )
+where
+
+import Cooked.Skeleton.User
+import Ledger.Index qualified as Ledger
+import Ledger.Slot qualified as Ledger
+import Ledger.Tx qualified as Ledger
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
+
+-- | Errors that can be produced by the blockchain
+data MockChainError
+  = -- | Validation errors, either in Phase 1 or Phase 2
+    MCEValidationError Ledger.ValidationPhase Ledger.ValidationError
+  | -- | The balancing user does not have enough funds
+    MCEUnbalanceable Peer Api.Value
+  | -- | The balancing user is required but missing
+    MCEMissingBalancingUser String
+  | -- | No suitable collateral could be associated with a skeleton
+    MCENoSuitableCollateral Integer Integer Api.Value
+  | -- | Translating a skeleton element to its Cardano counterpart failed
+    MCEToCardanoError Ledger.ToCardanoError
+  | -- | The required reference script is missing from a witness utxo
+    MCEWrongReferenceScriptError Api.TxOutRef Api.ScriptHash (Maybe Api.ScriptHash)
+  | -- | A UTxO is missing from the mockchain state
+    MCEUnknownOutRef Api.TxOutRef
+  | -- | A jump in time would result in a past slot
+    MCEPastSlot Ledger.Slot Ledger.Slot
+  | -- | An attempt to invoke an unsupported feature has been made
+    MCEUnsupportedFeature String
+  | -- | Used to provide 'MonadFail' instances.
+    MCEFailure String
+  deriving (Show, Eq)
+
+-- | Interpreting `Ledger.ToCardanoError` in terms of `MockChainError`
+runToCardanoErrorInMockChainError ::
+  forall effs a.
+  (Member (Error MockChainError) effs) =>
+  Sem (Error Ledger.ToCardanoError : effs) a ->
+  Sem effs a
+runToCardanoErrorInMockChainError = mapError MCEToCardanoError
+
+-- | Interpreting failures in terms of `MockChainError`
+runFailInMockChainError ::
+  forall effs a.
+  (Member (Error MockChainError) effs) =>
+  Sem (Fail : effs) a ->
+  Sem effs a
+runFailInMockChainError = interpret $
+  \(Fail s) -> throw $ MCEFailure s
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
new file mode 100644
index 000000000..e69de29bb
diff --git a/src/Cooked/MockChain/Log.hs b/src/Cooked/MockChain/Log.hs
new file mode 100644
index 000000000..2ce7dc98c
--- /dev/null
+++ b/src/Cooked/MockChain/Log.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Cooked.MockChain.Log
+  ( -- * Log entries
+    MockChainLogEntry (..),
+
+    -- * Logging effect
+    MockChainLog,
+    runMockChainLog,
+
+    -- * Logging primitive
+    logEvent,
+  )
+where
+
+import Cooked.MockChain.Common
+import Cooked.Skeleton
+import Plutus.Script.Utils.Scripts qualified as Script
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Writer
+
+-- | Events logged when processing transaction skeletons
+data MockChainLogEntry
+  = -- | Logging a Skeleton as it is submitted by the user.
+    MCLogSubmittedTxSkel TxSkel
+  | -- | Logging a Skeleton as it has been adjusted by the balancing mechanism,
+    -- alongside fee, and possible collateral utxos and return collateral user.
+    MCLogAdjustedTxSkel TxSkel Fee Collaterals
+  | -- | Logging the successful validation of a new transaction, with its id and
+    -- number of produced outputs.
+    MCLogNewTx Api.TxId Integer
+  | -- | Logging the fact that utxos provided by the user for balancing have to be
+    -- discarded for a specific reason.
+    MCLogDiscardedUtxos Integer String
+  | -- | Logging the fact that utxos provided as collaterals will not be used
+    -- because the transaction does not involve scripts. There are 2 cases,
+    -- depending on whether the user has provided an explicit user or a set of
+    -- utxos to be used as collaterals.
+    MCLogUnusedCollaterals (Either Peer CollateralIns)
+  | -- | Logging the automatic addition of a reference script
+    MCLogAddedReferenceScript TxSkelRedeemer Api.TxOutRef Script.ScriptHash
+  | -- | Logging the automatic addition of a withdrawal amount
+    MCLogAutoFilledWithdrawalAmount Api.Credential Api.Lovelace
+  | -- | Logging the automatic addition of the constitution script
+    MCLogAutoFilledConstitution Api.ScriptHash
+  | -- | Logging the automatic adjustment of a min ada amount
+    MCLogAdjustedTxSkelOut TxSkelOut Api.Lovelace
+  deriving (Show)
+
+-- | An effect to allow logging of mockchain events
+data MockChainLog :: Effect where
+  LogEvent :: MockChainLogEntry -> MockChainLog m ()
+
+makeSem_ ''MockChainLog
+
+-- | Interpreting a `MockChainLog` in terms of a writer of
+-- @[MockChainLogEntry]@
+runMockChainLog ::
+  (Member (Writer [MockChainLogEntry]) effs) =>
+  Sem (MockChainLog : effs) a ->
+  Sem effs a
+runMockChainLog = interpret $ \(LogEvent event) -> tell [event]
+
+-- | Logs an internal event occurring while processing a transaction skeleton
+logEvent :: (Member MockChainLog effs) => MockChainLogEntry -> Sem effs ()
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
new file mode 100644
index 000000000..0cc2a98c4
--- /dev/null
+++ b/src/Cooked/MockChain/Misc.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | This module defines primitives that offer quality of life features when
+-- operating a mockchain without interacting with the mockchain state itself.
+module Cooked.MockChain.Misc
+  ( -- * Misc effect
+    MockChainMisc,
+    runMockChainMisc,
+
+    -- * Misc primitives
+    define,
+    defineM,
+  )
+where
+
+import Cooked.Pretty
+import Polysemy
+
+-- | An effect that corresponds to extra QOL capabilities of the MockChain
+data MockChainMisc :: Effect where
+  Define :: (ToHash a) => String -> a -> MockChainMisc m a
+
+makeSem_ ''MockChainMisc
+
+-- | Interpreting a `MockChainMisc` in terms of a writer of @Map
+-- BuiltinByteString String@
+runMockChainMisc ::
+  forall effs a.
+  (Member (Writer (Map Api.BuiltinByteString String)) effs) =>
+  Sem (MockChainMisc : effs) a ->
+  Sem effs a
+runMockChainMisc = interpret $
+  \(Define name hashable) -> do
+    tell $ Map.singleton (toHash hashable) name
+    return hashable
+
+-- | Stores an alias matching a hashable data for pretty printing purpose
+define :: (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a
+
+-- | Like `define`, but binds the result of a monadic computation instead
+defineM :: (Member MockChainMisc effs) => String -> Sem effs a -> Sem effs a
+defineM name = (define name =<<)
diff --git a/src/Cooked/MockChain/Read.hs b/src/Cooked/MockChain/Read.hs
new file mode 100644
index 000000000..971d61530
--- /dev/null
+++ b/src/Cooked/MockChain/Read.hs
@@ -0,0 +1,407 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | This module exposes primitives to query the current state of the
+-- blockchain.
+module Cooked.MockChain.Read
+  ( -- * The `MockChainRead` effect
+    MockChainRead,
+    runMockChainRead,
+
+    -- * Queries related to protocol parameters
+    getParams,
+    govActionDeposit,
+    dRepDeposit,
+    stakeAddressDeposit,
+    stakePoolDeposit,
+
+    -- * Queries related to `Cooked.Skeleton.TxSkel`
+    txSkelDepositedValueInCertificates,
+    txSkelDepositedValueInProposals,
+    txSkelAllScripts,
+    txSkelInputScripts,
+    txSkelInputValue,
+
+    -- * Queries related to timing
+    currentSlot,
+    currentMSRange,
+    getEnclosingSlot,
+    slotRangeBefore,
+    slotRangeAfter,
+    slotToMSRange,
+
+    -- * Queries related to fetching UTxOs
+    allUtxos,
+    utxosAt,
+    txSkelOutByRef,
+    utxosFromCardanoTx,
+    lookupUtxos,
+    previewByRef,
+    viewByRef,
+
+    -- * Other queries
+    getConstitutionScript,
+    getCurrentReward,
+  )
+where
+
+import Cardano.Api qualified as Cardano
+import Cardano.Ledger.Conway.Core qualified as Conway
+import Cardano.Node.Emulator.Internal.Node qualified as Emulator
+import Control.Lens qualified as Lens
+import Control.Monad
+import Cooked.MockChain.Common
+import Cooked.MockChain.Error
+import Cooked.MockChain.MockChainState
+import Cooked.Skeleton
+import Data.Coerce (coerce)
+import Data.Map (Map)
+import Data.Map qualified as Map
+import Data.Maybe
+import Ledger.Slot qualified as Ledger
+import Ledger.Tx qualified as Ledger
+import Ledger.Tx.CardanoAPI qualified as Ledger
+import Optics.Core
+import Plutus.Script.Utils.Address qualified as Script
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
+import Polysemy.State
+
+-- | An effect that offers primitives to query the current state of the
+-- mockchain. As its name suggests, this effect is read-only and does not alter
+-- the state in any way.
+data MockChainRead :: Effect where
+  GetParams :: MockChainRead m Emulator.Params
+  TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
+  CurrentSlot :: MockChainRead m Ledger.Slot
+  AllUtxos :: MockChainRead m Utxos
+  UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m Utxos
+  GetConstitutionScript :: MockChainRead m (Maybe VScript)
+  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
+
+makeSem_ ''MockChainRead
+
+-- | The interpretation for read-only effect in the blockchain state
+runMockChainRead ::
+  forall effs a.
+  ( Members
+      '[ State MockChainState,
+         Error Ledger.ToCardanoError,
+         Error MockChainError
+       ]
+      effs
+  ) =>
+  Sem (MockChainRead : effs) a ->
+  Sem effs a
+runMockChainRead = interpret $ \case
+  GetParams -> gets mcstParams
+  TxSkelOutByRef oRef -> do
+    res <- gets $ Map.lookup oRef . mcstOutputs
+    case res of
+      Just (txSkelOut, True) -> return txSkelOut
+      _ -> throw $ MCEUnknownOutRef oRef
+  AllUtxos -> fetchUtxos $ const True
+  UtxosAt (Script.toAddress -> addr) -> fetchUtxos $ (== addr) . Script.toAddress
+  CurrentSlot -> gets $ view $ mcstLedgerStateL % to Emulator.getSlot
+  GetConstitutionScript -> gets $ view mcstConstitutionL
+  GetCurrentReward (Script.toCredential -> cred) -> do
+    stakeCredential <- undefined
+    gets $
+      preview $
+        mcstLedgerStateL
+          % to (Emulator.getReward stakeCredential)
+          % _Just
+          % to coerce
+  where
+    fetchUtxos decide =
+      gets $
+        toListOf $
+          mcstOutputsL
+            % to Map.toList
+            % traversed
+            % filtered (snd . snd)
+            % filtered (decide . fst . snd)
+            % to (fmap fst)
+
+-- | Returns the emulator parameters, including protocol parameters
+getParams ::
+  (Member MockChainRead effs) =>
+  Sem effs Emulator.Params
+
+-- | Retrieves the required governance action deposit amount
+govActionDeposit ::
+  (Member MockChainRead effs) =>
+  Sem effs Api.Lovelace
+govActionDeposit =
+  getParams
+    <&> Api.Lovelace
+    . Cardano.unCoin
+    . Lens.view Conway.ppGovActionDepositL
+    . Emulator.emulatorPParams
+
+-- | Retrieves the required drep deposit amount
+dRepDeposit ::
+  (Member MockChainRead effs) =>
+  Sem effs Api.Lovelace
+dRepDeposit =
+  getParams
+    <&> Api.Lovelace
+    . Cardano.unCoin
+    . Lens.view Conway.ppDRepDepositL
+    . Emulator.emulatorPParams
+
+-- | Retrieves the required stake address deposit amount
+stakeAddressDeposit ::
+  (Member MockChainRead effs) =>
+  Sem effs Api.Lovelace
+stakeAddressDeposit =
+  getParams
+    <&> Api.Lovelace
+    . Cardano.unCoin
+    . Lens.view Conway.ppKeyDepositL
+    . Emulator.emulatorPParams
+
+-- | Retrieves the required stake pool deposit amount
+stakePoolDeposit ::
+  (Member MockChainRead effs) =>
+  Sem effs Api.Lovelace
+stakePoolDeposit =
+  getParams
+    <&> Api.Lovelace
+    . Cardano.unCoin
+    . Lens.view Conway.ppPoolDepositL
+    . Emulator.emulatorPParams
+
+-- | Retrieves the total amount of lovelace deposited in certificates in this
+-- skeleton. Note that unregistering a staking address or a dRep lead to a
+-- negative deposit (a withdrawal, in fact) which means this function can return
+-- a negative amount of lovelace, which is intended. The deposited amounts are
+-- dictated by the current protocol parameters, and computed as such.
+txSkelDepositedValueInCertificates ::
+  (Member MockChainRead effs) =>
+  TxSkel ->
+  Sem effs Api.Lovelace
+txSkelDepositedValueInCertificates txSkel = do
+  sDep <- stakeAddressDeposit
+  dDep <- dRepDeposit
+  pDep <- stakePoolDeposit
+  return $
+    foldOf
+      ( txSkelCertificatesL
+          % traversed
+          % to
+            ( \case
+                TxSkelCertificate _ StakingRegister {} -> sDep
+                TxSkelCertificate _ StakingRegisterDelegate {} -> sDep
+                TxSkelCertificate _ StakingUnRegister {} -> -sDep
+                TxSkelCertificate _ DRepRegister {} -> dDep
+                TxSkelCertificate _ DRepUnRegister {} -> -dDep
+                TxSkelCertificate _ PoolRegister {} -> pDep
+                -- There is no special case for 'PoolRetire' because the deposit
+                -- is given back to the reward account.
+                _ -> Api.Lovelace 0
+            )
+      )
+      txSkel
+
+-- | Retrieves the total amount of lovelace deposited in proposals in this
+-- skeleton (equal to `govActionDeposit` times the number of proposals)
+txSkelDepositedValueInProposals ::
+  (Member MockChainRead effs) =>
+  TxSkel ->
+  Sem effs Api.Lovelace
+txSkelDepositedValueInProposals TxSkel {txSkelProposals} =
+  govActionDeposit
+    <&> Api.Lovelace
+    . (toInteger (length txSkelProposals) *)
+    . Api.getLovelace
+
+-- | Returns all scripts involved in this 'TxSkel'
+txSkelAllScripts ::
+  (Member MockChainRead effs) =>
+  TxSkel ->
+  Sem effs [VScript]
+txSkelAllScripts txSkel = do
+  txSkelSpendingScripts <- txSkelInputScripts txSkel
+  return
+    ( txSkelMintingScripts txSkel
+        <> txSkelWithdrawingScripts txSkel
+        <> txSkelProposingScripts txSkel
+        <> txSkelCertifyingScripts txSkel
+        <> txSkelSpendingScripts
+    )
+
+-- | Returns all scripts which guard transaction inputs
+txSkelInputScripts ::
+  (Member MockChainRead effs) =>
+  TxSkel ->
+  Sem effs [VScript]
+txSkelInputScripts =
+  fmap catMaybes
+    . mapM (previewByRef (txSkelOutOwnerL % userVScriptAT))
+    . Map.keys
+    . txSkelIns
+
+-- | look up the UTxOs the transaction consumes, and sum their values.
+txSkelInputValue ::
+  (Member MockChainRead effs) =>
+  TxSkel ->
+  Sem effs Api.Value
+txSkelInputValue =
+  fmap mconcat
+    . mapM (viewByRef txSkelOutValueL)
+    . Map.keys
+    . txSkelIns
+
+-- | Returns the current slot
+currentSlot ::
+  (Member MockChainRead effs) =>
+  Sem effs Ledger.Slot
+
+-- | Returns the closed ms interval corresponding to the current slot
+currentMSRange ::
+  (Members '[MockChainRead, Fail] effs) =>
+  Sem effs (Api.POSIXTime, Api.POSIXTime)
+currentMSRange = slotToMSRange =<< currentSlot
+
+-- | Return the slot that contains the given time. See 'slotToMSRange' for
+-- some satisfied equational properties.
+getEnclosingSlot ::
+  (Member MockChainRead effs) =>
+  Api.POSIXTime ->
+  Sem effs Ledger.Slot
+getEnclosingSlot t =
+  getParams
+    <&> (`Emulator.posixTimeToEnclosingSlot` t)
+    . Emulator.pSlotConfig
+
+-- | The infinite range of slots ending before or at the given time
+slotRangeBefore ::
+  (Members '[MockChainRead, Fail] effs) =>
+  Api.POSIXTime ->
+  Sem effs Ledger.SlotRange
+slotRangeBefore t = do
+  n <- getEnclosingSlot t
+  (_, b) <- slotToMSRange n
+  -- If the given time @t@ happens to be the last ms of its slot, we can include
+  -- the whole slot. Otherwise, the only way to be sure that the returned slot
+  -- range contains no time after @t@ is to go to the preceding slot.
+  return $ Api.to $ if t == b then n else n - 1
+
+-- | The infinite range of slots starting after or at the given time
+slotRangeAfter ::
+  (Members '[MockChainRead, Fail] effs) =>
+  Api.POSIXTime ->
+  Sem effs Ledger.SlotRange
+slotRangeAfter t = do
+  n <- getEnclosingSlot t
+  (a, _) <- slotToMSRange n
+  return $ Api.from $ if t == a then n else n + 1
+
+-- | Returns the closed ms interval corresponding to the slot with the given
+-- number. It holds that
+--
+-- > slotToMSRange (getEnclosingSlot t) == (a, b)    ==>   a <= t <= b
+--
+-- and
+--
+-- > slotToMSRange n == (a, b)   ==>   getEnclosingSlot a == n && getEnclosingSlot b == n
+--
+-- and
+--
+-- > slotToMSRange n == (a, b)   ==>   getEnclosingSlot (a-1) == n-1 && getEnclosingSlot (b+1) == n+1
+slotToMSRange ::
+  ( Members '[MockChainRead, Fail] effs,
+    Integral i
+  ) =>
+  i ->
+  Sem effs (Api.POSIXTime, Api.POSIXTime)
+slotToMSRange (fromIntegral -> slot) = do
+  slotConfig <- Emulator.pSlotConfig <$> getParams
+  case Emulator.slotToPOSIXTimeRange slotConfig slot of
+    Api.Interval
+      (Api.LowerBound (Api.Finite l) leftclosed)
+      (Api.UpperBound (Api.Finite r) rightclosed) ->
+        return
+          ( if leftclosed then l else l + 1,
+            if rightclosed then r else r - 1
+          )
+    _ -> fail "Unexpected unbounded slot: please report a bug at https://github.com/tweag/cooked-validators/issues"
+
+-- | Returns a list of all currently known outputs
+allUtxos ::
+  (Member MockChainRead effs) =>
+  Sem effs Utxos
+
+-- | Returns a list of all UTxOs at a certain address.
+utxosAt ::
+  ( Member MockChainRead effs,
+    Script.ToAddress a
+  ) =>
+  a ->
+  Sem effs Utxos
+
+-- | Returns an output given a reference to it
+txSkelOutByRef ::
+  (Member MockChainRead effs) =>
+  Api.TxOutRef ->
+  Sem effs TxSkelOut
+
+-- | Retrieves the ordered list of outputs of the given "CardanoTx".
+--
+-- This is useful when writing endpoints and/or traces to fetch utxos of
+-- interest right from the start and avoid querying the chain for them
+-- afterwards using 'allUtxos' or similar functions.
+utxosFromCardanoTx ::
+  (Member MockChainRead effs) =>
+  Ledger.CardanoTx ->
+  Sem effs [(Api.TxOutRef, TxSkelOut)]
+utxosFromCardanoTx =
+  mapM (\txOutRef -> (txOutRef,) <$> txSkelOutByRef txOutRef)
+    . fmap (Ledger.fromCardanoTxIn . snd)
+    . Ledger.getCardanoTxOutRefs
+
+-- | Go through all of the 'Api.TxOutRef's in the list and look them up in the
+-- state of the blockchain, throwing an error if one of them cannot be resolved.
+lookupUtxos ::
+  (Member MockChainRead effs) =>
+  [Api.TxOutRef] ->
+  Sem effs (Map Api.TxOutRef TxSkelOut)
+lookupUtxos =
+  foldM
+    (\m oRef -> flip (Map.insert oRef) m <$> txSkelOutByRef oRef)
+    Map.empty
+
+-- | Retrieves an output and views a specific element out of it
+viewByRef ::
+  ( Member MockChainRead effs,
+    Is g A_Getter
+  ) =>
+  Optic' g is TxSkelOut c ->
+  Api.TxOutRef ->
+  Sem effs c
+viewByRef optic = (view optic <$>) . txSkelOutByRef
+
+-- | Retrieves an output and previews a specific element out of it
+previewByRef ::
+  ( Member MockChainRead effs,
+    Is af An_AffineFold
+  ) =>
+  Optic' af is TxSkelOut c ->
+  Api.TxOutRef ->
+  Sem effs (Maybe c)
+previewByRef optic = (preview optic <$>) . txSkelOutByRef
+
+-- | Gets the current official constitution script
+getConstitutionScript ::
+  (Member MockChainRead effs) =>
+  Sem effs (Maybe VScript)
+
+-- | Gets the current reward associated with a credential
+getCurrentReward ::
+  ( Member MockChainRead effs,
+    Script.ToCredential c
+  ) =>
+  c ->
+  Sem effs (Maybe Api.Lovelace)
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
new file mode 100644
index 000000000..63c6b83a7
--- /dev/null
+++ b/src/Cooked/MockChain/Write.hs
@@ -0,0 +1,145 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | This module exposes primitives to update the current state of the
+-- blockchain, including by sending transactions for validation.
+module Cooked.MockChain.Write
+  ( -- * The `MockChainWrite` effect
+    MockChainWrite,
+    reinterpretMockChainWriteWithTweaks,
+    runMockChainWrite,
+
+    -- * Modifications of the current time
+    waitNSlots,
+    awaitSlot,
+    awaitEnclosingSlot,
+    waitNMSFromSlotLowerBound,
+    waitNMSFromSlotUpperBound,
+
+    -- * Sending `Cooked.Skeleton.TxSkel`s for validation
+    validateTxSkel,
+    validateTxSkel',
+    validateTxSkel_,
+
+    -- * Other operations
+    setParams,
+    setConstitutionScript,
+    forceOutputs,
+  )
+where
+
+import Cardano.Node.Emulator qualified as Emulator
+import Cooked.Ltl
+import Cooked.Skeleton
+import Cooked.Tweak
+import Ledger.Slot qualified as Ledger
+import Ledger.Tx qualified as Ledger
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+
+-- | An effect that offers all the primitives that are performing modifications
+-- on the blockchain state.
+data MockChainWrite :: Effect where
+  WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
+  SetParams :: Emulator.Params -> MockChainWrite m ()
+  ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
+  SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
+  ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
+
+makeSem_ ''MockChainWrite
+
+-- | Reinterpretes `MockChainWrite` in itself, when the `ModifyLocally` effect
+-- exists in the stack, applying the relevant modifications in the process.
+reinterpretMockChainWriteWithTweak ::
+  forall tweakEffs effs a.
+  ( Members
+      '[ ModifyLocally (UntypedTweak tweakEffs),
+         NonDet
+       ]
+      effs,
+    Subsume tweakEffs effs
+  ) =>
+  Sem (MockChainWrite : effs) a ->
+  Sem (MockChainWrite : effs) a
+reinterpretMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
+  ValidateTxSkel skel -> do
+    requirements <- getRequirements
+    let sumTweak :: Sem (Tweak : NonDet : tweakEffs) () =
+          foldr
+            ( \req acc -> case req of
+                Apply (UntypedTweak tweak) -> tweak >> acc
+                EnsureFailure (UntypedTweak tweak) -> do
+                  txSkel' <- getTxSkel
+                  results <- raise_ $ runNonDet @[] $ runTweak txSkel' tweak
+                  guard $ null results
+                  acc
+            )
+            (return ())
+            requirements
+    newTxSkel <- raise $ subsume_ $ fst <$> runTweak skel sumTweak
+    validateTxSkel newTxSkel
+  a -> send $ coerce a
+
+-- | Interpretes the `MockChainWrite` effect
+runMockChainWrite ::
+  forall effs a.
+  ( Members
+      '[ State MockChainState,
+         Error Ledger.ToCardanoError,
+         Error MockChainError,
+         MockChainLog,
+         MockChainRead,
+         Fail
+       ]
+      effs
+  ) =>
+  Sem (MockChainWrite : effs) a ->
+  Sem effs a
+runMockChainWrite = interpret $ \case
+  ValidateTxSkel skel -> do
+    undefined
+  ForceOutputs outs -> undefined
+  builtin -> undefined
+
+-- | Waits a certain number of slots and returns the new slot
+waitNSlots :: (Member MockChainWrite effs) => Integer -> Sem effs Ledger.Slot
+
+-- | Wait for a certain slot, or throws an error if the slot is already past
+awaitSlot :: (Member MockChainWrite effs, Integral i) => i -> m Ledger.Slot
+awaitSlot slot = currentSlot >>= waitNSlots . (slot -) . fromIntegral
+
+-- | Waits until the current slot becomes greater or equal to the slot
+--  containing the given POSIX time.  Note that that it might not wait for
+--  anything if the current slot is large enough.
+awaitEnclosingSlot :: (Member MockChainWrite effs) => Api.POSIXTime -> m Ledger.Slot
+awaitEnclosingSlot = awaitSlot <=< getEnclosingSlot
+
+-- | Wait a given number of ms from the lower bound of the current slot and
+-- returns the current slot after waiting.
+waitNMSFromSlotLowerBound :: (Member MockChainWrite effs, Integral i) => i -> m Ledger.Slot
+waitNMSFromSlotLowerBound duration = currentMSRange >>= awaitEnclosingSlot . (+ fromIntegral duration) . fst
+
+-- | Wait a given number of ms from the upper bound of the current slot and
+-- returns the current slot after waiting.
+waitNMSFromSlotUpperBound :: (Member MockChainWrite effs, Integral i) => i -> m Ledger.Slot
+waitNMSFromSlotUpperBound duration = currentMSRange >>= awaitEnclosingSlot . (+ fromIntegral duration) . snd
+
+-- | Generates, balances and validates a transaction from a skeleton, and
+-- returns the validated transaction.
+validateTxSkel :: (Member MockChainWrite effs) => TxSkel -> Sem effs Ledger.CardanoTx
+
+-- | Same as `validateTxSkel`, but only returns the generated UTxOs
+validateTxSkel' :: (Member MockChainWrite effs) => TxSkel -> m [Api.TxOutRef]
+validateTxSkel' = ((fmap fst <$>) . utxosFromCardanoTx) <=< validateTxSkel
+
+-- | Same as `validateTxSkel`, but discards the returned transaction
+validateTxSkel_ :: (Member MockChainWrite effs) => TxSkel -> m ()
+validateTxSkel_ = void . validateTxSkel
+
+-- | Updates the current parameters
+setParams :: (Member MockChainWrite effs) => Emulator.Params -> Sem effs ()
+
+-- | Sets the current script to act as the official constitution script
+setConstitutionScript :: (Member MockChainWrite effs, ToVScript s) => s -> Sem eff ()
+
+-- | Forces the generation of utxos corresponding to certain `TxSkelOut`
+forceOutputs :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs [Api.TxOutRef]
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index 7a77b3e39..bb84330d4 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -4,9 +4,7 @@
 -- attacks. They are skeleton modifications aware of the mockchain state.
 module Cooked.Tweak.Common
   ( -- * Tweak effect
-    TweakEff (..),
-    getTxSkel,
-    putTxSkel,
+    Tweak (..),
     runTweak,
 
     -- * Untyped tweaks
@@ -15,6 +13,10 @@ module Cooked.Tweak.Common
     -- * Optics
     selectP,
 
+    -- * Tweak primitives
+    getTxSkel,
+    putTxSkel,
+
     -- * Optics tweaks
     viewTweak,
     viewAllTweak,
@@ -39,18 +41,18 @@ import Polysemy.NonDet
 import Polysemy.State
 
 -- | An effet that allows to store or retrieve a `TxSkel` from a context
-data TweakEff :: Effect where
+data Tweak :: Effect where
   -- | Retrieves the `TxSkel` from the context
-  GetTxSkel :: TweakEff m TxSkel
+  GetTxSkel :: Tweak m TxSkel
   -- | Overrides the `TxSkel` in the context
-  PutTxSkel :: TxSkel -> TweakEff m ()
+  PutTxSkel :: TxSkel -> Tweak m ()
 
-makeSem ''TweakEff
+makeSem ''Tweak
 
 -- | Running a Tweak is equivalent to running a state monad storing a `TxSkel`
 runTweak ::
   TxSkel ->
-  Sem (TweakEff : effs) a ->
+  Sem (Tweak : effs) a ->
   Sem effs (TxSkel, a)
 runTweak txSkel =
   runState txSkel
@@ -64,32 +66,32 @@ runTweak txSkel =
 -- `Cooked.Ltl`. They encompass a computation which can branch and has access to
 -- a `TxSkel` on top of other effects.
 data UntypedTweak effs where
-  UntypedTweak :: Sem (TweakEff : NonDet : effs) a -> UntypedTweak effs
+  UntypedTweak :: Sem (Tweak : NonDet : effs) a -> UntypedTweak effs
 
 -- | Retrieves some value from the 'TxSkel'
 viewTweak ::
-  (Member TweakEff effs, Is k A_Getter) =>
+  (Member Tweak effs, Is k A_Getter) =>
   Optic' k is TxSkel a ->
   Sem effs a
 viewTweak optic = getTxSkel <&> view optic
 
 -- | Like 'viewTweak', only for indexed optics.
 iviewTweak ::
-  (Member TweakEff effs, Is k A_Getter) =>
+  (Member Tweak effs, Is k A_Getter) =>
   Optic' k (WithIx is) TxSkel a ->
   Sem effs (is, a)
 iviewTweak optic = getTxSkel <&> iview optic
 
 -- | Like the 'viewTweak', but returns a list of all foci
 viewAllTweak ::
-  (Member TweakEff effs, Is k A_Fold) =>
+  (Member Tweak effs, Is k A_Fold) =>
   Optic' k is TxSkel a ->
   Sem effs [a]
 viewAllTweak optic = getTxSkel <&> toListOf optic
 
 -- | The tweak that sets a certain value in the 'TxSkel'.
 setTweak ::
-  (Member TweakEff effs, Is k A_Setter) =>
+  (Member Tweak effs, Is k A_Setter) =>
   Optic' k is TxSkel a ->
   a ->
   Sem effs ()
@@ -97,7 +99,7 @@ setTweak optic = overTweak optic . const
 
 -- | The tweak that modifies a certain value in the 'TxSkel'.
 overTweak ::
-  (Member TweakEff effs, Is k A_Setter) =>
+  (Member Tweak effs, Is k A_Setter) =>
   Optic' k is TxSkel a ->
   (a -> a) ->
   Sem effs ()
@@ -108,7 +110,7 @@ overTweak optic change = getTxSkel >>= putTxSkel . over optic change
 -- as they were /before/ the tweak, and in the order in which they occurred on
 -- the original transaction.
 overMaybeTweak ::
-  (Member TweakEff effs, Is k A_Traversal) =>
+  (Member Tweak effs, Is k A_Traversal) =>
   Optic' k is TxSkel a ->
   (a -> Maybe a) ->
   Sem effs [a]
@@ -120,7 +122,7 @@ overMaybeTweak optic mChange = overMaybeSelectingTweak optic mChange (const True
 -- argument can be used to select which of the modifiable foci should be
 -- actually modified.
 overMaybeSelectingTweak ::
-  (Member TweakEff effs, Is k A_Traversal) =>
+  (Member Tweak effs, Is k A_Traversal) =>
   Optic' k is TxSkel a ->
   (a -> Maybe a) ->
   (Integer -> Bool) ->
@@ -240,7 +242,7 @@ overMaybeSelectingTweak optic mChange select = do
 -- So you see that tweaks constructed like this can branch quite wildly. Use
 -- with caution!
 combineModsTweak ::
-  (Eq is, Is k A_Traversal, Members '[TweakEff, NonDet] effs) =>
+  (Eq is, Is k A_Traversal, Members '[Tweak, NonDet] effs) =>
   ([is] -> [[is]]) ->
   Optic' k (WithIx is) TxSkel x ->
   (is -> x -> Sem effs [(x, l)]) ->

From b3fbf0caa35baef658023d76a972e44e6eb4141d Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 22 Jan 2026 01:38:54 +0100
Subject: [PATCH 31/96] removing old files

---
 cooked-validators.cabal           |   2 -
 src/Cooked/Effectful.hs           |  92 ------------
 src/Cooked/Ltl.hs                 |  38 ++---
 src/Cooked/MockChain.hs           |   8 +-
 src/Cooked/MockChain/Instances.hs |  69 +++++++++
 src/Cooked/MockChain/Staged.hs    | 228 ------------------------------
 src/Cooked/MockChain/Write.hs     |  31 ++--
 7 files changed, 115 insertions(+), 353 deletions(-)
 delete mode 100644 src/Cooked/Effectful.hs
 delete mode 100644 src/Cooked/MockChain/Staged.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index cd534bdd8..ff81de896 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -17,7 +17,6 @@ library
       Cooked.Attack.AddToken
       Cooked.Attack.DatumHijacking
       Cooked.Attack.DoubleSat
-      Cooked.Effectful
       Cooked.Families
       Cooked.InitialDistribution
       Cooked.Ltl
@@ -44,7 +43,6 @@ library
       Cooked.MockChain.Misc
       Cooked.MockChain.MockChainState
       Cooked.MockChain.Read
-      Cooked.MockChain.Staged
       Cooked.MockChain.Testing
       Cooked.MockChain.UtxoSearch
       Cooked.MockChain.UtxoState
diff --git a/src/Cooked/Effectful.hs b/src/Cooked/Effectful.hs
deleted file mode 100644
index cec90a228..000000000
--- a/src/Cooked/Effectful.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Cooked.Effectful where
-
-import Cardano.Api qualified as Cardano
-import Cardano.Node.Emulator.Internal.Node qualified as Emulator
-import Control.Monad (guard, msum, unless)
-import Cooked.MockChain.BlockChain (MockChainError (..), MockChainLogEntry)
-import Cooked.MockChain.Direct (MockChainBook (..))
-import Cooked.MockChain.MockChainState (MockChainState (..), mcstConstitutionL, mcstLedgerStateL)
-import Cooked.Pretty.Hashable (ToHash, toHash)
-import Cooked.Skeleton (ToVScript, TxSkel, TxSkelOut, VScript)
-import Data.Coerce
-import Data.Default
-import Data.Map qualified as Map
-import Data.Maybe (mapMaybe)
-import Ledger.Slot qualified as Ledger
-import Ledger.Tx.CardanoAPI qualified as Ledger
-import Optics.Core
-import Plutus.Script.Utils.Address qualified as Script
-import PlutusLedgerApi.V3 qualified as Api
-import Polysemy
-import Polysemy.Error (Error (..), mapError, runError, throw)
-import Polysemy.Fail (Fail (Fail))
-import Polysemy.Internal (Subsume)
-import Polysemy.NonDet
-import Polysemy.State
-import Polysemy.Writer (Writer, runWriter, tell)
-
--- * MockChainDirect
-
--- | A possible stack of effects to handle a direct interpretation of the
--- mockchain, that is without any tweaks nor branching.
-type MockChainDirect a =
-  Sem
-    '[ MockChainWrite,
-       MockChainRead,
-       MockChainMisc,
-       Fail
-     ]
-    a
-
-runMockChainDirect :: MockChainDirect a -> (MockChainBook, (MockChainState, Either MockChainError a))
-runMockChainDirect =
-  run
-    . runWriter
-    . runMockChainLog
-    . runState def
-    . runError
-    . runToCardanoError
-    . runFailInMockChainError
-    . runMockChainMisc
-    . runMockChainRead
-    . runMockChainWrite
-    . insertAt @4 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
-
--- * MockChainFull
-
-type TweakStack = '[MockChainRead, Fail, NonDet]
-
--- | A possible stack of effects to handle staged interpretation of the
--- mockchain, that is with tweaks and branching.
-type MockChainFull a =
-  Sem
-    [ ModifyOnTime (UntypedTweak TweakStack),
-      MockChainWrite,
-      MockChainMisc,
-      MockChainRead,
-      Fail,
-      NonDet
-    ]
-    a
-
-runMockChainFull :: MockChainFull a -> [(MockChainBook, (MockChainState, Either MockChainError a))]
-runMockChainFull =
-  run
-    . runNonDet
-    . runWriter
-    . runMockChainLog
-    . runState def
-    . runError
-    . runToCardanoError
-    . runFailInMockChainError
-    . runMockChainRead
-    . runMockChainMisc
-    . evalState []
-    . runModifyLocally
-    . runMockChainWrite
-    . insertAt @6 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
-    . interceptMockChainWriteWithTweak
-    . runModifyOnTime
-    . insertAt @2 @[ModifyLocally (UntypedTweak TweakStack), State [Ltl (UntypedTweak TweakStack)]]
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index aadc41937..f74d68fb3 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -33,12 +33,12 @@ module Cooked.Ltl
 
     -- * LTL Effects
     Requirement (..),
-    ModifyLtlEff (..),
+    ModifyGlobally,
     modifyLtl,
-    runModifyLtl,
-    FetchRequirementsEff,
+    runModifyGlobally,
+    ModifyLocally,
     getRequirements,
-    runFetchRequirements,
+    runModifyLocally,
   )
 where
 
@@ -306,18 +306,18 @@ finished (LtlNot f) = not $ finished f
 
 -- | An effect to modify a computation with an `Ltl` Formula. The idea is that
 -- the formula pinpoints locations where `Requirement`s should be enforced.
-data ModifyLtlEff a :: Effect where
-  ModifyLtl :: Ltl a -> m b -> ModifyLtlEff a m b
+data ModifyGlobally a :: Effect where
+  ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
 
-makeSem ''ModifyLtlEff
+makeSem ''ModifyGlobally
 
--- | Running the `ModifyLtlEff` effect requires to have access of the current
+-- | Running the `ModifyGlobally` effect requires to have access of the current
 -- list of `Ltl` formulas, and to have access to an empty computation.
 --
 -- A new formula is appended at the head of the current list of formula. Then,
 -- the actual computation is run, after which the newly added formula must be
 -- finished, otherwise the empty computation is returned.
-runModifyLtl ::
+runModifyGlobally ::
   forall modification effs a.
   ( Members
       '[ State [Ltl modification],
@@ -325,14 +325,14 @@ runModifyLtl ::
        ]
       effs
   ) =>
-  Sem (ModifyLtlEff modification ': effs) a ->
+  Sem (ModifyGlobally modification ': effs) a ->
   Sem effs a
-runModifyLtl =
+runModifyGlobally =
   interpretH $ \case
     ModifyLtl formula comp -> do
       modify (formula :)
       comp' <- runT comp
-      res <- raise $ runModifyLtl comp'
+      res <- raise $ runModifyGlobally comp'
       formulas <- get
       unless (null formulas) $ do
         guard (finished (head formulas))
@@ -341,19 +341,19 @@ runModifyLtl =
 
 -- | An effect to request and consume the list of requirements that should be
 -- enforced at the current time step.
-data FetchRequirementsEff a :: Effect where
-  GetRequirements :: FetchRequirementsEff a m [Requirement a]
+data ModifyLocally a :: Effect where
+  GetRequirements :: ModifyLocally a m [Requirement a]
 
-makeSem ''FetchRequirementsEff
+makeSem ''ModifyLocally
 
--- | Running the `FetchRequirementsEff` effect requires to have access to the current
+-- | Running the `ModifyLocally` effect requires to have access to the current
 -- list of `Ltl` formulas, and to be able to branch.
 --
 -- The function `nowLaterList` is invoked to fetch the various paths implied by
 -- the current formulas, and a branching is performed to explore all of
 -- them. The new formulas for next steps are stored, and each path is given the
 -- requirements to enforce at the current time step.
-runFetchRequirements ::
+runModifyLocally ::
   forall modification effs a.
   ( Members
       '[ State [Ltl modification],
@@ -361,9 +361,9 @@ runFetchRequirements ::
        ]
       effs
   ) =>
-  Sem (FetchRequirementsEff modification : effs) a ->
+  Sem (ModifyLocally modification : effs) a ->
   Sem effs a
-runFetchRequirements =
+runModifyLocally =
   interpret $ \GetRequirements -> do
     modifications <- gets nowLaterList
     msum . (modifications <&>) $ \(now, later) -> put later >> return now
diff --git a/src/Cooked/MockChain.hs b/src/Cooked/MockChain.hs
index 8b266d376..d591cc91e 100644
--- a/src/Cooked/MockChain.hs
+++ b/src/Cooked/MockChain.hs
@@ -4,10 +4,14 @@ module Cooked.MockChain (module X) where
 
 import Cooked.MockChain.AutoFilling as X
 import Cooked.MockChain.Balancing as X
-import Cooked.MockChain.BlockChain as X
+import Cooked.MockChain.Common as X
 import Cooked.MockChain.Direct as X
+import Cooked.MockChain.Error as X
+import Cooked.MockChain.Instances as X
+import Cooked.MockChain.Misc as X
 import Cooked.MockChain.MockChainState as X
-import Cooked.MockChain.Staged as X
+import Cooked.MockChain.Read as X
 import Cooked.MockChain.Testing as X
 import Cooked.MockChain.UtxoSearch as X
 import Cooked.MockChain.UtxoState as X
+import Cooked.MockChain.Write as X
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index e69de29bb..fd5986e95 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -0,0 +1,69 @@
+module Cooked.MockChain.Instances where
+
+import Cooked.MockChain.Misc
+import Cooked.MockChain.Read
+import Cooked.MockChain.Write
+
+-- * MockChainDirect
+
+-- | A possible stack of effects to handle a direct interpretation of the
+-- mockchain, that is without any tweaks nor branching.
+type MockChainDirect a =
+  Sem
+    '[ MockChainWrite,
+       MockChainRead,
+       MockChainMisc,
+       Fail
+     ]
+    a
+
+runMockChainDirect :: MockChainDirect a -> (MockChainBook, (MockChainState, Either MockChainError a))
+runMockChainDirect =
+  run
+    . runWriter
+    . runMockChainLog
+    . runState def
+    . runError
+    . runToCardanoError
+    . runFailInMockChainError
+    . runMockChainMisc
+    . runMockChainRead
+    . runMockChainWrite
+    . insertAt @4 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
+
+-- * MockChainFull
+
+type TweakStack = '[MockChainRead, Fail, NonDet]
+
+-- | A possible stack of effects to handle staged interpretation of the
+-- mockchain, that is with tweaks and branching.
+type MockChainFull a =
+  Sem
+    [ ModifyOnTime (UntypedTweak TweakStack),
+      MockChainWrite,
+      MockChainMisc,
+      MockChainRead,
+      Fail,
+      NonDet
+    ]
+    a
+
+runMockChainFull :: MockChainFull a -> [(MockChainBook, (MockChainState, Either MockChainError a))]
+runMockChainFull =
+  run
+    . runNonDet
+    . runWriter
+    . runMockChainLog
+    . runState def
+    . runError
+    . runToCardanoError
+    . runFailInMockChainError
+    . runMockChainRead
+    . runMockChainMisc
+    . evalState []
+    . runModifyLocally
+    . runMockChainWrite
+    . insertAt @6 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
+    . interceptMockChainWriteWithTweak
+    . runModifyOnTime
+    . insertAt @2 @[ModifyLocally (UntypedTweak TweakStack), State [Ltl (UntypedTweak TweakStack)]]
diff --git a/src/Cooked/MockChain/Staged.hs b/src/Cooked/MockChain/Staged.hs
deleted file mode 100644
index 7e19ed117..000000000
--- a/src/Cooked/MockChain/Staged.hs
+++ /dev/null
@@ -1,228 +0,0 @@
--- | This module provides a staged implementation of our `MonadBlockChain`. The
--- motivation behind this is to be able to modify traces using `Cooked.Ltl` and
--- `Cooked.Tweak` while they are interpreted.
-module Cooked.MockChain.Staged
-  ( interpretAndRunWith,
-    interpretAndRun,
-    StagedMockChain,
-    MockChainBuiltin,
-    MockChainTweak,
-    MonadModalBlockChain,
-    InterpMockChain,
-    somewhere,
-    somewhere',
-    everywhere,
-    everywhere',
-    withTweak,
-    there,
-    there',
-    nowhere',
-    nowhere,
-    whenAble',
-    whenAble,
-  )
-where
-
-import Cardano.Node.Emulator qualified as Emulator
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Except
-import Cooked.Ltl
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.Direct
-import Cooked.Pretty.Hashable
-import Cooked.Skeleton
-import Cooked.Tweak.Common
-import Ledger.Slot qualified as Ledger
-import Ledger.Tx qualified as Ledger
-import Plutus.Script.Utils.Address qualified as Script
-import PlutusLedgerApi.V3 qualified as Api
-
--- * 'StagedMockChain': An AST for 'MonadMockChain' computations
-
--- | Abstract representation of all the builtin functions of a 'MonadBlockChain'
-data MockChainBuiltin a where
-  -- methods of 'MonadBlockChain'
-  GetParams :: MockChainBuiltin Emulator.Params
-  SetParams :: Emulator.Params -> MockChainBuiltin ()
-  ValidateTxSkel :: TxSkel -> MockChainBuiltin Ledger.CardanoTx
-  TxSkelOutByRef :: Api.TxOutRef -> MockChainBuiltin TxSkelOut
-  WaitNSlots :: (Integral i) => i -> MockChainBuiltin Ledger.Slot
-  AllUtxos :: MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
-  UtxosAt :: (Script.ToAddress a) => a -> MockChainBuiltin [(Api.TxOutRef, TxSkelOut)]
-  LogEvent :: MockChainLogEntry -> MockChainBuiltin ()
-  Define :: (ToHash a) => String -> a -> MockChainBuiltin a
-  SetConstitutionScript :: (ToVScript s) => s -> MockChainBuiltin ()
-  GetConstitutionScript :: MockChainBuiltin (Maybe VScript)
-  GetCurrentReward :: (Script.ToCredential c) => c -> MockChainBuiltin (Maybe Api.Lovelace)
-  ForceOutputs :: [TxSkelOut] -> MockChainBuiltin [Api.TxOutRef]
-  -- The empty set of traces
-  Empty :: MockChainBuiltin a
-  -- The union of two sets of traces
-  Alt :: StagedMockChain a -> StagedMockChain a -> MockChainBuiltin a
-  -- for the 'MonadError MockChainError' instance
-  ThrowError :: MockChainError -> MockChainBuiltin a
-  CatchError :: StagedMockChain a -> (MockChainError -> StagedMockChain a) -> MockChainBuiltin a
-
--- | A 'StagedMockChain' is an AST of mockchain builtins wrapped into @LtlOp@ to
--- be subject to @Ltl@ modifications.
-type StagedMockChain = StagedLtl MockChainTweak MockChainBuiltin
-
-instance Alternative StagedMockChain where
-  empty = singletonBuiltin Empty
-  a <|> b = singletonBuiltin $ Alt a b
-
-instance MonadPlus StagedMockChain where
-  mzero = empty
-  mplus = (<|>)
-
-instance MonadFail StagedMockChain where
-  fail = singletonBuiltin . ThrowError . FailWith
-
-instance MonadError MockChainError StagedMockChain where
-  throwError = singletonBuiltin . ThrowError
-  catchError act = singletonBuiltin . CatchError act
-
-instance MonadBlockChainBalancing StagedMockChain where
-  getParams = singletonBuiltin GetParams
-  txSkelOutByRef = singletonBuiltin . TxSkelOutByRef
-  utxosAt = singletonBuiltin . UtxosAt
-  logEvent = singletonBuiltin . LogEvent
-
-instance MonadBlockChainWithoutValidation StagedMockChain where
-  allUtxos = singletonBuiltin AllUtxos
-  setParams = singletonBuiltin . SetParams
-  waitNSlots = singletonBuiltin . WaitNSlots
-  define name = singletonBuiltin . Define name
-  setConstitutionScript = singletonBuiltin . SetConstitutionScript
-  getConstitutionScript = singletonBuiltin GetConstitutionScript
-  getCurrentReward = singletonBuiltin . GetCurrentReward
-
-instance MonadBlockChain StagedMockChain where
-  validateTxSkel = singletonBuiltin . ValidateTxSkel
-  forceOutputs = singletonBuiltin . ForceOutputs
-
--- * Interpreting and running 'StagedMockChain'
-
--- | The domain in which 'StagedMockChain' gets interpreted
-type InterpMockChain = MockChainT []
-
--- | Tweaks operating within the 'InterpMockChain' domain
-type MockChainTweak = UntypedTweak InterpMockChain
-
-instance ModInterpBuiltin MockChainTweak MockChainBuiltin InterpMockChain where
-  modifyAndInterpBuiltin = \case
-    GetParams -> Left getParams
-    SetParams params -> Left $ setParams params
-    ValidateTxSkel skel -> Right $ \now -> do
-      (_, skel') <-
-        (`runTweakInChain` skel) $
-          foldr
-            ( \req acc -> case req of
-                Apply (UntypedTweak tweak) -> tweak >> acc
-                EnsureFailure (UntypedTweak tweak) -> ensureFailingTweak tweak >> acc
-            )
-            doNothingTweak
-            now
-      validateTxSkel skel'
-    TxSkelOutByRef o -> Left $ txSkelOutByRef o
-    WaitNSlots s -> Left $ waitNSlots s
-    AllUtxos -> Left allUtxos
-    UtxosAt address -> Left $ utxosAt address
-    LogEvent entry -> Left $ logEvent entry
-    Define name hash -> Left $ define name hash
-    SetConstitutionScript script -> Left $ setConstitutionScript script
-    GetConstitutionScript -> Left getConstitutionScript
-    GetCurrentReward cred -> Left $ getCurrentReward cred
-    ForceOutputs outs -> Left $ forceOutputs outs
-    Empty -> Left mzero
-    Alt l r -> Left $ interpStagedLtl l `mplus` interpStagedLtl r
-    ThrowError err -> Left $ throwError err
-    CatchError act handler -> Left $ catchError (interpStagedLtl act) (interpStagedLtl . handler)
-
--- | Interprets the staged mockchain then runs the resulting computation with a
--- custom function. This can be used, for example, to supply a custom
--- 'Cooked.InitialDistribution.InitialDistribution' by providing
--- 'runMockChainTFromInitDist'.
-interpretAndRunWith :: (forall m. (Monad m) => MockChainT m a -> m res) -> StagedMockChain a -> [res]
-interpretAndRunWith f = f . interpStagedLtl
-
--- | Same as 'interpretAndRunWith' but using 'runMockChainT' as the default way
--- to run the computation.
-interpretAndRun :: StagedMockChain a -> [MockChainReturn a]
-interpretAndRun = interpretAndRunWith runMockChainT
-
--- * Modalities
-
--- | A modal mockchain is a mockchain that allows us to use LTL modifications
--- with 'Tweak's
-type MonadModalBlockChain m = (MonadBlockChain m, MonadLtl MockChainTweak m)
-
-fromTweak :: Tweak m a -> Ltl (UntypedTweak m)
-fromTweak = LtlAtom . UntypedTweak
-
--- | Apply a 'Tweak' to some transaction in the given Trace. The tweak must
--- apply at least once.
-somewhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
-somewhere = somewhere' . fromTweak
-
--- | Apply an Ltl modification somewhere in the given Trace. The modification
--- must apply at least once.
-somewhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-somewhere' = modifyLtl . ltlEventually
-
--- | Apply a 'Tweak' to every transaction in a given trace. This is also
--- successful if there are no transactions at all.
-everywhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
-everywhere = everywhere' . fromTweak
-
--- | Apply an Ltl modification everywhere it can be (including nowhere if it
--- does not apply). If the modification branches, this will branch at every
--- location the modification can be applied.
-everywhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-everywhere' = modifyLtl . ltlAlways
-
--- | Ensures a given 'Tweak' can never successfully be applied in a computation
-nowhere :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
-nowhere = nowhere' . fromTweak
-
--- | Ensures a given Ltl modification can never be applied on a computation
-nowhere' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-nowhere' = modifyLtl . ltlNever
-
--- | Apply a given 'Tweak' at every location in a computation where it does not
--- fail, which might never occur.
-whenAble :: (MonadModalBlockChain m) => Tweak InterpMockChain b -> m a -> m a
-whenAble = whenAble' . fromTweak
-
--- | Apply an Ltl modification at every location in a computation where it is
--- possible. Does not fail if no such position exists.
-whenAble' :: (MonadLtl mod m) => Ltl mod -> m a -> m a
-whenAble' = modifyLtl . ltlWhenPossible
-
--- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
--- trace. Successful when this transaction exists and can be modified.
-there :: (MonadModalBlockChain m) => Integer -> Tweak InterpMockChain b -> m a -> m a
-there n = there' n . fromTweak
-
--- | Apply an Ltl modification to the (0-indexed) nth transaction in a
--- given trace. Successful when this transaction exists and can be modified.
---
--- See also `Cooked.Tweak.Labels.labelled` to select transactions based on
--- labels instead of their index.
-there' :: (MonadLtl mod m) => Integer -> Ltl mod -> m a -> m a
-there' n = modifyLtl . ltlDelay n
-
--- | Apply a 'Tweak' to the next transaction in the given trace. The order of
--- arguments is reversed compared to 'somewhere' and 'everywhere', because that
--- enables an idiom like
---
--- > do ...
--- >    endpoint arguments `withTweak` someModification
--- >    ...
---
--- where @endpoint@ builds and validates a single transaction depending on the
--- given @arguments@. Then `withTweak` says "I want to modify the transaction
--- returned by this endpoint in the following way".
-withTweak :: (MonadModalBlockChain m) => m a -> Tweak InterpMockChain b -> m a
-withTweak = flip (there 0)
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index 63c6b83a7..f6de53b33 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -5,7 +5,7 @@
 module Cooked.MockChain.Write
   ( -- * The `MockChainWrite` effect
     MockChainWrite,
-    reinterpretMockChainWriteWithTweaks,
+    reinterpretMockChainWriteWithTweak,
     runMockChainWrite,
 
     -- * Modifications of the current time
@@ -28,13 +28,24 @@ module Cooked.MockChain.Write
 where
 
 import Cardano.Node.Emulator qualified as Emulator
+import Control.Monad
 import Cooked.Ltl
+import Cooked.MockChain.Error
+import Cooked.MockChain.Log
+import Cooked.MockChain.MockChainState
+import Cooked.MockChain.Read
 import Cooked.Skeleton
-import Cooked.Tweak
+import Cooked.Tweak.Common
+import Data.Coerce
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
+import Polysemy.Internal
+import Polysemy.NonDet
+import Polysemy.State
 
 -- | An effect that offers all the primitives that are performing modifications
 -- on the blockchain state.
@@ -104,23 +115,23 @@ runMockChainWrite = interpret $ \case
 waitNSlots :: (Member MockChainWrite effs) => Integer -> Sem effs Ledger.Slot
 
 -- | Wait for a certain slot, or throws an error if the slot is already past
-awaitSlot :: (Member MockChainWrite effs, Integral i) => i -> m Ledger.Slot
+awaitSlot :: (Members '[MockChainRead, MockChainWrite] effs) => Integer -> Sem effs Ledger.Slot
 awaitSlot slot = currentSlot >>= waitNSlots . (slot -) . fromIntegral
 
 -- | Waits until the current slot becomes greater or equal to the slot
 --  containing the given POSIX time.  Note that that it might not wait for
 --  anything if the current slot is large enough.
-awaitEnclosingSlot :: (Member MockChainWrite effs) => Api.POSIXTime -> m Ledger.Slot
-awaitEnclosingSlot = awaitSlot <=< getEnclosingSlot
+awaitEnclosingSlot :: (Members '[MockChainRead, MockChainWrite] effs) => Api.POSIXTime -> Sem effs Ledger.Slot
+awaitEnclosingSlot time = getEnclosingSlot time >>= (\(Ledger.Slot s) -> awaitSlot s)
 
 -- | Wait a given number of ms from the lower bound of the current slot and
 -- returns the current slot after waiting.
-waitNMSFromSlotLowerBound :: (Member MockChainWrite effs, Integral i) => i -> m Ledger.Slot
+waitNMSFromSlotLowerBound :: (Members '[MockChainRead, MockChainWrite, Fail] effs) => Integer -> Sem effs Ledger.Slot
 waitNMSFromSlotLowerBound duration = currentMSRange >>= awaitEnclosingSlot . (+ fromIntegral duration) . fst
 
 -- | Wait a given number of ms from the upper bound of the current slot and
 -- returns the current slot after waiting.
-waitNMSFromSlotUpperBound :: (Member MockChainWrite effs, Integral i) => i -> m Ledger.Slot
+waitNMSFromSlotUpperBound :: (Members '[MockChainRead, MockChainWrite, Fail] effs) => Integer -> Sem effs Ledger.Slot
 waitNMSFromSlotUpperBound duration = currentMSRange >>= awaitEnclosingSlot . (+ fromIntegral duration) . snd
 
 -- | Generates, balances and validates a transaction from a skeleton, and
@@ -128,18 +139,18 @@ waitNMSFromSlotUpperBound duration = currentMSRange >>= awaitEnclosingSlot . (+
 validateTxSkel :: (Member MockChainWrite effs) => TxSkel -> Sem effs Ledger.CardanoTx
 
 -- | Same as `validateTxSkel`, but only returns the generated UTxOs
-validateTxSkel' :: (Member MockChainWrite effs) => TxSkel -> m [Api.TxOutRef]
+validateTxSkel' :: (Members '[MockChainRead, MockChainWrite] effs) => TxSkel -> Sem effs [Api.TxOutRef]
 validateTxSkel' = ((fmap fst <$>) . utxosFromCardanoTx) <=< validateTxSkel
 
 -- | Same as `validateTxSkel`, but discards the returned transaction
-validateTxSkel_ :: (Member MockChainWrite effs) => TxSkel -> m ()
+validateTxSkel_ :: (Member MockChainWrite effs) => TxSkel -> Sem effs ()
 validateTxSkel_ = void . validateTxSkel
 
 -- | Updates the current parameters
 setParams :: (Member MockChainWrite effs) => Emulator.Params -> Sem effs ()
 
 -- | Sets the current script to act as the official constitution script
-setConstitutionScript :: (Member MockChainWrite effs, ToVScript s) => s -> Sem eff ()
+setConstitutionScript :: (Member MockChainWrite effs, ToVScript s) => s -> Sem effs ()
 
 -- | Forces the generation of utxos corresponding to certain `TxSkelOut`
 forceOutputs :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs [Api.TxOutRef]

From 98d87e0c97468fc7b5979f1508affe5f11174dd9 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 22 Jan 2026 14:31:19 +0100
Subject: [PATCH 32/96] =?UTF-8?q?begin=20of=20autofilling=C3=A9?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Cooked/MockChain/AutoFilling.hs | 209 ++++++++++++++--------------
 1 file changed, 105 insertions(+), 104 deletions(-)

diff --git a/src/Cooked/MockChain/AutoFilling.hs b/src/Cooked/MockChain/AutoFilling.hs
index 9ef2dc9e5..ebc3c0f60 100644
--- a/src/Cooked/MockChain/AutoFilling.hs
+++ b/src/Cooked/MockChain/AutoFilling.hs
@@ -6,10 +6,10 @@ import Cardano.Api qualified as Cardano
 import Cardano.Ledger.Shelley.Core qualified as Shelley
 import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
 import Control.Monad
-import Cooked.MockChain.BlockChain
 import Cooked.MockChain.GenerateTx.Output
 import Cooked.MockChain.UtxoSearch
 import Cooked.Skeleton
+import Cooked.Tweak.Common
 import Data.List (find)
 import Data.Map qualified as Map
 import Data.Maybe
@@ -24,9 +24,9 @@ import PlutusLedgerApi.V3 qualified as Api
 -- out the withdrawn amount based on the associated user rewards. Does not
 -- tamper with an existing specified amount in such withdrawals. Logs an event
 -- when an amount has been successfully auto-filled.
-autoFillWithdrawalAmounts :: (MonadBlockChainWithoutValidation m) => TxSkel -> m TxSkel
+autoFillWithdrawalAmounts :: (Members '[MockChainRead, Tweak, MockChainLog] effs) => Sem effs ()
 autoFillWithdrawalAmounts txSkel = do
-  let withdrawals = view (txSkelWithdrawalsL % txSkelWithdrawalsListI) txSkel
+  withdrawals <- viewTweak (txSkelWithdrawalsL % txSkelWithdrawalsListI)
   newWithdrawals <- forM withdrawals $ \withdrawal -> do
     currentReward <- getCurrentReward $ view withdrawalUserL withdrawal
     let (changed, newWithdrawal) = case currentReward of
@@ -38,7 +38,7 @@ autoFillWithdrawalAmounts txSkel = do
           (view (withdrawalUserL % to Script.toCredential) newWithdrawal)
           (fromJust (preview withdrawalAmountAT newWithdrawal))
     return newWithdrawal
-  return $ txSkel & txSkelWithdrawalsL % txSkelWithdrawalsListI .~ newWithdrawals
+  overTweak (txSkelWithdrawalsL % txSkelWithdrawalsListI) newWithdrawals
 
 -- * Auto filling constitution script
 
@@ -46,119 +46,120 @@ autoFillWithdrawalAmounts txSkel = do
 -- out the constitution scripts with the current one. Does not tamper with an
 -- existing specified script in such withdrawals. Logs an event when the
 -- constitution script has been successfully auto-filled.
-autoFillConstitution :: (MonadBlockChainWithoutValidation m) => TxSkel -> m TxSkel
+autoFillConstitution :: (Members '[MockChainRead, Tweak, MockChainLog] effs) => Sem effs ()
 autoFillConstitution txSkel = do
   currentConstitution <- getConstitutionScript
   case currentConstitution of
-    Nothing -> return txSkel
+    Nothing -> return ()
     Just constitutionScript -> do
-      newProposals <- forM (view txSkelProposalsL txSkel) $ \prop -> do
+      proposals <- viewTweak txSkelProposalsL
+      newProposals <- forM proposals $ \prop -> do
         when (isn't txSkelProposalConstitutionAT prop) $
           logEvent $
             MCLogAutoFilledConstitution $
               Script.toScriptHash constitutionScript
         return (fillConstitution constitutionScript prop)
-      return $ txSkel & txSkelProposalsL .~ newProposals
+      overTweak txSkelProposalsL newProposals
 
--- * Auto filling reference scripts
+-- -- * Auto filling reference scripts
 
--- | Attempts to find in the index a utxo containing a reference script with the
--- given script hash, and attaches it to a redeemer when it does not yet have a
--- reference input and when it is allowed, in which case an event is logged.
-updateRedeemedScript :: (MonadBlockChain m) => [Api.TxOutRef] -> User IsScript Redemption -> m (User IsScript Redemption)
-updateRedeemedScript inputs rs@(UserRedeemedScript (toVScript -> vScript) txSkelRed@(TxSkelRedeemer {txSkelRedeemerAutoFill = True})) = do
-  oRefsInInputs <- runUtxoSearch (referenceScriptOutputsSearch vScript)
-  maybe
-    -- We leave the redeemer unchanged if no reference input was found
-    (return rs)
-    -- If a reference input is found, we assign it and log the event
-    ( \oRef -> do
-        logEvent $ MCLogAddedReferenceScript txSkelRed oRef (Script.toScriptHash vScript)
-        return $ over userTxSkelRedeemerAT (fillReferenceInput oRef) rs
-    )
-    $ case oRefsInInputs of
-      [] -> Nothing
-      -- If possible, we use a reference input appearing in regular inputs
-      l | Just (oRefM', _) <- find (\(r, _) -> r `elem` inputs) l -> Just oRefM'
-      -- If none exist, we use the first one we find elsewhere
-      ((oRefM', _) : _) -> Just oRefM'
-updateRedeemedScript _ rs = return rs
+-- -- | Attempts to find in the index a utxo containing a reference script with the
+-- -- given script hash, and attaches it to a redeemer when it does not yet have a
+-- -- reference input and when it is allowed, in which case an event is logged.
+-- updateRedeemedScript :: (MonadBlockChain m) => [Api.TxOutRef] -> User IsScript Redemption -> m (User IsScript Redemption)
+-- updateRedeemedScript inputs rs@(UserRedeemedScript (toVScript -> vScript) txSkelRed@(TxSkelRedeemer {txSkelRedeemerAutoFill = True})) = do
+--   oRefsInInputs <- runUtxoSearch (referenceScriptOutputsSearch vScript)
+--   maybe
+--     -- We leave the redeemer unchanged if no reference input was found
+--     (return rs)
+--     -- If a reference input is found, we assign it and log the event
+--     ( \oRef -> do
+--         logEvent $ MCLogAddedReferenceScript txSkelRed oRef (Script.toScriptHash vScript)
+--         return $ over userTxSkelRedeemerAT (fillReferenceInput oRef) rs
+--     )
+--     $ case oRefsInInputs of
+--       [] -> Nothing
+--       -- If possible, we use a reference input appearing in regular inputs
+--       l | Just (oRefM', _) <- find (\(r, _) -> r `elem` inputs) l -> Just oRefM'
+--       -- If none exist, we use the first one we find elsewhere
+--       ((oRefM', _) : _) -> Just oRefM'
+-- updateRedeemedScript _ rs = return rs
 
--- | Goes through the various parts of the skeleton where a redeemer can appear,
--- and attempts to attach a reference input to each of them, whenever it is
--- allowed and one has not already been set. Logs an event whenever such an
--- addition occurs.
-autoFillReferenceScripts :: forall m. (MonadBlockChain m) => TxSkel -> m TxSkel
-autoFillReferenceScripts txSkel = do
-  let inputs = view (txSkelInsL % to Map.keys) txSkel
-  newMints <- forM (view (txSkelMintsL % txSkelMintsListI) txSkel) $ \(Mint rs tks) ->
-    (`Mint` tks) <$> updateRedeemedScript inputs rs
-  newInputs <- forM (view (txSkelInsL % to Map.toList) txSkel) $ \(oRef, red) ->
-    (oRef,) <$> do
-      validatorM <- previewByRef (txSkelOutOwnerL % userVScriptAT) oRef
-      case validatorM of
-        Nothing -> return red
-        Just val -> view userTxSkelRedeemerL <$> updateRedeemedScript inputs (UserRedeemedScript val red)
-  newProposals <- forM (view txSkelProposalsL txSkel) $ \prop ->
-    case preview (txSkelProposalMConstitutionAT % _Just) prop of
-      Nothing -> return prop
-      Just rs -> flip (set (txSkelProposalMConstitutionAT % _Just)) prop <$> updateRedeemedScript inputs rs
-  newWithdrawals <- forM (view (txSkelWithdrawalsL % txSkelWithdrawalsListI) txSkel) $
-    \withdrawal@(Withdrawal user lv) -> case preview userEitherScriptP user of
-      Nothing -> return withdrawal
-      Just urs -> (`Withdrawal` lv) . review userEitherScriptP <$> updateRedeemedScript inputs urs
-  return $
-    txSkel
-      & txSkelMintsL
-      % txSkelMintsListI
-      .~ newMints
-      & txSkelInsL
-      .~ Map.fromList newInputs
-      & txSkelProposalsL
-      .~ newProposals
-      & txSkelWithdrawalsL
-      % txSkelWithdrawalsListI
-      .~ newWithdrawals
+-- -- | Goes through the various parts of the skeleton where a redeemer can appear,
+-- -- and attempts to attach a reference input to each of them, whenever it is
+-- -- allowed and one has not already been set. Logs an event whenever such an
+-- -- addition occurs.
+-- autoFillReferenceScripts :: forall m. (MonadBlockChain m) => TxSkel -> m TxSkel
+-- autoFillReferenceScripts txSkel = do
+--   let inputs = view (txSkelInsL % to Map.keys) txSkel
+--   newMints <- forM (view (txSkelMintsL % txSkelMintsListI) txSkel) $ \(Mint rs tks) ->
+--     (`Mint` tks) <$> updateRedeemedScript inputs rs
+--   newInputs <- forM (view (txSkelInsL % to Map.toList) txSkel) $ \(oRef, red) ->
+--     (oRef,) <$> do
+--       validatorM <- previewByRef (txSkelOutOwnerL % userVScriptAT) oRef
+--       case validatorM of
+--         Nothing -> return red
+--         Just val -> view userTxSkelRedeemerL <$> updateRedeemedScript inputs (UserRedeemedScript val red)
+--   newProposals <- forM (view txSkelProposalsL txSkel) $ \prop ->
+--     case preview (txSkelProposalMConstitutionAT % _Just) prop of
+--       Nothing -> return prop
+--       Just rs -> flip (set (txSkelProposalMConstitutionAT % _Just)) prop <$> updateRedeemedScript inputs rs
+--   newWithdrawals <- forM (view (txSkelWithdrawalsL % txSkelWithdrawalsListI) txSkel) $
+--     \withdrawal@(Withdrawal user lv) -> case preview userEitherScriptP user of
+--       Nothing -> return withdrawal
+--       Just urs -> (`Withdrawal` lv) . review userEitherScriptP <$> updateRedeemedScript inputs urs
+--   return $
+--     txSkel
+--       & txSkelMintsL
+--       % txSkelMintsListI
+--       .~ newMints
+--       & txSkelInsL
+--       .~ Map.fromList newInputs
+--       & txSkelProposalsL
+--       .~ newProposals
+--       & txSkelWithdrawalsL
+--       % txSkelWithdrawalsListI
+--       .~ newWithdrawals
 
--- * Auto filling min ada amounts
+-- -- * Auto filling min ada amounts
 
--- | Compute the required minimal ADA for a given output
-getTxSkelOutMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m Integer
-getTxSkelOutMinAda txSkelOut = do
-  params <- Emulator.pEmulatorPParams <$> getParams
-  Cardano.unCoin
-    . Shelley.getMinCoinTxOut params
-    . Cardano.toShelleyTxOut Cardano.ShelleyBasedEraConway
-    . Cardano.toCtxUTxOTxOut
-    <$> toCardanoTxOut txSkelOut
+-- -- | Compute the required minimal ADA for a given output
+-- getTxSkelOutMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m Integer
+-- getTxSkelOutMinAda txSkelOut = do
+--   params <- Emulator.pEmulatorPParams <$> getParams
+--   Cardano.unCoin
+--     . Shelley.getMinCoinTxOut params
+--     . Cardano.toShelleyTxOut Cardano.ShelleyBasedEraConway
+--     . Cardano.toCtxUTxOTxOut
+--     <$> toCardanoTxOut txSkelOut
 
--- | This transforms an output into another output which contains the minimal
--- required ada. If the previous quantity of ADA was sufficient, it remains
--- unchanged. This can require a few iterations to converge, as the added ADA
--- will increase the size of the UTXO which in turn might need more ADA.
-toTxSkelOutWithMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
--- The auto adjustment is disabled so nothing is done here
-toTxSkelOutWithMinAda txSkelOut@((^. txSkelOutValueAutoAdjustL) -> False) = return txSkelOut
--- The auto adjustment is enabled
-toTxSkelOutWithMinAda txSkelOut = do
-  txSkelOut' <- go txSkelOut
-  let originalAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut
-      updatedAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut'
-  when (originalAda /= updatedAda) $ logEvent $ MCLogAdjustedTxSkelOut txSkelOut updatedAda
-  return txSkelOut'
-  where
-    go :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
-    go skelOut = do
-      -- Computing the required minimal amount of ADA in this output
-      requiredAda <- getTxSkelOutMinAda skelOut
-      -- If this amount is sufficient, we return Nothing, otherwise, we adjust the
-      -- output and possibly iterate
-      if Api.getLovelace (skelOut ^. txSkelOutValueL % valueLovelaceL) >= requiredAda
-        then return skelOut
-        else go $ skelOut & txSkelOutValueL % valueLovelaceL .~ Api.Lovelace requiredAda
+-- -- | This transforms an output into another output which contains the minimal
+-- -- required ada. If the previous quantity of ADA was sufficient, it remains
+-- -- unchanged. This can require a few iterations to converge, as the added ADA
+-- -- will increase the size of the UTXO which in turn might need more ADA.
+-- toTxSkelOutWithMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
+-- -- The auto adjustment is disabled so nothing is done here
+-- toTxSkelOutWithMinAda txSkelOut@((^. txSkelOutValueAutoAdjustL) -> False) = return txSkelOut
+-- -- The auto adjustment is enabled
+-- toTxSkelOutWithMinAda txSkelOut = do
+--   txSkelOut' <- go txSkelOut
+--   let originalAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut
+--       updatedAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut'
+--   when (originalAda /= updatedAda) $ logEvent $ MCLogAdjustedTxSkelOut txSkelOut updatedAda
+--   return txSkelOut'
+--   where
+--     go :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
+--     go skelOut = do
+--       -- Computing the required minimal amount of ADA in this output
+--       requiredAda <- getTxSkelOutMinAda skelOut
+--       -- If this amount is sufficient, we return Nothing, otherwise, we adjust the
+--       -- output and possibly iterate
+--       if Api.getLovelace (skelOut ^. txSkelOutValueL % valueLovelaceL) >= requiredAda
+--         then return skelOut
+--         else go $ skelOut & txSkelOutValueL % valueLovelaceL .~ Api.Lovelace requiredAda
 
--- | This goes through all the `TxSkelOut`s of the given skeleton and updates
--- their ada value when requested by the user and required by the protocol
--- parameters. Logs an event whenever such a change occurs.
-autoFillMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
-autoFillMinAda skel = (\x -> skel & txSkelOutsL .~ x) <$> forM (skel ^. txSkelOutsL) toTxSkelOutWithMinAda
+-- -- | This goes through all the `TxSkelOut`s of the given skeleton and updates
+-- -- their ada value when requested by the user and required by the protocol
+-- -- parameters. Logs an event whenever such a change occurs.
+-- autoFillMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
+-- autoFillMinAda skel = (\x -> skel & txSkelOutsL .~ x) <$> forM (skel ^. txSkelOutsL) toTxSkelOutWithMinAda

From f038ea971205c5a5b5808e5262c66a4a640103e8 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Thu, 22 Jan 2026 18:51:38 +0100
Subject: [PATCH 33/96] GenerateTx

---
 cooked-validators.cabal                       |   1 -
 src/Cooked/Attack/AddToken.hs                 |  20 ++-
 src/Cooked/Attack/DatumHijacking.hs           |   3 +
 src/Cooked/Attack/DoubleSat.hs                |  30 ++--
 src/Cooked/MockChain/GenerateTx/Body.hs       |  76 ++++++----
 .../MockChain/GenerateTx/Certificate.hs       |  32 ++++-
 src/Cooked/MockChain/GenerateTx/Collateral.hs |  25 ++--
 src/Cooked/MockChain/GenerateTx/Common.hs     |  21 ---
 src/Cooked/MockChain/GenerateTx/Input.hs      |  19 +--
 src/Cooked/MockChain/GenerateTx/Mint.hs       |  21 +--
 src/Cooked/MockChain/GenerateTx/Output.hs     |  39 +++---
 src/Cooked/MockChain/GenerateTx/Proposal.hs   |  33 +++--
 .../MockChain/GenerateTx/ReferenceInputs.hs   |  15 +-
 .../MockChain/GenerateTx/Withdrawals.hs       |  22 +--
 src/Cooked/MockChain/GenerateTx/Witness.hs    | 111 +++++++++++----
 src/Cooked/Tweak/Common.hs                    |   6 +-
 src/Cooked/Tweak/Inputs.hs                    |  28 +++-
 src/Cooked/Tweak/Labels.hs                    |  44 +++++-
 src/Cooked/Tweak/Mint.hs                      |  11 +-
 src/Cooked/Tweak/OutPermutations.hs           |  12 +-
 src/Cooked/Tweak/Outputs.hs                   |  33 ++++-
 src/Cooked/Tweak/Signatories.hs               |  63 +++++++--
 src/Cooked/Tweak/ValidityRange.hs             | 132 ++++++++++++------
 23 files changed, 542 insertions(+), 255 deletions(-)
 delete mode 100644 src/Cooked/MockChain/GenerateTx/Common.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index ff81de896..a3ecfd474 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -30,7 +30,6 @@ library
       Cooked.MockChain.GenerateTx.Body
       Cooked.MockChain.GenerateTx.Certificate
       Cooked.MockChain.GenerateTx.Collateral
-      Cooked.MockChain.GenerateTx.Common
       Cooked.MockChain.GenerateTx.Input
       Cooked.MockChain.GenerateTx.Mint
       Cooked.MockChain.GenerateTx.Output
diff --git a/src/Cooked/Attack/AddToken.hs b/src/Cooked/Attack/AddToken.hs
index a51d7fdf2..39d71f73a 100644
--- a/src/Cooked/Attack/AddToken.hs
+++ b/src/Cooked/Attack/AddToken.hs
@@ -9,14 +9,18 @@ module Cooked.Attack.AddToken
 where
 
 import Control.Monad
-import Cooked.Pretty
+import Cooked.Pretty.Class
 import Cooked.Skeleton
-import Cooked.Tweak
+import Cooked.Tweak.Common
+import Cooked.Tweak.Labels
+import Cooked.Tweak.Outputs
 import Data.Map qualified as Map
 import Optics.Core
 import Plutus.Script.Utils.Value qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 import PlutusTx.Numeric qualified as PlutusTx
+import Polysemy
+import Polysemy.NonDet
 import Prettyprinter qualified as PP
 
 -- | This attack adds extra tokens of any kind for minting policies already
@@ -25,13 +29,15 @@ import Prettyprinter qualified as PP
 --
 -- This attack adds an 'AddTokenLbl' label.
 addTokenAttack ::
-  (MonadTweak m, IsTxSkelOutAllowedOwner o) =>
+  ( Members '[Tweak, NonDet] effs,
+    IsTxSkelOutAllowedOwner o
+  ) =>
   -- | For each policy that occurs in some 'Mint' constraint, return a list of
   -- token names together with how many tokens with that name should be minted.
   (VScript -> [(Api.TokenName, Integer)]) ->
   -- | The attacker, who receives the extra tokens.
   o ->
-  m Api.Value
+  Sem effs Api.Value
 addTokenAttack extraTokens attacker = do
   currencies <- viewTweak (txSkelMintsL % txSkelMintsAssetClassesG % to (fmap fst))
   oldMintsValue <- viewTweak (txSkelMintsL % to Script.toValue)
@@ -48,7 +54,9 @@ addTokenAttack extraTokens attacker = do
 --
 -- This attack adds an 'DupTokenLbl' label
 dupTokenAttack ::
-  (MonadTweak m, IsTxSkelOutAllowedOwner o) =>
+  ( Members '[Tweak, NonDet] effs,
+    IsTxSkelOutAllowedOwner o
+  ) =>
   -- | A function describing how the amount of tokens specified by a 'Mint'
   -- constraint should be changed, depending on the asset class and the amount
   -- specified by the constraint. The given function @f@ should probably satisfy
@@ -60,7 +68,7 @@ dupTokenAttack ::
   -- the modified transaction but were not minted by the original transaction
   -- are paid to this target.
   o ->
-  m Api.Value
+  Sem effs Api.Value
 dupTokenAttack change attacker = do
   mints <- viewTweak txSkelMintsL
   res <-
diff --git a/src/Cooked/Attack/DatumHijacking.hs b/src/Cooked/Attack/DatumHijacking.hs
index 853e79daf..3f4d77003 100644
--- a/src/Cooked/Attack/DatumHijacking.hs
+++ b/src/Cooked/Attack/DatumHijacking.hs
@@ -20,11 +20,14 @@ import Control.Monad
 import Cooked.Pretty.Class
 import Cooked.Skeleton
 import Cooked.Tweak
+import Cooked.Tweak.Common
 import Data.Bifunctor
 import Data.Kind (Type)
 import Data.Maybe
 import Data.Typeable
 import Optics.Core
+import Polysemy
+import Polysemy.NonDet
 
 -- | Parameters of the datum hijacking attacks. They state precisely which
 -- outputs should have their owner changed, wich owner should be assigned, to
diff --git a/src/Cooked/Attack/DoubleSat.hs b/src/Cooked/Attack/DoubleSat.hs
index 4f7c002e8..6735bf260 100644
--- a/src/Cooked/Attack/DoubleSat.hs
+++ b/src/Cooked/Attack/DoubleSat.hs
@@ -9,10 +9,15 @@ module Cooked.Attack.DoubleSat
   )
 where
 
-import Cooked.MockChain.BlockChain
-import Cooked.Pretty
+import Control.Monad
+import Cooked.MockChain.Read
+import Cooked.Pretty.Class
 import Cooked.Skeleton
-import Cooked.Tweak
+import Cooked.Tweak.Common
+import Cooked.Tweak.Inputs
+import Cooked.Tweak.Labels
+import Cooked.Tweak.Mint
+import Cooked.Tweak.Outputs
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Optics.Core
@@ -20,6 +25,8 @@ import Plutus.Script.Utils.Value qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
 import PlutusLedgerApi.V3 qualified as Api
 import PlutusTx.Numeric qualified as PlutusTx
+import Polysemy
+import Polysemy.NonDet
 
 {- Note: What is a double satisfaction attack?
 
@@ -66,7 +73,12 @@ instance {-# OVERLAPPING #-} Monoid DoubleSatDelta where
 -- value contained in new inputs to the transaction is then paid to the
 -- attacker.
 doubleSatAttack ::
-  (MonadTweak m, Eq is, Is k A_Traversal, IsTxSkelOutAllowedOwner owner) =>
+  forall effs is k owner a.
+  ( Members '[Tweak, NonDet, MockChainRead] effs,
+    Eq is,
+    Is k A_Traversal,
+    IsTxSkelOutAllowedOwner owner
+  ) =>
   -- | how to combine modifications from caused by different foci. See the
   -- comment at 'combineModsTweak', which uses the same logic.
   ([is] -> [[is]]) ->
@@ -96,13 +108,13 @@ doubleSatAttack ::
   -- 'Cooked.MockChain.UtxoState.UtxoState' argument.
   --
   -- ###################################
-  (is -> a -> m [(a, DoubleSatDelta)]) ->
+  (is -> a -> Sem effs [(a, DoubleSatDelta)]) ->
   -- | The attacker, who receives any surplus.
   --
   -- In the example, the extra value in the added input will be paid to the
   -- attacker.
   owner ->
-  m ()
+  Sem effs ()
 doubleSatAttack groupings optic change target = do
   deltas <- combineModsTweak groupings optic change
   let delta = joinDoubleSatDeltas deltas
@@ -110,18 +122,18 @@ doubleSatAttack groupings optic change target = do
   addedValue <- deltaBalance delta
   if addedValue `Api.gt` mempty
     then addOutputTweak $ target `receives` Value addedValue
-    else failingTweak
+    else mzero
   addLabelTweak DoubleSatLbl
   where
     -- for each triple of additional inputs, outputs, and mints,
     -- calculate its balance
-    deltaBalance :: (MonadTweak m) => DoubleSatDelta -> m Api.Value
+    deltaBalance :: DoubleSatDelta -> Sem effs Api.Value
     deltaBalance (inputs, outputs, mints) = do
       inValue <- foldMap (view txSkelOutValueL . snd) . filter ((`elem` Map.keys inputs) . fst) <$> allUtxos
       return $ inValue <> PlutusTx.negate (foldOf (traversed % txSkelOutValueL) outputs) <> Script.toValue mints
 
     -- Helper tweak to add a 'DoubleSatDelta' to a transaction
-    addDoubleSatDeltaTweak :: (MonadTweak m) => DoubleSatDelta -> m ()
+    addDoubleSatDeltaTweak :: DoubleSatDelta -> Sem effs ()
     addDoubleSatDeltaTweak (ins, outs, mints) =
       mapM_ (uncurry addInputTweak) (Map.toList ins)
         >> mapM_ addOutputTweak outs
diff --git a/src/Cooked/MockChain/GenerateTx/Body.hs b/src/Cooked/MockChain/GenerateTx/Body.hs
index 3709ba543..02a7e19ca 100644
--- a/src/Cooked/MockChain/GenerateTx/Body.hs
+++ b/src/Cooked/MockChain/GenerateTx/Body.hs
@@ -13,11 +13,10 @@ where
 import Cardano.Api qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad
-import Control.Monad.Except
-import Cooked.MockChain.BlockChain
+import Cooked.MockChain.Common
+import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Certificate
 import Cooked.MockChain.GenerateTx.Collateral
-import Cooked.MockChain.GenerateTx.Common
 import Cooked.MockChain.GenerateTx.Input
 import Cooked.MockChain.GenerateTx.Mint
 import Cooked.MockChain.GenerateTx.Output
@@ -25,6 +24,7 @@ import Cooked.MockChain.GenerateTx.Proposal
 import Cooked.MockChain.GenerateTx.ReferenceInputs
 import Cooked.MockChain.GenerateTx.Withdrawals
 import Cooked.MockChain.GenerateTx.Witness
+import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Data.Map qualified as Map
 import Data.Maybe
@@ -32,27 +32,31 @@ import Data.Set qualified as Set
 import Ledger.Address qualified as Ledger
 import Ledger.Tx.CardanoAPI qualified as Ledger
 import Plutus.Script.Utils.Address qualified as Script
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
 
 -- | Generates a body content from a skeleton
-txSkelToTxBodyContent :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Collaterals -> m (Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra)
+txSkelToTxBodyContent ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
+  TxSkel ->
+  Fee ->
+  Collaterals ->
+  Sem effs (Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra)
 txSkelToTxBodyContent skel@TxSkel {..} fee mCollaterals = do
   txIns <- mapM toTxInAndWitness $ Map.toList txSkelIns
   txInsReference <- toInsReference skel
   (txInsCollateral, txTotalCollateral, txReturnCollateral) <- toCollateralTriplet fee mCollaterals
   txOuts <- mapM toCardanoTxOut txSkelOuts
-  (txValidityLowerBound, txValidityUpperBound) <-
-    throwOnToCardanoError
-      "txSkelToBodyContent: Unable to translate transaction validity range."
-      $ Ledger.toCardanoValidityRange txSkelValidityRange
+  (txValidityLowerBound, txValidityUpperBound) <- fromEither $ Ledger.toCardanoValidityRange txSkelValidityRange
   txMintValue <- toMintValue txSkelMints
   txExtraKeyWits <-
     if null txSkelSignatories
       then return Cardano.TxExtraKeyWitnessesNone
       else
-        throwOnToCardanoErrorOrApply
-          "txSkelToBodyContent: Unable to translate the required signatories"
-          (Cardano.TxExtraKeyWitnesses Cardano.AlonzoEraOnwardsConway)
-          $ mapM (Ledger.toCardanoPaymentKeyHash . Ledger.PaymentPubKeyHash . Script.toPubKeyHash) txSkelSignatories
+        Cardano.TxExtraKeyWitnesses Cardano.AlonzoEraOnwardsConway
+          <$> fromEither
+            (mapM (Ledger.toCardanoPaymentKeyHash . Ledger.PaymentPubKeyHash . Script.toPubKeyHash) txSkelSignatories)
   txProtocolParams <- Cardano.BuildTxWith . Just . Emulator.ledgerProtocolParameters <$> getParams
   txProposalProcedures <- Just . Cardano.Featured Cardano.ConwayEraOnwardsConway <$> toProposalProcedures txSkelProposals
   txWithdrawals <- toWithdrawals txSkelWithdrawals
@@ -68,17 +72,21 @@ txSkelToTxBodyContent skel@TxSkel {..} fee mCollaterals = do
   return Cardano.TxBodyContent {..}
 
 -- | Generates a transaction body from a body content
-txBodyContentToTxBody :: (MonadBlockChainBalancing m) => Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra -> m (Cardano.TxBody Cardano.ConwayEra)
+txBodyContentToTxBody ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra ->
+  Sem effs (Cardano.TxBody Cardano.ConwayEra)
 txBodyContentToTxBody txBodyContent = do
   params <- getParams
   -- We create the associated Shelley TxBody
-  either
-    (throwError . MCEToCardanoError "generateTx :")
-    return
-    (Emulator.createTransactionBody params (Ledger.CardanoBuildTx txBodyContent))
+  fromEither $ Emulator.createTransactionBody params $ Ledger.CardanoBuildTx txBodyContent
 
 -- | Generates an index with utxos known to a 'TxSkel'
-txSkelToIndex :: (MonadBlockChainBalancing m) => TxSkel -> Collaterals -> m (Cardano.UTxO Cardano.ConwayEra)
+txSkelToIndex ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  TxSkel ->
+  Collaterals ->
+  Sem effs (Cardano.UTxO Cardano.ConwayEra)
 txSkelToIndex txSkel mCollaterals = do
   -- We build the index of UTxOs which are known to this skeleton. This includes
   -- collateral inputs, inputs and reference inputs.
@@ -90,14 +98,18 @@ txSkelToIndex txSkel mCollaterals = do
   -- We then compute their Cardano counterparts
   txOutL <- forM knownTxOuts toCardanoTxOut
   -- We build the index and handle the possible error
-  either (throwError . MCEToCardanoError "txSkelToIndex:") return $ do
-    txInL <- forM knownTxORefs Ledger.toCardanoTxIn
-    return $ Cardano.UTxO $ Map.fromList $ zip txInL $ Cardano.toCtxUTxOTxOut <$> txOutL
+  txInL <- fromEither $ forM knownTxORefs Ledger.toCardanoTxIn
+  return $ Cardano.UTxO $ Map.fromList $ zip txInL $ Cardano.toCtxUTxOTxOut <$> txOutL
 
 -- | Generates a transaction body from a 'TxSkel' and associated fee and
 -- collateral information. This transaction body accounts for the actual
 -- execution units of each of the scripts involved in the skeleton.
-txSkelToTxBody :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Collaterals -> m (Cardano.TxBody Cardano.ConwayEra)
+txSkelToTxBody ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
+  TxSkel ->
+  Fee ->
+  Collaterals ->
+  Sem effs (Cardano.TxBody Cardano.ConwayEra)
 txSkelToTxBody txSkel fee mCollaterals = do
   -- We create a first body content and body, without execution units
   txBodyContent' <- txSkelToTxBodyContent txSkel fee mCollaterals
@@ -111,22 +123,32 @@ txSkelToTxBody txSkel fee mCollaterals = do
   case Emulator.getTxExUnitsWithLogs params (Ledger.fromPlutusIndex index) tx' of
     -- Computing the execution units can result in all kinds of validation
     -- errors except for the ones related to the execution units themselves.
-    Left err -> throwError $ uncurry MCEValidationError err
+    Left err -> throw $ uncurry MCEValidationError err
     -- When no error arises, we get an execution unit for each script usage. We
     -- first have to transform this Ledger map to a cardano API map.
     Right (Map.mapKeysMonotonic (Cardano.toScriptIndex Cardano.AlonzoEraOnwardsConway) . fmap (Cardano.fromAlonzoExUnits . snd) -> exUnits) ->
       -- We can then assign the right execution units to the body content
       case Cardano.substituteExecutionUnits exUnits txBodyContent' of
         -- This can only be a @TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap@
-        Left _ -> throwError $ FailWith "Error while assigning execution units"
+        Left _ -> fail "Error while assigning execution units"
         -- We now have a body content with proper execution units and can create
         -- the final body from it
         Right txBody -> txBodyContentToTxBody txBody
 
 -- | Generates a Cardano transaction and signs it
-txSignatoriesAndBodyToCardanoTx :: [TxSkelSignatory] -> Cardano.TxBody Cardano.ConwayEra -> Cardano.Tx Cardano.ConwayEra
+txSignatoriesAndBodyToCardanoTx ::
+  [TxSkelSignatory] ->
+  Cardano.TxBody Cardano.ConwayEra ->
+  Cardano.Tx Cardano.ConwayEra
 txSignatoriesAndBodyToCardanoTx signatories txBody = Cardano.Tx txBody $ mapMaybe (toKeyWitness txBody) signatories
 
 -- | Generates a full Cardano transaction from a skeleton, fees and collaterals
-txSkelToCardanoTx :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Collaterals -> m (Cardano.Tx Cardano.ConwayEra)
-txSkelToCardanoTx txSkel fee = fmap (txSignatoriesAndBodyToCardanoTx (txSkelSignatories txSkel)) . txSkelToTxBody txSkel fee
+txSkelToCardanoTx ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
+  TxSkel ->
+  Fee ->
+  Collaterals ->
+  Sem effs (Cardano.Tx Cardano.ConwayEra)
+txSkelToCardanoTx txSkel fee =
+  fmap (txSignatoriesAndBodyToCardanoTx (txSkelSignatories txSkel))
+    . txSkelToTxBody txSkel fee
diff --git a/src/Cooked/MockChain/GenerateTx/Certificate.hs b/src/Cooked/MockChain/GenerateTx/Certificate.hs
index 0e21272ac..498b9dbfd 100644
--- a/src/Cooked/MockChain/GenerateTx/Certificate.hs
+++ b/src/Cooked/MockChain/GenerateTx/Certificate.hs
@@ -8,27 +8,41 @@ import Cardano.Ledger.DRep qualified as Ledger
 import Cardano.Ledger.PoolParams qualified as Ledger
 import Cardano.Ledger.Shelley.TxCert qualified as Shelley
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
-import Cooked.MockChain.BlockChain
+import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Witness
+import Cooked.MockChain.Read
 import Cooked.Skeleton.Certificate
 import Cooked.Skeleton.User
 import Data.Default
 import Data.Maybe.Strict
+import Ledger.Tx qualified as Ledger
 import Optics.Core
 import Plutus.Script.Utils.Address qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
 
-toDRep :: (MonadBlockChainBalancing m) => Api.DRep -> m Ledger.DRep
+toDRep ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.DRep ->
+  Sem effs Ledger.DRep
 toDRep Api.DRepAlwaysAbstain = return Ledger.DRepAlwaysAbstain
 toDRep Api.DRepAlwaysNoConfidence = return Ledger.DRepAlwaysNoConfidence
 toDRep (Api.DRep (Api.DRepCredential cred)) = Ledger.DRepCredential <$> toDRepCredential cred
 
-toDelegatee :: (MonadBlockChainBalancing m) => Api.Delegatee -> m Conway.Delegatee
+toDelegatee ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.Delegatee ->
+  Sem effs Conway.Delegatee
 toDelegatee (Api.DelegStake pkh) = Conway.DelegStake <$> toStakePoolKeyHash pkh
 toDelegatee (Api.DelegVote dRep) = Conway.DelegVote <$> toDRep dRep
 toDelegatee (Api.DelegStakeVote pkh dRep) = liftA2 Conway.DelegStakeVote (toStakePoolKeyHash pkh) (toDRep dRep)
 
-toCertificate :: (MonadBlockChainBalancing m) => TxSkelCertificate -> m (Cardano.Certificate Cardano.ConwayEra)
+toCertificate ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError, Fail] effs) =>
+  TxSkelCertificate ->
+  Sem effs (Cardano.Certificate Cardano.ConwayEra)
 toCertificate txSkelCert =
   do
     depositStake <- Cardano.Coin . Api.getLovelace <$> stakeAddressDeposit
@@ -74,7 +88,10 @@ toCertificate txSkelCert =
       TxSkelCertificate (Script.toCredential -> cred) CommitteeResign ->
         Conway.ConwayTxCertGov . (`Conway.ConwayResignCommitteeColdKey` SNothing) <$> toColdCredential cred
 
-toCertificateWitness :: (MonadBlockChainBalancing m) => TxSkelCertificate -> m (Maybe (Cardano.ScriptWitness Cardano.WitCtxStake Cardano.ConwayEra))
+toCertificateWitness ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  TxSkelCertificate ->
+  Sem effs (Maybe (Cardano.ScriptWitness Cardano.WitCtxStake Cardano.ConwayEra))
 toCertificateWitness =
   maybe
     (return Nothing)
@@ -85,7 +102,10 @@ toCertificateWitness =
     . preview (txSkelCertificateOwnerAT @IsEither)
 
 -- | Builds a 'Cardano.TxCertificates' from a list of 'TxSkelCertificate'
-toCertificates :: (MonadBlockChainBalancing m) => [TxSkelCertificate] -> m (Cardano.TxCertificates Cardano.BuildTx Cardano.ConwayEra)
+toCertificates ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
+  [TxSkelCertificate] ->
+  Sem effs (Cardano.TxCertificates Cardano.BuildTx Cardano.ConwayEra)
 toCertificates =
   fmap (Cardano.mkTxCertificates Cardano.ShelleyBasedEraConway)
     . mapM (\txSkelCert -> liftA2 (,) (toCertificate txSkelCert) (toCertificateWitness txSkelCert))
diff --git a/src/Cooked/MockChain/GenerateTx/Collateral.hs b/src/Cooked/MockChain/GenerateTx/Collateral.hs
index 9cf1de458..d441936dd 100644
--- a/src/Cooked/MockChain/GenerateTx/Collateral.hs
+++ b/src/Cooked/MockChain/GenerateTx/Collateral.hs
@@ -6,15 +6,17 @@ import Cardano.Api qualified as Cardano
 import Cardano.Ledger.Conway.Core qualified as Conway
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Common
-import Cooked.Skeleton
+import Cooked.MockChain.Common
+import Cooked.MockChain.Read
+import Cooked.Skeleton.Output
 import Data.Set qualified as Set
 import Ledger.Tx.CardanoAPI qualified as Ledger
 import Lens.Micro.Extras qualified as MicroLens
 import Plutus.Script.Utils.Address qualified as Script
 import Plutus.Script.Utils.Value qualified as Script
 import PlutusTx.Numeric qualified as PlutusTx
+import Polysemy
+import Polysemy.Error
 
 -- | Computes the collateral triplet from the fees and the collateral inputs in
 -- the context. What we call a collateral triplet is composed of:
@@ -24,10 +26,11 @@ import PlutusTx.Numeric qualified as PlutusTx
 -- These quantity should satisfy the equation (in terms of their values):
 -- collateral inputs = total collateral + return collateral
 toCollateralTriplet ::
-  (MonadBlockChainBalancing m) =>
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
   Fee ->
   Collaterals ->
-  m
+  Sem
+    effs
     ( Cardano.TxInsCollateral Cardano.ConwayEra,
       Cardano.TxTotalCollateral Cardano.ConwayEra,
       Cardano.TxReturnCollateral Cardano.CtxTx Cardano.ConwayEra
@@ -38,7 +41,7 @@ toCollateralTriplet fee (Just (Set.toList -> collateralInsList, returnCollateral
   txInsCollateral <-
     case collateralInsList of
       [] -> return Cardano.TxInsCollateralNone
-      l -> throwOnToCardanoError "toCollateralTriplet" $ Cardano.TxInsCollateral Cardano.AlonzoEraOnwardsConway <$> mapM Ledger.toCardanoTxIn l
+      l -> fromEither $ Cardano.TxInsCollateral Cardano.AlonzoEraOnwardsConway <$> mapM Ledger.toCardanoTxIn l
   -- Retrieving the total value in collateral inputs. This fails if one of the
   -- collateral inputs has not been successfully resolved.
   collateralInsValue <-
@@ -63,17 +66,11 @@ toCollateralTriplet fee (Just (Set.toList -> collateralInsList, returnCollateral
       then return Cardano.TxReturnCollateralNone
       else do
         -- The value is a translation of the remaining value
-        txReturnCollateralValue <-
-          Ledger.toCardanoTxOutValue
-            <$> throwOnToCardanoError
-              "toCollateralTriplet: cannot build return collateral value"
-              (Ledger.toCardanoValue returnCollateralValue)
+        txReturnCollateralValue <- Ledger.toCardanoTxOutValue <$> fromEither (Ledger.toCardanoValue returnCollateralValue)
         -- The address is the one from the return collateral user, which is
         -- required to exist here.
         networkId <- Emulator.pNetworkId <$> getParams
-        address <-
-          throwOnToCardanoError "toCollateralTriplet: cannot build return collateral address" $
-            Ledger.toCardanoAddressInEra networkId (Script.toAddress returnCollateralUser)
+        address <- fromEither $ Ledger.toCardanoAddressInEra networkId (Script.toAddress returnCollateralUser)
         -- The return collateral is built up from those elements
         return $
           Cardano.TxReturnCollateral Cardano.BabbageEraOnwardsConway $
diff --git a/src/Cooked/MockChain/GenerateTx/Common.hs b/src/Cooked/MockChain/GenerateTx/Common.hs
deleted file mode 100644
index 2aefb0f61..000000000
--- a/src/Cooked/MockChain/GenerateTx/Common.hs
+++ /dev/null
@@ -1,21 +0,0 @@
--- | Common utilities used to transfer generation errors raised by plutus-ledger
--- into instances of 'MockChainError'
-module Cooked.MockChain.GenerateTx.Common
-  ( throwOnToCardanoErrorOrApply,
-    throwOnToCardanoError,
-  )
-where
-
-import Control.Monad.Except
-import Cooked.MockChain.BlockChain
-import Ledger.Tx qualified as Ledger
-
--- | Lifts a 'Ledger.ToCardanoError' with an associated error message, or apply a
--- function if a value exists.
-throwOnToCardanoErrorOrApply :: (MonadError MockChainError m) => String -> (a -> b) -> Either Ledger.ToCardanoError a -> m b
-throwOnToCardanoErrorOrApply errorMsg f = either (throwError . MCEToCardanoError errorMsg) (return . f)
-
--- | Lifts a 'Ledger.ToCardanoError' with an associated error message, or leaves
--- the value unchanged if it exists.
-throwOnToCardanoError :: (MonadError MockChainError m) => String -> Either Ledger.ToCardanoError a -> m a
-throwOnToCardanoError = flip throwOnToCardanoErrorOrApply id
diff --git a/src/Cooked/MockChain/GenerateTx/Input.hs b/src/Cooked/MockChain/GenerateTx/Input.hs
index 4bfce560f..668412aba 100644
--- a/src/Cooked/MockChain/GenerateTx/Input.hs
+++ b/src/Cooked/MockChain/GenerateTx/Input.hs
@@ -2,19 +2,25 @@
 module Cooked.MockChain.GenerateTx.Input (toTxInAndWitness) where
 
 import Cardano.Api qualified as Cardano
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Common
+import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Witness
+import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Ledger.Tx.CardanoAPI qualified as Ledger
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
 
 -- | Converts a 'TxSkel' input, which consists of a 'Api.TxOutRef' and a
 -- 'TxSkelRedeemer', into a 'Cardano.TxIn', together with the appropriate witness.
 toTxInAndWitness ::
-  (MonadBlockChainBalancing m) =>
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
   (Api.TxOutRef, TxSkelRedeemer) ->
-  m (Cardano.TxIn, Cardano.BuildTxWith Cardano.BuildTx (Cardano.Witness Cardano.WitCtxTxIn Cardano.ConwayEra))
+  Sem
+    effs
+    ( Cardano.TxIn,
+      Cardano.BuildTxWith Cardano.BuildTx (Cardano.Witness Cardano.WitCtxTxIn Cardano.ConwayEra)
+    )
 toTxInAndWitness (txOutRef, txSkelRedeemer) = do
   TxSkelOut owner _ datum _ _ _ <- txSkelOutByRef txOutRef
   witness <- case owner of
@@ -26,7 +32,4 @@ toTxInAndWitness (txOutRef, txSkelRedeemer) = do
             NoTxSkelOutDatum -> Cardano.ScriptDatumForTxIn Nothing
             SomeTxSkelOutDatum _ Inline -> Cardano.InlineScriptDatum
             SomeTxSkelOutDatum dat _ -> Cardano.ScriptDatumForTxIn $ Just $ Ledger.toCardanoScriptData $ Api.toBuiltinData dat
-  throwOnToCardanoErrorOrApply
-    "toTxInAndWitness: Unable to translate TxOutRef"
-    (,Cardano.BuildTxWith witness)
-    (Ledger.toCardanoTxIn txOutRef)
+  (,Cardano.BuildTxWith witness) <$> fromEither (Ledger.toCardanoTxIn txOutRef)
diff --git a/src/Cooked/MockChain/GenerateTx/Mint.hs b/src/Cooked/MockChain/GenerateTx/Mint.hs
index 4abdca3b0..53b12114b 100644
--- a/src/Cooked/MockChain/GenerateTx/Mint.hs
+++ b/src/Cooked/MockChain/GenerateTx/Mint.hs
@@ -3,10 +3,11 @@ module Cooked.MockChain.GenerateTx.Mint (toMintValue) where
 
 import Cardano.Api qualified as Cardano
 import Control.Monad
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Common
+import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Witness
-import Cooked.Skeleton
+import Cooked.MockChain.Read
+import Cooked.Skeleton.Mint
+import Cooked.Skeleton.User
 import Data.Map qualified as Map
 import Data.Map.Strict qualified as SMap
 import GHC.Exts (fromList)
@@ -14,22 +15,24 @@ import Ledger.Tx.CardanoAPI qualified as Ledger
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 import PlutusTx.Builtins.Internal qualified as PlutusTx
+import Polysemy
+import Polysemy.Error
 
 -- | Converts a 'TxSkelMints' into a 'Cardano.TxMintValue'
-toMintValue :: (MonadBlockChainBalancing m) => TxSkelMints -> m (Cardano.TxMintValue Cardano.BuildTx Cardano.ConwayEra)
+toMintValue ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  TxSkelMints ->
+  Sem effs (Cardano.TxMintValue Cardano.BuildTx Cardano.ConwayEra)
 toMintValue txSkelMints | txSkelMints == mempty = return Cardano.TxMintNone
 toMintValue (unTxSkelMints -> mints) = fmap (Cardano.TxMintValue Cardano.MaryEraOnwardsConway . SMap.fromList) $
   forM (Map.toList mints) $ \(policyHash, (UserRedeemedScript policy red, Map.toList -> assets)) -> do
-    policyId <-
-      throwOnToCardanoError
-        "toMintValue: Unable to translate minting policy hash"
-        (Ledger.toCardanoPolicyId $ Script.toMintingPolicyHash policyHash)
+    policyId <- fromEither $ Ledger.toCardanoPolicyId $ Script.toMintingPolicyHash policyHash
     mintWitness <- Cardano.BuildTxWith <$> toScriptWitness policy red Cardano.NoScriptDatumForMint
     return
       ( policyId,
         ( fromList
             [ (Cardano.UnsafeAssetName name, Cardano.Quantity quantity)
-            | (Api.TokenName (PlutusTx.BuiltinByteString name), quantity) <- assets
+              | (Api.TokenName (PlutusTx.BuiltinByteString name), quantity) <- assets
             ],
           mintWitness
         )
diff --git a/src/Cooked/MockChain/GenerateTx/Output.hs b/src/Cooked/MockChain/GenerateTx/Output.hs
index 5279676af..531814378 100644
--- a/src/Cooked/MockChain/GenerateTx/Output.hs
+++ b/src/Cooked/MockChain/GenerateTx/Output.hs
@@ -3,37 +3,42 @@ module Cooked.MockChain.GenerateTx.Output (toCardanoTxOut) where
 
 import Cardano.Api qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Common
-import Cooked.Skeleton
+import Cooked.MockChain.Read
+import Cooked.Skeleton.Datum
+import Cooked.Skeleton.Output
 import Ledger.Tx.CardanoAPI qualified as Ledger
 import Optics.Core
 import Plutus.Script.Utils.Data qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
 
 -- | Converts a 'TxSkelOut' to the corresponding 'Cardano.TxOut'
-toCardanoTxOut :: (MonadBlockChainBalancing m) => TxSkelOut -> m (Cardano.TxOut Cardano.CtxTx Cardano.ConwayEra)
+toCardanoTxOut ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  TxSkelOut ->
+  Sem effs (Cardano.TxOut Cardano.CtxTx Cardano.ConwayEra)
 toCardanoTxOut output = do
   let oAddress = view txSkelOutAddressG output
       oValue = view txSkelOutValueL output
       oDatum = output ^. txSkelOutDatumL
       oRefScript = view txSkelOutMReferenceScriptL output
   networkId <- Emulator.pNetworkId <$> getParams
-  address <-
-    throwOnToCardanoError
-      ("toCardanoTxOut: Unable to translate the following address: " <> show oAddress)
-      (Ledger.toCardanoAddressInEra networkId oAddress)
-  (Ledger.toCardanoTxOutValue -> value) <-
-    throwOnToCardanoError
-      ("toCardanoTxOut: Unable to translate the following value:" <> show oValue)
-      (Ledger.toCardanoValue oValue)
+  address <- fromEither $ Ledger.toCardanoAddressInEra networkId oAddress
+  (Ledger.toCardanoTxOutValue -> value) <- fromEither $ Ledger.toCardanoValue oValue
   datum <- case oDatum of
     NoTxSkelOutDatum -> return Cardano.TxOutDatumNone
     SomeTxSkelOutDatum datum (Hashed NotResolved) ->
       Cardano.TxOutDatumHash Cardano.AlonzoEraOnwardsConway
-        <$> throwOnToCardanoError
-          "toCardanoTxOut: Unable to resolve/transate a datum hash."
-          (Ledger.toCardanoScriptDataHash $ Script.datumHash $ Api.Datum $ Api.toBuiltinData datum)
-    SomeTxSkelOutDatum datum (Hashed Resolved) -> return $ Cardano.TxOutSupplementalDatum Cardano.AlonzoEraOnwardsConway $ Ledger.toCardanoScriptData $ Api.toBuiltinData datum
-    SomeTxSkelOutDatum datum Inline -> return $ Cardano.TxOutDatumInline Cardano.BabbageEraOnwardsConway $ Ledger.toCardanoScriptData $ Api.toBuiltinData datum
+        <$> fromEither (Ledger.toCardanoScriptDataHash $ Script.datumHash $ Api.Datum $ Api.toBuiltinData datum)
+    SomeTxSkelOutDatum datum (Hashed Resolved) ->
+      return $
+        Cardano.TxOutSupplementalDatum Cardano.AlonzoEraOnwardsConway $
+          Ledger.toCardanoScriptData $
+            Api.toBuiltinData datum
+    SomeTxSkelOutDatum datum Inline ->
+      return $
+        Cardano.TxOutDatumInline Cardano.BabbageEraOnwardsConway $
+          Ledger.toCardanoScriptData $
+            Api.toBuiltinData datum
   return $ Cardano.TxOut address value datum $ Ledger.toCardanoReferenceScript oRefScript
diff --git a/src/Cooked/MockChain/GenerateTx/Proposal.hs b/src/Cooked/MockChain/GenerateTx/Proposal.hs
index e146f77fb..5445e1cd4 100644
--- a/src/Cooked/MockChain/GenerateTx/Proposal.hs
+++ b/src/Cooked/MockChain/GenerateTx/Proposal.hs
@@ -9,12 +9,12 @@ import Cardano.Ledger.Conway.Governance qualified as Conway
 import Cardano.Ledger.Conway.PParams qualified as Conway
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad
-import Control.Monad.Except (throwError)
-import Cooked.MockChain.BlockChain
+import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Anchor
-import Cooked.MockChain.GenerateTx.Common
 import Cooked.MockChain.GenerateTx.Witness
-import Cooked.Skeleton
+import Cooked.MockChain.Read
+import Cooked.Skeleton.Proposal
+import Cooked.Skeleton.User
 import Data.Coerce
 import Data.Map qualified as Map
 import Data.Map.Ordered.Strict qualified as OMap
@@ -25,10 +25,15 @@ import Lens.Micro qualified as MicroLens
 import Plutus.Script.Utils.Address qualified as Script
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
+import Polysemy
+import Polysemy.Error
 
 -- | Transorms a `Cooked.Skeleton.Proposal.ParameterChange` into an actual
 -- change over a Cardano parameter update
-toPParamsUpdate :: ParameterChange -> Conway.PParamsUpdate Emulator.EmulatorEra -> Conway.PParamsUpdate Emulator.EmulatorEra
+toPParamsUpdate ::
+  ParameterChange ->
+  Conway.PParamsUpdate Emulator.EmulatorEra ->
+  Conway.PParamsUpdate Emulator.EmulatorEra
 toPParamsUpdate pChange =
   -- From rational to bounded rational
   let toBR :: (Cardano.BoundedRational r) => Rational -> r
@@ -72,11 +77,15 @@ toPParamsUpdate pChange =
         MinFeeRefScriptCostPerByte q -> setL Conway.ppuMinFeeRefScriptCostPerByteL $ fromMaybe minBound $ Cardano.boundRational q
 
 -- | Translates a given skeleton proposal into a governance action
-toGovAction :: (MonadBlockChainBalancing m) => GovernanceAction a -> StrictMaybe Conway.ScriptHash -> m (Conway.GovAction Emulator.EmulatorEra)
+toGovAction ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  GovernanceAction a ->
+  StrictMaybe Conway.ScriptHash ->
+  Sem effs (Conway.GovAction Emulator.EmulatorEra)
 toGovAction NoConfidence _ = return $ Conway.NoConfidence SNothing
-toGovAction UpdateCommittee {} _ = throwError $ MCEUnsupportedFeature "UpdateCommittee"
-toGovAction NewConstitution {} _ = throwError $ MCEUnsupportedFeature "TxGovActionNewConstitution"
-toGovAction HardForkInitiation {} _ = throwError $ MCEUnsupportedFeature "TxGovActionHardForkInitiation"
+toGovAction UpdateCommittee {} _ = throw $ MCEUnsupportedFeature "UpdateCommittee"
+toGovAction NewConstitution {} _ = throw $ MCEUnsupportedFeature "TxGovActionNewConstitution"
+toGovAction HardForkInitiation {} _ = throw $ MCEUnsupportedFeature "TxGovActionHardForkInitiation"
 toGovAction (ParameterChange changes) sHash =
   return $ Conway.ParameterChange SNothing (foldl (flip toPParamsUpdate) (Conway.PParamsUpdate Cardano.emptyPParamsStrictMaybe) changes) sHash
 toGovAction (TreasuryWithdrawals (Map.toList -> withdrawals)) sHash =
@@ -84,9 +93,9 @@ toGovAction (TreasuryWithdrawals (Map.toList -> withdrawals)) sHash =
 
 -- | Translates a list of skeleton proposals into a proposal procedures
 toProposalProcedures ::
-  (MonadBlockChainBalancing m) =>
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
   [TxSkelProposal] ->
-  m (Cardano.TxProposalProcedures Cardano.BuildTx Cardano.ConwayEra)
+  Sem effs (Cardano.TxProposalProcedures Cardano.BuildTx Cardano.ConwayEra)
 toProposalProcedures props | null props = return Cardano.TxProposalProceduresNone
 toProposalProcedures props =
   Cardano.TxProposalProcedures . OMap.fromList
@@ -98,7 +107,7 @@ toProposalProcedures props =
           (Cardano.BuildTxWith -> mConstitutionWitness, mConstitutionHash) <- case mConstitution of
             Just (UserRedeemedScript (toVScript -> script) redeemer) -> do
               scriptWitness <- toScriptWitness script redeemer Cardano.NoScriptDatumForStake
-              Cardano.ScriptHash scriptHash <- throwOnToCardanoError "Unable to convert script hash" $ Ledger.toCardanoScriptHash $ Script.toScriptHash script
+              Cardano.ScriptHash scriptHash <- fromEither $ Ledger.toCardanoScriptHash $ Script.toScriptHash script
               return (Just scriptWitness, SJust scriptHash)
             _ -> return (Nothing, SNothing)
           cardanoGovAction <- toGovAction govAction mConstitutionHash
diff --git a/src/Cooked/MockChain/GenerateTx/ReferenceInputs.hs b/src/Cooked/MockChain/GenerateTx/ReferenceInputs.hs
index 0248808b9..69ae7375c 100644
--- a/src/Cooked/MockChain/GenerateTx/ReferenceInputs.hs
+++ b/src/Cooked/MockChain/GenerateTx/ReferenceInputs.hs
@@ -2,20 +2,24 @@
 module Cooked.MockChain.GenerateTx.ReferenceInputs (toInsReference) where
 
 import Cardano.Api qualified as Cardano
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Common
+import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Ledger.Tx.CardanoAPI qualified as Ledger
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
 
 -- | Takes a 'TxSkel' and generates the associated 'Cardano.TxInsReference' from
 -- its content. These reference inputs can be found in two places, either in
 -- direct reference inputs 'txSkelInsReference' or scattered in the various
 -- redeemers of the transaction, which can be gathered with
 -- 'txSkelInsReferenceInRedeemers'.
-toInsReference :: (MonadBlockChainBalancing m) => TxSkel -> m (Cardano.TxInsReference Cardano.BuildTx Cardano.ConwayEra)
+toInsReference ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  TxSkel ->
+  Sem effs (Cardano.TxInsReference Cardano.BuildTx Cardano.ConwayEra)
 toInsReference skel = do
   -- As regular inputs can be used to hold scripts as if in reference inputs, we
   -- need to remove from the reference inputs stored in redeemers the ones that
@@ -26,10 +30,7 @@ toInsReference skel = do
   if null refInputs
     then return Cardano.TxInsReferenceNone
     else do
-      cardanoRefInputs <-
-        throwOnToCardanoError
-          "toInsReference: Unable to translate reference inputs."
-          (mapM Ledger.toCardanoTxIn refInputs)
+      cardanoRefInputs <- fromEither $ mapM Ledger.toCardanoTxIn refInputs
       resolvedDatums <- mapM (viewByRef txSkelOutDatumL) refInputs
       return $
         Cardano.TxInsReference Cardano.BabbageEraOnwardsConway cardanoRefInputs $
diff --git a/src/Cooked/MockChain/GenerateTx/Withdrawals.hs b/src/Cooked/MockChain/GenerateTx/Withdrawals.hs
index e07242247..dafaaef31 100644
--- a/src/Cooked/MockChain/GenerateTx/Withdrawals.hs
+++ b/src/Cooked/MockChain/GenerateTx/Withdrawals.hs
@@ -4,19 +4,25 @@ module Cooked.MockChain.GenerateTx.Withdrawals (toWithdrawals) where
 import Cardano.Api qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
 import Control.Monad
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Common
+import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Witness
-import Cooked.Skeleton
+import Cooked.MockChain.Read
+import Cooked.Skeleton.User
+import Cooked.Skeleton.Withdrawal
 import Data.Coerce
 import Ledger.Tx.CardanoAPI qualified as Ledger
 import Optics.Core
 import Plutus.Script.Utils.Address qualified as Script
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
+import Polysemy
+import Polysemy.Error
 
 -- | Takes a 'TxSkelWithdrawals' and transforms it into a 'Cardano.TxWithdrawals'
-toWithdrawals :: (MonadBlockChainBalancing m) => TxSkelWithdrawals -> m (Cardano.TxWithdrawals Cardano.BuildTx Cardano.ConwayEra)
+toWithdrawals ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  TxSkelWithdrawals ->
+  Sem effs (Cardano.TxWithdrawals Cardano.BuildTx Cardano.ConwayEra)
 toWithdrawals withdrawals | withdrawals == mempty = return Cardano.TxWithdrawalsNone
 toWithdrawals (view txSkelWithdrawalsListI -> withdrawals) = do
   networkId <- Emulator.pNetworkId <$> getParams
@@ -24,17 +30,13 @@ toWithdrawals (view txSkelWithdrawalsListI -> withdrawals) = do
     let coinAmount = maybe (Cardano.Coin 0) coerce amount
     (sCred, witness) <- case user of
       UserPubKey (Script.toPubKeyHash -> pkh) -> do
-        sCred <-
-          throwOnToCardanoError "toWithdrawals: unable to translate pkh stake credential" $
-            Cardano.StakeCredentialByKey <$> Ledger.toCardanoStakeKeyHash pkh
+        sCred <- fromEither $ Cardano.StakeCredentialByKey <$> Ledger.toCardanoStakeKeyHash pkh
         return (sCred, Cardano.KeyWitness Cardano.KeyWitnessForStakeAddr)
       UserRedeemedScript (toVScript -> vScript) red -> do
         witness <-
           Cardano.ScriptWitness Cardano.ScriptWitnessForStakeAddr
             <$> toScriptWitness vScript red Cardano.NoScriptDatumForStake
-        sCred <-
-          throwOnToCardanoError "toWithdrawals: unable to translate script stake credential" $
-            Cardano.StakeCredentialByScript <$> Ledger.toCardanoScriptHash (Script.toScriptHash vScript)
+        sCred <- fromEither $ Cardano.StakeCredentialByScript <$> Ledger.toCardanoScriptHash (Script.toScriptHash vScript)
         return (sCred, witness)
     return (Cardano.makeStakeAddress networkId sCred, coinAmount, Cardano.BuildTxWith witness)
   return $ Cardano.TxWithdrawals Cardano.ShelleyBasedEraConway cardanoWithdrawals
diff --git a/src/Cooked/MockChain/GenerateTx/Witness.hs b/src/Cooked/MockChain/GenerateTx/Witness.hs
index 6dec00f17..f43fecc8d 100644
--- a/src/Cooked/MockChain/GenerateTx/Witness.hs
+++ b/src/Cooked/MockChain/GenerateTx/Witness.hs
@@ -20,103 +20,151 @@ import Cardano.Api qualified as Cardano
 import Cardano.Ledger.BaseTypes qualified as C.Ledger
 import Cardano.Ledger.Hashes qualified as C.Ledger
 import Cardano.Ledger.Shelley.API qualified as C.Ledger
-import Control.Monad.Except (throwError)
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Common
+import Cooked.MockChain.Error
+import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Ledger.Address qualified as Ledger
 import Ledger.Tx.CardanoAPI qualified as Ledger
 import Optics.Core
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
 
 -- | Translates a given credential to a reward account.
-toRewardAccount :: (MonadBlockChainBalancing m) => Api.Credential -> m C.Ledger.RewardAccount
-toRewardAccount = (C.Ledger.RewardAccount C.Ledger.Testnet <$>) . toCardanoCredential Cardano.AsStakeKey Cardano.unStakeKeyHash
+toRewardAccount ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.Credential ->
+  Sem effs C.Ledger.RewardAccount
+toRewardAccount =
+  (C.Ledger.RewardAccount C.Ledger.Testnet <$>)
+    . toCardanoCredential Cardano.AsStakeKey Cardano.unStakeKeyHash
 
 -- TODO: if this works, migrate to plutus-ledger
 
 -- | Converts an 'Api.PubKeyHash' to any kind of key
 deserialiseFromBuiltinByteString ::
-  (MonadBlockChainBalancing m, Cardano.SerialiseAsRawBytes a) =>
+  ( Members '[MockChainRead, Error Ledger.ToCardanoError] effs,
+    Cardano.SerialiseAsRawBytes a
+  ) =>
   Cardano.AsType a ->
   Api.BuiltinByteString ->
-  m a
+  Sem effs a
 deserialiseFromBuiltinByteString asType =
-  throwOnToCardanoError "deserialiseFromBuiltinByteString" . Ledger.deserialiseFromRawBytes asType . Api.fromBuiltin
+  fromEither
+    . Ledger.deserialiseFromRawBytes asType
+    . Api.fromBuiltin
 
 -- | Converts a plutus script hash into a cardano ledger script hash
-toScriptHash :: (MonadBlockChainBalancing m) => Api.ScriptHash -> m C.Ledger.ScriptHash
+toScriptHash ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.ScriptHash ->
+  Sem effs C.Ledger.ScriptHash
 toScriptHash (Api.ScriptHash sHash) = do
   Cardano.ScriptHash cHash <- deserialiseFromBuiltinByteString Cardano.AsScriptHash sHash
   return cHash
 
 -- | Converts a plutus pkhash into a certain cardano ledger hash
 toKeyHash ::
-  (MonadBlockChainBalancing m, Cardano.SerialiseAsRawBytes (Cardano.Hash key)) =>
+  ( Members '[MockChainRead, Error Ledger.ToCardanoError] effs,
+    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
+  ) =>
   Cardano.AsType key ->
   (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
   Api.PubKeyHash ->
-  m (C.Ledger.KeyHash kr)
-toKeyHash asType unwrap = fmap unwrap . deserialiseFromBuiltinByteString (Cardano.AsHash asType) . Api.getPubKeyHash
+  Sem effs (C.Ledger.KeyHash kr)
+toKeyHash asType unwrap =
+  fmap unwrap
+    . deserialiseFromBuiltinByteString (Cardano.AsHash asType)
+    . Api.getPubKeyHash
 
 -- | Converts an 'Api.PubKeyHash' into a cardano ledger stake pool key hash
-toStakePoolKeyHash :: (MonadBlockChainBalancing m) => Api.PubKeyHash -> m (C.Ledger.KeyHash 'C.Ledger.StakePool)
+toStakePoolKeyHash ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.PubKeyHash ->
+  Sem effs (C.Ledger.KeyHash 'C.Ledger.StakePool)
 toStakePoolKeyHash = toKeyHash Cardano.AsStakePoolKey Cardano.unStakePoolKeyHash
 
 -- | Converts an 'Api.PubKeyHash' into a cardano ledger VRFVerKeyHash
-toVRFVerKeyHash :: (MonadBlockChainBalancing m) => Api.PubKeyHash -> m (C.Ledger.VRFVerKeyHash a)
+toVRFVerKeyHash ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.PubKeyHash ->
+  Sem effs (C.Ledger.VRFVerKeyHash a)
 toVRFVerKeyHash (Api.PubKeyHash pkh) = do
   Cardano.VrfKeyHash key <- deserialiseFromBuiltinByteString (Cardano.AsHash Cardano.AsVrfKey) pkh
   return $ C.Ledger.toVRFVerKeyHash key
 
 -- | Converts an 'Api.Credential' to a Cardano Credential of the expected kind
 toCardanoCredential ::
-  (MonadBlockChainBalancing m, Cardano.SerialiseAsRawBytes (Cardano.Hash key)) =>
+  ( Members '[MockChainRead, Error Ledger.ToCardanoError] effs,
+    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
+  ) =>
   Cardano.AsType key ->
   (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
   Api.Credential ->
-  m (C.Ledger.Credential kr)
+  Sem effs (C.Ledger.Credential kr)
 toCardanoCredential _ _ (Api.ScriptCredential sHash) = C.Ledger.ScriptHashObj <$> toScriptHash sHash
 toCardanoCredential asType unwrap (Api.PubKeyCredential pkHash) = C.Ledger.KeyHashObj <$> toKeyHash asType unwrap pkHash
 
 -- | Translates a credential into a Cardano stake credential
-toStakeCredential :: (MonadBlockChainBalancing m) => Api.Credential -> m (C.Ledger.Credential 'C.Ledger.Staking)
+toStakeCredential ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.Staking)
 toStakeCredential = toCardanoCredential Cardano.AsStakeKey Cardano.unStakeKeyHash
 
 -- | Translates a credential into a Cardano drep credential
-toDRepCredential :: (MonadBlockChainBalancing m) => Api.Credential -> m (C.Ledger.Credential 'C.Ledger.DRepRole)
+toDRepCredential ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.DRepRole)
 toDRepCredential = toCardanoCredential Cardano.AsDRepKey Cardano.unDRepKeyHash
 
 -- | Translates a credential into a Cardano cold committee credential
-toColdCredential :: (MonadBlockChainBalancing m) => Api.Credential -> m (C.Ledger.Credential 'C.Ledger.ColdCommitteeRole)
+toColdCredential ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.ColdCommitteeRole)
 toColdCredential = toCardanoCredential Cardano.AsCommitteeColdKey Cardano.unCommitteeColdKeyHash
 
 -- | Translates a credential into a Cardano hot committee credential
-toHotCredential :: (MonadBlockChainBalancing m) => Api.Credential -> m (C.Ledger.Credential 'C.Ledger.HotCommitteeRole)
+toHotCredential ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.HotCommitteeRole)
 toHotCredential = toCardanoCredential Cardano.AsCommitteeHotKey Cardano.unCommitteeHotKeyHash
 
 -- | Translates a script and a reference script utxo into either a plutus script
 -- or a reference input containing the right script
-toPlutusScriptOrReferenceInput :: (MonadBlockChainBalancing m) => VScript -> Maybe Api.TxOutRef -> m (Cardano.PlutusScriptOrReferenceInput lang)
-toPlutusScriptOrReferenceInput (Script.Versioned (Script.Script script) _) Nothing = return $ Cardano.PScript $ Cardano.PlutusScriptSerialised script
+toPlutusScriptOrReferenceInput ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  VScript ->
+  Maybe Api.TxOutRef ->
+  Sem effs (Cardano.PlutusScriptOrReferenceInput lang)
+toPlutusScriptOrReferenceInput (Script.Versioned (Script.Script script) _) Nothing =
+  return $ Cardano.PScript $ Cardano.PlutusScriptSerialised script
 toPlutusScriptOrReferenceInput (Script.toScriptHash -> scriptHash) (Just scriptOutRef) = do
   (preview txSkelOutReferenceScriptHashAF -> mScriptHash) <- txSkelOutByRef scriptOutRef
   case mScriptHash of
     Just scriptHash'
-      | scriptHash == scriptHash' ->
-          Cardano.PReferenceScript
-            <$> throwOnToCardanoError
-              "toPlutusScriptOrReferenceInput: Unable to translate reference script utxo."
-              (Ledger.toCardanoTxIn scriptOutRef)
-    _ -> throwError $ MCEWrongReferenceScriptError scriptOutRef scriptHash mScriptHash
+      | scriptHash == scriptHash' -> do
+          s <- fromEither $ Ledger.toCardanoTxIn scriptOutRef
+          return $ Cardano.PReferenceScript s
+    _ -> throw $ MCEWrongReferenceScriptError scriptOutRef scriptHash mScriptHash
 
 -- | Translates a script with its associated redeemer and datum to a script
 -- witness. Note on the usage of 'Ledger.zeroExecutionUnits': at this stage of
 -- the transaction create, we cannot know the execution units used by the
 -- script. They will be filled out later on once the full body has been
 -- generated. So, for now, we temporarily leave them to 0.
-toScriptWitness :: (MonadBlockChainBalancing m, ToVScript a) => a -> TxSkelRedeemer -> Cardano.ScriptDatum b -> m (Cardano.ScriptWitness b Cardano.ConwayEra)
+toScriptWitness ::
+  ( Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs,
+    ToVScript a
+  ) =>
+  a ->
+  TxSkelRedeemer ->
+  Cardano.ScriptDatum b ->
+  Sem effs (Cardano.ScriptWitness b Cardano.ConwayEra)
 toScriptWitness (toVScript -> script@(Script.Versioned _ version)) (TxSkelRedeemer {..}) datum = do
   let scriptData = Ledger.toCardanoScriptData $ Api.toBuiltinData txSkelRedeemerContent
   case version of
@@ -132,7 +180,10 @@ toScriptWitness (toVScript -> script@(Script.Versioned _ version)) (TxSkelRedeem
 
 -- | Generates a key witnesses for a given signatory and body, when the
 -- signatory contains a private key.
-toKeyWitness :: Cardano.TxBody Cardano.ConwayEra -> TxSkelSignatory -> Maybe (Cardano.KeyWitness Cardano.ConwayEra)
+toKeyWitness ::
+  Cardano.TxBody Cardano.ConwayEra ->
+  TxSkelSignatory ->
+  Maybe (Cardano.KeyWitness Cardano.ConwayEra)
 toKeyWitness txBody =
   fmap
     ( Cardano.makeShelleyKeyWitness Cardano.ShelleyBasedEraConway txBody
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index bb84330d4..c1aec7595 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- | This module defines 'Tweak's which are the building blocks of our DSL for
@@ -66,7 +67,10 @@ runTweak txSkel =
 -- `Cooked.Ltl`. They encompass a computation which can branch and has access to
 -- a `TxSkel` on top of other effects.
 data UntypedTweak effs where
-  UntypedTweak :: Sem (Tweak : NonDet : effs) a -> UntypedTweak effs
+  UntypedTweak ::
+    (Members tweakEffs effs) =>
+    Sem (Tweak : NonDet : effs) a ->
+    UntypedTweak effs
 
 -- | Retrieves some value from the 'TxSkel'
 viewTweak ::
diff --git a/src/Cooked/Tweak/Inputs.hs b/src/Cooked/Tweak/Inputs.hs
index c2359e7d5..ea5941a52 100644
--- a/src/Cooked/Tweak/Inputs.hs
+++ b/src/Cooked/Tweak/Inputs.hs
@@ -14,11 +14,17 @@ import Cooked.Tweak.Common
 import Data.Map qualified as Map
 import Optics.Core
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.NonDet
 
 -- | Ensure that a given 'Api.TxOutRef' is being spent with a given
 -- 'TxSkelRedeemer'. The return value will be @Just@ the added data, if anything
 -- changed.
-ensureInputTweak :: (MonadTweak m) => Api.TxOutRef -> TxSkelRedeemer -> m (Maybe (Api.TxOutRef, TxSkelRedeemer))
+ensureInputTweak ::
+  (Member Tweak effs) =>
+  Api.TxOutRef ->
+  TxSkelRedeemer ->
+  Sem effs (Maybe (Api.TxOutRef, TxSkelRedeemer))
 ensureInputTweak oref howConsumed = do
   presentInputs <- viewTweak txSkelInsL
   if presentInputs Map.!? oref == Just howConsumed
@@ -29,7 +35,11 @@ ensureInputTweak oref howConsumed = do
 
 -- | Add an input to a transaction. If the given 'Api.TxOutRef' is already being
 -- consumed by the transaction, fail.
-addInputTweak :: (MonadTweak m) => Api.TxOutRef -> TxSkelRedeemer -> m ()
+addInputTweak ::
+  (Members '[Tweak, NonDet] effs) =>
+  Api.TxOutRef ->
+  TxSkelRedeemer ->
+  Sem effs ()
 addInputTweak oref howConsumed = do
   presentInputs <- viewTweak txSkelInsL
   guard (Map.notMember oref presentInputs)
@@ -37,7 +47,10 @@ addInputTweak oref howConsumed = do
 
 -- | Remove transaction inputs according to a given predicate. The returned list
 -- contains all removed inputs.
-removeInputTweak :: (MonadTweak m) => (Api.TxOutRef -> TxSkelRedeemer -> Bool) -> m [(Api.TxOutRef, TxSkelRedeemer)]
+removeInputTweak ::
+  (Member Tweak effs) =>
+  (Api.TxOutRef -> TxSkelRedeemer -> Bool) ->
+  Sem effs [(Api.TxOutRef, TxSkelRedeemer)]
 removeInputTweak removePred = do
   presentInputs <- viewTweak txSkelInsL
   let (removed, kept) = Map.partitionWithKey removePred presentInputs
@@ -46,7 +59,14 @@ removeInputTweak removePred = do
 
 -- | Applies an optional modification to all spend redeemers of type a. Returns
 -- the list of modified spending redemeers, as they were before being modified.
-modifySpendRedeemersOfTypeTweak :: forall a b m. (RedeemerConstrs a, RedeemerConstrs b, MonadTweak m) => (a -> Maybe b) -> m [TxSkelRedeemer]
+modifySpendRedeemersOfTypeTweak ::
+  forall a b effs.
+  ( RedeemerConstrs a,
+    RedeemerConstrs b,
+    Member Tweak effs
+  ) =>
+  (a -> Maybe b) ->
+  Sem effs [TxSkelRedeemer]
 modifySpendRedeemersOfTypeTweak f =
   overMaybeTweak (txSkelInsL % iso Map.toList Map.fromList % traversed % _2) $ \red -> do
     typedRedeemer <- red ^? txSkelRedeemerTypedAT
diff --git a/src/Cooked/Tweak/Labels.hs b/src/Cooked/Tweak/Labels.hs
index 91d8816f2..9e4e496fc 100644
--- a/src/Cooked/Tweak/Labels.hs
+++ b/src/Cooked/Tweak/Labels.hs
@@ -15,21 +15,43 @@ import Cooked.Tweak.Common
 import Data.Functor
 import Data.Set qualified as Set
 import Data.Text (Text)
+import Polysemy
+import Polysemy.NonDet
 
 -- | Adds a label to a 'TxSkel'.
-addLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m ()
+addLabelTweak ::
+  ( LabelConstrs lbl,
+    Member Tweak effs
+  ) =>
+  lbl ->
+  Sem effs ()
 addLabelTweak = overTweak txSkelLabelL . Set.insert . TxSkelLabel
 
 -- | Checks if a given label is present in the 'TxSkel'
-hasLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m Bool
+hasLabelTweak ::
+  ( LabelConstrs lbl,
+    Member Tweak effs
+  ) =>
+  lbl ->
+  Sem effs Bool
 hasLabelTweak = (viewTweak txSkelLabelL <&>) . Set.member . TxSkelLabel
 
 -- | Ensures a given label is present in the 'TxSkel'
-ensureLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m ()
+ensureLabelTweak ::
+  ( LabelConstrs lbl,
+    Members '[Tweak, NonDet] effs
+  ) =>
+  lbl ->
+  Sem effs ()
 ensureLabelTweak = hasLabelTweak >=> guard
 
 -- | Removes a label from a 'TxSkel' when possible, fails otherwise
-removeLabelTweak :: (LabelConstrs lbl, MonadTweak m) => lbl -> m ()
+removeLabelTweak ::
+  ( LabelConstrs lbl,
+    Members '[Tweak, NonDet] effs
+  ) =>
+  lbl ->
+  Sem effs ()
 removeLabelTweak lbl = do
   ensureLabelTweak lbl
   overTweak txSkelLabelL . Set.delete $ TxSkelLabel lbl
@@ -49,7 +71,13 @@ removeLabelTweak lbl = do
 -- >
 -- > someTest = someEndpoint & eveywhere (labelled SomeLabelType someTweak)
 -- > anotherTest = someEndpoint & somewhere (labelled SomeLabelType someTweak)
-labelled :: (LabelConstrs lbl, MonadTweak m) => lbl -> m a -> m a
+labelled ::
+  ( LabelConstrs lbl,
+    Members '[Tweak, NonDet] effs
+  ) =>
+  lbl ->
+  Sem effs a ->
+  Sem effs a
 labelled lbl = (ensureLabelTweak lbl >>)
 
 -- | `labelled` specialised to Text labels
@@ -66,5 +94,9 @@ labelled lbl = (ensureLabelTweak lbl >>)
 -- >      }
 -- >
 -- > someTest = someEndpoint & somewhere (labelled' "Spending" doubleSatAttack)
-labelled' :: (MonadTweak m) => Text -> m a -> m a
+labelled' ::
+  (Members '[Tweak, NonDet] effs) =>
+  Text ->
+  Sem effs a ->
+  Sem effs a
 labelled' = labelled
diff --git a/src/Cooked/Tweak/Mint.hs b/src/Cooked/Tweak/Mint.hs
index 81b3c1fe5..2c3f02864 100644
--- a/src/Cooked/Tweak/Mint.hs
+++ b/src/Cooked/Tweak/Mint.hs
@@ -9,15 +9,22 @@ import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Data.List (partition)
 import Optics.Core
+import Polysemy
 
 -- | Adds new entries to the 'TxSkelMints' of the transaction skeleton under
 -- modification.
-addMintsTweak :: (MonadTweak m) => [Mint] -> m ()
+addMintsTweak ::
+  (Member Tweak effs) =>
+  [Mint] ->
+  Sem effs ()
 addMintsTweak newMints = overTweak (txSkelMintsL % txSkelMintsListI) (++ newMints)
 
 -- | Remove some entries from the 'TxSkelMints' of a transaction, according to
 -- some predicate. The returned list holds the removed entries.
-removeMintTweak :: (MonadTweak m) => (Mint -> Bool) -> m [Mint]
+removeMintTweak ::
+  (Member Tweak effs) =>
+  (Mint -> Bool) ->
+  Sem effs [Mint]
 removeMintTweak removePred = do
   presentMints <- viewTweak $ txSkelMintsL % txSkelMintsListI
   let (removed, kept) = partition removePred presentMints
diff --git a/src/Cooked/Tweak/OutPermutations.hs b/src/Cooked/Tweak/OutPermutations.hs
index 30ec5bb3e..1785fc705 100644
--- a/src/Cooked/Tweak/OutPermutations.hs
+++ b/src/Cooked/Tweak/OutPermutations.hs
@@ -14,6 +14,8 @@ where
 import Control.Monad
 import Cooked.Skeleton
 import Cooked.Tweak.Common
+import Polysemy
+import Polysemy.NonDet
 import System.Random
 import System.Random.Shuffle
 
@@ -39,7 +41,10 @@ data PermutOutTweakMode = KeepIdentity (Maybe Int) | OmitIdentity (Maybe Int)
 --
 -- (In particular, this is clever enough to generate only the distinct
 -- permutations, even if some outputs are identical.)
-allOutPermutsTweak :: (MonadTweak m) => PermutOutTweakMode -> m ()
+allOutPermutsTweak ::
+  (Members '[Tweak, NonDet] effs) =>
+  PermutOutTweakMode ->
+  Sem effs ()
 allOutPermutsTweak mode = do
   oldOut <- viewTweak txSkelOutsL
   msum $
@@ -90,7 +95,10 @@ nonIdentityPermutations l = removeFirst l $ distinctPermutations l
 
 -- | This randomly permutes the outputs of a transaction with a given seed. Can
 -- be used to assess if a certain validator is order-dependant
-singleOutPermutTweak :: (MonadTweak m) => Int -> m ()
+singleOutPermutTweak ::
+  (Members '[Tweak, NonDet] effs) =>
+  Int ->
+  Sem effs ()
 singleOutPermutTweak seed = do
   outputs <- viewTweak txSkelOutsL
   let outputs' = shuffle' outputs (length outputs) (mkStdGen seed)
diff --git a/src/Cooked/Tweak/Outputs.hs b/src/Cooked/Tweak/Outputs.hs
index 198a384b9..207abdd97 100644
--- a/src/Cooked/Tweak/Outputs.hs
+++ b/src/Cooked/Tweak/Outputs.hs
@@ -19,10 +19,15 @@ import Data.List (partition)
 import Data.Maybe
 import Optics.Core
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.NonDet
 
 -- | Ensures that a certain output is produced by a transaction. The return
 -- value will be @Just@ the added output, when applicable.
-ensureOutputTweak :: (MonadTweak m) => TxSkelOut -> m (Maybe TxSkelOut)
+ensureOutputTweak ::
+  (Member Tweak effs) =>
+  TxSkelOut ->
+  Sem effs (Maybe TxSkelOut)
 ensureOutputTweak txSkelOut = do
   presentOutputs <- viewTweak txSkelOutsL
   if txSkelOut `elem` presentOutputs
@@ -33,12 +38,18 @@ ensureOutputTweak txSkelOut = do
 
 -- | Adds a transaction output, at the end of the current list of outputs, thus
 -- retaining the initial outputs order.
-addOutputTweak :: (MonadTweak m) => TxSkelOut -> m ()
+addOutputTweak ::
+  (Member Tweak effs) =>
+  TxSkelOut ->
+  Sem effs ()
 addOutputTweak txSkelOut = overTweak txSkelOutsL (++ [txSkelOut])
 
 -- | Removes transaction outputs according to some predicate. The returned list
 -- contains all the removed outputs.
-removeOutputTweak :: (MonadTweak m) => (TxSkelOut -> Bool) -> m [TxSkelOut]
+removeOutputTweak ::
+  (Member Tweak effs) =>
+  (TxSkelOut -> Bool) ->
+  Sem effs [TxSkelOut]
 removeOutputTweak removePred = do
   presentOutputs <- viewTweak txSkelOutsL
   let (removed, kept) = partition removePred presentOutputs
@@ -58,7 +69,13 @@ instance PrettyCooked TamperDatumLbl where
 --
 -- The tweak returns a list of the modified datums, as they were *before* the
 -- modification was applied to them.
-tamperDatumTweak :: forall a m. (MonadTweak m, DatumConstrs a) => (a -> Maybe a) -> m [a]
+tamperDatumTweak ::
+  forall a effs.
+  ( Members '[Tweak, NonDet] effs,
+    DatumConstrs a
+  ) =>
+  (a -> Maybe a) ->
+  Sem effs [a]
 tamperDatumTweak change = do
   beforeModification <- overMaybeTweak (txSkelOutsL % traversed % txSkelOutDatumL % txSkelOutDatumTypedAT) change
   guard . not . null $ beforeModification
@@ -83,7 +100,13 @@ tamperDatumTweak change = do
 -- > == (k_1 + 1) * ... * (k_n + 1) - 1
 --
 -- modified transactions.
-malformDatumTweak :: forall a m. (MonadTweak m, DatumConstrs a) => (a -> [Api.BuiltinData]) -> m ()
+malformDatumTweak ::
+  forall a effs.
+  ( Members '[Tweak, NonDet] effs,
+    DatumConstrs a
+  ) =>
+  (a -> [Api.BuiltinData]) ->
+  Sem effs ()
 malformDatumTweak change = do
   outputs <- viewAllTweak (txSkelOutsL % traversed)
   let modifiedOutputs = map (\output -> output : changeOutput output) outputs
diff --git a/src/Cooked/Tweak/Signatories.hs b/src/Cooked/Tweak/Signatories.hs
index bb15b54aa..8c71e3c4b 100644
--- a/src/Cooked/Tweak/Signatories.hs
+++ b/src/Cooked/Tweak/Signatories.hs
@@ -17,63 +17,98 @@ module Cooked.Tweak.Signatories
   )
 where
 
-import Cooked.Skeleton (TxSkelSignatory, txSkelSignatoriesL)
-import Cooked.Tweak.Common (MonadTweak, setTweak, viewTweak)
+import Cooked.Skeleton
+import Cooked.Tweak.Common
 import Data.List (delete, (\\))
+import Polysemy
 
 -- | Returns the current list of signatories
-getSignatoriesTweak :: (MonadTweak m) => m [TxSkelSignatory]
+getSignatoriesTweak ::
+  (Member Tweak effs) =>
+  Sem effs [TxSkelSignatory]
 getSignatoriesTweak = viewTweak txSkelSignatoriesL
 
 -- | Apply a function to the list of signatories and return the old ones
-modifySignatoriesTweak :: (MonadTweak m) => ([TxSkelSignatory] -> [TxSkelSignatory]) -> m [TxSkelSignatory]
+modifySignatoriesTweak ::
+  (Member Tweak effs) =>
+  ([TxSkelSignatory] -> [TxSkelSignatory]) ->
+  Sem effs [TxSkelSignatory]
 modifySignatoriesTweak f = do
   oldSignatories <- getSignatoriesTweak
   setTweak txSkelSignatoriesL (f oldSignatories)
   return oldSignatories
 
 -- | Change the current signatories and return the old ones
-setSignatoriesTweak :: (MonadTweak m) => [TxSkelSignatory] -> m [TxSkelSignatory]
+setSignatoriesTweak ::
+  (Member Tweak effs) =>
+  [TxSkelSignatory] ->
+  Sem effs [TxSkelSignatory]
 setSignatoriesTweak = modifySignatoriesTweak . const
 
 -- | Check if the signatories satisfy a certain predicate
-signatoriesSatisfyTweak :: (MonadTweak m) => ([TxSkelSignatory] -> Bool) -> m Bool
+signatoriesSatisfyTweak ::
+  (Member Tweak effs) =>
+  ([TxSkelSignatory] -> Bool) ->
+  Sem effs Bool
 signatoriesSatisfyTweak = (<$> getSignatoriesTweak)
 
 -- | Check if a signatory signs a transaction
-isSignatoryTweak :: (MonadTweak m) => TxSkelSignatory -> m Bool
+isSignatoryTweak ::
+  (Member Tweak effs) =>
+  TxSkelSignatory ->
+  Sem effs Bool
 isSignatoryTweak = signatoriesSatisfyTweak . elem
 
 -- | Check if the transaction has at least a signatory
-hasSignatoriesTweak :: (MonadTweak m) => m Bool
+hasSignatoriesTweak ::
+  (Member Tweak effs) =>
+  Sem effs Bool
 hasSignatoriesTweak = signatoriesSatisfyTweak (not . null)
 
 -- | Add a signatory to the transaction, at the head of the list of signatories, and
 -- return the old list of signatories
-addFirstSignatoryTweak :: (MonadTweak m) => TxSkelSignatory -> m [TxSkelSignatory]
+addFirstSignatoryTweak ::
+  (Member Tweak effs) =>
+  TxSkelSignatory ->
+  Sem effs [TxSkelSignatory]
 addFirstSignatoryTweak = modifySignatoriesTweak . (:)
 
 -- | Add signatories at the end of the list of signatories, and return the old list of
 -- signatories
-addSignatoriesTweak :: (MonadTweak m) => [TxSkelSignatory] -> m [TxSkelSignatory]
+addSignatoriesTweak ::
+  (Member Tweak effs) =>
+  [TxSkelSignatory] ->
+  Sem effs [TxSkelSignatory]
 addSignatoriesTweak = modifySignatoriesTweak . (<>)
 
 -- | Add a signatory to the transaction, at the end of the list of signatories, and
 -- return the old list of signatories
-addLastSignatoryTweak :: (MonadTweak m) => TxSkelSignatory -> m [TxSkelSignatory]
+addLastSignatoryTweak ::
+  (Member Tweak effs) =>
+  TxSkelSignatory ->
+  Sem effs [TxSkelSignatory]
 addLastSignatoryTweak = addSignatoriesTweak . (: [])
 
 -- | Remove signatories from the transaction and return the old list of signatories
-removeSignatoriesTweak :: (MonadTweak m) => [TxSkelSignatory] -> m [TxSkelSignatory]
+removeSignatoriesTweak ::
+  (Member Tweak effs) =>
+  [TxSkelSignatory] ->
+  Sem effs [TxSkelSignatory]
 removeSignatoriesTweak = modifySignatoriesTweak . (\\)
 
 -- | Remove a signatory from the transaction and return the old list of signatories
-removeSignatoryTweak :: (MonadTweak m) => TxSkelSignatory -> m [TxSkelSignatory]
+removeSignatoryTweak ::
+  (Member Tweak effs) =>
+  TxSkelSignatory ->
+  Sem effs [TxSkelSignatory]
 removeSignatoryTweak = modifySignatoriesTweak . delete
 
 -- | Changes the first signatory (adds it if there are no signatories) and return the
 -- old list of signatories.
-replaceFirstSignatoryTweak :: (MonadTweak m) => TxSkelSignatory -> m [TxSkelSignatory]
+replaceFirstSignatoryTweak ::
+  (Member Tweak effs) =>
+  TxSkelSignatory ->
+  Sem effs [TxSkelSignatory]
 replaceFirstSignatoryTweak =
   modifySignatoriesTweak
     . ( \newSignatory -> \case
diff --git a/src/Cooked/Tweak/ValidityRange.hs b/src/Cooked/Tweak/ValidityRange.hs
index efc8fe268..b735b41a8 100644
--- a/src/Cooked/Tweak/ValidityRange.hs
+++ b/src/Cooked/Tweak/ValidityRange.hs
@@ -1,64 +1,122 @@
 -- | This module defines 'Tweak's revolving around the validity range of a
 -- transaction
-module Cooked.Tweak.ValidityRange where
+module Cooked.Tweak.ValidityRange
+  ( getValidityRangeTweak,
+    setValidityRangeTweak,
+    setAlwaysValidRangeTweak,
+    setValidityStartTweak,
+    setValidityEndTweak,
+    validityRangeSatisfiesTweak,
+    isValidAtTweak,
+    isValidNowTweak,
+    isValidDuringTweak,
+    hasEmptyTimeRangeTweak,
+    hasFullTimeRangeTweak,
+    intersectValidityRangeTweak,
+    centerAroundValidityRangeTweak,
+    makeValidityRangeSingletonTweak,
+    makeValidityRangeNowTweak,
+  )
+where
 
 import Control.Monad
-import Cooked.MockChain
+import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Ledger.Slot qualified as Ledger
 import PlutusLedgerApi.V1.Interval qualified as Api
+import Polysemy
+import Polysemy.NonDet
 
 -- | Looks up the current validity range of the transaction
-getValidityRangeTweak :: (MonadTweak m) => m Ledger.SlotRange
+getValidityRangeTweak ::
+  (Member Tweak effs) =>
+  Sem effs Ledger.SlotRange
 getValidityRangeTweak = viewTweak txSkelValidityRangeL
 
 -- | Changes the current validity range, returning the old one
-setValidityRangeTweak :: (MonadTweak m) => Ledger.SlotRange -> m Ledger.SlotRange
+setValidityRangeTweak ::
+  (Member Tweak effs) =>
+  Ledger.SlotRange ->
+  Sem effs Ledger.SlotRange
 setValidityRangeTweak newRange = do
   oldRange <- getValidityRangeTweak
   setTweak txSkelValidityRangeL newRange
   return oldRange
 
 -- | Ensures the skeleton makes for an unconstrained validity range
-setAlwaysValidRangeTweak :: (MonadTweak m) => m Ledger.SlotRange
+setAlwaysValidRangeTweak ::
+  (Member Tweak effs) =>
+  Sem effs Ledger.SlotRange
 setAlwaysValidRangeTweak = setValidityRangeTweak Api.always
 
 -- | Sets the left bound of the validity range. Leaves the right bound unchanged
-setValidityStartTweak :: (MonadTweak m) => Ledger.Slot -> m Ledger.SlotRange
-setValidityStartTweak left = getValidityRangeTweak >>= setValidityRangeTweak . Api.Interval (Api.LowerBound (Api.Finite left) True) . Api.ivTo
+setValidityStartTweak ::
+  (Member Tweak effs) =>
+  Ledger.Slot ->
+  Sem effs Ledger.SlotRange
+setValidityStartTweak left =
+  getValidityRangeTweak
+    >>= setValidityRangeTweak
+      . Api.Interval (Api.LowerBound (Api.Finite left) True)
+      . Api.ivTo
 
 -- | Sets the right bound of the validity range. Leaves the left bound unchanged
-setValidityEndTweak :: (MonadTweak m) => Ledger.Slot -> m Ledger.SlotRange
-setValidityEndTweak right = getValidityRangeTweak >>= setValidityRangeTweak . flip Api.Interval (Api.UpperBound (Api.Finite right) True) . Api.ivFrom
+setValidityEndTweak ::
+  (Member Tweak effs) =>
+  Ledger.Slot ->
+  Sem effs Ledger.SlotRange
+setValidityEndTweak right =
+  getValidityRangeTweak
+    >>= setValidityRangeTweak
+      . flip Api.Interval (Api.UpperBound (Api.Finite right) True)
+      . Api.ivFrom
 
 -- | Checks if the validity range satisfies a certain predicate
-validityRangeSatisfiesTweak :: (MonadTweak m) => (Ledger.SlotRange -> Bool) -> m Bool
+validityRangeSatisfiesTweak ::
+  (Member Tweak effs) =>
+  (Ledger.SlotRange -> Bool) ->
+  Sem effs Bool
 validityRangeSatisfiesTweak = (<$> getValidityRangeTweak)
 
 -- | Checks if a given time belongs to the validity range of a transaction
-isValidAtTweak :: (MonadTweak m) => Ledger.Slot -> m Bool
+isValidAtTweak ::
+  (Member Tweak effs) =>
+  Ledger.Slot ->
+  Sem effs Bool
 isValidAtTweak = validityRangeSatisfiesTweak . Api.member
 
 -- | Checks if the current validity range includes the current time
-isValidNowTweak :: (MonadTweak m) => m Bool
+isValidNowTweak ::
+  (Members '[Tweak, MockChainRead] effs) =>
+  Sem effs Bool
 isValidNowTweak = currentSlot >>= isValidAtTweak
 
 -- | Checks if a given range is included in the validity range of a transaction
-isValidDuringTweak :: (MonadTweak m) => Ledger.SlotRange -> m Bool
+isValidDuringTweak ::
+  (Member Tweak effs) =>
+  Ledger.SlotRange ->
+  Sem effs Bool
 isValidDuringTweak = validityRangeSatisfiesTweak . flip Api.contains
 
 -- | Checks if the validity range is empty
-hasEmptyTimeRangeTweak :: (MonadTweak m) => m Bool
+hasEmptyTimeRangeTweak ::
+  (Member Tweak effs) =>
+  Sem effs Bool
 hasEmptyTimeRangeTweak = validityRangeSatisfiesTweak Api.isEmpty
 
 -- | Checks if the validity range is unconstrained
-hasFullTimeRangeTweak :: (MonadTweak m) => m Bool
+hasFullTimeRangeTweak ::
+  (Member Tweak effs) =>
+  Sem effs Bool
 hasFullTimeRangeTweak = validityRangeSatisfiesTweak (Api.always ==)
 
 -- | Adds a constraint to the current validity range. Returns the old range, and
 -- fails is the resulting interval is empty
-intersectValidityRangeTweak :: (MonadTweak m) => Ledger.SlotRange -> m Ledger.SlotRange
+intersectValidityRangeTweak ::
+  (Members '[Tweak, NonDet] effs) =>
+  Ledger.SlotRange ->
+  Sem effs Ledger.SlotRange
 intersectValidityRangeTweak newRange = do
   oldRange <- viewTweak txSkelValidityRangeL
   let combinedRange = Api.intersection newRange oldRange
@@ -67,37 +125,23 @@ intersectValidityRangeTweak newRange = do
   return oldRange
 
 -- | Centers the validity range around a value with a certain radius
-centerAroundValidityRangeTweak :: (MonadTweak m) => Ledger.Slot -> Integer -> m Ledger.SlotRange
-centerAroundValidityRangeTweak t r = do
-  let radius = Ledger.Slot r
-      left = t - radius
-      right = t + radius
-      newRange = Api.interval left right
-  setValidityRangeTweak newRange
+centerAroundValidityRangeTweak ::
+  (Member Tweak effs) =>
+  Ledger.Slot ->
+  Integer ->
+  Sem effs Ledger.SlotRange
+centerAroundValidityRangeTweak t (Ledger.Slot -> radius) = do
+  setValidityRangeTweak $ Api.interval (t - radius) (t + radius)
 
 -- | Makes a transaction range equal to a singleton
-makeValidityRangeSingletonTweak :: (MonadTweak m) => Ledger.Slot -> m Ledger.SlotRange
+makeValidityRangeSingletonTweak ::
+  (Member Tweak effs) =>
+  Ledger.Slot ->
+  Sem effs Ledger.SlotRange
 makeValidityRangeSingletonTweak = setValidityRangeTweak . Api.singleton
 
 -- | Makes the transaction validity range comply with the current time
-makeValidityRangeNowTweak :: (MonadTweak m) => m Ledger.SlotRange
+makeValidityRangeNowTweak ::
+  (Members '[Tweak, MockChainRead] effs) =>
+  Sem effs Ledger.SlotRange
 makeValidityRangeNowTweak = currentSlot >>= makeValidityRangeSingletonTweak
-
--- | Makes current time comply with the validity range of the transaction under
--- modification. Returns the new current time after the modification; fails if
--- current time is already after the validity range.
-waitUntilValidTweak :: (MonadTweak m) => m Ledger.Slot
-waitUntilValidTweak = do
-  now <- currentSlot
-  vRange <- getValidityRangeTweak
-  if Api.member now vRange
-    then return now
-    else do
-      guard $ Api.before now vRange
-      guard $ not $ Api.isEmpty vRange
-      later <- case Api.ivFrom vRange of
-        Api.LowerBound (Api.Finite left) isClosed ->
-          return $ left + fromIntegral (fromEnum $ not isClosed)
-        _ -> fail "Unexpected left-finite interval without left border: please report a bug at https://github.com/tweag/cooked-validators/issues"
-      void $ awaitSlot later
-      return later

From cf08230e43f594eec90932f9dcd3caf91543fe9f Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Thu, 22 Jan 2026 22:27:57 +0100
Subject: [PATCH 34/96] more files transformed

---
 src/Cooked/MockChain/AutoFilling.hs     | 234 +++++++++++++-----------
 src/Cooked/MockChain/Balancing.hs       | 104 ++++++++---
 src/Cooked/MockChain/GenerateTx/Body.hs |   4 +-
 src/Cooked/MockChain/Misc.hs            |  12 +-
 4 files changed, 219 insertions(+), 135 deletions(-)

diff --git a/src/Cooked/MockChain/AutoFilling.hs b/src/Cooked/MockChain/AutoFilling.hs
index ebc3c0f60..1588714c7 100644
--- a/src/Cooked/MockChain/AutoFilling.hs
+++ b/src/Cooked/MockChain/AutoFilling.hs
@@ -7,16 +7,20 @@ import Cardano.Ledger.Shelley.Core qualified as Shelley
 import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
 import Control.Monad
 import Cooked.MockChain.GenerateTx.Output
-import Cooked.MockChain.UtxoSearch
+import Cooked.MockChain.Log
+import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Data.List (find)
 import Data.Map qualified as Map
 import Data.Maybe
+import Ledger.Tx qualified as Ledger
 import Optics.Core
 import Plutus.Script.Utils.Address qualified as Script
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
 
 -- * Auto filling withdrawal amounts
 
@@ -24,8 +28,10 @@ import PlutusLedgerApi.V3 qualified as Api
 -- out the withdrawn amount based on the associated user rewards. Does not
 -- tamper with an existing specified amount in such withdrawals. Logs an event
 -- when an amount has been successfully auto-filled.
-autoFillWithdrawalAmounts :: (Members '[MockChainRead, Tweak, MockChainLog] effs) => Sem effs ()
-autoFillWithdrawalAmounts txSkel = do
+autoFillWithdrawalAmounts ::
+  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
+  Sem effs ()
+autoFillWithdrawalAmounts = do
   withdrawals <- viewTweak (txSkelWithdrawalsL % txSkelWithdrawalsListI)
   newWithdrawals <- forM withdrawals $ \withdrawal -> do
     currentReward <- getCurrentReward $ view withdrawalUserL withdrawal
@@ -38,7 +44,7 @@ autoFillWithdrawalAmounts txSkel = do
           (view (withdrawalUserL % to Script.toCredential) newWithdrawal)
           (fromJust (preview withdrawalAmountAT newWithdrawal))
     return newWithdrawal
-  overTweak (txSkelWithdrawalsL % txSkelWithdrawalsListI) newWithdrawals
+  setTweak (txSkelWithdrawalsL % txSkelWithdrawalsListI) newWithdrawals
 
 -- * Auto filling constitution script
 
@@ -46,8 +52,10 @@ autoFillWithdrawalAmounts txSkel = do
 -- out the constitution scripts with the current one. Does not tamper with an
 -- existing specified script in such withdrawals. Logs an event when the
 -- constitution script has been successfully auto-filled.
-autoFillConstitution :: (Members '[MockChainRead, Tweak, MockChainLog] effs) => Sem effs ()
-autoFillConstitution txSkel = do
+autoFillConstitution ::
+  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
+  Sem effs ()
+autoFillConstitution = do
   currentConstitution <- getConstitutionScript
   case currentConstitution of
     Nothing -> return ()
@@ -59,107 +67,129 @@ autoFillConstitution txSkel = do
             MCLogAutoFilledConstitution $
               Script.toScriptHash constitutionScript
         return (fillConstitution constitutionScript prop)
-      overTweak txSkelProposalsL newProposals
+      setTweak txSkelProposalsL newProposals
 
 -- -- * Auto filling reference scripts
 
--- -- | Attempts to find in the index a utxo containing a reference script with the
--- -- given script hash, and attaches it to a redeemer when it does not yet have a
--- -- reference input and when it is allowed, in which case an event is logged.
--- updateRedeemedScript :: (MonadBlockChain m) => [Api.TxOutRef] -> User IsScript Redemption -> m (User IsScript Redemption)
--- updateRedeemedScript inputs rs@(UserRedeemedScript (toVScript -> vScript) txSkelRed@(TxSkelRedeemer {txSkelRedeemerAutoFill = True})) = do
---   oRefsInInputs <- runUtxoSearch (referenceScriptOutputsSearch vScript)
---   maybe
---     -- We leave the redeemer unchanged if no reference input was found
---     (return rs)
---     -- If a reference input is found, we assign it and log the event
---     ( \oRef -> do
---         logEvent $ MCLogAddedReferenceScript txSkelRed oRef (Script.toScriptHash vScript)
---         return $ over userTxSkelRedeemerAT (fillReferenceInput oRef) rs
---     )
---     $ case oRefsInInputs of
---       [] -> Nothing
---       -- If possible, we use a reference input appearing in regular inputs
---       l | Just (oRefM', _) <- find (\(r, _) -> r `elem` inputs) l -> Just oRefM'
---       -- If none exist, we use the first one we find elsewhere
---       ((oRefM', _) : _) -> Just oRefM'
--- updateRedeemedScript _ rs = return rs
+-- | Attempts to find in the index a utxo containing a reference script with the
+-- given script hash, and attaches it to a redeemer when it does not yet have a
+-- reference input and when it is allowed, in which case an event is logged.
+updateRedeemedScript ::
+  (Member MockChainLog effs) =>
+  [Api.TxOutRef] ->
+  User IsScript Redemption ->
+  Sem effs (User IsScript Redemption)
+updateRedeemedScript
+  inputs
+  rs@( UserRedeemedScript
+         (toVScript -> vScript)
+         txSkelRed@(TxSkelRedeemer {txSkelRedeemerAutoFill = True})
+       ) = do
+    oRefsInInputs <- undefined -- runUtxoSearch (referenceScriptOutputsSearch vScript)
+    maybe
+      -- We leave the redeemer unchanged if no reference input was found
+      (return rs)
+      -- If a reference input is found, we assign it and log the event
+      ( \oRef -> do
+          logEvent $ MCLogAddedReferenceScript txSkelRed oRef (Script.toScriptHash vScript)
+          return $ over userTxSkelRedeemerAT (fillReferenceInput oRef) rs
+      )
+      $ case oRefsInInputs of
+        [] -> Nothing
+        -- If possible, we use a reference input appearing in regular inputs
+        l | Just (oRefM', _) <- find (\(r, _) -> r `elem` inputs) l -> Just oRefM'
+        -- If none exist, we use the first one we find elsewhere
+        ((oRefM', _) : _) -> Just oRefM'
+updateRedeemedScript _ rs = return rs
 
--- -- | Goes through the various parts of the skeleton where a redeemer can appear,
--- -- and attempts to attach a reference input to each of them, whenever it is
--- -- allowed and one has not already been set. Logs an event whenever such an
--- -- addition occurs.
--- autoFillReferenceScripts :: forall m. (MonadBlockChain m) => TxSkel -> m TxSkel
--- autoFillReferenceScripts txSkel = do
---   let inputs = view (txSkelInsL % to Map.keys) txSkel
---   newMints <- forM (view (txSkelMintsL % txSkelMintsListI) txSkel) $ \(Mint rs tks) ->
---     (`Mint` tks) <$> updateRedeemedScript inputs rs
---   newInputs <- forM (view (txSkelInsL % to Map.toList) txSkel) $ \(oRef, red) ->
---     (oRef,) <$> do
---       validatorM <- previewByRef (txSkelOutOwnerL % userVScriptAT) oRef
---       case validatorM of
---         Nothing -> return red
---         Just val -> view userTxSkelRedeemerL <$> updateRedeemedScript inputs (UserRedeemedScript val red)
---   newProposals <- forM (view txSkelProposalsL txSkel) $ \prop ->
---     case preview (txSkelProposalMConstitutionAT % _Just) prop of
---       Nothing -> return prop
---       Just rs -> flip (set (txSkelProposalMConstitutionAT % _Just)) prop <$> updateRedeemedScript inputs rs
---   newWithdrawals <- forM (view (txSkelWithdrawalsL % txSkelWithdrawalsListI) txSkel) $
---     \withdrawal@(Withdrawal user lv) -> case preview userEitherScriptP user of
---       Nothing -> return withdrawal
---       Just urs -> (`Withdrawal` lv) . review userEitherScriptP <$> updateRedeemedScript inputs urs
---   return $
---     txSkel
---       & txSkelMintsL
---       % txSkelMintsListI
---       .~ newMints
---       & txSkelInsL
---       .~ Map.fromList newInputs
---       & txSkelProposalsL
---       .~ newProposals
---       & txSkelWithdrawalsL
---       % txSkelWithdrawalsListI
---       .~ newWithdrawals
+-- | Goes through the various parts of the skeleton where a redeemer can appear,
+-- and attempts to attach a reference input to each of them, whenever it is
+-- allowed and one has not already been set. Logs an event whenever such an
+-- addition occurs.
+autoFillReferenceScripts ::
+  (Members '[Tweak, MockChainRead, MockChainLog] effs) =>
+  Sem effs ()
+autoFillReferenceScripts = do
+  inputsKeys <- viewTweak $ txSkelInsL % to Map.keys
+  -- Updating minting redeemers
+  mints <- viewTweak $ txSkelMintsL % txSkelMintsListI
+  newMints <- forM mints $ \(Mint rs tks) -> (`Mint` tks) <$> updateRedeemedScript inputsKeys rs
+  setTweak (txSkelMintsL % txSkelMintsListI) newMints
+  -- Updating spending redeemers
+  inputsList <- viewTweak $ txSkelInsL % to Map.toList
+  newInputs <- forM inputsList $ \(oRef, red) ->
+    (oRef,) <$> do
+      validatorM <- previewByRef (txSkelOutOwnerL % userVScriptAT) oRef
+      case validatorM of
+        Nothing -> return red
+        Just val -> view userTxSkelRedeemerL <$> updateRedeemedScript inputsKeys (UserRedeemedScript val red)
+  setTweak txSkelInsL $ Map.fromList newInputs
+  -- Updating proposing redeemers
+  proposals <- viewTweak txSkelProposalsL
+  newProposals <- forM proposals $ \prop ->
+    case preview (txSkelProposalMConstitutionAT % _Just) prop of
+      Nothing -> return prop
+      Just rs -> flip (set (txSkelProposalMConstitutionAT % _Just)) prop <$> updateRedeemedScript inputsKeys rs
+  setTweak txSkelProposalsL newProposals
+  -- Updating widrawing redeemers
+  withdrawals <- viewTweak $ txSkelWithdrawalsL % txSkelWithdrawalsListI
+  newWithdrawals <- forM withdrawals $
+    \withdrawal@(Withdrawal user lv) -> case preview userEitherScriptP user of
+      Nothing -> return withdrawal
+      Just urs -> (`Withdrawal` lv) . review userEitherScriptP <$> updateRedeemedScript inputsKeys urs
+  setTweak (txSkelWithdrawalsL % txSkelWithdrawalsListI) newWithdrawals
 
--- -- * Auto filling min ada amounts
+-- * Auto filling min ada amounts
 
--- -- | Compute the required minimal ADA for a given output
--- getTxSkelOutMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m Integer
--- getTxSkelOutMinAda txSkelOut = do
---   params <- Emulator.pEmulatorPParams <$> getParams
---   Cardano.unCoin
---     . Shelley.getMinCoinTxOut params
---     . Cardano.toShelleyTxOut Cardano.ShelleyBasedEraConway
---     . Cardano.toCtxUTxOTxOut
---     <$> toCardanoTxOut txSkelOut
+-- | Compute the required minimal ADA for a given output
+getTxSkelOutMinAda ::
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
+  TxSkelOut ->
+  Sem effs Integer
+getTxSkelOutMinAda txSkelOut = do
+  params <- Emulator.pEmulatorPParams <$> getParams
+  Cardano.unCoin
+    . Shelley.getMinCoinTxOut params
+    . Cardano.toShelleyTxOut Cardano.ShelleyBasedEraConway
+    . Cardano.toCtxUTxOTxOut
+    <$> toCardanoTxOut txSkelOut
 
--- -- | This transforms an output into another output which contains the minimal
--- -- required ada. If the previous quantity of ADA was sufficient, it remains
--- -- unchanged. This can require a few iterations to converge, as the added ADA
--- -- will increase the size of the UTXO which in turn might need more ADA.
--- toTxSkelOutWithMinAda :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
--- -- The auto adjustment is disabled so nothing is done here
--- toTxSkelOutWithMinAda txSkelOut@((^. txSkelOutValueAutoAdjustL) -> False) = return txSkelOut
--- -- The auto adjustment is enabled
--- toTxSkelOutWithMinAda txSkelOut = do
---   txSkelOut' <- go txSkelOut
---   let originalAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut
---       updatedAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut'
---   when (originalAda /= updatedAda) $ logEvent $ MCLogAdjustedTxSkelOut txSkelOut updatedAda
---   return txSkelOut'
---   where
---     go :: (MonadBlockChainBalancing m) => TxSkelOut -> m TxSkelOut
---     go skelOut = do
---       -- Computing the required minimal amount of ADA in this output
---       requiredAda <- getTxSkelOutMinAda skelOut
---       -- If this amount is sufficient, we return Nothing, otherwise, we adjust the
---       -- output and possibly iterate
---       if Api.getLovelace (skelOut ^. txSkelOutValueL % valueLovelaceL) >= requiredAda
---         then return skelOut
---         else go $ skelOut & txSkelOutValueL % valueLovelaceL .~ Api.Lovelace requiredAda
+-- | This transforms an output into another output which contains the minimal
+-- required ada. If the previous quantity of ADA was sufficient, it remains
+-- unchanged. This can require a few iterations to converge, as the added ADA
+-- will increase the size of the UTXO which in turn might need more ADA.
+toTxSkelOutWithMinAda ::
+  forall effs.
+  (Members '[MockChainRead, MockChainLog, Error Ledger.ToCardanoError] effs) =>
+  TxSkelOut ->
+  Sem effs TxSkelOut
+-- The auto adjustment is disabled so nothing is done here
+toTxSkelOutWithMinAda txSkelOut@((^. txSkelOutValueAutoAdjustL) -> False) = return txSkelOut
+-- The auto adjustment is enabled
+toTxSkelOutWithMinAda txSkelOut = do
+  txSkelOut' <- go txSkelOut
+  let originalAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut
+      updatedAda = view (txSkelOutValueL % valueLovelaceL) txSkelOut'
+  when (originalAda /= updatedAda) $ logEvent $ MCLogAdjustedTxSkelOut txSkelOut updatedAda
+  return txSkelOut'
+  where
+    go :: TxSkelOut -> Sem effs TxSkelOut
+    go skelOut = do
+      -- Computing the required minimal amount of ADA in this output
+      requiredAda <- getTxSkelOutMinAda skelOut
+      -- If this amount is sufficient, we return Nothing, otherwise, we adjust the
+      -- output and possibly iterate
+      if Api.getLovelace (skelOut ^. txSkelOutValueL % valueLovelaceL) >= requiredAda
+        then return skelOut
+        else go $ skelOut & txSkelOutValueL % valueLovelaceL .~ Api.Lovelace requiredAda
 
--- -- | This goes through all the `TxSkelOut`s of the given skeleton and updates
--- -- their ada value when requested by the user and required by the protocol
--- -- parameters. Logs an event whenever such a change occurs.
--- autoFillMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
--- autoFillMinAda skel = (\x -> skel & txSkelOutsL .~ x) <$> forM (skel ^. txSkelOutsL) toTxSkelOutWithMinAda
+-- | This goes through all the `TxSkelOut`s of the given skeleton and updates
+-- their ada value when requested by the user and required by the protocol
+-- parameters. Logs an event whenever such a change occurs.
+autoFillMinAda ::
+  (Members '[Tweak, MockChainRead, MockChainLog, Error Ledger.ToCardanoError] effs) =>
+  Sem effs ()
+autoFillMinAda = do
+  outputs <- viewTweak txSkelOutsL
+  newOutputs <- forM outputs toTxSkelOutWithMinAda
+  setTweak txSkelOutsL newOutputs
diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 726088ddb..9eb4b7bb8 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -15,11 +15,12 @@ import Cardano.Ledger.Conway.PParams qualified as Conway
 import Cardano.Ledger.Plutus.ExUnits qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
 import Control.Monad
-import Control.Monad.Except
 import Cooked.MockChain.AutoFilling
-import Cooked.MockChain.BlockChain
+import Cooked.MockChain.Common
+import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Body
-import Cooked.MockChain.UtxoSearch
+import Cooked.MockChain.Log
+import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Data.Bifunctor
 import Data.Function
@@ -27,6 +28,7 @@ import Data.List (find, partition, sortBy)
 import Data.Map qualified as Map
 import Data.Ratio qualified as Rat
 import Data.Set qualified as Set
+import Ledger.Tx qualified as Ledger
 import Lens.Micro.Extras qualified as MicroLens
 import Optics.Core
 import Optics.Core.Extras
@@ -35,6 +37,9 @@ import Plutus.Script.Utils.Value qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
 import PlutusLedgerApi.V3 qualified as Api
 import PlutusTx.Prelude qualified as PlutusTx
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
 
 -- | This is the main entry point of our balancing mechanism. This function
 -- takes a skeleton and returns a (possibly) balanced skeleton alongside the
@@ -42,14 +47,17 @@ import PlutusTx.Prelude qualified as PlutusTx
 -- be empty when no script is involved in the transaction. The options from the
 -- skeleton control whether it should be balanced, and how to compute its
 -- associated elements.
-balanceTxSkel :: (MonadBlockChainBalancing m) => TxSkel -> m (TxSkel, Fee, Collaterals)
+balanceTxSkel ::
+  (Members '[MockChainRead, MockChainLog, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
+  TxSkel ->
+  Sem effs (TxSkel, Fee, Collaterals)
 balanceTxSkel skelUnbal@TxSkel {..} = do
   -- We retrieve the possible balancing user. Any extra payment will be
   -- redirected to them, and utxos will be taken from their user if associated
   -- with the BalancingUtxosFromBalancingUser policy
   balancingUser <- case txSkelOptBalancingPolicy txSkelOpts of
     BalanceWithFirstSignatory -> case txSkelSignatories of
-      [] -> throwError $ MCEMissingBalancingUser "The list of signatories is empty, but the balancing user is supposed to be the first signatory."
+      [] -> throw $ MCEMissingBalancingUser "The list of signatories is empty, but the balancing user is supposed to be the first signatory."
       bw : _ -> return $ Just $ UserPubKey $ view txSkelSignatoryPubKeyHashL bw
     BalanceWith bUser -> return $ Just $ UserPubKey bUser
     DoNotBalance -> return Nothing
@@ -74,10 +82,10 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
       (True, CollateralUtxosFromUser cUser) -> logEvent (MCLogUnusedCollaterals $ Left $ UserPubKey cUser) >> return Nothing
       (True, CollateralUtxosFromBalancingUser) -> return Nothing
       (False, CollateralUtxosFromSet utxos rUser) -> return $ Just (utxos, UserPubKey rUser)
-      (False, CollateralUtxosFromUser cUser) -> Just . (,UserPubKey cUser) . Set.fromList . map fst <$> runUtxoSearch (onlyValueOutputsAtSearch $ Script.toPubKeyHash cUser)
+      (False, CollateralUtxosFromUser cUser) -> Just . (,UserPubKey cUser) . Set.fromList . map fst <$> undefined -- runUtxoSearch (onlyValueOutputsAtSearch $ Script.toPubKeyHash cUser)
       (False, CollateralUtxosFromBalancingUser) -> case balancingUser of
-        Nothing -> throwError $ MCEMissingBalancingUser "Collateral utxos should be taken from the balancing user, but it does not exist."
-        Just bUser -> Just . (,bUser) . Set.fromList . map fst <$> runUtxoSearch (onlyValueOutputsAtSearch bUser)
+        Nothing -> throw $ MCEMissingBalancingUser "Collateral utxos should be taken from the balancing user, but it does not exist."
+        Just bUser -> Just . (,bUser) . Set.fromList . map fst <$> undefined -- runUtxoSearch (onlyValueOutputsAtSearch bUser)
 
   -- At this point, the presence (or absence) of balancing user dictates
   -- whether the transaction should be automatically balanced or not.
@@ -94,12 +102,12 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
       -- utxos based on the associated policy
       balancingUtxos <-
         case txSkelOptBalancingUtxos txSkelOpts of
-          BalancingUtxosFromBalancingUser -> runUtxoSearch $ onlyValueOutputsAtSearch bUser
+          BalancingUtxosFromBalancingUser -> undefined -- runUtxoSearch $ onlyValueOutputsAtSearch bUser
           BalancingUtxosFromSet utxos ->
             -- We resolve the given set of utxos
-            runUtxoSearch (txSkelOutByRefSearch (Set.toList utxos))
-              -- We filter out those belonging to scripts, while throwing a
-              -- warning if any was actually discarded.
+            undefined -- runUtxoSearch (txSkelOutByRefSearch (Set.toList utxos))
+            -- We filter out those belonging to scripts, while throwing a
+            -- warning if any was actually discarded.
               >>= filterAndWarn (is (txSkelOutOwnerL % userPubKeyHashAT) . snd) "They belong to scripts."
           -- We filter the candidate utxos by removing those already present in the
           -- skeleton, throwing a warning if any was actually discarded
@@ -125,7 +133,7 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
 
 -- | This computes the minimum and maximum possible fee a transaction can cost
 -- based on the current protocol parameters and its number of scripts.
-getMinAndMaxFee :: (MonadBlockChainBalancing m) => Fee -> m (Fee, Fee)
+getMinAndMaxFee :: (Member MockChainRead effs) => Fee -> Sem effs (Fee, Fee)
 getMinAndMaxFee nbOfScripts = do
   -- We retrieve the necessary parameters to compute the maximum possible fee
   -- for a transaction. There are quite a few of them.
@@ -154,10 +162,18 @@ getMinAndMaxFee nbOfScripts = do
 
 -- | Computes optimal fee for a given skeleton and balances it around those fees.
 -- This uses a dichotomic search for an optimal "balanceable around" fee.
-computeFeeAndBalance :: (MonadBlockChainBalancing m) => Peer -> Fee -> Fee -> Utxos -> Collaterals -> TxSkel -> m (TxSkel, Fee, Collaterals)
+computeFeeAndBalance ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
+  Peer ->
+  Fee ->
+  Fee ->
+  Utxos ->
+  Collaterals ->
+  TxSkel ->
+  Sem effs (TxSkel, Fee, Collaterals)
 computeFeeAndBalance _ minFee maxFee _ _ _
   | minFee > maxFee =
-      throwError $ FailWith "Unreachable case, please report a bug at https://github.com/tweag/cooked-validators/issues"
+      fail "Unreachable case, please report a bug at https://github.com/tweag/cooked-validators/issues"
 computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals skel
   | minFee == maxFee = do
       -- The fee interval is reduced to a single element, we balance around it
@@ -168,7 +184,7 @@ computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals ske
       -- The fee interval is larger than a single element. We attempt to balance
       -- around its central point, which can fail due to missing value in
       -- balancing utxos or collateral utxos.
-      attemptedBalancing <- catchError
+      attemptedBalancing <- catch
         (Just <$> attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel)
         $ \case
           -- If it fails, and the remaining fee interval is not reduced to the
@@ -177,7 +193,7 @@ computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals ske
           -- fails and we spread the error.
           MCEUnbalanceable {} | fee - minFee > 0 -> return Nothing
           MCENoSuitableCollateral {} | fee - minFee > 0 -> return Nothing
-          err -> throwError err
+          err -> throw err
 
       (newMinFee, newMaxFee) <- case attemptedBalancing of
         -- The skeleton was not balanceable, we try strictly smaller fee
@@ -208,7 +224,14 @@ computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals ske
 
 -- | Helper function to group the two real steps of the balancing: balance a
 -- skeleton around a given fee, and compute the associated collateral inputs
-attemptBalancingAndCollaterals :: (MonadBlockChainBalancing m) => Peer -> Utxos -> Fee -> Collaterals -> TxSkel -> m (Collaterals, TxSkel)
+attemptBalancingAndCollaterals ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  Peer ->
+  Utxos ->
+  Fee ->
+  Collaterals ->
+  TxSkel ->
+  Sem effs (Collaterals, TxSkel)
 attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel = do
   adjustedCollateralIns <- collateralsFromFees fee mCollaterals
   attemptedSkel <- computeBalancedTxSkel balancingUser balancingUtxos skel fee
@@ -218,7 +241,12 @@ attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals ske
 -- accounting for the ratio to respect between fees and total collaterals, the
 -- min ada requirements in the associated return collateral and the maximum
 -- number of collateral inputs authorized by protocol parameters.
-collateralInsFromFees :: (MonadBlockChainBalancing m) => Fee -> CollateralIns -> Peer -> m CollateralIns
+collateralInsFromFees ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  Fee ->
+  CollateralIns ->
+  Peer ->
+  Sem effs CollateralIns
 collateralInsFromFees fee collateralIns returnCollateralUser = do
   -- We retrieve the protocal parameters
   params <- Emulator.pEmulatorPParams <$> getParams
@@ -232,7 +260,7 @@ collateralInsFromFees fee collateralIns returnCollateralUser = do
   -- add one because of ledger requirement which seem to round up this value.
   let totalCollateral = Script.lovelace . (+ 1) . (`div` 100) . (* percentage) $ fee
   -- Collateral tx outputs sorted by decreasing ada amount
-  collateralTxOuts <- runUtxoSearch (txSkelOutByRefSearch $ Set.toList collateralIns)
+  collateralTxOuts <- undefined -- runUtxoSearch (txSkelOutByRefSearch $ Set.toList collateralIns)
   -- Candidate subsets of utxos to be used as collaterals
   let candidatesRaw = reachValue collateralTxOuts totalCollateral nbMax
   -- Preparing a possible collateral error
@@ -241,7 +269,11 @@ collateralInsFromFees fee collateralIns returnCollateralUser = do
   Set.fromList . fst <$> getOptimalCandidate candidatesRaw returnCollateralUser noSuitableCollateralError
 
 -- | This adjusts collateral inputs when necessary
-collateralsFromFees :: (MonadBlockChainBalancing m) => Fee -> Collaterals -> m Collaterals
+collateralsFromFees ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  Fee ->
+  Collaterals ->
+  Sem effs Collaterals
 collateralsFromFees _ Nothing = return Nothing
 collateralsFromFees fee (Just (collateralIns, returnCollateralUser)) =
   Just . (,returnCollateralUser) <$> collateralInsFromFees fee collateralIns returnCollateralUser
@@ -251,7 +283,11 @@ collateralsFromFees fee (Just (collateralIns, returnCollateralUser)) =
 -- stops when the target is reached, not adding superfluous UTxOs. Despite
 -- optimizations, this function is theoretically in 2^n where n is the number of
 -- candidate UTxOs. Use with caution.
-reachValue :: Utxos -> Api.Value -> Fee -> [(Utxos, Api.Value)]
+reachValue ::
+  Utxos ->
+  Api.Value ->
+  Fee ->
+  [(Utxos, Api.Value)]
 -- Target is smaller than the empty value (which means in only contains negative
 -- entries), we stop looking as adding more elements would be superfluous.
 reachValue _ target _ | target `Api.leq` mempty = [([], PlutusTx.negate target)]
@@ -276,7 +312,12 @@ reachValue (h@(_, view txSkelOutValueL -> hVal) : t) target maxEls =
 -- | A helper function to grab an optimal candidate in terms of having a minimal
 -- enough amount of ada to sustain itself meant to be used after calling
 -- `reachValue`. This throws an error when there are no suitable candidates.
-getOptimalCandidate :: (MonadBlockChainBalancing m) => [(Utxos, Api.Value)] -> Peer -> MockChainError -> m ([Api.TxOutRef], Api.Value)
+getOptimalCandidate ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  [(Utxos, Api.Value)] ->
+  Peer ->
+  MockChainError ->
+  Sem effs ([Api.TxOutRef], Api.Value)
 getOptimalCandidate candidates paymentTarget mceError = do
   -- We decorate the candidates with their current ada and min ada requirements
   candidatesDecorated <- forM candidates $ \(output, val) ->
@@ -285,12 +326,17 @@ getOptimalCandidate candidates paymentTarget mceError = do
   let candidatesFiltered = [(minLv, (fst <$> l, val)) | (l, val, Api.Lovelace lv, minLv) <- candidatesDecorated, minLv <= lv]
   case sortBy (compare `on` fst) candidatesFiltered of
     -- If the list of candidates is empty, we throw an error
-    [] -> throwError mceError
+    [] -> throw mceError
     (_, ret) : _ -> return ret
 
 -- | This function was originally inspired by
 -- https://github.com/input-output-hk/plutus-apps/blob/d4255f05477fd8477ee9673e850ebb9ebb8c9657/plutus-ledger/src/Ledger/Fee.hs#L19
-estimateTxSkelFee :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Collaterals -> m Fee
+estimateTxSkelFee ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
+  TxSkel ->
+  Fee ->
+  Collaterals ->
+  Sem effs Fee
 estimateTxSkelFee skel fee mCollaterals = do
   -- We retrieve the necessary data to generate the transaction body
   params <- getParams
@@ -307,7 +353,13 @@ estimateTxSkelFee skel fee mCollaterals = do
 -- | This creates a balanced skeleton from a given skeleton and fee. In other
 -- words, this ensures that the following equation holds: input value + minted
 -- value + withdrawn value = output value + burned value + fee + deposits
-computeBalancedTxSkel :: (MonadBlockChainBalancing m) => Peer -> Utxos -> TxSkel -> Fee -> m TxSkel
+computeBalancedTxSkel ::
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  Peer ->
+  Utxos ->
+  TxSkel ->
+  Fee ->
+  Sem effs TxSkel
 computeBalancedTxSkel balancingUser balancingUtxos txSkel@TxSkel {..} (Script.lovelace -> feeValue) = do
   -- We compute the necessary values from the skeleton that are part of the
   -- equation, except for the `feeValue` which we already have.
diff --git a/src/Cooked/MockChain/GenerateTx/Body.hs b/src/Cooked/MockChain/GenerateTx/Body.hs
index 02a7e19ca..7bed7d27a 100644
--- a/src/Cooked/MockChain/GenerateTx/Body.hs
+++ b/src/Cooked/MockChain/GenerateTx/Body.hs
@@ -90,9 +90,7 @@ txSkelToIndex ::
 txSkelToIndex txSkel mCollaterals = do
   -- We build the index of UTxOs which are known to this skeleton. This includes
   -- collateral inputs, inputs and reference inputs.
-  let collateralIns = case mCollaterals of
-        Nothing -> []
-        Just (s, _) -> Set.toList s
+  let collateralIns = maybe [] (Set.toList . fst) mCollaterals
   -- We retrieve all the outputs known to the skeleton
   (knownTxORefs, knownTxOuts) <- unzip . Map.toList <$> lookupUtxos (Set.toList (txSkelKnownTxOutRefs txSkel) <> collateralIns)
   -- We then compute their Cardano counterparts
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index 0cc2a98c4..b56fb2962 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -13,8 +13,12 @@ module Cooked.MockChain.Misc
   )
 where
 
-import Cooked.Pretty
+import Cooked.Pretty.Hashable
+import Data.Map (Map)
+import Data.Map qualified as Map
+import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
+import Polysemy.Writer
 
 -- | An effect that corresponds to extra QOL capabilities of the MockChain
 data MockChainMisc :: Effect where
@@ -34,9 +38,9 @@ runMockChainMisc = interpret $
     tell $ Map.singleton (toHash hashable) name
     return hashable
 
--- | Stores an alias matching a hashable data for pretty printing purpose
-define :: (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a
+-- -- | Stores an alias matching a hashable data for pretty printing purpose
+define :: forall effs a. (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a
 
 -- | Like `define`, but binds the result of a monadic computation instead
-defineM :: (Member MockChainMisc effs) => String -> Sem effs a -> Sem effs a
+defineM :: (Member MockChainMisc effs, ToHash a) => String -> Sem effs a -> Sem effs a
 defineM name = (define name =<<)

From 7acfc4a7611f617d4cfde1ace0560d5a6ee3a156 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 23 Jan 2026 00:24:16 +0100
Subject: [PATCH 35/96] Only Testing and UtxoSearch remain

---
 cooked-validators.cabal                       |   2 +-
 src/Cooked/MockChain/Direct.hs                | 362 ------------------
 .../MockChain/GenerateTx/Certificate.hs       |   1 +
 src/Cooked/MockChain/GenerateTx/Credential.hs | 127 ++++++
 src/Cooked/MockChain/GenerateTx/Proposal.hs   |   1 +
 src/Cooked/MockChain/GenerateTx/Witness.hs    | 121 +-----
 src/Cooked/MockChain/Instances.hs             | 196 ++++++++--
 src/Cooked/MockChain/Read.hs                  |   3 +-
 src/Cooked/MockChain/Write.hs                 | 176 ++++++++-
 src/Cooked/Tweak.hs                           |   9 +-
 src/Cooked/Tweak/Common.hs                    |  13 -
 11 files changed, 465 insertions(+), 546 deletions(-)
 delete mode 100644 src/Cooked/MockChain/Direct.hs
 create mode 100644 src/Cooked/MockChain/GenerateTx/Credential.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index a3ecfd474..b9070402e 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -24,12 +24,12 @@ library
       Cooked.MockChain.AutoFilling
       Cooked.MockChain.Balancing
       Cooked.MockChain.Common
-      Cooked.MockChain.Direct
       Cooked.MockChain.Error
       Cooked.MockChain.GenerateTx.Anchor
       Cooked.MockChain.GenerateTx.Body
       Cooked.MockChain.GenerateTx.Certificate
       Cooked.MockChain.GenerateTx.Collateral
+      Cooked.MockChain.GenerateTx.Credential
       Cooked.MockChain.GenerateTx.Input
       Cooked.MockChain.GenerateTx.Mint
       Cooked.MockChain.GenerateTx.Output
diff --git a/src/Cooked/MockChain/Direct.hs b/src/Cooked/MockChain/Direct.hs
deleted file mode 100644
index 382550aed..000000000
--- a/src/Cooked/MockChain/Direct.hs
+++ /dev/null
@@ -1,362 +0,0 @@
-{-# OPTIONS_GHC -Wno-name-shadowing #-}
-
--- | This module provides a direct (as opposed to 'Cooked.MockChain.Staged')
--- implementation of the `MonadBlockChain` specification. This rely on the
--- emulator from cardano-node-emulator for transaction validation, although we
--- have our own internal state. This choice might be revised in the future.
-module Cooked.MockChain.Direct where
-
-import Cardano.Api qualified as Cardano
-import Cardano.Api.Ledger qualified as Cardano
-import Cardano.Node.Emulator.Internal.Node qualified as Emulator
-import Control.Applicative
-import Control.Lens qualified as Lens
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.Identity
-import Control.Monad.Reader
-import Control.Monad.State.Strict
-import Control.Monad.Writer
-import Cooked.InitialDistribution
-import Cooked.MockChain.AutoFilling
-import Cooked.MockChain.Balancing
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.GenerateTx.Body
-import Cooked.MockChain.GenerateTx.Output
-import Cooked.MockChain.GenerateTx.Witness
-import Cooked.MockChain.MockChainState
-import Cooked.MockChain.UtxoState (UtxoState)
-import Cooked.Pretty.Hashable
-import Cooked.Skeleton
-import Data.Coerce
-import Data.Default
-import Data.Map (Map)
-import Data.Map.Strict qualified as Map
-import Data.Maybe
-import Ledger.Index qualified as Ledger
-import Ledger.Orphans ()
-import Ledger.Tx qualified as Ledger
-import Ledger.Tx.CardanoAPI qualified as Ledger
-import Optics.Core
-import Plutus.Script.Utils.Address qualified as Script
-import Plutus.Script.Utils.Scripts qualified as Script
-import PlutusLedgerApi.V3 qualified as Api
-
--- * Direct Emulation
-
--- $mockchaindocstr
---
--- The MockChainT monad provides a direct emulator; that is, it gives us a
--- simple way to run a full validation process directly, without relying on a
--- deployed node. While simulated, the validation is performed by the
--- cardano-ledger code, thus ensuring similar results on the real chain.
---
--- A 'MockChain':
---
--- - stores and updates a 'MockChainState'
---
--- - returns a 'UtxoState' when run
---
--- - emits entries in a 'MockChainBook'
-
--- | A 'MockChainT' builds up a stack of monads on top of a given monad @m@ to
--- reflect the requirements of the simulation. It writes a 'MockChainBook',
--- updates and reads from a 'MockChainState' and throws possible
--- 'MockChainError's.
-newtype MockChainT m a = MockChainT
-  {unMockChain :: (ExceptT MockChainError (StateT MockChainState (WriterT MockChainBook m))) a}
-  deriving newtype
-    ( Functor,
-      Applicative,
-      MonadState MockChainState,
-      MonadError MockChainError,
-      MonadWriter MockChainBook
-    )
-
--- | Our 'MockChain' naturally instantiate the inner monad with 'Identity'
-type MockChain = MockChainT Identity
-
--- | Custom monad instance made to increase the slot count automatically
-instance (Monad m) => Monad (MockChainT m) where
-  return = pure
-  MockChainT x >>= f = MockChainT $ x >>= unMockChain . f
-
-instance (Monad m) => MonadFail (MockChainT m) where
-  fail = throwError . FailWith
-
-instance MonadTrans MockChainT where
-  lift = MockChainT . lift . lift . lift
-
-instance (Monad m, Alternative m) => Alternative (MockChainT m) where
-  empty = MockChainT $ ExceptT $ StateT $ const $ WriterT empty
-  (<|>) = combineMockChainT (<|>)
-
-instance (MonadPlus m) => MonadPlus (MockChainT m) where
-  mzero = lift mzero
-  mplus = combineMockChainT mplus
-
--- | Combines two 'MockChainT' together
-combineMockChainT :: (forall a. m a -> m a -> m a) -> MockChainT m x -> MockChainT m x -> MockChainT m x
-combineMockChainT f ma mb = MockChainT $
-  ExceptT $
-    StateT $ \s ->
-      let resA = runWriterT $ runStateT (runExceptT (unMockChain ma)) s
-          resB = runWriterT $ runStateT (runExceptT (unMockChain mb)) s
-       in WriterT $ f resA resB
-
--- * 'MockChain' return types
-
--- | The returned type when running a 'MockChainT'. This is both a reorganizing
--- and filtering of the natural returned type @((Either MockChainError a,
--- MockChainState), MockChainBook)@, which is much easier to query.
-data MockChainReturn a where
-  MockChainReturn ::
-    { -- | The value returned by the computation, or an error
-      mcrValue :: Either MockChainError a,
-      -- | The outputs at the end of the run
-      mcrOutputs :: Map Api.TxOutRef (TxSkelOut, Bool),
-      -- | The 'UtxoState' at the end of the run
-      mcrUtxoState :: UtxoState,
-      -- | The final journal emitted during the run
-      mcrJournal :: [MockChainLogEntry],
-      -- | The map of aliases defined during the run
-      mcrAliases :: Map Api.BuiltinByteString String
-    } ->
-    MockChainReturn a
-  deriving (Functor)
-
--- | Raw return type of running a 'MockChainT'
-type RawMockChainReturn a = ((Either MockChainError a, MockChainState), MockChainBook)
-
--- | Building a 'MockChainReturn' from a 'RawMockChainReturn'
-unRawMockChainReturn :: RawMockChainReturn a -> MockChainReturn a
-unRawMockChainReturn ((val, st), MockChainBook journal aliases) = MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases
-
--- * 'MockChain' configurations
-
--- | Configuration to run a 'MockChainT'
-data MockChainConf a b where
-  MockChainConf ::
-    { -- | The initial state from which to run the 'MockChainT'
-      mccInitialState :: MockChainState,
-      -- | The initial payments to issue in the run
-      mccInitialDistribution :: InitialDistribution,
-      -- | The function to apply on the result of the run
-      mccFunOnResult :: RawMockChainReturn a -> b
-    } ->
-    MockChainConf a b
-
--- | A configuration with a default initial state, a given distribution,
--- returning a 'MockChainReturn'
-initDistConf :: InitialDistribution -> MockChainConf a (MockChainReturn a)
-initDistConf i0 = MockChainConf def i0 unRawMockChainReturn
-
--- | A configuration with a given initial 'MockChainState', a default initial
--- distribution, returning the final 'MockChainState'
-mockChainStateConf :: MockChainState -> MockChainConf a MockChainState
-mockChainStateConf s0 = MockChainConf s0 def (snd . fst)
-
--- * 'MockChain' runs
-
--- We give the possibility to run a 'MockChain' or a 'MockChainT' from an
--- arbitrary 'MockChainConf', and instance for configuration with a given
--- 'InitialDistribution', which is the most used in our tests. All other
--- configuration can freely be built and used for runs.
-
--- | Runs a 'MockChainT' using a certain configuration
-runMockChainTFromConf :: (Monad m) => MockChainConf a b -> MockChainT m a -> m b
-runMockChainTFromConf MockChainConf {..} =
-  fmap mccFunOnResult
-    . runWriterT
-    . flip runStateT mccInitialState
-    . runExceptT
-    . unMockChain
-    . (forceOutputs (unInitialDistribution mccInitialDistribution) >>)
-
--- | Runs a 'MockChain' using a certain configuration
-runMockChainFromConf :: MockChainConf a b -> MockChain a -> b
-runMockChainFromConf conf = runIdentity . runMockChainTFromConf conf
-
--- | Runs a 'MockChainT' from an initial 'InitialDistribution'
-runMockChainTFromInitDist :: (Monad m) => InitialDistribution -> MockChainT m a -> m (MockChainReturn a)
-runMockChainTFromInitDist i0 = runMockChainTFromConf (initDistConf i0)
-
--- | See 'runMockChainTFromInitDist'
-runMockChainFromInitDist :: InitialDistribution -> MockChain a -> MockChainReturn a
-runMockChainFromInitDist i0 = runIdentity . runMockChainTFromInitDist i0
-
--- | Uses 'runMockChainTFromInitDist' with a default 'InitialDistribution'
-runMockChainT :: (Monad m) => MockChainT m a -> m (MockChainReturn a)
-runMockChainT = runMockChainTFromInitDist def
-
--- | Uses 'runMockChainFromInitDist' with a default 'InitialDistribution'
-runMockChain :: MockChain a -> MockChainReturn a
-runMockChain = runMockChainFromInitDist def
-
--- * Direct Interpretation of Operations
-
-instance (Monad m) => MonadBlockChainBalancing (MockChainT m) where
-  getParams = gets mcstParams
-  txSkelOutByRef oRef = do
-    res <- gets $ Map.lookup oRef . mcstOutputs
-    case res of
-      Just (txSkelOut, True) -> return txSkelOut
-      _ -> throwError $ MCEUnknownOutRef oRef
-  utxosAt (Script.toAddress -> addr) = filter ((addr ==) . view txSkelOutAddressG . snd) <$> allUtxos
-  logEvent l = tell $ MockChainBook [l] Map.empty
-
-instance (Monad m) => MonadBlockChainWithoutValidation (MockChainT m) where
-  allUtxos =
-    gets $
-      mapMaybe
-        (\(oRef, (txSkelOut, isAvailable)) -> if isAvailable then Just (oRef, txSkelOut) else Nothing)
-        . Map.toList
-        . mcstOutputs
-  setParams params = do
-    modify $ set mcstParamsL params
-    modify $ over mcstLedgerStateL (Emulator.updateStateParams params)
-  waitNSlots n = do
-    cs <- gets (Emulator.getSlot . mcstLedgerState)
-    if
-      | n == 0 -> return cs
-      | n > 0 -> do
-          let newSlot = cs + fromIntegral n
-          modify' (over mcstLedgerStateL $ Lens.set Emulator.elsSlotL $ fromIntegral newSlot)
-          return newSlot
-      | otherwise -> throwError $ MCEPastSlot cs (cs + fromIntegral n)
-  define name hashable = tell (MockChainBook [] (Map.singleton (toHash hashable) name)) >> return hashable
-  setConstitutionScript (toVScript -> cScript) = do
-    modify' (mcstConstitutionL ?~ cScript)
-    modify' $
-      over mcstLedgerStateL $
-        Lens.set Emulator.elsConstitutionScriptL $
-          (Cardano.SJust . Cardano.toShelleyScriptHash . Script.toCardanoScriptHash)
-            cScript
-  getConstitutionScript = gets (view mcstConstitutionL)
-  getCurrentReward (Script.toCredential -> cred) = do
-    stakeCredential <- toStakeCredential cred
-    gets (fmap coerce . Emulator.getReward stakeCredential . view mcstLedgerStateL)
-
--- | Most of the logic of the direct emulation happens here
-instance (Monad m) => MonadBlockChain (MockChainT m) where
-  validateTxSkel txSkel | TxSkelOpts {..} <- txSkelOpts txSkel = do
-    -- We log the submission of a new skeleton
-    logEvent $ MCLogSubmittedTxSkel txSkel
-    -- We retrieve the current parameters
-    oldParams <- getParams
-    -- We compute the optionally modified parameters
-    let newParams = txSkelOptModParams oldParams
-    -- We change the parameters for the duration of the validation process
-    setParams newParams
-    -- We ensure that the outputs have the required minimal amount of ada, when
-    -- requested in the skeleton options
-    txSkel <- autoFillMinAda txSkel
-    -- We retrieve the official constitution script and attach it to each
-    -- proposal that requires it, if it's not empty
-    txSkel <- autoFillConstitution txSkel
-    -- We add reference scripts in the various redeemers of the skeleton, when
-    -- they can be found in the index and are allowed to be auto filled
-    txSkel <- autoFillReferenceScripts txSkel
-    -- We attach the reward amount to withdrawals when applicable
-    txSkel <- autoFillWithdrawalAmounts txSkel
-    -- We balance the skeleton when requested in the skeleton option, and get
-    -- the associated fee, collateral inputs and return collateral user
-    (txSkel, fee, mCollaterals) <- balanceTxSkel txSkel
-    -- We log the adjusted skeleton
-    logEvent $ MCLogAdjustedTxSkel txSkel fee mCollaterals
-    -- We generate the transaction asscoiated with the skeleton, and apply on it
-    -- the modifications from the skeleton options
-    cardanoTx <- Ledger.CardanoEmulatorEraTx . txSkelOptModTx <$> txSkelToCardanoTx txSkel fee mCollaterals
-    -- To run transaction validation we need a minimal ledger state
-    eLedgerState <- gets mcstLedgerState
-    -- We finally run the emulated validation. We update our internal state
-    -- based on the validation result, and throw an error if this fails. If at
-    -- some point we want to allows mockchain runs with validation errors, the
-    -- caller will need to catch those errors and do something with them.
-    case Emulator.validateCardanoTx newParams eLedgerState cardanoTx of
-      -- In case of a phase 1 error, we give back the same index
-      (_, Ledger.FailPhase1 _ err) -> throwError $ MCEValidationError Ledger.Phase1 err
-      (newELedgerState, Ledger.FailPhase2 _ err _) | Just (colInputs, retColUser) <- mCollaterals -> do
-        -- We update the emulated ledger state
-        modify' (set mcstLedgerStateL newELedgerState)
-        -- We remove the collateral utxos from our own stored outputs
-        forM_ colInputs $ modify' . removeOutput
-        -- We add the returned collateral to our outputs (in practice this map
-        -- either contains no element, or a single one)
-        forM_ (Map.toList $ Ledger.getCardanoTxProducedReturnCollateral cardanoTx) $ \(txIn, txOut) ->
-          modify' $
-            addOutput
-              (Ledger.fromCardanoTxIn txIn)
-              (retColUser `receives` Value (Api.txOutValue . Ledger.fromCardanoTxOutToPV2TxInfoTxOut . Ledger.getTxOut $ txOut))
-        -- We throw a mockchain error
-        throwError $ MCEValidationError Ledger.Phase2 err
-      -- In case of success, we update the index with all inputs and outputs
-      -- contained in the transaction
-      (newELedgerState, Ledger.Success {}) -> do
-        -- We update the index with the utxos consumed and produced by the tx
-        modify' (set mcstLedgerStateL newELedgerState)
-        -- We retrieve the utxos created by the transaction
-        let utxos = Ledger.fromCardanoTxIn . snd <$> Ledger.getCardanoTxOutRefs cardanoTx
-        -- We add the news utxos to the state
-        forM_ (zip utxos (txSkelOuts txSkel)) $ modify' . uncurry addOutput
-        -- And remove the old ones
-        forM_ (Map.toList $ txSkelIns txSkel) $ modify' . removeOutput . fst
-      -- This is a theoretical unreachable case. Since we fail in Phase 2, it
-      -- means the transaction involved script, and thus we must have generated
-      -- collaterals.
-      (_, Ledger.FailPhase2 {})
-        | Nothing <- mCollaterals ->
-            fail "Unreachable case when processing validation result, please report a bug at https://github.com/tweag/cooked-validators/issues"
-    -- We apply a change of slot when requested in the options
-    when txSkelOptAutoSlotIncrease $ modify' (over mcstLedgerStateL Emulator.nextSlot)
-    -- We return the parameters to their original state
-    setParams oldParams
-    -- We log the validated transaction
-    logEvent $ MCLogNewTx (Ledger.fromCardanoTxId $ Ledger.getCardanoTxId cardanoTx) (fromIntegral $ length $ Ledger.getCardanoTxOutRefs cardanoTx)
-    -- We return the validated transaction
-    return cardanoTx
-
-  forceOutputs outputs = do
-    -- We retrieve the protocol parameters
-    params <- getParams
-    -- The emulator takes for granted transactions with a single pseudo input,
-    -- which we build to force transaction validation
-    let input =
-          ( Cardano.genesisUTxOPseudoTxIn (Emulator.pNetworkId params) $
-              Cardano.GenesisUTxOKeyHash $
-                Cardano.KeyHash "23d51e91ae5adc7ae801e9de4cd54175fb7464ec2680b25686bbb194",
-            Cardano.BuildTxWith $ Cardano.KeyWitness Cardano.KeyWitnessForSpending
-          )
-    -- We adjust the outputs for the minimal required ADA if needed
-    outputsMinAda <- mapM toTxSkelOutWithMinAda outputs
-    -- We transform these outputs to Cardano outputs
-    outputs' <- mapM toCardanoTxOut outputsMinAda
-    -- We create our transaction body, which only consists of the dummy input
-    -- and the outputs to force. This create might result in an error.
-    let transactionBody =
-          Emulator.createTransactionBody params $
-            Ledger.CardanoBuildTx
-              ( Ledger.emptyTxBodyContent
-                  { Cardano.txOuts = outputs',
-                    Cardano.txIns = [input]
-                  }
-              )
-    -- We retrieve the forcefully validated transaction associated with the
-    -- body, handling errors in the process.
-    cardanoTx <-
-      Ledger.CardanoEmulatorEraTx . txSignatoriesAndBodyToCardanoTx []
-        <$> either (throwError . MCEToCardanoError "forceOutputs :") return transactionBody
-    -- We need to adjust our internal state to account for the forced
-    -- transaction. We beging by computing the new map of outputs.
-    let outputsMap =
-          Map.fromList $
-            zipWith
-              (\x y -> (x, (y, True)))
-              (Ledger.fromCardanoTxIn . snd <$> Ledger.getCardanoTxOutRefs cardanoTx)
-              outputsMinAda
-    -- We update the index, which effectively receives the new utxos
-    modify' (over mcstLedgerStateL $ Lens.over Emulator.elsUtxoL (Ledger.fromPlutusIndex . Ledger.insert cardanoTx . Ledger.toPlutusIndex))
-    -- We update our internal map by adding the new outputs
-    modify' (over mcstOutputsL (<> outputsMap))
-    -- Finally, we return the created utxos
-    fmap fst <$> utxosFromCardanoTx cardanoTx
diff --git a/src/Cooked/MockChain/GenerateTx/Certificate.hs b/src/Cooked/MockChain/GenerateTx/Certificate.hs
index 498b9dbfd..d85e7e03d 100644
--- a/src/Cooked/MockChain/GenerateTx/Certificate.hs
+++ b/src/Cooked/MockChain/GenerateTx/Certificate.hs
@@ -9,6 +9,7 @@ import Cardano.Ledger.PoolParams qualified as Ledger
 import Cardano.Ledger.Shelley.TxCert qualified as Shelley
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Cooked.MockChain.Error
+import Cooked.MockChain.GenerateTx.Credential
 import Cooked.MockChain.GenerateTx.Witness
 import Cooked.MockChain.Read
 import Cooked.Skeleton.Certificate
diff --git a/src/Cooked/MockChain/GenerateTx/Credential.hs b/src/Cooked/MockChain/GenerateTx/Credential.hs
new file mode 100644
index 000000000..9e7f039f9
--- /dev/null
+++ b/src/Cooked/MockChain/GenerateTx/Credential.hs
@@ -0,0 +1,127 @@
+-- | This module exposes the generation of various kinds of credentials
+module Cooked.MockChain.GenerateTx.Credential
+  ( toRewardAccount,
+    toCardanoCredential,
+    toStakeCredential,
+    deserialiseFromBuiltinByteString,
+    toScriptHash,
+    toKeyHash,
+    toDRepCredential,
+    toStakePoolKeyHash,
+    toColdCredential,
+    toHotCredential,
+    toVRFVerKeyHash,
+  )
+where
+
+import Cardano.Api qualified as Cardano
+import Cardano.Ledger.BaseTypes qualified as C.Ledger
+import Cardano.Ledger.Hashes qualified as C.Ledger
+import Cardano.Ledger.Shelley.API qualified as C.Ledger
+import Ledger.Tx.CardanoAPI qualified as Ledger
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
+
+-- | Translates a given credential to a reward account.
+toRewardAccount ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.Credential ->
+  Sem effs C.Ledger.RewardAccount
+toRewardAccount =
+  (C.Ledger.RewardAccount C.Ledger.Testnet <$>)
+    . toCardanoCredential Cardano.AsStakeKey Cardano.unStakeKeyHash
+
+-- TODO: if this works, migrate to plutus-ledger
+
+-- | Converts an 'Api.PubKeyHash' to any kind of key
+deserialiseFromBuiltinByteString ::
+  ( Member (Error Ledger.ToCardanoError) effs,
+    Cardano.SerialiseAsRawBytes a
+  ) =>
+  Cardano.AsType a ->
+  Api.BuiltinByteString ->
+  Sem effs a
+deserialiseFromBuiltinByteString asType =
+  fromEither
+    . Ledger.deserialiseFromRawBytes asType
+    . Api.fromBuiltin
+
+-- | Converts a plutus script hash into a cardano ledger script hash
+toScriptHash ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.ScriptHash ->
+  Sem effs C.Ledger.ScriptHash
+toScriptHash (Api.ScriptHash sHash) = do
+  Cardano.ScriptHash cHash <- deserialiseFromBuiltinByteString Cardano.AsScriptHash sHash
+  return cHash
+
+-- | Converts a plutus pkhash into a certain cardano ledger hash
+toKeyHash ::
+  ( Member (Error Ledger.ToCardanoError) effs,
+    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
+  ) =>
+  Cardano.AsType key ->
+  (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
+  Api.PubKeyHash ->
+  Sem effs (C.Ledger.KeyHash kr)
+toKeyHash asType unwrap =
+  fmap unwrap
+    . deserialiseFromBuiltinByteString (Cardano.AsHash asType)
+    . Api.getPubKeyHash
+
+-- | Converts an 'Api.PubKeyHash' into a cardano ledger stake pool key hash
+toStakePoolKeyHash ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.PubKeyHash ->
+  Sem effs (C.Ledger.KeyHash 'C.Ledger.StakePool)
+toStakePoolKeyHash = toKeyHash Cardano.AsStakePoolKey Cardano.unStakePoolKeyHash
+
+-- | Converts an 'Api.PubKeyHash' into a cardano ledger VRFVerKeyHash
+toVRFVerKeyHash ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.PubKeyHash ->
+  Sem effs (C.Ledger.VRFVerKeyHash a)
+toVRFVerKeyHash (Api.PubKeyHash pkh) = do
+  Cardano.VrfKeyHash key <- deserialiseFromBuiltinByteString (Cardano.AsHash Cardano.AsVrfKey) pkh
+  return $ C.Ledger.toVRFVerKeyHash key
+
+-- | Converts an 'Api.Credential' to a Cardano Credential of the expected kind
+toCardanoCredential ::
+  ( Member (Error Ledger.ToCardanoError) effs,
+    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
+  ) =>
+  Cardano.AsType key ->
+  (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential kr)
+toCardanoCredential _ _ (Api.ScriptCredential sHash) = C.Ledger.ScriptHashObj <$> toScriptHash sHash
+toCardanoCredential asType unwrap (Api.PubKeyCredential pkHash) = C.Ledger.KeyHashObj <$> toKeyHash asType unwrap pkHash
+
+-- | Translates a credential into a Cardano stake credential
+toStakeCredential ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.Staking)
+toStakeCredential = toCardanoCredential Cardano.AsStakeKey Cardano.unStakeKeyHash
+
+-- | Translates a credential into a Cardano drep credential
+toDRepCredential ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.DRepRole)
+toDRepCredential = toCardanoCredential Cardano.AsDRepKey Cardano.unDRepKeyHash
+
+-- | Translates a credential into a Cardano cold committee credential
+toColdCredential ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.ColdCommitteeRole)
+toColdCredential = toCardanoCredential Cardano.AsCommitteeColdKey Cardano.unCommitteeColdKeyHash
+
+-- | Translates a credential into a Cardano hot committee credential
+toHotCredential ::
+  (Member (Error Ledger.ToCardanoError) effs) =>
+  Api.Credential ->
+  Sem effs (C.Ledger.Credential 'C.Ledger.HotCommitteeRole)
+toHotCredential = toCardanoCredential Cardano.AsCommitteeHotKey Cardano.unCommitteeHotKeyHash
diff --git a/src/Cooked/MockChain/GenerateTx/Proposal.hs b/src/Cooked/MockChain/GenerateTx/Proposal.hs
index 5445e1cd4..91046dd26 100644
--- a/src/Cooked/MockChain/GenerateTx/Proposal.hs
+++ b/src/Cooked/MockChain/GenerateTx/Proposal.hs
@@ -11,6 +11,7 @@ import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Monad
 import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Anchor
+import Cooked.MockChain.GenerateTx.Credential
 import Cooked.MockChain.GenerateTx.Witness
 import Cooked.MockChain.Read
 import Cooked.Skeleton.Proposal
diff --git a/src/Cooked/MockChain/GenerateTx/Witness.hs b/src/Cooked/MockChain/GenerateTx/Witness.hs
index f43fecc8d..36e3beb83 100644
--- a/src/Cooked/MockChain/GenerateTx/Witness.hs
+++ b/src/Cooked/MockChain/GenerateTx/Witness.hs
@@ -1,25 +1,11 @@
--- | This module exposes the generation of witnesses and reward account
+-- | This module exposes the generation of key and script witnesses
 module Cooked.MockChain.GenerateTx.Witness
-  ( toRewardAccount,
-    toCardanoCredential,
-    toScriptWitness,
+  ( toScriptWitness,
     toKeyWitness,
-    toStakeCredential,
-    deserialiseFromBuiltinByteString,
-    toScriptHash,
-    toKeyHash,
-    toDRepCredential,
-    toStakePoolKeyHash,
-    toColdCredential,
-    toHotCredential,
-    toVRFVerKeyHash,
   )
 where
 
 import Cardano.Api qualified as Cardano
-import Cardano.Ledger.BaseTypes qualified as C.Ledger
-import Cardano.Ledger.Hashes qualified as C.Ledger
-import Cardano.Ledger.Shelley.API qualified as C.Ledger
 import Cooked.MockChain.Error
 import Cooked.MockChain.Read
 import Cooked.Skeleton
@@ -31,109 +17,6 @@ import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Error
 
--- | Translates a given credential to a reward account.
-toRewardAccount ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.Credential ->
-  Sem effs C.Ledger.RewardAccount
-toRewardAccount =
-  (C.Ledger.RewardAccount C.Ledger.Testnet <$>)
-    . toCardanoCredential Cardano.AsStakeKey Cardano.unStakeKeyHash
-
--- TODO: if this works, migrate to plutus-ledger
-
--- | Converts an 'Api.PubKeyHash' to any kind of key
-deserialiseFromBuiltinByteString ::
-  ( Members '[MockChainRead, Error Ledger.ToCardanoError] effs,
-    Cardano.SerialiseAsRawBytes a
-  ) =>
-  Cardano.AsType a ->
-  Api.BuiltinByteString ->
-  Sem effs a
-deserialiseFromBuiltinByteString asType =
-  fromEither
-    . Ledger.deserialiseFromRawBytes asType
-    . Api.fromBuiltin
-
--- | Converts a plutus script hash into a cardano ledger script hash
-toScriptHash ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.ScriptHash ->
-  Sem effs C.Ledger.ScriptHash
-toScriptHash (Api.ScriptHash sHash) = do
-  Cardano.ScriptHash cHash <- deserialiseFromBuiltinByteString Cardano.AsScriptHash sHash
-  return cHash
-
--- | Converts a plutus pkhash into a certain cardano ledger hash
-toKeyHash ::
-  ( Members '[MockChainRead, Error Ledger.ToCardanoError] effs,
-    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
-  ) =>
-  Cardano.AsType key ->
-  (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
-  Api.PubKeyHash ->
-  Sem effs (C.Ledger.KeyHash kr)
-toKeyHash asType unwrap =
-  fmap unwrap
-    . deserialiseFromBuiltinByteString (Cardano.AsHash asType)
-    . Api.getPubKeyHash
-
--- | Converts an 'Api.PubKeyHash' into a cardano ledger stake pool key hash
-toStakePoolKeyHash ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.PubKeyHash ->
-  Sem effs (C.Ledger.KeyHash 'C.Ledger.StakePool)
-toStakePoolKeyHash = toKeyHash Cardano.AsStakePoolKey Cardano.unStakePoolKeyHash
-
--- | Converts an 'Api.PubKeyHash' into a cardano ledger VRFVerKeyHash
-toVRFVerKeyHash ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.PubKeyHash ->
-  Sem effs (C.Ledger.VRFVerKeyHash a)
-toVRFVerKeyHash (Api.PubKeyHash pkh) = do
-  Cardano.VrfKeyHash key <- deserialiseFromBuiltinByteString (Cardano.AsHash Cardano.AsVrfKey) pkh
-  return $ C.Ledger.toVRFVerKeyHash key
-
--- | Converts an 'Api.Credential' to a Cardano Credential of the expected kind
-toCardanoCredential ::
-  ( Members '[MockChainRead, Error Ledger.ToCardanoError] effs,
-    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
-  ) =>
-  Cardano.AsType key ->
-  (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
-  Api.Credential ->
-  Sem effs (C.Ledger.Credential kr)
-toCardanoCredential _ _ (Api.ScriptCredential sHash) = C.Ledger.ScriptHashObj <$> toScriptHash sHash
-toCardanoCredential asType unwrap (Api.PubKeyCredential pkHash) = C.Ledger.KeyHashObj <$> toKeyHash asType unwrap pkHash
-
--- | Translates a credential into a Cardano stake credential
-toStakeCredential ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.Credential ->
-  Sem effs (C.Ledger.Credential 'C.Ledger.Staking)
-toStakeCredential = toCardanoCredential Cardano.AsStakeKey Cardano.unStakeKeyHash
-
--- | Translates a credential into a Cardano drep credential
-toDRepCredential ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.Credential ->
-  Sem effs (C.Ledger.Credential 'C.Ledger.DRepRole)
-toDRepCredential = toCardanoCredential Cardano.AsDRepKey Cardano.unDRepKeyHash
-
--- | Translates a credential into a Cardano cold committee credential
-toColdCredential ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.Credential ->
-  Sem effs (C.Ledger.Credential 'C.Ledger.ColdCommitteeRole)
-toColdCredential = toCardanoCredential Cardano.AsCommitteeColdKey Cardano.unCommitteeColdKeyHash
-
--- | Translates a credential into a Cardano hot committee credential
-toHotCredential ::
-  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Api.Credential ->
-  Sem effs (C.Ledger.Credential 'C.Ledger.HotCommitteeRole)
-toHotCredential = toCardanoCredential Cardano.AsCommitteeHotKey Cardano.unCommitteeHotKeyHash
-
 -- | Translates a script and a reference script utxo into either a plutus script
 -- or a reference input containing the right script
 toPlutusScriptOrReferenceInput ::
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index fd5986e95..0b968d6cb 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -1,69 +1,191 @@
 module Cooked.MockChain.Instances where
 
+import Cooked.InitialDistribution
+import Cooked.Ltl
+import Cooked.MockChain.Error
+import Cooked.MockChain.Log
 import Cooked.MockChain.Misc
+import Cooked.MockChain.MockChainState
 import Cooked.MockChain.Read
+import Cooked.MockChain.UtxoState
 import Cooked.MockChain.Write
+import Cooked.Skeleton.Output
+import Data.Default
+import Data.Map (Map)
+import Ledger.Tx qualified as Ledger
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
+import Polysemy.NonDet
+import Polysemy.State
+import Polysemy.Writer
 
--- * MockChainDirect
+-- * 'MockChain' return types
+
+-- | The returned type when running a 'MockChainT'. This is both a reorganizing
+-- and filtering of the natural returned type @((Either MockChainError a,
+-- MockChainState), MockChainBook)@, which is much easier to query.
+data MockChainReturn a where
+  MockChainReturn ::
+    { -- | The value returned by the computation, or an error
+      mcrValue :: Either MockChainError a,
+      -- | The outputs at the end of the run
+      mcrOutputs :: Map Api.TxOutRef (TxSkelOut, Bool),
+      -- | The 'UtxoState' at the end of the run
+      mcrUtxoState :: UtxoState,
+      -- | The final journal emitted during the run
+      mcrJournal :: [MockChainLogEntry],
+      -- | The map of aliases defined during the run
+      mcrAliases :: Map Api.BuiltinByteString String
+    } ->
+    MockChainReturn a
+  deriving (Functor)
+
+-- | Raw return type of running a 'MockChainT'
+type RawMockChainReturn a =
+  ( Map Api.BuiltinByteString String,
+    ( [MockChainLogEntry],
+      ( MockChainState,
+        Either MockChainError a
+      )
+    )
+  )
+
+-- | The type of functions transforming an element of type @RawMockChainReturn a@
+-- into an element of type @b@
+type FunOnMockChainResult a b = RawMockChainReturn a -> b
+
+-- | Building a `MockChainReturn` from a `RawMockChainReturn`
+unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
+unRawMockChainReturn (aliases, (journal, (st, val))) =
+  MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases
+
+-- | Retrieving the `MockChainState` from a `RawMockChainReturn`
+stateFromMockChainReturn :: FunOnMockChainResult a MockChainState
+stateFromMockChainReturn = fst . snd . snd
+
+-- | Configuration to run a mockchain
+data MockChainConf effs a b where
+  MockChainConf ::
+    { -- | The initial state from which to run the 'MockChainT'
+      mccInitialState :: MockChainState,
+      -- | The initial payments to issue in the run
+      mccInitialDistribution :: InitialDistribution,
+      -- | The function to apply on the results of the run
+      mccFunOnResult :: FunOnMockChainResult a b,
+      -- | The actual run to execute
+      mccRun :: Sem effs a,
+      -- | The interpreter for the run. We always expect several possible
+      -- outcomes for a run, even when the effect stack does not make use of
+      -- `NonDet` in which case the list will be a singleton.
+      mccRunner :: forall a'. MockChainState -> Sem effs a' -> [RawMockChainReturn a']
+    } ->
+    MockChainConf effs a b
+
+-- | Running a mockchain conf to get a list of results of the expected type
+runMockChainConf ::
+  (Member MockChainWrite effs) =>
+  MockChainConf effs a b ->
+  [b]
+runMockChainConf (MockChainConf initialState initialDist funOnRes currentRun runner) =
+  funOnRes <$> runner initialState (forceOutputs (unInitialDistribution initialDist) >> currentRun)
+
+type DirectEffs =
+  '[ MockChainWrite,
+     MockChainRead,
+     MockChainMisc,
+     Fail
+   ]
 
 -- | A possible stack of effects to handle a direct interpretation of the
 -- mockchain, that is without any tweaks nor branching.
-type MockChainDirect a =
-  Sem
-    '[ MockChainWrite,
-       MockChainRead,
-       MockChainMisc,
-       Fail
-     ]
-    a
-
-runMockChainDirect :: MockChainDirect a -> (MockChainBook, (MockChainState, Either MockChainError a))
-runMockChainDirect =
-  run
+type MockChainDirect a = Sem DirectEffs a
+
+runMockChainDirect :: MockChainState -> MockChainDirect a -> [RawMockChainReturn a]
+runMockChainDirect mcst =
+  (: [])
+    . run
+    . runWriter
     . runWriter
     . runMockChainLog
-    . runState def
+    . runState mcst
     . runError
-    . runToCardanoError
+    . runToCardanoErrorInMockChainError
     . runFailInMockChainError
     . runMockChainMisc
     . runMockChainRead
     . runMockChainWrite
-    . insertAt @4 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
+    . insertAt @4
+      @[ Error Ledger.ToCardanoError,
+         Error MockChainError,
+         State MockChainState,
+         MockChainLog,
+         Writer [MockChainLogEntry],
+         Writer (Map Api.BuiltinByteString String)
+       ]
+
+-- | A default configuration to run a direct mockchain run. The intended usage
+-- is @runMockChainConf $ mockChainConfDirectTemplate myDirectRun@.
+mockChainConfDirectTemplate ::
+  MockChainDirect a ->
+  MockChainConf DirectEffs a (MockChainReturn a)
+mockChainConfDirectTemplate currentRun =
+  MockChainConf def def unRawMockChainReturn currentRun runMockChainDirect
 
--- * MockChainFull
+type TweakEffs = '[MockChainRead, Fail, NonDet]
 
-type TweakStack = '[MockChainRead, Fail, NonDet]
+type FullEffs =
+  '[ ModifyGlobally (UntypedTweak TweakEffs),
+     MockChainWrite,
+     MockChainMisc,
+     MockChainRead,
+     Fail,
+     NonDet
+   ]
 
 -- | A possible stack of effects to handle staged interpretation of the
 -- mockchain, that is with tweaks and branching.
-type MockChainFull a =
-  Sem
-    [ ModifyOnTime (UntypedTweak TweakStack),
-      MockChainWrite,
-      MockChainMisc,
-      MockChainRead,
-      Fail,
-      NonDet
-    ]
-    a
-
-runMockChainFull :: MockChainFull a -> [(MockChainBook, (MockChainState, Either MockChainError a))]
-runMockChainFull =
+type MockChainFull a = Sem FullEffs a
+
+runMockChainFull ::
+  MockChainState ->
+  MockChainFull a ->
+  [RawMockChainReturn a]
+runMockChainFull mcst =
   run
     . runNonDet
     . runWriter
+    . runWriter
     . runMockChainLog
-    . runState def
+    . runState mcst
     . runError
-    . runToCardanoError
+    . runToCardanoErrorInMockChainError
     . runFailInMockChainError
     . runMockChainRead
     . runMockChainMisc
     . evalState []
     . runModifyLocally
     . runMockChainWrite
-    . insertAt @6 @[Error Ledger.ToCardanoError, Error MockChainError, State MockChainState, MockChainLog, Writer MockChainBook]
-    . interceptMockChainWriteWithTweak
-    . runModifyOnTime
-    . insertAt @2 @[ModifyLocally (UntypedTweak TweakStack), State [Ltl (UntypedTweak TweakStack)]]
+    . insertAt @6
+      @[ Error Ledger.ToCardanoError,
+         Error MockChainError,
+         State MockChainState,
+         MockChainLog,
+         Writer [MockChainLogEntry],
+         Writer (Map Api.BuiltinByteString String)
+       ]
+    . reinterpretMockChainWriteWithTweak
+    . runModifyGlobally
+    . insertAt @2
+      @[ ModifyLocally (UntypedTweak TweakEffs),
+         State [Ltl (UntypedTweak TweakEffs)]
+       ]
+
+-- | A default configuration to run a staged mockchain run. The intended usage
+-- is @runMockChainConf $ mockChainConfFullTemplate myFullRun@.
+mockChainConfFullTemplate ::
+  MockChainFull a ->
+  MockChainConf FullEffs a (MockChainReturn a)
+mockChainConfFullTemplate currentRun =
+  MockChainConf def def unRawMockChainReturn currentRun runMockChainFull
diff --git a/src/Cooked/MockChain/Read.hs b/src/Cooked/MockChain/Read.hs
index 971d61530..80be3326c 100644
--- a/src/Cooked/MockChain/Read.hs
+++ b/src/Cooked/MockChain/Read.hs
@@ -51,6 +51,7 @@ import Control.Lens qualified as Lens
 import Control.Monad
 import Cooked.MockChain.Common
 import Cooked.MockChain.Error
+import Cooked.MockChain.GenerateTx.Credential (toStakeCredential)
 import Cooked.MockChain.MockChainState
 import Cooked.Skeleton
 import Data.Coerce (coerce)
@@ -106,7 +107,7 @@ runMockChainRead = interpret $ \case
   CurrentSlot -> gets $ view $ mcstLedgerStateL % to Emulator.getSlot
   GetConstitutionScript -> gets $ view mcstConstitutionL
   GetCurrentReward (Script.toCredential -> cred) -> do
-    stakeCredential <- undefined
+    stakeCredential <- toStakeCredential cred
     gets $
       preview $
         mcstLedgerStateL
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index f6de53b33..81cd910e7 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -6,6 +6,7 @@ module Cooked.MockChain.Write
   ( -- * The `MockChainWrite` effect
     MockChainWrite,
     reinterpretMockChainWriteWithTweak,
+    UntypedTweak (..),
     runMockChainWrite,
 
     -- * Modifications of the current time
@@ -27,18 +28,31 @@ module Cooked.MockChain.Write
   )
 where
 
-import Cardano.Node.Emulator qualified as Emulator
+import Cardano.Api qualified as Cardano
+import Cardano.Api.Ledger qualified as Cardano
+import Cardano.Node.Emulator.Internal.Node qualified as Emulator
+import Control.Lens qualified as Lens
 import Control.Monad
 import Cooked.Ltl
+import Cooked.MockChain.AutoFilling
+import Cooked.MockChain.Balancing
 import Cooked.MockChain.Error
+import Cooked.MockChain.GenerateTx.Body
+import Cooked.MockChain.GenerateTx.Output
 import Cooked.MockChain.Log
 import Cooked.MockChain.MockChainState
 import Cooked.MockChain.Read
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Data.Coerce
+import Data.Map.Strict qualified as Map
+import Ledger.Index qualified as Ledger
+import Ledger.Orphans ()
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
+import Ledger.Tx.CardanoAPI qualified as Ledger
+import Optics.Core
+import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Error
@@ -58,6 +72,11 @@ data MockChainWrite :: Effect where
 
 makeSem_ ''MockChainWrite
 
+-- | Wrapping up tweaks while hiding their return type and unsuring their stack
+-- of effects begins with `Tweak` and `NonDet`.
+data UntypedTweak tweakEffs where
+  UntypedTweak :: Sem (Tweak : NonDet : tweakEffs) a -> UntypedTweak tweakEffs
+
 -- | Reinterpretes `MockChainWrite` in itself, when the `ModifyLocally` effect
 -- exists in the stack, applying the relevant modifications in the process.
 reinterpretMockChainWriteWithTweak ::
@@ -106,10 +125,155 @@ runMockChainWrite ::
   Sem (MockChainWrite : effs) a ->
   Sem effs a
 runMockChainWrite = interpret $ \case
-  ValidateTxSkel skel -> do
-    undefined
-  ForceOutputs outs -> undefined
-  builtin -> undefined
+  SetParams params -> do
+    modify $ set mcstParamsL params
+    modify $ over mcstLedgerStateL $ Emulator.updateStateParams params
+  WaitNSlots n -> do
+    cs <- gets (Emulator.getSlot . mcstLedgerState)
+    if
+      | n == 0 -> return cs
+      | n > 0 -> do
+          let newSlot = cs + fromIntegral n
+          modify' (over mcstLedgerStateL $ Lens.set Emulator.elsSlotL $ fromIntegral newSlot)
+          return newSlot
+      | otherwise -> throw $ MCEPastSlot cs (cs + fromIntegral n)
+  SetConstitutionScript (toVScript -> cScript) -> do
+    modify' (mcstConstitutionL ?~ cScript)
+    modify' $
+      over mcstLedgerStateL $
+        Lens.set Emulator.elsConstitutionScriptL $
+          (Cardano.SJust . Cardano.toShelleyScriptHash . Script.toCardanoScriptHash)
+            cScript
+  ForceOutputs outputs -> do
+    -- We retrieve the protocol parameters
+    params <- getParams
+    -- The emulator takes for granted transactions with a single pseudo input,
+    -- which we build to force transaction validation
+    let input =
+          ( Cardano.genesisUTxOPseudoTxIn (Emulator.pNetworkId params) $
+              Cardano.GenesisUTxOKeyHash $
+                Cardano.KeyHash "23d51e91ae5adc7ae801e9de4cd54175fb7464ec2680b25686bbb194",
+            Cardano.BuildTxWith $ Cardano.KeyWitness Cardano.KeyWitnessForSpending
+          )
+    -- We adjust the outputs for the minimal required ADA if needed
+    outputsMinAda <- mapM toTxSkelOutWithMinAda outputs
+    -- We transform these outputs to Cardano outputs
+    outputs' <- mapM toCardanoTxOut outputsMinAda
+    -- We create our transaction body, which only consists of the dummy input
+    -- and the outputs to force, and make a transaction out of it.
+    cardanoTx <-
+      Ledger.CardanoEmulatorEraTx . txSignatoriesAndBodyToCardanoTx []
+        <$> fromEither
+          ( Emulator.createTransactionBody params $
+              Ledger.CardanoBuildTx
+                ( Ledger.emptyTxBodyContent
+                    { Cardano.txOuts = outputs',
+                      Cardano.txIns = [input]
+                    }
+                )
+          )
+    -- We need to adjust our internal state to account for the forced
+    -- transaction. We beging by computing the new map of outputs.
+    let outputsMap =
+          Map.fromList $
+            zipWith
+              (\x y -> (x, (y, True)))
+              (Ledger.fromCardanoTxIn . snd <$> Ledger.getCardanoTxOutRefs cardanoTx)
+              outputsMinAda
+    -- We update the index, which effectively receives the new utxos
+    modify'
+      ( over mcstLedgerStateL $
+          Lens.over
+            Emulator.elsUtxoL
+            ( Ledger.fromPlutusIndex
+                . Ledger.insert cardanoTx
+                . Ledger.toPlutusIndex
+            )
+      )
+    -- We update our internal map by adding the new outputs
+    modify' (over mcstOutputsL (<> outputsMap))
+    -- Finally, we return the created utxos
+    fmap fst <$> utxosFromCardanoTx cardanoTx
+  ValidateTxSkel skel -> fmap snd $ runTweak skel $ do
+    -- We retrieve the current skeleton options
+    TxSkelOpts {..} <- viewTweak txSkelOptsL
+    -- We log the submission of the new skeleton
+    viewTweak simple >>= logEvent . MCLogSubmittedTxSkel
+    -- We retrieve the current parameters
+    oldParams <- getParams
+    -- We compute the optionally modified parameters
+    let newParams = txSkelOptModParams oldParams
+    -- We change the parameters for the duration of the validation process
+    modify $ set mcstParamsL newParams
+    modify $ over mcstLedgerStateL $ Emulator.updateStateParams newParams
+    -- We ensure that the outputs have the required minimal amount of ada, when
+    -- requested in the skeleton options
+    autoFillMinAda
+    -- We retrieve the official constitution script and attach it to each
+    -- proposal that requires it, if it's not empty
+    autoFillConstitution
+    -- We add reference scripts in the various redeemers of the skeleton, when
+    -- they can be found in the index and are allowed to be auto filled
+    autoFillReferenceScripts
+    -- We attach the reward amount to withdrawals when applicable
+    autoFillWithdrawalAmounts
+    -- We balance the skeleton when requested in the skeleton option, and get
+    -- the associated fee, collateral inputs and return collateral user
+    (finalTxSkel, fee, mCollaterals) <- viewTweak simple >>= balanceTxSkel
+    -- We log the adjusted skeleton
+    logEvent $ MCLogAdjustedTxSkel finalTxSkel fee mCollaterals
+    -- We generate the transaction asscoiated with the skeleton, and apply on it
+    -- the modifications from the skeleton options
+    cardanoTx <- Ledger.CardanoEmulatorEraTx . txSkelOptModTx <$> txSkelToCardanoTx finalTxSkel fee mCollaterals
+    -- To run transaction validation we need a minimal ledger state
+    eLedgerState <- gets mcstLedgerState
+    -- We finally run the emulated validation. We update our internal state
+    -- based on the validation result, and throw an error if this fails. If at
+    -- some point we want to allows mockchain runs with validation errors, the
+    -- caller will need to catch those errors and do something with them.
+    case Emulator.validateCardanoTx newParams eLedgerState cardanoTx of
+      -- In case of a phase 1 error, we give back the same index
+      (_, Ledger.FailPhase1 _ err) -> throw $ MCEValidationError Ledger.Phase1 err
+      (newELedgerState, Ledger.FailPhase2 _ err _) | Just (colInputs, retColUser) <- mCollaterals -> do
+        -- We update the emulated ledger state
+        modify' (set mcstLedgerStateL newELedgerState)
+        -- We remove the collateral utxos from our own stored outputs
+        forM_ colInputs $ modify' . removeOutput
+        -- We add the returned collateral to our outputs (in practice this map
+        -- either contains no element, or a single one)
+        forM_ (Map.toList $ Ledger.getCardanoTxProducedReturnCollateral cardanoTx) $ \(txIn, txOut) ->
+          modify' $
+            addOutput
+              (Ledger.fromCardanoTxIn txIn)
+              (retColUser `receives` Value (Api.txOutValue . Ledger.fromCardanoTxOutToPV2TxInfoTxOut . Ledger.getTxOut $ txOut))
+        -- We throw a mockchain error
+        throw $ MCEValidationError Ledger.Phase2 err
+      -- In case of success, we update the index with all inputs and outputs
+      -- contained in the transaction
+      (newELedgerState, Ledger.Success {}) -> do
+        -- We update the index with the utxos consumed and produced by the tx
+        modify' (set mcstLedgerStateL newELedgerState)
+        -- We retrieve the utxos created by the transaction
+        let utxos = Ledger.fromCardanoTxIn . snd <$> Ledger.getCardanoTxOutRefs cardanoTx
+        -- We add the news utxos to the state
+        forM_ (zip utxos (txSkelOuts finalTxSkel)) $ modify' . uncurry addOutput
+        -- And remove the old ones
+        forM_ (Map.toList $ txSkelIns finalTxSkel) $ modify' . removeOutput . fst
+      -- This is a theoretical unreachable case. Since we fail in Phase 2, it
+      -- means the transaction involved script, and thus we must have generated
+      -- collaterals.
+      (_, Ledger.FailPhase2 {})
+        | Nothing <- mCollaterals ->
+            fail "Unreachable case when processing validation result, please report a bug at https://github.com/tweag/cooked-validators/issues"
+    -- We apply a change of slot when requested in the options
+    when txSkelOptAutoSlotIncrease $ modify' (over mcstLedgerStateL Emulator.nextSlot)
+    -- We return the parameters to their original state
+    modify $ set mcstParamsL oldParams
+    modify $ over mcstLedgerStateL $ Emulator.updateStateParams oldParams
+    -- We log the validated transaction
+    logEvent $ MCLogNewTx (Ledger.fromCardanoTxId $ Ledger.getCardanoTxId cardanoTx) (fromIntegral $ length $ Ledger.getCardanoTxOutRefs cardanoTx)
+    -- We return the validated transaction
+    return cardanoTx
 
 -- | Waits a certain number of slots and returns the new slot
 waitNSlots :: (Member MockChainWrite effs) => Integer -> Sem effs Ledger.Slot
@@ -140,7 +304,7 @@ validateTxSkel :: (Member MockChainWrite effs) => TxSkel -> Sem effs Ledger.Card
 
 -- | Same as `validateTxSkel`, but only returns the generated UTxOs
 validateTxSkel' :: (Members '[MockChainRead, MockChainWrite] effs) => TxSkel -> Sem effs [Api.TxOutRef]
-validateTxSkel' = ((fmap fst <$>) . utxosFromCardanoTx) <=< validateTxSkel
+validateTxSkel' = (fmap fst <$>) . utxosFromCardanoTx <=< validateTxSkel
 
 -- | Same as `validateTxSkel`, but discards the returned transaction
 validateTxSkel_ :: (Member MockChainWrite effs) => TxSkel -> Sem effs ()
diff --git a/src/Cooked/Tweak.hs b/src/Cooked/Tweak.hs
index 243ca9aab..0257eaa40 100644
--- a/src/Cooked/Tweak.hs
+++ b/src/Cooked/Tweak.hs
@@ -3,16 +3,11 @@
 -- time using `Cooked.Ltl`
 module Cooked.Tweak (module X) where
 
-import Cooked.Tweak.Common as X hiding
-  ( Tweak,
-    UntypedTweak,
-    runTweakInChain,
-    runTweakInChain',
-  )
+import Cooked.Tweak.Common as X
 import Cooked.Tweak.Inputs as X
 import Cooked.Tweak.Labels as X
 import Cooked.Tweak.Mint as X
-import Cooked.Tweak.OutPermutations as X hiding (distinctPermutations)
+import Cooked.Tweak.OutPermutations as X
 import Cooked.Tweak.Outputs as X
 import Cooked.Tweak.Signatories as X
 import Cooked.Tweak.ValidityRange as X
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index c1aec7595..68844196c 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- | This module defines 'Tweak's which are the building blocks of our DSL for
@@ -8,9 +7,6 @@ module Cooked.Tweak.Common
     Tweak (..),
     runTweak,
 
-    -- * Untyped tweaks
-    UntypedTweak (..),
-
     -- * Optics
     selectP,
 
@@ -63,15 +59,6 @@ runTweak txSkel =
           PutTxSkel skel -> put skel
       )
 
--- | Untyped tweaks are tweaks that will be deployed in time using
--- `Cooked.Ltl`. They encompass a computation which can branch and has access to
--- a `TxSkel` on top of other effects.
-data UntypedTweak effs where
-  UntypedTweak ::
-    (Members tweakEffs effs) =>
-    Sem (Tweak : NonDet : effs) a ->
-    UntypedTweak effs
-
 -- | Retrieves some value from the 'TxSkel'
 viewTweak ::
   (Member Tweak effs, Is k A_Getter) =>

From 7971f23284a423acfb968a112db00e88b73dcfb1 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 23 Jan 2026 00:28:23 +0100
Subject: [PATCH 36/96] pretty

---
 src/Cooked/MockChain.hs        |  1 -
 src/Cooked/Pretty/MockChain.hs | 15 ++++++---------
 2 files changed, 6 insertions(+), 10 deletions(-)

diff --git a/src/Cooked/MockChain.hs b/src/Cooked/MockChain.hs
index d591cc91e..11ea3f79c 100644
--- a/src/Cooked/MockChain.hs
+++ b/src/Cooked/MockChain.hs
@@ -5,7 +5,6 @@ module Cooked.MockChain (module X) where
 import Cooked.MockChain.AutoFilling as X
 import Cooked.MockChain.Balancing as X
 import Cooked.MockChain.Common as X
-import Cooked.MockChain.Direct as X
 import Cooked.MockChain.Error as X
 import Cooked.MockChain.Instances as X
 import Cooked.MockChain.Misc as X
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 38b9feac2..55b172ea8 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -4,8 +4,9 @@
 -- 'PrettyCookedMaybe' instances for data types returned by a @MockChain@ run.
 module Cooked.Pretty.MockChain () where
 
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.Direct
+import Cooked.MockChain.Error
+import Cooked.MockChain.Instances
+import Cooked.MockChain.Log
 import Cooked.MockChain.UtxoState
 import Cooked.Pretty.Class
 import Cooked.Pretty.Options
@@ -64,12 +65,8 @@ instance PrettyCooked MockChainError where
         "Percentage in params was" <+> prettyCookedOpt opts percentage,
         "Resulting minimal collateral value was" <+> prettyCookedOpt opts colVal
       ]
-  prettyCookedOpt opts (MCEToCardanoError msg cardanoError) =
-    prettyItemize @[DocCooked]
-      opts
-      "Transaction generation error:"
-      "-"
-      [PP.pretty msg, PP.pretty cardanoError]
+  prettyCookedOpt _ (MCEToCardanoError cardanoError) =
+    "Transaction generation error:" <+> PP.pretty cardanoError
   prettyCookedOpt opts (MCEUnknownOutRef txOutRef) = "Unknown transaction output ref:" <+> prettyCookedOpt opts txOutRef
   prettyCookedOpt opts (MCEWrongReferenceScriptError oRef expected got) =
     "Unable to fetch the following reference script:"
@@ -84,7 +81,7 @@ instance PrettyCooked MockChainError where
       <+> PP.viaShow current
       <+> "; target slot:"
       <+> PP.viaShow target
-  prettyCookedOpt _ (FailWith msg) = "Failed with:" <+> PP.pretty msg
+  prettyCookedOpt _ (MCEFailure msg) = "Failed with:" <+> PP.pretty msg
 
 instance PrettyCooked (Contextualized [MockChainLogEntry]) where
   prettyCookedOpt opts (Contextualized outputs entries) =

From 37adaf54aa4a4a6be0b8c4b4a1524cc48dba4283 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 23 Jan 2026 00:40:58 +0100
Subject: [PATCH 37/96] starting Testing.hs

---
 src/Cooked/MockChain/Testing.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 2df19d739..eb6182074 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -5,9 +5,9 @@ module Cooked.MockChain.Testing where
 import Control.Exception qualified as E
 import Control.Monad
 import Cooked.InitialDistribution
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.Direct
-import Cooked.MockChain.Staged
+import Cooked.MockChain.Error
+import Cooked.MockChain.Instances
+import Cooked.MockChain.Log
 import Cooked.MockChain.UtxoState
 import Cooked.Pretty
 import Data.Default

From 07d8971f063dba1615c8d4afa77ad4f572a3ec1d Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 23 Jan 2026 17:38:15 +0100
Subject: [PATCH 38/96] main sources fully transformed

---
 src/Cooked/Attack/DatumHijacking.hs |   3 +-
 src/Cooked/Families.hs              |  18 ++
 src/Cooked/Ltl.hs                   |  12 +-
 src/Cooked/MockChain/AutoFilling.hs |   9 +-
 src/Cooked/MockChain/Balancing.hs   |  17 +-
 src/Cooked/MockChain/Read.hs        |   8 +-
 src/Cooked/MockChain/Testing.hs     |  22 +-
 src/Cooked/MockChain/UtxoSearch.hs  | 356 +++++++++++++++++-----------
 src/Cooked/MockChain/Write.hs       |  87 ++++++-
 9 files changed, 360 insertions(+), 172 deletions(-)

diff --git a/src/Cooked/Attack/DatumHijacking.hs b/src/Cooked/Attack/DatumHijacking.hs
index 3f4d77003..e29ac64d5 100644
--- a/src/Cooked/Attack/DatumHijacking.hs
+++ b/src/Cooked/Attack/DatumHijacking.hs
@@ -18,9 +18,10 @@ where
 
 import Control.Monad
 import Cooked.Pretty.Class
+import Cooked.Pretty.Skeleton ()
 import Cooked.Skeleton
-import Cooked.Tweak
 import Cooked.Tweak.Common
+import Cooked.Tweak.Labels
 import Data.Bifunctor
 import Data.Kind (Type)
 import Data.Maybe
diff --git a/src/Cooked/Families.hs b/src/Cooked/Families.hs
index 0e5e1f4df..06adaad6b 100644
--- a/src/Cooked/Families.hs
+++ b/src/Cooked/Families.hs
@@ -18,6 +18,11 @@ module Cooked.Families
     type RevAux,
     type Member,
     type NonMember,
+
+    -- * Heterogeneous lists
+    HList (..),
+    hHead,
+    hTail,
   )
 where
 
@@ -70,3 +75,16 @@ type (∉) el els = NonMember el els '[]
 type family (⩀) (els :: [a]) (els' :: [a]) :: Constraint where
   '[] ⩀ _ = ()
   (x ': xs) ⩀ ys = (x ∉ ys, xs ⩀ ys)
+
+-- | Heterogeneous lists
+data HList :: [Type] -> Type where
+  HEmpty :: HList '[]
+  HCons :: a -> HList l -> HList (a ': l)
+
+-- | Head of an heterogeneous list
+hHead :: HList (a ': l) -> a
+hHead (HCons a _) = a
+
+-- | Tail of an heterogeneous list
+hTail :: HList (a ': l) -> HList l
+hTail (HCons _ l) = l
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index f74d68fb3..264bcf837 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -31,11 +31,15 @@ module Cooked.Ltl
     ltlNever,
     ltlNever',
 
-    -- * LTL Effects
+    -- * Requirements from a formula
     Requirement (..),
+
+    -- * Modifying a computation on time
     ModifyGlobally,
     modifyLtl,
     runModifyGlobally,
+
+    -- * Fetching the current requirements
     ModifyLocally,
     getRequirements,
     runModifyLocally,
@@ -318,14 +322,14 @@ makeSem ''ModifyGlobally
 -- the actual computation is run, after which the newly added formula must be
 -- finished, otherwise the empty computation is returned.
 runModifyGlobally ::
-  forall modification effs a.
+  forall mod effs a.
   ( Members
-      '[ State [Ltl modification],
+      '[ State [Ltl mod],
          NonDet
        ]
       effs
   ) =>
-  Sem (ModifyGlobally modification ': effs) a ->
+  Sem (ModifyGlobally mod ': effs) a ->
   Sem effs a
 runModifyGlobally =
   interpretH $ \case
diff --git a/src/Cooked/MockChain/AutoFilling.hs b/src/Cooked/MockChain/AutoFilling.hs
index 1588714c7..a989aa9b6 100644
--- a/src/Cooked/MockChain/AutoFilling.hs
+++ b/src/Cooked/MockChain/AutoFilling.hs
@@ -9,6 +9,7 @@ import Control.Monad
 import Cooked.MockChain.GenerateTx.Output
 import Cooked.MockChain.Log
 import Cooked.MockChain.Read
+import Cooked.MockChain.UtxoSearch
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Data.List (find)
@@ -75,7 +76,7 @@ autoFillConstitution = do
 -- given script hash, and attaches it to a redeemer when it does not yet have a
 -- reference input and when it is allowed, in which case an event is logged.
 updateRedeemedScript ::
-  (Member MockChainLog effs) =>
+  (Members '[MockChainLog, MockChainRead] effs) =>
   [Api.TxOutRef] ->
   User IsScript Redemption ->
   Sem effs (User IsScript Redemption)
@@ -85,7 +86,7 @@ updateRedeemedScript
          (toVScript -> vScript)
          txSkelRed@(TxSkelRedeemer {txSkelRedeemerAutoFill = True})
        ) = do
-    oRefsInInputs <- undefined -- runUtxoSearch (referenceScriptOutputsSearch vScript)
+    oRefsInInputs <- getTxOutRefs $ allUtxosSearch $ ensureProperReferenceScript vScript
     maybe
       -- We leave the redeemer unchanged if no reference input was found
       (return rs)
@@ -97,9 +98,9 @@ updateRedeemedScript
       $ case oRefsInInputs of
         [] -> Nothing
         -- If possible, we use a reference input appearing in regular inputs
-        l | Just (oRefM', _) <- find (\(r, _) -> r `elem` inputs) l -> Just oRefM'
+        l | Just oRefM' <- find (`elem` inputs) l -> Just oRefM'
         -- If none exist, we use the first one we find elsewhere
-        ((oRefM', _) : _) -> Just oRefM'
+        (oRefM' : _) -> Just oRefM'
 updateRedeemedScript _ rs = return rs
 
 -- | Goes through the various parts of the skeleton where a redeemer can appear,
diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 9eb4b7bb8..3ee317656 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -21,6 +21,7 @@ import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Body
 import Cooked.MockChain.Log
 import Cooked.MockChain.Read
+import Cooked.MockChain.UtxoSearch
 import Cooked.Skeleton
 import Data.Bifunctor
 import Data.Function
@@ -82,10 +83,12 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
       (True, CollateralUtxosFromUser cUser) -> logEvent (MCLogUnusedCollaterals $ Left $ UserPubKey cUser) >> return Nothing
       (True, CollateralUtxosFromBalancingUser) -> return Nothing
       (False, CollateralUtxosFromSet utxos rUser) -> return $ Just (utxos, UserPubKey rUser)
-      (False, CollateralUtxosFromUser cUser) -> Just . (,UserPubKey cUser) . Set.fromList . map fst <$> undefined -- runUtxoSearch (onlyValueOutputsAtSearch $ Script.toPubKeyHash cUser)
+      (False, CollateralUtxosFromUser (Script.toPubKeyHash -> cUser)) ->
+        Just . (,UserPubKey cUser) . Set.fromList
+          <$> getTxOutRefs (utxosAtSearch cUser ensureOnlyValueOutputs)
       (False, CollateralUtxosFromBalancingUser) -> case balancingUser of
         Nothing -> throw $ MCEMissingBalancingUser "Collateral utxos should be taken from the balancing user, but it does not exist."
-        Just bUser -> Just . (,bUser) . Set.fromList . map fst <$> undefined -- runUtxoSearch (onlyValueOutputsAtSearch bUser)
+        Just bUser -> Just . (,bUser) . Set.fromList <$> getTxOutRefs (utxosAtSearch bUser ensureOnlyValueOutputs)
 
   -- At this point, the presence (or absence) of balancing user dictates
   -- whether the transaction should be automatically balanced or not.
@@ -102,12 +105,12 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
       -- utxos based on the associated policy
       balancingUtxos <-
         case txSkelOptBalancingUtxos txSkelOpts of
-          BalancingUtxosFromBalancingUser -> undefined -- runUtxoSearch $ onlyValueOutputsAtSearch bUser
+          BalancingUtxosFromBalancingUser -> getTxOutRefsAndOutputs $ utxosAtSearch bUser ensureOnlyValueOutputs
           BalancingUtxosFromSet utxos ->
             -- We resolve the given set of utxos
-            undefined -- runUtxoSearch (txSkelOutByRefSearch (Set.toList utxos))
-            -- We filter out those belonging to scripts, while throwing a
-            -- warning if any was actually discarded.
+            getTxOutRefsAndOutputs (txSkelOutByRefSearch (Set.toList utxos) id)
+              -- We filter out those belonging to scripts, while throwing a
+              -- warning if any was actually discarded.
               >>= filterAndWarn (is (txSkelOutOwnerL % userPubKeyHashAT) . snd) "They belong to scripts."
           -- We filter the candidate utxos by removing those already present in the
           -- skeleton, throwing a warning if any was actually discarded
@@ -260,7 +263,7 @@ collateralInsFromFees fee collateralIns returnCollateralUser = do
   -- add one because of ledger requirement which seem to round up this value.
   let totalCollateral = Script.lovelace . (+ 1) . (`div` 100) . (* percentage) $ fee
   -- Collateral tx outputs sorted by decreasing ada amount
-  collateralTxOuts <- undefined -- runUtxoSearch (txSkelOutByRefSearch $ Set.toList collateralIns)
+  collateralTxOuts <- getTxOutRefsAndOutputs $ txSkelOutByRefSearch (Set.toList collateralIns) id
   -- Candidate subsets of utxos to be used as collaterals
   let candidatesRaw = reachValue collateralTxOuts totalCollateral nbMax
   -- Preparing a possible collateral error
diff --git a/src/Cooked/MockChain/Read.hs b/src/Cooked/MockChain/Read.hs
index 80be3326c..d282fbc6b 100644
--- a/src/Cooked/MockChain/Read.hs
+++ b/src/Cooked/MockChain/Read.hs
@@ -77,7 +77,7 @@ data MockChainRead :: Effect where
   TxSkelOutByRef :: Api.TxOutRef -> MockChainRead m TxSkelOut
   CurrentSlot :: MockChainRead m Ledger.Slot
   AllUtxos :: MockChainRead m Utxos
-  UtxosAt :: (Script.ToAddress a) => a -> MockChainRead m Utxos
+  UtxosAt :: (Script.ToCredential a) => a -> MockChainRead m Utxos
   GetConstitutionScript :: MockChainRead m (Maybe VScript)
   GetCurrentReward :: (Script.ToCredential c) => c -> MockChainRead m (Maybe Api.Lovelace)
 
@@ -103,7 +103,7 @@ runMockChainRead = interpret $ \case
       Just (txSkelOut, True) -> return txSkelOut
       _ -> throw $ MCEUnknownOutRef oRef
   AllUtxos -> fetchUtxos $ const True
-  UtxosAt (Script.toAddress -> addr) -> fetchUtxos $ (== addr) . Script.toAddress
+  UtxosAt (Script.toCredential -> cred) -> fetchUtxos $ (== cred) . Script.toCredential
   CurrentSlot -> gets $ view $ mcstLedgerStateL % to Emulator.getSlot
   GetConstitutionScript -> gets $ view mcstConstitutionL
   GetCurrentReward (Script.toCredential -> cred) -> do
@@ -338,9 +338,9 @@ allUtxos ::
 -- | Returns a list of all UTxOs at a certain address.
 utxosAt ::
   ( Member MockChainRead effs,
-    Script.ToAddress a
+    Script.ToCredential cred
   ) =>
-  a ->
+  cred ->
   Sem effs Utxos
 
 -- | Returns an output given a reference to it
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index eb6182074..a49eccd32 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -186,10 +186,10 @@ type StateProp prop = PrettyCookedOpts -> UtxoState -> prop
 -- enforced here, but it will often be assumed that @prop@ satisfies 'IsProp'.
 data Test a prop = Test
   { -- | The mockchain trace to test, which returns a result of type a
-    testTrace :: StagedMockChain a,
+    testTrace :: MockChainFull a,
     -- | The initial distribution from which the trace should be run
     testInitDist :: InitialDistribution,
-    -- | The requirement on the number of results, as 'StagedMockChain' is a
+    -- | The requirement on the number of results, as 'MockChainFull' is a
     -- 'Control.Monad.MonadPlus'
     testSizeProp :: SizeProp prop,
     -- | The property that should hold in case of failure over the resulting
@@ -210,7 +210,7 @@ data Test a prop = Test
 -- to pretty print messages when applicable.
 testToProp :: (IsProp prop, Show a) => Test a prop -> prop
 testToProp Test {..} =
-  let results = interpretAndRunWith (runMockChainTFromInitDist testInitDist) testTrace
+  let results = runMockChainConf $ (mockChainConfFullTemplate testTrace) {mccInitialDistribution = testInitDist}
    in testSizeProp (toInteger (length results))
         .&&. testAll
           ( \ret@(MockChainReturn outcome _ state mcLog names) ->
@@ -237,7 +237,7 @@ testCookedQC name = QC.testProperty name . testToProp
 -- * Simple test templates
 
 -- | A test template which expects a success from a trace
-mustSucceedTest :: (IsProp prop) => StagedMockChain a -> Test a prop
+mustSucceedTest :: (IsProp prop) => MockChainFull a -> Test a prop
 mustSucceedTest trace =
   Test
     { testTrace = trace,
@@ -249,7 +249,7 @@ mustSucceedTest trace =
     }
 
 -- | A test template which expects a failure from a trace
-mustFailTest :: (IsProp prop) => StagedMockChain a -> Test a prop
+mustFailTest :: (IsProp prop) => MockChainFull a -> Test a prop
 mustFailTest trace =
   Test
     { testTrace = trace,
@@ -413,25 +413,25 @@ possesses w ac n = isAtAddress [(w, [(ac, (== n))])]
 --}
 
 -- | A test template which expects a Phase 2 failure
-mustFailInPhase2Test :: (IsProp prop) => StagedMockChain a -> Test a prop
+mustFailInPhase2Test :: (IsProp prop) => MockChainFull a -> Test a prop
 mustFailInPhase2Test run = mustFailTest run `withFailureProp` isPhase2Failure
 
 -- | A test template which expects a specific phase 2 error message
-mustFailInPhase2WithMsgTest :: (IsProp prop) => String -> StagedMockChain a -> Test a prop
+mustFailInPhase2WithMsgTest :: (IsProp prop) => String -> MockChainFull a -> Test a prop
 mustFailInPhase2WithMsgTest msg run = mustFailTest run `withFailureProp` isPhase2FailureWithMsg msg
 
 -- | A test template which expects a Phase 1 failure
-mustFailInPhase1Test :: (IsProp prop) => StagedMockChain a -> Test a prop
+mustFailInPhase1Test :: (IsProp prop) => MockChainFull a -> Test a prop
 mustFailInPhase1Test run = mustFailTest run `withFailureProp` isPhase1Failure
 
 -- | A test template which expects a specific phase 1 error message
-mustFailInPhase1WithMsgTest :: (IsProp prop) => String -> StagedMockChain a -> Test a prop
+mustFailInPhase1WithMsgTest :: (IsProp prop) => String -> MockChainFull a -> Test a prop
 mustFailInPhase1WithMsgTest msg run = mustFailTest run `withFailureProp` isPhase1FailureWithMsg msg
 
 -- | A test template which expects a certain number of successful outcomes
-mustSucceedWithSizeTest :: (IsProp prop) => Integer -> StagedMockChain a -> Test a prop
+mustSucceedWithSizeTest :: (IsProp prop) => Integer -> MockChainFull a -> Test a prop
 mustSucceedWithSizeTest size run = mustSucceedTest run `withSizeProp` (testBool . (== size))
 
 -- | A test template which expects a certain number of unsuccessful outcomes
-mustFailWithSizeTest :: (IsProp prop) => Integer -> StagedMockChain a -> Test a prop
+mustFailWithSizeTest :: (IsProp prop) => Integer -> MockChainFull a -> Test a prop
 mustFailWithSizeTest size run = mustFailTest run `withSizeProp` isOfSize size
diff --git a/src/Cooked/MockChain/UtxoSearch.hs b/src/Cooked/MockChain/UtxoSearch.hs
index e377df67b..225f226d5 100644
--- a/src/Cooked/MockChain/UtxoSearch.hs
+++ b/src/Cooked/MockChain/UtxoSearch.hs
@@ -1,149 +1,229 @@
--- | This module provides a convenient framework to look through UTxOs and
--- search relevant ones based on predicates. For instance, it makes it very
--- convenient to gather all UTxOs at a certain address.
+-- | This module provides a convenient framework to look through UTxOs and:
+-- - filter them in a convenient manner
+-- - extract pieces of information from them
 module Cooked.MockChain.UtxoSearch
-  ( UtxoSearch,
-    runUtxoSearch,
+  ( -- * UTxO searches
+    UtxoSearchResult,
+    UtxoSearch,
+    beginSearch,
+    getOutputs,
+    getOutputsAndExtracts,
+    getTxOutRefs,
+    getTxOutRefsAndOutputs,
+
+    -- * Basic UTxO searches
+    utxosAtSearch,
     allUtxosSearch,
-    utxosOwnedBySearch,
-    utxosFromCardanoTxSearch,
     txSkelOutByRefSearch,
-    filterWith,
-    filterWithPure,
-    filterWithOptic,
-    filterWithPred,
-    filterWithValuePred,
-    filterWithOnlyAda,
-    filterWithNotOnlyAda,
-    onlyValueOutputsAtSearch,
-    vanillaOutputsAtSearch,
-    filterWithAlways,
-    referenceScriptOutputsSearch,
-    filterWithPureRev,
+
+    -- * Extracting new information from UTxOs
+    extract,
+    extractPure,
+    extractAFold,
+    extractTotal,
+    extractPureTotal,
+    extractGetter,
+
+    -- * Filtering some UTxOs out
+    ensure,
+    ensurePure,
+    ensureAFoldIs,
+    ensureAFoldIsn't,
+
+    -- * Cooked filters
+    ensureOnlyValueOutputs,
+    ensureVanillaOutputs,
+    ensureProperReferenceScript,
   )
 where
 
-import Control.Monad
-import Cooked.MockChain.BlockChain
-import Cooked.Skeleton
+import Control.Monad (filterM, forM)
+import Cooked.Families hiding (Member)
+import Cooked.MockChain.Common
+import Cooked.MockChain.Read
+import Cooked.Skeleton.Datum
+import Cooked.Skeleton.Output
+import Cooked.Skeleton.Value
+import Data.Functor
 import Data.Maybe
-import Ledger.Tx qualified as Ledger
-import ListT (ListT (..))
-import ListT qualified
 import Optics.Core
+import Optics.Core.Extras
 import Plutus.Script.Utils.Address qualified as Script
 import Plutus.Script.Utils.Scripts qualified as Script
-import Plutus.Script.Utils.Value qualified as Script
-import PlutusLedgerApi.V1.Value qualified as Api
 import PlutusLedgerApi.V3 qualified as Api
-
--- * The type of UTxO searches
-
--- | If a UTxO is a 'Api.TxOutRef' with some additional information, this type
--- captures a "stream" of UTxOs.
-type UtxoSearch m a = ListT m (Api.TxOutRef, a)
-
--- | Given a UTxO search, we can run it to obtain a list of UTxOs.
-runUtxoSearch :: (Monad m) => UtxoSearch m a -> m [(Api.TxOutRef, a)]
-runUtxoSearch = ListT.toList
-
--- * Initial UTxO searches
-
--- | Search all currently known 'Api.TxOutRef's together with their corresponding
--- 'Api.TxOut'.
-allUtxosSearch :: (MonadBlockChain m) => UtxoSearch m TxSkelOut
-allUtxosSearch = allUtxos >>= ListT.fromFoldable
-
--- | Search all 'Api.TxOutRef's at a certain address, together with their
--- 'Api.TxOut'. This will attempt to cast the owner of the 'TxSkelOut' to @addr@
--- so be careful how you use it.
-utxosOwnedBySearch :: (MonadBlockChainBalancing m, Script.ToAddress addr) => addr -> UtxoSearch m TxSkelOut
-utxosOwnedBySearch = utxosAt . Script.toAddress >=> ListT.fromFoldable
-
--- | Search all 'Cooked.Skelelton.Output.TxSkelOut's corresponding to given the list of
--- 'Api.TxOutRef's. Any 'Api.TxOutRef' that doesn't correspond to a known output
--- will be filtered out.
-txSkelOutByRefSearch :: (MonadBlockChainBalancing m) => [Api.TxOutRef] -> UtxoSearch m TxSkelOut
-txSkelOutByRefSearch orefs =
-  ListT.traverse (\o -> return (o, o)) (ListT.fromFoldable orefs)
-    `filterWith` ((Just <$>) . txSkelOutByRef)
-
--- | Search all 'Api.TxOutRef's of a transaction, together with their
--- 'Api.TxOut'.
-utxosFromCardanoTxSearch :: (MonadBlockChainBalancing m) => Ledger.CardanoTx -> UtxoSearch m TxSkelOut
-utxosFromCardanoTxSearch = utxosFromCardanoTx >=> ListT.fromFoldable
-
--- * filtering UTxO searches
-
--- | Transform a 'UtxoSearch' by applying a possibly partial monadic
--- transformation on each output in the stream
-filterWith :: (Monad m) => UtxoSearch m a -> (a -> m (Maybe b)) -> UtxoSearch m b
-filterWith (ListT as) f =
-  ListT $
-    as >>= \case
-      Nothing -> return Nothing
-      Just ((oref, a), rest) ->
-        let filteredRest@(ListT bs) = filterWith rest f
-         in f a >>= \case
-              Nothing -> bs
-              Just b -> return $ Just ((oref, b), filteredRest)
-
--- | Same as 'filterWith' but with a pure transformation
-filterWithPure :: (Monad m) => UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m b
-filterWithPure as f = filterWith as (return . f)
-
--- | Some as 'filterWithPure' but with a total transformation
-filterWithAlways :: (Monad m) => UtxoSearch m a -> (a -> b) -> UtxoSearch m b
-filterWithAlways as f = filterWithPure as (Just . f)
-
--- | Some as 'filterWithPure', but the transformation is taken from an optic
-filterWithOptic :: (Is k An_AffineFold, Monad m) => UtxoSearch m a -> Optic' k is a b -> UtxoSearch m b
-filterWithOptic as optic = filterWithPure as (^? optic)
-
--- | Same as 'filterWithPure' but the outputs are selected using a boolean
--- predicate, and not modified
-filterWithPred :: (Monad m) => UtxoSearch m a -> (a -> Bool) -> UtxoSearch m a
-filterWithPred as f = filterWithPure as $ \a -> if f a then Just a else Nothing
-
--- | Same as 'filterWithPure' but inverses the predicate
-filterWithPureRev :: (Monad m) => UtxoSearch m a -> (a -> Maybe b) -> UtxoSearch m a
-filterWithPureRev as = filterWithPred as . (isNothing .)
-
--- | A specific version of 'filterWithPred' where outputs must me of type
--- 'TxSkelOut' and the predicate only relies on their value
-filterWithValuePred :: (Monad m) => UtxoSearch m TxSkelOut -> (Api.Value -> Bool) -> UtxoSearch m TxSkelOut
-filterWithValuePred as f = filterWithPred as (f . view txSkelOutValueL)
-
--- | A specific version of 'filterWithValuePred' when 'TxSkelOut's are only kept
--- when they contain only ADA
-filterWithOnlyAda :: (Monad m) => UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
-filterWithOnlyAda as = filterWithValuePred as Script.isAdaOnlyValue
-
--- | A specific version of 'filterWithValuePred' when 'TxSkelOut's are only kept
--- when they contain non-ADA assets
-filterWithNotOnlyAda :: (Monad m) => UtxoSearch m TxSkelOut -> UtxoSearch m TxSkelOut
-filterWithNotOnlyAda as = filterWithValuePred as (not . Script.isAdaOnlyValue)
-
--- * Useful composite UTxO searches with filters already applied
-
--- | Search for UTxOs at a specific address, which only carry address and value
--- information (no datum, staking credential, or reference script).
-onlyValueOutputsAtSearch :: (MonadBlockChainBalancing m, Script.ToAddress addr) => addr -> UtxoSearch m TxSkelOut
-onlyValueOutputsAtSearch addr =
-  utxosOwnedBySearch addr
-    `filterWithPureRev` preview (txSkelOutDatumL % txSkelOutDatumKindAT)
-    `filterWithPureRev` view txSkelOutMStakingCredentialL
-    `filterWithPureRev` view txSkelOutMReferenceScriptL
-
--- | Same as 'onlyValueOutputsAtSearch', but also ensures the returned outputs
--- do not contain non-ADA assets. These "vanilla" outputs are perfect candidates
--- to be used for balancing transaction and attaching collaterals.
-vanillaOutputsAtSearch :: (MonadBlockChainBalancing m, Script.ToAddress addr) => addr -> UtxoSearch m TxSkelOut
-vanillaOutputsAtSearch = filterWithOnlyAda . onlyValueOutputsAtSearch
-
--- | Searches for all outputs containing a given script as reference script
-referenceScriptOutputsSearch ::
-  (MonadBlockChain m, Script.ToScriptHash s) => s -> UtxoSearch m TxSkelOut
-referenceScriptOutputsSearch s =
-  allUtxosSearch
-    `filterWithPred` ((Just (Script.toScriptHash s) ==) . preview txSkelOutReferenceScriptHashAF)
+import Polysemy
+
+type UtxoSearchResult elems = [(Api.TxOutRef, HList (TxSkelOut ': elems))]
+
+-- | A `UtxoSearch` is a computation that returns a list of UTxOs alongside
+-- their `TxSkelOut` counterpart and a list of other elements retrieved from the
+-- output. The idea is to begin with a simple search and refine the search with
+-- filters while appending new elements to the list.
+type UtxoSearch effs elems = Sem effs (UtxoSearchResult elems)
+
+-- | Wraps up a computation returning a `Utxos` into a `UtxoSearch`
+beginSearch ::
+  Sem effs Utxos ->
+  UtxoSearch effs '[]
+beginSearch = fmap (fmap (fmap (`HCons` HEmpty)))
+
+-- | Retrieves the `TxSkelOut`s from a `UtxoSearchResult`
+getOutputs ::
+  Sem effs (UtxoSearchResult elems) ->
+  Sem effs [TxSkelOut]
+getOutputs = fmap (fmap (hHead . snd))
+
+-- | Retrieves the `TxSkelOut`s from a `UtxoSearchResult` alongside the
+-- extracted elements
+getOutputsAndExtracts ::
+  Sem effs (UtxoSearchResult elems) ->
+  Sem effs [HList (TxSkelOut ': elems)]
+getOutputsAndExtracts = fmap (fmap snd)
+
+-- | Retrieves the `Api.TxOutRef`s from a `UtxoSearchResult`
+getTxOutRefs ::
+  Sem effs (UtxoSearchResult elems) ->
+  Sem effs [Api.TxOutRef]
+getTxOutRefs = fmap (fmap fst)
+
+-- | Retrieves both the `Api.TxOutRef`s and `TxSkelOut`s from a `UtxoSearchResult`
+getTxOutRefsAndOutputs ::
+  Sem effs (UtxoSearchResult elems) ->
+  Sem effs Utxos
+getTxOutRefsAndOutputs = fmap (fmap (\(oRef, HCons output _) -> (oRef, output)))
+
+-- | Searches for utxos at a given address with a given filter
+utxosAtSearch ::
+  (Member MockChainRead effs, Script.ToCredential pkh) =>
+  pkh ->
+  (UtxoSearch effs '[] -> UtxoSearch effs els) ->
+  UtxoSearch effs els
+utxosAtSearch pkh filters = filters $ beginSearch $ utxosAt pkh
+
+-- | Searches for all the known utxos with a given filter
+allUtxosSearch ::
+  (Member MockChainRead effs) =>
+  (UtxoSearch effs '[] -> UtxoSearch effs els) ->
+  UtxoSearch effs els
+allUtxosSearch filters = filters $ beginSearch allUtxos
+
+-- | Searches for utxos belonging to a given list
+txSkelOutByRefSearch ::
+  (Member MockChainRead effs) =>
+  [Api.TxOutRef] ->
+  (UtxoSearch effs '[] -> UtxoSearch effs els) ->
+  UtxoSearch effs els
+txSkelOutByRefSearch utxos filters = filters $ beginSearch (zip utxos <$> mapM txSkelOutByRef utxos)
+
+-- | Extracts a new element from the currently selected outputs, filtering in
+-- the process out utxos for which this element is not available
+extract ::
+  (TxSkelOut -> Sem effs (Maybe b)) ->
+  UtxoSearch effs els ->
+  UtxoSearch effs (b ': els)
+extract extractFun comp = do
+  resl <- comp
+  resl' <- forM resl $
+    \(oRef, HCons txSkelOut other) -> do
+      res <- extractFun txSkelOut
+      return $ res <&> (\x -> (oRef, HCons txSkelOut (HCons x other)))
+  return $ catMaybes resl'
+
+-- | Same as `extract`, but with a pure extraction function
+extractPure ::
+  (TxSkelOut -> Maybe b) ->
+  UtxoSearch effs els ->
+  UtxoSearch effs (b ': els)
+extractPure = extract . (return .)
+
+-- | Same as `extractPure`, using an affine fold to extract the element
+extractAFold ::
+  (Is k An_AffineFold) =>
+  Optic' k is TxSkelOut b ->
+  UtxoSearch effs els ->
+  UtxoSearch effs (b ': els)
+extractAFold = extractPure . preview
+
+-- | Same as `extract`, but with a total extraction function
+extractTotal ::
+  (TxSkelOut -> Sem effs b) ->
+  UtxoSearch effs els ->
+  UtxoSearch effs (b ': els)
+extractTotal = extract . (fmap Just .)
+
+-- | Same as `extract`, but with a pure and total extraction function
+extractPureTotal ::
+  (TxSkelOut -> b) ->
+  UtxoSearch effs els ->
+  UtxoSearch effs (b ': els)
+extractPureTotal = extractTotal . (return .)
+
+-- | Same as `extractPureTotal`, using a getter to extract the element
+extractGetter ::
+  (Is k A_Getter) =>
+  Optic' k is TxSkelOut b ->
+  UtxoSearch effs els ->
+  UtxoSearch effs (b ': els)
+extractGetter = extractPureTotal . view
+
+-- | Ensures the outputs resulting from the search satisfy the given predicate
+ensure ::
+  (TxSkelOut -> Sem effs Bool) ->
+  UtxoSearch effs els ->
+  UtxoSearch effs els
+ensure filterF comp =
+  comp >>= filterM (filterF . hHead . snd)
+
+-- | Same as `ensure`, but with a pure predicate
+ensurePure ::
+  (TxSkelOut -> Bool) ->
+  UtxoSearch effs els ->
+  UtxoSearch effs els
+ensurePure = ensure . (return .)
+
+-- | Ensures the outputs resulting from the search contain the focus of the
+-- given affine fold
+ensureAFoldIs ::
+  (Is k An_AffineFold) =>
+  Optic' k is TxSkelOut b ->
+  UtxoSearch effs els ->
+  UtxoSearch effs els
+ensureAFoldIs = ensurePure . is
+
+-- | Ensures the outputs resulting from the search do not contain the focus of
+-- the given affine fold
+ensureAFoldIsn't ::
+  (Is k An_AffineFold) =>
+  Optic' k is TxSkelOut b ->
+  UtxoSearch effs els ->
+  UtxoSearch effs els
+ensureAFoldIsn't = ensurePure . isn't
+
+-- | Ensures the outputs resulting from the search do not have a reference
+-- script, nor a staking credential, nor a datum
+ensureOnlyValueOutputs ::
+  UtxoSearch effs els ->
+  UtxoSearch effs els
+ensureOnlyValueOutputs =
+  ensureAFoldIsn't txSkelOutMReferenceScriptL
+    . ensureAFoldIsn't txSkelOutMStakingCredentialL
+    . ensureAFoldIsn't (txSkelOutDatumL % txSkelOutDatumKindAT)
+
+-- | Same as 'onlyValueOutputsAtSearch', but also ensures the searched outputs
+-- do not contain non-ADA assets.
+ensureVanillaOutputs ::
+  UtxoSearch effs els ->
+  UtxoSearch effs els
+ensureVanillaOutputs =
+  ensureAFoldIs (txSkelOutValueL % valueLovelaceP)
+    . ensureOnlyValueOutputs
+
+-- | Ensures the outputs resulting from the search have the given script as a
+-- reference script
+ensureProperReferenceScript ::
+  (Script.ToScriptHash s) =>
+  s ->
+  UtxoSearch effs els ->
+  UtxoSearch effs els
+ensureProperReferenceScript (Script.toScriptHash -> sHash) =
+  ensureAFoldIs (txSkelOutReferenceScriptHashAF % filtered (== sHash))
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index 81cd910e7..cf474483c 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -6,9 +6,17 @@ module Cooked.MockChain.Write
   ( -- * The `MockChainWrite` effect
     MockChainWrite,
     reinterpretMockChainWriteWithTweak,
-    UntypedTweak (..),
     runMockChainWrite,
 
+    -- * Untyped tweaks and associated modalities
+    UntypedTweak (..),
+    somewhere,
+    everywhere,
+    nowhere,
+    whenAble,
+    there,
+    withTweak,
+
     -- * Modifications of the current time
     waitNSlots,
     awaitSlot,
@@ -72,10 +80,83 @@ data MockChainWrite :: Effect where
 
 makeSem_ ''MockChainWrite
 
+type TypedTweak tweakEffs a = Sem (Tweak : NonDet : tweakEffs) a
+
 -- | Wrapping up tweaks while hiding their return type and unsuring their stack
 -- of effects begins with `Tweak` and `NonDet`.
 data UntypedTweak tweakEffs where
-  UntypedTweak :: Sem (Tweak : NonDet : tweakEffs) a -> UntypedTweak tweakEffs
+  UntypedTweak :: TypedTweak tweakEffs a -> UntypedTweak tweakEffs
+
+fromTweak ::
+  TypedTweak tweakEffs a ->
+  Ltl (UntypedTweak tweakEffs)
+fromTweak = LtlAtom . UntypedTweak
+
+-- | Applies a 'Tweak' to every step in a trace where it is applicable,
+-- branching at any such locations. The tweak must apply at least once.
+somewhere ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs a ->
+  Sem effs a ->
+  Sem effs a
+somewhere = modifyLtl . ltlEventually . fromTweak
+
+-- | Applies a 'Tweak' to every transaction in a given trace. Fails if the tweak
+-- fails anywhere in the trace.
+everywhere ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs a ->
+  Sem effs a ->
+  Sem effs a
+everywhere = modifyLtl . ltlAlways . fromTweak
+
+-- | Ensures a given 'Tweak' can never successfully be applied in a computation,
+-- and leaves the computation unchanged.
+nowhere ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs a ->
+  Sem effs a ->
+  Sem effs a
+nowhere = modifyLtl . ltlNever . fromTweak
+
+-- | Apply a given 'Tweak' at every location in a computation where it does not
+-- fail, which might never occur.
+whenAble ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs a ->
+  Sem effs a ->
+  Sem effs a
+whenAble = modifyLtl . ltlWhenPossible . fromTweak
+
+-- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
+-- trace. Successful when this transaction exists and can be modified.
+--
+-- See also `Cooked.Tweak.Labels.labelled` to select transactions based on
+-- labels instead of their index.
+there ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  Integer ->
+  TypedTweak tweakEffs a ->
+  Sem effs a ->
+  Sem effs a
+there n = modifyLtl . ltlDelay n . fromTweak
+
+-- | Apply a 'Tweak' to the next transaction in the given trace. The order of
+-- arguments enables an idiom like
+--
+-- > do ...
+-- >    endpoint arguments `withTweak` someModification
+-- >    ...
+--
+-- where @endpoint@ builds and validates a single transaction depending on the
+-- given @arguments@. Then `withTweak` says "I want to modify the transaction
+-- returned by this endpoint in the following way".
+withTweak ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  Sem effs a ->
+  TypedTweak tweakEffs a ->
+  Sem effs a
+withTweak = flip (there 0)
 
 -- | Reinterpretes `MockChainWrite` in itself, when the `ModifyLocally` effect
 -- exists in the stack, applying the relevant modifications in the process.
@@ -93,7 +174,7 @@ reinterpretMockChainWriteWithTweak ::
 reinterpretMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
   ValidateTxSkel skel -> do
     requirements <- getRequirements
-    let sumTweak :: Sem (Tweak : NonDet : tweakEffs) () =
+    let sumTweak :: TypedTweak tweakEffs () =
           foldr
             ( \req acc -> case req of
                 Apply (UntypedTweak tweak) -> tweak >> acc

From b9bf548d55897264bc241eba01c497800c328824 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 23 Jan 2026 17:45:09 +0100
Subject: [PATCH 39/96] UtxoSearch

---
 src/Cooked/MockChain/UtxoSearch.hs | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/src/Cooked/MockChain/UtxoSearch.hs b/src/Cooked/MockChain/UtxoSearch.hs
index 225f226d5..19d350d90 100644
--- a/src/Cooked/MockChain/UtxoSearch.hs
+++ b/src/Cooked/MockChain/UtxoSearch.hs
@@ -3,11 +3,14 @@
 -- - extract pieces of information from them
 module Cooked.MockChain.UtxoSearch
   ( -- * UTxO searches
-    UtxoSearchResult,
     UtxoSearch,
     beginSearch,
+
+    -- * Processing search result
+    UtxoSearchResult,
     getOutputs,
     getOutputsAndExtracts,
+    getExtracts,
     getTxOutRefs,
     getTxOutRefsAndOutputs,
 
@@ -77,8 +80,15 @@ getOutputs = fmap (fmap (hHead . snd))
 -- extracted elements
 getOutputsAndExtracts ::
   Sem effs (UtxoSearchResult elems) ->
-  Sem effs [HList (TxSkelOut ': elems)]
-getOutputsAndExtracts = fmap (fmap snd)
+  Sem effs [(TxSkelOut, HList elems)]
+getOutputsAndExtracts =
+  fmap (fmap (\(_, HCons output l) -> (output, l)))
+
+-- | Retrieves the extracted elements from a `UtxoSearchResult`
+getExtracts ::
+  Sem effs (UtxoSearchResult elems) ->
+  Sem effs [HList elems]
+getExtracts = fmap (fmap (hTail . snd))
 
 -- | Retrieves the `Api.TxOutRef`s from a `UtxoSearchResult`
 getTxOutRefs ::
@@ -113,7 +123,8 @@ txSkelOutByRefSearch ::
   [Api.TxOutRef] ->
   (UtxoSearch effs '[] -> UtxoSearch effs els) ->
   UtxoSearch effs els
-txSkelOutByRefSearch utxos filters = filters $ beginSearch (zip utxos <$> mapM txSkelOutByRef utxos)
+txSkelOutByRefSearch utxos filters =
+  filters $ beginSearch (zip utxos <$> mapM txSkelOutByRef utxos)
 
 -- | Extracts a new element from the currently selected outputs, filtering in
 -- the process out utxos for which this element is not available

From 0cd2a41d64e18b51993d35ccbccae84f729df576 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Fri, 23 Jan 2026 18:35:03 +0100
Subject: [PATCH 40/96] StagedMockChain is back

---
 src/Cooked/MockChain/Instances.hs | 12 ++++++------
 src/Cooked/MockChain/Testing.hs   | 20 ++++++++++----------
 2 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 0b968d6cb..e3823d575 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -146,13 +146,13 @@ type FullEffs =
 
 -- | A possible stack of effects to handle staged interpretation of the
 -- mockchain, that is with tweaks and branching.
-type MockChainFull a = Sem FullEffs a
+type StagedMockChain a = Sem FullEffs a
 
-runMockChainFull ::
+runStagedMockChain ::
   MockChainState ->
-  MockChainFull a ->
+  StagedMockChain a ->
   [RawMockChainReturn a]
-runMockChainFull mcst =
+runStagedMockChain mcst =
   run
     . runNonDet
     . runWriter
@@ -185,7 +185,7 @@ runMockChainFull mcst =
 -- | A default configuration to run a staged mockchain run. The intended usage
 -- is @runMockChainConf $ mockChainConfFullTemplate myFullRun@.
 mockChainConfFullTemplate ::
-  MockChainFull a ->
+  StagedMockChain a ->
   MockChainConf FullEffs a (MockChainReturn a)
 mockChainConfFullTemplate currentRun =
-  MockChainConf def def unRawMockChainReturn currentRun runMockChainFull
+  MockChainConf def def unRawMockChainReturn currentRun runStagedMockChain
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index a49eccd32..b906d8175 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -186,10 +186,10 @@ type StateProp prop = PrettyCookedOpts -> UtxoState -> prop
 -- enforced here, but it will often be assumed that @prop@ satisfies 'IsProp'.
 data Test a prop = Test
   { -- | The mockchain trace to test, which returns a result of type a
-    testTrace :: MockChainFull a,
+    testTrace :: StagedMockChain a,
     -- | The initial distribution from which the trace should be run
     testInitDist :: InitialDistribution,
-    -- | The requirement on the number of results, as 'MockChainFull' is a
+    -- | The requirement on the number of results, as 'StagedMockChain' is a
     -- 'Control.Monad.MonadPlus'
     testSizeProp :: SizeProp prop,
     -- | The property that should hold in case of failure over the resulting
@@ -237,7 +237,7 @@ testCookedQC name = QC.testProperty name . testToProp
 -- * Simple test templates
 
 -- | A test template which expects a success from a trace
-mustSucceedTest :: (IsProp prop) => MockChainFull a -> Test a prop
+mustSucceedTest :: (IsProp prop) => StagedMockChain a -> Test a prop
 mustSucceedTest trace =
   Test
     { testTrace = trace,
@@ -249,7 +249,7 @@ mustSucceedTest trace =
     }
 
 -- | A test template which expects a failure from a trace
-mustFailTest :: (IsProp prop) => MockChainFull a -> Test a prop
+mustFailTest :: (IsProp prop) => StagedMockChain a -> Test a prop
 mustFailTest trace =
   Test
     { testTrace = trace,
@@ -413,25 +413,25 @@ possesses w ac n = isAtAddress [(w, [(ac, (== n))])]
 --}
 
 -- | A test template which expects a Phase 2 failure
-mustFailInPhase2Test :: (IsProp prop) => MockChainFull a -> Test a prop
+mustFailInPhase2Test :: (IsProp prop) => StagedMockChain a -> Test a prop
 mustFailInPhase2Test run = mustFailTest run `withFailureProp` isPhase2Failure
 
 -- | A test template which expects a specific phase 2 error message
-mustFailInPhase2WithMsgTest :: (IsProp prop) => String -> MockChainFull a -> Test a prop
+mustFailInPhase2WithMsgTest :: (IsProp prop) => String -> StagedMockChain a -> Test a prop
 mustFailInPhase2WithMsgTest msg run = mustFailTest run `withFailureProp` isPhase2FailureWithMsg msg
 
 -- | A test template which expects a Phase 1 failure
-mustFailInPhase1Test :: (IsProp prop) => MockChainFull a -> Test a prop
+mustFailInPhase1Test :: (IsProp prop) => StagedMockChain a -> Test a prop
 mustFailInPhase1Test run = mustFailTest run `withFailureProp` isPhase1Failure
 
 -- | A test template which expects a specific phase 1 error message
-mustFailInPhase1WithMsgTest :: (IsProp prop) => String -> MockChainFull a -> Test a prop
+mustFailInPhase1WithMsgTest :: (IsProp prop) => String -> StagedMockChain a -> Test a prop
 mustFailInPhase1WithMsgTest msg run = mustFailTest run `withFailureProp` isPhase1FailureWithMsg msg
 
 -- | A test template which expects a certain number of successful outcomes
-mustSucceedWithSizeTest :: (IsProp prop) => Integer -> MockChainFull a -> Test a prop
+mustSucceedWithSizeTest :: (IsProp prop) => Integer -> StagedMockChain a -> Test a prop
 mustSucceedWithSizeTest size run = mustSucceedTest run `withSizeProp` (testBool . (== size))
 
 -- | A test template which expects a certain number of unsuccessful outcomes
-mustFailWithSizeTest :: (IsProp prop) => Integer -> MockChainFull a -> Test a prop
+mustFailWithSizeTest :: (IsProp prop) => Integer -> StagedMockChain a -> Test a prop
 mustFailWithSizeTest size run = mustFailTest run `withSizeProp` isOfSize size

From 52fc6685a6f4b72abf675c6e753c6f9e5891a844 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sat, 24 Jan 2026 01:57:18 +0100
Subject: [PATCH 41/96] all but Spec.Ltl

---
 src/Cooked.hs                       |   1 +
 src/Cooked/MockChain/Balancing.hs   |   4 +-
 src/Cooked/MockChain/Instances.hs   | 225 ++++++++++++++++++----------
 src/Cooked/MockChain/Testing.hs     |  87 +++++++----
 src/Cooked/MockChain/UtxoSearch.hs  |  10 +-
 src/Cooked/MockChain/Write.hs       |  20 +--
 src/Cooked/Tweak/Common.hs          |  16 ++
 tests/Spec/Attack/DatumHijacking.hs |  74 ++++-----
 tests/Spec/Attack/DupToken.hs       |  72 ++++-----
 tests/Spec/Balancing.hs             |  90 +++++------
 tests/Spec/BasicUsage.hs            |  10 +-
 tests/Spec/Certificates.hs          |   4 +-
 tests/Spec/InitialDistribution.hs   |  10 +-
 tests/Spec/InlineDatums.hs          |   9 +-
 tests/Spec/MinAda.hs                |   4 +-
 tests/Spec/MultiPurpose.hs          |   2 +-
 tests/Spec/ProposingScript.hs       |   3 +-
 tests/Spec/ReferenceInputs.hs       |   4 +-
 tests/Spec/ReferenceScripts.hs      |  22 +--
 tests/Spec/Slot.hs                  |   2 -
 tests/Spec/Tweak/Labels.hs          |  10 +-
 tests/Spec/Tweak/ValidityRange.hs   |  69 ++++++---
 tests/Spec/Withdrawals.hs           |   3 +-
 23 files changed, 444 insertions(+), 307 deletions(-)

diff --git a/src/Cooked.hs b/src/Cooked.hs
index 6bf1ea897..cba62ee67 100644
--- a/src/Cooked.hs
+++ b/src/Cooked.hs
@@ -3,6 +3,7 @@
 module Cooked (module X) where
 
 import Cooked.Attack as X
+import Cooked.Families as X
 import Cooked.InitialDistribution as X
 import Cooked.Ltl as X
 import Cooked.MockChain as X
diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 3ee317656..3655a5d2e 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -108,7 +108,7 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
           BalancingUtxosFromBalancingUser -> getTxOutRefsAndOutputs $ utxosAtSearch bUser ensureOnlyValueOutputs
           BalancingUtxosFromSet utxos ->
             -- We resolve the given set of utxos
-            getTxOutRefsAndOutputs (txSkelOutByRefSearch (Set.toList utxos) id)
+            getTxOutRefsAndOutputs (txSkelOutByRefSearch' (Set.toList utxos))
               -- We filter out those belonging to scripts, while throwing a
               -- warning if any was actually discarded.
               >>= filterAndWarn (is (txSkelOutOwnerL % userPubKeyHashAT) . snd) "They belong to scripts."
@@ -263,7 +263,7 @@ collateralInsFromFees fee collateralIns returnCollateralUser = do
   -- add one because of ledger requirement which seem to round up this value.
   let totalCollateral = Script.lovelace . (+ 1) . (`div` 100) . (* percentage) $ fee
   -- Collateral tx outputs sorted by decreasing ada amount
-  collateralTxOuts <- getTxOutRefsAndOutputs $ txSkelOutByRefSearch (Set.toList collateralIns) id
+  collateralTxOuts <- getTxOutRefsAndOutputs $ txSkelOutByRefSearch' $ Set.toList collateralIns
   -- Candidate subsets of utxos to be used as collaterals
   let candidatesRaw = reachValue collateralTxOuts totalCollateral nbMax
   -- Preparing a possible collateral error
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index e3823d575..fa50e2867 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -1,3 +1,20 @@
+-- | This module exposes concrete instances to run a mockchain. There are 3 of
+-- them :
+--
+-- - `DirectMockChain` exposes the minimal set of effects required to run a
+--   mockchain, without the ability to branch or modify runs. Use this only if
+--   you specifically want to disallow Ltl modifications (which behaves the same
+--   in the absence of modifications). In should also perform somewhat better,
+--   also in most cases this will be insignificant.
+--
+-- - `StagedMockChain` exposes all the primitives required to run a mockchain,
+--   with the addition of branching and Ltl modifications using tweaks. This
+--   should be the environement to use in 99% of the cases.
+--
+-- - `FullMockChain` exposes all the effects used to process a mockchain run,
+--   including intermediate effects usually hidden. This should only be used
+--   when the users requires to manually execute internal primitives of cooked,
+--   such as balancing.
 module Cooked.MockChain.Instances where
 
 import Cooked.InitialDistribution
@@ -10,6 +27,7 @@ import Cooked.MockChain.Read
 import Cooked.MockChain.UtxoState
 import Cooked.MockChain.Write
 import Cooked.Skeleton.Output
+import Cooked.Tweak.Common
 import Data.Default
 import Data.Map (Map)
 import Ledger.Tx qualified as Ledger
@@ -91,6 +109,20 @@ runMockChainConf ::
 runMockChainConf (MockChainConf initialState initialDist funOnRes currentRun runner) =
   funOnRes <$> runner initialState (forceOutputs (unInitialDistribution initialDist) >> currentRun)
 
+class MockChain effs where
+  runMockChain :: MockChainState -> Sem effs a -> [RawMockChainReturn a]
+
+runMockChainDef :: (MockChain effs) => Sem effs a -> [RawMockChainReturn a]
+runMockChainDef = runMockChain def
+
+-- | A default configuration to run a mockchain run.
+mockChainConfTemplate ::
+  (MockChain effs) =>
+  Sem effs a ->
+  MockChainConf effs a (MockChainReturn a)
+mockChainConfTemplate currentRun =
+  MockChainConf def def unRawMockChainReturn currentRun runMockChain
+
 type DirectEffs =
   '[ MockChainWrite,
      MockChainRead,
@@ -100,43 +132,37 @@ type DirectEffs =
 
 -- | A possible stack of effects to handle a direct interpretation of the
 -- mockchain, that is without any tweaks nor branching.
-type MockChainDirect a = Sem DirectEffs a
-
-runMockChainDirect :: MockChainState -> MockChainDirect a -> [RawMockChainReturn a]
-runMockChainDirect mcst =
-  (: [])
-    . run
-    . runWriter
-    . runWriter
-    . runMockChainLog
-    . runState mcst
-    . runError
-    . runToCardanoErrorInMockChainError
-    . runFailInMockChainError
-    . runMockChainMisc
-    . runMockChainRead
-    . runMockChainWrite
-    . insertAt @4
-      @[ Error Ledger.ToCardanoError,
-         Error MockChainError,
-         State MockChainState,
-         MockChainLog,
-         Writer [MockChainLogEntry],
-         Writer (Map Api.BuiltinByteString String)
-       ]
-
--- | A default configuration to run a direct mockchain run. The intended usage
--- is @runMockChainConf $ mockChainConfDirectTemplate myDirectRun@.
-mockChainConfDirectTemplate ::
-  MockChainDirect a ->
-  MockChainConf DirectEffs a (MockChainReturn a)
-mockChainConfDirectTemplate currentRun =
-  MockChainConf def def unRawMockChainReturn currentRun runMockChainDirect
-
-type TweakEffs = '[MockChainRead, Fail, NonDet]
+type DirectMockChain a = Sem DirectEffs a
 
-type FullEffs =
-  '[ ModifyGlobally (UntypedTweak TweakEffs),
+instance MockChain DirectEffs where
+  runMockChain mcst =
+    (: [])
+      . run
+      . runWriter
+      . runWriter
+      . runMockChainLog
+      . runState mcst
+      . runError
+      . runToCardanoErrorInMockChainError
+      . runFailInMockChainError
+      . runMockChainMisc
+      . runMockChainRead
+      . runMockChainWrite
+      . insertAt @4
+        @[ Error Ledger.ToCardanoError,
+           Error MockChainError,
+           State MockChainState,
+           MockChainLog,
+           Writer [MockChainLogEntry],
+           Writer (Map Api.BuiltinByteString String)
+         ]
+
+type StagedTweakEffs = '[MockChainRead, Fail, NonDet]
+
+type StagedTweak a = Sem (Tweak : NonDet : StagedTweakEffs) a
+
+type StagedEffs =
+  '[ ModifyGlobally (UntypedTweak StagedTweakEffs),
      MockChainWrite,
      MockChainMisc,
      MockChainRead,
@@ -146,46 +172,87 @@ type FullEffs =
 
 -- | A possible stack of effects to handle staged interpretation of the
 -- mockchain, that is with tweaks and branching.
-type StagedMockChain a = Sem FullEffs a
-
-runStagedMockChain ::
-  MockChainState ->
-  StagedMockChain a ->
-  [RawMockChainReturn a]
-runStagedMockChain mcst =
-  run
-    . runNonDet
-    . runWriter
-    . runWriter
-    . runMockChainLog
-    . runState mcst
-    . runError
-    . runToCardanoErrorInMockChainError
-    . runFailInMockChainError
-    . runMockChainRead
-    . runMockChainMisc
-    . evalState []
-    . runModifyLocally
-    . runMockChainWrite
-    . insertAt @6
-      @[ Error Ledger.ToCardanoError,
-         Error MockChainError,
-         State MockChainState,
-         MockChainLog,
-         Writer [MockChainLogEntry],
-         Writer (Map Api.BuiltinByteString String)
-       ]
-    . reinterpretMockChainWriteWithTweak
-    . runModifyGlobally
-    . insertAt @2
-      @[ ModifyLocally (UntypedTweak TweakEffs),
-         State [Ltl (UntypedTweak TweakEffs)]
-       ]
-
--- | A default configuration to run a staged mockchain run. The intended usage
--- is @runMockChainConf $ mockChainConfFullTemplate myFullRun@.
-mockChainConfFullTemplate ::
-  StagedMockChain a ->
-  MockChainConf FullEffs a (MockChainReturn a)
-mockChainConfFullTemplate currentRun =
-  MockChainConf def def unRawMockChainReturn currentRun runStagedMockChain
+type StagedMockChain a = Sem StagedEffs a
+
+instance MockChain StagedEffs where
+  runMockChain mcst =
+    run
+      . runNonDet
+      . runWriter
+      . runWriter
+      . runMockChainLog
+      . runState mcst
+      . runError
+      . runToCardanoErrorInMockChainError
+      . runFailInMockChainError
+      . runMockChainRead
+      . runMockChainMisc
+      . evalState []
+      . runModifyLocally
+      . runMockChainWrite
+      . insertAt @6
+        @[ Error Ledger.ToCardanoError,
+           Error MockChainError,
+           State MockChainState,
+           MockChainLog,
+           Writer [MockChainLogEntry],
+           Writer (Map Api.BuiltinByteString String)
+         ]
+      . reinterpretMockChainWriteWithTweak
+      . runModifyGlobally
+      . insertAt @2
+        @[ ModifyLocally (UntypedTweak StagedTweakEffs),
+           State [Ltl (UntypedTweak StagedTweakEffs)]
+         ]
+
+type FullTweakEffs =
+  '[ MockChainRead,
+     Fail,
+     Error Ledger.ToCardanoError,
+     Error MockChainError,
+     State MockChainState,
+     MockChainLog,
+     Writer [MockChainLogEntry],
+     Writer (Map Api.BuiltinByteString String),
+     NonDet
+   ]
+
+type FullTweak a = Sem (Tweak : NonDet : FullTweakEffs) a
+
+type FullEffs =
+  '[ ModifyGlobally (UntypedTweak FullTweakEffs),
+     MockChainWrite,
+     ModifyLocally (UntypedTweak FullTweakEffs),
+     State [Ltl (UntypedTweak FullTweakEffs)],
+     MockChainMisc,
+     MockChainRead,
+     Fail,
+     Error Ledger.ToCardanoError,
+     Error MockChainError,
+     State MockChainState,
+     MockChainLog,
+     Writer [MockChainLogEntry],
+     Writer (Map Api.BuiltinByteString String),
+     NonDet
+   ]
+
+type FullMockChain a = Sem FullEffs a
+
+instance MockChain FullEffs where
+  runMockChain mcst =
+    run
+      . runNonDet
+      . runWriter
+      . runWriter
+      . runMockChainLog
+      . runState mcst
+      . runError
+      . runToCardanoErrorInMockChainError
+      . runFailInMockChainError
+      . runMockChainRead
+      . runMockChainMisc
+      . evalState []
+      . runModifyLocally
+      . runMockChainWrite
+      . reinterpretMockChainWriteWithTweak
+      . runModifyGlobally
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index b906d8175..5042b6f32 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -9,6 +9,7 @@ import Cooked.MockChain.Error
 import Cooked.MockChain.Instances
 import Cooked.MockChain.Log
 import Cooked.MockChain.UtxoState
+import Cooked.MockChain.Write
 import Cooked.Pretty
 import Data.Default
 import Data.List (isInfixOf)
@@ -17,6 +18,7 @@ import Data.Text qualified as T
 import Ledger qualified
 import Plutus.Script.Utils.Address qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
+import Polysemy
 import Test.QuickCheck qualified as QC
 import Test.Tasty qualified as HU
 import Test.Tasty.HUnit qualified as HU
@@ -160,7 +162,7 @@ assertSameSets l r =
   complex requirements that involve both the journal and other components of the
   returned elements in the mockchain run. Granted, this use cas is extremely
   rare, but it does not mean our API should not reflect this capability.
-  However, we also provide 'JournalProp' as in most cases on predicating over
+  However, we also provide 'JournalProp' as in most cases predicating over
   the journal itself will be sufficient.
 --}
 
@@ -184,9 +186,9 @@ type StateProp prop = PrettyCookedOpts -> UtxoState -> prop
 -- | Data structure to test a mockchain trace. @a@ is the return typed of the
 -- tested trace, @prop@ is the domain in which the properties live. This is not
 -- enforced here, but it will often be assumed that @prop@ satisfies 'IsProp'.
-data Test a prop = Test
+data Test effs a prop = Test
   { -- | The mockchain trace to test, which returns a result of type a
-    testTrace :: StagedMockChain a,
+    testTrace :: Sem effs a,
     -- | The initial distribution from which the trace should be run
     testInitDist :: InitialDistribution,
     -- | The requirement on the number of results, as 'StagedMockChain' is a
@@ -208,9 +210,18 @@ data Test a prop = Test
 -- the nature of these outcomes, either calls 'testFailureProp' or
 -- 'testSuccessProp'. It also uses the aliases emitted during the mockchain run
 -- to pretty print messages when applicable.
-testToProp :: (IsProp prop, Show a) => Test a prop -> prop
+testToProp ::
+  ( IsProp prop,
+    Show a,
+    Member MockChainWrite effs,
+    MockChain effs
+  ) =>
+  Test effs a prop ->
+  prop
 testToProp Test {..} =
-  let results = runMockChainConf $ (mockChainConfFullTemplate testTrace) {mccInitialDistribution = testInitDist}
+  let results =
+        runMockChainConf $
+          (mockChainConfTemplate testTrace) {mccInitialDistribution = testInitDist}
    in testSizeProp (toInteger (length results))
         .&&. testAll
           ( \ret@(MockChainReturn outcome _ state mcLog names) ->
@@ -227,17 +238,33 @@ testToProp Test {..} =
 -- 'HU.testCase' with 'testCooked' and thus avoid the use of 'testToProp'.
 -- Sadly we cannot generalise it with type classes on @prop@ to work for
 -- QuichCheck at GHC will never be able to instantiate @prop@.
-testCooked :: (Show a) => String -> Test a HU.Assertion -> HU.TestTree
+testCooked ::
+  forall effs a.
+  ( Show a,
+    Member MockChainWrite effs,
+    MockChain effs
+  ) =>
+  String ->
+  Test effs a HU.Assertion ->
+  HU.TestTree
 testCooked name = HU.testCase name . testToProp
 
 -- | Same as 'testCooked', but for 'QC.Property'
-testCookedQC :: (Show a) => String -> Test a QC.Property -> HU.TestTree
+testCookedQC ::
+  forall effs a.
+  ( Show a,
+    Member MockChainWrite effs,
+    MockChain effs
+  ) =>
+  String ->
+  Test effs a QC.Property ->
+  HU.TestTree
 testCookedQC name = QC.testProperty name . testToProp
 
 -- * Simple test templates
 
 -- | A test template which expects a success from a trace
-mustSucceedTest :: (IsProp prop) => StagedMockChain a -> Test a prop
+mustSucceedTest :: (IsProp prop) => Sem effs a -> Test effs a prop
 mustSucceedTest trace =
   Test
     { testTrace = trace,
@@ -249,7 +276,7 @@ mustSucceedTest trace =
     }
 
 -- | A test template which expects a failure from a trace
-mustFailTest :: (IsProp prop) => StagedMockChain a -> Test a prop
+mustFailTest :: (IsProp prop) => Sem effs a -> Test effs a prop
 mustFailTest trace =
   Test
     { testTrace = trace,
@@ -263,16 +290,16 @@ mustFailTest trace =
 -- * Appending elements (in particular requirements) to existing tests
 
 -- | Gives an initial distribution from which the trace will be run
-withInitDist :: Test a prop -> InitialDistribution -> Test a prop
+withInitDist :: Test effs a prop -> InitialDistribution -> Test effs a prop
 withInitDist test initDist = test {testInitDist = initDist}
 
 -- | Gives some pretty options to render test messages
-withPrettyOpts :: Test a prop -> PrettyCookedOpts -> Test a prop
+withPrettyOpts :: Test effs a prop -> PrettyCookedOpts -> Test effs a prop
 withPrettyOpts test opts = test {testPrettyOpts = opts}
 
 -- | Appends a requirements over the emitted log, which will need to be satisfied
 -- both in case of success or failure of the run.
-withJournalProp :: (IsProp prop) => Test a prop -> JournalProp prop -> Test a prop
+withJournalProp :: (IsProp prop) => Test effs a prop -> JournalProp prop -> Test effs a prop
 withJournalProp test journalProp =
   test
     { testFailureProp = \opts journal err state -> testFailureProp test opts journal err state .&&. journalProp opts journal,
@@ -281,7 +308,7 @@ withJournalProp test journalProp =
 
 -- | Appends a requirements over the resulting 'UtxoState', which will need to
 -- be satisfied both in case of success or failure of the run.
-withStateProp :: (IsProp prop) => Test a prop -> StateProp prop -> Test a prop
+withStateProp :: (IsProp prop) => Test effs a prop -> StateProp prop -> Test effs a prop
 withStateProp test stateProp =
   test
     { testFailureProp = \opts journal err state -> testFailureProp test opts journal err state .&&. stateProp opts state,
@@ -290,18 +317,18 @@ withStateProp test stateProp =
 
 -- | Appends a requirement over the resulting value and state of the mockchain
 -- run which will need to be satisfied if the run is successful
-withSuccessProp :: (IsProp prop) => Test a prop -> SuccessProp a prop -> Test a prop
+withSuccessProp :: (IsProp prop) => Test effs a prop -> SuccessProp a prop -> Test effs a prop
 withSuccessProp test successProp =
   test
     { testSuccessProp = \opts journal val state -> testSuccessProp test opts journal val state .&&. successProp opts journal val state
     }
 
 -- | Same as 'withSuccessProp' but only considers the returning value of the run
-withResultProp :: (IsProp prop) => Test a prop -> (a -> prop) -> Test a prop
+withResultProp :: (IsProp prop) => Test effs a prop -> (a -> prop) -> Test effs a prop
 withResultProp test p = withSuccessProp test (\_ _ res _ -> p res)
 
 -- | Appends a requirement over the resulting number of outcomes of the run
-withSizeProp :: (IsProp prop) => Test a prop -> SizeProp prop -> Test a prop
+withSizeProp :: (IsProp prop) => Test effs a prop -> SizeProp prop -> Test effs a prop
 withSizeProp test reqSize =
   test
     { testSizeProp = \size -> testSizeProp test size .&&. reqSize size
@@ -309,11 +336,11 @@ withSizeProp test reqSize =
 
 -- | Appends a requirement over the resulting value and state of the mockchain
 -- run which will need to be satisfied if the run is successful
-withFailureProp :: (IsProp prop) => Test a prop -> FailureProp prop -> Test a prop
+withFailureProp :: (IsProp prop) => Test effs a prop -> FailureProp prop -> Test effs a prop
 withFailureProp test failureProp = test {testFailureProp = \opts journal err state -> testFailureProp test opts journal err state .&&. failureProp opts journal err state}
 
 -- | Same as 'withFailureProp' but only considers the returning error of the run
-withErrorProp :: (IsProp prop) => Test a prop -> (MockChainError -> prop) -> Test a prop
+withErrorProp :: (IsProp prop) => Test effs a prop -> (MockChainError -> prop) -> Test effs a prop
 withErrorProp test errorProp = withFailureProp test (\_ _ err _ -> errorProp err)
 
 -- * Specific properties around failures
@@ -413,25 +440,25 @@ possesses w ac n = isAtAddress [(w, [(ac, (== n))])]
 --}
 
 -- | A test template which expects a Phase 2 failure
-mustFailInPhase2Test :: (IsProp prop) => StagedMockChain a -> Test a prop
-mustFailInPhase2Test run = mustFailTest run `withFailureProp` isPhase2Failure
+mustFailInPhase2Test :: (IsProp prop) => Sem effs a -> Test effs a prop
+mustFailInPhase2Test trace = mustFailTest trace `withFailureProp` isPhase2Failure
 
 -- | A test template which expects a specific phase 2 error message
-mustFailInPhase2WithMsgTest :: (IsProp prop) => String -> StagedMockChain a -> Test a prop
-mustFailInPhase2WithMsgTest msg run = mustFailTest run `withFailureProp` isPhase2FailureWithMsg msg
+mustFailInPhase2WithMsgTest :: (IsProp prop) => String -> Sem effs a -> Test effs a prop
+mustFailInPhase2WithMsgTest msg trace = mustFailTest trace `withFailureProp` isPhase2FailureWithMsg msg
 
 -- | A test template which expects a Phase 1 failure
-mustFailInPhase1Test :: (IsProp prop) => StagedMockChain a -> Test a prop
-mustFailInPhase1Test run = mustFailTest run `withFailureProp` isPhase1Failure
+mustFailInPhase1Test :: (IsProp prop) => Sem effs a -> Test effs a prop
+mustFailInPhase1Test trace = mustFailTest trace `withFailureProp` isPhase1Failure
 
 -- | A test template which expects a specific phase 1 error message
-mustFailInPhase1WithMsgTest :: (IsProp prop) => String -> StagedMockChain a -> Test a prop
-mustFailInPhase1WithMsgTest msg run = mustFailTest run `withFailureProp` isPhase1FailureWithMsg msg
+mustFailInPhase1WithMsgTest :: (IsProp prop) => String -> Sem effs a -> Test effs a prop
+mustFailInPhase1WithMsgTest msg trace = mustFailTest trace `withFailureProp` isPhase1FailureWithMsg msg
 
 -- | A test template which expects a certain number of successful outcomes
-mustSucceedWithSizeTest :: (IsProp prop) => Integer -> StagedMockChain a -> Test a prop
-mustSucceedWithSizeTest size run = mustSucceedTest run `withSizeProp` (testBool . (== size))
+mustSucceedWithSizeTest :: (IsProp prop) => Integer -> Sem effs a -> Test effs a prop
+mustSucceedWithSizeTest size trace = mustSucceedTest trace `withSizeProp` (testBool . (== size))
 
 -- | A test template which expects a certain number of unsuccessful outcomes
-mustFailWithSizeTest :: (IsProp prop) => Integer -> StagedMockChain a -> Test a prop
-mustFailWithSizeTest size run = mustFailTest run `withSizeProp` isOfSize size
+mustFailWithSizeTest :: (IsProp prop) => Integer -> Sem effs a -> Test effs a prop
+mustFailWithSizeTest size trace = mustFailTest trace `withSizeProp` isOfSize size
diff --git a/src/Cooked/MockChain/UtxoSearch.hs b/src/Cooked/MockChain/UtxoSearch.hs
index 19d350d90..5b35ce6be 100644
--- a/src/Cooked/MockChain/UtxoSearch.hs
+++ b/src/Cooked/MockChain/UtxoSearch.hs
@@ -18,6 +18,7 @@ module Cooked.MockChain.UtxoSearch
     utxosAtSearch,
     allUtxosSearch,
     txSkelOutByRefSearch,
+    txSkelOutByRefSearch',
 
     -- * Extracting new information from UTxOs
     extract,
@@ -117,7 +118,7 @@ allUtxosSearch ::
   UtxoSearch effs els
 allUtxosSearch filters = filters $ beginSearch allUtxos
 
--- | Searches for utxos belonging to a given list
+-- | Searches for utxos belonging to a given list with a given filter
 txSkelOutByRefSearch ::
   (Member MockChainRead effs) =>
   [Api.TxOutRef] ->
@@ -126,6 +127,13 @@ txSkelOutByRefSearch ::
 txSkelOutByRefSearch utxos filters =
   filters $ beginSearch (zip utxos <$> mapM txSkelOutByRef utxos)
 
+-- | Searches for utxos belonging to a given list with no filter
+txSkelOutByRefSearch' ::
+  (Member MockChainRead effs) =>
+  [Api.TxOutRef] ->
+  UtxoSearch effs '[]
+txSkelOutByRefSearch' = (`txSkelOutByRefSearch` id)
+
 -- | Extracts a new element from the currently selected outputs, filtering in
 -- the process out utxos for which this element is not available
 extract ::
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index cf474483c..85cb4fe3f 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -96,7 +96,7 @@ fromTweak = LtlAtom . UntypedTweak
 -- branching at any such locations. The tweak must apply at least once.
 somewhere ::
   (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs a ->
+  TypedTweak tweakEffs b ->
   Sem effs a ->
   Sem effs a
 somewhere = modifyLtl . ltlEventually . fromTweak
@@ -105,7 +105,7 @@ somewhere = modifyLtl . ltlEventually . fromTweak
 -- fails anywhere in the trace.
 everywhere ::
   (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs a ->
+  TypedTweak tweakEffs b ->
   Sem effs a ->
   Sem effs a
 everywhere = modifyLtl . ltlAlways . fromTweak
@@ -114,7 +114,7 @@ everywhere = modifyLtl . ltlAlways . fromTweak
 -- and leaves the computation unchanged.
 nowhere ::
   (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs a ->
+  TypedTweak tweakEffs b ->
   Sem effs a ->
   Sem effs a
 nowhere = modifyLtl . ltlNever . fromTweak
@@ -123,7 +123,7 @@ nowhere = modifyLtl . ltlNever . fromTweak
 -- fail, which might never occur.
 whenAble ::
   (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs a ->
+  TypedTweak tweakEffs b ->
   Sem effs a ->
   Sem effs a
 whenAble = modifyLtl . ltlWhenPossible . fromTweak
@@ -136,7 +136,7 @@ whenAble = modifyLtl . ltlWhenPossible . fromTweak
 there ::
   (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
   Integer ->
-  TypedTweak tweakEffs a ->
+  TypedTweak tweakEffs b ->
   Sem effs a ->
   Sem effs a
 there n = modifyLtl . ltlDelay n . fromTweak
@@ -154,7 +154,7 @@ there n = modifyLtl . ltlDelay n . fromTweak
 withTweak ::
   (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
   Sem effs a ->
-  TypedTweak tweakEffs a ->
+  TypedTweak tweakEffs b ->
   Sem effs a
 withTweak = flip (there 0)
 
@@ -360,14 +360,16 @@ runMockChainWrite = interpret $ \case
 waitNSlots :: (Member MockChainWrite effs) => Integer -> Sem effs Ledger.Slot
 
 -- | Wait for a certain slot, or throws an error if the slot is already past
-awaitSlot :: (Members '[MockChainRead, MockChainWrite] effs) => Integer -> Sem effs Ledger.Slot
-awaitSlot slot = currentSlot >>= waitNSlots . (slot -) . fromIntegral
+awaitSlot :: (Members '[MockChainRead, MockChainWrite] effs) => Ledger.Slot -> Sem effs Ledger.Slot
+awaitSlot (Ledger.Slot targetSlot) = do
+  Ledger.Slot now <- currentSlot
+  waitNSlots (targetSlot - now)
 
 -- | Waits until the current slot becomes greater or equal to the slot
 --  containing the given POSIX time.  Note that that it might not wait for
 --  anything if the current slot is large enough.
 awaitEnclosingSlot :: (Members '[MockChainRead, MockChainWrite] effs) => Api.POSIXTime -> Sem effs Ledger.Slot
-awaitEnclosingSlot time = getEnclosingSlot time >>= (\(Ledger.Slot s) -> awaitSlot s)
+awaitEnclosingSlot time = getEnclosingSlot time >>= awaitSlot
 
 -- | Wait a given number of ms from the lower bound of the current slot and
 -- returns the current slot after waiting.
diff --git a/src/Cooked/Tweak/Common.hs b/src/Cooked/Tweak/Common.hs
index 68844196c..eef5704e0 100644
--- a/src/Cooked/Tweak/Common.hs
+++ b/src/Cooked/Tweak/Common.hs
@@ -6,6 +6,8 @@ module Cooked.Tweak.Common
   ( -- * Tweak effect
     Tweak (..),
     runTweak,
+    evalTweak,
+    execTweak,
 
     -- * Optics
     selectP,
@@ -59,6 +61,20 @@ runTweak txSkel =
           PutTxSkel skel -> put skel
       )
 
+-- | Same as `runTweak` but discards the returned `TxSkel`
+evalTweak ::
+  TxSkel ->
+  Sem (Tweak : effs) a ->
+  Sem effs a
+evalTweak skel = (snd <$>) . runTweak skel
+
+-- | Same as `runTweak` but discards the returned value
+execTweak ::
+  TxSkel ->
+  Sem (Tweak : effs) a ->
+  Sem effs TxSkel
+execTweak skel = (fst <$>) . runTweak skel
+
 -- | Retrieves some value from the 'TxSkel'
 viewTweak ::
   (Member Tweak effs, Is k A_Getter) =>
diff --git a/tests/Spec/Attack/DatumHijacking.hs b/tests/Spec/Attack/DatumHijacking.hs
index f8065a7fc..d04e11ea1 100644
--- a/tests/Spec/Attack/DatumHijacking.hs
+++ b/tests/Spec/Attack/DatumHijacking.hs
@@ -3,13 +3,14 @@
 module Spec.Attack.DatumHijacking (tests) where
 
 import Cooked
-import Data.Bifunctor
 import Data.Map qualified as Map
 import Optics.Core
 import Plutus.Attack.DatumHijacking
 import Plutus.Script.Utils.V3 qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.NonDet
 import Prettyprinter
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -27,9 +28,9 @@ lockTxSkel o v =
       txSkelSignatories = txSkelSignatoriesFromList [wallet 1]
     }
 
-txLock :: (MonadBlockChain m) => Script.MultiPurposeScript DHContract -> m Api.TxOutRef
+txLock :: Script.MultiPurposeScript DHContract -> StagedMockChain Api.TxOutRef
 txLock v = do
-  (oref, _) : _ <- runUtxoSearch $ utxosOwnedBySearch (wallet 1) `filterWithValuePred` (`Api.geq` lockValue)
+  oref : _ <- getTxOutRefs $ utxosAtSearch (wallet 1) $ ensureAFoldIs (txSkelOutValueL % filtered (`Api.geq` lockValue))
   head <$> validateTxSkel' (lockTxSkel oref v)
 
 relockTxSkel :: Script.MultiPurposeScript DHContract -> Api.TxOutRef -> TxSkel
@@ -41,13 +42,12 @@ relockTxSkel v o =
     }
 
 txRelock ::
-  (MonadBlockChain m) =>
   Script.MultiPurposeScript DHContract ->
   Api.TxOutRef ->
-  m ()
+  StagedMockChain ()
 txRelock v oref = validateTxSkel_ $ relockTxSkel v oref
 
-datumHijackingTrace :: (MonadBlockChain m) => Script.MultiPurposeScript DHContract -> m ()
+datumHijackingTrace :: Script.MultiPurposeScript DHContract -> StagedMockChain ()
 datumHijackingTrace v = do
   txLock v >>= txRelock v
 
@@ -76,23 +76,20 @@ tests =
                   carelessValidator `receives` InlineDatum SecondLock <&&> Value x2
                 ]
             skelOut bound select =
-              ( fmap (second txSkelOuts)
-                  <$> runTweak
-                    ( datumHijackingAttack $
-                        ( txSkelOutPredDatumHijackingParams
-                            ( \out ->
-                                preview (txSkelOutOwnerL % userScriptHashAF) out == Just (Script.toScriptHash carelessValidator)
-                                  && view txSkelOutDatumL out == SomeTxSkelOutDatum SecondLock Inline
-                                  && bound `Api.geq` view txSkelOutValueL out
-                            )
-                            thief
+              (run . runNonDet . evalTweak skelIn)
+                ( datumHijackingAttack $
+                    ( outPredDatumHijackingParams
+                        ( \out ->
+                            preview (txSkelOutOwnerL % userScriptHashAF) out == Just (Script.toScriptHash carelessValidator)
+                              && view txSkelOutDatumL out == SomeTxSkelOutDatum SecondLock Inline
+                              && bound `Api.geq` view txSkelOutValueL out
                         )
-                          { dhpAllOutputs = True,
-                            dhpIndexPred = select
-                          }
+                        thief
                     )
-                    skelIn
-              )
+                      { dhpAllOutputs = True,
+                        dhpIndexPred = select
+                      }
+                )
             outsExpected a b =
               [ carelessValidator `receives` InlineDatum SecondLock <&&> Value x1,
                 a `receives` InlineDatum SecondLock <&&> Value x3,
@@ -100,36 +97,31 @@ tests =
                 carelessValidator `receives` InlineDatum FirstLock <&&> Value x2,
                 b `receives` InlineDatum SecondLock <&&> Value x2
               ]
-         in [ testCase "no modified transactions if no interesting outputs to steal" $ [] @=? mcrValue <$> skelOut mempty (const True),
+         in [ testCase "no modified transactions if no interesting outputs to steal" $
+                [] @=? skelOut mempty (const True),
               testCase "one modified transaction for one interesting output" $
-                [ Right
-                    ( [carelessValidator `receives` (InlineDatum SecondLock <&&> Value x3)],
-                      outsExpected thief carelessValidator
-                    )
+                [ [carelessValidator `receives` (InlineDatum SecondLock <&&> Value x3)],
+                  outsExpected thief carelessValidator
                 ]
-                  @=? mcrValue <$> skelOut x2 (0 ==),
+                  @=? skelOut x2 (0 ==),
               testCase "two modified transactions for two interesting outputs" $
-                [ Right
-                    ( [ carelessValidator `receives` (InlineDatum SecondLock <&&> Value x3),
-                        carelessValidator `receives` (InlineDatum SecondLock <&&> Value x2)
-                      ],
-                      outsExpected thief thief
-                    )
+                [ [ carelessValidator `receives` (InlineDatum SecondLock <&&> Value x3),
+                    carelessValidator `receives` (InlineDatum SecondLock <&&> Value x2)
+                  ],
+                  outsExpected thief thief
                 ]
-                  @=? mcrValue <$> skelOut x2 (const True),
+                  @=? skelOut x2 (const True),
               testCase "select second interesting output to get one modified transaction" $
-                [ Right
-                    ( [carelessValidator `receives` (InlineDatum SecondLock <&&> Value x2)],
-                      outsExpected carelessValidator thief
-                    )
+                [ [carelessValidator `receives` (InlineDatum SecondLock <&&> Value x2)],
+                  outsExpected carelessValidator thief
                 ]
-                  @=? mcrValue <$> skelOut x2 (1 ==)
+                  @=? skelOut x2 (1 ==)
             ],
       testCooked "careful validator" $
         mustFailInPhase2Test $
           somewhere
             ( datumHijackingAttack $
-                ( txSkelOutPredDatumHijackingParams
+                ( outPredDatumHijackingParams
                     ( \out ->
                         preview (txSkelOutOwnerL % userScriptHashAF) out == Just (Script.toScriptHash carefulValidator)
                           && view txSkelOutDatumL out == SomeTxSkelOutDatum SecondLock Inline
@@ -144,7 +136,7 @@ tests =
         mustSucceedTest $
           somewhere
             ( datumHijackingAttack $
-                ( txSkelOutPredDatumHijackingParams
+                ( outPredDatumHijackingParams
                     ( \out ->
                         preview (txSkelOutOwnerL % userScriptHashAF) out == Just (Script.toScriptHash carelessValidator)
                           && view txSkelOutDatumL out == SomeTxSkelOutDatum SecondLock Inline
diff --git a/tests/Spec/Attack/DupToken.hs b/tests/Spec/Attack/DupToken.hs
index b51a4f02d..8b97da62e 100644
--- a/tests/Spec/Attack/DupToken.hs
+++ b/tests/Spec/Attack/DupToken.hs
@@ -8,10 +8,12 @@ import Optics.Core
 import Plutus.Attack.DupToken
 import Plutus.Script.Utils.V3 qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
+import Polysemy
+import Polysemy.NonDet
 import Test.Tasty
 import Test.Tasty.HUnit
 
-dupTokenTrace :: (MonadBlockChain m) => Script.Versioned Script.MintingPolicy -> Api.TokenName -> Integer -> Wallet -> m ()
+dupTokenTrace :: Script.Versioned Script.MintingPolicy -> Api.TokenName -> Integer -> Wallet -> StagedMockChain ()
 dupTokenTrace pol tName amount recipient = validateTxSkel_ skel
   where
     skel =
@@ -49,34 +51,33 @@ tests =
                     ],
                   txSkelSignatories = txSkelSignatoriesFromList [wallet 3]
                 }
-            skelOut select = runTweak (dupTokenAttack select attacker) skelIn
+            skelOut select = (run . runNonDet . runTweak skelIn) (dupTokenAttack select attacker)
             skelExpected v1 v2 =
               let increment = Api.assetClassValue ac1 (v1 - 5) <> Api.assetClassValue ac2 (v2 - 7)
-               in [ Right
-                      ( increment,
-                        txSkelTemplate
-                          { txSkelLabel = Set.singleton $ TxSkelLabel DupTokenLbl,
-                            txSkelMints =
-                              review
-                                txSkelMintsListI
-                                [ mint pol1 () tName1 v1,
-                                  mint pol2 () tName2 v2
-                                ],
-                            txSkelOuts =
-                              [ wallet 1 `receives` Value (Api.assetClassValue ac1 1 <> Script.lovelace 1234),
-                                wallet 2 `receives` Value (Api.assetClassValue ac2 2),
-                                attacker `receives` Value increment
+               in [ ( txSkelTemplate
+                        { txSkelLabel = Set.singleton $ TxSkelLabel DupTokenLbl,
+                          txSkelMints =
+                            review
+                              txSkelMintsListI
+                              [ mint pol1 () tName1 v1,
+                                mint pol2 () tName2 v2
                               ],
-                            txSkelSignatories = txSkelSignatoriesFromList [wallet 3]
-                          }
-                      )
+                          txSkelOuts =
+                            [ wallet 1 `receives` Value (Api.assetClassValue ac1 1 <> Script.lovelace 1234),
+                              wallet 2 `receives` Value (Api.assetClassValue ac2 2),
+                              attacker `receives` Value increment
+                            ],
+                          txSkelSignatories = txSkelSignatoriesFromList [wallet 3]
+                        },
+                      increment
+                    )
                   ]
          in [ testCase "add one token in every asset class" $
-                skelExpected 6 8 @=? mcrValue <$> skelOut (\_ _ n -> n + 1),
+                skelExpected 6 8 @=? skelOut (\_ _ n -> n + 1),
               testCase "no modified transaction if no increase in value specified" $
-                [] @=? mcrValue <$> skelOut (\_ _ n -> n),
+                [] @=? skelOut (\_ _ n -> n),
               testCase "add tokens depending on the asset class" $
-                skelExpected 10 7 @=? mcrValue <$> skelOut (\mp tk n -> if Api.assetClass (Script.toCurrencySymbol mp) tk == ac1 then n + 5 else n)
+                skelExpected 10 7 @=? skelOut (\mp tk n -> if Api.assetClass (Script.toCurrencySymbol mp) tk == ac1 then n + 5 else n)
             ],
       testCooked "careful minting policy" $
         let tName = Api.TokenName "MockToken"
@@ -103,19 +104,18 @@ tests =
                   txSkelSignatories = txSkelSignatoriesFromList [wallet 2]
                 }
             skelExpected =
-              [ Right
-                  ( Api.assetClassValue ac1 1,
-                    txSkelTemplate
-                      { txSkelLabel = Set.singleton $ TxSkelLabel DupTokenLbl,
-                        txSkelMints = review txSkelMintsListI [mint pol () tName1 2],
-                        txSkelOuts =
-                          [ wallet 1 `receives` Value (Api.assetClassValue ac1 1 <> Api.assetClassValue ac2 2),
-                            attacker `receives` Value (Api.assetClassValue ac1 1)
-                          ],
-                        txSkelSignatories = txSkelSignatoriesFromList [wallet 2]
-                      }
-                  )
+              [ ( txSkelTemplate
+                    { txSkelLabel = Set.singleton $ TxSkelLabel DupTokenLbl,
+                      txSkelMints = review txSkelMintsListI [mint pol () tName1 2],
+                      txSkelOuts =
+                        [ wallet 1 `receives` Value (Api.assetClassValue ac1 1 <> Api.assetClassValue ac2 2),
+                          attacker `receives` Value (Api.assetClassValue ac1 1)
+                        ],
+                      txSkelSignatories = txSkelSignatoriesFromList [wallet 2]
+                    },
+                  Api.assetClassValue ac1 1
+                )
               ]
-            skelOut = runTweak (dupTokenAttack (\_ _ i -> i + 1) attacker) skelIn
-         in skelExpected @=? mcrValue <$> skelOut
+            skelOut = (run . runNonDet . runTweak skelIn) (dupTokenAttack (\_ _ i -> i + 1) attacker)
+         in skelExpected @=? skelOut
     ]
diff --git a/tests/Spec/Balancing.hs b/tests/Spec/Balancing.hs
index 12166fd50..bfd9f3015 100644
--- a/tests/Spec/Balancing.hs
+++ b/tests/Spec/Balancing.hs
@@ -8,9 +8,7 @@ import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Text (isInfixOf)
 import Ledger.Index qualified as Ledger
-import ListT
 import Optics.Core
-import Optics.Core.Extras
 import Plutus.Script.Utils.V3 qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
 import PlutusLedgerApi.V3 qualified as Api
@@ -41,35 +39,34 @@ initialDistributionBalancing =
 
 type TestBalancingOutcome = (TxSkel, TxSkel, Fee, Collaterals, [Api.TxOutRef])
 
-spendsScriptUtxo :: (MonadBlockChain m) => Bool -> m (Map Api.TxOutRef TxSkelRedeemer)
+spendsScriptUtxo :: Bool -> FullMockChain (Map Api.TxOutRef TxSkelRedeemer)
 spendsScriptUtxo False = return Map.empty
 spendsScriptUtxo True = do
-  (scriptOutRef, _) : _ <- runUtxoSearch $ utxosOwnedBySearch $ Script.trueSpendingMPScript @()
+  (scriptOutRef, _) : _ <- utxosAt $ Script.trueSpendingMPScript @()
   return $ Map.singleton scriptOutRef emptyTxSkelRedeemerNoAutoFill
 
 testingBalancingTemplate ::
-  (MonadBlockChain m) =>
   -- Value to pay to bob
   Api.Value ->
   -- Value to pay back to alice
   Api.Value ->
-  -- Search for utxos to be spent
-  UtxoSearch m a ->
-  -- Search for utxos to be used for balancing
-  UtxoSearch m b ->
-  -- Search for utxos to be used for collaterals
-  UtxoSearch m c ->
+  -- utxos to be spent
+  FullMockChain [Api.TxOutRef] ->
+  -- utxos to be used for balancing
+  FullMockChain [Api.TxOutRef] ->
+  -- utxos to be used for collaterals
+  FullMockChain [Api.TxOutRef] ->
   -- Whether to consum the script utxo
   Bool ->
   -- Option modifications
   (TxSkelOpts -> TxSkelOpts) ->
   -- Wether to adjust the output with min ada
   Bool ->
-  m TestBalancingOutcome
+  FullMockChain TestBalancingOutcome
 testingBalancingTemplate toBobValue toAliceValue spendSearch balanceSearch collateralSearch consumeScriptUtxo optionsMod adjust = do
-  ((fst <$>) -> toSpendUtxos) <- runUtxoSearch spendSearch
-  ((fst <$>) -> toBalanceUtxos) <- runUtxoSearch balanceSearch
-  ((fst <$>) -> toCollateralUtxos) <- runUtxoSearch collateralSearch
+  toSpendUtxos <- spendSearch
+  toBalanceUtxos <- balanceSearch
+  toCollateralUtxos <- collateralSearch
   additionalSpend <- spendsScriptUtxo consumeScriptUtxo
   let valueConstr = if adjust then Value else FixedValue
       skel =
@@ -97,25 +94,32 @@ testingBalancingTemplate toBobValue toAliceValue spendSearch balanceSearch colla
           }
   (skel', fee, mCols) <- balanceTxSkel skel
   validateTxSkel_ skel
-  nonOnlyValueUtxos <- runUtxoSearch aliceNonOnlyValueUtxos
-  return (skel, skel', fee, mCols, fst <$> nonOnlyValueUtxos)
+  nonOnlyValueUtxos <- aliceNonOnlyValueUtxos
+  return (skel, skel', fee, mCols, nonOnlyValueUtxos)
 
-aliceNonOnlyValueUtxos :: (MonadBlockChain m) => UtxoSearch m TxSkelOut
+aliceNonOnlyValueUtxos :: FullMockChain [Api.TxOutRef]
 aliceNonOnlyValueUtxos =
-  utxosOwnedBySearch alice `filterWithPred` \o ->
-    is txSkelOutReferenceScriptAT o
-      || is (txSkelOutDatumL % txSkelOutDatumKindAT) o
-
-aliceNAdaUtxos :: (MonadBlockChain m) => Integer -> UtxoSearch m TxSkelOut
-aliceNAdaUtxos n = utxosOwnedBySearch alice `filterWithValuePred` ((== Api.Lovelace (n * 1_000_000)) . Api.lovelaceValueOf)
-
-aliceRefScriptUtxos :: (MonadBlockChain m) => UtxoSearch m TxSkelOut
-aliceRefScriptUtxos = utxosOwnedBySearch alice `filterWithPred` is txSkelOutReferenceScriptAT
-
-emptySearch :: (MonadBlockChain m) => UtxoSearch m TxSkelOut
-emptySearch = ListT.fromFoldable []
-
-simplePaymentToBob :: (MonadBlockChain m) => Integer -> Integer -> Integer -> Integer -> Bool -> (TxSkelOpts -> TxSkelOpts) -> Bool -> m TestBalancingOutcome
+  getTxOutRefs $
+    utxosAtSearch alice $
+      ensureAFoldIs txSkelOutReferenceScriptAT
+        . ensureAFoldIs (txSkelOutDatumL % txSkelOutDatumKindAT)
+
+aliceNAdaUtxos :: Integer -> FullMockChain [Api.TxOutRef]
+aliceNAdaUtxos n =
+  getTxOutRefs $
+    utxosAtSearch alice $
+      ensureAFoldIs (txSkelOutValueL % valueLovelaceL % filtered (== Api.Lovelace (n * 1_000_000)))
+
+aliceRefScriptUtxos :: FullMockChain [Api.TxOutRef]
+aliceRefScriptUtxos =
+  getTxOutRefs $
+    utxosAtSearch alice $
+      ensureAFoldIs txSkelOutReferenceScriptAT
+
+emptySearch :: FullMockChain [Api.TxOutRef]
+emptySearch = return []
+
+simplePaymentToBob :: Integer -> Integer -> Integer -> Integer -> Bool -> (TxSkelOpts -> TxSkelOpts) -> Bool -> FullMockChain TestBalancingOutcome
 simplePaymentToBob lv apples oranges bananas =
   testingBalancingTemplate
     (Script.lovelace lv <> apple apples <> orange oranges <> banana bananas)
@@ -124,7 +128,7 @@ simplePaymentToBob lv apples oranges bananas =
     emptySearch
     emptySearch
 
-bothPaymentsToBobAndAlice :: (MonadBlockChain m) => Integer -> Bool -> (TxSkelOpts -> TxSkelOpts) -> Bool -> m TestBalancingOutcome
+bothPaymentsToBobAndAlice :: Integer -> Bool -> (TxSkelOpts -> TxSkelOpts) -> Bool -> FullMockChain TestBalancingOutcome
 bothPaymentsToBobAndAlice val =
   testingBalancingTemplate
     (Script.lovelace val)
@@ -133,10 +137,10 @@ bothPaymentsToBobAndAlice val =
     emptySearch
     emptySearch
 
-noBalanceMaxFee :: (MonadBlockChain m) => m ()
+noBalanceMaxFee :: FullMockChain ()
 noBalanceMaxFee = do
   maxFee <- snd <$> getMinAndMaxFee 0
-  ((txOutRef, _) : _) <- runUtxoSearch $ utxosOwnedBySearch alice `filterWithValuePred` (== Script.ada 30)
+  (txOutRef : _) <- aliceNAdaUtxos 30
   validateTxSkel_ $
     txSkelTemplate
       { txSkelOuts = [bob `receives` Value (Script.lovelace (30_000_000 - maxFee))],
@@ -149,7 +153,7 @@ noBalanceMaxFee = do
         txSkelSignatories = txSkelSignatoriesFromList [alice]
       }
 
-balanceReduceFee :: (MonadBlockChain m) => m (Integer, Integer, Integer, Integer)
+balanceReduceFee :: FullMockChain (Integer, Integer, Integer, Integer)
 balanceReduceFee = do
   let skelAutoFee =
         txSkelTemplate
@@ -169,9 +173,9 @@ balanceReduceFee = do
   feeBalancedManual' <- estimateTxSkelFee skelBalancedManual feeBalancedManual mColsManual
   return (feeBalanced, feeBalanced', feeBalancedManual, feeBalancedManual')
 
-reachingMagic :: (MonadBlockChain m) => m ()
+reachingMagic :: FullMockChain ()
 reachingMagic = do
-  bananaOutRefs <- (fst <$>) <$> runUtxoSearch (utxosOwnedBySearch alice `filterWithValuePred` (banana 1 `Api.leq`))
+  bananaOutRefs <- getTxOutRefs $ utxosAtSearch alice $ ensureAFoldIs (txSkelOutValueL % filtered (banana 1 <=))
   validateTxSkel_ $
     txSkelTemplate
       { txSkelOuts = [bob `receives` Value (Script.ada 106 <> banana 12)],
@@ -200,7 +204,7 @@ colInsNb cis (_, _, _, Just (refs, _), _) = testBool $ cis == length refs
 retOutsNb :: Int -> ResProp
 retOutsNb ros (_, _, _, _, refs) = testBool $ ros == length refs
 
-testBalancingSucceedsWith :: String -> [ResProp] -> StagedMockChain TestBalancingOutcome -> TestTree
+testBalancingSucceedsWith :: String -> [ResProp] -> FullMockChain TestBalancingOutcome -> TestTree
 testBalancingSucceedsWith msg props run =
   testCooked msg $
     mustSucceedTest run
@@ -239,7 +243,7 @@ failsLackOfCollateralWallet :: MockChainError -> Assertion
 failsLackOfCollateralWallet (MCEMissingBalancingUser msg) = "Collateral utxos should be taken from the balancing user, but it does not exist." .==. msg
 failsLackOfCollateralWallet _ = testBool False
 
-testBalancingFailsWith :: (Show a) => String -> (MockChainError -> Assertion) -> StagedMockChain a -> TestTree
+testBalancingFailsWith :: (Show a) => String -> (MockChainError -> Assertion) -> FullMockChain a -> TestTree
 testBalancingFailsWith msg p smc =
   testCooked msg $
     mustFailTest smc
@@ -451,7 +455,7 @@ tests =
                   ( testingBalancingTemplate
                       (Script.ada 142)
                       mempty
-                      (utxosOwnedBySearch alice)
+                      ((fst <$>) <$> utxosAt alice)
                       emptySearch
                       (aliceNAdaUtxos 1)
                       True
@@ -635,7 +639,7 @@ tests =
                     (apple 2 <> orange 5 <> banana 4)
                     mempty
                     emptySearch
-                    (utxosOwnedBySearch alice)
+                    ((fst <$>) <$> utxosAt alice)
                     emptySearch
                     False
                     (setFixedFee 1_000_000)
@@ -647,7 +651,7 @@ tests =
                 ( testingBalancingTemplate
                     mempty
                     mempty
-                    (onlyValueOutputsAtSearch alice)
+                    ((fst <$>) <$> utxosAt alice)
                     emptySearch
                     emptySearch
                     False
diff --git a/tests/Spec/BasicUsage.hs b/tests/Spec/BasicUsage.hs
index f24e4fa1d..a8182a36f 100644
--- a/tests/Spec/BasicUsage.hs
+++ b/tests/Spec/BasicUsage.hs
@@ -12,7 +12,7 @@ alice = wallet 1
 bob = wallet 2
 carrie = wallet 3
 
-pkToPk :: (MonadBlockChain m) => Wallet -> Wallet -> Integer -> m ()
+pkToPk :: Wallet -> Wallet -> Integer -> StagedMockChain ()
 pkToPk sender recipient amount =
   validateTxSkel_ $
     txSkelTemplate
@@ -20,14 +20,14 @@ pkToPk sender recipient amount =
         txSkelSignatories = txSkelSignatoriesFromList [sender]
       }
 
-multiplePksToPks :: (MonadBlockChain m) => m ()
+multiplePksToPks :: StagedMockChain ()
 multiplePksToPks =
   do
     pkToPk alice bob 10
     pkToPk bob carrie 10
     pkToPk carrie alice 10
 
-mintingQuickValue :: (MonadBlockChain m) => m ()
+mintingQuickValue :: StagedMockChain ()
 mintingQuickValue =
   validateTxSkel_
     txSkelTemplate
@@ -36,7 +36,7 @@ mintingQuickValue =
         txSkelSignatories = txSkelSignatoriesFromList [alice]
       }
 
-payToAlwaysTrueValidator :: (MonadBlockChain m) => m Api.TxOutRef
+payToAlwaysTrueValidator :: StagedMockChain Api.TxOutRef
 payToAlwaysTrueValidator =
   head
     <$> ( validateTxSkel' $
@@ -46,7 +46,7 @@ payToAlwaysTrueValidator =
               }
         )
 
-consumeAlwaysTrueValidator :: (MonadBlockChain m) => m ()
+consumeAlwaysTrueValidator :: StagedMockChain ()
 consumeAlwaysTrueValidator = do
   outref <- payToAlwaysTrueValidator
   validateTxSkel_ $
diff --git a/tests/Spec/Certificates.hs b/tests/Spec/Certificates.hs
index 2eb2eb278..1f932e631 100644
--- a/tests/Spec/Certificates.hs
+++ b/tests/Spec/Certificates.hs
@@ -12,7 +12,7 @@ alice = wallet 1
 bob :: Wallet
 bob = wallet 1
 
-publishCertificate :: (MonadModalBlockChain m) => TxSkelCertificate -> m ()
+publishCertificate :: TxSkelCertificate -> DirectMockChain ()
 publishCertificate cert =
   validateTxSkel_ $
     txSkelTemplate
@@ -20,7 +20,7 @@ publishCertificate cert =
         txSkelCertificates = [cert]
       }
 
-withdraw :: (MonadBlockChain m) => User IsEither Redemption -> m ()
+withdraw :: User IsEither Redemption -> DirectMockChain ()
 withdraw user =
   validateTxSkel_ $
     txSkelTemplate
diff --git a/tests/Spec/InitialDistribution.hs b/tests/Spec/InitialDistribution.hs
index cb0426a7d..cfe2f8fc2 100644
--- a/tests/Spec/InitialDistribution.hs
+++ b/tests/Spec/InitialDistribution.hs
@@ -2,7 +2,6 @@ module Spec.InitialDistribution where
 
 import Cooked
 import Data.Map qualified as Map
-import Data.Maybe (catMaybes)
 import Optics.Core
 import Plutus.Script.Utils.V3 qualified as Script
 import Test.Tasty
@@ -25,14 +24,13 @@ initialDistributionWithReferenceScript =
     (alice `receives` Value (Script.ada 2) <&&> ReferenceScript (Script.trueSpendingMPScript @()))
       : replicate 2 (bob `receives` Value (Script.ada 100))
 
-getValueFromInitialDatum :: (MonadBlockChain m) => m [Integer]
+getValueFromInitialDatum :: DirectMockChain [Integer]
 getValueFromInitialDatum = do
-  aliceUtxos <- runUtxoSearch $ utxosOwnedBySearch alice
-  catMaybes <$> mapM (previewByRef (txSkelOutDatumL % txSkelOutDatumTypedAT @Integer) . fst) aliceUtxos
+  fmap hHead <$> getExtracts (utxosAtSearch alice (extractAFold (txSkelOutDatumL % txSkelOutDatumTypedAT @Integer)))
 
-spendReferenceAlwaysTrueValidator :: (MonadBlockChain m) => m ()
+spendReferenceAlwaysTrueValidator :: DirectMockChain ()
 spendReferenceAlwaysTrueValidator = do
-  [(referenceScriptTxOutRef, _)] <- runUtxoSearch $ utxosOwnedBySearch alice
+  [(referenceScriptTxOutRef, _)] <- utxosAt alice
   (scriptTxOutRef : _) <-
     validateTxSkel' $
       txSkelTemplate
diff --git a/tests/Spec/InlineDatums.hs b/tests/Spec/InlineDatums.hs
index 91ad48e62..1b3cbee55 100644
--- a/tests/Spec/InlineDatums.hs
+++ b/tests/Spec/InlineDatums.hs
@@ -19,10 +19,9 @@ instance PrettyCooked SimpleContractDatum where
 -- pay a script with an inline datum, while @listUtxosTestTrace False@ will use
 -- a datum hash.
 listUtxosTestTrace ::
-  (MonadBlockChain m) =>
   Bool ->
   Script.Versioned Script.Validator ->
-  m (Api.TxOutRef, TxSkelOut)
+  DirectMockChain (Api.TxOutRef, TxSkelOut)
 listUtxosTestTrace useInlineDatum validator =
   (\oref -> (oref,) <$> txSkelOutByRef oref) . head
     =<< validateTxSkel'
@@ -39,10 +38,9 @@ listUtxosTestTrace useInlineDatum validator =
 -- This is used to test whether a validator will correctly see the
 -- _input data_ of a transaction as inline datums or datum hashes.
 spendOutputTestTrace ::
-  (MonadBlockChain m) =>
   Bool ->
   Script.Versioned Script.Validator ->
-  m ()
+  DirectMockChain ()
 spendOutputTestTrace useInlineDatum validator = do
   (theTxOutRef, _) <- listUtxosTestTrace useInlineDatum validator
   validateTxSkel_
@@ -62,10 +60,9 @@ spendOutputTestTrace useInlineDatum validator = do
 -- This is used to test whether a validator will correctly see the _output data_
 -- of atransaction as inline datums or datum hashes.
 continuingOutputTestTrace ::
-  (MonadBlockChain m) =>
   OutputDatumKind ->
   Script.Versioned Script.Validator ->
-  m ()
+  DirectMockChain ()
 continuingOutputTestTrace datumKindOnSecondPayment validator = do
   (theTxOutRef, theOutput) <- listUtxosTestTrace True validator
   validateTxSkel_
diff --git a/tests/Spec/MinAda.hs b/tests/Spec/MinAda.hs
index f269c91d4..65ef5ec63 100644
--- a/tests/Spec/MinAda.hs
+++ b/tests/Spec/MinAda.hs
@@ -21,7 +21,7 @@ heavyDatum = HeavyDatum (take 100 [0 ..])
 instance PrettyCooked HeavyDatum where
   prettyCookedOpt opts (HeavyDatum ints) = prettyItemizeNoTitle opts "-" ints
 
-paymentWithMinAda :: (MonadBlockChain m) => m Integer
+paymentWithMinAda :: DirectMockChain Integer
 paymentWithMinAda = do
   tx <-
     validateTxSkel
@@ -31,7 +31,7 @@ paymentWithMinAda = do
         }
   view (txSkelOutValueL % valueLovelaceL % lovelaceIntegerI) . snd . (!! 0) <$> utxosFromCardanoTx tx
 
-paymentWithoutMinAda :: (MonadBlockChain m) => Integer -> m ()
+paymentWithoutMinAda :: Integer -> DirectMockChain ()
 paymentWithoutMinAda paidLovelaces = do
   validateTxSkel_
     txSkelTemplate
diff --git a/tests/Spec/MultiPurpose.hs b/tests/Spec/MultiPurpose.hs
index 0c69c7af1..28159a16a 100644
--- a/tests/Spec/MultiPurpose.hs
+++ b/tests/Spec/MultiPurpose.hs
@@ -22,7 +22,7 @@ alice, bob :: Wallet
 alice = wallet 1
 bob = wallet 2
 
-runScript :: (MonadModalBlockChain m) => m ()
+runScript :: StagedMockChain ()
 runScript = do
   [oRef@(Api.TxOutRef txId _), oRef', oRef''] <-
     validateTxSkel' $
diff --git a/tests/Spec/ProposingScript.hs b/tests/Spec/ProposingScript.hs
index 16be65b92..7d980ab03 100644
--- a/tests/Spec/ProposingScript.hs
+++ b/tests/Spec/ProposingScript.hs
@@ -9,7 +9,6 @@ alice :: Wallet
 alice = wallet 1
 
 testProposingScript ::
-  (MonadBlockChain m) =>
   -- | Whether or not to automatically fetch a reference script
   Bool ->
   -- | Whether or not to automatically attach the constitution
@@ -20,7 +19,7 @@ testProposingScript ::
   Maybe VScript ->
   -- | The governance action to propose
   GovernanceAction IsScript ->
-  m ()
+  DirectMockChain ()
 testProposingScript autoRefScript autoConstitution constitution mScript govAction = do
   setConstitutionScript constitution
   validateTxSkel_ $
diff --git a/tests/Spec/ReferenceInputs.hs b/tests/Spec/ReferenceInputs.hs
index e9a618394..32d5f7257 100644
--- a/tests/Spec/ReferenceInputs.hs
+++ b/tests/Spec/ReferenceInputs.hs
@@ -13,7 +13,7 @@ import Test.Tasty qualified as Tasty
 instance PrettyCooked FooDatum where
   prettyCookedOpt opts (FooDatum pkh) = "FooDatum" PP.<+> prettyHash opts pkh
 
-trace1 :: (MonadBlockChain m) => m ()
+trace1 :: DirectMockChain ()
 trace1 = do
   txOutRefFoo : txOutRefBar : _ <-
     validateTxSkel'
@@ -32,7 +32,7 @@ trace1 = do
         txSkelSignatories = txSkelSignatoriesFromList [wallet 3]
       }
 
-trace2 :: (MonadBlockChain m) => m ()
+trace2 :: DirectMockChain ()
 trace2 = do
   refORef : scriptORef : _ <-
     validateTxSkel'
diff --git a/tests/Spec/ReferenceScripts.hs b/tests/Spec/ReferenceScripts.hs
index 7b06199f2..9f1ad94e2 100644
--- a/tests/Spec/ReferenceScripts.hs
+++ b/tests/Spec/ReferenceScripts.hs
@@ -14,10 +14,9 @@ import PlutusLedgerApi.V3 qualified as V3
 import Test.Tasty
 
 putRefScriptOnWalletOutput ::
-  (MonadBlockChain m) =>
   Wallet ->
   Script.Versioned Script.Validator ->
-  m V3.TxOutRef
+  DirectMockChain V3.TxOutRef
 putRefScriptOnWalletOutput recipient referenceScript =
   head
     <$> validateTxSkel'
@@ -27,10 +26,9 @@ putRefScriptOnWalletOutput recipient referenceScript =
         }
 
 putRefScriptOnScriptOutput ::
-  (MonadBlockChain m) =>
   Script.Versioned Script.Validator ->
   Script.Versioned Script.Validator ->
-  m V3.TxOutRef
+  DirectMockChain V3.TxOutRef
 putRefScriptOnScriptOutput recipient referenceScript =
   head
     <$> validateTxSkel'
@@ -40,10 +38,9 @@ putRefScriptOnScriptOutput recipient referenceScript =
         }
 
 checkReferenceScriptOnOref ::
-  (MonadBlockChain m) =>
   Api.ScriptHash ->
   V3.TxOutRef ->
-  m ()
+  DirectMockChain ()
 checkReferenceScriptOnOref expectedScriptHash refScriptOref = do
   oref : _ <-
     validateTxSkel'
@@ -62,7 +59,7 @@ checkReferenceScriptOnOref expectedScriptHash refScriptOref = do
 -- should be consumed in the transaction or not. If it should, then at
 -- transaction generation no reference input should appear, as inputs also act
 -- as reference inputs.
-useReferenceScript :: (MonadBlockChain m) => Wallet -> Bool -> Script.Versioned Script.Validator -> m Ledger.CardanoTx
+useReferenceScript :: Wallet -> Bool -> Script.Versioned Script.Validator -> DirectMockChain Ledger.CardanoTx
 useReferenceScript spendingSubmitter consumeScriptOref theScript = do
   scriptOref <- putRefScriptOnWalletOutput (wallet 3) theScript
   oref : _ <-
@@ -80,7 +77,7 @@ useReferenceScript spendingSubmitter consumeScriptOref theScript = do
         txSkelSignatories = txSkelSignatoriesFromList $ spendingSubmitter : [wallet 3 | consumeScriptOref]
       }
 
-useReferenceScriptInInputs :: (MonadBlockChain m) => Wallet -> Script.Versioned Script.Validator -> m ()
+useReferenceScriptInInputs :: Wallet -> Script.Versioned Script.Validator -> DirectMockChain ()
 useReferenceScriptInInputs spendingSubmitter theScript = do
   scriptOref <- putRefScriptOnWalletOutput (wallet 1) theScript
   oref : _ <-
@@ -95,7 +92,7 @@ useReferenceScriptInInputs spendingSubmitter theScript = do
         txSkelSignatories = txSkelSignatoriesFromList [spendingSubmitter]
       }
 
-referenceMint :: (MonadBlockChain m) => Script.Versioned Script.MintingPolicy -> Script.Versioned Script.MintingPolicy -> Int -> Bool -> m ()
+referenceMint :: Script.Versioned Script.MintingPolicy -> Script.Versioned Script.MintingPolicy -> Int -> Bool -> DirectMockChain ()
 referenceMint mp1 mp2 n autoRefScript = do
   ((!! n) -> mpOutRef) <-
     validateTxSkel' $
@@ -147,13 +144,10 @@ tests =
         ],
       testGroup
         "using reference scripts"
-        [ testCooked "fail from transaction generation for missing reference scripts" $
+        [ testCooked @DirectEffs "fail from transaction generation for missing reference scripts" $
             mustFailTest
               ( do
-                  (consumedOref, _) : _ <-
-                    runUtxoSearch $
-                      utxosOwnedBySearch (wallet 1)
-                        `filterWithValuePred` (`Api.geq` Script.lovelace 42_000_000)
+                  consumedOref : _ <- getTxOutRefs $ utxosAtSearch (wallet 1) $ ensureAFoldIs (txSkelOutValueL % filtered (`Api.geq` Script.lovelace 42_000_000))
                   oref : _ <-
                     validateTxSkel'
                       txSkelTemplate
diff --git a/tests/Spec/Slot.hs b/tests/Spec/Slot.hs
index 24190593d..e304af3f5 100644
--- a/tests/Spec/Slot.hs
+++ b/tests/Spec/Slot.hs
@@ -1,7 +1,5 @@
 module Spec.Slot (tests) where
 
-import Cooked.MockChain.BlockChain
-import Cooked.MockChain.Direct
 import Ledger.Slot qualified as Ledger
 import PlutusLedgerApi.V3 qualified as Api
 import Test.Tasty
diff --git a/tests/Spec/Tweak/Labels.hs b/tests/Spec/Tweak/Labels.hs
index 8c2190acd..2bd0a1333 100644
--- a/tests/Spec/Tweak/Labels.hs
+++ b/tests/Spec/Tweak/Labels.hs
@@ -14,7 +14,7 @@ alice = wallet 1
 bob = wallet 2
 carrie = wallet 3
 
-payTo :: (MonadBlockChain m) => Wallet -> Integer -> m ()
+payTo :: Wallet -> Integer -> StagedMockChain ()
 payTo target amount = do
   validateTxSkel_ $
     txSkelTemplate
@@ -22,7 +22,7 @@ payTo target amount = do
         txSkelOuts = [target `receives` Value (Script.ada amount)]
       }
 
-payments :: (MonadBlockChain m) => m ()
+payments :: StagedMockChain ()
 payments = do
   payTo alice 10
   payTo bob 5
@@ -30,12 +30,12 @@ payments = do
   payTo alice 25
   payTo alice 32
 
-labelAmountTweak :: (MonadTweak m) => m ()
+labelAmountTweak :: StagedTweak ()
 labelAmountTweak = do
   [target] <- viewAllTweak (txSkelOutsL % _head % txSkelOutValueL % valueLovelaceL)
   addLabelTweak $ Api.getLovelace target
 
-labelNameTweak :: (MonadTweak m) => m ()
+labelNameTweak :: StagedTweak ()
 labelNameTweak = do
   target <-
     viewAllTweak
@@ -50,7 +50,7 @@ labelNameTweak = do
     [t] | t == bob -> addLabelTweak @Text "Bob"
     _ -> mzero
 
-labelNames :: (MonadModalBlockChain m) => m ()
+labelNames :: StagedMockChain ()
 labelNames = everywhere labelNameTweak payments
 
 tests :: TestTree
diff --git a/tests/Spec/Tweak/ValidityRange.hs b/tests/Spec/Tweak/ValidityRange.hs
index 8378fb196..44a34bb8d 100644
--- a/tests/Spec/Tweak/ValidityRange.hs
+++ b/tests/Spec/Tweak/ValidityRange.hs
@@ -1,11 +1,27 @@
 module Spec.Tweak.ValidityRange (tests) where
 
-import Control.Monad
-import Cooked
+import Control.Monad (void)
+import Cooked.MockChain.Error
+import Cooked.MockChain.Log
+import Cooked.MockChain.MockChainState
+import Cooked.MockChain.Read
+import Cooked.MockChain.Testing
+import Cooked.MockChain.Write
+import Cooked.Skeleton
+import Cooked.Tweak.Common
+import Cooked.Tweak.ValidityRange
+import Data.Default (def)
 import Data.Either (rights)
 import Data.Function (on)
 import Ledger.Slot qualified as Ledger
+import Ledger.Tx qualified as Ledger
 import PlutusLedgerApi.V1.Interval qualified as Api
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
+import Polysemy.NonDet
+import Polysemy.State
+import Polysemy.Writer
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, assertBool, testCase)
 
@@ -18,7 +34,7 @@ toSlotRangeTranslate translation a b =
     (Ledger.getSlot translation + a)
     (Ledger.getSlot translation + b)
 
-checkIsValidDuring :: (MonadTweak m) => m Assertion
+checkIsValidDuring :: (Member Tweak effs) => Sem effs Assertion
 checkIsValidDuring = do
   b <- hasFullTimeRangeTweak
   b1 <- isValidDuringTweak $ toSlotRange 101 1015
@@ -29,7 +45,7 @@ checkIsValidDuring = do
     assertBool "interval inclusions are wrong" $
       b && b1 && b2 && not b3
 
-checkAddToValidityRange :: (MonadTweak m) => m Assertion
+checkAddToValidityRange :: (Members '[Tweak, MockChainRead, MockChainWrite, NonDet] effs) => Sem effs Assertion
 checkAddToValidityRange = do
   timeOrigin <- currentSlot
   void $ centerAroundValidityRangeTweak (timeOrigin + Ledger.Slot 100) 80
@@ -47,22 +63,41 @@ checkAddToValidityRange = do
     assertBool "interval intersection is wrong" $
       b && b1 && b2 && b3 && not b4 && b5
 
-checkMoveCurrentSlot :: (MonadTweak m) => m Assertion
-checkMoveCurrentSlot = do
-  void $ setValidityRangeTweak $ toSlotRange 10 20
-  void waitUntilValidTweak
-  b1 <- (\now -> now >= 10 && now <= 20) <$> currentSlot
-  b2 <- isValidNowTweak
-  void $ setValidityRangeTweak $ toSlotRange 15 25
-  void waitUntilValidTweak
-  b3 <- (\now -> now >= 15 && now <= 25) <$> currentSlot
-  return $ assertBool "Time shift did not occur" $ b1 && b2 && b3
+type ValidityRangeEffs =
+  '[ Tweak,
+     MockChainWrite,
+     MockChainRead,
+     NonDet
+   ]
+
+interpretValidityRange :: Sem ValidityRangeEffs a -> [a]
+interpretValidityRange =
+  run
+    . fmap rights
+    . runNonDet
+    . fmap snd
+    . runWriter
+    . runMockChainLog
+    . evalState def
+    . runError
+    . runFailInMockChainError
+    . runToCardanoErrorInMockChainError
+    . runMockChainRead
+    . runMockChainWrite
+    . evalTweak txSkelTemplate
+    . insertAt @3
+      @'[ Error Ledger.ToCardanoError,
+          Fail,
+          Error MockChainError,
+          State MockChainState,
+          MockChainLog,
+          Writer [MockChainLogEntry]
+        ]
 
 tests :: TestTree
 tests =
   testGroup
     "Validity range tweaks"
-    [ testCase "Validity inclusion" $ fst . head . rights $ mcrValue <$> runTweak checkIsValidDuring txSkelTemplate,
-      testCase "Validity intersection" $ fst . head . rights $ mcrValue <$> runTweak checkAddToValidityRange txSkelTemplate,
-      testCase "Time shifting in validity range" $ fst . head . rights $ mcrValue <$> runTweak checkMoveCurrentSlot txSkelTemplate
+    [ testCase "Validity inclusion" $ testConjoin $ interpretValidityRange checkIsValidDuring,
+      testCase "Validity intersection" $ testConjoin $ interpretValidityRange checkAddToValidityRange
     ]
diff --git a/tests/Spec/Withdrawals.hs b/tests/Spec/Withdrawals.hs
index f23f041c5..b76996bb2 100644
--- a/tests/Spec/Withdrawals.hs
+++ b/tests/Spec/Withdrawals.hs
@@ -12,11 +12,10 @@ alice :: Wallet
 alice = wallet 1
 
 testWithdrawingScript ::
-  (MonadModalBlockChain m) =>
   Maybe (User IsEither Redemption) ->
   User IsEither Redemption ->
   Maybe Integer ->
-  m ()
+  StagedMockChain ()
 testWithdrawingScript userCertifying userRewarding mAmount = do
   when (isJust userCertifying) $
     validateTxSkel_ $

From 723b998c5f6de6526e7c70e865d43a634ac41423 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sat, 24 Jan 2026 02:47:15 +0100
Subject: [PATCH 42/96] fixing running

---
 src/Cooked/MockChain/Instances.hs | 48 +++++++++++++--------------
 src/Cooked/MockChain/Testing.hs   |  4 +--
 tests/Spec/Attack/DoubleSat.hs    | 35 ++++++++++++--------
 tests/Spec/Ltl.hs                 | 55 ++++++++++++++++++++++---------
 4 files changed, 86 insertions(+), 56 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index fa50e2867..4ee43d9e3 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -84,44 +84,44 @@ stateFromMockChainReturn :: FunOnMockChainResult a MockChainState
 stateFromMockChainReturn = fst . snd . snd
 
 -- | Configuration to run a mockchain
-data MockChainConf effs a b where
+data MockChainConf a b where
   MockChainConf ::
     { -- | The initial state from which to run the 'MockChainT'
       mccInitialState :: MockChainState,
       -- | The initial payments to issue in the run
       mccInitialDistribution :: InitialDistribution,
       -- | The function to apply on the results of the run
-      mccFunOnResult :: FunOnMockChainResult a b,
-      -- | The actual run to execute
-      mccRun :: Sem effs a,
-      -- | The interpreter for the run. We always expect several possible
-      -- outcomes for a run, even when the effect stack does not make use of
-      -- `NonDet` in which case the list will be a singleton.
-      mccRunner :: forall a'. MockChainState -> Sem effs a' -> [RawMockChainReturn a']
+      mccFunOnResult :: FunOnMockChainResult a b
     } ->
-    MockChainConf effs a b
+    MockChainConf a b
 
--- | Running a mockchain conf to get a list of results of the expected type
-runMockChainConf ::
-  (Member MockChainWrite effs) =>
-  MockChainConf effs a b ->
-  [b]
-runMockChainConf (MockChainConf initialState initialDist funOnRes currentRun runner) =
-  funOnRes <$> runner initialState (forceOutputs (unInitialDistribution initialDist) >> currentRun)
+mockChainConfTemplate :: MockChainConf a (MockChainReturn a)
+mockChainConfTemplate = MockChainConf def def unRawMockChainReturn
+
+-- -- | Running a mockchain conf to get a list of results of the expected type
+-- runMockChainConf ::
+--   (Member MockChainWrite effs) =>
+--   MockChainConf effs a b ->
+--   [b]
+-- runMockChainConf (MockChainConf initialState initialDist funOnRes currentRun runner) =
+--   funOnRes <$> runner initialState (forceOutputs (unInitialDistribution initialDist) >> currentRun)
 
 class MockChain effs where
   runMockChain :: MockChainState -> Sem effs a -> [RawMockChainReturn a]
 
-runMockChainDef :: (MockChain effs) => Sem effs a -> [RawMockChainReturn a]
-runMockChainDef = runMockChain def
+runMockChainFromConf ::
+  (MockChain effs, Member MockChainWrite effs) =>
+  MockChainConf a b ->
+  Sem effs a ->
+  [b]
+runMockChainFromConf (MockChainConf initState initDist funOnResult) currentRun =
+  funOnResult <$> runMockChain initState (forceOutputs (unInitialDistribution initDist) >> currentRun)
 
--- | A default configuration to run a mockchain run.
-mockChainConfTemplate ::
-  (MockChain effs) =>
+runMockChainDef ::
+  (MockChain effs, Member MockChainWrite effs) =>
   Sem effs a ->
-  MockChainConf effs a (MockChainReturn a)
-mockChainConfTemplate currentRun =
-  MockChainConf def def unRawMockChainReturn currentRun runMockChain
+  [MockChainReturn a]
+runMockChainDef = runMockChainFromConf mockChainConfTemplate
 
 type DirectEffs =
   '[ MockChainWrite,
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 5042b6f32..8411493c2 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -219,9 +219,7 @@ testToProp ::
   Test effs a prop ->
   prop
 testToProp Test {..} =
-  let results =
-        runMockChainConf $
-          (mockChainConfTemplate testTrace) {mccInitialDistribution = testInitDist}
+  let results = runMockChainFromConf (mockChainConfTemplate {mccInitialDistribution = testInitDist}) testTrace
    in testSizeProp (toInteger (length results))
         .&&. testAll
           ( \ret@(MockChainReturn outcome _ state mcLog names) ->
diff --git a/tests/Spec/Attack/DoubleSat.hs b/tests/Spec/Attack/DoubleSat.hs
index 4c4d4c370..7adcde103 100644
--- a/tests/Spec/Attack/DoubleSat.hs
+++ b/tests/Spec/Attack/DoubleSat.hs
@@ -35,18 +35,27 @@ instance PrettyCooked BRedeemer where
 customInitDist :: InitialDistribution
 customInitDist =
   def
-    <> InitialDistribution ((\n -> aValidator `receives` VisibleHashedDatum ADatum <&&> Value (Script.ada n)) <$> [2, 3, 4, 5])
-    <> InitialDistribution ((\n -> bValidator `receives` VisibleHashedDatum BDatum <&&> Value (Script.ada n)) <$> [6, 7])
+    <> InitialDistribution
+      ( ((\n -> aValidator `receives` VisibleHashedDatum ADatum <&&> Value (Script.ada n)) <$> [2, 3, 4, 5])
+          <> ((\n -> bValidator `receives` VisibleHashedDatum BDatum <&&> Value (Script.ada n)) <$> [6, 7])
+      )
 
 -- | Utxos generated from the initial distribution
 aUtxo1, aUtxo2, aUtxo3, aUtxo4, bUtxo1, bUtxo2 :: (V3.TxOutRef, TxSkelOut)
 (aUtxo1, aUtxo2, aUtxo3, aUtxo4, bUtxo1, bUtxo2) =
-  case mcrValue $ runMockChainFromInitDist customInitDist $ do
-    [a1, a2, a3, a4] <- runUtxoSearch $ utxosOwnedBySearch aValidator
-    [b1, b2] <- runUtxoSearch $ utxosOwnedBySearch bValidator
-    return (a1, a2, a3, a4, b1, b2) of
-    Left _ -> error "Initial distribution error"
-    Right a -> a
+  case mcrValue
+    <$> runMockChainConf @DirectEffs
+      ( mockChainConfTemplate
+          ( do
+              [a1, a2, a3, a4] <- utxosAt aValidator
+              [b1, b2] <- utxosAt bValidator
+              return (a1, a2, a3, a4, b1, b2)
+          )
+      )
+        { mccInitialDistribution = customInitDist
+        } of
+    [Right a] -> a
+    _ -> error "Initial distribution error"
 
 tests :: TestTree
 tests =
@@ -88,19 +97,19 @@ tests =
                         splitMode
                         (txSkelInsL % itraversed) -- we know that every 'TxOutRef' in the inputs points to a UTxO that the 'aValidator' owns
                         ( \aOref _aRedeemer -> do
-                            bUtxos <- runUtxoSearch $ utxosOwnedBySearch bValidator
+                            bUtxos <- utxosAt bValidator
                             if
                               | aOref == fst aUtxo1 ->
                                   return
                                     [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
-                                    | (bOref, bOut) <- bUtxos,
-                                      view txSkelOutValueL bOut == Script.lovelace 123 -- not satisfied by any UTxO in 'dsTestMockChain'
+                                      | (bOref, bOut) <- bUtxos,
+                                        view txSkelOutValueL bOut == Script.lovelace 123 -- not satisfied by any UTxO in 'dsTestMockChain'
                                     ]
                               | aOref == fst aUtxo2 ->
                                   return
                                     [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
-                                    | (bOref, _) <- bUtxos,
-                                      bOref == fst bUtxo1
+                                      | (bOref, _) <- bUtxos,
+                                        bOref == fst bUtxo1
                                     ]
                               | aOref == fst aUtxo3 ->
                                   return $
diff --git a/tests/Spec/Ltl.hs b/tests/Spec/Ltl.hs
index 486fd34d1..7aa73b9b6 100644
--- a/tests/Spec/Ltl.hs
+++ b/tests/Spec/Ltl.hs
@@ -1,16 +1,23 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 module Spec.Ltl where
 
-import Control.Monad
-import Control.Monad.Writer
+import Control.Monad (MonadPlus (..), guard, replicateM, void)
 import Cooked.Ltl
 import Cooked.MockChain.Testing
 import Data.Maybe
+import Polysemy
+import Polysemy.NonDet
+import Polysemy.State
+import Polysemy.Writer
 import Test.Tasty
 import Test.Tasty.HUnit
 
-data TestBuiltin a where
-  EmitInteger :: Integer -> TestBuiltin ()
-  GetInteger :: TestBuiltin Integer
+data TestBuiltin :: Effect where
+  EmitInteger :: Integer -> TestBuiltin m ()
+  GetInteger :: TestBuiltin m Integer
+
+makeSem ''TestBuiltin
 
 data TestModification
   = Add Integer
@@ -23,11 +30,14 @@ applyMod _ Fail = Nothing
 applyMod i (Add i') = if i == i' then Nothing else Just $ i + i'
 applyMod i (Mul i') = if i == i' then Nothing else Just $ i * i'
 
-type TestStaged = StagedLtl TestModification TestBuiltin
-
-instance (MonadPlus m, MonadWriter [Integer] m) => ModInterpBuiltin TestModification TestBuiltin m where
-  modifyAndInterpBuiltin GetInteger = Left (return 42)
-  modifyAndInterpBuiltin (EmitInteger i) = Right $ \now ->
+runTestEffect ::
+  (Members '[Writer [Integer], ModifyLocally TestModification, NonDet] effs) =>
+  Sem (TestBuiltin : effs) a ->
+  Sem effs a
+runTestEffect = interpret $ \case
+  GetInteger -> return 42
+  EmitInteger i -> do
+    now <- getRequirements
     maybe mzero (tell . (: [])) $
       foldl
         ( \acc el -> do
@@ -41,14 +51,27 @@ instance (MonadPlus m, MonadWriter [Integer] m) => ModInterpBuiltin TestModifica
         (Just i)
         now
 
-emitInteger :: Integer -> TestStaged ()
-emitInteger = singletonBuiltin . EmitInteger
-
-getInteger :: TestStaged Integer
-getInteger = singletonBuiltin GetInteger
+type TestStaged a =
+  Sem
+    '[ ModifyGlobally TestModification,
+       TestBuiltin,
+       Writer [Integer],
+       ModifyLocally TestModification,
+       State [Ltl TestModification],
+       NonDet
+     ]
+    a
 
 go :: TestStaged a -> [[Integer]]
-go = execWriterT . interpStagedLtl
+go =
+  run
+    . runNonDet
+    . evalState []
+    . runModifyLocally
+    . fmap fst
+    . runWriter
+    . runTestEffect
+    . runModifyGlobally
 
 nonemptyTraces :: [TestStaged ()]
 nonemptyTraces =

From 26c5bf60dff613e7c1f8308aa15b717c91fee57d Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sat, 24 Jan 2026 02:56:18 +0100
Subject: [PATCH 43/96] progressing, but a lot of work remains in tests

---
 tests/Spec/Attack/DoubleSat.hs | 18 ++++++++----------
 1 file changed, 8 insertions(+), 10 deletions(-)

diff --git a/tests/Spec/Attack/DoubleSat.hs b/tests/Spec/Attack/DoubleSat.hs
index 7adcde103..883190faf 100644
--- a/tests/Spec/Attack/DoubleSat.hs
+++ b/tests/Spec/Attack/DoubleSat.hs
@@ -44,16 +44,13 @@ customInitDist =
 aUtxo1, aUtxo2, aUtxo3, aUtxo4, bUtxo1, bUtxo2 :: (V3.TxOutRef, TxSkelOut)
 (aUtxo1, aUtxo2, aUtxo3, aUtxo4, bUtxo1, bUtxo2) =
   case mcrValue
-    <$> runMockChainConf @DirectEffs
-      ( mockChainConfTemplate
-          ( do
-              [a1, a2, a3, a4] <- utxosAt aValidator
-              [b1, b2] <- utxosAt bValidator
-              return (a1, a2, a3, a4, b1, b2)
-          )
-      )
-        { mccInitialDistribution = customInitDist
-        } of
+    <$> runMockChainFromConf @DirectEffs
+      (mockChainConfTemplate {mccInitialDistribution = customInitDist})
+      ( do
+          [a1, a2, a3, a4] <- utxosAt aValidator
+          [b1, b2] <- utxosAt bValidator
+          return (a1, a2, a3, a4, b1, b2)
+      ) of
     [Right a] -> a
     _ -> error "Initial distribution error"
 
@@ -91,6 +88,7 @@ tests =
             skelsOut splitMode aInputs =
               mapMaybe
                 ((\case Right (_, skel') -> Just skel'; _ -> Nothing) . mcrValue)
+                --
                 ( runTweakFrom
                     customInitDist
                     ( doubleSatAttack

From 42706ba3f1d0650aed08fcf245e65bf97ec58026 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 01:21:08 +0100
Subject: [PATCH 44/96] it finally compiles ... but it doesn't work ... yet

---
 src/Cooked/MockChain/Instances.hs   | 34 ++++++-----
 src/Cooked/MockChain/Testing.hs     |  6 +-
 tests/Spec/Attack/DoubleSat.hs      | 87 ++++++++++++++---------------
 tests/Spec/Slot.hs                  | 33 ++++++++++-
 tests/Spec/Tweak/Common.hs          | 87 +++++++++++++++--------------
 tests/Spec/Tweak/OutPermutations.hs | 22 ++++----
 tests/Spec/Tweak/TamperDatum.hs     | 62 ++++++++++----------
 7 files changed, 181 insertions(+), 150 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 4ee43d9e3..481bb6f2a 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -98,27 +98,33 @@ data MockChainConf a b where
 mockChainConfTemplate :: MockChainConf a (MockChainReturn a)
 mockChainConfTemplate = MockChainConf def def unRawMockChainReturn
 
--- -- | Running a mockchain conf to get a list of results of the expected type
--- runMockChainConf ::
---   (Member MockChainWrite effs) =>
---   MockChainConf effs a b ->
---   [b]
--- runMockChainConf (MockChainConf initialState initialDist funOnRes currentRun runner) =
---   funOnRes <$> runner initialState (forceOutputs (unInitialDistribution initialDist) >> currentRun)
-
-class MockChain effs where
+class IsMockChain effs where
   runMockChain :: MockChainState -> Sem effs a -> [RawMockChainReturn a]
 
 runMockChainFromConf ::
-  (MockChain effs, Member MockChainWrite effs) =>
+  ( IsMockChain effs,
+    Member MockChainWrite effs
+  ) =>
   MockChainConf a b ->
   Sem effs a ->
   [b]
 runMockChainFromConf (MockChainConf initState initDist funOnResult) currentRun =
   funOnResult <$> runMockChain initState (forceOutputs (unInitialDistribution initDist) >> currentRun)
 
+runMockChainFromInitDist ::
+  ( IsMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  InitialDistribution ->
+  Sem effs a ->
+  [MockChainReturn a]
+runMockChainFromInitDist initDist =
+  runMockChainFromConf $ mockChainConfTemplate {mccInitialDistribution = initDist}
+
 runMockChainDef ::
-  (MockChain effs, Member MockChainWrite effs) =>
+  ( IsMockChain effs,
+    Member MockChainWrite effs
+  ) =>
   Sem effs a ->
   [MockChainReturn a]
 runMockChainDef = runMockChainFromConf mockChainConfTemplate
@@ -134,7 +140,7 @@ type DirectEffs =
 -- mockchain, that is without any tweaks nor branching.
 type DirectMockChain a = Sem DirectEffs a
 
-instance MockChain DirectEffs where
+instance IsMockChain DirectEffs where
   runMockChain mcst =
     (: [])
       . run
@@ -174,7 +180,7 @@ type StagedEffs =
 -- mockchain, that is with tweaks and branching.
 type StagedMockChain a = Sem StagedEffs a
 
-instance MockChain StagedEffs where
+instance IsMockChain StagedEffs where
   runMockChain mcst =
     run
       . runNonDet
@@ -238,7 +244,7 @@ type FullEffs =
 
 type FullMockChain a = Sem FullEffs a
 
-instance MockChain FullEffs where
+instance IsMockChain FullEffs where
   runMockChain mcst =
     run
       . runNonDet
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 8411493c2..4cbb62d7b 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -214,7 +214,7 @@ testToProp ::
   ( IsProp prop,
     Show a,
     Member MockChainWrite effs,
-    MockChain effs
+    IsMockChain effs
   ) =>
   Test effs a prop ->
   prop
@@ -240,7 +240,7 @@ testCooked ::
   forall effs a.
   ( Show a,
     Member MockChainWrite effs,
-    MockChain effs
+    IsMockChain effs
   ) =>
   String ->
   Test effs a HU.Assertion ->
@@ -252,7 +252,7 @@ testCookedQC ::
   forall effs a.
   ( Show a,
     Member MockChainWrite effs,
-    MockChain effs
+    IsMockChain effs
   ) =>
   String ->
   Test effs a QC.Property ->
diff --git a/tests/Spec/Attack/DoubleSat.hs b/tests/Spec/Attack/DoubleSat.hs
index 883190faf..3cede8c17 100644
--- a/tests/Spec/Attack/DoubleSat.hs
+++ b/tests/Spec/Attack/DoubleSat.hs
@@ -5,9 +5,9 @@ module Spec.Attack.DoubleSat (tests) where
 import Control.Arrow
 import Cooked
 import Data.Default
+import Data.Either
 import Data.List (subsequences)
 import Data.Map qualified as Map
-import Data.Maybe
 import Data.Set qualified as Set
 import Data.Tuple (swap)
 import Optics.Core
@@ -44,8 +44,8 @@ customInitDist =
 aUtxo1, aUtxo2, aUtxo3, aUtxo4, bUtxo1, bUtxo2 :: (V3.TxOutRef, TxSkelOut)
 (aUtxo1, aUtxo2, aUtxo3, aUtxo4, bUtxo1, bUtxo2) =
   case mcrValue
-    <$> runMockChainFromConf @DirectEffs
-      (mockChainConfTemplate {mccInitialDistribution = customInitDist})
+    <$> runMockChainFromInitDist @DirectEffs
+      customInitDist
       ( do
           [a1, a2, a3, a4] <- utxosAt aValidator
           [b1, b2] <- utxosAt bValidator
@@ -86,48 +86,45 @@ tests =
             -- on the focused input 'aValidator' UTxO.
             skelsOut :: ([V3.TxOutRef] -> [[V3.TxOutRef]]) -> [(ARedeemer, V3.TxOutRef)] -> [TxSkel]
             skelsOut splitMode aInputs =
-              mapMaybe
-                ((\case Right (_, skel') -> Just skel'; _ -> Nothing) . mcrValue)
-                --
-                ( runTweakFrom
-                    customInitDist
-                    ( doubleSatAttack
-                        splitMode
-                        (txSkelInsL % itraversed) -- we know that every 'TxOutRef' in the inputs points to a UTxO that the 'aValidator' owns
-                        ( \aOref _aRedeemer -> do
-                            bUtxos <- utxosAt bValidator
-                            if
-                              | aOref == fst aUtxo1 ->
-                                  return
-                                    [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
-                                      | (bOref, bOut) <- bUtxos,
-                                        view txSkelOutValueL bOut == Script.lovelace 123 -- not satisfied by any UTxO in 'dsTestMockChain'
-                                    ]
-                              | aOref == fst aUtxo2 ->
-                                  return
-                                    [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
-                                      | (bOref, _) <- bUtxos,
-                                        bOref == fst bUtxo1
-                                    ]
-                              | aOref == fst aUtxo3 ->
-                                  return $
-                                    concatMap
-                                      ( \(bOref, _) ->
-                                          if
-                                            | bOref == fst bUtxo1 ->
-                                                [(someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)]
-                                            | bOref == fst bUtxo2 ->
-                                                [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1),
-                                                  (someTxSkelRedeemer ARedeemer3, toDelta bOref $ someTxSkelRedeemer BRedeemer2)
-                                                ]
-                                            | otherwise -> []
-                                      )
-                                      bUtxos
-                              | otherwise -> return []
-                        )
-                        (wallet 6)
-                    )
-                    (skelIn aInputs)
+              rights
+                ( fmap mcrValue $
+                    runMockChainFromInitDist @StagedEffs customInitDist $
+                      execTweak (skelIn aInputs) $
+                        doubleSatAttack
+                          splitMode
+                          (txSkelInsL % itraversed) -- we know that every 'TxOutRef' in the inputs points to a UTxO that the 'aValidator' owns
+                          ( \aOref _aRedeemer -> do
+                              bUtxos <- utxosAt bValidator
+                              if
+                                | aOref == fst aUtxo1 ->
+                                    return
+                                      [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
+                                        | (bOref, bOut) <- bUtxos,
+                                          view txSkelOutValueL bOut == Script.lovelace 123 -- not satisfied by any UTxO in 'dsTestMockChain'
+                                      ]
+                                | aOref == fst aUtxo2 ->
+                                    return
+                                      [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
+                                        | (bOref, _) <- bUtxos,
+                                          bOref == fst bUtxo1
+                                      ]
+                                | aOref == fst aUtxo3 ->
+                                    return $
+                                      concatMap
+                                        ( \(bOref, _) ->
+                                            if
+                                              | bOref == fst bUtxo1 ->
+                                                  [(someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)]
+                                              | bOref == fst bUtxo2 ->
+                                                  [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1),
+                                                    (someTxSkelRedeemer ARedeemer3, toDelta bOref $ someTxSkelRedeemer BRedeemer2)
+                                                  ]
+                                              | otherwise -> []
+                                        )
+                                        bUtxos
+                                | otherwise -> return []
+                          )
+                          (wallet 6)
                 )
               where
                 toDelta :: V3.TxOutRef -> TxSkelRedeemer -> DoubleSatDelta
diff --git a/tests/Spec/Slot.hs b/tests/Spec/Slot.hs
index e304af3f5..cf076ead3 100644
--- a/tests/Spec/Slot.hs
+++ b/tests/Spec/Slot.hs
@@ -1,17 +1,44 @@
 module Spec.Slot (tests) where
 
+import Cooked.MockChain.Error
+import Cooked.MockChain.MockChainState
+import Cooked.MockChain.Read
+import Data.Default
 import Ledger.Slot qualified as Ledger
+import Ledger.Tx qualified as Ledger
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
+import Polysemy.State
 import Test.Tasty
 import Test.Tasty.QuickCheck
 
+runSlot ::
+  Sem
+    '[ MockChainRead,
+       State MockChainState,
+       Fail,
+       Error Ledger.ToCardanoError,
+       Error MockChainError
+     ]
+    a ->
+  Either MockChainError a
+runSlot =
+  run
+    . runError
+    . runToCardanoErrorInMockChainError
+    . runFailInMockChainError
+    . evalState def
+    . runMockChainRead
+
 tests :: TestTree
 tests =
   testGroup
     "time handling"
     [ testProperty "bounds computed by slotToMSRange are included in slot" $
         \n ->
-          case mcrValue $ runMockChain $ do
+          case runSlot $ do
             (l, r) <- slotToMSRange $ Ledger.Slot n
             Ledger.Slot nl <- getEnclosingSlot l
             Ledger.Slot nr <- getEnclosingSlot r
@@ -20,7 +47,7 @@ tests =
             Right (nl, nr) -> nl == n && nr == n,
       testProperty "bounds computed by slotToMSRange are maximal" $
         \n ->
-          case mcrValue $ runMockChain $ do
+          case runSlot $ do
             (l, r) <- slotToMSRange $ Ledger.Slot n
             Ledger.Slot nl <- getEnclosingSlot (l - 1)
             Ledger.Slot nr <- getEnclosingSlot (r + 1)
@@ -28,7 +55,7 @@ tests =
             Left _err -> False
             Right (nl, nr) -> nl == n - 1 && nr == n + 1,
       testProperty "time is always included in enclosing slot" $
-        \t -> case mcrValue $ runMockChain $ slotToMSRange =<< getEnclosingSlot (Api.POSIXTime t) of
+        \t -> case runSlot $ slotToMSRange =<< getEnclosingSlot (Api.POSIXTime t) of
           Left _err -> False
           Right (Api.POSIXTime a, Api.POSIXTime b) -> a <= t && a <= b
     ]
diff --git a/tests/Spec/Tweak/Common.hs b/tests/Spec/Tweak/Common.hs
index a1f8e26bd..d6c21ef0e 100644
--- a/tests/Spec/Tweak/Common.hs
+++ b/tests/Spec/Tweak/Common.hs
@@ -5,6 +5,8 @@ import Data.List (subsequences)
 import Optics.Core
 import Plutus.Script.Utils.Value qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
+import Polysemy
+import Polysemy.NonDet
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -20,44 +22,45 @@ tests =
     "building blocks for tweaks"
     [ testGroup "overMaybeSelectingTweak" $
         let skel = mkSkel [123, 234, 345]
-         in [ testCase "return empty list and don't change anything if no applicable modifications" $ -- this one is a regression test
-                [Right ([], skel)]
-                  @=? mcrValue
-                    <$> runTweak
-                      ( overMaybeSelectingTweak
-                          (txSkelOutsL % traversed % txSkelOutValueL)
-                          (const Nothing)
-                          (const True)
-                      )
-                      skel,
+         in [ testCase "return empty list and don't change anything if no applicable modifications" $ -- this one is a regression test -- this one is a regression test
+        -- this one is a regression test
+                [skel]
+                  @=? run
+                    ( runNonDet $
+                        execTweak skel $
+                          overMaybeSelectingTweak
+                            (txSkelOutsL % traversed % txSkelOutValueL)
+                            (const Nothing)
+                            (const True)
+                    ),
               testCase "select applied modification by index" $
-                [Right ([Script.lovelace 345], mkSkel [123, 234, 789])]
-                  @=? mcrValue
-                    <$> runTweak
-                      ( overMaybeSelectingTweak
-                          (txSkelOutsL % traversed % txSkelOutValueL)
-                          ( \value ->
-                              if value `Api.geq` Script.lovelace 200
-                                then Just $ Script.lovelace 789
-                                else Nothing
-                          )
-                          (== 1)
-                      )
-                      skel,
+                [(mkSkel [123, 234, 789], [Script.lovelace 345])]
+                  @=? run
+                    ( runNonDet $
+                        runTweak skel $
+                          overMaybeSelectingTweak
+                            (txSkelOutsL % traversed % txSkelOutValueL)
+                            ( \value ->
+                                if value `Api.geq` Script.lovelace 200
+                                  then Just $ Script.lovelace 789
+                                  else Nothing
+                            )
+                            (== 1)
+                    ),
               testCase "return unmodified foci in the right order" $
-                [Right ([Script.lovelace 123, Script.lovelace 345], mkSkel [789, 234, 789])]
-                  @=? mcrValue
-                    <$> runTweak
-                      ( overMaybeSelectingTweak
-                          (txSkelOutsL % traversed % txSkelOutValueL)
-                          (const $ Just $ Script.lovelace 789)
-                          (`elem` [0, 2])
-                      )
-                      skel
+                [(mkSkel [789, 234, 789], [Script.lovelace 123, Script.lovelace 345])]
+                  @=? run
+                    ( runNonDet $
+                        runTweak skel $
+                          overMaybeSelectingTweak
+                            (txSkelOutsL % traversed % txSkelOutValueL)
+                            (const $ Just $ Script.lovelace 789)
+                            (`elem` [0, 2])
+                    )
             ],
       testGroup "combineModsTweak" $
         let skelIn = mkSkel [0, 0, 0]
-            skelOut x y z = Right ([0 | x /= 0] ++ [1 | y /= 0] ++ [2 | z /= 0], mkSkel [x, y, z])
+            skelOut x y z = (mkSkel [x, y, z], [0 | x /= 0] ++ [1 | y /= 0] ++ [2 | z /= 0])
          in [ testCase "all combinations of modifications" $
                 assertSameSets
                   [ -- one changed focus
@@ -90,14 +93,13 @@ tests =
                     skelOut 2 2 1,
                     skelOut 2 2 2
                   ]
-                  ( mcrValue
-                      <$> runTweak
-                        ( combineModsTweak
+                  ( run $
+                      runNonDet $
+                        runTweak skelIn $
+                          combineModsTweak
                             (tail . subsequences)
                             (txSkelOutsL % itraversed % txSkelOutValueL % valueLovelaceL)
                             (\i x -> return [(x + 1, i), (x + 2, i)])
-                        )
-                        skelIn
                   ),
               testCase "separate modifications" $
                 assertSameSets
@@ -109,14 +111,13 @@ tests =
                     skelOut 0 0 1,
                     skelOut 0 0 2
                   ]
-                  ( mcrValue
-                      <$> runTweak
-                        ( combineModsTweak
+                  ( run $
+                      runNonDet $
+                        runTweak skelIn $
+                          combineModsTweak
                             (map (: []))
                             (txSkelOutsL % itraversed % txSkelOutValueL % valueLovelaceL)
                             (\i x -> return [(x + 1, i), (x + 2, i)])
-                        )
-                        skelIn
                   )
             ]
     ]
diff --git a/tests/Spec/Tweak/OutPermutations.hs b/tests/Spec/Tweak/OutPermutations.hs
index f215eb5df..935192510 100644
--- a/tests/Spec/Tweak/OutPermutations.hs
+++ b/tests/Spec/Tweak/OutPermutations.hs
@@ -1,10 +1,10 @@
 module Spec.Tweak.OutPermutations (tests) where
 
 import Cooked
-import Cooked.Tweak.OutPermutations
-import Data.Either (rights)
 import Data.List (group)
 import Plutus.Script.Utils.Value qualified as Script
+import Polysemy
+import Polysemy.NonDet
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -66,24 +66,24 @@ tests =
             skel x y z = txSkelTemplate {txSkelOuts = [x, y, z]}
          in [ testCase "KeepIdentity (Just 2)" $
                 assertSameSets
-                  (map (Right . ((),)) [skel a b c, skel b a c])
-                  (mcrValue <$> runTweak (allOutPermutsTweak $ KeepIdentity $ Just 2) (skel a b c)),
+                  [skel a b c, skel b a c]
+                  (run $ runNonDet $ execTweak (skel a b c) $ allOutPermutsTweak $ KeepIdentity $ Just 2),
               testCase "KeepIdentity Nothing" $
                 assertSameSets
-                  (map (Right . ((),)) [skel a b c, skel a c b, skel b a c, skel b c a, skel c a b, skel c b a])
-                  (mcrValue <$> runTweak (allOutPermutsTweak $ KeepIdentity Nothing) (skel a b c)),
+                  [skel a b c, skel a c b, skel b a c, skel b c a, skel c a b, skel c b a]
+                  (run $ runNonDet $ execTweak (skel a b c) $ allOutPermutsTweak $ KeepIdentity Nothing),
               testCase "OmitIdentity (Just 2)" $
                 assertSameSets
-                  [Right ((), skel b a c)]
-                  (mcrValue <$> runTweak (allOutPermutsTweak $ OmitIdentity $ Just 2) (skel a b c)),
+                  [skel b a c]
+                  (run $ runNonDet $ execTweak (skel a b c) $ allOutPermutsTweak $ OmitIdentity $ Just 2),
               testCase "OmitIdentity Nothing" $
                 assertSameSets
-                  (map (Right . ((),)) [skel a c b, skel b a c, skel b c a, skel c a b, skel c b a])
-                  (mcrValue <$> runTweak (allOutPermutsTweak $ OmitIdentity Nothing) (skel a b c))
+                  [skel a c b, skel b a c, skel b c a, skel c a b, skel c b a]
+                  (run $ runNonDet $ execTweak (skel a b c) $ allOutPermutsTweak $ OmitIdentity Nothing)
             ],
       testGroup "tests for a single random outputs permutation:" $
         let l = (\i -> wallet i `receives` Value (Script.lovelace 123)) <$> [1 .. 5]
-            runs = txSkelOuts . snd <$> rights (mcrValue <$> ((\i -> runTweak (singleOutPermutTweak i) txSkelTemplate {txSkelOuts = l}) =<< [1 .. 5]))
+            runs = txSkelOuts <$> ([1 .. 5] >>= (run . runNonDet . execTweak (txSkelTemplate {txSkelOuts = l}) . singleOutPermutTweak))
          in [ testCase "All permutations contain the correct elements" $
                 mapM_ (assertSameSets l) runs,
               testCase "All permutations are different from the initial distribution" $
diff --git a/tests/Spec/Tweak/TamperDatum.hs b/tests/Spec/Tweak/TamperDatum.hs
index 9ff4770d4..e619918a9 100644
--- a/tests/Spec/Tweak/TamperDatum.hs
+++ b/tests/Spec/Tweak/TamperDatum.hs
@@ -4,11 +4,12 @@
 module Spec.Tweak.TamperDatum where
 
 import Cooked
-import Data.Either
 import Data.Set qualified as Set
 import Optics.Core
 import Plutus.Script.Utils.Value qualified as Script
 import PlutusTx qualified
+import Polysemy
+import Polysemy.NonDet
 import Prettyprinter (viaShow)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@=?))
@@ -22,31 +23,30 @@ alice = wallet 1
 tamperDatumTweakTest :: TestTree
 tamperDatumTweakTest =
   testCase "tamperDatumTweak" $
-    [ Right
-        ( [(52, 53)],
-          txSkelTemplate
-            { txSkelLabel = Set.singleton $ TxSkelLabel TamperDatumLbl,
-              txSkelOuts =
-                [ alice `receives` VisibleHashedDatum (52 :: Integer, 54 :: Integer),
-                  alice `receives` Value (Script.lovelace 234),
-                  alice `receives` VisibleHashedDatum (76 :: Integer, 77 :: Integer)
-                ]
-            }
-        )
+    [ ( txSkelTemplate
+          { txSkelLabel = Set.singleton $ TxSkelLabel TamperDatumLbl,
+            txSkelOuts =
+              [ alice `receives` VisibleHashedDatum (52 :: Integer, 54 :: Integer),
+                alice `receives` Value (Script.lovelace 234),
+                alice `receives` VisibleHashedDatum (76 :: Integer, 77 :: Integer)
+              ]
+          },
+        [(52, 53)]
+      )
     ]
-      @=? mcrValue
-        <$> runTweak
-          ( tamperDatumTweak @(Integer, Integer)
-              (\(x, y) -> if y == 77 then Nothing else Just (x, y + 1))
-          )
-          ( txSkelTemplate
+      @=? (run . runNonDet)
+        ( runTweak
+            txSkelTemplate
               { txSkelOuts =
                   [ alice `receives` VisibleHashedDatum (52 :: Integer, 53 :: Integer),
                     alice `receives` Value (Script.lovelace 234),
                     alice `receives` VisibleHashedDatum (76 :: Integer, 77 :: Integer)
                   ]
               }
-          )
+            ( tamperDatumTweak @(Integer, Integer)
+                (\(x, y) -> if y == 77 then Nothing else Just (x, y + 1))
+            )
+        )
 
 malformDatumTweakTest :: TestTree
 malformDatumTweakTest =
@@ -70,9 +70,17 @@ malformDatumTweakTest =
             txSkelWithDatums1And4 (52 :: Integer, 53 :: Integer) (84 :: Integer, ()), -- datum1 untouched, datum4 changed
             txSkelWithDatums1And4 (52 :: Integer, 53 :: Integer) False -- datum1 untouched, datum4 changed
           ]
-          ( fmap (allBuiltinData . snd) . rights $
-              mcrValue
-                <$> runTweak
+          ( (fmap allBuiltinData . run . runNonDet)
+              ( execTweak
+                  ( txSkelTemplate
+                      { txSkelOuts =
+                          [ alice `receives` VisibleHashedDatum (52 :: Integer, 53 :: Integer),
+                            alice `receives` Value (Script.lovelace 234),
+                            alice `receives` VisibleHashedDatum (76 :: Integer, 77 :: Integer),
+                            alice `receives` VisibleHashedDatum (84 :: Integer, 85 :: Integer)
+                          ]
+                      }
+                  )
                   ( malformDatumTweak @(Integer, Integer)
                       ( \(x, y) ->
                           if y == 77
@@ -83,15 +91,7 @@ malformDatumTweakTest =
                               ]
                       )
                   )
-                  ( txSkelTemplate
-                      { txSkelOuts =
-                          [ alice `receives` VisibleHashedDatum (52 :: Integer, 53 :: Integer),
-                            alice `receives` Value (Script.lovelace 234),
-                            alice `receives` VisibleHashedDatum (76 :: Integer, 77 :: Integer),
-                            alice `receives` VisibleHashedDatum (84 :: Integer, 85 :: Integer)
-                          ]
-                      }
-                  )
+              )
           )
 
 tests :: TestTree

From d40c9634d2ef9103e7195399ac74a635d518897a Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 15:32:07 +0100
Subject: [PATCH 45/96] MockChainState -> State

---
 cooked-validators.cabal                              | 2 +-
 src/Cooked/MockChain.hs                              | 2 +-
 src/Cooked/MockChain/Instances.hs                    | 2 +-
 src/Cooked/MockChain/Read.hs                         | 2 +-
 src/Cooked/MockChain/{MockChainState.hs => State.hs} | 2 +-
 src/Cooked/MockChain/Write.hs                        | 2 +-
 tests/Spec/Slot.hs                                   | 2 +-
 tests/Spec/Tweak/ValidityRange.hs                    | 2 +-
 8 files changed, 8 insertions(+), 8 deletions(-)
 rename src/Cooked/MockChain/{MockChainState.hs => State.hs} (98%)

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index b9070402e..7af23cf64 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -40,8 +40,8 @@ library
       Cooked.MockChain.Instances
       Cooked.MockChain.Log
       Cooked.MockChain.Misc
-      Cooked.MockChain.MockChainState
       Cooked.MockChain.Read
+      Cooked.MockChain.State
       Cooked.MockChain.Testing
       Cooked.MockChain.UtxoSearch
       Cooked.MockChain.UtxoState
diff --git a/src/Cooked/MockChain.hs b/src/Cooked/MockChain.hs
index 11ea3f79c..2e56e7c2d 100644
--- a/src/Cooked/MockChain.hs
+++ b/src/Cooked/MockChain.hs
@@ -8,8 +8,8 @@ import Cooked.MockChain.Common as X
 import Cooked.MockChain.Error as X
 import Cooked.MockChain.Instances as X
 import Cooked.MockChain.Misc as X
-import Cooked.MockChain.MockChainState as X
 import Cooked.MockChain.Read as X
+import Cooked.MockChain.State as X
 import Cooked.MockChain.Testing as X
 import Cooked.MockChain.UtxoSearch as X
 import Cooked.MockChain.UtxoState as X
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 481bb6f2a..c93e5a329 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -22,8 +22,8 @@ import Cooked.Ltl
 import Cooked.MockChain.Error
 import Cooked.MockChain.Log
 import Cooked.MockChain.Misc
-import Cooked.MockChain.MockChainState
 import Cooked.MockChain.Read
+import Cooked.MockChain.State
 import Cooked.MockChain.UtxoState
 import Cooked.MockChain.Write
 import Cooked.Skeleton.Output
diff --git a/src/Cooked/MockChain/Read.hs b/src/Cooked/MockChain/Read.hs
index d282fbc6b..07413fd63 100644
--- a/src/Cooked/MockChain/Read.hs
+++ b/src/Cooked/MockChain/Read.hs
@@ -52,7 +52,7 @@ import Control.Monad
 import Cooked.MockChain.Common
 import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Credential (toStakeCredential)
-import Cooked.MockChain.MockChainState
+import Cooked.MockChain.State
 import Cooked.Skeleton
 import Data.Coerce (coerce)
 import Data.Map (Map)
diff --git a/src/Cooked/MockChain/MockChainState.hs b/src/Cooked/MockChain/State.hs
similarity index 98%
rename from src/Cooked/MockChain/MockChainState.hs
rename to src/Cooked/MockChain/State.hs
index 39c3d4b34..5774723be 100644
--- a/src/Cooked/MockChain/MockChainState.hs
+++ b/src/Cooked/MockChain/State.hs
@@ -1,6 +1,6 @@
 -- | This module exposes the internal state in which our direct simulation is
 -- run, and functions to update and query it.
-module Cooked.MockChain.MockChainState
+module Cooked.MockChain.State
   ( MockChainState (..),
     mcstParamsL,
     mcstLedgerStateL,
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index 85cb4fe3f..b92daee36 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -48,8 +48,8 @@ import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Body
 import Cooked.MockChain.GenerateTx.Output
 import Cooked.MockChain.Log
-import Cooked.MockChain.MockChainState
 import Cooked.MockChain.Read
+import Cooked.MockChain.State
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Data.Coerce
diff --git a/tests/Spec/Slot.hs b/tests/Spec/Slot.hs
index cf076ead3..9d4445d32 100644
--- a/tests/Spec/Slot.hs
+++ b/tests/Spec/Slot.hs
@@ -1,8 +1,8 @@
 module Spec.Slot (tests) where
 
 import Cooked.MockChain.Error
-import Cooked.MockChain.MockChainState
 import Cooked.MockChain.Read
+import Cooked.MockChain.State
 import Data.Default
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
diff --git a/tests/Spec/Tweak/ValidityRange.hs b/tests/Spec/Tweak/ValidityRange.hs
index 44a34bb8d..ca8d8313b 100644
--- a/tests/Spec/Tweak/ValidityRange.hs
+++ b/tests/Spec/Tweak/ValidityRange.hs
@@ -3,8 +3,8 @@ module Spec.Tweak.ValidityRange (tests) where
 import Control.Monad (void)
 import Cooked.MockChain.Error
 import Cooked.MockChain.Log
-import Cooked.MockChain.MockChainState
 import Cooked.MockChain.Read
+import Cooked.MockChain.State
 import Cooked.MockChain.Testing
 import Cooked.MockChain.Write
 import Cooked.Skeleton

From 2406854c8c4b87c08055ed0e6c4af5ccb7f217a5 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 16:33:28 +0100
Subject: [PATCH 46/96] fixing bug in UTxOSearch

---
 src/Cooked/MockChain/UtxoSearch.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Cooked/MockChain/UtxoSearch.hs b/src/Cooked/MockChain/UtxoSearch.hs
index 5b35ce6be..763609e95 100644
--- a/src/Cooked/MockChain/UtxoSearch.hs
+++ b/src/Cooked/MockChain/UtxoSearch.hs
@@ -224,8 +224,8 @@ ensureOnlyValueOutputs ::
   UtxoSearch effs els ->
   UtxoSearch effs els
 ensureOnlyValueOutputs =
-  ensureAFoldIsn't txSkelOutMReferenceScriptL
-    . ensureAFoldIsn't txSkelOutMStakingCredentialL
+  ensureAFoldIsn't txSkelOutReferenceScriptAT
+    . ensureAFoldIsn't txSkelOutStakingCredentialAT
     . ensureAFoldIsn't (txSkelOutDatumL % txSkelOutDatumKindAT)
 
 -- | Same as 'onlyValueOutputsAtSearch', but also ensures the searched outputs

From 55b256a165fbd45b28878cef46474f5678befa06 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 17:08:36 +0100
Subject: [PATCH 47/96] fixing DH spec change

---
 tests/Spec/Attack/DatumHijacking.hs | 65 +++++++++++++----------------
 1 file changed, 29 insertions(+), 36 deletions(-)

diff --git a/tests/Spec/Attack/DatumHijacking.hs b/tests/Spec/Attack/DatumHijacking.hs
index d04e11ea1..0e19cb4da 100644
--- a/tests/Spec/Attack/DatumHijacking.hs
+++ b/tests/Spec/Attack/DatumHijacking.hs
@@ -51,9 +51,6 @@ datumHijackingTrace :: Script.MultiPurposeScript DHContract -> StagedMockChain (
 datumHijackingTrace v = do
   txLock v >>= txRelock v
 
-txSkelFromOuts :: [TxSkelOut] -> TxSkel
-txSkelFromOuts os = txSkelTemplate {txSkelOuts = os, txSkelSignatories = txSkelSignatoriesFromList [wallet 1]}
-
 -- * TestTree for the datum hijacking attack
 
 thief :: Script.MultiPurposeScript DHContract
@@ -64,19 +61,23 @@ tests =
   testGroup
     "datum hijacking attack"
     [ testGroup "unit tests on a 'TxSkel'" $
-        let x1 = Script.lovelace 10001
-            x2 = Script.lovelace 10000
-            x3 = Script.lovelace 9999
-            skelIn =
-              txSkelFromOuts
-                [ carelessValidator `receives` InlineDatum SecondLock <&&> Value x1,
-                  carelessValidator `receives` InlineDatum SecondLock <&&> Value x3,
-                  carefulValidator `receives` InlineDatum SecondLock <&&> Value x1,
-                  carelessValidator `receives` InlineDatum FirstLock <&&> Value x2,
-                  carelessValidator `receives` InlineDatum SecondLock <&&> Value x2
-                ]
-            skelOut bound select =
-              (run . runNonDet . evalTweak skelIn)
+        let value_10_001 = Script.lovelace 10_001
+            value_10_000 = Script.lovelace 10000
+            value_9_999 = Script.lovelace 9999
+            inSkel =
+              txSkelTemplate
+                { txSkelOuts =
+                    [ carelessValidator `receives` InlineDatum SecondLock <&&> Value value_10_001,
+                      carelessValidator `receives` InlineDatum SecondLock <&&> Value value_9_999,
+                      carefulValidator `receives` InlineDatum SecondLock <&&> Value value_10_001,
+                      carelessValidator `receives` InlineDatum FirstLock <&&> Value value_10_000,
+                      carelessValidator `receives` InlineDatum SecondLock <&&> Value value_10_000
+                    ],
+                  txSkelSignatories = txSkelSignatoriesFromList [wallet 1]
+                }
+            outSkelOutputs :: Api.Value -> (Integer -> Bool) -> [[TxSkelOut]]
+            outSkelOutputs bound select =
+              (fmap txSkelOuts . run . runNonDet . execTweak inSkel)
                 ( datumHijackingAttack $
                     ( outPredDatumHijackingParams
                         ( \out ->
@@ -91,31 +92,23 @@ tests =
                       }
                 )
             outsExpected a b =
-              [ carelessValidator `receives` InlineDatum SecondLock <&&> Value x1,
-                a `receives` InlineDatum SecondLock <&&> Value x3,
-                carefulValidator `receives` InlineDatum SecondLock <&&> Value x1,
-                carelessValidator `receives` InlineDatum FirstLock <&&> Value x2,
-                b `receives` InlineDatum SecondLock <&&> Value x2
+              [ carelessValidator `receives` InlineDatum SecondLock <&&> Value value_10_001,
+                a `receives` InlineDatum SecondLock <&&> Value value_9_999,
+                carefulValidator `receives` InlineDatum SecondLock <&&> Value value_10_001,
+                carelessValidator `receives` InlineDatum FirstLock <&&> Value value_10_000,
+                b `receives` InlineDatum SecondLock <&&> Value value_10_000
               ]
          in [ testCase "no modified transactions if no interesting outputs to steal" $
-                [] @=? skelOut mempty (const True),
+                [] @=? outSkelOutputs mempty (const True),
               testCase "one modified transaction for one interesting output" $
-                [ [carelessValidator `receives` (InlineDatum SecondLock <&&> Value x3)],
-                  outsExpected thief carelessValidator
-                ]
-                  @=? skelOut x2 (0 ==),
+                [outsExpected thief carelessValidator]
+                  @=? outSkelOutputs value_10_000 (0 ==),
               testCase "two modified transactions for two interesting outputs" $
-                [ [ carelessValidator `receives` (InlineDatum SecondLock <&&> Value x3),
-                    carelessValidator `receives` (InlineDatum SecondLock <&&> Value x2)
-                  ],
-                  outsExpected thief thief
-                ]
-                  @=? skelOut x2 (const True),
+                [outsExpected thief thief]
+                  @=? outSkelOutputs value_10_000 (const True),
               testCase "select second interesting output to get one modified transaction" $
-                [ [carelessValidator `receives` (InlineDatum SecondLock <&&> Value x2)],
-                  outsExpected carelessValidator thief
-                ]
-                  @=? skelOut x2 (1 ==)
+                [outsExpected carelessValidator thief]
+                  @=? outSkelOutputs value_10_000 (1 ==)
             ],
       testCooked "careful validator" $
         mustFailInPhase2Test $

From 0ed22900a97ab1cc53e18c15b59e0c418b35ab3f Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 17:42:28 +0100
Subject: [PATCH 48/96] all good

---
 src/Cooked/MockChain/Testing.hs |  5 +++++
 tests/Spec/Balancing.hs         | 22 ++++++++++++----------
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 4cbb62d7b..40cecf0fc 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -56,6 +56,11 @@ testBool :: (IsProp prop) => Bool -> prop
 testBool True = testSuccess
 testBool False = testFailure
 
+-- | Turns a boolean into a @prop@, displaying an error message when applicable
+testBoolMsg :: (IsProp prop) => String -> Bool -> prop
+testBoolMsg _ True = testSuccess
+testBoolMsg msg False = testFailureMsg msg
+
 -- | Ensures all elements of a list satisfy a given @prop@
 testAll :: (IsProp prop) => (a -> prop) -> [a] -> prop
 testAll f = testConjoin . map f
diff --git a/tests/Spec/Balancing.hs b/tests/Spec/Balancing.hs
index bfd9f3015..6668af1af 100644
--- a/tests/Spec/Balancing.hs
+++ b/tests/Spec/Balancing.hs
@@ -9,6 +9,7 @@ import Data.Set qualified as Set
 import Data.Text (isInfixOf)
 import Ledger.Index qualified as Ledger
 import Optics.Core
+import Optics.Core.Extras
 import Plutus.Script.Utils.V3 qualified as Script
 import PlutusLedgerApi.V1.Value qualified as Api
 import PlutusLedgerApi.V3 qualified as Api
@@ -101,8 +102,9 @@ aliceNonOnlyValueUtxos :: FullMockChain [Api.TxOutRef]
 aliceNonOnlyValueUtxos =
   getTxOutRefs $
     utxosAtSearch alice $
-      ensureAFoldIs txSkelOutReferenceScriptAT
-        . ensureAFoldIs (txSkelOutDatumL % txSkelOutDatumKindAT)
+      ensurePure $ \skel ->
+        is txSkelOutReferenceScriptAT skel
+          || is (txSkelOutDatumL % txSkelOutDatumKindAT) skel
 
 aliceNAdaUtxos :: Integer -> FullMockChain [Api.TxOutRef]
 aliceNAdaUtxos n =
@@ -175,7 +177,7 @@ balanceReduceFee = do
 
 reachingMagic :: FullMockChain ()
 reachingMagic = do
-  bananaOutRefs <- getTxOutRefs $ utxosAtSearch alice $ ensureAFoldIs (txSkelOutValueL % filtered (banana 1 <=))
+  bananaOutRefs <- getTxOutRefs $ utxosAtSearch alice $ ensureAFoldIs (txSkelOutValueL % filtered (banana 1 `Api.leq`))
   validateTxSkel_ $
     txSkelTemplate
       { txSkelOuts = [bob `receives` Value (Script.ada 106 <> banana 12)],
@@ -189,20 +191,20 @@ reachingMagic = do
 type ResProp = TestBalancingOutcome -> Assertion
 
 hasFee :: Integer -> ResProp
-hasFee fee (_, _, fee', _, _) = testBool $ fee == fee'
+hasFee fee (_, _, fee', _, _) = testBoolMsg "hasFee" $ fee == fee'
 
 additionalOutsNb :: Int -> ResProp
-additionalOutsNb ao (txSkel1, txSkel2, _, _, _) = testBool $ length (txSkelOuts txSkel2) - length (txSkelOuts txSkel1) == ao
+additionalOutsNb ao (txSkel1, txSkel2, _, _, _) = testBoolMsg "AdditionalOutsNb" $ length (txSkelOuts txSkel2) - length (txSkelOuts txSkel1) == ao
 
 insNb :: Int -> ResProp
-insNb n (_, TxSkel {..}, _, _, _) = testBool $ length txSkelIns == n
+insNb n (_, TxSkel {..}, _, _, _) = testBoolMsg "insNb" $ length txSkelIns == n
 
 colInsNb :: Int -> ResProp
-colInsNb cis (_, _, _, Nothing, _) = testBool $ cis == 0
-colInsNb cis (_, _, _, Just (refs, _), _) = testBool $ cis == length refs
+colInsNb cis (_, _, _, Nothing, _) = testBoolMsg "colInsNb" $ cis == 0
+colInsNb cis (_, _, _, Just (refs, _), _) = testBoolMsg "colInsNb" $ cis == length refs
 
 retOutsNb :: Int -> ResProp
-retOutsNb ros (_, _, _, _, refs) = testBool $ ros == length refs
+retOutsNb ros (_, _, _, _, refs) = testBoolMsg "retOutsNb" $ ros == length refs
 
 testBalancingSucceedsWith :: String -> [ResProp] -> FullMockChain TestBalancingOutcome -> TestTree
 testBalancingSucceedsWith msg props run =
@@ -651,7 +653,7 @@ tests =
                 ( testingBalancingTemplate
                     mempty
                     mempty
-                    ((fst <$>) <$> utxosAt alice)
+                    (getTxOutRefs $ utxosAtSearch alice ensureOnlyValueOutputs)
                     emptySearch
                     emptySearch
                     False

From 299143f8a6c8217ccd4306bb7aca7fd6e2466877 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 18:54:28 +0100
Subject: [PATCH 49/96] improving pretty-printing of runs + note primitive

---
 src/Cooked/MockChain/Instances.hs | 25 ++++++++++++++++---------
 src/Cooked/MockChain/Misc.hs      | 20 ++++++++++++++++----
 src/Cooked/MockChain/Testing.hs   |  2 +-
 src/Cooked/Pretty/MockChain.hs    | 14 +++++++++++---
 4 files changed, 44 insertions(+), 17 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index c93e5a329..8636e5b42 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -55,7 +55,9 @@ data MockChainReturn a where
       -- | The final journal emitted during the run
       mcrJournal :: [MockChainLogEntry],
       -- | The map of aliases defined during the run
-      mcrAliases :: Map Api.BuiltinByteString String
+      mcrAliases :: Map Api.BuiltinByteString String,
+      -- | The notes taken by the user during the run
+      mcrNoteBook :: [String]
     } ->
     MockChainReturn a
   deriving (Functor)
@@ -64,8 +66,10 @@ data MockChainReturn a where
 type RawMockChainReturn a =
   ( Map Api.BuiltinByteString String,
     ( [MockChainLogEntry],
-      ( MockChainState,
-        Either MockChainError a
+      ( [String],
+        ( MockChainState,
+          Either MockChainError a
+        )
       )
     )
   )
@@ -76,12 +80,8 @@ type FunOnMockChainResult a b = RawMockChainReturn a -> b
 
 -- | Building a `MockChainReturn` from a `RawMockChainReturn`
 unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
-unRawMockChainReturn (aliases, (journal, (st, val))) =
-  MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases
-
--- | Retrieving the `MockChainState` from a `RawMockChainReturn`
-stateFromMockChainReturn :: FunOnMockChainResult a MockChainState
-stateFromMockChainReturn = fst . snd . snd
+unRawMockChainReturn (aliases, (journal, (notes, (st, val)))) =
+  MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases notes
 
 -- | Configuration to run a mockchain
 data MockChainConf a b where
@@ -146,6 +146,7 @@ instance IsMockChain DirectEffs where
       . run
       . runWriter
       . runWriter
+      . runWriter
       . runMockChainLog
       . runState mcst
       . runError
@@ -159,6 +160,7 @@ instance IsMockChain DirectEffs where
            Error MockChainError,
            State MockChainState,
            MockChainLog,
+           Writer [String],
            Writer [MockChainLogEntry],
            Writer (Map Api.BuiltinByteString String)
          ]
@@ -186,6 +188,7 @@ instance IsMockChain StagedEffs where
       . runNonDet
       . runWriter
       . runWriter
+      . runWriter
       . runMockChainLog
       . runState mcst
       . runError
@@ -201,6 +204,7 @@ instance IsMockChain StagedEffs where
            Error MockChainError,
            State MockChainState,
            MockChainLog,
+           Writer [String],
            Writer [MockChainLogEntry],
            Writer (Map Api.BuiltinByteString String)
          ]
@@ -218,6 +222,7 @@ type FullTweakEffs =
      Error MockChainError,
      State MockChainState,
      MockChainLog,
+     Writer [String],
      Writer [MockChainLogEntry],
      Writer (Map Api.BuiltinByteString String),
      NonDet
@@ -237,6 +242,7 @@ type FullEffs =
      Error MockChainError,
      State MockChainState,
      MockChainLog,
+     Writer [String],
      Writer [MockChainLogEntry],
      Writer (Map Api.BuiltinByteString String),
      NonDet
@@ -250,6 +256,7 @@ instance IsMockChain FullEffs where
       . runNonDet
       . runWriter
       . runWriter
+      . runWriter
       . runMockChainLog
       . runState mcst
       . runError
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index b56fb2962..dbaa443ee 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -10,9 +10,12 @@ module Cooked.MockChain.Misc
     -- * Misc primitives
     define,
     defineM,
+    note,
+    noteP,
   )
 where
 
+import Cooked.Pretty.Class
 import Cooked.Pretty.Hashable
 import Data.Map (Map)
 import Data.Map qualified as Map
@@ -23,6 +26,7 @@ import Polysemy.Writer
 -- | An effect that corresponds to extra QOL capabilities of the MockChain
 data MockChainMisc :: Effect where
   Define :: (ToHash a) => String -> a -> MockChainMisc m a
+  Note :: (Show s) => s -> MockChainMisc m ()
 
 makeSem_ ''MockChainMisc
 
@@ -30,17 +34,25 @@ makeSem_ ''MockChainMisc
 -- BuiltinByteString String@
 runMockChainMisc ::
   forall effs a.
-  (Member (Writer (Map Api.BuiltinByteString String)) effs) =>
+  (Members '[Writer (Map Api.BuiltinByteString String), Writer [String]] effs) =>
   Sem (MockChainMisc : effs) a ->
   Sem effs a
-runMockChainMisc = interpret $
-  \(Define name hashable) -> do
+runMockChainMisc = interpret $ \case
+  (Define name hashable) -> do
     tell $ Map.singleton (toHash hashable) name
     return hashable
+  (Note s) -> tell [show s]
 
--- -- | Stores an alias matching a hashable data for pretty printing purpose
+-- | Stores an alias matching a hashable data for pretty printing purpose
 define :: forall effs a. (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a
 
+-- | Takes note of a showable element to trace at the end of the run
+note :: forall effs s. (Member MockChainMisc effs, Show s) => s -> Sem effs ()
+
+-- | Takes note of a pretty-printable element to trace at the end of the run
+noteP :: forall effs s. (Member MockChainMisc effs, PrettyCooked s) => s -> Sem effs ()
+noteP = note . prettyCooked
+
 -- | Like `define`, but binds the result of a monadic computation instead
 defineM :: (Member MockChainMisc effs, ToHash a) => String -> Sem effs a -> Sem effs a
 defineM name = (define name =<<)
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 40cecf0fc..92e9c9145 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -227,7 +227,7 @@ testToProp Test {..} =
   let results = runMockChainFromConf (mockChainConfTemplate {mccInitialDistribution = testInitDist}) testTrace
    in testSizeProp (toInteger (length results))
         .&&. testAll
-          ( \ret@(MockChainReturn outcome _ state mcLog names) ->
+          ( \ret@(MockChainReturn outcome _ state mcLog names _) ->
               let pcOpts = addHashNames names testPrettyOpts
                in testCounterexample
                     (renderString (prettyCookedOpt pcOpts) ret)
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 55b172ea8..ca9c889b1 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -27,12 +27,20 @@ import Prettyprinter ((<+>))
 import Prettyprinter qualified as PP
 
 instance (Show a) => PrettyCooked [MockChainReturn a] where
-  prettyCookedOpt opts = prettyItemize opts "Results:" "-"
+  prettyCookedOpt opts [outcome] = prettyCookedOpt opts outcome
+  prettyCookedOpt opts outcomes =
+    PP.vsep
+      ( zipWith
+          (\n d -> PP.vsep ["", PP.pretty n <> "." <+> d])
+          ([1 ..] :: [Int])
+          (PP.align . prettyCookedOpt opts <$> outcomes)
+      )
 
 instance (Show a) => PrettyCooked (MockChainReturn a) where
-  prettyCookedOpt opts' (MockChainReturn res outputs utxoState entries ((`addHashNames` opts') -> opts)) =
+  prettyCookedOpt opts' (MockChainReturn res outputs utxoState entries ((`addHashNames` opts') -> opts) noteBook) =
     PP.vsep $
-      [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts]
+      [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
+        <> [prettyItemize opts "📔 Notes:" "-" (PP.pretty @_ @() <$> noteBook) | not (null noteBook)]
         <> prettyCookedOptList opts utxoState
         <> [ case res of
                Left err -> "🔴 Error:" <+> prettyCookedOpt opts err

From edde6ba91c4c49c548e85cec2dce0fd47af2b0f8 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 19:30:29 +0100
Subject: [PATCH 50/96] here comes MockChainJournal

---
 cooked-validators.cabal           |  1 +
 src/Cooked/MockChain/Instances.hs | 50 +++++++++----------------------
 src/Cooked/MockChain/Journal.hs   | 38 +++++++++++++++++++++++
 src/Cooked/MockChain/Log.hs       |  7 +++--
 src/Cooked/MockChain/Misc.hs      | 16 +++++-----
 src/Cooked/MockChain/Testing.hs   | 50 ++++++++++++++++---------------
 tests/Spec/ProposingScript.hs     | 20 ++++++-------
 tests/Spec/ReferenceScripts.hs    |  2 +-
 tests/Spec/Tweak/ValidityRange.hs |  2 +-
 tests/Spec/Withdrawals.hs         |  8 ++---
 10 files changed, 106 insertions(+), 88 deletions(-)
 create mode 100644 src/Cooked/MockChain/Journal.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 7af23cf64..c2d0de975 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -38,6 +38,7 @@ library
       Cooked.MockChain.GenerateTx.Withdrawals
       Cooked.MockChain.GenerateTx.Witness
       Cooked.MockChain.Instances
+      Cooked.MockChain.Journal
       Cooked.MockChain.Log
       Cooked.MockChain.Misc
       Cooked.MockChain.Read
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 8636e5b42..59214784a 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -20,6 +20,7 @@ module Cooked.MockChain.Instances where
 import Cooked.InitialDistribution
 import Cooked.Ltl
 import Cooked.MockChain.Error
+import Cooked.MockChain.Journal
 import Cooked.MockChain.Log
 import Cooked.MockChain.Misc
 import Cooked.MockChain.Read
@@ -53,7 +54,7 @@ data MockChainReturn a where
       -- | The 'UtxoState' at the end of the run
       mcrUtxoState :: UtxoState,
       -- | The final journal emitted during the run
-      mcrJournal :: [MockChainLogEntry],
+      mcrLog :: [MockChainLogEntry],
       -- | The map of aliases defined during the run
       mcrAliases :: Map Api.BuiltinByteString String,
       -- | The notes taken by the user during the run
@@ -63,16 +64,7 @@ data MockChainReturn a where
   deriving (Functor)
 
 -- | Raw return type of running a 'MockChainT'
-type RawMockChainReturn a =
-  ( Map Api.BuiltinByteString String,
-    ( [MockChainLogEntry],
-      ( [String],
-        ( MockChainState,
-          Either MockChainError a
-        )
-      )
-    )
-  )
+type RawMockChainReturn a = (MockChainJournal, (MockChainState, Either MockChainError a))
 
 -- | The type of functions transforming an element of type @RawMockChainReturn a@
 -- into an element of type @b@
@@ -80,7 +72,7 @@ type FunOnMockChainResult a b = RawMockChainReturn a -> b
 
 -- | Building a `MockChainReturn` from a `RawMockChainReturn`
 unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
-unRawMockChainReturn (aliases, (journal, (notes, (st, val)))) =
+unRawMockChainReturn (MockChainJournal journal aliases notes, (st, val)) =
   MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases notes
 
 -- | Configuration to run a mockchain
@@ -145,14 +137,12 @@ instance IsMockChain DirectEffs where
     (: [])
       . run
       . runWriter
-      . runWriter
-      . runWriter
-      . runMockChainLog
+      . runMockChainLog fromLogEntry
       . runState mcst
       . runError
       . runToCardanoErrorInMockChainError
       . runFailInMockChainError
-      . runMockChainMisc
+      . runMockChainMisc fromAlias fromNote
       . runMockChainRead
       . runMockChainWrite
       . insertAt @4
@@ -160,9 +150,7 @@ instance IsMockChain DirectEffs where
            Error MockChainError,
            State MockChainState,
            MockChainLog,
-           Writer [String],
-           Writer [MockChainLogEntry],
-           Writer (Map Api.BuiltinByteString String)
+           Writer MockChainJournal
          ]
 
 type StagedTweakEffs = '[MockChainRead, Fail, NonDet]
@@ -187,15 +175,13 @@ instance IsMockChain StagedEffs where
     run
       . runNonDet
       . runWriter
-      . runWriter
-      . runWriter
-      . runMockChainLog
+      . runMockChainLog fromLogEntry
       . runState mcst
       . runError
       . runToCardanoErrorInMockChainError
       . runFailInMockChainError
       . runMockChainRead
-      . runMockChainMisc
+      . runMockChainMisc fromAlias fromNote
       . evalState []
       . runModifyLocally
       . runMockChainWrite
@@ -204,9 +190,7 @@ instance IsMockChain StagedEffs where
            Error MockChainError,
            State MockChainState,
            MockChainLog,
-           Writer [String],
-           Writer [MockChainLogEntry],
-           Writer (Map Api.BuiltinByteString String)
+           Writer MockChainJournal
          ]
       . reinterpretMockChainWriteWithTweak
       . runModifyGlobally
@@ -222,9 +206,7 @@ type FullTweakEffs =
      Error MockChainError,
      State MockChainState,
      MockChainLog,
-     Writer [String],
-     Writer [MockChainLogEntry],
-     Writer (Map Api.BuiltinByteString String),
+     Writer MockChainJournal,
      NonDet
    ]
 
@@ -242,9 +224,7 @@ type FullEffs =
      Error MockChainError,
      State MockChainState,
      MockChainLog,
-     Writer [String],
-     Writer [MockChainLogEntry],
-     Writer (Map Api.BuiltinByteString String),
+     Writer MockChainJournal,
      NonDet
    ]
 
@@ -255,15 +235,13 @@ instance IsMockChain FullEffs where
     run
       . runNonDet
       . runWriter
-      . runWriter
-      . runWriter
-      . runMockChainLog
+      . runMockChainLog fromLogEntry
       . runState mcst
       . runError
       . runToCardanoErrorInMockChainError
       . runFailInMockChainError
       . runMockChainRead
-      . runMockChainMisc
+      . runMockChainMisc fromAlias fromNote
       . evalState []
       . runModifyLocally
       . runMockChainWrite
diff --git a/src/Cooked/MockChain/Journal.hs b/src/Cooked/MockChain/Journal.hs
new file mode 100644
index 000000000..0a020e622
--- /dev/null
+++ b/src/Cooked/MockChain/Journal.hs
@@ -0,0 +1,38 @@
+-- | This module exposes the various events emitted during a mockchain run.
+module Cooked.MockChain.Journal where
+
+import Cooked.MockChain.Log
+import Data.Map
+import Data.Map qualified as Map
+import PlutusLedgerApi.V3 qualified as Api
+
+-- | This represents the writable elements that can be emitted throughout a
+-- 'MockChain' run.
+data MockChainJournal where
+  MockChainJournal ::
+    { -- | Log entries generated by cooked-validators
+      mcbLog :: [MockChainLogEntry],
+      -- | Aliases stored by the user
+      mcbAliases :: Map Api.BuiltinByteString String,
+      -- | Notes taken by the user
+      mcbNotes :: [String]
+    } ->
+    MockChainJournal
+
+instance Semigroup MockChainJournal where
+  MockChainJournal l a n <> MockChainJournal l' a' n' = MockChainJournal (l <> l') (a <> a') (n <> n')
+
+instance Monoid MockChainJournal where
+  mempty = MockChainJournal mempty mempty mempty
+
+-- | Build a `MockChainJournal` from a single log entry
+fromLogEntry :: MockChainLogEntry -> MockChainJournal
+fromLogEntry entry = MockChainJournal [entry] mempty mempty
+
+-- | Build a `MockChainJournal` from a single alias
+fromAlias :: String -> Api.BuiltinByteString -> MockChainJournal
+fromAlias s hash = MockChainJournal mempty (Map.singleton hash s) mempty
+
+-- | Build a `MockChainJournal` from a single note
+fromNote :: String -> MockChainJournal
+fromNote s = MockChainJournal mempty mempty [show s]
diff --git a/src/Cooked/MockChain/Log.hs b/src/Cooked/MockChain/Log.hs
index 2ce7dc98c..6a110b563 100644
--- a/src/Cooked/MockChain/Log.hs
+++ b/src/Cooked/MockChain/Log.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 
 module Cooked.MockChain.Log
-  ( -- * Log entries
+  ( -- * Logging events
     MockChainLogEntry (..),
 
     -- * Logging effect
@@ -57,10 +57,11 @@ makeSem_ ''MockChainLog
 -- | Interpreting a `MockChainLog` in terms of a writer of
 -- @[MockChainLogEntry]@
 runMockChainLog ::
-  (Member (Writer [MockChainLogEntry]) effs) =>
+  (Member (Writer j) effs) =>
+  (MockChainLogEntry -> j) ->
   Sem (MockChainLog : effs) a ->
   Sem effs a
-runMockChainLog = interpret $ \(LogEvent event) -> tell [event]
+runMockChainLog inject = interpret $ \(LogEvent event) -> tell $ inject event
 
 -- | Logs an internal event occurring while processing a transaction skeleton
 logEvent :: (Member MockChainLog effs) => MockChainLogEntry -> Sem effs ()
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index dbaa443ee..32ff13ef0 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -17,8 +17,6 @@ where
 
 import Cooked.Pretty.Class
 import Cooked.Pretty.Hashable
-import Data.Map (Map)
-import Data.Map qualified as Map
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Writer
@@ -33,15 +31,15 @@ makeSem_ ''MockChainMisc
 -- | Interpreting a `MockChainMisc` in terms of a writer of @Map
 -- BuiltinByteString String@
 runMockChainMisc ::
-  forall effs a.
-  (Members '[Writer (Map Api.BuiltinByteString String), Writer [String]] effs) =>
+  forall effs a j.
+  (Member (Writer j) effs) =>
+  (String -> Api.BuiltinByteString -> j) ->
+  (String -> j) ->
   Sem (MockChainMisc : effs) a ->
   Sem effs a
-runMockChainMisc = interpret $ \case
-  (Define name hashable) -> do
-    tell $ Map.singleton (toHash hashable) name
-    return hashable
-  (Note s) -> tell [show s]
+runMockChainMisc injectAlias injectNote = interpret $ \case
+  (Define name hashable) -> tell (injectAlias name $ toHash hashable) >> return hashable
+  (Note s) -> tell $ injectNote $ show s
 
 -- | Stores an alias matching a hashable data for pretty printing purpose
 define :: forall effs a. (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 92e9c9145..27bdc8b07 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
 -- | This modules provides primitives to run tests over mockchain executions and
 -- to provide requirements on the the number and results of these runs.
 module Cooked.MockChain.Testing where
@@ -156,19 +158,19 @@ assertSameSets l r =
 -- * Data structure to test mockchain traces
 
 {--
-  Note on properties over the journal (or list of 'MockChainLogEntry'): our
-  'Test' structure does not directly embed a predicate over the journal. Instead
+  Note on properties over the log (or list of 'MockChainLogEntry'): our
+  'Test' structure does not directly embed a predicate over the log. Instead
   it is embedded in both the failure and success prediates. The reason is
-  simple: the journal is generated and accessible in both cases and thus it is
+  simple: the log is generated and accessible in both cases and thus it is
   theoretically possible to define predicates that combine requirements over the
-  journal and the error in case of failure, and the journal and the returning
-  state and value in the case of success. If the journal predicate was a field
+  log and the error in case of failure, and the log and the returning
+  state and value in the case of success. If the log predicate was a field
   in itself, this link would be broken and it would not be possible to epxress
-  complex requirements that involve both the journal and other components of the
+  complex requirements that involve both the log and other components of the
   returned elements in the mockchain run. Granted, this use cas is extremely
   rare, but it does not mean our API should not reflect this capability.
-  However, we also provide 'JournalProp' as in most cases predicating over
-  the journal itself will be sufficient.
+  However, we also provide 'LogProp' as in most cases predicating over
+  the log itself will be sufficient.
 --}
 
 -- | Type of properties over failures
@@ -182,8 +184,8 @@ type SuccessProp a prop = PrettyCookedOpts -> [MockChainLogEntry] -> a -> UtxoSt
 -- contain anything significant that can be pretty printed.
 type SizeProp prop = Integer -> prop
 
--- | Type of properties over the mockchain journal
-type JournalProp prop = PrettyCookedOpts -> [MockChainLogEntry] -> prop
+-- | Type of properties over the mockchain log
+type LogProp prop = PrettyCookedOpts -> [MockChainLogEntry] -> prop
 
 -- | Type of properties over the 'UtxoState'
 type StateProp prop = PrettyCookedOpts -> UtxoState -> prop
@@ -302,11 +304,11 @@ withPrettyOpts test opts = test {testPrettyOpts = opts}
 
 -- | Appends a requirements over the emitted log, which will need to be satisfied
 -- both in case of success or failure of the run.
-withJournalProp :: (IsProp prop) => Test effs a prop -> JournalProp prop -> Test effs a prop
-withJournalProp test journalProp =
+withLogProp :: (IsProp prop) => Test effs a prop -> LogProp prop -> Test effs a prop
+withLogProp test logProp =
   test
-    { testFailureProp = \opts journal err state -> testFailureProp test opts journal err state .&&. journalProp opts journal,
-      testSuccessProp = \opts journal val state -> testSuccessProp test opts journal val state .&&. journalProp opts journal
+    { testFailureProp = \opts log err state -> testFailureProp test opts log err state .&&. logProp opts log,
+      testSuccessProp = \opts log val state -> testSuccessProp test opts log val state .&&. logProp opts log
     }
 
 -- | Appends a requirements over the resulting 'UtxoState', which will need to
@@ -314,8 +316,8 @@ withJournalProp test journalProp =
 withStateProp :: (IsProp prop) => Test effs a prop -> StateProp prop -> Test effs a prop
 withStateProp test stateProp =
   test
-    { testFailureProp = \opts journal err state -> testFailureProp test opts journal err state .&&. stateProp opts state,
-      testSuccessProp = \opts journal val state -> testSuccessProp test opts journal val state .&&. stateProp opts state
+    { testFailureProp = \opts log err state -> testFailureProp test opts log err state .&&. stateProp opts state,
+      testSuccessProp = \opts log val state -> testSuccessProp test opts log val state .&&. stateProp opts state
     }
 
 -- | Appends a requirement over the resulting value and state of the mockchain
@@ -323,7 +325,7 @@ withStateProp test stateProp =
 withSuccessProp :: (IsProp prop) => Test effs a prop -> SuccessProp a prop -> Test effs a prop
 withSuccessProp test successProp =
   test
-    { testSuccessProp = \opts journal val state -> testSuccessProp test opts journal val state .&&. successProp opts journal val state
+    { testSuccessProp = \opts log val state -> testSuccessProp test opts log val state .&&. successProp opts log val state
     }
 
 -- | Same as 'withSuccessProp' but only considers the returning value of the run
@@ -340,7 +342,7 @@ withSizeProp test reqSize =
 -- | Appends a requirement over the resulting value and state of the mockchain
 -- run which will need to be satisfied if the run is successful
 withFailureProp :: (IsProp prop) => Test effs a prop -> FailureProp prop -> Test effs a prop
-withFailureProp test failureProp = test {testFailureProp = \opts journal err state -> testFailureProp test opts journal err state .&&. failureProp opts journal err state}
+withFailureProp test failureProp = test {testFailureProp = \opts log err state -> testFailureProp test opts log err state .&&. failureProp opts log err state}
 
 -- | Same as 'withFailureProp' but only considers the returning error of the run
 withErrorProp :: (IsProp prop) => Test effs a prop -> (MockChainError -> prop) -> Test effs a prop
@@ -385,21 +387,21 @@ isAtMostOfSize :: (IsProp prop) => Integer -> SizeProp prop
 isAtMostOfSize n1 n2 | n1 >= n2 = testSuccess
 isAtMostOfSize n1 n2 = testFailureMsg $ "Incorrect number of results (expected at most: " <> show n1 <> " but got: " <> show n2 <> ")"
 
--- * Specific properties over the journal
+-- * Specific properties over the log
 
 -- | Ensures a certain event has been emitted. This uses the constructor's name
 -- of the 'MockChainLogEntry' by relying on 'show' being lazy.
-happened :: (IsProp prop) => String -> JournalProp prop
-happened eventName _ journal
-  | allEventNames <- Set.fromList (head . words . show <$> journal) =
+happened :: (IsProp prop) => String -> LogProp prop
+happened eventName _ log
+  | allEventNames <- Set.fromList (head . words . show <$> log) =
       if eventName `Set.member` allEventNames
         then testSuccess
         else testFailureMsg $ "The event " <> show eventName <> " did not occur (but those did: " <> show allEventNames <> ")"
 
 -- | Ensures a certain event has not been emitted. This uses the constructor's
 -- name of the 'MockChainLogEntry' by relying on 'show' being lazy.
-didNotHappen :: (IsProp prop) => String -> JournalProp prop
-didNotHappen eventName _ journal | not (eventName `Set.member` Set.fromList (head . words . show <$> journal)) = testSuccess
+didNotHappen :: (IsProp prop) => String -> LogProp prop
+didNotHappen eventName _ log | not (eventName `Set.member` Set.fromList (head . words . show <$> log)) = testSuccess
 didNotHappen eventName _ _ = testFailureMsg $ "The event " <> show eventName <> " was forbidden but occurred nonetheless"
 
 -- * Specific properties over successes
diff --git a/tests/Spec/ProposingScript.hs b/tests/Spec/ProposingScript.hs
index 7d980ab03..ce83ece0e 100644
--- a/tests/Spec/ProposingScript.hs
+++ b/tests/Spec/ProposingScript.hs
@@ -68,37 +68,37 @@ tests =
             mustFailTest
               (testProposingScript False False checkProposingScript (Just alwaysTrueProposingValidator) (ParameterChange [FeePerByte 100]))
               `withFailureProp` isPhase1FailureWithMsg "InvalidPolicyHash"
-              `withJournalProp` didNotHappen "MCLogAutoFilledConstitution",
+              `withLogProp` didNotHappen "MCLogAutoFilledConstitution",
           testCooked "Success when executing the right constitution script" $
             mustSucceedTest
               (testProposingScript False False alwaysTrueProposingValidator (Just alwaysTrueProposingValidator) (ParameterChange [FeePerByte 100]))
-              `withJournalProp` didNotHappen "MCLogAutoFilledConstitution",
+              `withLogProp` didNotHappen "MCLogAutoFilledConstitution",
           testCooked "Success when executing a more complex constitution script" $
             mustSucceedTest
               (testProposingScript False False checkProposingScript (Just checkProposingScript) (ParameterChange [FeePerByte 100]))
-              `withJournalProp` didNotHappen "MCLogAutoFilledConstitution",
+              `withLogProp` didNotHappen "MCLogAutoFilledConstitution",
           testCooked "Failure when executing a more complex constitution script with the wrong proposal" $
             mustFailInPhase2Test
               (testProposingScript False False checkProposingScript (Just checkProposingScript) (ParameterChange [FeePerByte 50]))
-              `withJournalProp` didNotHappen "MCLogAutoFilledConstitution",
+              `withLogProp` didNotHappen "MCLogAutoFilledConstitution",
           testCooked "Success when executing a more complex constitution script as a reference script" $
             mustSucceedTest (testProposingScript True False checkProposingScript (Just checkProposingScript) (ParameterChange [FeePerByte 100]))
-              `withJournalProp` happened "MCLogAddedReferenceScript"
-              `withJournalProp` didNotHappen "MCLogAutoFilledConstitution"
+              `withLogProp` happened "MCLogAddedReferenceScript"
+              `withLogProp` didNotHappen "MCLogAutoFilledConstitution"
         ],
       testGroup
         "Automated constitution attachment"
         [ testCooked "Success when auto assigning the constitution script" $
             mustSucceedTest
               (testProposingScript False True checkProposingScript Nothing (ParameterChange [FeePerByte 100]))
-              `withJournalProp` happened "MCLogAutoFilledConstitution",
+              `withLogProp` happened "MCLogAutoFilledConstitution",
           testCooked "Success when auto assigning the constitution script and using it as a reference script" $
             mustSucceedTest (testProposingScript True True checkProposingScript Nothing (ParameterChange [FeePerByte 100]))
-              `withJournalProp` happened "MCLogAddedReferenceScript"
-              `withJournalProp` happened "MCLogAutoFilledConstitution",
+              `withLogProp` happened "MCLogAddedReferenceScript"
+              `withLogProp` happened "MCLogAutoFilledConstitution",
           testCooked "Success when auto assigning the constitution script while overriding an existing one" $
             mustSucceedTest
               (testProposingScript False True checkProposingScript (Just alwaysFalseProposingValidator) (ParameterChange [FeePerByte 100]))
-              `withJournalProp` happened "MCLogAutoFilledConstitution"
+              `withLogProp` happened "MCLogAutoFilledConstitution"
         ]
     ]
diff --git a/tests/Spec/ReferenceScripts.hs b/tests/Spec/ReferenceScripts.hs
index 9f1ad94e2..272fbacec 100644
--- a/tests/Spec/ReferenceScripts.hs
+++ b/tests/Spec/ReferenceScripts.hs
@@ -238,7 +238,7 @@ tests =
               referenceMint Script.alwaysSucceedPolicyVersioned Script.alwaysSucceedPolicyVersioned 0 False,
           testCooked "succeed if relying on automated finding of reference minting policy" $
             mustSucceedTest (referenceMint Script.alwaysSucceedPolicyVersioned Script.alwaysSucceedPolicyVersioned 0 True)
-              `withJournalProp` happened "MCLogAddedReferenceScript",
+              `withLogProp` happened "MCLogAddedReferenceScript",
           testCooked "fail if given the wrong reference minting policy" $
             mustFailTest (referenceMint Script.alwaysFailPolicyVersioned Script.alwaysSucceedPolicyVersioned 0 False)
               `withErrorProp` \case
diff --git a/tests/Spec/Tweak/ValidityRange.hs b/tests/Spec/Tweak/ValidityRange.hs
index ca8d8313b..a77a4aa37 100644
--- a/tests/Spec/Tweak/ValidityRange.hs
+++ b/tests/Spec/Tweak/ValidityRange.hs
@@ -77,7 +77,7 @@ interpretValidityRange =
     . runNonDet
     . fmap snd
     . runWriter
-    . runMockChainLog
+    . runMockChainLog (: [])
     . evalState def
     . runError
     . runFailInMockChainError
diff --git a/tests/Spec/Withdrawals.hs b/tests/Spec/Withdrawals.hs
index b76996bb2..9f07e5b70 100644
--- a/tests/Spec/Withdrawals.hs
+++ b/tests/Spec/Withdrawals.hs
@@ -62,7 +62,7 @@ tests =
               (scriptUserWithdrawing 0)
               Nothing
           )
-          `withJournalProp` happened "MCLogAutoFilledWithdrawalAmount",
+          `withLogProp` happened "MCLogAutoFilledWithdrawalAmount",
       testCooked ".. but the script's logic might say No" $
         mustFailTest
           ( testWithdrawingScript
@@ -71,7 +71,7 @@ tests =
               Nothing
           )
           `withFailureProp` isPhase2FailureWithMsg "Wrong quantity: 0 instead of 2000000"
-          `withJournalProp` happened "MCLogAutoFilledWithdrawalAmount",
+          `withLogProp` happened "MCLogAutoFilledWithdrawalAmount",
       testCooked "We cannot withdraw more than our rewards (0)" $
         mustFailTest
           ( testWithdrawingScript
@@ -80,7 +80,7 @@ tests =
               (Just 2)
           )
           `withFailureProp` isPhase1FailureWithMsg "WithdrawalsNotInRewardsCERTS"
-          `withJournalProp` didNotHappen "MCLogAutoFilledWithdrawalAmount",
+          `withLogProp` didNotHappen "MCLogAutoFilledWithdrawalAmount",
       testCooked "A peer can also make a withdrawal" $
         mustSucceedTest
           ( testWithdrawingScript
@@ -88,5 +88,5 @@ tests =
               aliceUser
               Nothing
           )
-          `withJournalProp` happened "MCLogAutoFilledWithdrawalAmount"
+          `withLogProp` happened "MCLogAutoFilledWithdrawalAmount"
     ]

From c4de79e48e32d69f29dafdaf457faae6392d4dab Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Sun, 25 Jan 2026 20:38:08 +0100
Subject: [PATCH 51/96] migrating temporarily to the haskell-update branch from
 nixpkgs to get cabal-install 3.16.1.0

---
 flake.lock |  14 ++---
 flake.nix  | 153 ++++++++++++++++++++++++++++-------------------------
 2 files changed, 88 insertions(+), 79 deletions(-)

diff --git a/flake.lock b/flake.lock
index 85ebc3f5a..0bf532c57 100644
--- a/flake.lock
+++ b/flake.lock
@@ -57,17 +57,17 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1750127977,
-        "narHash": "sha256-zD1OwL7YRiurl1NW16Ke88S7JStBfawbiY/DVpS28P4=",
+        "lastModified": 1769300771,
+        "narHash": "sha256-MI1YHDj3a4B3Tl4y8xXQUfOMmp1/+89ZAERztmmMCpI=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "28ace32529a63842e4f8103e4f9b24960cf6c23a",
+        "rev": "b2286b474056786a86863bd3efd9f5ab36d030b6",
         "type": "github"
       },
       "original": {
         "owner": "NixOS",
+        "ref": "haskell-updates",
         "repo": "nixpkgs",
-        "rev": "28ace32529a63842e4f8103e4f9b24960cf6c23a",
         "type": "github"
       }
     },
@@ -80,11 +80,11 @@
         ]
       },
       "locked": {
-        "lastModified": 1767281941,
-        "narHash": "sha256-6MkqajPICgugsuZ92OMoQcgSHnD6sJHwk8AxvMcIgTE=",
+        "lastModified": 1769069492,
+        "narHash": "sha256-Efs3VUPelRduf3PpfPP2ovEB4CXT7vHf8W+xc49RL/U=",
         "owner": "cachix",
         "repo": "pre-commit-hooks.nix",
-        "rev": "f0927703b7b1c8d97511c4116eb9b4ec6645a0fa",
+        "rev": "a1ef738813b15cf8ec759bdff5761b027e3e1d23",
         "type": "github"
       },
       "original": {
diff --git a/flake.nix b/flake.nix
index e127efd5d..deceda322 100644
--- a/flake.nix
+++ b/flake.nix
@@ -1,12 +1,18 @@
 {
-  inputs.nixpkgs.url =
-    "github:NixOS/nixpkgs/28ace32529a63842e4f8103e4f9b24960cf6c23a";
+  inputs.nixpkgs.url = "github:NixOS/nixpkgs/haskell-updates";
   inputs.flake-utils.url = "github:numtide/flake-utils";
   inputs.pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix";
   inputs.pre-commit-hooks.inputs.nixpkgs.follows = "nixpkgs";
 
-  outputs = { self, nixpkgs, flake-utils, pre-commit-hooks }:
-    flake-utils.lib.eachDefaultSystem (system:
+  outputs =
+    {
+      self,
+      nixpkgs,
+      flake-utils,
+      pre-commit-hooks,
+    }:
+    flake-utils.lib.eachDefaultSystem (
+      system:
       let
         pkgs = nixpkgs.legacyPackages.${system};
         hpkgs = pkgs.haskell.packages.ghc96;
@@ -16,16 +22,15 @@
         ## is due to a bug where older processors (>= 10 years)
         ## would not be supported. This should not change anything
         ## on newer machines. This could be revised in the future.
-        blst-portable = pkgs.blst.overrideAttrs (_: _: {
-          buildPhase = ''
-            runHook preBuild
-            ./build.sh -shared -D__BLST_PORTABLE__ ${
-              pkgs.lib.optionalString pkgs.stdenv.hostPlatform.isWindows
-              "flavour=mingw64"
-            }
-            runHook postBuild
-          '';
-        });
+        blst-portable = pkgs.blst.overrideAttrs (
+          _: _: {
+            buildPhase = ''
+              runHook preBuild
+              ./build.sh -shared -D__BLST_PORTABLE__ ${pkgs.lib.optionalString pkgs.stdenv.hostPlatform.isWindows "flavour=mingw64"}
+              runHook postBuild
+            '';
+          }
+        );
 
         pre-commit = pre-commit-hooks.lib.${system}.run {
           src = ./.;
@@ -46,75 +51,79 @@
             ## for more information.
           };
         };
-      in {
+      in
+      {
         formatter = pkgs.nixfmt;
 
-        devShells = let
-          ## The minimal dependency set to build the project with `cabal`.
-          buildInputs = [
-            blst-portable
-            pkgs.pkg-config
-            pkgs.glibcLocales
-            pkgs.zlib
-            pkgs.libsodium
-            pkgs.secp256k1
-            pkgs.lmdb
-            hpkgs.ghc
-            hpkgs.cabal-install
-          ];
+        devShells =
+          let
+            ## The minimal dependency set to build the project with `cabal`.
+            buildInputs = [
+              blst-portable
+              pkgs.pkg-config
+              pkgs.glibcLocales
+              pkgs.zlib
+              pkgs.libsodium
+              pkgs.secp256k1
+              pkgs.lmdb
+              hpkgs.ghc
+              hpkgs.cabal-install
+            ];
 
-          ## Folders in which to find ".so" files
-          LD_LIBRARY_PATH = pkgs.lib.strings.makeLibraryPath [
-            pkgs.xz
-            pkgs.zlib
-            pkgs.lmdb
-            pkgs.openssl_3_4
-            pkgs.postgresql # For cardano-node-emulator
-            pkgs.openldap # For freer-extras‽
-            pkgs.libsodium
-            pkgs.secp256k1
-            pkgs.lmdb
-            blst-portable
-          ];
+            ## Folders in which to find ".so" files
+            LD_LIBRARY_PATH = pkgs.lib.strings.makeLibraryPath [
+              pkgs.xz
+              pkgs.zlib
+              pkgs.lmdb
+              pkgs.openssl_3_6
+              pkgs.postgresql # For cardano-node-emulator
+              pkgs.openldap # For freer-extras‽
+              pkgs.libsodium
+              pkgs.secp256k1
+              pkgs.lmdb
+              blst-portable
+            ];
 
-          LANG = "C.UTF-8";
+            LANG = "C.UTF-8";
 
-        in {
-          ci = pkgs.mkShell {
-            inherit buildInputs;
-            inherit LD_LIBRARY_PATH;
-            inherit LANG;
-          };
+          in
+          {
+            ci = pkgs.mkShell {
+              inherit buildInputs;
+              inherit LD_LIBRARY_PATH;
+              inherit LANG;
+            };
 
-          default = pkgs.mkShell {
-            buildInputs = buildInputs ++ [
-              pkgs.hpack
-              pkgs.hlint
-              hpkgs.ormolu
-              hpkgs.haskell-language-server
-            ];
+            default = pkgs.mkShell {
+              buildInputs = buildInputs ++ [
+                pkgs.hpack
+                pkgs.hlint
+                hpkgs.ormolu
+                hpkgs.haskell-language-server
+              ];
 
-            inherit LD_LIBRARY_PATH;
-            inherit LANG;
+              inherit LD_LIBRARY_PATH;
+              inherit LANG;
 
-            # In addition to the pre-commit hooks, this redefines a cabal
-            # command that gets rid of annoying "Writing: .....*.html" output
-            # when running cabal test.
-            shellHook = pre-commit.shellHook + ''
-              function cabal() {
-                    if [ "$1" != "test" ]; then
-                      command cabal "$@"
-                    else
-                      command cabal --test-option=--color=always "$@" | grep -vE --color=never "^Writing:.*html$"
-                    fi
-              }
-              export -f cabal
-            '';
+              # In addition to the pre-commit hooks, this redefines a cabal
+              # command that gets rid of annoying "Writing: .....*.html" output
+              # when running cabal test.
+              shellHook = pre-commit.shellHook + ''
+                function cabal() {
+                      if [ "$1" != "test" ]; then
+                        command cabal "$@"
+                      else
+                        command cabal --test-option=--color=always "$@" | grep -vE --color=never "^Writing:.*html$"
+                      fi
+                }
+                export -f cabal
+              '';
+            };
           };
-        };
 
         checks = { inherit pre-commit; };
-      });
+      }
+    );
 
   nixConfig = {
     extra-trusted-substituters = [

From 995c2057ab2fb6e0827eef1bf34e360946a30be4 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 26 Jan 2026 01:00:24 +0100
Subject: [PATCH 52/96] tweak file in mockchain

---
 cooked-validators.cabal           |   3 +-
 src/Cooked/MockChain.hs           |   2 +
 src/Cooked/MockChain/Instances.hs |   6 +-
 src/Cooked/MockChain/Tweak.hs     | 138 ++++++++++++++++++++++++++++++
 src/Cooked/MockChain/Write.hs     | 126 +--------------------------
 5 files changed, 146 insertions(+), 129 deletions(-)
 create mode 100644 src/Cooked/MockChain/Tweak.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index c2d0de975..c9d201982 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.4
 
--- This file has been generated from package.yaml by hpack version 0.37.0.
+-- This file has been generated from package.yaml by hpack version 0.38.3.
 --
 -- see: https://github.com/sol/hpack
 
@@ -44,6 +44,7 @@ library
       Cooked.MockChain.Read
       Cooked.MockChain.State
       Cooked.MockChain.Testing
+      Cooked.MockChain.Tweak
       Cooked.MockChain.UtxoSearch
       Cooked.MockChain.UtxoState
       Cooked.MockChain.Write
diff --git a/src/Cooked/MockChain.hs b/src/Cooked/MockChain.hs
index 2e56e7c2d..6e3de73a3 100644
--- a/src/Cooked/MockChain.hs
+++ b/src/Cooked/MockChain.hs
@@ -7,10 +7,12 @@ import Cooked.MockChain.Balancing as X
 import Cooked.MockChain.Common as X
 import Cooked.MockChain.Error as X
 import Cooked.MockChain.Instances as X
+import Cooked.MockChain.Journal as X
 import Cooked.MockChain.Misc as X
 import Cooked.MockChain.Read as X
 import Cooked.MockChain.State as X
 import Cooked.MockChain.Testing as X
+import Cooked.MockChain.Tweak as X
 import Cooked.MockChain.UtxoSearch as X
 import Cooked.MockChain.UtxoState as X
 import Cooked.MockChain.Write as X
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 59214784a..bc12a2f7b 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -25,10 +25,10 @@ import Cooked.MockChain.Log
 import Cooked.MockChain.Misc
 import Cooked.MockChain.Read
 import Cooked.MockChain.State
+import Cooked.MockChain.Tweak
 import Cooked.MockChain.UtxoState
 import Cooked.MockChain.Write
 import Cooked.Skeleton.Output
-import Cooked.Tweak.Common
 import Data.Default
 import Data.Map (Map)
 import Ledger.Tx qualified as Ledger
@@ -155,7 +155,7 @@ instance IsMockChain DirectEffs where
 
 type StagedTweakEffs = '[MockChainRead, Fail, NonDet]
 
-type StagedTweak a = Sem (Tweak : NonDet : StagedTweakEffs) a
+type StagedTweak a = TypedTweak StagedTweakEffs a
 
 type StagedEffs =
   '[ ModifyGlobally (UntypedTweak StagedTweakEffs),
@@ -210,7 +210,7 @@ type FullTweakEffs =
      NonDet
    ]
 
-type FullTweak a = Sem (Tweak : NonDet : FullTweakEffs) a
+type FullTweak a = TypedTweak FullTweakEffs a
 
 type FullEffs =
   '[ ModifyGlobally (UntypedTweak FullTweakEffs),
diff --git a/src/Cooked/MockChain/Tweak.hs b/src/Cooked/MockChain/Tweak.hs
new file mode 100644
index 000000000..24b105e8d
--- /dev/null
+++ b/src/Cooked/MockChain/Tweak.hs
@@ -0,0 +1,138 @@
+-- | This module applies the `Cooked.Tweak.Common.Tweak` effect for the purpose
+-- of modifying transaction skeleton before sending them for validation.
+module Cooked.MockChain.Tweak
+  ( -- * Modifying mockchain runs using tweaks
+    reinterpretMockChainWriteWithTweak,
+
+    -- * Typed and Untyped tweaks geared for `TxSkel` modifications
+    TypedTweak,
+    UntypedTweak (..),
+
+    -- * Modalities to deploy `UntypedTweak`s on time
+    somewhere,
+    everywhere,
+    nowhere,
+    whenAble,
+    there,
+    withTweak,
+  )
+where
+
+import Control.Monad
+import Cooked.Ltl
+import Cooked.MockChain.Write
+import Cooked.Tweak.Common
+import Data.Coerce
+import Polysemy
+import Polysemy.Internal
+import Polysemy.NonDet
+
+type TypedTweak tweakEffs a = Sem (Tweak : NonDet : tweakEffs) a
+
+-- | Wrapping up tweaks while hiding their return type and unsuring their stack
+-- of effects begins with `Tweak` and `NonDet`.
+data UntypedTweak tweakEffs where
+  UntypedTweak :: TypedTweak tweakEffs a -> UntypedTweak tweakEffs
+
+fromTweak ::
+  TypedTweak tweakEffs a ->
+  Ltl (UntypedTweak tweakEffs)
+fromTweak = LtlAtom . UntypedTweak
+
+-- | Applies a 'Tweak' to every step in a trace where it is applicable,
+-- branching at any such locations. The tweak must apply at least once.
+somewhere ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs b ->
+  Sem effs a ->
+  Sem effs a
+somewhere = modifyLtl . ltlEventually . fromTweak
+
+-- | Applies a 'Tweak' to every transaction in a given trace. Fails if the tweak
+-- fails anywhere in the trace.
+everywhere ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs b ->
+  Sem effs a ->
+  Sem effs a
+everywhere = modifyLtl . ltlAlways . fromTweak
+
+-- | Ensures a given 'Tweak' can never successfully be applied in a computation,
+-- and leaves the computation unchanged.
+nowhere ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs b ->
+  Sem effs a ->
+  Sem effs a
+nowhere = modifyLtl . ltlNever . fromTweak
+
+-- | Apply a given 'Tweak' at every location in a computation where it does not
+-- fail, which might never occur.
+whenAble ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  TypedTweak tweakEffs b ->
+  Sem effs a ->
+  Sem effs a
+whenAble = modifyLtl . ltlWhenPossible . fromTweak
+
+-- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
+-- trace. Successful when this transaction exists and can be modified.
+--
+-- See also `Cooked.Tweak.Labels.labelled` to select transactions based on
+-- labels instead of their index.
+there ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  Integer ->
+  TypedTweak tweakEffs b ->
+  Sem effs a ->
+  Sem effs a
+there n = modifyLtl . ltlDelay n . fromTweak
+
+-- | Apply a 'Tweak' to the next transaction in the given trace. The order of
+-- arguments enables an idiom like
+--
+-- > do ...
+-- >    endpoint arguments `withTweak` someModification
+-- >    ...
+--
+-- where @endpoint@ builds and validates a single transaction depending on the
+-- given @arguments@. Then `withTweak` says "I want to modify the transaction
+-- returned by this endpoint in the following way".
+withTweak ::
+  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
+  Sem effs a ->
+  TypedTweak tweakEffs b ->
+  Sem effs a
+withTweak = flip (there 0)
+
+-- | Reinterpretes `MockChainWrite` in itself, when the `ModifyLocally` effect
+-- exists in the stack, applying the relevant modifications in the process.
+reinterpretMockChainWriteWithTweak ::
+  forall tweakEffs effs a.
+  ( Members
+      '[ ModifyLocally (UntypedTweak tweakEffs),
+         NonDet
+       ]
+      effs,
+    Subsume tweakEffs effs
+  ) =>
+  Sem (MockChainWrite : effs) a ->
+  Sem (MockChainWrite : effs) a
+reinterpretMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
+  ValidateTxSkel skel -> do
+    requirements <- getRequirements
+    let sumTweak :: TypedTweak tweakEffs () =
+          foldr
+            ( \req acc -> case req of
+                Apply (UntypedTweak tweak) -> tweak >> acc
+                EnsureFailure (UntypedTweak tweak) -> do
+                  txSkel' <- getTxSkel
+                  results <- raise_ $ runNonDet @[] $ runTweak txSkel' tweak
+                  guard $ null results
+                  acc
+            )
+            (return ())
+            requirements
+    newTxSkel <- raise $ subsume_ $ fst <$> runTweak skel sumTweak
+    validateTxSkel newTxSkel
+  a -> send $ coerce a
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index b92daee36..3e950cc0e 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -4,19 +4,9 @@
 -- blockchain, including by sending transactions for validation.
 module Cooked.MockChain.Write
   ( -- * The `MockChainWrite` effect
-    MockChainWrite,
-    reinterpretMockChainWriteWithTweak,
+    MockChainWrite (..),
     runMockChainWrite,
 
-    -- * Untyped tweaks and associated modalities
-    UntypedTweak (..),
-    somewhere,
-    everywhere,
-    nowhere,
-    whenAble,
-    there,
-    withTweak,
-
     -- * Modifications of the current time
     waitNSlots,
     awaitSlot,
@@ -41,7 +31,6 @@ import Cardano.Api.Ledger qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
 import Control.Lens qualified as Lens
 import Control.Monad
-import Cooked.Ltl
 import Cooked.MockChain.AutoFilling
 import Cooked.MockChain.Balancing
 import Cooked.MockChain.Error
@@ -52,7 +41,6 @@ import Cooked.MockChain.Read
 import Cooked.MockChain.State
 import Cooked.Skeleton
 import Cooked.Tweak.Common
-import Data.Coerce
 import Data.Map.Strict qualified as Map
 import Ledger.Index qualified as Ledger
 import Ledger.Orphans ()
@@ -65,8 +53,6 @@ import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Error
 import Polysemy.Fail
-import Polysemy.Internal
-import Polysemy.NonDet
 import Polysemy.State
 
 -- | An effect that offers all the primitives that are performing modifications
@@ -80,116 +66,6 @@ data MockChainWrite :: Effect where
 
 makeSem_ ''MockChainWrite
 
-type TypedTweak tweakEffs a = Sem (Tweak : NonDet : tweakEffs) a
-
--- | Wrapping up tweaks while hiding their return type and unsuring their stack
--- of effects begins with `Tweak` and `NonDet`.
-data UntypedTweak tweakEffs where
-  UntypedTweak :: TypedTweak tweakEffs a -> UntypedTweak tweakEffs
-
-fromTweak ::
-  TypedTweak tweakEffs a ->
-  Ltl (UntypedTweak tweakEffs)
-fromTweak = LtlAtom . UntypedTweak
-
--- | Applies a 'Tweak' to every step in a trace where it is applicable,
--- branching at any such locations. The tweak must apply at least once.
-somewhere ::
-  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs b ->
-  Sem effs a ->
-  Sem effs a
-somewhere = modifyLtl . ltlEventually . fromTweak
-
--- | Applies a 'Tweak' to every transaction in a given trace. Fails if the tweak
--- fails anywhere in the trace.
-everywhere ::
-  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs b ->
-  Sem effs a ->
-  Sem effs a
-everywhere = modifyLtl . ltlAlways . fromTweak
-
--- | Ensures a given 'Tweak' can never successfully be applied in a computation,
--- and leaves the computation unchanged.
-nowhere ::
-  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs b ->
-  Sem effs a ->
-  Sem effs a
-nowhere = modifyLtl . ltlNever . fromTweak
-
--- | Apply a given 'Tweak' at every location in a computation where it does not
--- fail, which might never occur.
-whenAble ::
-  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  TypedTweak tweakEffs b ->
-  Sem effs a ->
-  Sem effs a
-whenAble = modifyLtl . ltlWhenPossible . fromTweak
-
--- | Apply a 'Tweak' to the (0-indexed) nth transaction in a given
--- trace. Successful when this transaction exists and can be modified.
---
--- See also `Cooked.Tweak.Labels.labelled` to select transactions based on
--- labels instead of their index.
-there ::
-  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  Integer ->
-  TypedTweak tweakEffs b ->
-  Sem effs a ->
-  Sem effs a
-there n = modifyLtl . ltlDelay n . fromTweak
-
--- | Apply a 'Tweak' to the next transaction in the given trace. The order of
--- arguments enables an idiom like
---
--- > do ...
--- >    endpoint arguments `withTweak` someModification
--- >    ...
---
--- where @endpoint@ builds and validates a single transaction depending on the
--- given @arguments@. Then `withTweak` says "I want to modify the transaction
--- returned by this endpoint in the following way".
-withTweak ::
-  (Members '[ModifyGlobally (UntypedTweak tweakEffs)] effs) =>
-  Sem effs a ->
-  TypedTweak tweakEffs b ->
-  Sem effs a
-withTweak = flip (there 0)
-
--- | Reinterpretes `MockChainWrite` in itself, when the `ModifyLocally` effect
--- exists in the stack, applying the relevant modifications in the process.
-reinterpretMockChainWriteWithTweak ::
-  forall tweakEffs effs a.
-  ( Members
-      '[ ModifyLocally (UntypedTweak tweakEffs),
-         NonDet
-       ]
-      effs,
-    Subsume tweakEffs effs
-  ) =>
-  Sem (MockChainWrite : effs) a ->
-  Sem (MockChainWrite : effs) a
-reinterpretMockChainWriteWithTweak = reinterpret @MockChainWrite $ \case
-  ValidateTxSkel skel -> do
-    requirements <- getRequirements
-    let sumTweak :: TypedTweak tweakEffs () =
-          foldr
-            ( \req acc -> case req of
-                Apply (UntypedTweak tweak) -> tweak >> acc
-                EnsureFailure (UntypedTweak tweak) -> do
-                  txSkel' <- getTxSkel
-                  results <- raise_ $ runNonDet @[] $ runTweak txSkel' tweak
-                  guard $ null results
-                  acc
-            )
-            (return ())
-            requirements
-    newTxSkel <- raise $ subsume_ $ fst <$> runTweak skel sumTweak
-    validateTxSkel newTxSkel
-  a -> send $ coerce a
-
 -- | Interpretes the `MockChainWrite` effect
 runMockChainWrite ::
   forall effs a.

From 679d118dcb605511c857d5be4bb6ffce29a59cca Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 26 Jan 2026 01:21:22 +0100
Subject: [PATCH 53/96] Byebye UtxoState.hs

---
 cooked-validators.cabal           |   1 -
 src/Cooked/MockChain.hs           |   1 -
 src/Cooked/MockChain/Instances.hs |   1 -
 src/Cooked/MockChain/State.hs     | 129 ++++++++++++++++++++++++++----
 src/Cooked/MockChain/Testing.hs   |   2 +-
 src/Cooked/MockChain/UtxoState.hs | 103 ------------------------
 src/Cooked/Pretty/MockChain.hs    |   2 +-
 7 files changed, 117 insertions(+), 122 deletions(-)
 delete mode 100644 src/Cooked/MockChain/UtxoState.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index c9d201982..73fa58f65 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -46,7 +46,6 @@ library
       Cooked.MockChain.Testing
       Cooked.MockChain.Tweak
       Cooked.MockChain.UtxoSearch
-      Cooked.MockChain.UtxoState
       Cooked.MockChain.Write
       Cooked.Pretty
       Cooked.Pretty.Class
diff --git a/src/Cooked/MockChain.hs b/src/Cooked/MockChain.hs
index 6e3de73a3..ad87ea2a5 100644
--- a/src/Cooked/MockChain.hs
+++ b/src/Cooked/MockChain.hs
@@ -14,5 +14,4 @@ import Cooked.MockChain.State as X
 import Cooked.MockChain.Testing as X
 import Cooked.MockChain.Tweak as X
 import Cooked.MockChain.UtxoSearch as X
-import Cooked.MockChain.UtxoState as X
 import Cooked.MockChain.Write as X
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index bc12a2f7b..89abe4a6a 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -26,7 +26,6 @@ import Cooked.MockChain.Misc
 import Cooked.MockChain.Read
 import Cooked.MockChain.State
 import Cooked.MockChain.Tweak
-import Cooked.MockChain.UtxoState
 import Cooked.MockChain.Write
 import Cooked.Skeleton.Output
 import Data.Default
diff --git a/src/Cooked/MockChain/State.hs b/src/Cooked/MockChain/State.hs
index 5774723be..8dc6ee2a9 100644
--- a/src/Cooked/MockChain/State.hs
+++ b/src/Cooked/MockChain/State.hs
@@ -1,26 +1,43 @@
 -- | This module exposes the internal state in which our direct simulation is
--- run, and functions to update and query it.
+-- run, as well as a simplified version, more akin to testing and printing.
 module Cooked.MockChain.State
-  ( MockChainState (..),
+  ( -- * `MockChainState` and associated optics
+    MockChainState (..),
     mcstParamsL,
     mcstLedgerStateL,
     mcstOutputsL,
     mcstConstitutionL,
-    mcstToUtxoState,
+
+    -- * Adding and removing outputs from a `MockChainState`
     addOutput,
     removeOutput,
+
+    -- * `UtxoState`: A simplified, address-focused view on a `MockChainState`
+    UtxoPayloadDatum (..),
+    UtxoPayload (..),
+    UtxoPayloadSet (..),
+    UtxoState (..),
+
+    -- * Querying the assets owned by a given address
+    holdsInState,
+
+    -- * Transforming a `MockChainState` into an `UtxoState`
+    mcstToUtxoState,
   )
 where
 
 import Cardano.Node.Emulator.Internal.Node qualified as Emulator
-import Cooked.MockChain.UtxoState
 import Cooked.Skeleton
 import Data.Default
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
+import Data.Function (on)
+import Data.List qualified as List
+import Data.Map (Map)
+import Data.Map qualified as Map
 import Ledger.Orphans ()
 import Optics.Core
 import Optics.TH
+import Plutus.Script.Utils.Address qualified as Script
+import PlutusLedgerApi.V1.Value qualified as Api
 import PlutusLedgerApi.V3 qualified as Api
 
 -- | The state used to run the simulation in 'Cooked.MockChain.Direct'
@@ -55,6 +72,98 @@ makeLensesFor [("mcstConstitution", "mcstConstitutionL")] ''MockChainState
 instance Default MockChainState where
   def = MockChainState def (Emulator.initialState def) Map.empty Nothing
 
+-- | Stores an output in a 'MockChainState'
+addOutput :: Api.TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
+addOutput oRef = set (mcstOutputsL % at oRef) . Just . (,True)
+
+-- | Removes an output from the 'MockChainState'
+removeOutput :: Api.TxOutRef -> MockChainState -> MockChainState
+removeOutput oRef = set (mcstOutputsL % at oRef) Nothing
+
+-- | A simplified version of a 'Cooked.Skeleton.Datum.TxSkelOutDatum' which only
+-- stores the actual datum and whether it is hashed or inline.
+data UtxoPayloadDatum where
+  NoUtxoPayloadDatum :: UtxoPayloadDatum
+  SomeUtxoPayloadDatum :: (DatumConstrs dat) => dat -> Bool -> UtxoPayloadDatum
+
+deriving instance Show UtxoPayloadDatum
+
+instance Ord UtxoPayloadDatum where
+  compare NoUtxoPayloadDatum NoUtxoPayloadDatum = EQ
+  compare NoUtxoPayloadDatum _ = LT
+  compare _ NoUtxoPayloadDatum = GT
+  compare
+    (SomeUtxoPayloadDatum (Api.toBuiltinData -> dat) b)
+    (SomeUtxoPayloadDatum (Api.toBuiltinData -> dat') b') =
+      compare (dat, b) (dat', b')
+
+instance Eq UtxoPayloadDatum where
+  dat == dat' = compare dat dat' == EQ
+
+-- | A convenient wrapping of the interesting information of a UTxO.
+data UtxoPayload where
+  UtxoPayload ::
+    { -- | The reference of this UTxO
+      utxoPayloadTxOutRef :: Api.TxOutRef,
+      -- | The value stored in this UTxO
+      utxoPayloadValue :: Api.Value,
+      -- | The optional datum stored in this UTxO
+      utxoPayloadDatum :: UtxoPayloadDatum,
+      -- | The optional reference script stored in this UTxO
+      utxoPayloadReferenceScript :: Maybe Api.ScriptHash
+    } ->
+    UtxoPayload
+  deriving (Eq, Show)
+
+instance Eq UtxoPayloadSet where
+  (UtxoPayloadSet xs) == (UtxoPayloadSet ys) = xs' == ys'
+    where
+      k (UtxoPayload ref val dat rs) = (ref, Api.flattenValue val, dat, rs)
+      xs' = List.sortBy (compare `on` k) xs
+      ys' = List.sortBy (compare `on` k) ys
+
+instance Semigroup UtxoPayloadSet where
+  UtxoPayloadSet a <> UtxoPayloadSet b = UtxoPayloadSet $ a ++ b
+
+instance Monoid UtxoPayloadSet where
+  mempty = UtxoPayloadSet []
+
+-- | Represents a /set/ of payloads.
+newtype UtxoPayloadSet = UtxoPayloadSet
+  { -- | List of UTxOs contained in this 'UtxoPayloadSet'
+    utxoPayloadSet :: [UtxoPayload]
+    -- We use a list instead of a set because 'Api.Value' doesn't implement 'Ord'
+    -- and because it is possible that we want to distinguish between utxo states
+    -- that have additional utxos, even if these could have been merged together.
+  }
+  deriving (Show)
+
+-- | A description of who owns what in a blockchain. Owners are addresses and
+-- they each own a 'UtxoPayloadSet'.
+data UtxoState where
+  UtxoState ::
+    { -- | Utxos available to be consumed
+      availableUtxos :: Map Api.Address UtxoPayloadSet,
+      -- | Utxos already consumed
+      consumedUtxos :: Map Api.Address UtxoPayloadSet
+    } ->
+    UtxoState
+  deriving (Eq)
+
+instance Semigroup UtxoState where
+  (UtxoState a c) <> (UtxoState a' c') = UtxoState (Map.unionWith (<>) a a') (Map.unionWith (<>) c c')
+
+instance Monoid UtxoState where
+  mempty = UtxoState Map.empty Map.empty
+
+-- | Total value accessible to what's pointed by the address.
+holdsInState :: (Script.ToAddress a) => a -> UtxoState -> Api.Value
+holdsInState (Script.toAddress -> address) = maybe mempty utxoPayloadSetTotal . Map.lookup address . availableUtxos
+
+-- | Computes the total value in a set
+utxoPayloadSetTotal :: UtxoPayloadSet -> Api.Value
+utxoPayloadSetTotal = mconcat . fmap utxoPayloadValue . utxoPayloadSet
+
 -- | Builds a 'UtxoState' from a 'MockChainState'
 mcstToUtxoState :: MockChainState -> UtxoState
 mcstToUtxoState =
@@ -77,11 +186,3 @@ mcstToUtxoState =
        in if bool
             then utxoState {availableUtxos = Map.insertWith (<>) newAddress newPayloadSet (availableUtxos utxoState)}
             else utxoState {consumedUtxos = Map.insertWith (<>) newAddress newPayloadSet (consumedUtxos utxoState)}
-
--- | Stores an output in a 'MockChainState'
-addOutput :: Api.TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
-addOutput oRef txSkelOut = over mcstOutputsL (Map.insert oRef (txSkelOut, True))
-
--- | Removes an output from the 'MockChainState'
-removeOutput :: Api.TxOutRef -> MockChainState -> MockChainState
-removeOutput oRef = over mcstOutputsL (Map.update (\(output, _) -> Just (output, False)) oRef)
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 27bdc8b07..33baea50c 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -10,7 +10,7 @@ import Cooked.InitialDistribution
 import Cooked.MockChain.Error
 import Cooked.MockChain.Instances
 import Cooked.MockChain.Log
-import Cooked.MockChain.UtxoState
+import Cooked.MockChain.State
 import Cooked.MockChain.Write
 import Cooked.Pretty
 import Data.Default
diff --git a/src/Cooked/MockChain/UtxoState.hs b/src/Cooked/MockChain/UtxoState.hs
deleted file mode 100644
index 055daad72..000000000
--- a/src/Cooked/MockChain/UtxoState.hs
+++ /dev/null
@@ -1,103 +0,0 @@
--- | This module provides a depiction of the state we return when running a
--- 'Cooked.BlockChain.Direct.MockChain'.
-module Cooked.MockChain.UtxoState
-  ( UtxoState (..),
-    UtxoPayloadSet (..),
-    UtxoPayload (..),
-    UtxoPayloadDatum (..),
-    holdsInState,
-  )
-where
-
-import Cooked.Skeleton.Datum
-import Data.Function (on)
-import Data.List qualified as List
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
-import Plutus.Script.Utils.Address qualified as Script
-import PlutusLedgerApi.V1.Value qualified as Api
-import PlutusLedgerApi.V3 qualified as Api
-
--- | A description of who owns what in a blockchain. Owners are addresses and
--- they each own a 'UtxoPayloadSet'.
-data UtxoState where
-  UtxoState ::
-    { -- | Utxos available to be consumed
-      availableUtxos :: Map Api.Address UtxoPayloadSet,
-      -- | Utxos already consumed
-      consumedUtxos :: Map Api.Address UtxoPayloadSet
-    } ->
-    UtxoState
-  deriving (Eq)
-
--- | Total value accessible to what's pointed by the address.
-holdsInState :: (Script.ToAddress a) => a -> UtxoState -> Api.Value
-holdsInState (Script.toAddress -> address) = maybe mempty utxoPayloadSetTotal . Map.lookup address . availableUtxos
-
-instance Semigroup UtxoState where
-  (UtxoState a c) <> (UtxoState a' c') = UtxoState (Map.unionWith (<>) a a') (Map.unionWith (<>) c c')
-
-instance Monoid UtxoState where
-  mempty = UtxoState Map.empty Map.empty
-
--- | Represents a /set/ of payloads.
-newtype UtxoPayloadSet = UtxoPayloadSet
-  { -- | List of UTxOs contained in this 'UtxoPayloadSet'
-    utxoPayloadSet :: [UtxoPayload]
-    -- We use a list instead of a set because 'Api.Value' doesn't implement 'Ord'
-    -- and because it is possible that we want to distinguish between utxo states
-    -- that have additional utxos, even if these could have been merged together.
-  }
-  deriving (Show)
-
--- | A simplified version of a 'Cooked.Skeleton.Datum.TxSkelOutDatum' which only
--- stores the actual datum and whether it is hashed or inline.
-data UtxoPayloadDatum where
-  NoUtxoPayloadDatum :: UtxoPayloadDatum
-  SomeUtxoPayloadDatum :: (DatumConstrs dat) => dat -> Bool -> UtxoPayloadDatum
-
-deriving instance Show UtxoPayloadDatum
-
-instance Ord UtxoPayloadDatum where
-  compare NoUtxoPayloadDatum NoUtxoPayloadDatum = EQ
-  compare NoUtxoPayloadDatum _ = LT
-  compare _ NoUtxoPayloadDatum = GT
-  compare
-    (SomeUtxoPayloadDatum (Api.toBuiltinData -> dat) b)
-    (SomeUtxoPayloadDatum (Api.toBuiltinData -> dat') b') =
-      compare (dat, b) (dat', b')
-
-instance Eq UtxoPayloadDatum where
-  dat == dat' = compare dat dat' == EQ
-
--- | A convenient wrapping of the interesting information of a UTxO.
-data UtxoPayload where
-  UtxoPayload ::
-    { -- | The reference of this UTxO
-      utxoPayloadTxOutRef :: Api.TxOutRef,
-      -- | The value stored in this UTxO
-      utxoPayloadValue :: Api.Value,
-      -- | The optional datum stored in this UTxO
-      utxoPayloadDatum :: UtxoPayloadDatum,
-      -- | The optional reference script stored in this UTxO
-      utxoPayloadReferenceScript :: Maybe Api.ScriptHash
-    } ->
-    UtxoPayload
-  deriving (Eq, Show)
-
-instance Eq UtxoPayloadSet where
-  (UtxoPayloadSet xs) == (UtxoPayloadSet ys) = xs' == ys'
-    where
-      k (UtxoPayload ref val dat rs) = (ref, Api.flattenValue val, dat, rs)
-      xs' = List.sortBy (compare `on` k) xs
-      ys' = List.sortBy (compare `on` k) ys
-
-instance Semigroup UtxoPayloadSet where
-  UtxoPayloadSet a <> UtxoPayloadSet b = UtxoPayloadSet $ a ++ b
-
-instance Monoid UtxoPayloadSet where
-  mempty = UtxoPayloadSet []
-
--- | Computes the total value in a set
-utxoPayloadSetTotal :: UtxoPayloadSet -> Api.Value
-utxoPayloadSetTotal = mconcat . fmap utxoPayloadValue . utxoPayloadSet
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index ca9c889b1..421e87a57 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -7,7 +7,7 @@ module Cooked.Pretty.MockChain () where
 import Cooked.MockChain.Error
 import Cooked.MockChain.Instances
 import Cooked.MockChain.Log
-import Cooked.MockChain.UtxoState
+import Cooked.MockChain.State
 import Cooked.Pretty.Class
 import Cooked.Pretty.Options
 import Cooked.Pretty.Skeleton

From 231bc3435e036a534ae5178e3a48217fb149657c Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 26 Jan 2026 02:23:44 +0100
Subject: [PATCH 54/96] optics utxoState

---
 src/Cooked/MockChain/State.hs  | 116 ++++++++++++++++++++++++++++-----
 src/Cooked/Pretty/MockChain.hs |   2 +-
 2 files changed, 99 insertions(+), 19 deletions(-)

diff --git a/src/Cooked/MockChain/State.hs b/src/Cooked/MockChain/State.hs
index 8dc6ee2a9..d8c0ea1c3 100644
--- a/src/Cooked/MockChain/State.hs
+++ b/src/Cooked/MockChain/State.hs
@@ -1,5 +1,16 @@
 -- | This module exposes the internal state in which our direct simulation is
--- run, as well as a simplified version, more akin to testing and printing.
+-- run (`MockChainState`), as well as a restricted and simplified version
+-- (`UtxoState`). The latter only consists of Utxos with a focus on who owns
+-- those Utxos. You can see this as having some sort of an "account" view of the
+-- ledger state, which typically does not exist in Cardano. This is useful for
+-- two reasons:
+--
+-- - For printing purposes, where it is much more convient to see the available
+--   assets as "who owns what" rather than a set of mixed Utxos.
+--
+-- - For testings purposes, when querying the final state of a run is
+--   ineeded. For instance, properties such as "does Alice indeed owns 3 XXX
+--   tokens at the end of this run?" become much easier to express.
 module Cooked.MockChain.State
   ( -- * `MockChainState` and associated optics
     MockChainState (..),
@@ -7,16 +18,27 @@ module Cooked.MockChain.State
     mcstLedgerStateL,
     mcstOutputsL,
     mcstConstitutionL,
+    mcstMOutputL,
 
-    -- * Adding and removing outputs from a `MockChainState`
+    -- * Helpers to add or remove outputs from a `MockChainState`
     addOutput,
     removeOutput,
 
     -- * `UtxoState`: A simplified, address-focused view on a `MockChainState`
     UtxoPayloadDatum (..),
+    utxoPayloadDatumKindAT,
+    utxoPayloadDatumTypedAT,
     UtxoPayload (..),
+    utxoPayloadTxOutRefL,
+    utxoPayloadValueL,
+    utxoPayloadDatumL,
+    utxoPayloadMReferenceScriptHashL,
+    utxoPayloadReferenceScriptHashAT,
     UtxoPayloadSet (..),
+    utxoPayloadSetListI,
     UtxoState (..),
+    availableUtxosL,
+    consumedUtxosL,
 
     -- * Querying the assets owned by a given address
     holdsInState,
@@ -33,6 +55,7 @@ import Data.Function (on)
 import Data.List qualified as List
 import Data.Map (Map)
 import Data.Map qualified as Map
+import Data.Typeable
 import Ledger.Orphans ()
 import Optics.Core
 import Optics.TH
@@ -72,20 +95,59 @@ makeLensesFor [("mcstConstitution", "mcstConstitutionL")] ''MockChainState
 instance Default MockChainState where
   def = MockChainState def (Emulator.initialState def) Map.empty Nothing
 
+-- | Accesses a given available Utxo from a `MockChainState`
+mcstMOutputL :: Api.TxOutRef -> Lens' MockChainState (Maybe TxSkelOut)
+mcstMOutputL oRef = mcstOutputsL % at oRef % iso (fmap fst) (fmap (,True))
+
 -- | Stores an output in a 'MockChainState'
 addOutput :: Api.TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
-addOutput oRef = set (mcstOutputsL % at oRef) . Just . (,True)
+addOutput oRef = set (mcstMOutputL oRef) . Just
 
 -- | Removes an output from the 'MockChainState'
 removeOutput :: Api.TxOutRef -> MockChainState -> MockChainState
 removeOutput oRef = set (mcstOutputsL % at oRef) Nothing
 
 -- | A simplified version of a 'Cooked.Skeleton.Datum.TxSkelOutDatum' which only
--- stores the actual datum and whether it is hashed or inline.
+-- stores the actual datum and whether it is hashed (@True@) or inline
+-- (@False@). The only difference is that whether the datum was resolved in the
+-- transaction creating it on the ledger is absent, which makes sense after the
+-- fact.
 data UtxoPayloadDatum where
   NoUtxoPayloadDatum :: UtxoPayloadDatum
   SomeUtxoPayloadDatum :: (DatumConstrs dat) => dat -> Bool -> UtxoPayloadDatum
 
+-- | Focuses on whether on not this `UtxoPayloadDatum` isHashed
+utxoPayloadDatumKindAT :: AffineTraversal' UtxoPayloadDatum Bool
+utxoPayloadDatumKindAT =
+  atraversal
+    ( \case
+        NoUtxoPayloadDatum -> Left NoUtxoPayloadDatum
+        SomeUtxoPayloadDatum _ b -> Right b
+    )
+    ( flip
+        ( \kind -> \case
+            NoUtxoPayloadDatum -> NoUtxoPayloadDatum
+            SomeUtxoPayloadDatum content _ -> SomeUtxoPayloadDatum content kind
+        )
+    )
+
+-- | Extracts, or sets, the typed datum of a 'UtxoPayloadDatum' following the
+-- same rules as `txSkelOutDatumTypedAT`
+utxoPayloadDatumTypedAT :: (DatumConstrs a, DatumConstrs b) => AffineTraversal UtxoPayloadDatum UtxoPayloadDatum a b
+utxoPayloadDatumTypedAT =
+  atraversal
+    ( \case
+        (SomeUtxoPayloadDatum content _) | Just content' <- cast content -> Right content'
+        (SomeUtxoPayloadDatum content _) | Just content' <- Api.fromBuiltinData $ Api.toBuiltinData content -> Right content'
+        dc -> Left dc
+    )
+    ( flip
+        ( \content -> \case
+            NoUtxoPayloadDatum -> NoUtxoPayloadDatum
+            SomeUtxoPayloadDatum _ kind -> SomeUtxoPayloadDatum content kind
+        )
+    )
+
 deriving instance Show UtxoPayloadDatum
 
 instance Ord UtxoPayloadDatum where
@@ -109,24 +171,22 @@ data UtxoPayload where
       utxoPayloadValue :: Api.Value,
       -- | The optional datum stored in this UTxO
       utxoPayloadDatum :: UtxoPayloadDatum,
-      -- | The optional reference script stored in this UTxO
-      utxoPayloadReferenceScript :: Maybe Api.ScriptHash
+      -- | The hash of the optional reference script stored in this UTxO
+      utxoPayloadReferenceScriptHash :: Maybe Api.ScriptHash
     } ->
     UtxoPayload
   deriving (Eq, Show)
 
-instance Eq UtxoPayloadSet where
-  (UtxoPayloadSet xs) == (UtxoPayloadSet ys) = xs' == ys'
-    where
-      k (UtxoPayload ref val dat rs) = (ref, Api.flattenValue val, dat, rs)
-      xs' = List.sortBy (compare `on` k) xs
-      ys' = List.sortBy (compare `on` k) ys
+makeLensesFor [("utxoPayloadTxOutRef", "utxoPayloadTxOutRefL")] ''UtxoPayload
 
-instance Semigroup UtxoPayloadSet where
-  UtxoPayloadSet a <> UtxoPayloadSet b = UtxoPayloadSet $ a ++ b
+makeLensesFor [("utxoPayloadValue", "utxoPayloadValueL")] ''UtxoPayload
 
-instance Monoid UtxoPayloadSet where
-  mempty = UtxoPayloadSet []
+makeLensesFor [("utxoPayloadDatum", "utxoPayloadDatumL")] ''UtxoPayload
+
+makeLensesFor [("utxoPayloadReferenceScriptHash", "utxoPayloadMReferenceScriptHashL")] ''UtxoPayload
+
+utxoPayloadReferenceScriptHashAT :: AffineTraversal' UtxoPayload Api.ScriptHash
+utxoPayloadReferenceScriptHashAT = utxoPayloadMReferenceScriptHashL % _Just
 
 -- | Represents a /set/ of payloads.
 newtype UtxoPayloadSet = UtxoPayloadSet
@@ -138,6 +198,22 @@ newtype UtxoPayloadSet = UtxoPayloadSet
   }
   deriving (Show)
 
+utxoPayloadSetListI :: Iso' UtxoPayloadSet [UtxoPayload]
+utxoPayloadSetListI = iso utxoPayloadSet UtxoPayloadSet
+
+instance Eq UtxoPayloadSet where
+  (UtxoPayloadSet xs) == (UtxoPayloadSet ys) = xs' == ys'
+    where
+      k (UtxoPayload ref val dat rs) = (ref, Api.flattenValue val, dat, rs)
+      xs' = List.sortBy (compare `on` k) xs
+      ys' = List.sortBy (compare `on` k) ys
+
+instance Semigroup UtxoPayloadSet where
+  UtxoPayloadSet a <> UtxoPayloadSet b = UtxoPayloadSet $ a ++ b
+
+instance Monoid UtxoPayloadSet where
+  mempty = UtxoPayloadSet []
+
 -- | A description of who owns what in a blockchain. Owners are addresses and
 -- they each own a 'UtxoPayloadSet'.
 data UtxoState where
@@ -150,6 +226,10 @@ data UtxoState where
     UtxoState
   deriving (Eq)
 
+makeLensesFor [("availableUtxos", "availableUtxosL")] ''UtxoState
+
+makeLensesFor [("consumedUtxos", "consumedUtxosL")] ''UtxoState
+
 instance Semigroup UtxoState where
   (UtxoState a c) <> (UtxoState a' c') = UtxoState (Map.unionWith (<>) a a') (Map.unionWith (<>) c c')
 
@@ -158,11 +238,11 @@ instance Monoid UtxoState where
 
 -- | Total value accessible to what's pointed by the address.
 holdsInState :: (Script.ToAddress a) => a -> UtxoState -> Api.Value
-holdsInState (Script.toAddress -> address) = maybe mempty utxoPayloadSetTotal . Map.lookup address . availableUtxos
+holdsInState (Script.toAddress -> address) = maybe mempty utxoPayloadSetTotal . view (availableUtxosL % at address)
 
 -- | Computes the total value in a set
 utxoPayloadSetTotal :: UtxoPayloadSet -> Api.Value
-utxoPayloadSetTotal = mconcat . fmap utxoPayloadValue . utxoPayloadSet
+utxoPayloadSetTotal = foldOf (utxoPayloadSetListI % folded % utxoPayloadValueL)
 
 -- | Builds a 'UtxoState' from a 'MockChainState'
 mcstToUtxoState :: MockChainState -> UtxoState
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 421e87a57..4bd721d4f 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -240,7 +240,7 @@ instance PrettyCookedList UtxoPayloadSet where
               else Nothing,
             Just (prettyCookedOpt opts utxoPayloadValue),
             (\(dat, hashed) -> "Datum (" <> (if hashed then "hashed" else "inline") <> "):" <+> dat) <$> splitDatum utxoPayloadDatum,
-            ("Reference script hash:" <+>) . prettyHash opts <$> utxoPayloadReferenceScript
+            ("Reference script hash:" <+>) . prettyHash opts <$> utxoPayloadReferenceScriptHash
           ] of
           [] -> Nothing
           [doc] -> Just $ PP.align doc

From d397a787f18818c0e1fb0a21262e8327476f93ca Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Mon, 26 Jan 2026 17:48:04 +0100
Subject: [PATCH 55/96] Runnable + docs

---
 cooked-validators.cabal                     |  1 +
 src/Cooked/Ltl.hs                           | 37 +++++---
 src/Cooked/MockChain.hs                     |  1 +
 src/Cooked/MockChain/GenerateTx/Proposal.hs |  6 +-
 src/Cooked/MockChain/Instances.hs           | 95 ++-------------------
 src/Cooked/MockChain/Journal.hs             |  2 +-
 src/Cooked/MockChain/Log.hs                 |  6 ++
 src/Cooked/MockChain/Misc.hs                |  2 +-
 src/Cooked/MockChain/Runnable.hs            | 91 ++++++++++++++++++++
 src/Cooked/MockChain/State.hs               | 13 ++-
 src/Cooked/MockChain/Testing.hs             |  8 +-
 src/Cooked/MockChain/Tweak.hs               |  8 +-
 src/Cooked/MockChain/UtxoSearch.hs          |  7 +-
 src/Cooked/Pretty/MockChain.hs              |  2 +-
 src/Cooked/Pretty/Skeleton.hs               |  2 +-
 src/Cooked/Skeleton/Proposal.hs             | 66 +++++++-------
 16 files changed, 194 insertions(+), 153 deletions(-)
 create mode 100644 src/Cooked/MockChain/Runnable.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 73fa58f65..e1e2ba790 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -42,6 +42,7 @@ library
       Cooked.MockChain.Log
       Cooked.MockChain.Misc
       Cooked.MockChain.Read
+      Cooked.MockChain.Runnable
       Cooked.MockChain.State
       Cooked.MockChain.Testing
       Cooked.MockChain.Tweak
diff --git a/src/Cooked/Ltl.hs b/src/Cooked/Ltl.hs
index 264bcf837..61637fa13 100644
--- a/src/Cooked/Ltl.hs
+++ b/src/Cooked/Ltl.hs
@@ -4,10 +4,10 @@
 -- transactions using LTL formulaes with atomic modifications. This idea is to
 -- describe when to apply certain modifications within a trace.
 module Cooked.Ltl
-  ( -- * LTL formulas
+  ( -- * `Ltl` formulas
     Ltl (..),
 
-    -- * LTL combinators
+    -- * `Ltl` combinators
     ltlNot',
     ltlOr',
     ltlAnd',
@@ -31,15 +31,17 @@ module Cooked.Ltl
     ltlNever,
     ltlNever',
 
-    -- * Requirements from a formula
-    Requirement (..),
+    -- * `Ltl` helpers,
+    nowLaterList,
+    finished,
 
-    -- * Modifying a computation on time
+    -- * Laying out modifications on time using `Ltl`
     ModifyGlobally,
     modifyLtl,
     runModifyGlobally,
 
-    -- * Fetching the current requirements
+    -- * Locally applying laid out modifications
+    Requirement (..),
     ModifyLocally,
     getRequirements,
     runModifyLocally,
@@ -52,7 +54,7 @@ import Polysemy
 import Polysemy.NonDet
 import Polysemy.State
 
--- | Type of LTL formulas with atomic formulas of type @a@. Think of @a@ as a
+-- | Type of `Ltl` formulas with atomic formulas of type @a@. Think of @a@ as a
 -- type of "modifications", then a value of type @Ltl a@ describes where to
 -- apply `Requirement`s in a trace.
 data Ltl a
@@ -197,7 +199,7 @@ ltlImplies f1 f2 = (f2 `LtlAnd` f1) `LtlOr` LtlNot f1
 ltlImplies' :: a -> a -> Ltl a
 ltlImplies' a1 a2 = LtlAtom a1 `ltlImplies` LtlAtom a2
 
--- | Simplification procedure for LTL formulas. This function knows how
+-- | Simplification procedure for `Ltl` formulas. This function knows how
 -- `LtlTruth` and `LtlFalsity` play with negation, conjunction and disjunction
 -- and recursively applies this knowledge; it is used to keep the formulas
 -- `nowLaterList` generates from growing too wildly. While this function does
@@ -252,7 +254,7 @@ data Requirement a
     EnsureFailure a
   deriving (Show, Eq)
 
--- | For each LTL formula that describes a modification of a computation in a
+-- | For each `Ltl` formula that describes a modification of a computation in a
 -- list, split it into a list of @(doNow, doLater)@ pairs, and then
 -- appropriately combine the results. The result of the splitting is bound to
 -- the following semantics:
@@ -261,7 +263,7 @@ data Requirement a
 -- the current time step (`Apply`), or that should fail at the current time step
 -- (`EnsureFailure`)
 --
--- * @doLater@ is an LTL formula describing the modification that should be
+-- * @doLater@ is an `Ltl` formula describing the modification that should be
 -- applied from the next time step onwards.
 --
 -- The return value is a list because a formula might be satisfied in different
@@ -308,12 +310,17 @@ finished (LtlUntil _ _) = False
 finished (LtlRelease _ _) = True
 finished (LtlNot f) = not $ finished f
 
--- | An effect to modify a computation with an `Ltl` Formula. The idea is that
+-- | An effect to modify a computation with an `Ltl` formula. The idea is that
 -- the formula pinpoints locations where `Requirement`s should be enforced.
 data ModifyGlobally a :: Effect where
   ModifyLtl :: Ltl a -> m b -> ModifyGlobally a m b
 
-makeSem ''ModifyGlobally
+makeSem_ ''ModifyGlobally
+
+-- | Lays out an `Ltl` formula to be used for modification within the execution
+-- of the wrapped computation. See `ModifyLocally` for how to consume and use
+-- the laid out modifications.
+modifyLtl :: forall a r b. (Member (ModifyGlobally a) r) => Ltl a -> Sem r b -> Sem r b
 
 -- | Running the `ModifyGlobally` effect requires to have access of the current
 -- list of `Ltl` formulas, and to have access to an empty computation.
@@ -348,7 +355,11 @@ runModifyGlobally =
 data ModifyLocally a :: Effect where
   GetRequirements :: ModifyLocally a m [Requirement a]
 
-makeSem ''ModifyLocally
+makeSem_ ''ModifyLocally
+
+-- | Reads and consumes a modification from the context, typically laid out by
+-- `ModifyGlobally` further up the stack of effects.
+getRequirements :: (Member (ModifyLocally a) effs) => Sem effs [Requirement a]
 
 -- | Running the `ModifyLocally` effect requires to have access to the current
 -- list of `Ltl` formulas, and to be able to branch.
diff --git a/src/Cooked/MockChain.hs b/src/Cooked/MockChain.hs
index ad87ea2a5..5006c238e 100644
--- a/src/Cooked/MockChain.hs
+++ b/src/Cooked/MockChain.hs
@@ -10,6 +10,7 @@ import Cooked.MockChain.Instances as X
 import Cooked.MockChain.Journal as X
 import Cooked.MockChain.Misc as X
 import Cooked.MockChain.Read as X
+import Cooked.MockChain.Runnable as X
 import Cooked.MockChain.State as X
 import Cooked.MockChain.Testing as X
 import Cooked.MockChain.Tweak as X
diff --git a/src/Cooked/MockChain/GenerateTx/Proposal.hs b/src/Cooked/MockChain/GenerateTx/Proposal.hs
index 91046dd26..06a8167b7 100644
--- a/src/Cooked/MockChain/GenerateTx/Proposal.hs
+++ b/src/Cooked/MockChain/GenerateTx/Proposal.hs
@@ -29,10 +29,10 @@ import PlutusLedgerApi.V1.Value qualified as Api
 import Polysemy
 import Polysemy.Error
 
--- | Transorms a `Cooked.Skeleton.Proposal.ParameterChange` into an actual
--- change over a Cardano parameter update
+-- | Transorms a `Cooked.Skeleton.Proposal.ParamChange` into an actual change
+-- over a Cardano parameter update
 toPParamsUpdate ::
-  ParameterChange ->
+  ParamChange ->
   Conway.PParamsUpdate Emulator.EmulatorEra ->
   Conway.PParamsUpdate Emulator.EmulatorEra
 toPParamsUpdate pChange =
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 89abe4a6a..1a4cd6cb4 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 -- | This module exposes concrete instances to run a mockchain. There are 3 of
 -- them :
 --
@@ -17,21 +19,17 @@
 --   such as balancing.
 module Cooked.MockChain.Instances where
 
-import Cooked.InitialDistribution
 import Cooked.Ltl
 import Cooked.MockChain.Error
 import Cooked.MockChain.Journal
 import Cooked.MockChain.Log
 import Cooked.MockChain.Misc
 import Cooked.MockChain.Read
+import Cooked.MockChain.Runnable
 import Cooked.MockChain.State
 import Cooked.MockChain.Tweak
 import Cooked.MockChain.Write
-import Cooked.Skeleton.Output
-import Data.Default
-import Data.Map (Map)
 import Ledger.Tx qualified as Ledger
-import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Error
 import Polysemy.Fail
@@ -39,87 +37,6 @@ import Polysemy.NonDet
 import Polysemy.State
 import Polysemy.Writer
 
--- * 'MockChain' return types
-
--- | The returned type when running a 'MockChainT'. This is both a reorganizing
--- and filtering of the natural returned type @((Either MockChainError a,
--- MockChainState), MockChainBook)@, which is much easier to query.
-data MockChainReturn a where
-  MockChainReturn ::
-    { -- | The value returned by the computation, or an error
-      mcrValue :: Either MockChainError a,
-      -- | The outputs at the end of the run
-      mcrOutputs :: Map Api.TxOutRef (TxSkelOut, Bool),
-      -- | The 'UtxoState' at the end of the run
-      mcrUtxoState :: UtxoState,
-      -- | The final journal emitted during the run
-      mcrLog :: [MockChainLogEntry],
-      -- | The map of aliases defined during the run
-      mcrAliases :: Map Api.BuiltinByteString String,
-      -- | The notes taken by the user during the run
-      mcrNoteBook :: [String]
-    } ->
-    MockChainReturn a
-  deriving (Functor)
-
--- | Raw return type of running a 'MockChainT'
-type RawMockChainReturn a = (MockChainJournal, (MockChainState, Either MockChainError a))
-
--- | The type of functions transforming an element of type @RawMockChainReturn a@
--- into an element of type @b@
-type FunOnMockChainResult a b = RawMockChainReturn a -> b
-
--- | Building a `MockChainReturn` from a `RawMockChainReturn`
-unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
-unRawMockChainReturn (MockChainJournal journal aliases notes, (st, val)) =
-  MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases notes
-
--- | Configuration to run a mockchain
-data MockChainConf a b where
-  MockChainConf ::
-    { -- | The initial state from which to run the 'MockChainT'
-      mccInitialState :: MockChainState,
-      -- | The initial payments to issue in the run
-      mccInitialDistribution :: InitialDistribution,
-      -- | The function to apply on the results of the run
-      mccFunOnResult :: FunOnMockChainResult a b
-    } ->
-    MockChainConf a b
-
-mockChainConfTemplate :: MockChainConf a (MockChainReturn a)
-mockChainConfTemplate = MockChainConf def def unRawMockChainReturn
-
-class IsMockChain effs where
-  runMockChain :: MockChainState -> Sem effs a -> [RawMockChainReturn a]
-
-runMockChainFromConf ::
-  ( IsMockChain effs,
-    Member MockChainWrite effs
-  ) =>
-  MockChainConf a b ->
-  Sem effs a ->
-  [b]
-runMockChainFromConf (MockChainConf initState initDist funOnResult) currentRun =
-  funOnResult <$> runMockChain initState (forceOutputs (unInitialDistribution initDist) >> currentRun)
-
-runMockChainFromInitDist ::
-  ( IsMockChain effs,
-    Member MockChainWrite effs
-  ) =>
-  InitialDistribution ->
-  Sem effs a ->
-  [MockChainReturn a]
-runMockChainFromInitDist initDist =
-  runMockChainFromConf $ mockChainConfTemplate {mccInitialDistribution = initDist}
-
-runMockChainDef ::
-  ( IsMockChain effs,
-    Member MockChainWrite effs
-  ) =>
-  Sem effs a ->
-  [MockChainReturn a]
-runMockChainDef = runMockChainFromConf mockChainConfTemplate
-
 type DirectEffs =
   '[ MockChainWrite,
      MockChainRead,
@@ -131,7 +48,7 @@ type DirectEffs =
 -- mockchain, that is without any tweaks nor branching.
 type DirectMockChain a = Sem DirectEffs a
 
-instance IsMockChain DirectEffs where
+instance RunnableMockChain DirectEffs where
   runMockChain mcst =
     (: [])
       . run
@@ -169,7 +86,7 @@ type StagedEffs =
 -- mockchain, that is with tweaks and branching.
 type StagedMockChain a = Sem StagedEffs a
 
-instance IsMockChain StagedEffs where
+instance RunnableMockChain StagedEffs where
   runMockChain mcst =
     run
       . runNonDet
@@ -229,7 +146,7 @@ type FullEffs =
 
 type FullMockChain a = Sem FullEffs a
 
-instance IsMockChain FullEffs where
+instance RunnableMockChain FullEffs where
   runMockChain mcst =
     run
       . runNonDet
diff --git a/src/Cooked/MockChain/Journal.hs b/src/Cooked/MockChain/Journal.hs
index 0a020e622..5a30145d9 100644
--- a/src/Cooked/MockChain/Journal.hs
+++ b/src/Cooked/MockChain/Journal.hs
@@ -7,7 +7,7 @@ import Data.Map qualified as Map
 import PlutusLedgerApi.V3 qualified as Api
 
 -- | This represents the writable elements that can be emitted throughout a
--- 'MockChain' run.
+-- mockchain run.
 data MockChainJournal where
   MockChainJournal ::
     { -- | Log entries generated by cooked-validators
diff --git a/src/Cooked/MockChain/Log.hs b/src/Cooked/MockChain/Log.hs
index 6a110b563..173eb1807 100644
--- a/src/Cooked/MockChain/Log.hs
+++ b/src/Cooked/MockChain/Log.hs
@@ -1,5 +1,11 @@
 {-# LANGUAGE TemplateHaskell #-}
 
+-- | This module exposes primitives required to log internal pieces of
+-- information during a mockchain run. This includes, in particular, all the
+-- adjustment automatically done by \cooked-validators\ during the transaction
+-- processing phase. This effect is typically not available to users, and should
+-- solely be used to track internal events. To trace additional elements from a
+-- user's perspective, use `Cooked.MockChain.Misc.note` instead.
 module Cooked.MockChain.Log
   ( -- * Logging events
     MockChainLogEntry (..),
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index 32ff13ef0..9f22aad95 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -4,7 +4,7 @@
 -- operating a mockchain without interacting with the mockchain state itself.
 module Cooked.MockChain.Misc
   ( -- * Misc effect
-    MockChainMisc,
+    MockChainMisc (..),
     runMockChainMisc,
 
     -- * Misc primitives
diff --git a/src/Cooked/MockChain/Runnable.hs b/src/Cooked/MockChain/Runnable.hs
new file mode 100644
index 000000000..cd19fa6c4
--- /dev/null
+++ b/src/Cooked/MockChain/Runnable.hs
@@ -0,0 +1,91 @@
+module Cooked.MockChain.Runnable where
+
+import Cooked.InitialDistribution
+import Cooked.MockChain.Error
+import Cooked.MockChain.Journal
+import Cooked.MockChain.Log
+import Cooked.MockChain.State
+import Cooked.MockChain.Write
+import Cooked.Skeleton.Output
+import Data.Default
+import Data.Map (Map)
+import PlutusLedgerApi.V3 qualified as Api
+import Polysemy
+
+-- | Raw return type of running a mockchain
+type RawMockChainReturn a = (MockChainJournal, (MockChainState, Either MockChainError a))
+
+-- | The returned type when running a mockchain. This is both a reorganizing and
+-- filtering of the natural returned type `RawMockChainReturn`.
+data MockChainReturn a where
+  MockChainReturn ::
+    { -- | The value returned by the computation, or an error
+      mcrValue :: Either MockChainError a,
+      -- | The outputs at the end of the run
+      mcrOutputs :: Map Api.TxOutRef (TxSkelOut, Bool),
+      -- | The 'UtxoState' at the end of the run
+      mcrUtxoState :: UtxoState,
+      -- | The final journal emitted during the run
+      mcrLog :: [MockChainLogEntry],
+      -- | The map of aliases defined during the run
+      mcrAliases :: Map Api.BuiltinByteString String,
+      -- | The notes taken by the user during the run
+      mcrNoteBook :: [String]
+    } ->
+    MockChainReturn a
+  deriving (Functor)
+
+-- | The type of functions transforming an element of type @RawMockChainReturn a@
+-- into an element of type @b@
+type FunOnMockChainResult a b = RawMockChainReturn a -> b
+
+-- | Building a `MockChainReturn` from a `RawMockChainReturn`
+unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
+unRawMockChainReturn (MockChainJournal journal aliases notes, (st, val)) =
+  MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases notes
+
+-- | Configuration to run a mockchain
+data MockChainConf a b where
+  MockChainConf ::
+    { -- | The initial state from which to run the 'MockChainT'
+      mccInitialState :: MockChainState,
+      -- | The initial payments to issue in the run
+      mccInitialDistribution :: InitialDistribution,
+      -- | The function to apply on the results of the run
+      mccFunOnResult :: FunOnMockChainResult a b
+    } ->
+    MockChainConf a b
+
+mockChainConfTemplate :: MockChainConf a (MockChainReturn a)
+mockChainConfTemplate = MockChainConf def def unRawMockChainReturn
+
+class RunnableMockChain effs where
+  runMockChain :: MockChainState -> Sem effs a -> [RawMockChainReturn a]
+
+runMockChainFromConf ::
+  ( RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  MockChainConf a b ->
+  Sem effs a ->
+  [b]
+runMockChainFromConf (MockChainConf initState initDist funOnResult) currentRun =
+  funOnResult <$> runMockChain initState (forceOutputs (unInitialDistribution initDist) >> currentRun)
+
+runMockChainFromInitDist ::
+  ( RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  InitialDistribution ->
+  Sem effs a ->
+  [MockChainReturn a]
+runMockChainFromInitDist initDist =
+  runMockChainFromConf $ mockChainConfTemplate {mccInitialDistribution = initDist}
+
+runMockChainDef ::
+  ( RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  [MockChainReturn a]
+runMockChainDef = runMockChainFromConf mockChainConfTemplate
diff --git a/src/Cooked/MockChain/State.hs b/src/Cooked/MockChain/State.hs
index d8c0ea1c3..978bb0c0a 100644
--- a/src/Cooked/MockChain/State.hs
+++ b/src/Cooked/MockChain/State.hs
@@ -6,10 +6,10 @@
 -- two reasons:
 --
 -- - For printing purposes, where it is much more convient to see the available
---   assets as "who owns what" rather than a set of mixed Utxos.
+--   assets as "who owns what" rather than as a set of mixed Utxos.
 --
 -- - For testings purposes, when querying the final state of a run is
---   ineeded. For instance, properties such as "does Alice indeed owns 3 XXX
+--   needed. For instance, properties such as "does Alice indeed owns 3 XXX
 --   tokens at the end of this run?" become much easier to express.
 module Cooked.MockChain.State
   ( -- * `MockChainState` and associated optics
@@ -177,14 +177,20 @@ data UtxoPayload where
     UtxoPayload
   deriving (Eq, Show)
 
+-- | A lens to set or get the UTxO reference from this `UtxoPayload`
 makeLensesFor [("utxoPayloadTxOutRef", "utxoPayloadTxOutRefL")] ''UtxoPayload
 
+-- | A lens to set or get the value from this `UtxoPayload`
 makeLensesFor [("utxoPayloadValue", "utxoPayloadValueL")] ''UtxoPayload
 
+-- | A lens to set or get the datum from this `UtxoPayload`
 makeLensesFor [("utxoPayloadDatum", "utxoPayloadDatumL")] ''UtxoPayload
 
+-- | A lens to set or get the optional reference script hash from this
+-- `UtxoPayload`
 makeLensesFor [("utxoPayloadReferenceScriptHash", "utxoPayloadMReferenceScriptHashL")] ''UtxoPayload
 
+-- | Focusing on the optional reference script hash of a `UtxoPayload`
 utxoPayloadReferenceScriptHashAT :: AffineTraversal' UtxoPayload Api.ScriptHash
 utxoPayloadReferenceScriptHashAT = utxoPayloadMReferenceScriptHashL % _Just
 
@@ -198,6 +204,7 @@ newtype UtxoPayloadSet = UtxoPayloadSet
   }
   deriving (Show)
 
+-- | Going back and forth between a list of `UtxoPayload` and a `UtxoPayloadSet`
 utxoPayloadSetListI :: Iso' UtxoPayloadSet [UtxoPayload]
 utxoPayloadSetListI = iso utxoPayloadSet UtxoPayloadSet
 
@@ -226,8 +233,10 @@ data UtxoState where
     UtxoState
   deriving (Eq)
 
+-- | A lens to set or get the available UTxOs from a `UtxoState`
 makeLensesFor [("availableUtxos", "availableUtxosL")] ''UtxoState
 
+-- | A lens to set or get the consumed UTxOs from a `UtxoState`
 makeLensesFor [("consumedUtxos", "consumedUtxosL")] ''UtxoState
 
 instance Semigroup UtxoState where
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 33baea50c..d70227a23 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -8,8 +8,8 @@ import Control.Exception qualified as E
 import Control.Monad
 import Cooked.InitialDistribution
 import Cooked.MockChain.Error
-import Cooked.MockChain.Instances
 import Cooked.MockChain.Log
+import Cooked.MockChain.Runnable
 import Cooked.MockChain.State
 import Cooked.MockChain.Write
 import Cooked.Pretty
@@ -221,7 +221,7 @@ testToProp ::
   ( IsProp prop,
     Show a,
     Member MockChainWrite effs,
-    IsMockChain effs
+    RunnableMockChain effs
   ) =>
   Test effs a prop ->
   prop
@@ -247,7 +247,7 @@ testCooked ::
   forall effs a.
   ( Show a,
     Member MockChainWrite effs,
-    IsMockChain effs
+    RunnableMockChain effs
   ) =>
   String ->
   Test effs a HU.Assertion ->
@@ -259,7 +259,7 @@ testCookedQC ::
   forall effs a.
   ( Show a,
     Member MockChainWrite effs,
-    IsMockChain effs
+    RunnableMockChain effs
   ) =>
   String ->
   Test effs a QC.Property ->
diff --git a/src/Cooked/MockChain/Tweak.hs b/src/Cooked/MockChain/Tweak.hs
index 24b105e8d..d97f4e57f 100644
--- a/src/Cooked/MockChain/Tweak.hs
+++ b/src/Cooked/MockChain/Tweak.hs
@@ -4,7 +4,9 @@ module Cooked.MockChain.Tweak
   ( -- * Modifying mockchain runs using tweaks
     reinterpretMockChainWriteWithTweak,
 
-    -- * Typed and Untyped tweaks geared for `TxSkel` modifications
+    -- * Typed and Untyped tweaks geared for `Cooked.Skeleton.TxSkel`
+
+    --   modifications
     TypedTweak,
     UntypedTweak (..),
 
@@ -27,10 +29,10 @@ import Polysemy
 import Polysemy.Internal
 import Polysemy.NonDet
 
+-- | A stack of effects starting with `Tweak` and `NonDet`
 type TypedTweak tweakEffs a = Sem (Tweak : NonDet : tweakEffs) a
 
--- | Wrapping up tweaks while hiding their return type and unsuring their stack
--- of effects begins with `Tweak` and `NonDet`.
+-- | Wrapping up typed tweaks to existentially quantify on their return type
 data UntypedTweak tweakEffs where
   UntypedTweak :: TypedTweak tweakEffs a -> UntypedTweak tweakEffs
 
diff --git a/src/Cooked/MockChain/UtxoSearch.hs b/src/Cooked/MockChain/UtxoSearch.hs
index 763609e95..1e8841973 100644
--- a/src/Cooked/MockChain/UtxoSearch.hs
+++ b/src/Cooked/MockChain/UtxoSearch.hs
@@ -57,6 +57,9 @@ import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 
+-- | Raw result of a `UtxoSearch`. We store the `Api.TxOutRef` of the output,
+-- alongside an heterogeneous list starting with the output in question,
+-- followed by any element that was extracted during the search.
 type UtxoSearchResult elems = [(Api.TxOutRef, HList (TxSkelOut ': elems))]
 
 -- | A `UtxoSearch` is a computation that returns a list of UTxOs alongside
@@ -228,8 +231,8 @@ ensureOnlyValueOutputs =
     . ensureAFoldIsn't txSkelOutStakingCredentialAT
     . ensureAFoldIsn't (txSkelOutDatumL % txSkelOutDatumKindAT)
 
--- | Same as 'onlyValueOutputsAtSearch', but also ensures the searched outputs
--- do not contain non-ADA assets.
+-- | Same as 'ensureOnlyValueOutputs', but also ensures the searched outputs do not
+-- contain non-ADA assets.
 ensureVanillaOutputs ::
   UtxoSearch effs els ->
   UtxoSearch effs els
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 4bd721d4f..02f7ba913 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -5,8 +5,8 @@
 module Cooked.Pretty.MockChain () where
 
 import Cooked.MockChain.Error
-import Cooked.MockChain.Instances
 import Cooked.MockChain.Log
+import Cooked.MockChain.Runnable
 import Cooked.MockChain.State
 import Cooked.Pretty.Class
 import Cooked.Pretty.Options
diff --git a/src/Cooked/Pretty/Skeleton.hs b/src/Cooked/Pretty/Skeleton.hs
index 2dc203205..c5af6b71b 100644
--- a/src/Cooked/Pretty/Skeleton.hs
+++ b/src/Cooked/Pretty/Skeleton.hs
@@ -95,7 +95,7 @@ instance PrettyCooked Withdrawal where
       prettyCookedOptList opts user
         ++ [maybe "Amount to be autofilled" (("Amount: " <>) . PP.pretty . Api.getLovelace) mAmount]
 
-instance PrettyCooked ParameterChange where
+instance PrettyCooked ParamChange where
   prettyCookedOpt opts (FeePerByte n) = "Fee per byte:" <+> prettyCookedOpt opts n
   prettyCookedOpt opts (FeeFixed n) = "Fee fixed:" <+> prettyCookedOpt opts n
   prettyCookedOpt opts (MaxBlockBodySize n) = "Max block body size:" <+> prettyCookedOpt opts n
diff --git a/src/Cooked/Skeleton/Proposal.hs b/src/Cooked/Skeleton/Proposal.hs
index 090eb29ce..2c673e5a0 100644
--- a/src/Cooked/Skeleton/Proposal.hs
+++ b/src/Cooked/Skeleton/Proposal.hs
@@ -4,7 +4,7 @@
 -- script govAction1, simpleProposal pk govAction2, ... ]@
 module Cooked.Skeleton.Proposal
   ( -- * Data types
-    ParameterChange (..),
+    ParamChange (..),
     GovernanceAction (..),
     TxSkelProposal (..),
 
@@ -40,68 +40,68 @@ import PlutusTx.Prelude qualified as PlutusTx
 -- | These are all the protocol parameters. They are taken from
 -- https://github.com/IntersectMBO/cardano-ledger/blob/c4fbc05999866fea7c0cb1b211fd5288f286b95d/eras/conway/impl/cddl-files/conway.cddl#L381-L412
 -- and will most likely change in future eras.
-data ParameterChange where
+data ParamChange where
   -- | The linear factor for the minimum fee calculation
-  FeePerByte :: Integer -> ParameterChange
+  FeePerByte :: Integer -> ParamChange
   -- | The constant factor for the minimum fee calculation
-  FeeFixed :: Integer -> ParameterChange
+  FeeFixed :: Integer -> ParamChange
   -- | Maximal block body size
-  MaxBlockBodySize :: Integer -> ParameterChange
+  MaxBlockBodySize :: Integer -> ParamChange
   -- | Maximal transaction size
-  MaxTxSize :: Integer -> ParameterChange
+  MaxTxSize :: Integer -> ParamChange
   -- | Maximal block header size
-  MaxBlockHeaderSize :: Integer -> ParameterChange
+  MaxBlockHeaderSize :: Integer -> ParamChange
   -- | The amount of a key registration deposit
-  KeyDeposit :: Integer -> ParameterChange
+  KeyDeposit :: Integer -> ParamChange
   -- | The amount of a pool registration deposit
-  PoolDeposit :: Integer -> ParameterChange
+  PoolDeposit :: Integer -> ParamChange
   -- | Maximum number of epochs in the future a pool retirement is allowed to
   -- be scheduled future for.
-  PoolRetirementMaxEpoch :: Integer -> ParameterChange
+  PoolRetirementMaxEpoch :: Integer -> ParamChange
   -- | Desired number of pools
-  PoolNumber :: Integer -> ParameterChange
+  PoolNumber :: Integer -> ParamChange
   -- | Pool influence
-  PoolInfluence :: Rational -> ParameterChange
+  PoolInfluence :: Rational -> ParamChange
   -- | Monetary expansion
-  MonetaryExpansion :: Rational -> ParameterChange
+  MonetaryExpansion :: Rational -> ParamChange
   -- | Treasury expansion
-  TreasuryCut :: Rational -> ParameterChange
+  TreasuryCut :: Rational -> ParamChange
   -- | Minimum Stake Pool Cost
-  MinPoolCost :: Integer -> ParameterChange
+  MinPoolCost :: Integer -> ParamChange
   -- | Cost in lovelace per byte of UTxO storage
-  CoinsPerUTxOByte :: Integer -> ParameterChange
+  CoinsPerUTxOByte :: Integer -> ParamChange
   -- | Cost models for non-native script languages
   CostModels ::
     { cmPlutusV1Costs :: [Integer],
       cmPlutusV2Costs :: [Integer],
       cmPlutusV3Costs :: [Integer]
     } ->
-    ParameterChange
+    ParamChange
   -- | Prices of execution units
   Prices ::
     { pMemoryCost :: Rational,
       pStepCost :: Rational
     } ->
-    ParameterChange
+    ParamChange
   -- | Max total script execution resources units allowed per tx
   MaxTxExUnits ::
     { mteuMemory :: Integer,
       mteuSteps :: Integer
     } ->
-    ParameterChange
+    ParamChange
   -- | Max total script execution resources units allowed per block
   MaxBlockExUnits ::
     { mbeuMemory :: Integer,
       mbeuSteps :: Integer
     } ->
-    ParameterChange
+    ParamChange
   -- | Max size of a Value in an output
-  MaxValSize :: Integer -> ParameterChange
+  MaxValSize :: Integer -> ParamChange
   -- | Percentage of the txfee which must be provided as collateral when
   -- including non-native scripts.
-  CollateralPercentage :: Integer -> ParameterChange
+  CollateralPercentage :: Integer -> ParamChange
   -- | Maximum number of collateral inputs allowed in a transaction
-  MaxCollateralInputs :: Integer -> ParameterChange
+  MaxCollateralInputs :: Integer -> ParamChange
   -- | Thresholds for pool votes
   PoolVotingThresholds ::
     { pvtMotionNoConfidence :: Rational,
@@ -110,7 +110,7 @@ data ParameterChange where
       pvtHardFork :: Rational,
       pvtSecurityGroup :: Rational
     } ->
-    ParameterChange
+    ParamChange
   -- | Thresholds for DRep votes
   DRepVotingThresholds ::
     { drvtMotionNoConfidence :: Rational,
@@ -124,22 +124,22 @@ data ParameterChange where
       drvtGovernanceGroup :: Rational,
       drvtTreasuryWithdrawal :: Rational
     } ->
-    ParameterChange
+    ParamChange
   -- | Minimum size of the Constitutional Committee
-  CommitteeMinSize :: Integer -> ParameterChange
+  CommitteeMinSize :: Integer -> ParamChange
   -- | The Constitutional Committee Term limit in number of Slots
-  CommitteeMaxTermLength :: Integer -> ParameterChange
+  CommitteeMaxTermLength :: Integer -> ParamChange
   -- | Gov action lifetime in number of Epochs
-  GovActionLifetime :: Integer -> ParameterChange
+  GovActionLifetime :: Integer -> ParamChange
   -- | The amount of the Gov Action deposit
-  GovActionDeposit :: Integer -> ParameterChange
+  GovActionDeposit :: Integer -> ParamChange
   -- | The amount of a DRep registration deposit
-  DRepRegistrationDeposit :: Integer -> ParameterChange
+  DRepRegistrationDeposit :: Integer -> ParamChange
   -- | The number of Epochs that a DRep can perform no activity without losing
   -- their @Active@ status.
-  DRepActivity :: Integer -> ParameterChange
+  DRepActivity :: Integer -> ParamChange
   -- | Reference scripts fee for the minimum fee calculation
-  MinFeeRefScriptCostPerByte :: Rational -> ParameterChange
+  MinFeeRefScriptCostPerByte :: Rational -> ParamChange
   deriving (Show, Eq)
 
 -- | This lists the various possible governance actions. Only two of these
@@ -148,7 +148,7 @@ data ParameterChange where
 data GovernanceAction :: UserKind -> Type where
   -- If several parameter changes are of the same kind, only the last
   -- one will take effect
-  ParameterChange :: [ParameterChange] -> GovernanceAction IsScript
+  ParameterChange :: [ParamChange] -> GovernanceAction IsScript
   TreasuryWithdrawals :: Map Api.Credential Api.Lovelace -> GovernanceAction IsScript
   HardForkInitiation :: Api.ProtocolVersion -> GovernanceAction IsNone
   NoConfidence :: GovernanceAction IsNone

From 22e7ad314c768ee40d190d60e3fec3594f7f8ddd Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Mon, 26 Jan 2026 18:40:18 +0100
Subject: [PATCH 56/96] documentation

---
 src/Cooked/MockChain/Instances.hs | 19 +++++++++++++++----
 src/Cooked/MockChain/Runnable.hs  | 20 ++++++++++++++++++--
 src/Cooked/MockChain/Testing.hs   |  3 +--
 3 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 1a4cd6cb4..11e77b843 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -37,6 +37,7 @@ import Polysemy.NonDet
 import Polysemy.State
 import Polysemy.Writer
 
+-- | The most direct stack of effects to run a mockchain
 type DirectEffs =
   '[ MockChainWrite,
      MockChainRead,
@@ -44,8 +45,7 @@ type DirectEffs =
      Fail
    ]
 
--- | A possible stack of effects to handle a direct interpretation of the
--- mockchain, that is without any tweaks nor branching.
+-- | A mockchain computation builds on top of the `DirectEffs` stack of effects
 type DirectMockChain a = Sem DirectEffs a
 
 instance RunnableMockChain DirectEffs where
@@ -69,10 +69,16 @@ instance RunnableMockChain DirectEffs where
            Writer MockChainJournal
          ]
 
+-- | A stack of effects aimed at being used as modifications for a
+-- `StagedMockChain` computation
 type StagedTweakEffs = '[MockChainRead, Fail, NonDet]
 
+-- | A tweak computation based on the `StagedTweakEffs` stack of effects
 type StagedTweak a = TypedTweak StagedTweakEffs a
 
+-- | A stack of effects which allows everything allowed by `DirectEffs` with the
+-- addition of branching and `Ltl` modification with tweaks living in
+-- `StagedTweakEffs`
 type StagedEffs =
   '[ ModifyGlobally (UntypedTweak StagedTweakEffs),
      MockChainWrite,
@@ -82,8 +88,7 @@ type StagedEffs =
      NonDet
    ]
 
--- | A possible stack of effects to handle staged interpretation of the
--- mockchain, that is with tweaks and branching.
+-- | A mockchain computation builds on top of the `StagedEffs` stack of effects
 type StagedMockChain a = Sem StagedEffs a
 
 instance RunnableMockChain StagedEffs where
@@ -115,6 +120,8 @@ instance RunnableMockChain StagedEffs where
            State [Ltl (UntypedTweak StagedTweakEffs)]
          ]
 
+-- | A stack of effects aimed at being used as modifications for a
+-- `FullMockChain` computation
 type FullTweakEffs =
   '[ MockChainRead,
      Fail,
@@ -126,8 +133,11 @@ type FullTweakEffs =
      NonDet
    ]
 
+-- | A tweak computation based on the `FullTweakEffs` stack of effects
 type FullTweak a = TypedTweak FullTweakEffs a
 
+-- | A stack of effects which allows everything allowed by `StagedEffs` with the
+-- addition of all the lower level effects required to interpret it.
 type FullEffs =
   '[ ModifyGlobally (UntypedTweak FullTweakEffs),
      MockChainWrite,
@@ -144,6 +154,7 @@ type FullEffs =
      NonDet
    ]
 
+-- | A mockchain computation builds on top of the `FullEffs` stack of effects
 type FullMockChain a = Sem FullEffs a
 
 instance RunnableMockChain FullEffs where
diff --git a/src/Cooked/MockChain/Runnable.hs b/src/Cooked/MockChain/Runnable.hs
index cd19fa6c4..6c90eada1 100644
--- a/src/Cooked/MockChain/Runnable.hs
+++ b/src/Cooked/MockChain/Runnable.hs
@@ -1,3 +1,11 @@
+-- | This module exposes the infrastructure to execute mockchain runs. In
+-- particular:
+--
+-- - The return types of the runs (raw and refined)
+--
+-- - The initial configuration with which to execute a run
+--
+-- - The notion of `RunnableMockChain` to actually execution computations
 module Cooked.MockChain.Runnable where
 
 import Cooked.InitialDistribution
@@ -44,10 +52,10 @@ unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
 unRawMockChainReturn (MockChainJournal journal aliases notes, (st, val)) =
   MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases notes
 
--- | Configuration to run a mockchain
+-- | Configuration from which to run a mockchain
 data MockChainConf a b where
   MockChainConf ::
-    { -- | The initial state from which to run the 'MockChainT'
+    { -- | The initial state from which to run the mockchain
       mccInitialState :: MockChainState,
       -- | The initial payments to issue in the run
       mccInitialDistribution :: InitialDistribution,
@@ -56,12 +64,18 @@ data MockChainConf a b where
     } ->
     MockChainConf a b
 
+-- | The default `MockChainConf`, which uses the default initial state and
+-- initial distribution, and returns a refined `MockChainReturn`
 mockChainConfTemplate :: MockChainConf a (MockChainReturn a)
 mockChainConfTemplate = MockChainConf def def unRawMockChainReturn
 
+-- | The class of effects that represent a mockchain run
 class RunnableMockChain effs where
+  -- | Runs a computation from an initial `MockChainState`, while returning a
+  -- list of `RawMockChainReturn`
   runMockChain :: MockChainState -> Sem effs a -> [RawMockChainReturn a]
 
+-- | Runs a `RunnableMockChain` from an initial `MockChainConf`
 runMockChainFromConf ::
   ( RunnableMockChain effs,
     Member MockChainWrite effs
@@ -72,6 +86,7 @@ runMockChainFromConf ::
 runMockChainFromConf (MockChainConf initState initDist funOnResult) currentRun =
   funOnResult <$> runMockChain initState (forceOutputs (unInitialDistribution initDist) >> currentRun)
 
+-- | Runs a `RunnableMockChain` from an initial distribution
 runMockChainFromInitDist ::
   ( RunnableMockChain effs,
     Member MockChainWrite effs
@@ -82,6 +97,7 @@ runMockChainFromInitDist ::
 runMockChainFromInitDist initDist =
   runMockChainFromConf $ mockChainConfTemplate {mccInitialDistribution = initDist}
 
+-- | Runs a `RunnableMockChain` from a default configuration
 runMockChainDef ::
   ( RunnableMockChain effs,
     Member MockChainWrite effs
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index d70227a23..cf6baa46f 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -198,8 +198,7 @@ data Test effs a prop = Test
     testTrace :: Sem effs a,
     -- | The initial distribution from which the trace should be run
     testInitDist :: InitialDistribution,
-    -- | The requirement on the number of results, as 'StagedMockChain' is a
-    -- 'Control.Monad.MonadPlus'
+    -- | The requirement on the number of results
     testSizeProp :: SizeProp prop,
     -- | The property that should hold in case of failure over the resulting
     -- error and the logs emitted during the run

From 402f108e1f978d80be168b7838d177a5b0b73cd0 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Tue, 27 Jan 2026 17:24:43 +0100
Subject: [PATCH 57/96] updating CHANGELOG from main

---
 CHANGELOG.md | Bin 35831 -> 36559 bytes
 1 file changed, 0 insertions(+), 0 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index b398ebeae3a1dbd41a521d93aba47ed4f45e5532..a2af250cfc2dab3fcce0a4ed467f62407619d506 100644
GIT binary patch
delta 632
zcmY*WyN(nw5af<*1CoUVl0qvXA?*x%7odZP)sY~bP6+k`#xv8qW39&??Dh_K$$Y>i
zNE;CG5qt?>z;}?+p1tD{*=|=?S6BV|di>+t@t0>$Gh9-S;)2bk;{u)6E$bc4!48%-
ziua%HPlp_<Mh7TkTp!XG*$_QJO@Po*rPsOw_oTMywK4D%qG4!@qP-^X3MgBnRemcZ
z!rP<Oh5|cF3B(Nv5q<8YFUWK&2i!W<u@cr{`(nwgsx97ryvQeiH5aH{TWYJ=`EWZ`
z+YQ#<wPUxcYt7o(#CEsj93fT>RFIj4b$vsgia83o*kx(bJ<s!dlgVs0!v|{J?jhBO
z*LkDtCOtB&_Uh4ePzPC!3Mh#zVpl7s`gO8u6cA#Wjm8Aj+Ec~m3V~Qgr{$6pE^-$+
z%two)cs2HV;^;-T6?{Urt`?K2zJn(hR?RSeL_?4O^Yeea_@hW$rj1XcQf>(*ee|Di
zjoKyu#|6lGT{QwufqAm3Jv5fYOkN^nu`UUcs2C4!LlRmn-@n@*J((Vz?T4E;)3bb$
WFP<aA>EiTdwm8X7UVVT3^X4~4QP;Qt

delta 13
VcmX><m+AX-rU`1B|1n+c1^_RG2E+gW


From 561286678331aa1e6bb6392a2b8b1030ec374855 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Tue, 27 Jan 2026 17:32:22 +0100
Subject: [PATCH 58/96] txSkelLabel -> txSkelLabels

---
 CHANGELOG.md                    | Bin 36559 -> 36610 bytes
 src/Cooked/Skeleton.hs          |  11 ++++++-----
 src/Cooked/Tweak/Labels.hs      |   6 +++---
 tests/Spec/Attack/DoubleSat.hs  |  10 +++++-----
 tests/Spec/Attack/DupToken.hs   |   4 ++--
 tests/Spec/Tweak/Labels.hs      |   2 +-
 tests/Spec/Tweak/TamperDatum.hs |   2 +-
 7 files changed, 18 insertions(+), 17 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index a2af250cfc2dab3fcce0a4ed467f62407619d506..cb5ad7308e15e962c0f6bbd0b308085a6fe0c62c 100644
GIT binary patch
delta 65
zcmX><m#JwU(}rFqBVC1rl8WH$)EuA0q|}@Qg^a{vg{0KfJcXjvyu{qp6ory}6cxn@
Jn|qj?djJ~{7(D<0

delta 14
VcmZpg$8>%!(}rHA%?FsAdH^q71`_}P

diff --git a/src/Cooked/Skeleton.hs b/src/Cooked/Skeleton.hs
index 27c8dc668..cffdc57c0 100644
--- a/src/Cooked/Skeleton.hs
+++ b/src/Cooked/Skeleton.hs
@@ -15,7 +15,7 @@
 module Cooked.Skeleton
   ( module X,
     TxSkel (..),
-    txSkelLabelL,
+    txSkelLabelsL,
     txSkelOptsL,
     txSkelMintsL,
     txSkelValidityRangeL,
@@ -68,8 +68,9 @@ data TxSkel where
   TxSkel ::
     { -- | Labels do not influence the transaction generation at all; they are
       -- pretty-printed whenever cooked-validators prints a transaction, and can
-      -- therefore make the output more informative.
-      txSkelLabel :: Set TxSkelLabel,
+      -- therefore make the output more informative. They can also be used to
+      -- select skeletons to be modified during a mockchain run.
+      txSkelLabels :: Set TxSkelLabel,
       -- | Some options that control transaction generation.
       txSkelOpts :: TxSkelOpts,
       -- | Any value minted or burned by the transaction. You'll probably want
@@ -112,7 +113,7 @@ data TxSkel where
   deriving (Show, Eq)
 
 -- | Focusing on the labels of a 'TxSkel'
-makeLensesFor [("txSkelLabel", "txSkelLabelL")] ''TxSkel
+makeLensesFor [("txSkelLabels", "txSkelLabelsL")] ''TxSkel
 
 -- | Focusing on the optics of a 'TxSkel'
 makeLensesFor [("txSkelOpts", "txSkelOptsL")] ''TxSkel
@@ -150,7 +151,7 @@ makeLensesFor [("txSkelCertificates", "txSkelCertificatesL")] ''TxSkel
 txSkelTemplate :: TxSkel
 txSkelTemplate =
   TxSkel
-    { txSkelLabel = mempty,
+    { txSkelLabels = mempty,
       txSkelOpts = def,
       txSkelMints = mempty,
       txSkelValidityRange = Api.always,
diff --git a/src/Cooked/Tweak/Labels.hs b/src/Cooked/Tweak/Labels.hs
index 9e4e496fc..9216b3b44 100644
--- a/src/Cooked/Tweak/Labels.hs
+++ b/src/Cooked/Tweak/Labels.hs
@@ -25,7 +25,7 @@ addLabelTweak ::
   ) =>
   lbl ->
   Sem effs ()
-addLabelTweak = overTweak txSkelLabelL . Set.insert . TxSkelLabel
+addLabelTweak = overTweak txSkelLabelsL . Set.insert . TxSkelLabel
 
 -- | Checks if a given label is present in the 'TxSkel'
 hasLabelTweak ::
@@ -34,7 +34,7 @@ hasLabelTweak ::
   ) =>
   lbl ->
   Sem effs Bool
-hasLabelTweak = (viewTweak txSkelLabelL <&>) . Set.member . TxSkelLabel
+hasLabelTweak = (viewTweak txSkelLabelsL <&>) . Set.member . TxSkelLabel
 
 -- | Ensures a given label is present in the 'TxSkel'
 ensureLabelTweak ::
@@ -54,7 +54,7 @@ removeLabelTweak ::
   Sem effs ()
 removeLabelTweak lbl = do
   ensureLabelTweak lbl
-  overTweak txSkelLabelL . Set.delete $ TxSkelLabel lbl
+  overTweak txSkelLabelsL . Set.delete $ TxSkelLabel lbl
 
 -- | Apply a tweak to a given transaction if it has a specific label. Fails if
 -- it does not.
diff --git a/tests/Spec/Attack/DoubleSat.hs b/tests/Spec/Attack/DoubleSat.hs
index 3cede8c17..00cb4a82f 100644
--- a/tests/Spec/Attack/DoubleSat.hs
+++ b/tests/Spec/Attack/DoubleSat.hs
@@ -99,14 +99,14 @@ tests =
                                 | aOref == fst aUtxo1 ->
                                     return
                                       [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
-                                        | (bOref, bOut) <- bUtxos,
-                                          view txSkelOutValueL bOut == Script.lovelace 123 -- not satisfied by any UTxO in 'dsTestMockChain'
+                                      | (bOref, bOut) <- bUtxos,
+                                        view txSkelOutValueL bOut == Script.lovelace 123 -- not satisfied by any UTxO in 'dsTestMockChain'
                                       ]
                                 | aOref == fst aUtxo2 ->
                                     return
                                       [ (someTxSkelRedeemer ARedeemer2, toDelta bOref $ someTxSkelRedeemer BRedeemer1)
-                                        | (bOref, _) <- bUtxos,
-                                          bOref == fst bUtxo1
+                                      | (bOref, _) <- bUtxos,
+                                        bOref == fst bUtxo1
                                       ]
                                 | aOref == fst aUtxo3 ->
                                     return $
@@ -138,7 +138,7 @@ tests =
             skelExpected :: [(ARedeemer, V3.TxOutRef)] -> [(BRedeemer, (V3.TxOutRef, TxSkelOut))] -> TxSkel
             skelExpected aInputs bInputs =
               txSkelTemplate
-                { txSkelLabel = Set.singleton $ TxSkelLabel DoubleSatLbl,
+                { txSkelLabels = Set.singleton $ TxSkelLabel DoubleSatLbl,
                   txSkelIns =
                     Map.fromList
                       ( ( \(bRedeemer, (bOref, _)) ->
diff --git a/tests/Spec/Attack/DupToken.hs b/tests/Spec/Attack/DupToken.hs
index 8b97da62e..dc9a9fe47 100644
--- a/tests/Spec/Attack/DupToken.hs
+++ b/tests/Spec/Attack/DupToken.hs
@@ -55,7 +55,7 @@ tests =
             skelExpected v1 v2 =
               let increment = Api.assetClassValue ac1 (v1 - 5) <> Api.assetClassValue ac2 (v2 - 7)
                in [ ( txSkelTemplate
-                        { txSkelLabel = Set.singleton $ TxSkelLabel DupTokenLbl,
+                        { txSkelLabels = Set.singleton $ TxSkelLabel DupTokenLbl,
                           txSkelMints =
                             review
                               txSkelMintsListI
@@ -105,7 +105,7 @@ tests =
                 }
             skelExpected =
               [ ( txSkelTemplate
-                    { txSkelLabel = Set.singleton $ TxSkelLabel DupTokenLbl,
+                    { txSkelLabels = Set.singleton $ TxSkelLabel DupTokenLbl,
                       txSkelMints = review txSkelMintsListI [mint pol () tName1 2],
                       txSkelOuts =
                         [ wallet 1 `receives` Value (Api.assetClassValue ac1 1 <> Api.assetClassValue ac2 2),
diff --git a/tests/Spec/Tweak/Labels.hs b/tests/Spec/Tweak/Labels.hs
index 2bd0a1333..d23ed366c 100644
--- a/tests/Spec/Tweak/Labels.hs
+++ b/tests/Spec/Tweak/Labels.hs
@@ -80,7 +80,7 @@ tests =
         $ mustSucceedTest
         $ everywhere
           ( do
-              txSkelLabels <- viewAllTweak $ txSkelLabelL % to Set.toList % traversed % txSkelLabelTypedP @Text
+              txSkelLabels <- viewAllTweak $ txSkelLabelsL % to Set.toList % traversed % txSkelLabelTypedP @Text
               guard $ not $ null txSkelLabels
               labelAmountTweak
           )
diff --git a/tests/Spec/Tweak/TamperDatum.hs b/tests/Spec/Tweak/TamperDatum.hs
index e619918a9..23676929a 100644
--- a/tests/Spec/Tweak/TamperDatum.hs
+++ b/tests/Spec/Tweak/TamperDatum.hs
@@ -24,7 +24,7 @@ tamperDatumTweakTest :: TestTree
 tamperDatumTweakTest =
   testCase "tamperDatumTweak" $
     [ ( txSkelTemplate
-          { txSkelLabel = Set.singleton $ TxSkelLabel TamperDatumLbl,
+          { txSkelLabels = Set.singleton $ TxSkelLabel TamperDatumLbl,
             txSkelOuts =
               [ alice `receives` VisibleHashedDatum (52 :: Integer, 54 :: Integer),
                 alice `receives` Value (Script.lovelace 234),

From 82784eb5a30902b0776c704a121264537bd0c2c9 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Wed, 28 Jan 2026 02:27:38 +0100
Subject: [PATCH 59/96] improvements

---
 src/Cooked/MockChain/Common.hs      |  8 +++++--
 src/Cooked/MockChain/Journal.hs     | 11 +++++----
 src/Cooked/MockChain/Misc.hs        | 33 +++++++++++++++++++--------
 src/Cooked/MockChain/Runnable.hs    |  4 +++-
 src/Cooked/MockChain/Write.hs       | 31 +++++++++++++++----------
 src/Cooked/Pretty/Class.hs          | 17 ++++++++++++--
 src/Cooked/Pretty/MockChain.hs      | 12 +++++-----
 src/Cooked/Pretty/Skeleton.hs       |  4 ++++
 tests/Spec/Attack/DatumHijacking.hs |  2 +-
 tests/Spec/BasicUsage.hs            |  2 +-
 tests/Spec/InitialDistribution.hs   |  2 +-
 tests/Spec/InlineDatums.hs          |  4 ++--
 tests/Spec/MinAda.hs                |  5 ++---
 tests/Spec/MultiPurpose.hs          | 12 +++++-----
 tests/Spec/ReferenceInputs.hs       |  4 ++--
 tests/Spec/ReferenceScripts.hs      | 35 +++++++++++++++--------------
 16 files changed, 118 insertions(+), 68 deletions(-)

diff --git a/src/Cooked/MockChain/Common.hs b/src/Cooked/MockChain/Common.hs
index f7421f882..1ad8b71cd 100644
--- a/src/Cooked/MockChain/Common.hs
+++ b/src/Cooked/MockChain/Common.hs
@@ -4,6 +4,7 @@ module Cooked.MockChain.Common
     Fee,
     CollateralIns,
     Collaterals,
+    Utxo,
     Utxos,
   )
 where
@@ -24,5 +25,8 @@ type CollateralIns = Set Api.TxOutRef
 -- | An alias for optional pairs of collateral inputs and return collateral peer
 type Collaterals = Maybe (CollateralIns, Peer)
 
--- | An alias for lists of utxos with their associated output
-type Utxos = [(Api.TxOutRef, TxSkelOut)]
+-- | An alias for an output and its reference
+type Utxo = (Api.TxOutRef, TxSkelOut)
+
+-- | An alias for lists of `Utxo`
+type Utxos = [Utxo]
diff --git a/src/Cooked/MockChain/Journal.hs b/src/Cooked/MockChain/Journal.hs
index 5a30145d9..b59531e16 100644
--- a/src/Cooked/MockChain/Journal.hs
+++ b/src/Cooked/MockChain/Journal.hs
@@ -2,6 +2,8 @@
 module Cooked.MockChain.Journal where
 
 import Cooked.MockChain.Log
+import Cooked.Pretty.Class
+import Cooked.Pretty.Options
 import Data.Map
 import Data.Map qualified as Map
 import PlutusLedgerApi.V3 qualified as Api
@@ -14,8 +16,9 @@ data MockChainJournal where
       mcbLog :: [MockChainLogEntry],
       -- | Aliases stored by the user
       mcbAliases :: Map Api.BuiltinByteString String,
-      -- | Notes taken by the user
-      mcbNotes :: [String]
+      -- | Notes taken by the user, parameterized by some pretty cooked options,
+      -- to get a better display at the end of the run
+      mcbNotes :: [PrettyCookedOpts -> DocCooked]
     } ->
     MockChainJournal
 
@@ -34,5 +37,5 @@ fromAlias :: String -> Api.BuiltinByteString -> MockChainJournal
 fromAlias s hash = MockChainJournal mempty (Map.singleton hash s) mempty
 
 -- | Build a `MockChainJournal` from a single note
-fromNote :: String -> MockChainJournal
-fromNote s = MockChainJournal mempty mempty [show s]
+fromNote :: (PrettyCookedOpts -> DocCooked) -> MockChainJournal
+fromNote s = MockChainJournal mempty mempty [s]
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index 9f22aad95..cfa2a06ef 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -7,24 +7,30 @@ module Cooked.MockChain.Misc
     MockChainMisc (..),
     runMockChainMisc,
 
-    -- * Misc primitives
+    -- * Storing aliases for hashable elements
     define,
     defineM,
+
+    -- * Taking notes in the notebook
     note,
     noteP,
+    noteL,
+    noteS,
   )
 where
 
 import Cooked.Pretty.Class
 import Cooked.Pretty.Hashable
+import Cooked.Pretty.Options
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Writer
+import Prettyprinter qualified as PP
 
 -- | An effect that corresponds to extra QOL capabilities of the MockChain
 data MockChainMisc :: Effect where
   Define :: (ToHash a) => String -> a -> MockChainMisc m a
-  Note :: (Show s) => s -> MockChainMisc m ()
+  Note :: (PrettyCookedOpts -> DocCooked) -> MockChainMisc m ()
 
 makeSem_ ''MockChainMisc
 
@@ -34,23 +40,32 @@ runMockChainMisc ::
   forall effs a j.
   (Member (Writer j) effs) =>
   (String -> Api.BuiltinByteString -> j) ->
-  (String -> j) ->
+  ((PrettyCookedOpts -> DocCooked) -> j) ->
   Sem (MockChainMisc : effs) a ->
   Sem effs a
 runMockChainMisc injectAlias injectNote = interpret $ \case
   (Define name hashable) -> tell (injectAlias name $ toHash hashable) >> return hashable
-  (Note s) -> tell $ injectNote $ show s
+  (Note s) -> tell $ injectNote s
 
 -- | Stores an alias matching a hashable data for pretty printing purpose
 define :: forall effs a. (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a
 
+-- | Like `define`, but binds the result of a monadic computation instead
+defineM :: (Member MockChainMisc effs, ToHash a) => String -> Sem effs a -> Sem effs a
+defineM name = (define name =<<)
+
 -- | Takes note of a showable element to trace at the end of the run
-note :: forall effs s. (Member MockChainMisc effs, Show s) => s -> Sem effs ()
+note :: forall effs. (Member MockChainMisc effs) => (PrettyCookedOpts -> DocCooked) -> Sem effs ()
 
 -- | Takes note of a pretty-printable element to trace at the end of the run
 noteP :: forall effs s. (Member MockChainMisc effs, PrettyCooked s) => s -> Sem effs ()
-noteP = note . prettyCooked
+noteP doc = note (`prettyCookedOpt` doc)
 
--- | Like `define`, but binds the result of a monadic computation instead
-defineM :: (Member MockChainMisc effs, ToHash a) => String -> Sem effs a -> Sem effs a
-defineM name = (define name =<<)
+-- | Takes note of a pretty-printable element as list with a title, to trace at
+-- the end of the run
+noteL :: forall effs l. (Member MockChainMisc effs, PrettyCookedList l) => String -> l -> Sem effs ()
+noteL title docs = note $ \opts -> prettyItemize opts (prettyCooked title) "-" docs
+
+-- | Takes note of a showable element to trace at the end of the run
+noteS :: forall effs s. (Member MockChainMisc effs, Show s) => s -> Sem effs ()
+noteS doc = note $ const (PP.viaShow doc)
diff --git a/src/Cooked/MockChain/Runnable.hs b/src/Cooked/MockChain/Runnable.hs
index 6c90eada1..ccecc457d 100644
--- a/src/Cooked/MockChain/Runnable.hs
+++ b/src/Cooked/MockChain/Runnable.hs
@@ -14,6 +14,8 @@ import Cooked.MockChain.Journal
 import Cooked.MockChain.Log
 import Cooked.MockChain.State
 import Cooked.MockChain.Write
+import Cooked.Pretty.Class
+import Cooked.Pretty.Options
 import Cooked.Skeleton.Output
 import Data.Default
 import Data.Map (Map)
@@ -38,7 +40,7 @@ data MockChainReturn a where
       -- | The map of aliases defined during the run
       mcrAliases :: Map Api.BuiltinByteString String,
       -- | The notes taken by the user during the run
-      mcrNoteBook :: [String]
+      mcrNoteBook :: [PrettyCookedOpts -> DocCooked]
     } ->
     MockChainReturn a
   deriving (Functor)
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index 3e950cc0e..55611898a 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -33,6 +33,7 @@ import Control.Lens qualified as Lens
 import Control.Monad
 import Cooked.MockChain.AutoFilling
 import Cooked.MockChain.Balancing
+import Cooked.MockChain.Common
 import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Body
 import Cooked.MockChain.GenerateTx.Output
@@ -60,9 +61,9 @@ import Polysemy.State
 data MockChainWrite :: Effect where
   WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
   SetParams :: Emulator.Params -> MockChainWrite m ()
-  ValidateTxSkel :: TxSkel -> MockChainWrite m Ledger.CardanoTx
+  ValidateTxSkel :: TxSkel -> MockChainWrite m (Ledger.CardanoTx, Utxos)
   SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
-  ForceOutputs :: [TxSkelOut] -> MockChainWrite m [Api.TxOutRef]
+  ForceOutputs :: [TxSkelOut] -> MockChainWrite m Utxos
 
 makeSem_ ''MockChainWrite
 
@@ -150,7 +151,7 @@ runMockChainWrite = interpret $ \case
     -- We update our internal map by adding the new outputs
     modify' (over mcstOutputsL (<> outputsMap))
     -- Finally, we return the created utxos
-    fmap fst <$> utxosFromCardanoTx cardanoTx
+    return $ Map.toList (fst <$> outputsMap)
   ValidateTxSkel skel -> fmap snd $ runTweak skel $ do
     -- We retrieve the current skeleton options
     TxSkelOpts {..} <- viewTweak txSkelOptsL
@@ -188,7 +189,7 @@ runMockChainWrite = interpret $ \case
     -- based on the validation result, and throw an error if this fails. If at
     -- some point we want to allows mockchain runs with validation errors, the
     -- caller will need to catch those errors and do something with them.
-    case Emulator.validateCardanoTx newParams eLedgerState cardanoTx of
+    newOutputs <- case Emulator.validateCardanoTx newParams eLedgerState cardanoTx of
       -- In case of a phase 1 error, we give back the same index
       (_, Ledger.FailPhase1 _ err) -> throw $ MCEValidationError Ledger.Phase1 err
       (newELedgerState, Ledger.FailPhase2 _ err _) | Just (colInputs, retColUser) <- mCollaterals -> do
@@ -212,10 +213,14 @@ runMockChainWrite = interpret $ \case
         modify' (set mcstLedgerStateL newELedgerState)
         -- We retrieve the utxos created by the transaction
         let utxos = Ledger.fromCardanoTxIn . snd <$> Ledger.getCardanoTxOutRefs cardanoTx
+        -- We combine them with their corresponding `TxSkelOut`
+        let newOutputs = zip utxos (txSkelOuts finalTxSkel)
         -- We add the news utxos to the state
-        forM_ (zip utxos (txSkelOuts finalTxSkel)) $ modify' . uncurry addOutput
+        forM_ newOutputs $ modify' . uncurry addOutput
         -- And remove the old ones
         forM_ (Map.toList $ txSkelIns finalTxSkel) $ modify' . removeOutput . fst
+        -- We return the newly created outputs
+        return newOutputs
       -- This is a theoretical unreachable case. Since we fail in Phase 2, it
       -- means the transaction involved script, and thus we must have generated
       -- collaterals.
@@ -230,7 +235,7 @@ runMockChainWrite = interpret $ \case
     -- We log the validated transaction
     logEvent $ MCLogNewTx (Ledger.fromCardanoTxId $ Ledger.getCardanoTxId cardanoTx) (fromIntegral $ length $ Ledger.getCardanoTxOutRefs cardanoTx)
     -- We return the validated transaction
-    return cardanoTx
+    return (cardanoTx, newOutputs)
 
 -- | Waits a certain number of slots and returns the new slot
 waitNSlots :: (Member MockChainWrite effs) => Integer -> Sem effs Ledger.Slot
@@ -258,12 +263,12 @@ waitNMSFromSlotUpperBound :: (Members '[MockChainRead, MockChainWrite, Fail] eff
 waitNMSFromSlotUpperBound duration = currentMSRange >>= awaitEnclosingSlot . (+ fromIntegral duration) . snd
 
 -- | Generates, balances and validates a transaction from a skeleton, and
--- returns the validated transaction.
-validateTxSkel :: (Member MockChainWrite effs) => TxSkel -> Sem effs Ledger.CardanoTx
+-- returns the validated transaction, alongside the created UTxOs.
+validateTxSkel :: (Member MockChainWrite effs) => TxSkel -> Sem effs (Ledger.CardanoTx, Utxos)
 
 -- | Same as `validateTxSkel`, but only returns the generated UTxOs
-validateTxSkel' :: (Members '[MockChainRead, MockChainWrite] effs) => TxSkel -> Sem effs [Api.TxOutRef]
-validateTxSkel' = (fmap fst <$>) . utxosFromCardanoTx <=< validateTxSkel
+validateTxSkel' :: (Members '[MockChainRead, MockChainWrite] effs) => TxSkel -> Sem effs Utxos
+validateTxSkel' = fmap snd . validateTxSkel
 
 -- | Same as `validateTxSkel`, but discards the returned transaction
 validateTxSkel_ :: (Member MockChainWrite effs) => TxSkel -> Sem effs ()
@@ -275,5 +280,7 @@ setParams :: (Member MockChainWrite effs) => Emulator.Params -> Sem effs ()
 -- | Sets the current script to act as the official constitution script
 setConstitutionScript :: (Member MockChainWrite effs, ToVScript s) => s -> Sem effs ()
 
--- | Forces the generation of utxos corresponding to certain `TxSkelOut`
-forceOutputs :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs [Api.TxOutRef]
+-- | Forces the generation of utxos corresponding to certain
+-- `TxSkelOut`. Returns the created UTxOs, which might differ from the original
+-- list if some min ADA adjustment occured.
+forceOutputs :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs Utxos
diff --git a/src/Cooked/Pretty/Class.hs b/src/Cooked/Pretty/Class.hs
index 17d5ded1a..9072b780d 100644
--- a/src/Cooked/Pretty/Class.hs
+++ b/src/Cooked/Pretty/Class.hs
@@ -15,6 +15,7 @@ module Cooked.Pretty.Class
   )
 where
 
+import Cooked.Families
 import Cooked.Pretty.Hashable
 import Cooked.Pretty.Options
 import Data.ByteString qualified as ByteString
@@ -51,8 +52,8 @@ instance PrettyCooked DocCooked where
   prettyCookedOpt _ = id
 
 -- | Type class of things that can be pretty printed as a list of
--- documents. Similarly to 'PrettyCooked', at least of the functions from this
--- class needs to be manually implemented to avoid infinite loops.
+-- documents. Similarly to 'PrettyCooked', at least one of the functions from
+-- this class needs to be manually implemented to avoid infinite loops.
 class PrettyCookedList a where
   -- | Pretty prints an element as a list on some 'PrettyCookedOpts'
   prettyCookedOptList :: PrettyCookedOpts -> a -> [DocCooked]
@@ -62,6 +63,9 @@ class PrettyCookedList a where
   prettyCookedOptListMaybe :: PrettyCookedOpts -> a -> [Maybe DocCooked]
   prettyCookedOptListMaybe opts = fmap Just . prettyCookedOptList opts
 
+  prettyCookedListMaybe :: a -> [Maybe DocCooked]
+  prettyCookedListMaybe = prettyCookedOptListMaybe def
+
   -- | Pretty prints an elements as a list
   prettyCookedList :: a -> [DocCooked]
   prettyCookedList = prettyCookedOptList def
@@ -182,3 +186,12 @@ instance PrettyCooked Rational where
 
 instance PrettyCooked Text where
   prettyCookedOpt _ = PP.pretty
+
+instance PrettyCooked String where
+  prettyCookedOpt _ = PP.pretty
+
+instance PrettyCookedList (HList '[]) where
+  prettyCookedOptList _ HEmpty = []
+
+instance (PrettyCooked a, PrettyCookedList (HList l)) => PrettyCookedList (HList (a ': l)) where
+  prettyCookedOptList opts (HCons h t) = prettyCookedOpt opts h : prettyCookedOptList opts t
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 02f7ba913..f306b8591 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -14,6 +14,7 @@ import Cooked.Pretty.Skeleton
 import Cooked.Skeleton.User
 import Cooked.Wallet (walletPKHashToId)
 import Data.Function (on)
+import Data.List (intersperse)
 import Data.List qualified as List
 import Data.Map (Map)
 import Data.Map qualified as Map
@@ -27,20 +28,21 @@ import Prettyprinter ((<+>))
 import Prettyprinter qualified as PP
 
 instance (Show a) => PrettyCooked [MockChainReturn a] where
+  prettyCookedOpt _ [] = "[]"
   prettyCookedOpt opts [outcome] = prettyCookedOpt opts outcome
   prettyCookedOpt opts outcomes =
-    PP.vsep
-      ( zipWith
-          (\n d -> PP.vsep ["", PP.pretty n <> "." <+> d])
+    PP.vsep $
+      intersperse "" $
+        zipWith
+          (\n d -> PP.pretty n <> "." <+> d)
           ([1 ..] :: [Int])
           (PP.align . prettyCookedOpt opts <$> outcomes)
-      )
 
 instance (Show a) => PrettyCooked (MockChainReturn a) where
   prettyCookedOpt opts' (MockChainReturn res outputs utxoState entries ((`addHashNames` opts') -> opts) noteBook) =
     PP.vsep $
       [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
-        <> [prettyItemize opts "📔 Notes:" "-" (PP.pretty @_ @() <$> noteBook) | not (null noteBook)]
+        <> [prettyItemize opts "📔 Notes:" "-" (($ opts) <$> noteBook) | not (null noteBook)]
         <> prettyCookedOptList opts utxoState
         <> [ case res of
                Left err -> "🔴 Error:" <+> prettyCookedOpt opts err
diff --git a/src/Cooked/Pretty/Skeleton.hs b/src/Cooked/Pretty/Skeleton.hs
index c5af6b71b..e50531b41 100644
--- a/src/Cooked/Pretty/Skeleton.hs
+++ b/src/Cooked/Pretty/Skeleton.hs
@@ -9,6 +9,7 @@ import Cooked.Pretty.Class
 import Cooked.Pretty.Options
 import Cooked.Pretty.Plutus ()
 import Cooked.Skeleton
+import Cooked.Wallet (Wallet)
 import Data.Default
 import Data.Map (Map)
 import Data.Map qualified as Map
@@ -22,6 +23,9 @@ import PlutusLedgerApi.V3 qualified as Api
 import Prettyprinter ((<+>))
 import Prettyprinter qualified as PP
 
+instance PrettyCooked Wallet where
+  prettyCookedOpt opts = prettyHash opts . Script.toPubKeyHash
+
 instance PrettyCooked TxSkelSignatory where
   prettyCookedOpt opts (TxSkelSignatory (Script.toPubKeyHash -> pkh) Nothing) = prettyHash opts pkh <+> "(no private key attached)"
   prettyCookedOpt opts (TxSkelSignatory (Script.toPubKeyHash -> pkh) Just {}) = prettyHash opts pkh
diff --git a/tests/Spec/Attack/DatumHijacking.hs b/tests/Spec/Attack/DatumHijacking.hs
index 0e19cb4da..2ba2d2201 100644
--- a/tests/Spec/Attack/DatumHijacking.hs
+++ b/tests/Spec/Attack/DatumHijacking.hs
@@ -31,7 +31,7 @@ lockTxSkel o v =
 txLock :: Script.MultiPurposeScript DHContract -> StagedMockChain Api.TxOutRef
 txLock v = do
   oref : _ <- getTxOutRefs $ utxosAtSearch (wallet 1) $ ensureAFoldIs (txSkelOutValueL % filtered (`Api.geq` lockValue))
-  head <$> validateTxSkel' (lockTxSkel oref v)
+  fst . head <$> validateTxSkel' (lockTxSkel oref v)
 
 relockTxSkel :: Script.MultiPurposeScript DHContract -> Api.TxOutRef -> TxSkel
 relockTxSkel v o =
diff --git a/tests/Spec/BasicUsage.hs b/tests/Spec/BasicUsage.hs
index a8182a36f..7baaa5fe4 100644
--- a/tests/Spec/BasicUsage.hs
+++ b/tests/Spec/BasicUsage.hs
@@ -38,7 +38,7 @@ mintingQuickValue =
 
 payToAlwaysTrueValidator :: StagedMockChain Api.TxOutRef
 payToAlwaysTrueValidator =
-  head
+  fst . head
     <$> ( validateTxSkel' $
             txSkelTemplate
               { txSkelOuts = [Script.trueSpendingMPScript @() `receives` Value (Script.ada 10)],
diff --git a/tests/Spec/InitialDistribution.hs b/tests/Spec/InitialDistribution.hs
index cfe2f8fc2..c98448697 100644
--- a/tests/Spec/InitialDistribution.hs
+++ b/tests/Spec/InitialDistribution.hs
@@ -31,7 +31,7 @@ getValueFromInitialDatum = do
 spendReferenceAlwaysTrueValidator :: DirectMockChain ()
 spendReferenceAlwaysTrueValidator = do
   [(referenceScriptTxOutRef, _)] <- utxosAt alice
-  (scriptTxOutRef : _) <-
+  ((scriptTxOutRef, _) : _) <-
     validateTxSkel' $
       txSkelTemplate
         { txSkelOuts = [Script.trueSpendingMPScript @() `receives` Value (Script.ada 2)],
diff --git a/tests/Spec/InlineDatums.hs b/tests/Spec/InlineDatums.hs
index 1b3cbee55..16914e5da 100644
--- a/tests/Spec/InlineDatums.hs
+++ b/tests/Spec/InlineDatums.hs
@@ -23,8 +23,8 @@ listUtxosTestTrace ::
   Script.Versioned Script.Validator ->
   DirectMockChain (Api.TxOutRef, TxSkelOut)
 listUtxosTestTrace useInlineDatum validator =
-  (\oref -> (oref,) <$> txSkelOutByRef oref) . head
-    =<< validateTxSkel'
+  head
+    <$> validateTxSkel'
       txSkelTemplate
         { txSkelOuts = [validator `receives` (if useInlineDatum then InlineDatum else VisibleHashedDatum) FirstPaymentDatum],
           txSkelSignatories = txSkelSignatoriesFromList [wallet 1]
diff --git a/tests/Spec/MinAda.hs b/tests/Spec/MinAda.hs
index 65ef5ec63..0593ea407 100644
--- a/tests/Spec/MinAda.hs
+++ b/tests/Spec/MinAda.hs
@@ -23,13 +23,12 @@ instance PrettyCooked HeavyDatum where
 
 paymentWithMinAda :: DirectMockChain Integer
 paymentWithMinAda = do
-  tx <-
-    validateTxSkel
+  view (txSkelOutValueL % valueLovelaceL % lovelaceIntegerI) . snd . (!! 0)
+    <$> validateTxSkel'
       txSkelTemplate
         { txSkelOuts = [wallet 2 `receives` VisibleHashedDatum heavyDatum],
           txSkelSignatories = txSkelSignatoriesFromList [wallet 1]
         }
-  view (txSkelOutValueL % valueLovelaceL % lovelaceIntegerI) . snd . (!! 0) <$> utxosFromCardanoTx tx
 
 paymentWithoutMinAda :: Integer -> DirectMockChain ()
 paymentWithoutMinAda paidLovelaces = do
diff --git a/tests/Spec/MultiPurpose.hs b/tests/Spec/MultiPurpose.hs
index 28159a16a..61a32d3b5 100644
--- a/tests/Spec/MultiPurpose.hs
+++ b/tests/Spec/MultiPurpose.hs
@@ -24,7 +24,7 @@ bob = wallet 2
 
 runScript :: StagedMockChain ()
 runScript = do
-  [oRef@(Api.TxOutRef txId _), oRef', oRef''] <-
+  [(oRef@(Api.TxOutRef txId _), _), (oRef', _), (oRef'', _)] <-
     validateTxSkel' $
       txSkelTemplate
         { txSkelOuts =
@@ -39,11 +39,11 @@ runScript = do
       (mintSkel2, mintValue2, tn2) = mkMintSkel alice oRef' script
       (mintSkel3, mintValue3, tn3) = mkMintSkel bob oRef'' script
 
-  (oRefScript : _) <- validateTxSkel' mintSkel1
-  (oRefScript1 : _) <- validateTxSkel' mintSkel2
-  (oRefScript2 : _) <- validateTxSkel' mintSkel3
+  ((oRefScript, _) : _) <- validateTxSkel' mintSkel1
+  ((oRefScript1, _) : _) <- validateTxSkel' mintSkel2
+  ((oRefScript2, _) : _) <- validateTxSkel' mintSkel3
 
-  (oRefScript1' : oRefScript2' : _) <-
+  ((oRefScript1', _) : (oRefScript2', _) : _) <-
     validateTxSkel' $
       txSkelTemplate
         { txSkelSignatories = txSkelSignatoriesFromList [alice],
@@ -60,7 +60,7 @@ runScript = do
           txSkelMints = review txSkelMintsListI [burn script BurnToken tn1 1]
         }
 
-  (oRefScript2'' : _) <-
+  ((oRefScript2'', _) : _) <-
     validateTxSkel' $
       txSkelTemplate
         { txSkelSignatories = txSkelSignatoriesFromList [bob],
diff --git a/tests/Spec/ReferenceInputs.hs b/tests/Spec/ReferenceInputs.hs
index 32d5f7257..c4b144cc4 100644
--- a/tests/Spec/ReferenceInputs.hs
+++ b/tests/Spec/ReferenceInputs.hs
@@ -15,7 +15,7 @@ instance PrettyCooked FooDatum where
 
 trace1 :: DirectMockChain ()
 trace1 = do
-  txOutRefFoo : txOutRefBar : _ <-
+  (txOutRefFoo, _) : (txOutRefBar, _) : _ <-
     validateTxSkel'
       txSkelTemplate
         { txSkelOuts =
@@ -34,7 +34,7 @@ trace1 = do
 
 trace2 :: DirectMockChain ()
 trace2 = do
-  refORef : scriptORef : _ <-
+  (refORef, _) : (scriptORef, _) : _ <-
     validateTxSkel'
       ( txSkelTemplate
           { txSkelOuts =
diff --git a/tests/Spec/ReferenceScripts.hs b/tests/Spec/ReferenceScripts.hs
index 272fbacec..c5d477714 100644
--- a/tests/Spec/ReferenceScripts.hs
+++ b/tests/Spec/ReferenceScripts.hs
@@ -18,7 +18,7 @@ putRefScriptOnWalletOutput ::
   Script.Versioned Script.Validator ->
   DirectMockChain V3.TxOutRef
 putRefScriptOnWalletOutput recipient referenceScript =
-  head
+  fst . head
     <$> validateTxSkel'
       txSkelTemplate
         { txSkelOuts = [recipient `receives` ReferenceScript referenceScript],
@@ -30,7 +30,7 @@ putRefScriptOnScriptOutput ::
   Script.Versioned Script.Validator ->
   DirectMockChain V3.TxOutRef
 putRefScriptOnScriptOutput recipient referenceScript =
-  head
+  fst . head
     <$> validateTxSkel'
       txSkelTemplate
         { txSkelOuts = [recipient `receives` ReferenceScript referenceScript],
@@ -42,7 +42,7 @@ checkReferenceScriptOnOref ::
   V3.TxOutRef ->
   DirectMockChain ()
 checkReferenceScriptOnOref expectedScriptHash refScriptOref = do
-  oref : _ <-
+  (oref, _) : _ <-
     validateTxSkel'
       txSkelTemplate
         { txSkelOuts = [requireRefScriptValidator expectedScriptHash `receives` Value (Script.ada 42)],
@@ -62,25 +62,26 @@ checkReferenceScriptOnOref expectedScriptHash refScriptOref = do
 useReferenceScript :: Wallet -> Bool -> Script.Versioned Script.Validator -> DirectMockChain Ledger.CardanoTx
 useReferenceScript spendingSubmitter consumeScriptOref theScript = do
   scriptOref <- putRefScriptOnWalletOutput (wallet 3) theScript
-  oref : _ <-
+  (oref, _) : _ <-
     validateTxSkel'
       txSkelTemplate
         { txSkelOuts = [theScript `receives` Value (Script.ada 42)],
           txSkelSignatories = txSkelSignatoriesFromList [wallet 1]
         }
-  validateTxSkel
-    txSkelTemplate
-      { txSkelIns =
-          Map.fromList $
-            (oref, TxSkelRedeemer () (Just scriptOref) False)
-              : [(scriptOref, emptyTxSkelRedeemer) | consumeScriptOref],
-        txSkelSignatories = txSkelSignatoriesFromList $ spendingSubmitter : [wallet 3 | consumeScriptOref]
-      }
+  fst
+    <$> validateTxSkel
+      txSkelTemplate
+        { txSkelIns =
+            Map.fromList $
+              (oref, TxSkelRedeemer () (Just scriptOref) False)
+                : [(scriptOref, emptyTxSkelRedeemer) | consumeScriptOref],
+          txSkelSignatories = txSkelSignatoriesFromList $ spendingSubmitter : [wallet 3 | consumeScriptOref]
+        }
 
 useReferenceScriptInInputs :: Wallet -> Script.Versioned Script.Validator -> DirectMockChain ()
 useReferenceScriptInInputs spendingSubmitter theScript = do
   scriptOref <- putRefScriptOnWalletOutput (wallet 1) theScript
-  oref : _ <-
+  (oref, _) : _ <-
     validateTxSkel'
       txSkelTemplate
         { txSkelOuts = [theScript `receives` Value (Script.ada 42)],
@@ -94,7 +95,7 @@ useReferenceScriptInInputs spendingSubmitter theScript = do
 
 referenceMint :: Script.Versioned Script.MintingPolicy -> Script.Versioned Script.MintingPolicy -> Int -> Bool -> DirectMockChain ()
 referenceMint mp1 mp2 n autoRefScript = do
-  ((!! n) -> mpOutRef) <-
+  ((!! n) -> (mpOutRef, _)) <-
     validateTxSkel' $
       txSkelTemplate
         { txSkelOuts =
@@ -148,7 +149,7 @@ tests =
             mustFailTest
               ( do
                   consumedOref : _ <- getTxOutRefs $ utxosAtSearch (wallet 1) $ ensureAFoldIs (txSkelOutValueL % filtered (`Api.geq` Script.lovelace 42_000_000))
-                  oref : _ <-
+                  (oref, _) : _ <-
                     validateTxSkel'
                       txSkelTemplate
                         { txSkelOuts = [Script.alwaysSucceedValidatorVersioned `receives` Value (Script.ada 42)],
@@ -168,7 +169,7 @@ tests =
             mustFailTest
               ( do
                   scriptOref <- putRefScriptOnWalletOutput (wallet 3) Script.alwaysFailValidatorVersioned
-                  oref : _ <-
+                  (oref, _) : _ <-
                     validateTxSkel'
                       txSkelTemplate
                         { txSkelOuts = [Script.alwaysSucceedValidatorVersioned `receives` Value (Script.ada 42)],
@@ -186,7 +187,7 @@ tests =
           testCooked "phase 1 - fail if using a reference script with 'someRedeemer'" $
             mustFailInPhase1Test $ do
               scriptOref <- putRefScriptOnWalletOutput (wallet 3) Script.alwaysSucceedValidatorVersioned
-              oref : _ <-
+              (oref, _) : _ <-
                 validateTxSkel'
                   txSkelTemplate
                     { txSkelOuts = [Script.alwaysSucceedValidatorVersioned `receives` Value (Script.ada 42)],

From 6850bdc90bebfc9632e95e634f8bd810a9b7d2be Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Wed, 28 Jan 2026 14:42:50 +0100
Subject: [PATCH 60/96] ormolu

---
 src/Cooked/MockChain/GenerateTx/Mint.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Cooked/MockChain/GenerateTx/Mint.hs b/src/Cooked/MockChain/GenerateTx/Mint.hs
index 53b12114b..d1eab2b0f 100644
--- a/src/Cooked/MockChain/GenerateTx/Mint.hs
+++ b/src/Cooked/MockChain/GenerateTx/Mint.hs
@@ -32,7 +32,7 @@ toMintValue (unTxSkelMints -> mints) = fmap (Cardano.TxMintValue Cardano.MaryEra
       ( policyId,
         ( fromList
             [ (Cardano.UnsafeAssetName name, Cardano.Quantity quantity)
-              | (Api.TokenName (PlutusTx.BuiltinByteString name), quantity) <- assets
+            | (Api.TokenName (PlutusTx.BuiltinByteString name), quantity) <- assets
             ],
           mintWitness
         )

From 55be72d21f69bf7037cd5a6e03738ffb9927ceab Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Wed, 28 Jan 2026 18:38:41 +0100
Subject: [PATCH 61/96] assert + beginning of StagedRun

---
 cooked-validators.cabal           |  1 +
 src/Cooked/Families.hs            | 12 ++++++
 src/Cooked/MockChain/Instances.hs |  6 +--
 src/Cooked/MockChain/Journal.hs   | 20 ++++++---
 src/Cooked/MockChain/Misc.hs      | 16 +++++++-
 src/Cooked/MockChain/Runnable.hs  | 13 ++----
 src/Cooked/MockChain/Testing.hs   | 16 +++++---
 src/Cooked/Pretty/MockChain.hs    |  3 +-
 tests/Spec.hs                     | 32 ++++++++-------
 tests/Spec/StagedRun.hs           | 67 +++++++++++++++++++++++++++++++
 10 files changed, 144 insertions(+), 42 deletions(-)
 create mode 100644 tests/Spec/StagedRun.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index e1e2ba790..9b8f421fa 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -190,6 +190,7 @@ test-suite spec
       Spec.ReferenceInputs
       Spec.ReferenceScripts
       Spec.Slot
+      Spec.StagedRun
       Spec.Tweak
       Spec.Tweak.Common
       Spec.Tweak.Labels
diff --git a/src/Cooked/Families.hs b/src/Cooked/Families.hs
index 06adaad6b..9a8bb0a9c 100644
--- a/src/Cooked/Families.hs
+++ b/src/Cooked/Families.hs
@@ -88,3 +88,15 @@ hHead (HCons a _) = a
 -- | Tail of an heterogeneous list
 hTail :: HList (a ': l) -> HList l
 hTail (HCons _ l) = l
+
+instance Eq (HList '[]) where
+  _ == _ = True
+
+instance (Eq (HList l), Eq a) => Eq (HList (a ': l)) where
+  HCons h t == HCons h' t' = h == h' && t == t'
+
+instance Show (HList '[]) where
+  show _ = "[]"
+
+instance (Show (HList l), Show a) => Show (HList (a ': l)) where
+  show (HCons h t) = show h <> " : " <> show t
diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 11e77b843..2bcb9fe4e 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -58,7 +58,7 @@ instance RunnableMockChain DirectEffs where
       . runError
       . runToCardanoErrorInMockChainError
       . runFailInMockChainError
-      . runMockChainMisc fromAlias fromNote
+      . runMockChainMisc fromAlias fromNote fromAssert
       . runMockChainRead
       . runMockChainWrite
       . insertAt @4
@@ -102,7 +102,7 @@ instance RunnableMockChain StagedEffs where
       . runToCardanoErrorInMockChainError
       . runFailInMockChainError
       . runMockChainRead
-      . runMockChainMisc fromAlias fromNote
+      . runMockChainMisc fromAlias fromNote fromAssert
       . evalState []
       . runModifyLocally
       . runMockChainWrite
@@ -168,7 +168,7 @@ instance RunnableMockChain FullEffs where
       . runToCardanoErrorInMockChainError
       . runFailInMockChainError
       . runMockChainRead
-      . runMockChainMisc fromAlias fromNote
+      . runMockChainMisc fromAlias fromNote fromAssert
       . evalState []
       . runModifyLocally
       . runMockChainWrite
diff --git a/src/Cooked/MockChain/Journal.hs b/src/Cooked/MockChain/Journal.hs
index b59531e16..fc9bc6a5e 100644
--- a/src/Cooked/MockChain/Journal.hs
+++ b/src/Cooked/MockChain/Journal.hs
@@ -18,24 +18,32 @@ data MockChainJournal where
       mcbAliases :: Map Api.BuiltinByteString String,
       -- | Notes taken by the user, parameterized by some pretty cooked options,
       -- to get a better display at the end of the run
-      mcbNotes :: [PrettyCookedOpts -> DocCooked]
+      mcbNotes :: [PrettyCookedOpts -> DocCooked],
+      -- | Assertions gathered during the run, alongside their associated error
+      -- messages to display in case of failure
+      mcbAssertions :: [(String, Bool)]
     } ->
     MockChainJournal
 
 instance Semigroup MockChainJournal where
-  MockChainJournal l a n <> MockChainJournal l' a' n' = MockChainJournal (l <> l') (a <> a') (n <> n')
+  MockChainJournal l a n p <> MockChainJournal l' a' n' p' =
+    MockChainJournal (l <> l') (a <> a') (n <> n') (p <> p')
 
 instance Monoid MockChainJournal where
-  mempty = MockChainJournal mempty mempty mempty
+  mempty = MockChainJournal mempty mempty mempty mempty
 
 -- | Build a `MockChainJournal` from a single log entry
 fromLogEntry :: MockChainLogEntry -> MockChainJournal
-fromLogEntry entry = MockChainJournal [entry] mempty mempty
+fromLogEntry entry = mempty {mcbLog = [entry]}
 
 -- | Build a `MockChainJournal` from a single alias
 fromAlias :: String -> Api.BuiltinByteString -> MockChainJournal
-fromAlias s hash = MockChainJournal mempty (Map.singleton hash s) mempty
+fromAlias s hash = mempty {mcbAliases = Map.singleton hash s}
 
 -- | Build a `MockChainJournal` from a single note
 fromNote :: (PrettyCookedOpts -> DocCooked) -> MockChainJournal
-fromNote s = MockChainJournal mempty mempty [s]
+fromNote s = mempty {mcbNotes = [s]}
+
+-- | Build a `MockChainJournal` from a single assertion and error message
+fromAssert :: String -> Bool -> MockChainJournal
+fromAssert s p = mempty {mcbAssertions = [(s, p)]}
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index cfa2a06ef..88b62f1cc 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -16,6 +16,10 @@ module Cooked.MockChain.Misc
     noteP,
     noteL,
     noteS,
+
+    -- * Asserting properties
+    assert,
+    assert',
   )
 where
 
@@ -31,6 +35,7 @@ import Prettyprinter qualified as PP
 data MockChainMisc :: Effect where
   Define :: (ToHash a) => String -> a -> MockChainMisc m a
   Note :: (PrettyCookedOpts -> DocCooked) -> MockChainMisc m ()
+  Assert :: String -> Bool -> MockChainMisc m ()
 
 makeSem_ ''MockChainMisc
 
@@ -41,11 +46,13 @@ runMockChainMisc ::
   (Member (Writer j) effs) =>
   (String -> Api.BuiltinByteString -> j) ->
   ((PrettyCookedOpts -> DocCooked) -> j) ->
+  (String -> Bool -> j) ->
   Sem (MockChainMisc : effs) a ->
   Sem effs a
-runMockChainMisc injectAlias injectNote = interpret $ \case
+runMockChainMisc injectAlias injectNote injectPred = interpret $ \case
   (Define name hashable) -> tell (injectAlias name $ toHash hashable) >> return hashable
   (Note s) -> tell $ injectNote s
+  (Assert s b) -> tell $ injectPred s b
 
 -- | Stores an alias matching a hashable data for pretty printing purpose
 define :: forall effs a. (Member MockChainMisc effs, ToHash a) => String -> a -> Sem effs a
@@ -69,3 +76,10 @@ noteL title docs = note $ \opts -> prettyItemize opts (prettyCooked title) "-" d
 -- | Takes note of a showable element to trace at the end of the run
 noteS :: forall effs s. (Member MockChainMisc effs, Show s) => s -> Sem effs ()
 noteS doc = note $ const (PP.viaShow doc)
+
+-- | Ensures a specific property holds, sending the provided error message otherwise
+assert :: forall effs. (Member MockChainMisc effs) => String -> Bool -> Sem effs ()
+
+-- | Ensures a specific property holds, with a default error message otherwise
+assert' :: forall effs. (Member MockChainMisc effs) => Bool -> Sem effs ()
+assert' = assert "Assertion error"
diff --git a/src/Cooked/MockChain/Runnable.hs b/src/Cooked/MockChain/Runnable.hs
index ccecc457d..0ba318c63 100644
--- a/src/Cooked/MockChain/Runnable.hs
+++ b/src/Cooked/MockChain/Runnable.hs
@@ -11,11 +11,8 @@ module Cooked.MockChain.Runnable where
 import Cooked.InitialDistribution
 import Cooked.MockChain.Error
 import Cooked.MockChain.Journal
-import Cooked.MockChain.Log
 import Cooked.MockChain.State
 import Cooked.MockChain.Write
-import Cooked.Pretty.Class
-import Cooked.Pretty.Options
 import Cooked.Skeleton.Output
 import Data.Default
 import Data.Map (Map)
@@ -36,11 +33,7 @@ data MockChainReturn a where
       -- | The 'UtxoState' at the end of the run
       mcrUtxoState :: UtxoState,
       -- | The final journal emitted during the run
-      mcrLog :: [MockChainLogEntry],
-      -- | The map of aliases defined during the run
-      mcrAliases :: Map Api.BuiltinByteString String,
-      -- | The notes taken by the user during the run
-      mcrNoteBook :: [PrettyCookedOpts -> DocCooked]
+      mcrJournal :: MockChainJournal
     } ->
     MockChainReturn a
   deriving (Functor)
@@ -51,8 +44,8 @@ type FunOnMockChainResult a b = RawMockChainReturn a -> b
 
 -- | Building a `MockChainReturn` from a `RawMockChainReturn`
 unRawMockChainReturn :: FunOnMockChainResult a (MockChainReturn a)
-unRawMockChainReturn (MockChainJournal journal aliases notes, (st, val)) =
-  MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal aliases notes
+unRawMockChainReturn (journal, (st, val)) =
+  MockChainReturn val (mcstOutputs st) (mcstToUtxoState st) journal
 
 -- | Configuration from which to run a mockchain
 data MockChainConf a b where
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index cf6baa46f..781d17603 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -8,6 +8,7 @@ import Control.Exception qualified as E
 import Control.Monad
 import Cooked.InitialDistribution
 import Cooked.MockChain.Error
+import Cooked.MockChain.Journal
 import Cooked.MockChain.Log
 import Cooked.MockChain.Runnable
 import Cooked.MockChain.State
@@ -228,13 +229,16 @@ testToProp Test {..} =
   let results = runMockChainFromConf (mockChainConfTemplate {mccInitialDistribution = testInitDist}) testTrace
    in testSizeProp (toInteger (length results))
         .&&. testAll
-          ( \ret@(MockChainReturn outcome _ state mcLog names _) ->
+          ( \ret@(MockChainReturn outcome _ state (MockChainJournal mcLog names _ assertions)) ->
               let pcOpts = addHashNames names testPrettyOpts
-               in testCounterexample
-                    (renderString (prettyCookedOpt pcOpts) ret)
-                    $ case outcome of
-                      Left err -> testFailureProp pcOpts mcLog err state
-                      Right result -> testSuccessProp pcOpts mcLog result state
+               in testConjoin
+                    [ testConjoin $ uncurry testBoolMsg <$> assertions,
+                      testCounterexample
+                        (renderString (prettyCookedOpt pcOpts) ret)
+                        $ case outcome of
+                          Left err -> testFailureProp pcOpts mcLog err state
+                          Right result -> testSuccessProp pcOpts mcLog result state
+                    ]
           )
           results
 
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index f306b8591..cc5af7e57 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -5,6 +5,7 @@
 module Cooked.Pretty.MockChain () where
 
 import Cooked.MockChain.Error
+import Cooked.MockChain.Journal
 import Cooked.MockChain.Log
 import Cooked.MockChain.Runnable
 import Cooked.MockChain.State
@@ -39,7 +40,7 @@ instance (Show a) => PrettyCooked [MockChainReturn a] where
           (PP.align . prettyCookedOpt opts <$> outcomes)
 
 instance (Show a) => PrettyCooked (MockChainReturn a) where
-  prettyCookedOpt opts' (MockChainReturn res outputs utxoState entries ((`addHashNames` opts') -> opts) noteBook) =
+  prettyCookedOpt opts' (MockChainReturn res outputs utxoState (MockChainJournal entries ((`addHashNames` opts') -> opts) noteBook _)) =
     PP.vsep $
       [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
         <> [prettyItemize opts "📔 Notes:" "-" (($ opts) <$> noteBook) | not (null noteBook)]
diff --git a/tests/Spec.hs b/tests/Spec.hs
index 5ef3a09d9..c2b9f1523 100644
--- a/tests/Spec.hs
+++ b/tests/Spec.hs
@@ -11,6 +11,7 @@ import Spec.ProposingScript qualified as ProposingScript
 import Spec.ReferenceInputs qualified as ReferenceInputs
 import Spec.ReferenceScripts qualified as ReferenceScripts
 import Spec.Slot qualified as Slot
+import Spec.StagedRun qualified as Staged
 import Spec.Tweak qualified as Tweak
 import Spec.Withdrawals qualified as Withdrawals
 import Test.Tasty
@@ -20,19 +21,20 @@ main =
   defaultMain $
     testGroup
       "cooked-validators"
-      [ Attack.tests,
-        Balancing.tests,
-        BasicUsage.tests,
-        Certificates.tests,
-        InititalDistribution.tests,
-        InlineDatums.tests,
-        Ltl.tests,
-        MinAda.tests,
-        MultiPurpose.tests,
-        ProposingScript.tests,
-        ReferenceInputs.tests,
-        ReferenceScripts.tests,
-        Slot.tests,
-        Tweak.tests,
-        Withdrawals.tests
+      [ -- Attack.tests,
+        -- Balancing.tests,
+        -- BasicUsage.tests,
+        -- Certificates.tests,
+        -- InititalDistribution.tests,
+        -- InlineDatums.tests,
+        -- Ltl.tests,
+        -- MinAda.tests,
+        -- MultiPurpose.tests,
+        -- ProposingScript.tests,
+        -- ReferenceInputs.tests,
+        -- ReferenceScripts.tests,
+        -- Slot.tests,
+        Staged.tests -- ,
+        -- Tweak.tests,
+        -- Withdrawals.tests
       ]
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
new file mode 100644
index 000000000..9f540fc43
--- /dev/null
+++ b/tests/Spec/StagedRun.hs
@@ -0,0 +1,67 @@
+module Spec.StagedRun where
+
+import Cooked
+import Optics.Core
+import Plutus.Script.Utils.V3.Generators
+import Plutus.Script.Utils.Value
+import PlutusLedgerApi.V3 qualified as Api
+import Test.Tasty (TestTree)
+
+stagedRun :: StagedMockChain ()
+stagedRun = do
+  -- Defining some aliases for wallets
+  alice <- define "alice" $ wallet 1
+  bob <- define "bob" $ wallet 2
+  carrie <- define "carrie" $ wallet 3
+  -- Defining some aliases for scripts
+  trueScript <- define "trueScript" $ trueMPScript @()
+  falseScript <- define "falseScript" $ falseMPScript @()
+  -- Defining some aliases for tokens
+  permanent <- define "permanent" $ Api.TokenName "permanent"
+  quick <- define "quick" $ Api.TokenName "quick"
+  -- Some values
+  let permanentValue = Value . review (valueAssetClassAmountP falseScript permanent)
+      quickValue = Value . review (valueAssetClassAmountP trueScript quick)
+  -- Providing an initial distribution of funds
+  outputs <-
+    forceOutputs $
+      replicate 4 (bob `receives` Value (ada 10))
+        ++ replicate 4 (carrie `receives` Value (ada 10))
+        ++ replicate 4 (alice `receives` Value (ada 10))
+        ++ [ alice `receives` permanentValue 3 <&&> InlineDatum (3 :: Integer),
+             alice `receives` permanentValue 5 <&&> HiddenHashedDatum (15 :: Integer),
+             alice `receives` quickValue 4,
+             alice `receives` quickValue 10 <&&> VisibleHashedDatum (25 :: Integer),
+             alice `receives` permanentValue 12 <&&> VisibleHashedDatum (10 :: Integer),
+             alice `receives` InlineDatum (20 :: Integer)
+           ]
+  -- Ensuring that "Alice" got 10 utxos out of the "forceOutputs" call
+  aliceUtxos <-
+    beginSearch (return outputs)
+      & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
+  assert' $ length aliceUtxos == 10
+  -- Ensuring that Alice has 2 utxos with quick values with the right amount
+  aliceQuickValueExtracts <-
+    getExtracts $
+      beginSearch (return outputs)
+        & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
+        . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
+  assert' $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [4, 10])
+  -- Ensuring the Alice has 2 utxos created with hashed datums with permanent
+  -- values, and retrieving the typed content of those datums.
+  aliceHashedDatums <-
+    getExtracts $
+      beginSearch (return outputs)
+        & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
+        . extractAFold (txSkelOutValueL % valueAssetClassAmountP falseScript permanent)
+        . extractAFold (txSkelOutDatumL % txSkelOutDatumKindAT % datumKindResolvedP)
+        . extractAFold (txSkelOutDatumL % txSkelOutDatumTypedAT @Integer)
+  assert' $
+    aliceHashedDatums
+      == [ HCons 5 (HCons NotResolved (HCons 15 HEmpty)),
+           HCons 12 (HCons Resolved (HCons 10 HEmpty))
+         ]
+  return ()
+
+tests :: TestTree
+tests = testCooked "Full staged run" $ mustSucceedTest stagedRun `withInitDist` InitialDistribution []

From e3ff2fac61faf377b2948467f57804bf01121ff4 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 29 Jan 2026 18:54:06 +0100
Subject: [PATCH 62/96] bye bye double nondet

---
 src/Cooked/MockChain/Instances.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 2bcb9fe4e..f74085244 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -71,7 +71,11 @@ instance RunnableMockChain DirectEffs where
 
 -- | A stack of effects aimed at being used as modifications for a
 -- `StagedMockChain` computation
-type StagedTweakEffs = '[MockChainRead, Fail, NonDet]
+type StagedTweakEffs =
+  '[ MockChainMisc,
+     MockChainRead,
+     Fail
+   ]
 
 -- | A tweak computation based on the `StagedTweakEffs` stack of effects
 type StagedTweak a = TypedTweak StagedTweakEffs a
@@ -113,7 +117,7 @@ instance RunnableMockChain StagedEffs where
            MockChainLog,
            Writer MockChainJournal
          ]
-      . reinterpretMockChainWriteWithTweak
+      . reinterpretMockChainWriteWithTweak @StagedTweakEffs
       . runModifyGlobally
       . insertAt @2
         @[ ModifyLocally (UntypedTweak StagedTweakEffs),
@@ -123,14 +127,14 @@ instance RunnableMockChain StagedEffs where
 -- | A stack of effects aimed at being used as modifications for a
 -- `FullMockChain` computation
 type FullTweakEffs =
-  '[ MockChainRead,
+  '[ MockChainMisc,
+     MockChainRead,
      Fail,
      Error Ledger.ToCardanoError,
      Error MockChainError,
      State MockChainState,
      MockChainLog,
-     Writer MockChainJournal,
-     NonDet
+     Writer MockChainJournal
    ]
 
 -- | A tweak computation based on the `FullTweakEffs` stack of effects
@@ -172,5 +176,5 @@ instance RunnableMockChain FullEffs where
       . evalState []
       . runModifyLocally
       . runMockChainWrite
-      . reinterpretMockChainWriteWithTweak
+      . reinterpretMockChainWriteWithTweak @FullTweakEffs
       . runModifyGlobally

From ce1664d462c7cc7f2c6bbb7e56cd0c2b264bb078 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 29 Jan 2026 22:51:29 +0100
Subject: [PATCH 63/96] bye InitialDistribution.hs

---
 cooked-validators.cabal           |  1 -
 src/Cooked.hs                     |  1 -
 src/Cooked/InitialDistribution.hs | 50 ---------------------------
 src/Cooked/MockChain/Runnable.hs  | 57 ++++++++++++++++++++++++++++---
 src/Cooked/MockChain/Testing.hs   |  1 -
 tests/Spec.hs                     | 32 ++++++++---------
 6 files changed, 69 insertions(+), 73 deletions(-)
 delete mode 100644 src/Cooked/InitialDistribution.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 9b8f421fa..1eb38e96a 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -18,7 +18,6 @@ library
       Cooked.Attack.DatumHijacking
       Cooked.Attack.DoubleSat
       Cooked.Families
-      Cooked.InitialDistribution
       Cooked.Ltl
       Cooked.MockChain
       Cooked.MockChain.AutoFilling
diff --git a/src/Cooked.hs b/src/Cooked.hs
index cba62ee67..bde37fdfb 100644
--- a/src/Cooked.hs
+++ b/src/Cooked.hs
@@ -4,7 +4,6 @@ module Cooked (module X) where
 
 import Cooked.Attack as X
 import Cooked.Families as X
-import Cooked.InitialDistribution as X
 import Cooked.Ltl as X
 import Cooked.MockChain as X
 import Cooked.Pretty as X
diff --git a/src/Cooked/InitialDistribution.hs b/src/Cooked/InitialDistribution.hs
deleted file mode 100644
index a3c058f0e..000000000
--- a/src/Cooked/InitialDistribution.hs
+++ /dev/null
@@ -1,50 +0,0 @@
--- | This module provides a convenient way to spread assets between wallets and
--- scripts at the initialization of the mock chain. These initial assets can be
--- accompanied by datums, staking credentials and reference scripts.
-module Cooked.InitialDistribution
-  ( InitialDistribution (..),
-    distributionFromList,
-  )
-where
-
-import Cooked.Skeleton
-import Cooked.Wallet
-import Data.Default
-import Data.List (foldl')
-import Plutus.Script.Utils.Value qualified as Script
-import PlutusLedgerApi.V3 qualified as Api
-
--- * Initial distribution of funds
-
--- | Describes the initial distribution of UTxOs per user.
---
---  The following specifies a starting state where @wallet 1@ owns two UTxOs,
---  one with 42 Ada and one with 2 Ada and one "TOK" token; @wallet 2@ owns a
---  single UTxO with 10 Ada and @wallet 3@ has 10 Ada and a permanent value
---
---  > i0 = distributionFromList $
---  >        [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
---  >        , (wallet 2 , [ ada 10 ])
---  >        , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
---  >        ]
---
--- Note that payment issued through an initial distribution will be attached
--- enough ADA to sustain themselves.
-data InitialDistribution where
-  InitialDistribution ::
-    {unInitialDistribution :: [TxSkelOut]} ->
-    InitialDistribution
-
--- | 4 UTxOs with 100 Ada each, for each of the first 4 'knownWallets'
-instance Default InitialDistribution where
-  def = distributionFromList . zip (take 4 knownWallets) . repeat . replicate 4 $ Script.ada 100
-
-instance Semigroup InitialDistribution where
-  i <> j = InitialDistribution (unInitialDistribution i <> unInitialDistribution j)
-
-instance Monoid InitialDistribution where
-  mempty = InitialDistribution mempty
-
--- | Creating a initial distribution with simple values assigned to owners
-distributionFromList :: (IsTxSkelOutAllowedOwner owner) => [(owner, [Api.Value])] -> InitialDistribution
-distributionFromList = InitialDistribution . foldl' (\x (user, values) -> x <> map (receives user . Value) values) []
diff --git a/src/Cooked/MockChain/Runnable.hs b/src/Cooked/MockChain/Runnable.hs
index 0ba318c63..7225dffbc 100644
--- a/src/Cooked/MockChain/Runnable.hs
+++ b/src/Cooked/MockChain/Runnable.hs
@@ -1,26 +1,73 @@
 -- | This module exposes the infrastructure to execute mockchain runs. In
 -- particular:
 --
+-- - The notion of initial distribution (a list of payments)
+--
 -- - The return types of the runs (raw and refined)
 --
 -- - The initial configuration with which to execute a run
 --
--- - The notion of `RunnableMockChain` to actually execution computations
+-- - The notion of `RunnableMockChain` to actually execute computations
 module Cooked.MockChain.Runnable where
 
-import Cooked.InitialDistribution
 import Cooked.MockChain.Error
 import Cooked.MockChain.Journal
 import Cooked.MockChain.State
 import Cooked.MockChain.Write
 import Cooked.Skeleton.Output
+import Cooked.Wallet
 import Data.Default
+import Data.List (foldl')
 import Data.Map (Map)
+import Plutus.Script.Utils.Value qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 
+-- * Initial distribution of funds
+
+-- | Describes the initial distribution of UTxOs per user.
+--
+--  The following specifies a starting state where @wallet 1@ owns two UTxOs,
+--  one with 42 Ada and one with 2 Ada and one "TOK" token; @wallet 2@ owns a
+--  single UTxO with 10 Ada and @wallet 3@ has 10 Ada and a permanent value
+--
+--  > i0 = distributionFromList $
+--  >        [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
+--  >        , (wallet 2 , [ ada 10 ])
+--  >        , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
+--  >        ]
+--
+-- Note that payment issued through an initial distribution will be attached
+-- enough ADA to sustain themselves.
+data InitialDistribution where
+  InitialDistribution ::
+    {unInitialDistribution :: [TxSkelOut]} ->
+    InitialDistribution
+
+-- | 4 UTxOs with 100 Ada each, for each of the first 4 'knownWallets'
+instance Default InitialDistribution where
+  def =
+    distributionFromList
+      . zip (take 4 knownWallets)
+      . repeat
+      . replicate 4
+      $ Script.ada 100
+
+instance Semigroup InitialDistribution where
+  i <> j = InitialDistribution (unInitialDistribution i <> unInitialDistribution j)
+
+instance Monoid InitialDistribution where
+  mempty = InitialDistribution mempty
+
+-- | Creating a initial distribution with simple values assigned to owners
+distributionFromList :: (IsTxSkelOutAllowedOwner owner) => [(owner, [Api.Value])] -> InitialDistribution
+distributionFromList =
+  InitialDistribution
+    . foldl' (\x (user, values) -> x <> map (receives user . Value) values) []
+
 -- | Raw return type of running a mockchain
-type RawMockChainReturn a = (MockChainJournal, (MockChainState, Either MockChainError a))
+type RawMockChainReturn a =
+  (MockChainJournal, (MockChainState, Either MockChainError a))
 
 -- | The returned type when running a mockchain. This is both a reorganizing and
 -- filtering of the natural returned type `RawMockChainReturn`.
@@ -79,7 +126,9 @@ runMockChainFromConf ::
   Sem effs a ->
   [b]
 runMockChainFromConf (MockChainConf initState initDist funOnResult) currentRun =
-  funOnResult <$> runMockChain initState (forceOutputs (unInitialDistribution initDist) >> currentRun)
+  fmap funOnResult $
+    runMockChain initState $
+      forceOutputs (unInitialDistribution initDist) >> currentRun
 
 -- | Runs a `RunnableMockChain` from an initial distribution
 runMockChainFromInitDist ::
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 781d17603..3e6ffe593 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -6,7 +6,6 @@ module Cooked.MockChain.Testing where
 
 import Control.Exception qualified as E
 import Control.Monad
-import Cooked.InitialDistribution
 import Cooked.MockChain.Error
 import Cooked.MockChain.Journal
 import Cooked.MockChain.Log
diff --git a/tests/Spec.hs b/tests/Spec.hs
index c2b9f1523..59a72ab31 100644
--- a/tests/Spec.hs
+++ b/tests/Spec.hs
@@ -21,20 +21,20 @@ main =
   defaultMain $
     testGroup
       "cooked-validators"
-      [ -- Attack.tests,
-        -- Balancing.tests,
-        -- BasicUsage.tests,
-        -- Certificates.tests,
-        -- InititalDistribution.tests,
-        -- InlineDatums.tests,
-        -- Ltl.tests,
-        -- MinAda.tests,
-        -- MultiPurpose.tests,
-        -- ProposingScript.tests,
-        -- ReferenceInputs.tests,
-        -- ReferenceScripts.tests,
-        -- Slot.tests,
-        Staged.tests -- ,
-        -- Tweak.tests,
-        -- Withdrawals.tests
+      [ Attack.tests,
+        Balancing.tests,
+        BasicUsage.tests,
+        Certificates.tests,
+        InititalDistribution.tests,
+        InlineDatums.tests,
+        Ltl.tests,
+        MinAda.tests,
+        MultiPurpose.tests,
+        ProposingScript.tests,
+        ReferenceInputs.tests,
+        ReferenceScripts.tests,
+        Slot.tests,
+        Staged.tests,
+        Tweak.tests,
+        Withdrawals.tests
       ]

From c3a5b8a20166e06aca520228f821c4f981e279c1 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sat, 31 Jan 2026 03:23:29 +0100
Subject: [PATCH 64/96] Inject + pretty

---
 src/Cooked/MockChain/Instances.hs | 71 ++++++++++++++++++++++++++++++-
 src/Cooked/MockChain/Misc.hs      | 12 ++++--
 src/Cooked/MockChain/Testing.hs   |  2 +-
 src/Cooked/Pretty/Class.hs        |  9 ++++
 src/Cooked/Pretty/MockChain.hs    | 14 +++---
 src/Cooked/Pretty/Options.hs      | 13 +++++-
 tests/Spec/StagedRun.hs           | 17 ++++++--
 tests/Spec/Tweak/TamperDatum.hs   |  4 --
 8 files changed, 120 insertions(+), 22 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index f74085244..4b06b1d9c 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
--- | This module exposes concrete instances to run a mockchain. There are 3 of
+-- | This module exposes concrete instances to run a mockchain. There are 4 of
 -- them :
 --
 -- - `DirectMockChain` exposes the minimal set of effects required to run a
@@ -13,6 +13,12 @@
 --   with the addition of branching and Ltl modifications using tweaks. This
 --   should be the environement to use in 99% of the cases.
 --
+-- - `StagedInjectMockChain` exposes the same primitives as `StagedMockChain`,
+--   with an additional custom effect that can both be used in the main thread
+--   and in the associated tweaks. This allows a mockchain run to depend on
+--   arbitrary additional effects (if multiple effects are needed, this single
+--   effect can be instantiated to a bundle).
+--
 -- - `FullMockChain` exposes all the effects used to process a mockchain run,
 --   including intermediate effects usually hidden. This should only be used
 --   when the users requires to manually execute internal primitives of cooked,
@@ -178,3 +184,66 @@ instance RunnableMockChain FullEffs where
       . runMockChainWrite
       . reinterpretMockChainWriteWithTweak @FullTweakEffs
       . runModifyGlobally
+
+-------------------------------------
+
+class Interpret eff where
+  runInterpret :: Sem (eff : effs) a -> Sem effs a
+
+-- | A stack of effects aimed at being used as modifications for a
+-- `StagedMockChain` computation
+type StagedInjectTweakEff injEff =
+  '[ injEff,
+     MockChainMisc,
+     MockChainRead,
+     Fail
+   ]
+
+-- | A tweak computation based on the `StagedInjectTweakEff` stack of effects
+type StagedInjectTweak injEff a = TypedTweak (StagedInjectTweakEff injEff) a
+
+-- | A stack of effects which allows everything allowed by `DirectEff` with the
+-- addition of branching and `Ltl` modification with tweaks living in
+-- `StagedInjectTweakEff`
+type StagedInjectEff injEff =
+  '[ ModifyGlobally (UntypedTweak (StagedInjectTweakEff injEff)),
+     MockChainWrite,
+     injEff,
+     MockChainMisc,
+     MockChainRead,
+     Fail,
+     NonDet
+   ]
+
+-- | A mockchain computation builds on top of the `StagedInjectEff` stack of effects
+type StagedInjectMockChain injEff a = Sem (StagedInjectEff injEff) a
+
+instance (Interpret injEff) => RunnableMockChain (StagedInjectEff injEff) where
+  runMockChain mcst =
+    run
+      . runNonDet
+      . runWriter
+      . runMockChainLog fromLogEntry
+      . runState mcst
+      . runError
+      . runToCardanoErrorInMockChainError
+      . runFailInMockChainError
+      . runMockChainRead
+      . runMockChainMisc fromAlias fromNote fromAssert
+      . runInterpret
+      . evalState []
+      . runModifyLocally
+      . runMockChainWrite
+      . insertAt @7
+        @[ Error Ledger.ToCardanoError,
+           Error MockChainError,
+           State MockChainState,
+           MockChainLog,
+           Writer MockChainJournal
+         ]
+      . reinterpretMockChainWriteWithTweak @(StagedInjectTweakEff injEff)
+      . runModifyGlobally
+      . insertAt @2
+        @[ ModifyLocally (UntypedTweak (StagedInjectTweakEff injEff)),
+           State [Ltl (UntypedTweak (StagedInjectTweakEff injEff))]
+         ]
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index 88b62f1cc..a7654396b 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -15,6 +15,7 @@ module Cooked.MockChain.Misc
     note,
     noteP,
     noteL,
+    noteW,
     noteS,
 
     -- * Asserting properties
@@ -61,7 +62,8 @@ define :: forall effs a. (Member MockChainMisc effs, ToHash a) => String -> a ->
 defineM :: (Member MockChainMisc effs, ToHash a) => String -> Sem effs a -> Sem effs a
 defineM name = (define name =<<)
 
--- | Takes note of a showable element to trace at the end of the run
+-- | Takes note of an element represented as its rendering function to trace at
+-- the end of the run
 note :: forall effs. (Member MockChainMisc effs) => (PrettyCookedOpts -> DocCooked) -> Sem effs ()
 
 -- | Takes note of a pretty-printable element to trace at the end of the run
@@ -74,8 +76,12 @@ noteL :: forall effs l. (Member MockChainMisc effs, PrettyCookedList l) => Strin
 noteL title docs = note $ \opts -> prettyItemize opts (prettyCooked title) "-" docs
 
 -- | Takes note of a showable element to trace at the end of the run
-noteS :: forall effs s. (Member MockChainMisc effs, Show s) => s -> Sem effs ()
-noteS doc = note $ const (PP.viaShow doc)
+noteW :: forall effs s. (Member MockChainMisc effs, Show s) => s -> Sem effs ()
+noteW = note . const . PP.viaShow
+
+-- | Takes note of a String to trace at the end of the run
+noteS :: forall effs. (Member MockChainMisc effs) => String -> Sem effs ()
+noteS = noteP
 
 -- | Ensures a specific property holds, sending the provided error message otherwise
 assert :: forall effs. (Member MockChainMisc effs) => String -> Bool -> Sem effs ()
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 3e6ffe593..8fed0b24c 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -206,7 +206,7 @@ data Test effs a prop = Test
     -- | The property that should hold in case of success over the returned
     -- result and the final state of the trace, as well as the logs
     testSuccessProp :: SuccessProp a prop,
-    -- | The printing option that should be use to render test results
+    -- | The printing options that should be use to render the test results
     testPrettyOpts :: PrettyCookedOpts
   }
 
diff --git a/src/Cooked/Pretty/Class.hs b/src/Cooked/Pretty/Class.hs
index 9072b780d..ab8d810d8 100644
--- a/src/Cooked/Pretty/Class.hs
+++ b/src/Cooked/Pretty/Class.hs
@@ -190,8 +190,17 @@ instance PrettyCooked Text where
 instance PrettyCooked String where
   prettyCookedOpt _ = PP.pretty
 
+instance PrettyCooked (HList '[]) where
+  prettyCookedOpt _ HEmpty = "[]"
+
 instance PrettyCookedList (HList '[]) where
   prettyCookedOptList _ HEmpty = []
 
+instance (PrettyCooked a, PrettyCooked (HList l)) => PrettyCooked (HList (a ': l)) where
+  prettyCookedOpt opts (HCons h t) = prettyCookedOpt opts h <+> ":" <+> prettyCookedOpt opts t
+
 instance (PrettyCooked a, PrettyCookedList (HList l)) => PrettyCookedList (HList (a ': l)) where
   prettyCookedOptList opts (HCons h t) = prettyCookedOpt opts h : prettyCookedOptList opts t
+
+instance (PrettyCooked a, PrettyCooked b) => PrettyCooked (a, b) where
+  prettyCookedOpt opts (a, b) = "(" <+> prettyCookedOpt opts a <+> "," <+> prettyCookedOpt opts b <+> ")"
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index cc5af7e57..3d86bfadb 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -40,14 +40,16 @@ instance (Show a) => PrettyCooked [MockChainReturn a] where
           (PP.align . prettyCookedOpt opts <$> outcomes)
 
 instance (Show a) => PrettyCooked (MockChainReturn a) where
-  prettyCookedOpt opts' (MockChainReturn res outputs utxoState (MockChainJournal entries ((`addHashNames` opts') -> opts) noteBook _)) =
+  prettyCookedOpt opts' (MockChainReturn res outputs (UtxoState available consumed) (MockChainJournal entries ((`addHashNames` opts') -> opts) noteBook _)) =
     PP.vsep $
-      [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
-        <> [prettyItemize opts "📔 Notes:" "-" (($ opts) <$> noteBook) | not (null noteBook)]
-        <> prettyCookedOptList opts utxoState
+      [prettyItemize opts "📔 Notes:" "-" (($ opts) <$> noteBook) | pcOptPrintNotebook opts && not (null noteBook)]
+        <> [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
+        <> ["💰" <+> prettyCookedOpt opts available | pcOptPrintRemainingUTxOs opts]
+        <> ["🗑️" <+> prettyCookedOpt opts consumed | pcOptPrintConsumedUTxOs opts]
         <> [ case res of
                Left err -> "🔴 Error:" <+> prettyCookedOpt opts err
                Right a -> "🟢 Returned value:" <+> PP.viaShow a
+           | pcOptPrintReturnedValue opts
            ]
 
 instance PrettyCooked Peer where
@@ -174,10 +176,6 @@ instance PrettyCooked (Contextualized MockChainLogEntry) where
   prettyCookedOpt opts (Contextualized _ (MCLogAutoFilledConstitution constitution)) =
     "New auto-filled constitution:" <+> prettyHash opts constitution
 
-instance PrettyCookedList UtxoState where
-  prettyCookedOptList opts (UtxoState available consumed) =
-    "✅" <+> prettyCookedOpt opts available : ["❎" <+> prettyCookedOpt opts consumed | pcOptPrintConsumedUTxOs opts]
-
 -- | Pretty print a 'UtxoState'. Print the known wallets first, then unknown
 -- pubkeys, then scripts.
 instance PrettyCooked (Map Api.Address UtxoPayloadSet) where
diff --git a/src/Cooked/Pretty/Options.hs b/src/Cooked/Pretty/Options.hs
index 98bd59172..fa27369fd 100644
--- a/src/Cooked/Pretty/Options.hs
+++ b/src/Cooked/Pretty/Options.hs
@@ -39,7 +39,13 @@ data PrettyCookedOpts = PrettyCookedOpts
     pcOptHashes :: PrettyCookedHashOpts,
     -- | Whether to display the log
     pcOptPrintLog :: Bool,
-    -- | Whether to display consumed UTxOs in the end state. Default: False
+    -- | Whether to display the notebook
+    pcOptPrintNotebook :: Bool,
+    -- | Whether to display the remaining utxos
+    pcOptPrintRemainingUTxOs :: Bool,
+    -- | Whether to display the return value
+    pcOptPrintReturnedValue :: Bool,
+    -- | Whether to display the consumed utxos
     pcOptPrintConsumedUTxOs :: Bool
   }
   deriving (Eq, Show)
@@ -53,6 +59,9 @@ instance Default PrettyCookedOpts where
         pcOptNumericUnderscores = True,
         pcOptHashes = def,
         pcOptPrintLog = True,
+        pcOptPrintNotebook = True,
+        pcOptPrintRemainingUTxOs = True,
+        pcOptPrintReturnedValue = True,
         pcOptPrintConsumedUTxOs = False
       }
 
@@ -127,5 +136,5 @@ hashNamesFromList = Map.fromList . map (first toHash)
 -- mockchain runs, such as for names that depend on on-chain data, typically a
 -- 'Api.TxOutRef'.
 addHashNames :: Map Api.BuiltinByteString String -> PrettyCookedOpts -> PrettyCookedOpts
-addHashNames names opts'@(PrettyCookedOpts _ _ _ _ hashOpts _ _) =
+addHashNames names opts'@(pcOptHashes -> hashOpts) =
   opts' {pcOptHashes = hashOpts {pcOptHashNames = Map.union names (pcOptHashNames hashOpts)}}
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index 9f540fc43..c9568c41c 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -1,13 +1,21 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Spec.StagedRun where
 
+import Control.Monad
 import Cooked
 import Optics.Core
 import Plutus.Script.Utils.V3.Generators
 import Plutus.Script.Utils.Value
 import PlutusLedgerApi.V3 qualified as Api
+import Polysemy.Bundle
+import Polysemy.State
 import Test.Tasty (TestTree)
 
-stagedRun :: StagedMockChain ()
+instance Interpret (Bundle '[State Integer]) where
+  runInterpret = evalState 0 . runBundle
+
+stagedRun :: StagedInjectMockChain (Bundle '[State Integer]) Integer
 stagedRun = do
   -- Defining some aliases for wallets
   alice <- define "alice" $ wallet 1
@@ -35,11 +43,13 @@ stagedRun = do
              alice `receives` permanentValue 12 <&&> VisibleHashedDatum (10 :: Integer),
              alice `receives` InlineDatum (20 :: Integer)
            ]
+  noteS "We have given a few assets to Alice, Bob and Carry to begin the run"
   -- Ensuring that "Alice" got 10 utxos out of the "forceOutputs" call
   aliceUtxos <-
     beginSearch (return outputs)
       & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
   assert' $ length aliceUtxos == 10
+  forM_ (zip [(1 :: Integer) ..] aliceUtxos) $ \(i, (_, output)) -> noteL ("Alice UTxO number " <> show i) output
   -- Ensuring that Alice has 2 utxos with quick values with the right amount
   aliceQuickValueExtracts <-
     getExtracts $
@@ -47,7 +57,7 @@ stagedRun = do
         & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
         . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
   assert' $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [4, 10])
-  -- Ensuring the Alice has 2 utxos created with hashed datums with permanent
+  -- Ensuring that Alice has 2 utxos created with hashed datums with permanent
   -- values, and retrieving the typed content of those datums.
   aliceHashedDatums <-
     getExtracts $
@@ -61,7 +71,8 @@ stagedRun = do
       == [ HCons 5 (HCons NotResolved (HCons 15 HEmpty)),
            HCons 12 (HCons Resolved (HCons 10 HEmpty))
          ]
-  return ()
+  mplus (sendBundle $ put 10) (sendBundle $ put 20)
+  sendBundle get
 
 tests :: TestTree
 tests = testCooked "Full staged run" $ mustSucceedTest stagedRun `withInitDist` InitialDistribution []
diff --git a/tests/Spec/Tweak/TamperDatum.hs b/tests/Spec/Tweak/TamperDatum.hs
index 23676929a..5ea8df4d4 100644
--- a/tests/Spec/Tweak/TamperDatum.hs
+++ b/tests/Spec/Tweak/TamperDatum.hs
@@ -10,13 +10,9 @@ import Plutus.Script.Utils.Value qualified as Script
 import PlutusTx qualified
 import Polysemy
 import Polysemy.NonDet
-import Prettyprinter (viaShow)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@=?))
 
-instance PrettyCooked (Integer, Integer) where
-  prettyCookedOpt _ = viaShow
-
 alice :: Wallet
 alice = wallet 1
 

From 447600af9ec5c78b5d42c9300d7da90bb34b860a Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 2 Feb 2026 13:04:50 +0100
Subject: [PATCH 65/96] improving Staged instance

---
 src/Cooked/MockChain/Instances.hs | 64 +++++++------------------------
 src/Cooked/Pretty/MockChain.hs    |  6 +--
 2 files changed, 17 insertions(+), 53 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 4b06b1d9c..5cc054e59 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -37,6 +37,7 @@ import Cooked.MockChain.Tweak
 import Cooked.MockChain.Write
 import Ledger.Tx qualified as Ledger
 import Polysemy
+import Polysemy.Bundle
 import Polysemy.Error
 import Polysemy.Fail
 import Polysemy.NonDet
@@ -77,11 +78,7 @@ instance RunnableMockChain DirectEffs where
 
 -- | A stack of effects aimed at being used as modifications for a
 -- `StagedMockChain` computation
-type StagedTweakEffs =
-  '[ MockChainMisc,
-     MockChainRead,
-     Fail
-   ]
+type StagedTweakEffs = StagedInjectTweakEffs (Bundle '[])
 
 -- | A tweak computation based on the `StagedTweakEffs` stack of effects
 type StagedTweak a = TypedTweak StagedTweakEffs a
@@ -89,46 +86,13 @@ type StagedTweak a = TypedTweak StagedTweakEffs a
 -- | A stack of effects which allows everything allowed by `DirectEffs` with the
 -- addition of branching and `Ltl` modification with tweaks living in
 -- `StagedTweakEffs`
-type StagedEffs =
-  '[ ModifyGlobally (UntypedTweak StagedTweakEffs),
-     MockChainWrite,
-     MockChainMisc,
-     MockChainRead,
-     Fail,
-     NonDet
-   ]
+type StagedEffs = StagedInjectEffs (Bundle '[])
 
 -- | A mockchain computation builds on top of the `StagedEffs` stack of effects
 type StagedMockChain a = Sem StagedEffs a
 
-instance RunnableMockChain StagedEffs where
-  runMockChain mcst =
-    run
-      . runNonDet
-      . runWriter
-      . runMockChainLog fromLogEntry
-      . runState mcst
-      . runError
-      . runToCardanoErrorInMockChainError
-      . runFailInMockChainError
-      . runMockChainRead
-      . runMockChainMisc fromAlias fromNote fromAssert
-      . evalState []
-      . runModifyLocally
-      . runMockChainWrite
-      . insertAt @6
-        @[ Error Ledger.ToCardanoError,
-           Error MockChainError,
-           State MockChainState,
-           MockChainLog,
-           Writer MockChainJournal
-         ]
-      . reinterpretMockChainWriteWithTweak @StagedTweakEffs
-      . runModifyGlobally
-      . insertAt @2
-        @[ ModifyLocally (UntypedTweak StagedTweakEffs),
-           State [Ltl (UntypedTweak StagedTweakEffs)]
-         ]
+instance Interpret (Bundle '[]) where
+  runInterpret = runBundle
 
 -- | A stack of effects aimed at being used as modifications for a
 -- `FullMockChain` computation
@@ -192,7 +156,7 @@ class Interpret eff where
 
 -- | A stack of effects aimed at being used as modifications for a
 -- `StagedMockChain` computation
-type StagedInjectTweakEff injEff =
+type StagedInjectTweakEffs injEff =
   '[ injEff,
      MockChainMisc,
      MockChainRead,
@@ -200,13 +164,13 @@ type StagedInjectTweakEff injEff =
    ]
 
 -- | A tweak computation based on the `StagedInjectTweakEff` stack of effects
-type StagedInjectTweak injEff a = TypedTweak (StagedInjectTweakEff injEff) a
+type StagedInjectTweak injEff a = TypedTweak (StagedInjectTweakEffs injEff) a
 
 -- | A stack of effects which allows everything allowed by `DirectEff` with the
 -- addition of branching and `Ltl` modification with tweaks living in
 -- `StagedInjectTweakEff`
-type StagedInjectEff injEff =
-  '[ ModifyGlobally (UntypedTweak (StagedInjectTweakEff injEff)),
+type StagedInjectEffs injEff =
+  '[ ModifyGlobally (UntypedTweak (StagedInjectTweakEffs injEff)),
      MockChainWrite,
      injEff,
      MockChainMisc,
@@ -216,9 +180,9 @@ type StagedInjectEff injEff =
    ]
 
 -- | A mockchain computation builds on top of the `StagedInjectEff` stack of effects
-type StagedInjectMockChain injEff a = Sem (StagedInjectEff injEff) a
+type StagedInjectMockChain injEff a = Sem (StagedInjectEffs injEff) a
 
-instance (Interpret injEff) => RunnableMockChain (StagedInjectEff injEff) where
+instance (Interpret injEff) => RunnableMockChain (StagedInjectEffs injEff) where
   runMockChain mcst =
     run
       . runNonDet
@@ -241,9 +205,9 @@ instance (Interpret injEff) => RunnableMockChain (StagedInjectEff injEff) where
            MockChainLog,
            Writer MockChainJournal
          ]
-      . reinterpretMockChainWriteWithTweak @(StagedInjectTweakEff injEff)
+      . reinterpretMockChainWriteWithTweak @(StagedInjectTweakEffs injEff)
       . runModifyGlobally
       . insertAt @2
-        @[ ModifyLocally (UntypedTweak (StagedInjectTweakEff injEff)),
-           State [Ltl (UntypedTweak (StagedInjectTweakEff injEff))]
+        @[ ModifyLocally (UntypedTweak (StagedInjectTweakEffs injEff)),
+           State [Ltl (UntypedTweak (StagedInjectTweakEffs injEff))]
          ]
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 3d86bfadb..658f90e44 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -44,11 +44,11 @@ instance (Show a) => PrettyCooked (MockChainReturn a) where
     PP.vsep $
       [prettyItemize opts "📔 Notes:" "-" (($ opts) <$> noteBook) | pcOptPrintNotebook opts && not (null noteBook)]
         <> [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
-        <> ["💰" <+> prettyCookedOpt opts available | pcOptPrintRemainingUTxOs opts]
-        <> ["🗑️" <+> prettyCookedOpt opts consumed | pcOptPrintConsumedUTxOs opts]
+        <> ["💰" <+> prettyCookedOpt opts available | pcOptPrintRemainingUTxOs opts && not (null available)]
+        <> ["🗑️" <+> prettyCookedOpt opts consumed | pcOptPrintConsumedUTxOs opts && not (null consumed)]
         <> [ case res of
                Left err -> "🔴 Error:" <+> prettyCookedOpt opts err
-               Right a -> "🟢 Returned value:" <+> PP.viaShow a
+               Right a -> "🟢 Success with returned value:" <+> PP.viaShow a
            | pcOptPrintReturnedValue opts
            ]
 

From 1ff0fced91bb2686a2241f9adba49524d44d231b Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Mon, 2 Feb 2026 22:57:04 +0100
Subject: [PATCH 66/96] more generic testing framework

---
 src/Cooked/MockChain/Instances.hs |  38 ++-
 src/Cooked/MockChain/Testing.hs   | 488 ++++++++++++++++++++++++------
 2 files changed, 409 insertions(+), 117 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 5cc054e59..10e8a5063 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -76,24 +76,6 @@ instance RunnableMockChain DirectEffs where
            Writer MockChainJournal
          ]
 
--- | A stack of effects aimed at being used as modifications for a
--- `StagedMockChain` computation
-type StagedTweakEffs = StagedInjectTweakEffs (Bundle '[])
-
--- | A tweak computation based on the `StagedTweakEffs` stack of effects
-type StagedTweak a = TypedTweak StagedTweakEffs a
-
--- | A stack of effects which allows everything allowed by `DirectEffs` with the
--- addition of branching and `Ltl` modification with tweaks living in
--- `StagedTweakEffs`
-type StagedEffs = StagedInjectEffs (Bundle '[])
-
--- | A mockchain computation builds on top of the `StagedEffs` stack of effects
-type StagedMockChain a = Sem StagedEffs a
-
-instance Interpret (Bundle '[]) where
-  runInterpret = runBundle
-
 -- | A stack of effects aimed at being used as modifications for a
 -- `FullMockChain` computation
 type FullTweakEffs =
@@ -149,8 +131,6 @@ instance RunnableMockChain FullEffs where
       . reinterpretMockChainWriteWithTweak @FullTweakEffs
       . runModifyGlobally
 
--------------------------------------
-
 class Interpret eff where
   runInterpret :: Sem (eff : effs) a -> Sem effs a
 
@@ -211,3 +191,21 @@ instance (Interpret injEff) => RunnableMockChain (StagedInjectEffs injEff) where
         @[ ModifyLocally (UntypedTweak (StagedInjectTweakEffs injEff)),
            State [Ltl (UntypedTweak (StagedInjectTweakEffs injEff))]
          ]
+
+-- | A stack of effects aimed at being used as modifications for a
+-- `StagedMockChain` computation
+type StagedTweakEffs = StagedInjectTweakEffs (Bundle '[])
+
+-- | A tweak computation based on the `StagedTweakEffs` stack of effects
+type StagedTweak a = TypedTweak StagedTweakEffs a
+
+-- | A stack of effects which allows everything allowed by `DirectEffs` with the
+-- addition of branching and `Ltl` modification with tweaks living in
+-- `StagedTweakEffs`
+type StagedEffs = StagedInjectEffs (Bundle '[])
+
+-- | A mockchain computation builds on top of the `StagedEffs` stack of effects
+type StagedMockChain a = Sem StagedEffs a
+
+instance Interpret (Bundle '[]) where
+  runInterpret = runBundle
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 8fed0b24c..e36a2c98a 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -90,7 +90,9 @@ infixr 2 .||.
 a .||. b = testDisjoin [a, b]
 
 -- | Catches a HUnit test failure, if the test fails.
-assertionToMaybe :: HU.Assertion -> IO (Maybe HU.HUnitFailure)
+assertionToMaybe ::
+  HU.Assertion ->
+  IO (Maybe HU.HUnitFailure)
 assertionToMaybe = flip E.catches [E.Handler $ return . Just] . (>> return Nothing)
 
 -- | HUnit instance of 'IsProp'
@@ -124,13 +126,23 @@ instance IsProp QC.Property where
 
 -- | Here we provide our own universsal quantifier instead of 'QC.forAll', so we
 --  can monomorphize it to returning a 'QC.Property'
-forAll :: (Show a) => QC.Gen a -> (a -> QC.Property) -> QC.Property
+forAll ::
+  (Show a) =>
+  QC.Gen a ->
+  (a -> QC.Property) ->
+  QC.Property
 forAll = QC.forAll
 
 -- * Extra HUnit assertions
 
 -- | Asserts whether a set is a subset of another one, both given as lists.
-assertSubset :: (Show a, Eq a) => [a] -> [a] -> HU.Assertion
+assertSubset ::
+  ( Show a,
+    Eq a
+  ) =>
+  [a] ->
+  [a] ->
+  HU.Assertion
 assertSubset l r =
   testConjoin
     ( map
@@ -147,7 +159,13 @@ assertSubset l r =
     )
 
 -- | Asserts whether 2 sets are equal, both given as lists.
-assertSameSets :: (Show a, Eq a) => [a] -> [a] -> HU.Assertion
+assertSameSets ::
+  ( Show a,
+    Eq a
+  ) =>
+  [a] ->
+  [a] ->
+  HU.Assertion
 assertSameSets l r =
   HU.assertBool
     ("expected lists of the same length, got " ++ show (length l) ++ " and " ++ show (length r))
@@ -190,12 +208,19 @@ type LogProp prop = PrettyCookedOpts -> [MockChainLogEntry] -> prop
 -- | Type of properties over the 'UtxoState'
 type StateProp prop = PrettyCookedOpts -> UtxoState -> prop
 
+-- | Type of trace runners
+type Runner effs a b = MockChainState -> InitialDistribution -> Sem effs a -> [MockChainReturn b]
+
 -- | Data structure to test a mockchain trace. @a@ is the return typed of the
 -- tested trace, @prop@ is the domain in which the properties live. This is not
 -- enforced here, but it will often be assumed that @prop@ satisfies 'IsProp'.
-data Test effs a prop = Test
+data Test effs a b prop = Test
   { -- | The mockchain trace to test, which returns a result of type a
     testTrace :: Sem effs a,
+    -- | The runner of the trace, possibly changing the return type
+    testRunner :: Runner effs a b,
+    -- | The initial state from which the trace should be run
+    testInitState :: MockChainState,
     -- | The initial distribution from which the trace should be run
     testInitDist :: InitialDistribution,
     -- | The requirement on the number of results
@@ -205,7 +230,7 @@ data Test effs a prop = Test
     testFailureProp :: FailureProp prop,
     -- | The property that should hold in case of success over the returned
     -- result and the final state of the trace, as well as the logs
-    testSuccessProp :: SuccessProp a prop,
+    testSuccessProp :: SuccessProp b prop,
     -- | The printing options that should be use to render the test results
     testPrettyOpts :: PrettyCookedOpts
   }
@@ -218,14 +243,12 @@ data Test effs a prop = Test
 -- to pretty print messages when applicable.
 testToProp ::
   ( IsProp prop,
-    Show a,
-    Member MockChainWrite effs,
-    RunnableMockChain effs
+    Show b
   ) =>
-  Test effs a prop ->
+  Test effs a b prop ->
   prop
 testToProp Test {..} =
-  let results = runMockChainFromConf (mockChainConfTemplate {mccInitialDistribution = testInitDist}) testTrace
+  let results = testRunner testInitState testInitDist testTrace
    in testSizeProp (toInteger (length results))
         .&&. testAll
           ( \ret@(MockChainReturn outcome _ state (MockChainJournal mcLog names _ assertions)) ->
@@ -246,35 +269,39 @@ testToProp Test {..} =
 -- Sadly we cannot generalise it with type classes on @prop@ to work for
 -- QuichCheck at GHC will never be able to instantiate @prop@.
 testCooked ::
-  forall effs a.
-  ( Show a,
-    Member MockChainWrite effs,
-    RunnableMockChain effs
-  ) =>
+  forall effs a b.
+  (Show b) =>
   String ->
-  Test effs a HU.Assertion ->
+  Test effs a b HU.Assertion ->
   HU.TestTree
 testCooked name = HU.testCase name . testToProp
 
 -- | Same as 'testCooked', but for 'QC.Property'
 testCookedQC ::
-  forall effs a.
-  ( Show a,
-    Member MockChainWrite effs,
-    RunnableMockChain effs
-  ) =>
+  forall effs a b.
+  (Show b) =>
   String ->
-  Test effs a QC.Property ->
+  Test effs a b QC.Property ->
   HU.TestTree
 testCookedQC name = QC.testProperty name . testToProp
 
 -- * Simple test templates
 
--- | A test template which expects a success from a trace
-mustSucceedTest :: (IsProp prop) => Sem effs a -> Test effs a prop
-mustSucceedTest trace =
+-- | A test template which expects a success from a trace. This test template is
+-- built from a trace and a dedicated runner, to be used for runs that do not
+-- implement `RunnableMockChain`. One of the intended uses is for running
+-- `StagedInjectMockChain` when the additional effect results in a extended
+-- return value (such as a resulting state).
+mustSucceedTest' ::
+  (IsProp prop) =>
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustSucceedTest' runner trace =
   Test
     { testTrace = trace,
+      testRunner = runner,
+      testInitState = def,
       testInitDist = def,
       testSizeProp = isAtLeastOfSize 1,
       testFailureProp = \_ _ _ _ -> testFailureMsg "💀 Unexpected failure!",
@@ -282,11 +309,29 @@ mustSucceedTest trace =
       testPrettyOpts = def
     }
 
--- | A test template which expects a failure from a trace
-mustFailTest :: (IsProp prop) => Sem effs a -> Test effs a prop
-mustFailTest trace =
+-- | A test template which expects a success from a `RunnableMockChain` trace.
+mustSucceedTest ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  Test effs a a prop
+mustSucceedTest = mustSucceedTest' $ \initState initDist ->
+  runMockChainFromConf $ MockChainConf initState initDist unRawMockChainReturn
+
+-- | A test template which expects a failure from a trace. See
+-- `mustSucceedTest'` for more information on its intended usage.
+mustFailTest' ::
+  (IsProp prop) =>
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustFailTest' runner trace =
   Test
     { testTrace = trace,
+      testRunner = runner,
+      testInitState = def,
       testInitDist = def,
       testSizeProp = const testSuccess,
       testFailureProp = \_ _ _ _ -> testSuccess,
@@ -294,48 +339,90 @@ mustFailTest trace =
       testPrettyOpts = def
     }
 
+-- | A test template which expects a failure from a `RunnableMockChain` trace.
+mustFailTest ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  Test effs a a prop
+mustFailTest = mustFailTest' $ \initState initDist ->
+  runMockChainFromConf $ MockChainConf initState initDist unRawMockChainReturn
+
 -- * Appending elements (in particular requirements) to existing tests
 
 -- | Gives an initial distribution from which the trace will be run
-withInitDist :: Test effs a prop -> InitialDistribution -> Test effs a prop
+withInitDist ::
+  Test effs a b prop ->
+  InitialDistribution ->
+  Test effs a b prop
 withInitDist test initDist = test {testInitDist = initDist}
 
 -- | Gives some pretty options to render test messages
-withPrettyOpts :: Test effs a prop -> PrettyCookedOpts -> Test effs a prop
+withPrettyOpts ::
+  Test effs a b prop ->
+  PrettyCookedOpts ->
+  Test effs a b prop
 withPrettyOpts test opts = test {testPrettyOpts = opts}
 
 -- | Appends a requirements over the emitted log, which will need to be satisfied
 -- both in case of success or failure of the run.
-withLogProp :: (IsProp prop) => Test effs a prop -> LogProp prop -> Test effs a prop
+withLogProp ::
+  (IsProp prop) =>
+  Test effs a b prop ->
+  LogProp prop ->
+  Test effs a b prop
 withLogProp test logProp =
   test
-    { testFailureProp = \opts log err state -> testFailureProp test opts log err state .&&. logProp opts log,
-      testSuccessProp = \opts log val state -> testSuccessProp test opts log val state .&&. logProp opts log
+    { testFailureProp = \opts log err state ->
+        testFailureProp test opts log err state .&&. logProp opts log,
+      testSuccessProp = \opts log val state ->
+        testSuccessProp test opts log val state .&&. logProp opts log
     }
 
 -- | Appends a requirements over the resulting 'UtxoState', which will need to
 -- be satisfied both in case of success or failure of the run.
-withStateProp :: (IsProp prop) => Test effs a prop -> StateProp prop -> Test effs a prop
+withStateProp ::
+  (IsProp prop) =>
+  Test effs a b prop ->
+  StateProp prop ->
+  Test effs a b prop
 withStateProp test stateProp =
   test
-    { testFailureProp = \opts log err state -> testFailureProp test opts log err state .&&. stateProp opts state,
-      testSuccessProp = \opts log val state -> testSuccessProp test opts log val state .&&. stateProp opts state
+    { testFailureProp = \opts log err state ->
+        testFailureProp test opts log err state .&&. stateProp opts state,
+      testSuccessProp = \opts log val state ->
+        testSuccessProp test opts log val state .&&. stateProp opts state
     }
 
 -- | Appends a requirement over the resulting value and state of the mockchain
 -- run which will need to be satisfied if the run is successful
-withSuccessProp :: (IsProp prop) => Test effs a prop -> SuccessProp a prop -> Test effs a prop
+withSuccessProp ::
+  (IsProp prop) =>
+  Test effs a b prop ->
+  SuccessProp b prop ->
+  Test effs a b prop
 withSuccessProp test successProp =
   test
-    { testSuccessProp = \opts log val state -> testSuccessProp test opts log val state .&&. successProp opts log val state
+    { testSuccessProp = \opts log val state ->
+        testSuccessProp test opts log val state .&&. successProp opts log val state
     }
 
 -- | Same as 'withSuccessProp' but only considers the returning value of the run
-withResultProp :: (IsProp prop) => Test effs a prop -> (a -> prop) -> Test effs a prop
+withResultProp ::
+  (IsProp prop) =>
+  Test effs a b prop ->
+  (b -> prop) ->
+  Test effs a b prop
 withResultProp test p = withSuccessProp test (\_ _ res _ -> p res)
 
 -- | Appends a requirement over the resulting number of outcomes of the run
-withSizeProp :: (IsProp prop) => Test effs a prop -> SizeProp prop -> Test effs a prop
+withSizeProp ::
+  (IsProp prop) =>
+  Test effs a b prop ->
+  SizeProp prop ->
+  Test effs a b prop
 withSizeProp test reqSize =
   test
     { testSizeProp = \size -> testSizeProp test size .&&. reqSize size
@@ -343,92 +430,188 @@ withSizeProp test reqSize =
 
 -- | Appends a requirement over the resulting value and state of the mockchain
 -- run which will need to be satisfied if the run is successful
-withFailureProp :: (IsProp prop) => Test effs a prop -> FailureProp prop -> Test effs a prop
-withFailureProp test failureProp = test {testFailureProp = \opts log err state -> testFailureProp test opts log err state .&&. failureProp opts log err state}
+withFailureProp ::
+  (IsProp prop) =>
+  Test effs a b prop ->
+  FailureProp prop ->
+  Test effs a b prop
+withFailureProp test failureProp =
+  test
+    { testFailureProp = \opts log err state ->
+        testFailureProp test opts log err state .&&. failureProp opts log err state
+    }
 
 -- | Same as 'withFailureProp' but only considers the returning error of the run
-withErrorProp :: (IsProp prop) => Test effs a prop -> (MockChainError -> prop) -> Test effs a prop
+withErrorProp ::
+  (IsProp prop) =>
+  Test effs a b prop ->
+  (MockChainError -> prop) ->
+  Test effs a b prop
 withErrorProp test errorProp = withFailureProp test (\_ _ err _ -> errorProp err)
 
 -- * Specific properties around failures
 
 -- | A property to ensure a phase 1 failure
-isPhase1Failure :: (IsProp prop) => FailureProp prop
+isPhase1Failure ::
+  (IsProp prop) =>
+  FailureProp prop
 isPhase1Failure _ _ (MCEValidationError Ledger.Phase1 _) _ = testSuccess
-isPhase1Failure pcOpts _ e _ = testFailureMsg $ "Expected phase 1 evaluation failure, got: " ++ renderString (prettyCookedOpt pcOpts) e
+isPhase1Failure pcOpts _ e _ =
+  testFailureMsg $
+    "Expected phase 1 evaluation failure, got: "
+      ++ renderString (prettyCookedOpt pcOpts) e
 
 -- | A property to ensure a phase 2 failure
-isPhase2Failure :: (IsProp prop) => FailureProp prop
+isPhase2Failure ::
+  (IsProp prop) =>
+  FailureProp prop
 isPhase2Failure _ _ (MCEValidationError Ledger.Phase2 _) _ = testSuccess
-isPhase2Failure pcOpts _ e _ = testFailureMsg $ "Expected phase 2 evaluation failure, got: " ++ renderString (prettyCookedOpt pcOpts) e
+isPhase2Failure pcOpts _ e _ =
+  testFailureMsg $
+    "Expected phase 2 evaluation failure, got: "
+      ++ renderString (prettyCookedOpt pcOpts) e
 
 -- | Same as 'isPhase1Failure' with an added predicate on the text error
-isPhase1FailureWithMsg :: (IsProp prop) => String -> FailureProp prop
-isPhase1FailureWithMsg s _ _ (MCEValidationError Ledger.Phase1 (Ledger.CardanoLedgerValidationError text)) _ | s `isInfixOf` T.unpack text = testSuccess
-isPhase1FailureWithMsg _ pcOpts _ e _ = testFailureMsg $ "Expected phase 1 evaluation failure with constrained messages, got: " ++ renderString (prettyCookedOpt pcOpts) e
+isPhase1FailureWithMsg ::
+  (IsProp prop) =>
+  String ->
+  FailureProp prop
+isPhase1FailureWithMsg s _ _ (MCEValidationError Ledger.Phase1 (Ledger.CardanoLedgerValidationError text)) _
+  | s `isInfixOf` T.unpack text =
+      testSuccess
+isPhase1FailureWithMsg _ pcOpts _ e _ =
+  testFailureMsg $
+    "Expected phase 1 evaluation failure with constrained messages, got: "
+      ++ renderString (prettyCookedOpt pcOpts) e
 
 -- | Same as 'isPhase2Failure' with an added predicate over the text error
-isPhase2FailureWithMsg :: (IsProp prop) => String -> FailureProp prop
-isPhase2FailureWithMsg s _ _ (MCEValidationError Ledger.Phase2 (Ledger.ScriptFailure (Ledger.EvaluationError texts _))) _ | any (isInfixOf s . T.unpack) texts = testSuccess
-isPhase2FailureWithMsg _ pcOpts _ e _ = testFailureMsg $ "Expected phase 2 evaluation failure with constrained messages, got: " ++ renderString (prettyCookedOpt pcOpts) e
+isPhase2FailureWithMsg ::
+  (IsProp prop) =>
+  String ->
+  FailureProp prop
+isPhase2FailureWithMsg s _ _ (MCEValidationError Ledger.Phase2 (Ledger.ScriptFailure (Ledger.EvaluationError texts _))) _
+  | any (isInfixOf s . T.unpack) texts =
+      testSuccess
+isPhase2FailureWithMsg _ pcOpts _ e _ =
+  testFailureMsg $
+    "Expected phase 2 evaluation failure with constrained messages, got: "
+      ++ renderString (prettyCookedOpt pcOpts) e
 
 -- * Specific properties around number of outcomes
 
 -- | Ensures the run has an exact given number of outcomes
-isOfSize :: (IsProp prop) => Integer -> SizeProp prop
+isOfSize ::
+  (IsProp prop) =>
+  Integer ->
+  SizeProp prop
 isOfSize n1 n2 | n1 == n2 = testSuccess
-isOfSize n1 n2 = testFailureMsg $ "Incorrect number of results (expected: " <> show n1 <> " but got: " <> show n2 <> ")"
+isOfSize n1 n2 =
+  testFailureMsg $
+    "Incorrect number of results (expected: "
+      <> show n1
+      <> " but got: "
+      <> show n2
+      <> ")"
 
 -- | Ensures the run has a minimal number of outcomes
-isAtLeastOfSize :: (IsProp prop) => Integer -> SizeProp prop
+isAtLeastOfSize ::
+  (IsProp prop) =>
+  Integer ->
+  SizeProp prop
 isAtLeastOfSize n1 n2 | n1 <= n2 = testSuccess
-isAtLeastOfSize n1 n2 = testFailureMsg $ "Incorrect number of results (expected at least: " <> show n1 <> " but got: " <> show n2 <> ")"
+isAtLeastOfSize n1 n2 =
+  testFailureMsg $
+    "Incorrect number of results (expected at least: "
+      <> show n1
+      <> " but got: "
+      <> show n2
+      <> ")"
 
 -- | Ensures the run has a minimal number of outcomes
-isAtMostOfSize :: (IsProp prop) => Integer -> SizeProp prop
+isAtMostOfSize ::
+  (IsProp prop) =>
+  Integer ->
+  SizeProp prop
 isAtMostOfSize n1 n2 | n1 >= n2 = testSuccess
-isAtMostOfSize n1 n2 = testFailureMsg $ "Incorrect number of results (expected at most: " <> show n1 <> " but got: " <> show n2 <> ")"
+isAtMostOfSize n1 n2 =
+  testFailureMsg $
+    "Incorrect number of results (expected at most: "
+      <> show n1
+      <> " but got: "
+      <> show n2
+      <> ")"
 
 -- * Specific properties over the log
 
 -- | Ensures a certain event has been emitted. This uses the constructor's name
 -- of the 'MockChainLogEntry' by relying on 'show' being lazy.
-happened :: (IsProp prop) => String -> LogProp prop
+happened ::
+  (IsProp prop) =>
+  String ->
+  LogProp prop
 happened eventName _ log
   | allEventNames <- Set.fromList (head . words . show <$> log) =
       if eventName `Set.member` allEventNames
         then testSuccess
-        else testFailureMsg $ "The event " <> show eventName <> " did not occur (but those did: " <> show allEventNames <> ")"
+        else
+          testFailureMsg $
+            "The event "
+              <> show eventName
+              <> " did not occur (but those did: "
+              <> show allEventNames
+              <> ")"
 
 -- | Ensures a certain event has not been emitted. This uses the constructor's
 -- name of the 'MockChainLogEntry' by relying on 'show' being lazy.
 didNotHappen :: (IsProp prop) => String -> LogProp prop
 didNotHappen eventName _ log | not (eventName `Set.member` Set.fromList (head . words . show <$> log)) = testSuccess
-didNotHappen eventName _ _ = testFailureMsg $ "The event " <> show eventName <> " was forbidden but occurred nonetheless"
+didNotHappen eventName _ _ =
+  testFailureMsg $
+    "The event "
+      <> show eventName
+      <> " was forbidden but occurred nonetheless"
 
 -- * Specific properties over successes
 
 -- | Ensures that the given addresses satisfy certain amount requirements over a
 -- list of given asset classes in the end of the run
-isAtAddress :: (IsProp prop, Script.ToAddress addr, Show addr) => [(addr, [(Api.AssetClass, Integer -> Bool)])] -> SuccessProp a prop
+isAtAddress ::
+  ( IsProp prop,
+    Script.ToAddress addr,
+    Show addr
+  ) =>
+  [(addr, [(Api.AssetClass, Integer -> Bool)])] ->
+  SuccessProp a prop
 isAtAddress addressesReqs _ _ _ utxoState =
   testAll
     ( \(w, assetsReqs) ->
-        let ownedValue = holdsInState w utxoState
-         in testAll
-              ( \(ac, nbReq) ->
-                  let amount = Api.assetClassValueOf ownedValue ac
-                   in if nbReq amount
-                        then testSuccess
-                        else testFailureMsg $ "Unsatisfied quantity requirement for " <> show w <> " over asset class " <> show ac
-              )
-              assetsReqs
+        testAll
+          ( \(ac, nbReq) ->
+              let amount = Api.assetClassValueOf (holdsInState w utxoState) ac
+               in if nbReq amount
+                    then testSuccess
+                    else
+                      testFailureMsg $
+                        "Unsatisfied quantity requirement for "
+                          <> show w
+                          <> " over asset class "
+                          <> show ac
+          )
+          assetsReqs
     )
     addressesReqs
 
 -- | Ensures that a given address possesses exactly a certain amount of a given
 -- asset class in the end of the run
-possesses :: (IsProp prop, Script.ToAddress addr, Show addr) => addr -> Api.AssetClass -> Integer -> SuccessProp a prop
+possesses ::
+  ( IsProp prop,
+    Script.ToAddress addr,
+    Show addr
+  ) =>
+  addr ->
+  Api.AssetClass ->
+  Integer ->
+  SuccessProp a prop
 possesses w ac n = isAtAddress [(w, [(ac, (== n))])]
 
 -- * Advanced test templates
@@ -446,26 +629,137 @@ possesses w ac n = isAtAddress [(w, [(ac, (== n))])]
 
 --}
 
--- | A test template which expects a Phase 2 failure
-mustFailInPhase2Test :: (IsProp prop) => Sem effs a -> Test effs a prop
-mustFailInPhase2Test trace = mustFailTest trace `withFailureProp` isPhase2Failure
-
--- | A test template which expects a specific phase 2 error message
-mustFailInPhase2WithMsgTest :: (IsProp prop) => String -> Sem effs a -> Test effs a prop
-mustFailInPhase2WithMsgTest msg trace = mustFailTest trace `withFailureProp` isPhase2FailureWithMsg msg
-
--- | A test template which expects a Phase 1 failure
-mustFailInPhase1Test :: (IsProp prop) => Sem effs a -> Test effs a prop
-mustFailInPhase1Test trace = mustFailTest trace `withFailureProp` isPhase1Failure
-
--- | A test template which expects a specific phase 1 error message
-mustFailInPhase1WithMsgTest :: (IsProp prop) => String -> Sem effs a -> Test effs a prop
-mustFailInPhase1WithMsgTest msg trace = mustFailTest trace `withFailureProp` isPhase1FailureWithMsg msg
-
--- | A test template which expects a certain number of successful outcomes
-mustSucceedWithSizeTest :: (IsProp prop) => Integer -> Sem effs a -> Test effs a prop
-mustSucceedWithSizeTest size trace = mustSucceedTest trace `withSizeProp` (testBool . (== size))
-
--- | A test template which expects a certain number of unsuccessful outcomes
-mustFailWithSizeTest :: (IsProp prop) => Integer -> Sem effs a -> Test effs a prop
-mustFailWithSizeTest size trace = mustFailTest trace `withSizeProp` isOfSize size
+-- | A test template expecting a Phase 2 failure for arbitrary runs
+mustFailInPhase2Test' ::
+  (IsProp prop) =>
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustFailInPhase2Test' runner trace =
+  mustFailTest' runner trace `withFailureProp` isPhase2Failure
+
+-- | A test template expecting a Phase 2 failure for `RunnableMockChain` runs
+mustFailInPhase2Test ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  Test effs a a prop
+mustFailInPhase2Test trace =
+  mustFailTest trace `withFailureProp` isPhase2Failure
+
+-- | A test template expecting a specific phase 2 error message for arbitrary
+-- runs
+mustFailInPhase2WithMsgTest' ::
+  (IsProp prop) =>
+  String ->
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustFailInPhase2WithMsgTest' msg runner trace =
+  mustFailTest' runner trace `withFailureProp` isPhase2FailureWithMsg msg
+
+-- | A test template expecting a specific phase 2 error message for
+-- `RunnableMockChain` runs
+mustFailInPhase2WithMsgTest ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  String ->
+  Sem effs a ->
+  Test effs a a prop
+mustFailInPhase2WithMsgTest msg trace =
+  mustFailTest trace `withFailureProp` isPhase2FailureWithMsg msg
+
+-- | A test template expecting a Phase 1 failure
+mustFailInPhase1Test' ::
+  (IsProp prop) =>
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustFailInPhase1Test' runner trace =
+  mustFailTest' runner trace `withFailureProp` isPhase1Failure
+
+-- | A test template expecting a Phase 1 failure for `RunnableMockChain` runs
+mustFailInPhase1Test ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  Test effs a a prop
+mustFailInPhase1Test trace =
+  mustFailTest trace `withFailureProp` isPhase1Failure
+
+-- | A test template expecting a specific phase 1 error message
+mustFailInPhase1WithMsgTest' ::
+  (IsProp prop) =>
+  String ->
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustFailInPhase1WithMsgTest' msg runner trace =
+  mustFailTest' runner trace `withFailureProp` isPhase1FailureWithMsg msg
+
+-- | A test template expecting a specific phase 1 error message for
+-- `RunnableMockChain` runs
+mustFailInPhase1WithMsgTest ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  String ->
+  Sem effs a ->
+  Test effs a a prop
+mustFailInPhase1WithMsgTest msg trace =
+  mustFailTest trace `withFailureProp` isPhase1FailureWithMsg msg
+
+-- | A test template expecting a certain number of successful outcomes for
+-- arbitrary runs
+mustSucceedWithSizeTest' ::
+  (IsProp prop) =>
+  Integer ->
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustSucceedWithSizeTest' size runner trace =
+  mustSucceedTest' runner trace `withSizeProp` isOfSize size
+
+-- | A test template expecting a certain number of successful outcomes for
+-- `RunnableMockChain` runs
+mustSucceedWithSizeTest ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Integer ->
+  Sem effs a ->
+  Test effs a a prop
+mustSucceedWithSizeTest size trace =
+  mustSucceedTest trace `withSizeProp` isOfSize size
+
+-- | A test template expecting a certain number of unsuccessful outcomes for
+-- arbitrary runs
+mustFailWithSizeTest' ::
+  (IsProp prop) =>
+  Integer ->
+  Runner effs a b ->
+  Sem effs a ->
+  Test effs a b prop
+mustFailWithSizeTest' size runner trace =
+  mustFailTest' runner trace `withSizeProp` isOfSize size
+
+-- | A test template expecting a certain number of unsuccessful outcomes for
+-- `RunnableMockChain` runs
+mustFailWithSizeTest ::
+  ( IsProp prop,
+    RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Integer ->
+  Sem effs a ->
+  Test effs a a prop
+mustFailWithSizeTest size trace =
+  mustFailTest trace `withSizeProp` isOfSize size

From 1f1a92347c9bed9c51f6300f34e87130062eff6d Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Mon, 2 Feb 2026 23:07:48 +0100
Subject: [PATCH 67/96] improving the testing framework

---
 src/Cooked/MockChain/Instances.hs | 29 ++++++++++++++++-------------
 src/Cooked/MockChain/Testing.hs   |  4 ++--
 tests/Spec/StagedRun.hs           |  4 ++--
 3 files changed, 20 insertions(+), 17 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 10e8a5063..0aa482e2e 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -52,7 +52,7 @@ type DirectEffs =
      Fail
    ]
 
--- | A mockchain computation builds on top of the `DirectEffs` stack of effects
+-- | A mockchain computation built on top of the `DirectEffs` stack of effects
 type DirectMockChain a = Sem DirectEffs a
 
 instance RunnableMockChain DirectEffs where
@@ -110,7 +110,7 @@ type FullEffs =
      NonDet
    ]
 
--- | A mockchain computation builds on top of the `FullEffs` stack of effects
+-- | A mockchain computation built on top of the `FullEffs` stack of effects
 type FullMockChain a = Sem FullEffs a
 
 instance RunnableMockChain FullEffs where
@@ -131,8 +131,10 @@ instance RunnableMockChain FullEffs where
       . reinterpretMockChainWriteWithTweak @FullTweakEffs
       . runModifyGlobally
 
-class Interpret eff where
-  runInterpret :: Sem (eff : effs) a -> Sem effs a
+-- | The class of effects that can be interpreted on their own on top of an
+-- arbitrary stack of effects
+class InterpretAlone eff where
+  runInterpretAlone :: Sem (eff : effs) a -> Sem effs a
 
 -- | A stack of effects aimed at being used as modifications for a
 -- `StagedMockChain` computation
@@ -143,12 +145,12 @@ type StagedInjectTweakEffs injEff =
      Fail
    ]
 
--- | A tweak computation based on the `StagedInjectTweakEff` stack of effects
+-- | A tweak computation based on the `StagedInjectTweakEffs` stack of effects
 type StagedInjectTweak injEff a = TypedTweak (StagedInjectTweakEffs injEff) a
 
--- | A stack of effects which allows everything allowed by `DirectEff` with the
+-- | A stack of effects which allows everything allowed by `DirectEffs` with the
 -- addition of branching and `Ltl` modification with tweaks living in
--- `StagedInjectTweakEff`
+-- `StagedInjectTweakEffs`
 type StagedInjectEffs injEff =
   '[ ModifyGlobally (UntypedTweak (StagedInjectTweakEffs injEff)),
      MockChainWrite,
@@ -159,10 +161,11 @@ type StagedInjectEffs injEff =
      NonDet
    ]
 
--- | A mockchain computation builds on top of the `StagedInjectEff` stack of effects
+-- | A mockchain computation built on top of the `StagedInjectEffs` stack of
+-- effects
 type StagedInjectMockChain injEff a = Sem (StagedInjectEffs injEff) a
 
-instance (Interpret injEff) => RunnableMockChain (StagedInjectEffs injEff) where
+instance (InterpretAlone injEff) => RunnableMockChain (StagedInjectEffs injEff) where
   runMockChain mcst =
     run
       . runNonDet
@@ -174,7 +177,7 @@ instance (Interpret injEff) => RunnableMockChain (StagedInjectEffs injEff) where
       . runFailInMockChainError
       . runMockChainRead
       . runMockChainMisc fromAlias fromNote fromAssert
-      . runInterpret
+      . runInterpretAlone
       . evalState []
       . runModifyLocally
       . runMockChainWrite
@@ -204,8 +207,8 @@ type StagedTweak a = TypedTweak StagedTweakEffs a
 -- `StagedTweakEffs`
 type StagedEffs = StagedInjectEffs (Bundle '[])
 
--- | A mockchain computation builds on top of the `StagedEffs` stack of effects
+-- | A mockchain computation built on top of the `StagedEffs` stack of effects
 type StagedMockChain a = Sem StagedEffs a
 
-instance Interpret (Bundle '[]) where
-  runInterpret = runBundle
+instance InterpretAlone (Bundle '[]) where
+  runInterpretAlone = runBundle
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index e36a2c98a..eff152194 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -290,8 +290,8 @@ testCookedQC name = QC.testProperty name . testToProp
 -- | A test template which expects a success from a trace. This test template is
 -- built from a trace and a dedicated runner, to be used for runs that do not
 -- implement `RunnableMockChain`. One of the intended uses is for running
--- `StagedInjectMockChain` when the additional effect results in a extended
--- return value (such as a resulting state).
+-- `Cooked.MockChain.Instance.StagedInjectMockChain` when the additional effect
+-- results in a extended return value (such as a resulting state).
 mustSucceedTest' ::
   (IsProp prop) =>
   Runner effs a b ->
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index c9568c41c..a8b6ca383 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -12,8 +12,8 @@ import Polysemy.Bundle
 import Polysemy.State
 import Test.Tasty (TestTree)
 
-instance Interpret (Bundle '[State Integer]) where
-  runInterpret = evalState 0 . runBundle
+instance InterpretAlone (Bundle '[State Integer]) where
+  runInterpretAlone = evalState 0 . runBundle
 
 stagedRun :: StagedInjectMockChain (Bundle '[State Integer]) Integer
 stagedRun = do

From efc2fbb95eb08f8ab493a9208df73ebb8e32cee3 Mon Sep 17 00:00:00 2001
From: mmontin <mathieu.montin@moduscreate.com>
Date: Mon, 2 Feb 2026 23:32:59 +0100
Subject: [PATCH 68/96] manual export of instances

---
 src/Cooked/MockChain/Instances.hs | 40 ++++++++++++++++++++++++-------
 1 file changed, 32 insertions(+), 8 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 0aa482e2e..97a3fd7ea 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -16,14 +16,38 @@
 -- - `StagedInjectMockChain` exposes the same primitives as `StagedMockChain`,
 --   with an additional custom effect that can both be used in the main thread
 --   and in the associated tweaks. This allows a mockchain run to depend on
---   arbitrary additional effects (if multiple effects are needed, this single
---   effect can be instantiated to a bundle).
+--   arbitrary additional effects. If multiple effects are needed, this single
+--   effect can be instantiated to a bundle.
 --
 -- - `FullMockChain` exposes all the effects used to process a mockchain run,
 --   including intermediate effects usually hidden. This should only be used
 --   when the users requires to manually execute internal primitives of cooked,
 --   such as balancing.
-module Cooked.MockChain.Instances where
+module Cooked.MockChain.Instances
+  ( -- * Direct, simple mockchain instance
+    DirectEffs,
+    DirectMockChain,
+
+    -- * Staged mockchain instance with all effects
+    FullTweakEffs,
+    FullTweak,
+    FullEffs,
+    FullMockChain,
+
+    -- * Staged mockchain instance with minimal effects
+    StagedTweakEffs,
+    StagedTweak,
+    StagedEffs,
+    StagedMockChain,
+
+    -- * Staged mockchain instance with minimal effects and a custom effect
+    InterpretAlone (..),
+    StagedInjectTweakEffs,
+    StagedInjectTweak,
+    StagedInjectEffs,
+    StagedInjectMockChain,
+  )
+where
 
 import Cooked.Ltl
 import Cooked.MockChain.Error
@@ -131,11 +155,6 @@ instance RunnableMockChain FullEffs where
       . reinterpretMockChainWriteWithTweak @FullTweakEffs
       . runModifyGlobally
 
--- | The class of effects that can be interpreted on their own on top of an
--- arbitrary stack of effects
-class InterpretAlone eff where
-  runInterpretAlone :: Sem (eff : effs) a -> Sem effs a
-
 -- | A stack of effects aimed at being used as modifications for a
 -- `StagedMockChain` computation
 type StagedInjectTweakEffs injEff =
@@ -165,6 +184,11 @@ type StagedInjectEffs injEff =
 -- effects
 type StagedInjectMockChain injEff a = Sem (StagedInjectEffs injEff) a
 
+-- | The class of effects that can be interpreted on their own on top of an
+-- arbitrary stack of effects
+class InterpretAlone eff where
+  runInterpretAlone :: Sem (eff : effs) a -> Sem effs a
+
 instance (InterpretAlone injEff) => RunnableMockChain (StagedInjectEffs injEff) where
   runMockChain mcst =
     run

From e53fd352f84eefe8e3eded07ecb1c6ca12620dc7 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 10 Feb 2026 01:45:41 +0100
Subject: [PATCH 69/96] merge + extraEffs

---
 src/Cooked/MockChain/Instances.hs | 58 +++++++++++++++----------------
 tests/Spec/StagedRun.hs           |  2 +-
 2 files changed, 29 insertions(+), 31 deletions(-)

diff --git a/src/Cooked/MockChain/Instances.hs b/src/Cooked/MockChain/Instances.hs
index 97a3fd7ea..c7e2f25ed 100644
--- a/src/Cooked/MockChain/Instances.hs
+++ b/src/Cooked/MockChain/Instances.hs
@@ -5,24 +5,22 @@
 --
 -- - `DirectMockChain` exposes the minimal set of effects required to run a
 --   mockchain, without the ability to branch or modify runs. Use this only if
---   you specifically want to disallow Ltl modifications (which behaves the same
---   in the absence of modifications). In should also perform somewhat better,
---   also in most cases this will be insignificant.
+--   you specifically want to disallow `Ltl` modifications.
 --
 -- - `StagedMockChain` exposes all the primitives required to run a mockchain,
---   with the addition of branching and Ltl modifications using tweaks. This
+--   with the addition of branching and `Ltl` modifications using tweaks. This
 --   should be the environement to use in 99% of the cases.
 --
--- - `StagedInjectMockChain` exposes the same primitives as `StagedMockChain`,
+-- - `ExtendedStagedMockChain` exposes the same primitives as `StagedMockChain`,
 --   with an additional custom effect that can both be used in the main thread
 --   and in the associated tweaks. This allows a mockchain run to depend on
---   arbitrary additional effects. If multiple effects are needed, this single
---   effect can be instantiated to a bundle.
+--   arbitrary additional effects (if multiple effects are needed, this single
+--   effect can be instantiated to a `Bundle` wrapping up those effects).
 --
 -- - `FullMockChain` exposes all the effects used to process a mockchain run,
---   including intermediate effects usually hidden. This should only be used
---   when the users requires to manually execute internal primitives of cooked,
---   such as balancing.
+--   including intermediate hidden in the other instances. This should only be
+--   used when explicitly executing internal primitives of cooked, such as
+--   balancing, is required.
 module Cooked.MockChain.Instances
   ( -- * Direct, simple mockchain instance
     DirectEffs,
@@ -42,10 +40,10 @@ module Cooked.MockChain.Instances
 
     -- * Staged mockchain instance with minimal effects and a custom effect
     InterpretAlone (..),
-    StagedInjectTweakEffs,
-    StagedInjectTweak,
-    StagedInjectEffs,
-    StagedInjectMockChain,
+    ExtendedStagedTweakEffs,
+    ExtendedStagedTweak,
+    ExtendedStagedEffs,
+    ExtendedStagedMockChain,
   )
 where
 
@@ -157,39 +155,39 @@ instance RunnableMockChain FullEffs where
 
 -- | A stack of effects aimed at being used as modifications for a
 -- `StagedMockChain` computation
-type StagedInjectTweakEffs injEff =
-  '[ injEff,
+type ExtendedStagedTweakEffs extraEff =
+  '[ extraEff,
      MockChainMisc,
      MockChainRead,
      Fail
    ]
 
--- | A tweak computation based on the `StagedInjectTweakEffs` stack of effects
-type StagedInjectTweak injEff a = TypedTweak (StagedInjectTweakEffs injEff) a
+-- | A tweak computation based on the `ExtendedStagedTweakEffs` stack of effects
+type ExtendedStagedTweak extraEff a = TypedTweak (ExtendedStagedTweakEffs extraEff) a
 
 -- | A stack of effects which allows everything allowed by `DirectEffs` with the
 -- addition of branching and `Ltl` modification with tweaks living in
--- `StagedInjectTweakEffs`
-type StagedInjectEffs injEff =
-  '[ ModifyGlobally (UntypedTweak (StagedInjectTweakEffs injEff)),
+-- `ExtendedStagedTweakEffs`
+type ExtendedStagedEffs extraEff =
+  '[ ModifyGlobally (UntypedTweak (ExtendedStagedTweakEffs extraEff)),
      MockChainWrite,
-     injEff,
+     extraEff,
      MockChainMisc,
      MockChainRead,
      Fail,
      NonDet
    ]
 
--- | A mockchain computation built on top of the `StagedInjectEffs` stack of
+-- | A mockchain computation built on top of the `ExtendedStagedEffs` stack of
 -- effects
-type StagedInjectMockChain injEff a = Sem (StagedInjectEffs injEff) a
+type ExtendedStagedMockChain extraEff a = Sem (ExtendedStagedEffs extraEff) a
 
 -- | The class of effects that can be interpreted on their own on top of an
 -- arbitrary stack of effects
 class InterpretAlone eff where
   runInterpretAlone :: Sem (eff : effs) a -> Sem effs a
 
-instance (InterpretAlone injEff) => RunnableMockChain (StagedInjectEffs injEff) where
+instance (InterpretAlone extraEff) => RunnableMockChain (ExtendedStagedEffs extraEff) where
   runMockChain mcst =
     run
       . runNonDet
@@ -212,16 +210,16 @@ instance (InterpretAlone injEff) => RunnableMockChain (StagedInjectEffs injEff)
            MockChainLog,
            Writer MockChainJournal
          ]
-      . reinterpretMockChainWriteWithTweak @(StagedInjectTweakEffs injEff)
+      . reinterpretMockChainWriteWithTweak @(ExtendedStagedTweakEffs extraEff)
       . runModifyGlobally
       . insertAt @2
-        @[ ModifyLocally (UntypedTweak (StagedInjectTweakEffs injEff)),
-           State [Ltl (UntypedTweak (StagedInjectTweakEffs injEff))]
+        @[ ModifyLocally (UntypedTweak (ExtendedStagedTweakEffs extraEff)),
+           State [Ltl (UntypedTweak (ExtendedStagedTweakEffs extraEff))]
          ]
 
 -- | A stack of effects aimed at being used as modifications for a
 -- `StagedMockChain` computation
-type StagedTweakEffs = StagedInjectTweakEffs (Bundle '[])
+type StagedTweakEffs = ExtendedStagedTweakEffs (Bundle '[])
 
 -- | A tweak computation based on the `StagedTweakEffs` stack of effects
 type StagedTweak a = TypedTweak StagedTweakEffs a
@@ -229,7 +227,7 @@ type StagedTweak a = TypedTweak StagedTweakEffs a
 -- | A stack of effects which allows everything allowed by `DirectEffs` with the
 -- addition of branching and `Ltl` modification with tweaks living in
 -- `StagedTweakEffs`
-type StagedEffs = StagedInjectEffs (Bundle '[])
+type StagedEffs = ExtendedStagedEffs (Bundle '[])
 
 -- | A mockchain computation built on top of the `StagedEffs` stack of effects
 type StagedMockChain a = Sem StagedEffs a
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index a8b6ca383..78b055521 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -15,7 +15,7 @@ import Test.Tasty (TestTree)
 instance InterpretAlone (Bundle '[State Integer]) where
   runInterpretAlone = evalState 0 . runBundle
 
-stagedRun :: StagedInjectMockChain (Bundle '[State Integer]) Integer
+stagedRun :: ExtendedStagedMockChain (Bundle '[State Integer]) Integer
 stagedRun = do
   -- Defining some aliases for wallets
   alice <- define "alice" $ wallet 1

From 202443ccf89e2dd8ca0c228b2886584c4dde5b15 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Wed, 11 Feb 2026 23:50:54 +0100
Subject: [PATCH 70/96] refactoring of initial distributions

---
 src/Cooked/MockChain/Runnable.hs    |  42 +++----
 src/Cooked/MockChain/Testing.hs     |  22 ++++
 src/Cooked/MockChain/UtxoSearch.hs  |   7 ++
 src/Cooked/MockChain/Write.hs       |   5 +
 tests/Spec/Attack/DatumHijacking.hs |   6 +-
 tests/Spec/Attack/DoubleSat.hs      |   9 +-
 tests/Spec/Attack/DupToken.hs       |   4 +-
 tests/Spec/Balancing.hs             |  21 ++--
 tests/Spec/BasicUsage.hs            |  10 +-
 tests/Spec/Certificates.hs          |   3 +-
 tests/Spec/InitialDistribution.hs   |   7 +-
 tests/Spec/InlineDatums.hs          |  30 ++---
 tests/Spec/MinAda.hs                |   1 +
 tests/Spec/MultiPurpose.hs          |   1 +
 tests/Spec/ProposingScript.hs       |   1 +
 tests/Spec/ReferenceInputs.hs       |   4 +-
 tests/Spec/ReferenceScripts.hs      |  28 ++---
 tests/Spec/StagedRun.hs             | 185 +++++++++++++++++++++++++++-
 tests/Spec/Tweak/Labels.hs          |   1 +
 tests/Spec/Withdrawals.hs           |   2 +
 20 files changed, 300 insertions(+), 89 deletions(-)

diff --git a/src/Cooked/MockChain/Runnable.hs b/src/Cooked/MockChain/Runnable.hs
index 7225dffbc..1b93bc964 100644
--- a/src/Cooked/MockChain/Runnable.hs
+++ b/src/Cooked/MockChain/Runnable.hs
@@ -38,32 +38,21 @@ import Polysemy
 --  >        ]
 --
 -- Note that payment issued through an initial distribution will be attached
--- enough ADA to sustain themselves.
-data InitialDistribution where
-  InitialDistribution ::
-    {unInitialDistribution :: [TxSkelOut]} ->
-    InitialDistribution
+-- enough ADA to sustain themselves unless a fixed value is explicitly required.
+type InitialDistribution = [TxSkelOut]
 
 -- | 4 UTxOs with 100 Ada each, for each of the first 4 'knownWallets'
-instance Default InitialDistribution where
-  def =
-    distributionFromList
-      . zip (take 4 knownWallets)
-      . repeat
-      . replicate 4
-      $ Script.ada 100
-
-instance Semigroup InitialDistribution where
-  i <> j = InitialDistribution (unInitialDistribution i <> unInitialDistribution j)
-
-instance Monoid InitialDistribution where
-  mempty = InitialDistribution mempty
+initialDistributionTemplate :: InitialDistribution
+initialDistributionTemplate =
+  distributionFromList
+    . zip (take 4 knownWallets)
+    . repeat
+    . replicate 4
+    $ Script.ada 100
 
 -- | Creating a initial distribution with simple values assigned to owners
 distributionFromList :: (IsTxSkelOutAllowedOwner owner) => [(owner, [Api.Value])] -> InitialDistribution
-distributionFromList =
-  InitialDistribution
-    . foldl' (\x (user, values) -> x <> map (receives user . Value) values) []
+distributionFromList = foldl' (\x (user, values) -> x <> map (receives user . Value) values) []
 
 -- | Raw return type of running a mockchain
 type RawMockChainReturn a =
@@ -128,7 +117,7 @@ runMockChainFromConf ::
 runMockChainFromConf (MockChainConf initState initDist funOnResult) currentRun =
   fmap funOnResult $
     runMockChain initState $
-      forceOutputs (unInitialDistribution initDist) >> currentRun
+      forceOutputs initDist >> currentRun
 
 -- | Runs a `RunnableMockChain` from an initial distribution
 runMockChainFromInitDist ::
@@ -141,6 +130,15 @@ runMockChainFromInitDist ::
 runMockChainFromInitDist initDist =
   runMockChainFromConf $ mockChainConfTemplate {mccInitialDistribution = initDist}
 
+-- | Same as `runMockChainFromInitDist` using the `initialDistributionTemplate`
+runMockChainFromInitDistTemplate ::
+  ( RunnableMockChain effs,
+    Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  [MockChainReturn a]
+runMockChainFromInitDistTemplate = runMockChainFromInitDist initialDistributionTemplate
+
 -- | Runs a `RunnableMockChain` from a default configuration
 runMockChainDef ::
   ( RunnableMockChain effs,
diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index eff152194..985d0d60c 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -276,6 +276,17 @@ testCooked ::
   HU.TestTree
 testCooked name = HU.testCase name . testToProp
 
+-- Same as `testCooked` but first assigns the initial distribution template as a
+-- starting point to the test
+testCookedFromInitDistTemplate ::
+  forall effs a b.
+  (Show b) =>
+  String ->
+  Test effs a b HU.Assertion ->
+  HU.TestTree
+testCookedFromInitDistTemplate name =
+  testCooked name . (`withInitDist` initialDistributionTemplate)
+
 -- | Same as 'testCooked', but for 'QC.Property'
 testCookedQC ::
   forall effs a b.
@@ -285,6 +296,17 @@ testCookedQC ::
   HU.TestTree
 testCookedQC name = QC.testProperty name . testToProp
 
+-- Same as `testCookedQC` but first assigns the initial distribution template as a
+-- starting point to the test
+testCookedQCFromInitDistTemplate ::
+  forall effs a b.
+  (Show b) =>
+  String ->
+  Test effs a b QC.Property ->
+  HU.TestTree
+testCookedQCFromInitDistTemplate name =
+  testCookedQC name . (`withInitDist` initialDistributionTemplate)
+
 -- * Simple test templates
 
 -- | A test template which expects a success from a trace. This test template is
diff --git a/src/Cooked/MockChain/UtxoSearch.hs b/src/Cooked/MockChain/UtxoSearch.hs
index 1e8841973..a0a2eedd1 100644
--- a/src/Cooked/MockChain/UtxoSearch.hs
+++ b/src/Cooked/MockChain/UtxoSearch.hs
@@ -5,6 +5,7 @@ module Cooked.MockChain.UtxoSearch
   ( -- * UTxO searches
     UtxoSearch,
     beginSearch,
+    beginSearchP,
 
     -- * Processing search result
     UtxoSearchResult,
@@ -74,6 +75,12 @@ beginSearch ::
   UtxoSearch effs '[]
 beginSearch = fmap (fmap (fmap (`HCons` HEmpty)))
 
+-- | Same as `beginSearch` with a pure input
+beginSearchP ::
+  Utxos ->
+  UtxoSearch effs '[]
+beginSearchP = beginSearch . return
+
 -- | Retrieves the `TxSkelOut`s from a `UtxoSearchResult`
 getOutputs ::
   Sem effs (UtxoSearchResult elems) ->
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index 55611898a..6c676588b 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -23,6 +23,7 @@ module Cooked.MockChain.Write
     setParams,
     setConstitutionScript,
     forceOutputs,
+    forceOutputs_,
   )
 where
 
@@ -284,3 +285,7 @@ setConstitutionScript :: (Member MockChainWrite effs, ToVScript s) => s -> Sem e
 -- `TxSkelOut`. Returns the created UTxOs, which might differ from the original
 -- list if some min ADA adjustment occured.
 forceOutputs :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs Utxos
+
+-- | Same as `forceOutputs`, but discards the returned outputs
+forceOutputs_ :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs ()
+forceOutputs_ = void . forceOutputs
diff --git a/tests/Spec/Attack/DatumHijacking.hs b/tests/Spec/Attack/DatumHijacking.hs
index 2ba2d2201..5b234299b 100644
--- a/tests/Spec/Attack/DatumHijacking.hs
+++ b/tests/Spec/Attack/DatumHijacking.hs
@@ -111,7 +111,8 @@ tests =
                   @=? outSkelOutputs value_10_000 (1 ==)
             ],
       testCooked "careful validator" $
-        mustFailInPhase2Test $
+        mustFailInPhase2Test $ do
+          forceOutputs_ initialDistributionTemplate
           somewhere
             ( datumHijackingAttack $
                 ( outPredDatumHijackingParams
@@ -126,7 +127,8 @@ tests =
             )
             (datumHijackingTrace carefulValidator),
       testCooked "careless validator" $
-        mustSucceedTest $
+        mustSucceedTest $ do
+          forceOutputs_ initialDistributionTemplate
           somewhere
             ( datumHijackingAttack $
                 ( outPredDatumHijackingParams
diff --git a/tests/Spec/Attack/DoubleSat.hs b/tests/Spec/Attack/DoubleSat.hs
index 00cb4a82f..c8d31b53b 100644
--- a/tests/Spec/Attack/DoubleSat.hs
+++ b/tests/Spec/Attack/DoubleSat.hs
@@ -4,7 +4,6 @@ module Spec.Attack.DoubleSat (tests) where
 
 import Control.Arrow
 import Cooked
-import Data.Default
 import Data.Either
 import Data.List (subsequences)
 import Data.Map qualified as Map
@@ -34,11 +33,9 @@ instance PrettyCooked BRedeemer where
 -- each own a few UTxOs, with different values
 customInitDist :: InitialDistribution
 customInitDist =
-  def
-    <> InitialDistribution
-      ( ((\n -> aValidator `receives` VisibleHashedDatum ADatum <&&> Value (Script.ada n)) <$> [2, 3, 4, 5])
-          <> ((\n -> bValidator `receives` VisibleHashedDatum BDatum <&&> Value (Script.ada n)) <$> [6, 7])
-      )
+  initialDistributionTemplate
+    <> ((\n -> aValidator `receives` VisibleHashedDatum ADatum <&&> Value (Script.ada n)) <$> [2, 3, 4, 5])
+    <> ((\n -> bValidator `receives` VisibleHashedDatum BDatum <&&> Value (Script.ada n)) <$> [6, 7])
 
 -- | Utxos generated from the initial distribution
 aUtxo1, aUtxo2, aUtxo3, aUtxo4, bUtxo1, bUtxo2 :: (V3.TxOutRef, TxSkelOut)
diff --git a/tests/Spec/Attack/DupToken.hs b/tests/Spec/Attack/DupToken.hs
index dc9a9fe47..b8089d197 100644
--- a/tests/Spec/Attack/DupToken.hs
+++ b/tests/Spec/Attack/DupToken.hs
@@ -14,7 +14,9 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 dupTokenTrace :: Script.Versioned Script.MintingPolicy -> Api.TokenName -> Integer -> Wallet -> StagedMockChain ()
-dupTokenTrace pol tName amount recipient = validateTxSkel_ skel
+dupTokenTrace pol tName amount recipient = do
+  forceOutputs_ initialDistributionTemplate
+  validateTxSkel_ skel
   where
     skel =
       let mints = review txSkelMintsListI [mint pol () tName amount]
diff --git a/tests/Spec/Balancing.hs b/tests/Spec/Balancing.hs
index 6668af1af..43ba21b7b 100644
--- a/tests/Spec/Balancing.hs
+++ b/tests/Spec/Balancing.hs
@@ -26,17 +26,16 @@ banana = Script.multiPurposeScriptValue Script.trueMintingMPScript $ Api.TokenNa
 
 initialDistributionBalancing :: InitialDistribution
 initialDistributionBalancing =
-  InitialDistribution
-    [ Script.trueSpendingMPScript @() `receives` FixedValue (Script.ada 42) <&&> VisibleHashedDatum (),
-      alice `receives` FixedValue (Script.ada 2 <> apple 3),
-      alice `receives` FixedValue (Script.ada 25),
-      alice `receives` FixedValue (Script.ada 40 <> orange 6),
-      alice `receives` FixedValue (Script.ada 8),
-      alice `receives` FixedValue (Script.ada 30),
-      alice `receives` FixedValue (Script.lovelace 1280229 <> banana 3) <&&> VisibleHashedDatum (10 :: Integer),
-      alice `receives` FixedValue (Script.ada 1 <> banana 7) <&&> ReferenceScript (Script.trueSpendingMPScript @()),
-      alice `receives` FixedValue (Script.ada 105 <> banana 2) <&&> VisibleHashedDatum ()
-    ]
+  [ Script.trueSpendingMPScript @() `receives` FixedValue (Script.ada 42) <&&> VisibleHashedDatum (),
+    alice `receives` FixedValue (Script.ada 2 <> apple 3),
+    alice `receives` FixedValue (Script.ada 25),
+    alice `receives` FixedValue (Script.ada 40 <> orange 6),
+    alice `receives` FixedValue (Script.ada 8),
+    alice `receives` FixedValue (Script.ada 30),
+    alice `receives` FixedValue (Script.lovelace 1280229 <> banana 3) <&&> VisibleHashedDatum (10 :: Integer),
+    alice `receives` FixedValue (Script.ada 1 <> banana 7) <&&> ReferenceScript (Script.trueSpendingMPScript @()),
+    alice `receives` FixedValue (Script.ada 105 <> banana 2) <&&> VisibleHashedDatum ()
+  ]
 
 type TestBalancingOutcome = (TxSkel, TxSkel, Fee, Collaterals, [Api.TxOutRef])
 
diff --git a/tests/Spec/BasicUsage.hs b/tests/Spec/BasicUsage.hs
index 7baaa5fe4..69722d2f2 100644
--- a/tests/Spec/BasicUsage.hs
+++ b/tests/Spec/BasicUsage.hs
@@ -60,9 +60,9 @@ tests :: TestTree
 tests =
   testGroup
     "Basic usage"
-    [ testCooked "Payment from alice to bob, with auto-balancing" $ mustSucceedTest $ pkToPk alice bob 10,
-      testCooked "Circular payments of 10 ada between alice bob and carrie" $ mustSucceedTest multiplePksToPks,
-      testCooked "Minting quick tokens" $ mustSucceedTest mintingQuickValue,
-      testCooked "Paying to the always true validator" $ mustSucceedTest payToAlwaysTrueValidator,
-      testCooked "Consuming the always true validator" $ mustSucceedTest consumeAlwaysTrueValidator
+    [ testCookedFromInitDistTemplate "Payment from alice to bob, with auto-balancing" $ mustSucceedTest $ pkToPk alice bob 10,
+      testCookedFromInitDistTemplate "Circular payments of 10 ada between alice bob and carrie" $ mustSucceedTest multiplePksToPks,
+      testCookedFromInitDistTemplate "Minting quick tokens" $ mustSucceedTest mintingQuickValue,
+      testCookedFromInitDistTemplate "Paying to the always true validator" $ mustSucceedTest payToAlwaysTrueValidator,
+      testCookedFromInitDistTemplate "Consuming the always true validator" $ mustSucceedTest consumeAlwaysTrueValidator
     ]
diff --git a/tests/Spec/Certificates.hs b/tests/Spec/Certificates.hs
index 1f932e631..29022d8b9 100644
--- a/tests/Spec/Certificates.hs
+++ b/tests/Spec/Certificates.hs
@@ -13,7 +13,8 @@ bob :: Wallet
 bob = wallet 1
 
 publishCertificate :: TxSkelCertificate -> DirectMockChain ()
-publishCertificate cert =
+publishCertificate cert = do
+  forceOutputs_ [alice `receives` Value (Script.ada 100)]
   validateTxSkel_ $
     txSkelTemplate
       { txSkelSignatories = txSkelSignatoriesFromList [alice],
diff --git a/tests/Spec/InitialDistribution.hs b/tests/Spec/InitialDistribution.hs
index c98448697..9715407b8 100644
--- a/tests/Spec/InitialDistribution.hs
+++ b/tests/Spec/InitialDistribution.hs
@@ -13,16 +13,15 @@ alice, bob :: Wallet
 -- type Int and value 10 for each datum kind
 initialDistributionWithDatum :: InitialDistribution
 initialDistributionWithDatum =
-  InitialDistribution $ [receives alice] <*> ([VisibleHashedDatum, HiddenHashedDatum] <*> [10 :: Integer])
+  [receives alice] <*> ([VisibleHashedDatum, HiddenHashedDatum] <*> [10 :: Integer])
 
 -- | An initial distribution where alice owns a UTxO with a reference
 -- script corresponding to the always succeed validators and bob owns
 -- 2 UTxOs with 100 ADA
 initialDistributionWithReferenceScript :: InitialDistribution
 initialDistributionWithReferenceScript =
-  InitialDistribution $
-    (alice `receives` Value (Script.ada 2) <&&> ReferenceScript (Script.trueSpendingMPScript @()))
-      : replicate 2 (bob `receives` Value (Script.ada 100))
+  (alice `receives` Value (Script.ada 2) <&&> ReferenceScript (Script.trueSpendingMPScript @()))
+    : replicate 2 (bob `receives` Value (Script.ada 100))
 
 getValueFromInitialDatum :: DirectMockChain [Integer]
 getValueFromInitialDatum = do
diff --git a/tests/Spec/InlineDatums.hs b/tests/Spec/InlineDatums.hs
index 16914e5da..2c94b2ca7 100644
--- a/tests/Spec/InlineDatums.hs
+++ b/tests/Spec/InlineDatums.hs
@@ -93,12 +93,12 @@ tests =
         "from the MockChain's point of view on Transaction outputs (allUtxos)"
         -- The validator used in these test cases does not actually matter, we
         -- just need some script to pay to.
-        [ testCooked "the datum is retrieved correctly" $
+        [ testCookedFromInitDistTemplate "the datum is retrieved correctly" $
             mustSucceedTest (listUtxosTestTrace True requireInlineDatumInInputValidator)
               `withResultProp` \(_, output) -> case Script.toOutputDatum (output ^. txSkelOutDatumL) of
                 Api.OutputDatum _ -> testSuccess
                 _ -> testFailure,
-          testCooked "the datum hash is retrieved correctly" $
+          testCookedFromInitDistTemplate "the datum hash is retrieved correctly" $
             mustSucceedTest (listUtxosTestTrace False requireInlineDatumInInputValidator)
               `withResultProp` \(_, output) -> case Script.toOutputDatum (output ^. txSkelOutDatumL) of
                 Api.OutputDatumHash _ -> testSuccess
@@ -110,19 +110,19 @@ tests =
             "looking at transaction inputs"
             [ testGroup
                 "validator expects an inline datum..."
-                [ testCooked "...and gets an inline datum, expecting success" $
+                [ testCookedFromInitDistTemplate "...and gets an inline datum, expecting success" $
                     mustSucceedTest $
                       spendOutputTestTrace True requireInlineDatumInInputValidator,
-                  testCooked "...and gets a datum hash, expecting script failure" $
+                  testCookedFromInitDistTemplate "...and gets a datum hash, expecting script failure" $
                     mustFailInPhase2Test $
                       spendOutputTestTrace False requireInlineDatumInInputValidator
                 ],
               testGroup
                 "validator expects a datum hash..."
-                [ testCooked "...and gets an inline datum, expecting script failure" $
+                [ testCookedFromInitDistTemplate "...and gets an inline datum, expecting script failure" $
                     mustFailInPhase2Test $
                       spendOutputTestTrace True requireHashedDatumInInputValidator,
-                  testCooked "...and gets a datum hash, expecting success" $
+                  testCookedFromInitDistTemplate "...and gets a datum hash, expecting success" $
                     mustSucceedTest $
                       spendOutputTestTrace False requireHashedDatumInInputValidator
                 ]
@@ -131,37 +131,37 @@ tests =
             "looking at transaction outputs"
             [ testGroup
                 "validator expects a regular datum..."
-                [ testCooked "...and gets a regular datum, expecting success" $
+                [ testCookedFromInitDistTemplate "...and gets a regular datum, expecting success" $
                     mustSucceedTest $
                       continuingOutputTestTrace Datum requireHashedDatumInOutputValidator,
-                  testCooked "...and gets an inline datum, expecting script failure" $
+                  testCookedFromInitDistTemplate "...and gets an inline datum, expecting script failure" $
                     mustFailInPhase2Test $
                       continuingOutputTestTrace Inline requireHashedDatumInOutputValidator,
-                  testCooked "...and gets a datum hash, expecting script failure" $
+                  testCookedFromInitDistTemplate "...and gets a datum hash, expecting script failure" $
                     mustFailInPhase2Test $
                       continuingOutputTestTrace OnlyHash requireHashedDatumInOutputValidator
                 ],
               testGroup
                 "validator expects an inline datum..."
-                [ testCooked "...and gets a regular datum, expecting script failure" $
+                [ testCookedFromInitDistTemplate "...and gets a regular datum, expecting script failure" $
                     mustFailInPhase2Test $
                       continuingOutputTestTrace Datum requireInlineDatumInOutputValidator,
-                  testCooked "...and gets an inline datum, expecting success" $
+                  testCookedFromInitDistTemplate "...and gets an inline datum, expecting success" $
                     mustSucceedTest $
                       continuingOutputTestTrace Inline requireInlineDatumInOutputValidator,
-                  testCooked "...and gets a datum hash, expecting script failure" $
+                  testCookedFromInitDistTemplate "...and gets a datum hash, expecting script failure" $
                     mustFailInPhase2Test $
                       continuingOutputTestTrace OnlyHash requireInlineDatumInOutputValidator
                 ],
               testGroup
                 "validator expects a datum hash..."
-                [ testCooked "...and gets a regular datum, expecting script failure" $
+                [ testCookedFromInitDistTemplate "...and gets a regular datum, expecting script failure" $
                     mustFailInPhase2Test $
                       continuingOutputTestTrace Datum requireOnlyHashedDatumInOutputValidator,
-                  testCooked "...and gets an inline datum, expecting script failure" $
+                  testCookedFromInitDistTemplate "...and gets an inline datum, expecting script failure" $
                     mustFailInPhase2Test $
                       continuingOutputTestTrace Inline requireOnlyHashedDatumInOutputValidator,
-                  testCooked "...and gets a datum hash, expecting success" $
+                  testCookedFromInitDistTemplate "...and gets a datum hash, expecting success" $
                     mustSucceedTest $
                       continuingOutputTestTrace OnlyHash requireOnlyHashedDatumInOutputValidator
                 ]
diff --git a/tests/Spec/MinAda.hs b/tests/Spec/MinAda.hs
index 0593ea407..75e21bfcc 100644
--- a/tests/Spec/MinAda.hs
+++ b/tests/Spec/MinAda.hs
@@ -23,6 +23,7 @@ instance PrettyCooked HeavyDatum where
 
 paymentWithMinAda :: DirectMockChain Integer
 paymentWithMinAda = do
+  forceOutputs_ initialDistributionTemplate
   view (txSkelOutValueL % valueLovelaceL % lovelaceIntegerI) . snd . (!! 0)
     <$> validateTxSkel'
       txSkelTemplate
diff --git a/tests/Spec/MultiPurpose.hs b/tests/Spec/MultiPurpose.hs
index 61a32d3b5..975f7464b 100644
--- a/tests/Spec/MultiPurpose.hs
+++ b/tests/Spec/MultiPurpose.hs
@@ -24,6 +24,7 @@ bob = wallet 2
 
 runScript :: StagedMockChain ()
 runScript = do
+  forceOutputs_ initialDistributionTemplate
   [(oRef@(Api.TxOutRef txId _), _), (oRef', _), (oRef'', _)] <-
     validateTxSkel' $
       txSkelTemplate
diff --git a/tests/Spec/ProposingScript.hs b/tests/Spec/ProposingScript.hs
index ce83ece0e..b1292833a 100644
--- a/tests/Spec/ProposingScript.hs
+++ b/tests/Spec/ProposingScript.hs
@@ -21,6 +21,7 @@ testProposingScript ::
   GovernanceAction IsScript ->
   DirectMockChain ()
 testProposingScript autoRefScript autoConstitution constitution mScript govAction = do
+  forceOutputs_ initialDistributionTemplate
   setConstitutionScript constitution
   validateTxSkel_ $
     txSkelTemplate
diff --git a/tests/Spec/ReferenceInputs.hs b/tests/Spec/ReferenceInputs.hs
index c4b144cc4..aecebb344 100644
--- a/tests/Spec/ReferenceInputs.hs
+++ b/tests/Spec/ReferenceInputs.hs
@@ -55,6 +55,6 @@ tests :: Tasty.TestTree
 tests =
   Tasty.testGroup
     "Reference inputs"
-    [ testCooked "We can reference an input that can't be spent" $ mustSucceedTest trace1,
-      testCooked "We can decode the datum hash from a reference input" $ mustSucceedTest trace2
+    [ testCookedFromInitDistTemplate "We can reference an input that can't be spent" $ mustSucceedTest trace1,
+      testCookedFromInitDistTemplate "We can decode the datum hash from a reference input" $ mustSucceedTest trace2
     ]
diff --git a/tests/Spec/ReferenceScripts.hs b/tests/Spec/ReferenceScripts.hs
index c5d477714..d1166eade 100644
--- a/tests/Spec/ReferenceScripts.hs
+++ b/tests/Spec/ReferenceScripts.hs
@@ -123,29 +123,29 @@ tests =
     [ testGroup "putting reference scripts on chain and retrieving them" $
         let theRefScript = Script.alwaysSucceedValidatorVersioned
             theRefScriptHash = Script.toScriptHash theRefScript
-         in [ testCooked "on a public key output" $
+         in [ testCookedFromInitDistTemplate "on a public key output" $
                 mustSucceedTest
                   (putRefScriptOnWalletOutput (wallet 3) theRefScript >>= previewByRef txSkelOutReferenceScriptHashAF)
                   `withResultProp` (testCounterexample "the script hash on the retrieved output is wrong" . (Just theRefScriptHash .==.)),
-              testCooked "on a script output" $
+              testCookedFromInitDistTemplate "on a script output" $
                 mustSucceedTest
                   (putRefScriptOnScriptOutput Script.alwaysSucceedValidatorVersioned theRefScript >>= previewByRef txSkelOutReferenceScriptHashAF)
                   `withResultProp` (testCounterexample "the script hash on the retrieved output is wrong" . (Just theRefScriptHash .==.))
             ],
       testGroup
         "checking the presence of reference scripts on the TxInfo"
-        [ testCooked "fail if wrong reference script" $
+        [ testCookedFromInitDistTemplate "fail if wrong reference script" $
             mustFailInPhase2WithMsgTest "there is no reference input with the correct script hash" $
               putRefScriptOnWalletOutput (wallet 3) Script.alwaysFailValidatorVersioned
                 >>= checkReferenceScriptOnOref (Script.toScriptHash Script.alwaysSucceedValidatorVersioned),
-          testCooked "succeed if correct reference script" $
+          testCookedFromInitDistTemplate "succeed if correct reference script" $
             mustSucceedTest $
               putRefScriptOnWalletOutput (wallet 3) Script.alwaysSucceedValidatorVersioned
                 >>= checkReferenceScriptOnOref (Script.toScriptHash Script.alwaysSucceedValidatorVersioned)
         ],
       testGroup
         "using reference scripts"
-        [ testCooked @DirectEffs "fail from transaction generation for missing reference scripts" $
+        [ testCookedFromInitDistTemplate @DirectEffs "fail from transaction generation for missing reference scripts" $
             mustFailTest
               ( do
                   consumedOref : _ <- getTxOutRefs $ utxosAtSearch (wallet 1) $ ensureAFoldIs (txSkelOutValueL % filtered (`Api.geq` Script.lovelace 42_000_000))
@@ -165,7 +165,7 @@ tests =
               `withErrorProp` \case
                 MCEUnknownOutRef _ -> testSuccess
                 _ -> testFailure,
-          testCooked "fail from transaction generation for mismatching reference scripts" $
+          testCookedFromInitDistTemplate "fail from transaction generation for mismatching reference scripts" $
             mustFailTest
               ( do
                   scriptOref <- putRefScriptOnWalletOutput (wallet 3) Script.alwaysFailValidatorVersioned
@@ -184,7 +184,7 @@ tests =
               `withErrorProp` \case
                 MCEWrongReferenceScriptError {} -> testSuccess
                 _ -> testFailure,
-          testCooked "phase 1 - fail if using a reference script with 'someRedeemer'" $
+          testCookedFromInitDistTemplate "phase 1 - fail if using a reference script with 'someRedeemer'" $
             mustFailInPhase1Test $ do
               scriptOref <- putRefScriptOnWalletOutput (wallet 3) Script.alwaysSucceedValidatorVersioned
               (oref, _) : _ <-
@@ -199,14 +199,14 @@ tests =
                     txSkelInsReference = Set.singleton scriptOref,
                     txSkelSignatories = txSkelSignatoriesFromList [wallet 1]
                   },
-          testCooked "fail if reference script's requirement is violated" $
+          testCookedFromInitDistTemplate "fail if reference script's requirement is violated" $
             mustFailInPhase2WithMsgTest "the required signer is missing" $
               useReferenceScript (wallet 1) False $
                 Script.toVersioned $
                   requireSignerValidator $
                     Script.toPubKeyHash $
                       wallet 2,
-          testCooked "succeed if reference script's requirement is met" $
+          testCookedFromInitDistTemplate "succeed if reference script's requirement is met" $
             mustSucceedTest
               ( useReferenceScript (wallet 1) False $
                   Script.toVersioned $
@@ -218,7 +218,7 @@ tests =
                 case Cardano.txInsReference bodyContent of
                   Cardano.TxInsReference _ [_] _ -> testSuccess
                   _ -> testFailure,
-          testCooked "succeed if the reference script is in one of the inputs" $
+          testCookedFromInitDistTemplate "succeed if the reference script is in one of the inputs" $
             mustSucceedTest
               ( useReferenceScript (wallet 1) True $
                   Script.toVersioned $
@@ -234,18 +234,18 @@ tests =
         ],
       testGroup
         "referencing minting policies"
-        [ testCooked "succeed if given a reference minting policy" $
+        [ testCookedFromInitDistTemplate "succeed if given a reference minting policy" $
             mustSucceedTest $
               referenceMint Script.alwaysSucceedPolicyVersioned Script.alwaysSucceedPolicyVersioned 0 False,
-          testCooked "succeed if relying on automated finding of reference minting policy" $
+          testCookedFromInitDistTemplate "succeed if relying on automated finding of reference minting policy" $
             mustSucceedTest (referenceMint Script.alwaysSucceedPolicyVersioned Script.alwaysSucceedPolicyVersioned 0 True)
               `withLogProp` happened "MCLogAddedReferenceScript",
-          testCooked "fail if given the wrong reference minting policy" $
+          testCookedFromInitDistTemplate "fail if given the wrong reference minting policy" $
             mustFailTest (referenceMint Script.alwaysFailPolicyVersioned Script.alwaysSucceedPolicyVersioned 0 False)
               `withErrorProp` \case
                 MCEWrongReferenceScriptError {} -> testSuccess
                 _ -> testFailure,
-          testCooked "fail if referencing the wrong utxo" $
+          testCookedFromInitDistTemplate "fail if referencing the wrong utxo" $
             mustFailTest (referenceMint Script.alwaysSucceedPolicyVersioned Script.alwaysSucceedPolicyVersioned 1 False)
               `withErrorProp` \case
                 MCEWrongReferenceScriptError {} -> testSuccess
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index 78b055521..37a882e50 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -4,14 +4,189 @@ module Spec.StagedRun where
 
 import Control.Monad
 import Cooked
+import Data.Default
 import Optics.Core
 import Plutus.Script.Utils.V3.Generators
+import Plutus.Script.Utils.V3.Typed
 import Plutus.Script.Utils.Value
 import PlutusLedgerApi.V3 qualified as Api
 import Polysemy.Bundle
+import Polysemy.Reader
 import Polysemy.State
 import Test.Tasty (TestTree)
 
+{--
+Script for the demo :
+
+Enter a repl and load the required dependencies.
+
+> cabal repl tests
+> :l tests/Spec/StagedRun
+> import Cooked
+
+- We define a run which does nothing
+--}
+
+demoRun :: StagedMockChain ()
+demoRun = return ()
+
+{--
+Maybe we want to include payments directly within the run (as opposed to outside of the run)
+--}
+
+demoRunForceOutputs :: StagedMockChain ()
+demoRunForceOutputs =
+  forceOutputs_ $
+    replicate 4 (wallet 2 `receives` Value (ada 10))
+      ++ replicate 4 (wallet 1 `receives` Value (ada 10))
+      ++ [wallet 1 `receives` InlineDatum (20 :: Integer)]
+
+{--
+Notice that cooked already made some adjustments to the value of an input (min ADA accounted for).
+We can actually ask cooked to show the adjustement it mades during the run.
+--}
+
+printAndRunWithLog :: (Show a) => StagedMockChain a -> IO ()
+printAndRunWithLog = printCookedOpt (def {pcOptPrintLog = True}) . runMockChainDef
+
+{--
+However, we could also tell cooked not to do any adjustment, which would result in a
+UTxO which could not exist on-chain.
+--}
+
+demoRunForceOutputsNoMinAda :: StagedMockChain ()
+demoRunForceOutputsNoMinAda =
+  forceOutputs_ $
+    replicate 4 (wallet 2 `receives` Value (ada 10))
+      ++ replicate 4 (wallet 1 `receives` Value (ada 10))
+      ++ [wallet 1 `receives` InlineDatum (20 :: Integer) <&&> FixedValue (ada 0)]
+
+{--
+In practice, there is no insight to do that in such cases, but during audits it can often be useful to
+check that the computations were done right in the offchain code.
+
+Let's now move on to some more complex and interesting initial values.
+--}
+
+demoRunFullForcedOutputs :: StagedMockChain ()
+demoRunFullForcedOutputs = do
+  let alice = wallet 1
+      bob = wallet 2
+      trueScript = trueMPScript @()
+      falseScript = falseMPScript @()
+      permanent = Api.TokenName "permanent"
+      quick = Api.TokenName "quick"
+      permanentValue = review (valueAssetClassAmountP falseScript permanent)
+      quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_ $
+    replicate 4 (bob `receives` Value (ada 10))
+      ++ replicate 4 (alice `receives` Value (ada 10))
+      ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
+           alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
+           alice `receives` Value (quickValue 4),
+           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
+           alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
+           alice `receives` InlineDatum (20 :: Integer)
+         ]
+
+{--
+Notice that cooked made min ADA adjustment to all of the relevant inputs. We can also
+notice that some script have aliases, and the wallets are labelled wallet 1 to wallet 10
+but some other entities such as the token names are represented by their hashes.
+Thankfully, we can freely create nicknames for everything when initializing variables.
+--}
+
+demoRunNicknames :: StagedMockChain ()
+demoRunNicknames = do
+  alice <- define "alice" $ wallet 1
+  bob <- define "bob" $ wallet 2
+  trueScript <- define "trueScript" $ trueMPScript @()
+  falseScript <- define "falseScript" $ falseMPScript @()
+  permanent <- define "permanent" $ Api.TokenName "permanent"
+  quick <- define "quick" $ Api.TokenName "quick"
+  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
+      quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_ $
+    replicate 4 (bob `receives` Value (ada 10))
+      ++ replicate 4 (alice `receives` Value (ada 10))
+      ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
+           alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
+           alice `receives` Value (quickValue 4),
+           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
+           alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
+           alice `receives` InlineDatum (20 :: Integer)
+         ]
+
+{--
+While the aliasing is perfect, it relies on static data for now, and data manually written.
+There are many cases where this should rely on dynamic data / data coming from the client
+codebase. Thankfully, a StagedMockChain can be extended to integrate arbritrary effects, such
+as a State or a Reader effect, within a bundle (if several effects are used) placed at the
+right location within the effect stack. Let's rewrite the above using this capability.
+--}
+
+data Environment = Environment
+  { alice :: Wallet,
+    bob :: Wallet,
+    trueScript :: MultiPurposeScript (),
+    falseScript :: MultiPurposeScript (),
+    permanent :: Api.TokenName,
+    quick :: Api.TokenName
+  }
+
+initialEnvironment :: Environment
+initialEnvironment =
+  Environment
+    (wallet 1)
+    (wallet 2)
+    trueMPScript
+    falseMPScript
+    (Api.TokenName "permanent")
+    (Api.TokenName "quick")
+
+demoRunNicknamesEnv :: ExtendedStagedMockChain (Reader Environment) ()
+demoRunNicknamesEnv = do
+  alice <- asks alice >>= define "alice"
+  bob <- asks bob >>= define "bob"
+  trueScript <- asks trueScript >>= define "trueScript"
+  falseScript <- asks falseScript >>= define "falseScript"
+  permanent <- asks permanent >>= define "permanent"
+  quick <- asks quick >>= define "quick"
+  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
+      quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_ $
+    replicate 4 (bob `receives` Value (ada 10))
+      ++ replicate 4 (alice `receives` Value (ada 10))
+      ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
+           alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
+           alice `receives` Value (quickValue 4),
+           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
+           alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
+           alice `receives` InlineDatum (20 :: Integer)
+         ]
+
+{--
+Let's try to run this as we did before (we notice it does not work because we lack an instance)
+--}
+
+instance InterpretAlone (Reader Environment) where
+  runInterpretAlone = runReader initialEnvironment
+
+-- >
+-- Script for the demo :
+--
+-- - Run an empty "StagedMockChain": notice that we see a non-empty state (Initial distribution)
+--
+-- - Run it without the initial distribution ! Clean slate !
+--
+-- - Add a "forceOutputs" call with assets given to peers, notice a similar ending state
+--
+-- - Notice that the ending state is unreadable, add aliases
+--
+-- - Make some queries about existing utxos (show the resulting types, the filtering)
+--
+-- - Make some tracing about the results, and some assertions as well (they only take effect in testing mode)
+
 instance InterpretAlone (Bundle '[State Integer]) where
   runInterpretAlone = evalState 0 . runBundle
 
@@ -20,7 +195,6 @@ stagedRun = do
   -- Defining some aliases for wallets
   alice <- define "alice" $ wallet 1
   bob <- define "bob" $ wallet 2
-  carrie <- define "carrie" $ wallet 3
   -- Defining some aliases for scripts
   trueScript <- define "trueScript" $ trueMPScript @()
   falseScript <- define "falseScript" $ falseMPScript @()
@@ -34,7 +208,6 @@ stagedRun = do
   outputs <-
     forceOutputs $
       replicate 4 (bob `receives` Value (ada 10))
-        ++ replicate 4 (carrie `receives` Value (ada 10))
         ++ replicate 4 (alice `receives` Value (ada 10))
         ++ [ alice `receives` permanentValue 3 <&&> InlineDatum (3 :: Integer),
              alice `receives` permanentValue 5 <&&> HiddenHashedDatum (15 :: Integer),
@@ -46,14 +219,14 @@ stagedRun = do
   noteS "We have given a few assets to Alice, Bob and Carry to begin the run"
   -- Ensuring that "Alice" got 10 utxos out of the "forceOutputs" call
   aliceUtxos <-
-    beginSearch (return outputs)
+    beginSearchP outputs
       & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
   assert' $ length aliceUtxos == 10
   forM_ (zip [(1 :: Integer) ..] aliceUtxos) $ \(i, (_, output)) -> noteL ("Alice UTxO number " <> show i) output
   -- Ensuring that Alice has 2 utxos with quick values with the right amount
   aliceQuickValueExtracts <-
     getExtracts $
-      beginSearch (return outputs)
+      beginSearchP outputs
         & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
         . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
   assert' $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [4, 10])
@@ -61,7 +234,7 @@ stagedRun = do
   -- values, and retrieving the typed content of those datums.
   aliceHashedDatums <-
     getExtracts $
-      beginSearch (return outputs)
+      beginSearchP outputs
         & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
         . extractAFold (txSkelOutValueL % valueAssetClassAmountP falseScript permanent)
         . extractAFold (txSkelOutDatumL % txSkelOutDatumKindAT % datumKindResolvedP)
@@ -75,4 +248,4 @@ stagedRun = do
   sendBundle get
 
 tests :: TestTree
-tests = testCooked "Full staged run" $ mustSucceedTest stagedRun `withInitDist` InitialDistribution []
+tests = testCooked "Full staged run" $ mustSucceedTest stagedRun
diff --git a/tests/Spec/Tweak/Labels.hs b/tests/Spec/Tweak/Labels.hs
index d23ed366c..6ce04d394 100644
--- a/tests/Spec/Tweak/Labels.hs
+++ b/tests/Spec/Tweak/Labels.hs
@@ -24,6 +24,7 @@ payTo target amount = do
 
 payments :: StagedMockChain ()
 payments = do
+  forceOutputs_ [alice `receives` Value (Script.ada 100)]
   payTo alice 10
   payTo bob 5
   payTo bob 8
diff --git a/tests/Spec/Withdrawals.hs b/tests/Spec/Withdrawals.hs
index 9f07e5b70..8ee6340e2 100644
--- a/tests/Spec/Withdrawals.hs
+++ b/tests/Spec/Withdrawals.hs
@@ -4,6 +4,7 @@ import Control.Monad
 import Cooked
 import Data.Maybe
 import Optics.Core.Extras
+import Plutus.Script.Utils.Value qualified as Script
 import Plutus.Withdrawals
 import PlutusLedgerApi.V3 qualified as Api
 import Test.Tasty
@@ -17,6 +18,7 @@ testWithdrawingScript ::
   Maybe Integer ->
   StagedMockChain ()
 testWithdrawingScript userCertifying userRewarding mAmount = do
+  forceOutputs_ [alice `receives` Value (Script.ada 100)]
   when (isJust userCertifying) $
     validateTxSkel_ $
       txSkelTemplate

From 556fe7c012bb5f49c32119f1f07ca0d9c08fc991 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 13 Feb 2026 16:14:11 +0100
Subject: [PATCH 71/96] some improvements here and there

---
 src/Cooked/Attack/DatumHijacking.hs |  18 +-
 src/Cooked/Families.hs              |   2 +-
 src/Cooked/MockChain/Misc.hs        |   2 +-
 src/Cooked/MockChain/State.hs       |   5 +-
 src/Cooked/Pretty/MockChain.hs      |   7 +-
 src/Cooked/Pretty/Options.hs        |   7 +-
 src/Cooked/Pretty/Skeleton.hs       |   2 +-
 src/Cooked/Skeleton/Option.hs       |   9 +-
 tests/Spec/StagedRun.hs             | 280 ++++++++++++++++++----------
 9 files changed, 216 insertions(+), 116 deletions(-)

diff --git a/src/Cooked/Attack/DatumHijacking.hs b/src/Cooked/Attack/DatumHijacking.hs
index e29ac64d5..b7317fcba 100644
--- a/src/Cooked/Attack/DatumHijacking.hs
+++ b/src/Cooked/Attack/DatumHijacking.hs
@@ -8,6 +8,7 @@ module Cooked.Attack.DatumHijacking
     DatumHijackingLabel (..),
     redirectOutputTweakAny,
     datumHijackingAttack,
+    typedByDatumHijackingParams,
     ownedByDatumHijackingParams,
     scriptsDatumHijackingParams,
     defaultDatumHijackingParams,
@@ -78,14 +79,27 @@ outPredDatumHijackingParams = defaultDatumHijackingParams . filtered
 
 -- | Datum hijacking parameters targetting all the outputs owned by a certain
 -- type of owner, and redirecting each of them in a separate transaction.
-ownedByDatumHijackingParams ::
+typedByDatumHijackingParams ::
   forall (oldOwner :: Type) owner.
   ( IsTxSkelOutAllowedOwner owner,
     Typeable oldOwner
   ) =>
   owner ->
   DatumHijackingParams
-ownedByDatumHijackingParams = defaultDatumHijackingParams (txSkelOutOwnerL % userTypedAF @oldOwner)
+typedByDatumHijackingParams = defaultDatumHijackingParams (txSkelOutOwnerL % userTypedAF @oldOwner)
+
+-- | Datum hijacking parameters targetting all the outputs owner by a given
+-- user, and redirecting each of them in a separate transaction.
+ownedByDatumHijackingParams ::
+  forall oldOwner owner.
+  ( IsTxSkelOutAllowedOwner owner,
+    Typeable oldOwner,
+    Eq oldOwner
+  ) =>
+  oldOwner ->
+  owner ->
+  DatumHijackingParams
+ownedByDatumHijackingParams user = defaultDatumHijackingParams (txSkelOutOwnerL % userTypedAF @oldOwner % filtered (== user))
 
 -- | Datum hijacking parameters targetting all the outputs owned by a script,
 -- and redirecting each of them in a separate transaction.
diff --git a/src/Cooked/Families.hs b/src/Cooked/Families.hs
index 9a8bb0a9c..aabb88b82 100644
--- a/src/Cooked/Families.hs
+++ b/src/Cooked/Families.hs
@@ -51,7 +51,7 @@ type family (∪) (xs :: [a]) (ys :: [a]) :: [a] where
 -- because the type checker is not smart enough to understand that this type
 -- family decreases in @els@, due to the presence of @extras@. @extras@ is used
 -- to keep track of the original list and output a relevant message in the empty
--- case, which could otherwise be omitted altogther at no loss of type safety.
+-- case, which could otherwise be omitted altogether at no loss of type safety.
 type family Member (el :: a) (els :: [a]) (extras :: [a]) :: Constraint where
   Member x (x ': xs) _ = ()
   Member x (y ': xs) l = Member x xs (y ': l)
diff --git a/src/Cooked/MockChain/Misc.hs b/src/Cooked/MockChain/Misc.hs
index a7654396b..165a47a01 100644
--- a/src/Cooked/MockChain/Misc.hs
+++ b/src/Cooked/MockChain/Misc.hs
@@ -88,4 +88,4 @@ assert :: forall effs. (Member MockChainMisc effs) => String -> Bool -> Sem effs
 
 -- | Ensures a specific property holds, with a default error message otherwise
 assert' :: forall effs. (Member MockChainMisc effs) => Bool -> Sem effs ()
-assert' = assert "Assertion error"
+assert' = assert "Assertion"
diff --git a/src/Cooked/MockChain/State.hs b/src/Cooked/MockChain/State.hs
index 978bb0c0a..51397681b 100644
--- a/src/Cooked/MockChain/State.hs
+++ b/src/Cooked/MockChain/State.hs
@@ -103,9 +103,10 @@ mcstMOutputL oRef = mcstOutputsL % at oRef % iso (fmap fst) (fmap (,True))
 addOutput :: Api.TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
 addOutput oRef = set (mcstMOutputL oRef) . Just
 
--- | Removes an output from the 'MockChainState'
+-- | Removes an output from the 'MockChainState'. This does not actually remove
+-- it from the map, but instead marks its availability to @False@
 removeOutput :: Api.TxOutRef -> MockChainState -> MockChainState
-removeOutput oRef = set (mcstOutputsL % at oRef) Nothing
+removeOutput oRef = set (mcstOutputsL % at oRef % _Just % _2) False
 
 -- | A simplified version of a 'Cooked.Skeleton.Datum.TxSkelOutDatum' which only
 -- stores the actual datum and whether it is hashed (@True@) or inline
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 658f90e44..0b3bd9c65 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -40,12 +40,15 @@ instance (Show a) => PrettyCooked [MockChainReturn a] where
           (PP.align . prettyCookedOpt opts <$> outcomes)
 
 instance (Show a) => PrettyCooked (MockChainReturn a) where
-  prettyCookedOpt opts' (MockChainReturn res outputs (UtxoState available consumed) (MockChainJournal entries ((`addHashNames` opts') -> opts) noteBook _)) =
+  prettyCookedOpt opts' (MockChainReturn res outputs (UtxoState available consumed) (MockChainJournal entries ((`addHashNames` opts') -> opts) noteBook assertions)) =
     PP.vsep $
       [prettyItemize opts "📔 Notes:" "-" (($ opts) <$> noteBook) | pcOptPrintNotebook opts && not (null noteBook)]
         <> [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
-        <> ["💰" <+> prettyCookedOpt opts available | pcOptPrintRemainingUTxOs opts && not (null available)]
+        <> [ prettyItemize opts "❓ Assertions:" "-" ((\(s, b) -> (if b then "✔" else "✘") <+> prettyCookedOpt opts s) <$> assertions)
+           | pcOptPrintAssertions opts && not (null assertions)
+           ]
         <> ["🗑️" <+> prettyCookedOpt opts consumed | pcOptPrintConsumedUTxOs opts && not (null consumed)]
+        <> ["💰" <+> prettyCookedOpt opts available | pcOptPrintRemainingUTxOs opts && not (null available)]
         <> [ case res of
                Left err -> "🔴 Error:" <+> prettyCookedOpt opts err
                Right a -> "🟢 Success with returned value:" <+> PP.viaShow a
diff --git a/src/Cooked/Pretty/Options.hs b/src/Cooked/Pretty/Options.hs
index fa27369fd..08e1a411a 100644
--- a/src/Cooked/Pretty/Options.hs
+++ b/src/Cooked/Pretty/Options.hs
@@ -46,7 +46,9 @@ data PrettyCookedOpts = PrettyCookedOpts
     -- | Whether to display the return value
     pcOptPrintReturnedValue :: Bool,
     -- | Whether to display the consumed utxos
-    pcOptPrintConsumedUTxOs :: Bool
+    pcOptPrintConsumedUTxOs :: Bool,
+    -- | Whether to display assertions
+    pcOptPrintAssertions :: Bool
   }
   deriving (Eq, Show)
 
@@ -62,7 +64,8 @@ instance Default PrettyCookedOpts where
         pcOptPrintNotebook = True,
         pcOptPrintRemainingUTxOs = True,
         pcOptPrintReturnedValue = True,
-        pcOptPrintConsumedUTxOs = False
+        pcOptPrintConsumedUTxOs = False,
+        pcOptPrintAssertions = True
       }
 
 -- | Whether to print transaction outputs references.
diff --git a/src/Cooked/Pretty/Skeleton.hs b/src/Cooked/Pretty/Skeleton.hs
index e50531b41..81cadb2b7 100644
--- a/src/Cooked/Pretty/Skeleton.hs
+++ b/src/Cooked/Pretty/Skeleton.hs
@@ -246,7 +246,7 @@ instance PrettyCookedList TxSkelOut where
     ]
       ++ catMaybes
         [ prettyCookedOptMaybe opts (output ^. txSkelOutDatumL),
-          ("Reference script hash:" <+>) . prettyHash opts <$> preview txSkelOutReferenceScriptHashAF output
+          ("Reference script:" <+>) . prettyHash opts <$> preview txSkelOutReferenceScriptHashAF output
         ]
 
 instance PrettyCooked TxSkelOut where
diff --git a/src/Cooked/Skeleton/Option.hs b/src/Cooked/Skeleton/Option.hs
index f1910458a..d9b61ab51 100644
--- a/src/Cooked/Skeleton/Option.hs
+++ b/src/Cooked/Skeleton/Option.hs
@@ -76,7 +76,7 @@ data BalancingUtxos
   = -- | Use all UTxOs containing only a Value (no datum, no staking credential,
     -- and no reference script) belonging to the balancing user.
     BalancingUtxosFromBalancingUser
-  | -- | Use the provided UTxOs. UTxOs belonging to scripts will be filtered out
+  | -- | Use the provided UTxOs. UTxOs belonging to scripts will be filtered out.
     BalancingUtxosFromSet (Set Api.TxOutRef)
   deriving (Eq, Ord, Show)
 
@@ -155,13 +155,10 @@ data TxSkelOpts = TxSkelOpts
     -- Default is @[]@.
     txSkelOptModTx :: Cardano.Tx Cardano.ConwayEra -> Cardano.Tx Cardano.ConwayEra,
     -- | Whether to balance the transaction or not, and which user should
-    -- provide/reclaim the missing and surplus value. Balancing ensures that
-    --
-    -- > input + mints == output + fees + burns
+    -- provide/reclaim the missing and surplus value.
     --
     -- If you decide to set @txSkelOptBalance = DoNotBalance@ you will have trouble
-    -- satisfying that equation by hand unless you use @ManualFee@. You will
-    -- likely see a error about value preservation.
+    -- satisfying the balancing equation by hand unless you use @ManualFee@.
     --
     -- Default is 'BalanceWithFirstSignatory'
     txSkelOptBalancingPolicy :: BalancingPolicy,
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index 37a882e50..896b81fdc 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -5,16 +5,36 @@ module Spec.StagedRun where
 import Control.Monad
 import Cooked
 import Data.Default
+import Data.Map qualified as Map
+import Data.Set qualified as Set
 import Optics.Core
 import Plutus.Script.Utils.V3.Generators
 import Plutus.Script.Utils.V3.Typed
 import Plutus.Script.Utils.Value
 import PlutusLedgerApi.V3 qualified as Api
-import Polysemy.Bundle
+import PlutusTx.Prelude qualified as PlutusTx
+import Polysemy
 import Polysemy.Reader
-import Polysemy.State
 import Test.Tasty (TestTree)
 
+printAndRun ::
+  ( Show a,
+    RunnableMockChain effs,
+    Polysemy.Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  IO ()
+printAndRun =
+  printCookedOpt
+    ( def
+        { pcOptPrintLog = True,
+          pcOptHashes = def, -- {pcOptHashNames = mempty},
+          pcOptPrintConsumedUTxOs = True,
+          pcOptPrintRemainingUTxOs = True
+        }
+    )
+    . runMockChainDef
+
 {--
 Script for the demo :
 
@@ -24,44 +44,60 @@ Enter a repl and load the required dependencies.
 > :l tests/Spec/StagedRun
 > import Cooked
 
-- We define a run which does nothing
+We define a run which does nothing
 --}
 
 demoRun :: StagedMockChain ()
 demoRun = return ()
 
 {--
-Maybe we want to include payments directly within the run (as opposed to outside of the run)
+We run it using "printAndRun".
+It's not too impressive, as there's nothing there.
+Let's add some initial assets.
 --}
 
 demoRunForceOutputs :: StagedMockChain ()
 demoRunForceOutputs =
-  forceOutputs_ $
-    replicate 4 (wallet 2 `receives` Value (ada 10))
-      ++ replicate 4 (wallet 1 `receives` Value (ada 10))
-      ++ [wallet 1 `receives` InlineDatum (20 :: Integer)]
+  forceOutputs_
+    [ wallet 2 `receives` Value (ada 10),
+      wallet 1 `receives` ReferenceScript (trueMPScript @()),
+      wallet 1 `receives` InlineDatum (20 :: Integer),
+      wallet 2 `receives` VisibleHashedDatum (10 :: Integer)
+    ]
 
 {--
-Notice that cooked already made some adjustments to the value of an input (min ADA accounted for).
-We can actually ask cooked to show the adjustement it mades during the run.
+WE RUN IT
+
+Notice that there are hashes everywhere. Let's make some aliases
+to improve readability of the mockchain state. We will do two things:
+\* add aliases
+\* change the running option to have the default hashmap
 --}
 
-printAndRunWithLog :: (Show a) => StagedMockChain a -> IO ()
-printAndRunWithLog = printCookedOpt (def {pcOptPrintLog = True}) . runMockChainDef
+demoRunForceOutputsAliases :: StagedMockChain ()
+demoRunForceOutputsAliases = do
+  alice <- define "alice" $ wallet 1
+  bob <- define "bob" $ wallet 2
+  trueScript <- define "trueScript" $ trueMPScript @()
+  forceOutputs_
+    [ bob `receives` Value (ada 10),
+      alice `receives` ReferenceScript trueScript,
+      alice `receives` InlineDatum (20 :: Integer),
+      bob `receives` VisibleHashedDatum (10 :: Integer)
+    ]
 
 {--
+Notice that cooked already made some adjustments to the value of an input (min ADA accounted for).
+We can actually ask cooked to show the adjustement it mades during the run.
+(we change the opt in the runner above)
+
+WE RUN IT
+
 However, we could also tell cooked not to do any adjustment, which would result in a
 UTxO which could not exist on-chain.
---}
 
-demoRunForceOutputsNoMinAda :: StagedMockChain ()
-demoRunForceOutputsNoMinAda =
-  forceOutputs_ $
-    replicate 4 (wallet 2 `receives` Value (ada 10))
-      ++ replicate 4 (wallet 1 `receives` Value (ada 10))
-      ++ [wallet 1 `receives` InlineDatum (20 :: Integer) <&&> FixedValue (ada 0)]
+WE SKIP IT
 
-{--
 In practice, there is no insight to do that in such cases, but during audits it can often be useful to
 check that the computations were done right in the offchain code.
 
@@ -70,34 +106,6 @@ Let's now move on to some more complex and interesting initial values.
 
 demoRunFullForcedOutputs :: StagedMockChain ()
 demoRunFullForcedOutputs = do
-  let alice = wallet 1
-      bob = wallet 2
-      trueScript = trueMPScript @()
-      falseScript = falseMPScript @()
-      permanent = Api.TokenName "permanent"
-      quick = Api.TokenName "quick"
-      permanentValue = review (valueAssetClassAmountP falseScript permanent)
-      quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_ $
-    replicate 4 (bob `receives` Value (ada 10))
-      ++ replicate 4 (alice `receives` Value (ada 10))
-      ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
-           alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
-           alice `receives` Value (quickValue 4),
-           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
-           alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
-           alice `receives` InlineDatum (20 :: Integer)
-         ]
-
-{--
-Notice that cooked made min ADA adjustment to all of the relevant inputs. We can also
-notice that some script have aliases, and the wallets are labelled wallet 1 to wallet 10
-but some other entities such as the token names are represented by their hashes.
-Thankfully, we can freely create nicknames for everything when initializing variables.
---}
-
-demoRunNicknames :: StagedMockChain ()
-demoRunNicknames = do
   alice <- define "alice" $ wallet 1
   bob <- define "bob" $ wallet 2
   trueScript <- define "trueScript" $ trueMPScript @()
@@ -165,87 +173,161 @@ demoRunNicknamesEnv = do
            alice `receives` InlineDatum (20 :: Integer)
          ]
 
-{--
-Let's try to run this as we did before (we notice it does not work because we lack an instance)
---}
-
 instance InterpretAlone (Reader Environment) where
   runInterpretAlone = runReader initialEnvironment
 
--- >
--- Script for the demo :
---
--- - Run an empty "StagedMockChain": notice that we see a non-empty state (Initial distribution)
---
--- - Run it without the initial distribution ! Clean slate !
---
--- - Add a "forceOutputs" call with assets given to peers, notice a similar ending state
---
--- - Notice that the ending state is unreadable, add aliases
---
--- - Make some queries about existing utxos (show the resulting types, the filtering)
---
--- - Make some tracing about the results, and some assertions as well (they only take effect in testing mode)
-
-instance InterpretAlone (Bundle '[State Integer]) where
-  runInterpretAlone = evalState 0 . runBundle
-
-stagedRun :: ExtendedStagedMockChain (Bundle '[State Integer]) Integer
-stagedRun = do
-  -- Defining some aliases for wallets
-  alice <- define "alice" $ wallet 1
-  bob <- define "bob" $ wallet 2
-  -- Defining some aliases for scripts
-  trueScript <- define "trueScript" $ trueMPScript @()
-  falseScript <- define "falseScript" $ falseMPScript @()
-  -- Defining some aliases for tokens
-  permanent <- define "permanent" $ Api.TokenName "permanent"
-  quick <- define "quick" $ Api.TokenName "quick"
-  -- Some values
-  let permanentValue = Value . review (valueAssetClassAmountP falseScript permanent)
-      quickValue = Value . review (valueAssetClassAmountP trueScript quick)
-  -- Providing an initial distribution of funds
+{--
+RUN IT
+
+Now, let's make some assertions, searches and traces
+--}
+
+demoRunSearches :: ExtendedStagedMockChain (Reader Environment) ()
+demoRunSearches = do
+  alice <- asks alice >>= define "alice"
+  bob <- asks bob >>= define "bob"
+  trueScript <- asks trueScript >>= define "trueScript"
+  falseScript <- asks falseScript >>= define "falseScript"
+  permanent <- asks permanent >>= define "permanent"
+  quick <- asks quick >>= define "quick"
+  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
+      quickValue = review (valueAssetClassAmountP trueScript quick)
   outputs <-
     forceOutputs $
       replicate 4 (bob `receives` Value (ada 10))
         ++ replicate 4 (alice `receives` Value (ada 10))
-        ++ [ alice `receives` permanentValue 3 <&&> InlineDatum (3 :: Integer),
-             alice `receives` permanentValue 5 <&&> HiddenHashedDatum (15 :: Integer),
-             alice `receives` quickValue 4,
-             alice `receives` quickValue 10 <&&> VisibleHashedDatum (25 :: Integer),
-             alice `receives` permanentValue 12 <&&> VisibleHashedDatum (10 :: Integer),
+        ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
+             alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
+             alice `receives` Value (quickValue 4),
+             alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
+             alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
              alice `receives` InlineDatum (20 :: Integer)
            ]
   noteS "We have given a few assets to Alice, Bob and Carry to begin the run"
   -- Ensuring that "Alice" got 10 utxos out of the "forceOutputs" call
   aliceUtxos <-
     beginSearchP outputs
-      & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
-  assert' $ length aliceUtxos == 10
+      & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
+  assert "Alice has the right amount of utxos" $ length aliceUtxos == 10
   forM_ (zip [(1 :: Integer) ..] aliceUtxos) $ \(i, (_, output)) -> noteL ("Alice UTxO number " <> show i) output
   -- Ensuring that Alice has 2 utxos with quick values with the right amount
   aliceQuickValueExtracts <-
     getExtracts $
       beginSearchP outputs
-        & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
+        & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
         . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
-  assert' $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [4, 10])
+  assert "We properly extracted the quick token from Alice's utxos" $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [4, 10])
   -- Ensuring that Alice has 2 utxos created with hashed datums with permanent
   -- values, and retrieving the typed content of those datums.
   aliceHashedDatums <-
     getExtracts $
       beginSearchP outputs
-        & ensureAFoldIs (txSkelOutOwnerL % userEitherPubKeyP % userTypedPubKeyAT @Wallet % filtered (== alice))
+        & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
         . extractAFold (txSkelOutValueL % valueAssetClassAmountP falseScript permanent)
         . extractAFold (txSkelOutDatumL % txSkelOutDatumKindAT % datumKindResolvedP)
         . extractAFold (txSkelOutDatumL % txSkelOutDatumTypedAT @Integer)
-  assert' $
+  assert "We properly extracted more info from Alice's utxos" $
     aliceHashedDatums
       == [ HCons 5 (HCons NotResolved (HCons 15 HEmpty)),
            HCons 12 (HCons Resolved (HCons 10 HEmpty))
          ]
-  mplus (sendBundle $ put 10) (sendBundle $ put 20)
-  sendBundle get
+
+{--
+So now that we've seen those features, let's clear out the field and
+start using those UTxOs we've created.
+Make sure the log is visible.
+Speak about signatory and balancing.
+
+Enable show consumed utxos
+
+RUN IT
+
+Remove line  alice `receives` Value (quickValue 4)
+
+RUN IT
+
+Balancing fails.
+Add manual UTxOs for balancing using.
+
+  txSkelOpts = def {txSkelOptBalancingUtxos = BalancingUtxosFromSet $ Set.fromList (fst <$> outputs)}
+
+Notice, thanks to the "consumed utxos", that one UTxO with a datum has been used.
+This makes sense considering the options we provided.
+Maybe a better solution here would be to manually provide the UTxO to spend and preserve the datum in the residual payment.
+
+  txSkelOuts =
+    [ bob `receives` Value (quickValue 2),
+      snd (outputs !! 6) & txSkelOutValueL % valueAssetClassAmountL trueScript quick %~ (+ (-2))
+    ],
+  txSkelIns = Map.singleton (fst (outputs !! 6)) emptyTxSkelRedeemer
+
+--}
+
+demoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
+demoRunFirstTransaction = do
+  alice <- asks alice >>= define "alice"
+  bob <- asks bob >>= define "bob"
+  trueScript <- asks trueScript >>= define "trueScript"
+  falseScript <- asks falseScript >>= define "falseScript"
+  permanent <- asks permanent >>= define "permanent"
+  quick <- asks quick >>= define "quick"
+  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
+      quickValue = review (valueAssetClassAmountP trueScript quick)
+  outputs <-
+    forceOutputs $
+      replicate 4 (alice `receives` Value (ada 10))
+        ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
+             alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (5 :: Integer),
+             -- alice `receives` Value (quickValue 4),
+             alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
+             alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (12 :: Integer),
+             alice `receives` InlineDatum (0 :: Integer)
+           ]
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        -- txSkelOuts = [bob `receives` Value (quickValue 2)],
+        txSkelOuts =
+          [ bob `receives` Value (quickValue 2),
+            snd (outputs !! 6) & txSkelOutValueL % valueAssetClassAmountL trueScript quick %~ (+ (-2))
+          ],
+        txSkelIns = Map.singleton (fst (outputs !! 6)) emptyTxSkelRedeemer
+        -- txSkelOpts = def {txSkelOptBalancingUtxos = BalancingUtxosFromSet $ Set.fromList (fst <$> outputs)}
+      }
+
+{--
+Now, what if we want to quickly change the target of the payment from bob to wallet 3?
+Of course, we don't want to manually change the nominal transaction.
+
+Let's use our first tweak !
+--}
+
+tweakedDemoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
+tweakedDemoRunFirstTransaction = withTweak demoRunFirstTransaction $ do
+  carol <- define "carol" (wallet 3)
+  setTweak (txSkelOutsL % traversed % txSkelOutOwnerL) (UserPubKey carol)
+
+{--
+We can see that carol hit the jackpot ! She got both UTxOs for herself. Something
+went wrong, all we wanted to do was redirect the output initially targeted to bob.
+Let's do better and use ... the DatumHijackingAttack !
+
+Take a look at the various parameters.
+
+RUN IT !
+--}
+
+dhDemoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
+dhDemoRunFirstTransaction = withTweak demoRunFirstTransaction $ do
+  carol <- define "carol" $ wallet 3
+  bob <- asks bob
+  datumHijackingAttack $ ownedByDatumHijackingParams bob carol
+
+{--
+Show that the Skeleton has been labelled in the log
+
+This is already nice, but attempting a DH attack when no script is involved is a bit lame.
+--}
 
 tests :: TestTree
-tests = testCooked "Full staged run" $ mustSucceedTest stagedRun
+tests = testCooked "Full staged run" $ mustSucceedTest @_ @StagedEffs (return ())

From e409f515b0d337a116a30aaccbfc0140a31a5e01 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 13 Feb 2026 19:04:28 +0100
Subject: [PATCH 72/96] continuing the presentation

---
 src/Cooked/Pretty/Hashable.hs  |   3 +
 src/Cooked/Pretty/MockChain.hs |  21 ++-
 tests/Plutus/InlineDatums.hs   |   5 +-
 tests/Spec/StagedRun.hs        | 288 +++++++++++++++++++++++++++------
 4 files changed, 256 insertions(+), 61 deletions(-)

diff --git a/src/Cooked/Pretty/Hashable.hs b/src/Cooked/Pretty/Hashable.hs
index 9bdaf9f16..f427b3c96 100644
--- a/src/Cooked/Pretty/Hashable.hs
+++ b/src/Cooked/Pretty/Hashable.hs
@@ -33,6 +33,9 @@ instance ToHash Wallet where
 instance ToHash (Script.Versioned Script.MintingPolicy) where
   toHash = toHash . Script.toCurrencySymbol
 
+instance ToHash (Script.Versioned Script.Validator) where
+  toHash = toHash . Script.toValidatorHash
+
 instance ToHash (Script.Versioned Script.Script) where
   toHash = toHash . Script.toScriptHash
 
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 0b3bd9c65..eb087a52e 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -42,13 +42,22 @@ instance (Show a) => PrettyCooked [MockChainReturn a] where
 instance (Show a) => PrettyCooked (MockChainReturn a) where
   prettyCookedOpt opts' (MockChainReturn res outputs (UtxoState available consumed) (MockChainJournal entries ((`addHashNames` opts') -> opts) noteBook assertions)) =
     PP.vsep $
-      [prettyItemize opts "📔 Notes:" "-" (($ opts) <$> noteBook) | pcOptPrintNotebook opts && not (null noteBook)]
-        <> [prettyCookedOpt opts (Contextualized outputs entries) | pcOptPrintLog opts && not (null entries)]
-        <> [ prettyItemize opts "❓ Assertions:" "-" ((\(s, b) -> (if b then "✔" else "✘") <+> prettyCookedOpt opts s) <$> assertions)
+      [ prettyItemize opts "📔 Notes:" "-" $ ($ opts) <$> noteBook
+      | pcOptPrintNotebook opts && not (null noteBook)
+      ]
+        <> [ prettyCookedOpt opts $ Contextualized outputs entries
+           | pcOptPrintLog opts && not (null entries)
+           ]
+        <> [ prettyItemize opts (if all snd assertions then "✅ Assertions:" else "❌ Assertions:") "-" $
+               (\(s, b) -> (if b then "✔" else "✘") <+> prettyCookedOpt opts s) <$> assertions
            | pcOptPrintAssertions opts && not (null assertions)
            ]
-        <> ["🗑️" <+> prettyCookedOpt opts consumed | pcOptPrintConsumedUTxOs opts && not (null consumed)]
-        <> ["💰" <+> prettyCookedOpt opts available | pcOptPrintRemainingUTxOs opts && not (null available)]
+        <> [ "🗑️" <+> prettyCookedOpt opts consumed
+           | pcOptPrintConsumedUTxOs opts && not (null consumed)
+           ]
+        <> [ "💰" <+> prettyCookedOpt opts available
+           | pcOptPrintRemainingUTxOs opts && not (null available)
+           ]
         <> [ case res of
                Left err -> "🔴 Error:" <+> prettyCookedOpt opts err
                Right a -> "🟢 Success with returned value:" <+> PP.viaShow a
@@ -244,7 +253,7 @@ instance PrettyCookedList UtxoPayloadSet where
               else Nothing,
             Just (prettyCookedOpt opts utxoPayloadValue),
             (\(dat, hashed) -> "Datum (" <> (if hashed then "hashed" else "inline") <> "):" <+> dat) <$> splitDatum utxoPayloadDatum,
-            ("Reference script hash:" <+>) . prettyHash opts <$> utxoPayloadReferenceScriptHash
+            ("Reference script:" <+>) . prettyHash opts <$> utxoPayloadReferenceScriptHash
           ] of
           [] -> Nothing
           [doc] -> Just $ PP.align doc
diff --git a/tests/Plutus/InlineDatums.hs b/tests/Plutus/InlineDatums.hs
index 4527066f6..e20f9c14b 100644
--- a/tests/Plutus/InlineDatums.hs
+++ b/tests/Plutus/InlineDatums.hs
@@ -2,6 +2,7 @@
 
 module Plutus.InlineDatums where
 
+import Cooked.ShowBS
 import Plutus.Script.Utils.V3 qualified as Script
 import PlutusCore.Version
 import PlutusLedgerApi.V3 qualified as Api
@@ -80,8 +81,8 @@ outputDatumSpendingPurpose datumKind oRef _ _ Api.TxInfo {txInfoInputs, txInfoOu
             (OnlyHash, Api.OutputDatumHash h) -> not $ Map.member h txInfoData
             (Datum, Api.OutputDatumHash h) -> Map.member h txInfoData
             (Inline, Api.OutputDatum _) -> True
-            _ -> False
-    _ -> False
+            _ -> traceError "Wrong matching between expected and real datum kinds"
+    _ -> traceError "Wrong inputs/outputs"
 
 compiledOutputDatumSpendingPurpose :: CompiledCode (OutputDatumKind -> BuiltinData -> BuiltinUnit)
 compiledOutputDatumSpendingPurpose = $$(compile [||script||])
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index 896b81fdc..10e0cd70b 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -8,11 +8,11 @@ import Data.Default
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Optics.Core
+import Plutus.InlineDatums
 import Plutus.Script.Utils.V3.Generators
 import Plutus.Script.Utils.V3.Typed
 import Plutus.Script.Utils.Value
 import PlutusLedgerApi.V3 qualified as Api
-import PlutusTx.Prelude qualified as PlutusTx
 import Polysemy
 import Polysemy.Reader
 import Test.Tasty (TestTree)
@@ -27,9 +27,9 @@ printAndRun ::
 printAndRun =
   printCookedOpt
     ( def
-        { pcOptPrintLog = True,
+        { pcOptPrintLog = False,
           pcOptHashes = def, -- {pcOptHashNames = mempty},
-          pcOptPrintConsumedUTxOs = True,
+          pcOptPrintConsumedUTxOs = False,
           pcOptPrintRemainingUTxOs = True
         }
     )
@@ -44,6 +44,26 @@ Enter a repl and load the required dependencies.
 > :l tests/Spec/StagedRun
 > import Cooked
 
+Start with the following running function
+
+printAndRun ::
+  ( Show a,
+    RunnableMockChain effs,
+    Polysemy.Member MockChainWrite effs
+  ) =>
+  Sem effs a ->
+  IO ()
+printAndRun =
+  printCookedOpt
+    ( def
+        { pcOptPrintLog = False,
+          pcOptHashes = def {pcOptHashNames = mempty},
+          pcOptPrintConsumedUTxOs = False,
+          pcOptPrintRemainingUTxOs = True
+        }
+    )
+    . runMockChainDef
+
 We define a run which does nothing
 --}
 
@@ -87,6 +107,7 @@ demoRunForceOutputsAliases = do
     ]
 
 {--
+
 Notice that cooked already made some adjustments to the value of an input (min ADA accounted for).
 We can actually ask cooked to show the adjustement it mades during the run.
 (we change the opt in the runner above)
@@ -107,21 +128,16 @@ Let's now move on to some more complex and interesting initial values.
 demoRunFullForcedOutputs :: StagedMockChain ()
 demoRunFullForcedOutputs = do
   alice <- define "alice" $ wallet 1
-  bob <- define "bob" $ wallet 2
   trueScript <- define "trueScript" $ trueMPScript @()
-  falseScript <- define "falseScript" $ falseMPScript @()
-  permanent <- define "permanent" $ Api.TokenName "permanent"
   quick <- define "quick" $ Api.TokenName "quick"
-  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
-      quickValue = review (valueAssetClassAmountP trueScript quick)
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
   forceOutputs_ $
-    replicate 4 (bob `receives` Value (ada 10))
-      ++ replicate 4 (alice `receives` Value (ada 10))
-      ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
-           alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
+    replicate 4 (alice `receives` Value (ada 10))
+      ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
+           alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
            alice `receives` Value (quickValue 4),
-           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
-           alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
+           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
+           alice `receives` Value (quickValue 12) <&&> VisibleHashedDatum (12 :: Integer),
            alice `receives` InlineDatum (20 :: Integer)
          ]
 
@@ -155,22 +171,17 @@ initialEnvironment =
 demoRunNicknamesEnv :: ExtendedStagedMockChain (Reader Environment) ()
 demoRunNicknamesEnv = do
   alice <- asks alice >>= define "alice"
-  bob <- asks bob >>= define "bob"
   trueScript <- asks trueScript >>= define "trueScript"
-  falseScript <- asks falseScript >>= define "falseScript"
-  permanent <- asks permanent >>= define "permanent"
   quick <- asks quick >>= define "quick"
-  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
-      quickValue = review (valueAssetClassAmountP trueScript quick)
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
   forceOutputs_ $
-    replicate 4 (bob `receives` Value (ada 10))
-      ++ replicate 4 (alice `receives` Value (ada 10))
-      ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
-           alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
+    replicate 4 (alice `receives` Value (ada 10))
+      ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
+           alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (15 :: Integer),
            alice `receives` Value (quickValue 4),
            alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
-           alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
-           alice `receives` InlineDatum (20 :: Integer)
+           alice `receives` Value (quickValue 12) <&&> VisibleHashedDatum (10 :: Integer),
+           alice `receives` InlineDatum (0 :: Integer)
          ]
 
 instance InterpretAlone (Reader Environment) where
@@ -179,36 +190,32 @@ instance InterpretAlone (Reader Environment) where
 {--
 RUN IT
 
+HIDE THE LOG
+
 Now, let's make some assertions, searches and traces
 --}
 
 demoRunSearches :: ExtendedStagedMockChain (Reader Environment) ()
 demoRunSearches = do
   alice <- asks alice >>= define "alice"
-  bob <- asks bob >>= define "bob"
   trueScript <- asks trueScript >>= define "trueScript"
-  falseScript <- asks falseScript >>= define "falseScript"
-  permanent <- asks permanent >>= define "permanent"
   quick <- asks quick >>= define "quick"
-  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
-      quickValue = review (valueAssetClassAmountP trueScript quick)
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
   outputs <-
     forceOutputs $
-      replicate 4 (bob `receives` Value (ada 10))
-        ++ replicate 4 (alice `receives` Value (ada 10))
-        ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
-             alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (15 :: Integer),
+      replicate 4 (alice `receives` Value (ada 10))
+        ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
+             alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
              alice `receives` Value (quickValue 4),
-             alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
-             alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (10 :: Integer),
-             alice `receives` InlineDatum (20 :: Integer)
+             alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
+             alice `receives` InlineDatum (0 :: Integer)
            ]
-  noteS "We have given a few assets to Alice, Bob and Carry to begin the run"
+  noteS "We have given a few assets to Alice at the beginning of the run"
   -- Ensuring that "Alice" got 10 utxos out of the "forceOutputs" call
   aliceUtxos <-
     beginSearchP outputs
       & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
-  assert "Alice has the right amount of utxos" $ length aliceUtxos == 10
+  assert "Alice has the right amount of utxos" $ length aliceUtxos == 9
   forM_ (zip [(1 :: Integer) ..] aliceUtxos) $ \(i, (_, output)) -> noteL ("Alice UTxO number " <> show i) output
   -- Ensuring that Alice has 2 utxos with quick values with the right amount
   aliceQuickValueExtracts <-
@@ -216,32 +223,57 @@ demoRunSearches = do
       beginSearchP outputs
         & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
         . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
-  assert "We properly extracted the quick token from Alice's utxos" $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [4, 10])
+  assert "We properly extracted the quick tokens from Alice's utxos" $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [3, 5, 4, 10])
   -- Ensuring that Alice has 2 utxos created with hashed datums with permanent
   -- values, and retrieving the typed content of those datums.
   aliceHashedDatums <-
     getExtracts $
       beginSearchP outputs
         & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
-        . extractAFold (txSkelOutValueL % valueAssetClassAmountP falseScript permanent)
+        . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
         . extractAFold (txSkelOutDatumL % txSkelOutDatumKindAT % datumKindResolvedP)
         . extractAFold (txSkelOutDatumL % txSkelOutDatumTypedAT @Integer)
   assert "We properly extracted more info from Alice's utxos" $
     aliceHashedDatums
-      == [ HCons 5 (HCons NotResolved (HCons 15 HEmpty)),
-           HCons 12 (HCons Resolved (HCons 10 HEmpty))
+      == [ HCons 5 (HCons NotResolved (HCons 5 HEmpty)),
+           HCons 10 (HCons Resolved (HCons 10 HEmpty))
          ]
 
 {--
 So now that we've seen those features, let's clear out the field and
 start using those UTxOs we've created.
-Make sure the log is visible.
 Speak about signatory and balancing.
 
+Make sure the log is visible.
 Enable show consumed utxos
 
 RUN IT
 
+--}
+
+demoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
+demoRunFirstTransaction = do
+  alice <- asks alice >>= define "alice"
+  bob <- asks bob >>= define "bob"
+  trueScript <- asks trueScript >>= define "trueScript"
+  quick <- asks quick >>= define "quick"
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_ $
+    replicate 4 (alice `receives` Value (ada 10))
+      ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
+           alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
+           alice `receives` Value (quickValue 4),
+           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
+           alice `receives` InlineDatum (0 :: Integer)
+         ]
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelOuts = [bob `receives` Value (quickValue 2)]
+      }
+
+{--
+
 Remove line  alice `receives` Value (quickValue 4)
 
 RUN IT
@@ -263,24 +295,21 @@ Maybe a better solution here would be to manually provide the UTxO to spend and
 
 --}
 
-demoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
-demoRunFirstTransaction = do
+demoRunFirstTransaction2 :: ExtendedStagedMockChain (Reader Environment) ()
+demoRunFirstTransaction2 = do
   alice <- asks alice >>= define "alice"
   bob <- asks bob >>= define "bob"
   trueScript <- asks trueScript >>= define "trueScript"
-  falseScript <- asks falseScript >>= define "falseScript"
-  permanent <- asks permanent >>= define "permanent"
   quick <- asks quick >>= define "quick"
-  let permanentValue = review (valueAssetClassAmountP falseScript permanent)
-      quickValue = review (valueAssetClassAmountP trueScript quick)
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
   outputs <-
     forceOutputs $
       replicate 4 (alice `receives` Value (ada 10))
-        ++ [ alice `receives` Value (permanentValue 3) <&&> InlineDatum (3 :: Integer),
-             alice `receives` Value (permanentValue 5) <&&> HiddenHashedDatum (5 :: Integer),
+        ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
+             alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
              -- alice `receives` Value (quickValue 4),
              alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
-             alice `receives` Value (permanentValue 12) <&&> VisibleHashedDatum (12 :: Integer),
+             alice `receives` Value (quickValue 12) <&&> VisibleHashedDatum (12 :: Integer),
              alice `receives` InlineDatum (0 :: Integer)
            ]
   validateTxSkel_ $
@@ -327,7 +356,160 @@ dhDemoRunFirstTransaction = withTweak demoRunFirstTransaction $ do
 Show that the Skeleton has been labelled in the log
 
 This is already nice, but attempting a DH attack when no script is involved is a bit lame.
+
+Let's start fresh from a new trace, and have some scripts be executed first.
+We can invoke a minting policy for the sake of it.
+--}
+
+demoRunFirstScripts :: StagedMockChain ()
+demoRunFirstScripts = do
+  alice <- define "alice" $ wallet 1
+  trueScript <- define "trueScript" $ trueMPScript @()
+  quick <- define "quick" $ Api.TokenName "quick"
+  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_ [alice `receives` Value (ada 100)]
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
+        txSkelOuts =
+          [ inlineScript `receives` Value (quickValue 1),
+            trueScript `receives` Value (quickValue 1)
+          ]
+      }
+
+{--
+We can see that the fee for the transaction is .396 ADA. This is not that huge
+but maybe we can do even better. How about we use a reference script?
 --}
 
+demoRunReferenceScript :: StagedMockChain ()
+demoRunReferenceScript = do
+  alice <- define "alice" $ wallet 1
+  trueScript <- define "trueScript" $ trueMPScript @()
+  quick <- define "quick" $ Api.TokenName "quick"
+  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_
+    [ alice `receives` Value (ada 100),
+      alice `receives` ReferenceScript trueScript
+    ]
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
+        txSkelOuts =
+          [ inlineScript `receives` Value (quickValue 1),
+            trueScript `receives` Value (quickValue 1)
+          ]
+      }
+
+{--
+We can see that cooked automatically attached the reference script input.
+Not too bad, even for a small script like the always true script, we now
+only have to pay .192 ADA
+
+Of course this can be disabled. And manual utxos can be provided.
+
+Now let's try to consume those UTxOs we've created at the script addresses.
+
+--}
+
+demoRunScriptUtxos :: StagedMockChain ()
+demoRunScriptUtxos = do
+  alice <- define "alice" $ wallet 1
+  trueScript <- define "trueScript" $ trueMPScript @()
+  quick <- define "quick" $ Api.TokenName "quick"
+  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_
+    [ alice `receives` Value (ada 100),
+      alice `receives` ReferenceScript trueScript
+    ]
+  (isORef, isOutput) : (tsORef, tsOutput) : _ <-
+    validateTxSkel' $
+      txSkelTemplate
+        { txSkelSignatories = txSkelSignatoriesFromList [alice],
+          txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
+          txSkelOuts =
+            [ inlineScript `receives` Value (quickValue 1),
+              trueScript `receives` Value (quickValue 1)
+            ]
+        }
+
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelIns = Map.singleton tsORef emptyTxSkelRedeemer,
+        txSkelOuts = [tsOutput]
+      }
+
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelIns = Map.singleton isORef emptyTxSkelRedeemer,
+        txSkelOuts = [isOutput]
+      }
+
+{--
+It does not work ! We have a phase 2 validation error, because the inline validator
+requires ... an inline datum in its continuing output. Let's fix this.
+--}
+
+demoRunScriptUtxosFixed :: StagedMockChain ()
+demoRunScriptUtxosFixed = do
+  alice <- define "alice" $ wallet 1
+  trueScript <- define "trueScript" $ trueMPScript @()
+  quick <- define "quick" $ Api.TokenName "quick"
+  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
+  let quickValue = review (valueAssetClassAmountP trueScript quick)
+  forceOutputs_
+    [ alice `receives` Value (ada 100),
+      alice `receives` ReferenceScript trueScript
+    ]
+  (isORef, isOutput) : (tsORef, tsOutput) : _ <-
+    validateTxSkel' $
+      txSkelTemplate
+        { txSkelSignatories = txSkelSignatoriesFromList [alice],
+          txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
+          txSkelOuts =
+            [ inlineScript `receives` Value (quickValue 1),
+              trueScript `receives` Value (quickValue 1)
+            ]
+        }
+
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelIns = Map.singleton tsORef emptyTxSkelRedeemer,
+        txSkelOuts = [tsOutput]
+      }
+
+  validateTxSkel_ $
+    txSkelTemplate
+      { txSkelSignatories = txSkelSignatoriesFromList [alice],
+        txSkelIns = Map.singleton isORef emptyTxSkelRedeemer,
+        txSkelOuts = [set txSkelOutDatumL (SomeTxSkelOutDatum () Cooked.Inline) isOutput],
+        txSkelLabels = Set.fromList [label "Spending inlineScript"]
+      }
+
+{--
+From here onwards, deactivate the log and the consumed UTXOs
+
+Let spice things up a little bit.
+
+We notice that spending the inline validator only requires an inline datum, no
+matter the content of the utxo.
+
+Let's label the interesting transaction (WE DO IT) and target it for a nice attack.
+--}
+
+demoRunInlineDatumHijacking :: StagedMockChain ()
+demoRunInlineDatumHijacking =
+  (`whenAble` demoRunScriptUtxosFixed) $ labelled' "Spending inlineScript" $ do
+    void $ datumHijackingAttack (ownedByDatumHijackingParams requireInlineDatumInOutputValidator (wallet 1))
+    overTweak txSkelOutsL ((requireInlineDatumInOutputValidator `receives` InlineDatum ()) :)
+
 tests :: TestTree
 tests = testCooked "Full staged run" $ mustSucceedTest @_ @StagedEffs (return ())

From 1df10c8c74e8b8306d6961e5025bf5f66d254458 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 13 Feb 2026 23:53:06 +0100
Subject: [PATCH 73/96] very slight adjustments

---
 src/Cooked/MockChain/Balancing.hs | 5 ++++-
 tests/Spec/StagedRun.hs           | 6 +++---
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 3655a5d2e..c61376705 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -136,6 +136,9 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
 
 -- | This computes the minimum and maximum possible fee a transaction can cost
 -- based on the current protocol parameters and its number of scripts.
+-- In the Dijsktra era, this will be modified with new protocol parameters.
+-- See https://github.com/IntersectMBO/cardano-ledger/blob/master/docs/adr/2024-08-14_009-refscripts-fee-change.md
+-- for more information
 getMinAndMaxFee :: (Member MockChainRead effs) => Fee -> Sem effs (Fee, Fee)
 getMinAndMaxFee nbOfScripts = do
   -- We retrieve the necessary parameters to compute the maximum possible fee
@@ -289,7 +292,7 @@ collateralsFromFees fee (Just (collateralIns, returnCollateralUser)) =
 reachValue ::
   Utxos ->
   Api.Value ->
-  Fee ->
+  Integer ->
   [(Utxos, Api.Value)]
 -- Target is smaller than the empty value (which means in only contains negative
 -- entries), we stop looking as adding more elements would be superfluous.
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index 10e0cd70b..9b025c2ef 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -8,7 +8,7 @@ import Data.Default
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Optics.Core
-import Plutus.InlineDatums
+import Plutus.InlineDatums (requireInlineDatumInOutputValidator)
 import Plutus.Script.Utils.V3.Generators
 import Plutus.Script.Utils.V3.Typed
 import Plutus.Script.Utils.Value
@@ -490,8 +490,8 @@ demoRunScriptUtxosFixed = do
     txSkelTemplate
       { txSkelSignatories = txSkelSignatoriesFromList [alice],
         txSkelIns = Map.singleton isORef emptyTxSkelRedeemer,
-        txSkelOuts = [set txSkelOutDatumL (SomeTxSkelOutDatum () Cooked.Inline) isOutput],
-        txSkelLabels = Set.fromList [label "Spending inlineScript"]
+        txSkelOuts = [set txSkelOutDatumL (SomeTxSkelOutDatum () Inline) isOutput] -- ,
+        -- txSkelLabels = Set.fromList [label "Spending inlineScript"]
       }
 
 {--

From f2770ccb603d965f7ec9fa28f1392e61177d71b2 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sat, 14 Feb 2026 15:11:39 +0100
Subject: [PATCH 74/96] defer validtation errors during balancing

---
 src/Cooked/MockChain/GenerateTx/Body.hs | 13 ++++++----
 src/Cooked/Pretty/Skeleton.hs           |  5 ++--
 src/Cooked/Skeleton/Option.hs           | 32 ++++++++++++++++++++-----
 tests/Spec/StagedRun.hs                 |  2 +-
 4 files changed, 39 insertions(+), 13 deletions(-)

diff --git a/src/Cooked/MockChain/GenerateTx/Body.hs b/src/Cooked/MockChain/GenerateTx/Body.hs
index 7bed7d27a..2f6b27788 100644
--- a/src/Cooked/MockChain/GenerateTx/Body.hs
+++ b/src/Cooked/MockChain/GenerateTx/Body.hs
@@ -119,9 +119,14 @@ txSkelToTxBody txSkel fee mCollaterals = do
   params <- getParams
   -- We retrieve the execution units associated with the transaction
   case Emulator.getTxExUnitsWithLogs params (Ledger.fromPlutusIndex index) tx' of
-    -- Computing the execution units can result in all kinds of validation
-    -- errors except for the ones related to the execution units themselves.
-    Left err -> throw $ uncurry MCEValidationError err
+    -- Computing the execution units can result in all kinds of phase 2
+    -- validation failures, except for the ones related to the execution units
+    -- themselves. Unless required in the options, we throw the validation
+    -- failure right away when applicable.
+    Left err | not $ txSkelOptDeferPhase2FailuresDuringBalancing $ txSkelOpts txSkel -> throw $ uncurry MCEValidationError err
+    -- The other option is to ignore those and return the unchanged body with
+    -- the existing execution units, postponing the handling of the failures.
+    Left _ -> return txBody'
     -- When no error arises, we get an execution unit for each script usage. We
     -- first have to transform this Ledger map to a cardano API map.
     Right (Map.mapKeysMonotonic (Cardano.toScriptIndex Cardano.AlonzoEraOnwardsConway) . fmap (Cardano.fromAlonzoExUnits . snd) -> exUnits) ->
@@ -131,7 +136,7 @@ txSkelToTxBody txSkel fee mCollaterals = do
         Left _ -> fail "Error while assigning execution units"
         -- We now have a body content with proper execution units and can create
         -- the final body from it
-        Right txBody -> txBodyContentToTxBody txBody
+        Right txBodyContent -> txBodyContentToTxBody txBodyContent
 
 -- | Generates a Cardano transaction and signs it
 txSignatoriesAndBodyToCardanoTx ::
diff --git a/src/Cooked/Pretty/Skeleton.hs b/src/Cooked/Pretty/Skeleton.hs
index 81cadb2b7..cb2e15960 100644
--- a/src/Cooked/Pretty/Skeleton.hs
+++ b/src/Cooked/Pretty/Skeleton.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveFunctor #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 -- | This module implements 'PrettyCooked', 'PrettyCookedList' and
@@ -293,13 +292,15 @@ instance PrettyCookedList TxSkelOpts where
         txSkelOptBalancingUtxos
         _
         txSkelOptCollateralUtxos
+        txSkelOptDeferFailures
       ) =
       [ prettyIfNot True prettyAutoSlotIncrease txSkelOptAutoSlotIncrease,
         prettyIfNot def prettyBalanceOutputPolicy txSkelOptBalanceOutputPolicy,
         prettyIfNot def prettyBalanceFeePolicy txSkelOptFeePolicy,
         prettyIfNot def prettyBalancingPolicy txSkelOptBalancingPolicy,
         prettyIfNot def prettyBalancingUtxos txSkelOptBalancingUtxos,
-        prettyIfNot def prettyCollateralUtxos txSkelOptCollateralUtxos
+        prettyIfNot def prettyCollateralUtxos txSkelOptCollateralUtxos,
+        prettyIfNot False (const "Defer Phase 2 failures during balancing") txSkelOptDeferFailures
       ]
       where
         prettyIfNot :: (Eq a) => a -> (a -> DocCooked) -> a -> Maybe DocCooked
diff --git a/src/Cooked/Skeleton/Option.hs b/src/Cooked/Skeleton/Option.hs
index d9b61ab51..2da05a9bf 100644
--- a/src/Cooked/Skeleton/Option.hs
+++ b/src/Cooked/Skeleton/Option.hs
@@ -193,26 +193,45 @@ data TxSkelOpts = TxSkelOpts
     -- computed automatically from a given, or the balancing, user.
     --
     -- Default is 'CollateralUtxosFromBalancingUser'
-    txSkelOptCollateralUtxos :: CollateralUtxos
+    txSkelOptCollateralUtxos :: CollateralUtxos,
+    -- | Whether to defer validation failures occurring during balancing
+    -- (specifically during the computation of execution units) to the actual
+    -- later validation attempt of the transaction.
+    --
+    -- When set to @False@: the phase 2 validation failures will be caught as
+    -- early as possible, during the first attempt at generating a proper
+    -- Cardano body. This will shortcut the whole balancing process which
+    -- iterates the body generation, and thus increase performances (by 40%). As
+    -- a result, the balanced `TxSkel` will never be computed and thus will be
+    -- absent from the log, which is the only downside.
+    --
+    -- When set to @True@: the phase 2 validation erros will be ignored during
+    -- the balancing process. This will result in a worst performance, but will
+    -- allow the log to display a balanced version of the failing `TxSkel`,
+    -- which might be useful. Only use this when debugging complicated phase 2
+    -- failures which require a precise view of the balanced `TxSkel` sent for
+    -- validation.
+    txSkelOptDeferPhase2FailuresDuringBalancing :: Bool
   }
 
 -- | Comparing 'TxSkelOpts' is possible as long as we ignore modifications to the
 -- generated transaction and the parameters.
 instance Eq TxSkelOpts where
-  (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos)
-    == (TxSkelOpts slotIncrease' _ balancingPol' feePol' balOutputPol' balUtxos' _ colUtxos') =
+  (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos deferFailures)
+    == (TxSkelOpts slotIncrease' _ balancingPol' feePol' balOutputPol' balUtxos' _ colUtxos' deferFailures') =
       slotIncrease == slotIncrease'
         && balancingPol == balancingPol'
         && feePol == feePol'
         && balOutputPol == balOutputPol'
         && balUtxos == balUtxos'
         && colUtxos == colUtxos'
+        && deferFailures == deferFailures'
 
 -- | Showing 'TxSkelOpts' is possible as long as we ignore modifications to the
 -- generated transaction and the parameters.
 instance Show TxSkelOpts where
-  show (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos) =
-    show [show slotIncrease, show balancingPol, show feePol, show balOutputPol, show balUtxos, show colUtxos]
+  show (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos deferFailures) =
+    show [show slotIncrease, show balancingPol, show feePol, show balOutputPol, show balUtxos, show colUtxos, show deferFailures]
 
 -- | A lens to get or set the automatic slot increase option
 makeLensesFor [("txSkelOptAutoSlotIncrease", "txSkelOptAutoSlotIncreaseL")] ''TxSkelOpts
@@ -251,7 +270,8 @@ instance Default TxSkelOpts where
         txSkelOptFeePolicy = def,
         txSkelOptBalancingUtxos = def,
         txSkelOptModParams = id,
-        txSkelOptCollateralUtxos = def
+        txSkelOptCollateralUtxos = def,
+        txSkelOptDeferPhase2FailuresDuringBalancing = False
       }
 
 -- | Appends a transaction modification to the given 'TxSkelOpts'
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
index 9b025c2ef..afaa03881 100644
--- a/tests/Spec/StagedRun.hs
+++ b/tests/Spec/StagedRun.hs
@@ -27,7 +27,7 @@ printAndRun ::
 printAndRun =
   printCookedOpt
     ( def
-        { pcOptPrintLog = False,
+        { pcOptPrintLog = True,
           pcOptHashes = def, -- {pcOptHashNames = mempty},
           pcOptPrintConsumedUTxOs = False,
           pcOptPrintRemainingUTxOs = True

From b1a92db4c93d11170b401bbbdaf8a428ad40c4cf Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Sun, 15 Feb 2026 19:52:35 +0100
Subject: [PATCH 75/96] balancing

---
 src/Cooked/MockChain/Balancing.hs | 61 +++++++++++++++++++------------
 src/Cooked/Pretty/Skeleton.hs     |  6 ++-
 src/Cooked/Skeleton/Option.hs     | 49 ++++++++++++++++++-------
 3 files changed, 77 insertions(+), 39 deletions(-)

diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index c61376705..e1e2511dc 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -27,6 +27,7 @@ import Data.Bifunctor
 import Data.Function
 import Data.List (find, partition, sortBy)
 import Data.Map qualified as Map
+import Data.Maybe (fromMaybe)
 import Data.Ratio qualified as Rat
 import Data.Set qualified as Set
 import Ledger.Tx qualified as Ledger
@@ -139,7 +140,10 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
 -- In the Dijsktra era, this will be modified with new protocol parameters.
 -- See https://github.com/IntersectMBO/cardano-ledger/blob/master/docs/adr/2024-08-14_009-refscripts-fee-change.md
 -- for more information
-getMinAndMaxFee :: (Member MockChainRead effs) => Fee -> Sem effs (Fee, Fee)
+getMinAndMaxFee ::
+  (Members '[MockChainRead] effs) =>
+  Integer ->
+  Sem effs (Fee, Fee)
 getMinAndMaxFee nbOfScripts = do
   -- We retrieve the necessary parameters to compute the maximum possible fee
   -- for a transaction. There are quite a few of them.
@@ -290,30 +294,37 @@ collateralsFromFees fee (Just (collateralIns, returnCollateralUser)) =
 -- optimizations, this function is theoretically in 2^n where n is the number of
 -- candidate UTxOs. Use with caution.
 reachValue ::
+  -- | The Utxos available to reach the value
   Utxos ->
+  -- | The target value to reach
   Api.Value ->
+  -- | The maximum number of Utxos allowed to reach the target
   Integer ->
+  -- | A list of lists of Utxos sufficient to reach the target, with the
+  -- exceeding amount between their total sum and the target.
   [(Utxos, Api.Value)]
--- Target is smaller than the empty value (which means in only contains negative
--- entries), we stop looking as adding more elements would be superfluous.
-reachValue _ target _ | target `Api.leq` mempty = [([], PlutusTx.negate target)]
--- The target is not reached, but the max number of elements is reached, we
--- would need more elements but are not allowed to look for them.
-reachValue _ _ maxEls | maxEls == 0 = []
--- The target is not reached, and cannot possibly be reached, as the remaining
--- candidates do not sum up to the target.
-reachValue l target _ | not $ target `Api.leq` mconcat (view txSkelOutValueL . snd <$> l) = []
--- There is no more elements to go through and the target has not been
--- reached. Encompassed by the previous case, but needed by GHC.
-reachValue [] _ _ = []
--- Main recursive case, where we either pick or drop the head. We only pick the
--- head if it contributes to reaching the target, i.e. if its intersection with
--- the positive part of the target is not empty.
-reachValue (h@(_, view txSkelOutValueL -> hVal) : t) target maxEls =
-  (++) (reachValue t target maxEls) $
-    if snd (Api.split target) PlutusTx./\ hVal == mempty
-      then []
-      else first (h :) <$> reachValue t (target <> PlutusTx.negate hVal) (maxEls - 1)
+reachValue utxos = go utxos (mconcat $ view txSkelOutValueL . snd <$> utxos)
+  where
+    go :: Utxos -> Api.Value -> Api.Value -> Integer -> [(Utxos, Api.Value)]
+    -- Target is smaller than the empty value (which means in only contains negative
+    -- entries), we stop looking as adding more elements would be superfluous.
+    go _ _ target _ | target `Api.leq` mempty = [([], PlutusTx.negate target)]
+    -- The fuel has been fully consumed, and the target is not yet reached.
+    go _ _ _ fuel | fuel <= 0 = []
+    -- The target is not reached, and cannot possibly be reached, as the remaining
+    -- candidates do not sum up to the target.
+    go _ available target _ | not $ target `Api.leq` available = []
+    -- There is no more elements to go through and the target has not been
+    -- reached. Encompassed by the previous case, but needed by GHC.
+    go [] _ _ _ = []
+    -- Main recursive case, where we either pick or drop the head. We only pick the
+    -- head if it contributes to reaching the target, i.e. if its intersection with
+    -- the positive part of the target is not empty.
+    go (h@(_, view txSkelOutValueL -> hVal) : t) ((<> PlutusTx.negate hVal) -> available') target fuel =
+      go t available' target fuel
+        ++ if snd (Api.split target) PlutusTx./\ hVal == mempty
+          then []
+          else first (h :) <$> go t available' (target <> PlutusTx.negate hVal) (fuel - 1)
 
 -- | A helper function to grab an optimal candidate in terms of having a minimal
 -- enough amount of ada to sustain itself meant to be used after calling
@@ -335,8 +346,8 @@ getOptimalCandidate candidates paymentTarget mceError = do
     [] -> throw mceError
     (_, ret) : _ -> return ret
 
--- | This function was originally inspired by
--- https://github.com/input-output-hk/plutus-apps/blob/d4255f05477fd8477ee9673e850ebb9ebb8c9657/plutus-ledger/src/Ledger/Fee.hs#L19
+-- | Estimates the required fee for a given skeleton with a given initial fee
+-- and collaterals
 estimateTxSkelFee ::
   (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   TxSkel ->
@@ -404,9 +415,11 @@ computeBalancedTxSkel balancingUser balancingUtxos txSkel@TxSkel {..} (Script.lo
   let noInputs = inValue == mempty && missingLeft' == mempty
       missingLeft'' = if noInputs then Script.lovelace 1 else missingLeft'
       missingRight'' = if noInputs then missingRight' <> Script.lovelace 1 else missingRight'
+  -- We retrieve the maximum number of Utxos that can be used for balancing
+  let maxNbOfBalancingUtxos = fromMaybe (toInteger $ length balancingUtxos) (txSkelOptMaxNbOfBalancingUtxos txSkelOpts)
   -- This gives us what we need to run our `reachValue` algorithm and append to
   -- the resulting values whatever payment was missing in the initial skeleton
-  let candidatesRaw = second (<> missingRight'') <$> reachValue balancingUtxos missingLeft'' (toInteger $ length balancingUtxos)
+  let candidatesRaw = second (<> missingRight'') <$> reachValue balancingUtxos missingLeft'' maxNbOfBalancingUtxos
   -- We prepare a possible balancing error with the difference between the
   -- requested amount and the maximum amount provided by the balancing user
   let totalValue = mconcat $ view txSkelOutValueL . snd <$> balancingUtxos
diff --git a/src/Cooked/Pretty/Skeleton.hs b/src/Cooked/Pretty/Skeleton.hs
index cb2e15960..8b3b0b725 100644
--- a/src/Cooked/Pretty/Skeleton.hs
+++ b/src/Cooked/Pretty/Skeleton.hs
@@ -12,7 +12,7 @@ import Cooked.Wallet (Wallet)
 import Data.Default
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromJust)
 import Data.Set qualified as Set
 import Ledger.Slot qualified as Ledger
 import Optics.Core
@@ -293,6 +293,7 @@ instance PrettyCookedList TxSkelOpts where
         _
         txSkelOptCollateralUtxos
         txSkelOptDeferFailures
+        txSkelOptMaxNbOfBalancingUtxos
       ) =
       [ prettyIfNot True prettyAutoSlotIncrease txSkelOptAutoSlotIncrease,
         prettyIfNot def prettyBalanceOutputPolicy txSkelOptBalanceOutputPolicy,
@@ -300,7 +301,8 @@ instance PrettyCookedList TxSkelOpts where
         prettyIfNot def prettyBalancingPolicy txSkelOptBalancingPolicy,
         prettyIfNot def prettyBalancingUtxos txSkelOptBalancingUtxos,
         prettyIfNot def prettyCollateralUtxos txSkelOptCollateralUtxos,
-        prettyIfNot False (const "Defer Phase 2 failures during balancing") txSkelOptDeferFailures
+        prettyIfNot False (const "Defer Phase 2 failures during balancing") txSkelOptDeferFailures,
+        prettyIfNot Nothing (("Limit the number of balancing Utxos to " <>) . PP.pretty . fromJust) txSkelOptMaxNbOfBalancingUtxos
       ]
       where
         prettyIfNot :: (Eq a) => a -> (a -> DocCooked) -> a -> Maybe DocCooked
diff --git a/src/Cooked/Skeleton/Option.hs b/src/Cooked/Skeleton/Option.hs
index 2da05a9bf..61353350b 100644
--- a/src/Cooked/Skeleton/Option.hs
+++ b/src/Cooked/Skeleton/Option.hs
@@ -20,6 +20,8 @@ module Cooked.Skeleton.Option
     txSkelOptBalancingUtxosL,
     txSkelOptModParamsL,
     txSkelOptCollateralUtxosL,
+    txSkelOptDeferPhase2FailuresDuringBalancingL,
+    txSkelOptMaxNbOfBalancingUtxosL,
 
     -- * Utilities
     txSkelOptAddModTx,
@@ -196,29 +198,45 @@ data TxSkelOpts = TxSkelOpts
     txSkelOptCollateralUtxos :: CollateralUtxos,
     -- | Whether to defer validation failures occurring during balancing
     -- (specifically during the computation of execution units) to the actual
-    -- later validation attempt of the transaction.
+    -- later submission of the transaction.
     --
     -- When set to @False@: the phase 2 validation failures will be caught as
-    -- early as possible, during the first attempt at generating a proper
-    -- Cardano body. This will shortcut the whole balancing process which
+    -- early as possible, typically during balancing when the execution units
+    -- are computed. This will shortcut the whole balancing process which
     -- iterates the body generation, and thus increase performances (by 40%). As
     -- a result, the balanced `TxSkel` will never be computed and thus will be
     -- absent from the log, which is the only downside.
     --
     -- When set to @True@: the phase 2 validation erros will be ignored during
-    -- the balancing process. This will result in a worst performance, but will
-    -- allow the log to display a balanced version of the failing `TxSkel`,
+    -- the balancing process. This will result in a worst performance (40%), but
+    -- will allow the log to display a balanced version of the failing `TxSkel`,
     -- which might be useful. Only use this when debugging complicated phase 2
     -- failures which require a precise view of the balanced `TxSkel` sent for
     -- validation.
-    txSkelOptDeferPhase2FailuresDuringBalancing :: Bool
+    --
+    -- Default is `False`
+    txSkelOptDeferPhase2FailuresDuringBalancing :: Bool,
+    -- | The optional maximum number of Utxos that can be used during
+    -- balancing. The algorithm which selects Utxos when permorming balancing is
+    -- greedy. In the default use case where the are only a few wallets and
+    -- Utxos (the most common case for testing purpose), this is fine. However,
+    -- if the amount of candidate Utxos is big (let's say, bigger than 15), this
+    -- is problematic. Use this option to limit the number of Utxos that can be
+    -- used during the balancing process.
+    --
+    -- Alternatively, this can also be used to pilot balancing in some way. For
+    -- instance, setting this option to @Just 1@ will result in a single Utxo
+    -- added in the inputs of the transaction, if such a Utxo exist.
+    --
+    -- Default is @Nothing@
+    txSkelOptMaxNbOfBalancingUtxos :: Maybe Integer
   }
 
 -- | Comparing 'TxSkelOpts' is possible as long as we ignore modifications to the
 -- generated transaction and the parameters.
 instance Eq TxSkelOpts where
-  (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos deferFailures)
-    == (TxSkelOpts slotIncrease' _ balancingPol' feePol' balOutputPol' balUtxos' _ colUtxos' deferFailures') =
+  (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos deferFailures maxNbBalUtxos)
+    == (TxSkelOpts slotIncrease' _ balancingPol' feePol' balOutputPol' balUtxos' _ colUtxos' deferFailures' maxNbBalUtxos') =
       slotIncrease == slotIncrease'
         && balancingPol == balancingPol'
         && feePol == feePol'
@@ -226,12 +244,13 @@ instance Eq TxSkelOpts where
         && balUtxos == balUtxos'
         && colUtxos == colUtxos'
         && deferFailures == deferFailures'
+        && maxNbBalUtxos == maxNbBalUtxos'
 
 -- | Showing 'TxSkelOpts' is possible as long as we ignore modifications to the
 -- generated transaction and the parameters.
 instance Show TxSkelOpts where
-  show (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos deferFailures) =
-    show [show slotIncrease, show balancingPol, show feePol, show balOutputPol, show balUtxos, show colUtxos, show deferFailures]
+  show (TxSkelOpts slotIncrease _ balancingPol feePol balOutputPol balUtxos _ colUtxos deferFailures maxNbBalUtxos) =
+    show [show slotIncrease, show balancingPol, show feePol, show balOutputPol, show balUtxos, show colUtxos, show deferFailures, show maxNbBalUtxos]
 
 -- | A lens to get or set the automatic slot increase option
 makeLensesFor [("txSkelOptAutoSlotIncrease", "txSkelOptAutoSlotIncreaseL")] ''TxSkelOpts
@@ -257,8 +276,11 @@ makeLensesFor [("txSkelOptModParams", "txSkelOptModParamsL")] ''TxSkelOpts
 -- | A lens to get or set the collateral utxos option
 makeLensesFor [("txSkelOptCollateralUtxos", "txSkelOptCollateralUtxosL")] ''TxSkelOpts
 
--- | A lens to get or set the anchor resolution option
-makeLensesFor [("txSkelOptAnchorResolution", "txSkelOptAnchorResolutionL")] ''TxSkelOpts
+-- | A lens to get or set the deferring of the failures option
+makeLensesFor [("txSkelOptDeferPhase2FailuresDuringBalancing", "txSkelOptDeferPhase2FailuresDuringBalancingL")] ''TxSkelOpts
+
+-- | A lens to get or set the max nb of balancing Utxos option
+makeLensesFor [("txSkelOptMaxNbOfBalancingUtxos", "txSkelOptMaxNbOfBalancingUtxosL")] ''TxSkelOpts
 
 instance Default TxSkelOpts where
   def =
@@ -271,7 +293,8 @@ instance Default TxSkelOpts where
         txSkelOptBalancingUtxos = def,
         txSkelOptModParams = id,
         txSkelOptCollateralUtxos = def,
-        txSkelOptDeferPhase2FailuresDuringBalancing = False
+        txSkelOptDeferPhase2FailuresDuringBalancing = False,
+        txSkelOptMaxNbOfBalancingUtxos = Nothing
       }
 
 -- | Appends a transaction modification to the given 'TxSkelOpts'

From 785f97f4b74ba9129a718b7e538b05457862cede Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 16 Feb 2026 22:27:41 +0100
Subject: [PATCH 76/96] without the demo

---
 cooked-validators.cabal      |   1 -
 tests/Plutus/InlineDatums.hs |   1 -
 tests/Spec.hs                |   2 -
 tests/Spec/StagedRun.hs      | 515 -----------------------------------
 4 files changed, 519 deletions(-)
 delete mode 100644 tests/Spec/StagedRun.hs

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index 1eb38e96a..a72a511ba 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -189,7 +189,6 @@ test-suite spec
       Spec.ReferenceInputs
       Spec.ReferenceScripts
       Spec.Slot
-      Spec.StagedRun
       Spec.Tweak
       Spec.Tweak.Common
       Spec.Tweak.Labels
diff --git a/tests/Plutus/InlineDatums.hs b/tests/Plutus/InlineDatums.hs
index e20f9c14b..f8742dcf1 100644
--- a/tests/Plutus/InlineDatums.hs
+++ b/tests/Plutus/InlineDatums.hs
@@ -2,7 +2,6 @@
 
 module Plutus.InlineDatums where
 
-import Cooked.ShowBS
 import Plutus.Script.Utils.V3 qualified as Script
 import PlutusCore.Version
 import PlutusLedgerApi.V3 qualified as Api
diff --git a/tests/Spec.hs b/tests/Spec.hs
index 59a72ab31..5ef3a09d9 100644
--- a/tests/Spec.hs
+++ b/tests/Spec.hs
@@ -11,7 +11,6 @@ import Spec.ProposingScript qualified as ProposingScript
 import Spec.ReferenceInputs qualified as ReferenceInputs
 import Spec.ReferenceScripts qualified as ReferenceScripts
 import Spec.Slot qualified as Slot
-import Spec.StagedRun qualified as Staged
 import Spec.Tweak qualified as Tweak
 import Spec.Withdrawals qualified as Withdrawals
 import Test.Tasty
@@ -34,7 +33,6 @@ main =
         ReferenceInputs.tests,
         ReferenceScripts.tests,
         Slot.tests,
-        Staged.tests,
         Tweak.tests,
         Withdrawals.tests
       ]
diff --git a/tests/Spec/StagedRun.hs b/tests/Spec/StagedRun.hs
deleted file mode 100644
index 9b025c2ef..000000000
--- a/tests/Spec/StagedRun.hs
+++ /dev/null
@@ -1,515 +0,0 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-
-module Spec.StagedRun where
-
-import Control.Monad
-import Cooked
-import Data.Default
-import Data.Map qualified as Map
-import Data.Set qualified as Set
-import Optics.Core
-import Plutus.InlineDatums (requireInlineDatumInOutputValidator)
-import Plutus.Script.Utils.V3.Generators
-import Plutus.Script.Utils.V3.Typed
-import Plutus.Script.Utils.Value
-import PlutusLedgerApi.V3 qualified as Api
-import Polysemy
-import Polysemy.Reader
-import Test.Tasty (TestTree)
-
-printAndRun ::
-  ( Show a,
-    RunnableMockChain effs,
-    Polysemy.Member MockChainWrite effs
-  ) =>
-  Sem effs a ->
-  IO ()
-printAndRun =
-  printCookedOpt
-    ( def
-        { pcOptPrintLog = False,
-          pcOptHashes = def, -- {pcOptHashNames = mempty},
-          pcOptPrintConsumedUTxOs = False,
-          pcOptPrintRemainingUTxOs = True
-        }
-    )
-    . runMockChainDef
-
-{--
-Script for the demo :
-
-Enter a repl and load the required dependencies.
-
-> cabal repl tests
-> :l tests/Spec/StagedRun
-> import Cooked
-
-Start with the following running function
-
-printAndRun ::
-  ( Show a,
-    RunnableMockChain effs,
-    Polysemy.Member MockChainWrite effs
-  ) =>
-  Sem effs a ->
-  IO ()
-printAndRun =
-  printCookedOpt
-    ( def
-        { pcOptPrintLog = False,
-          pcOptHashes = def {pcOptHashNames = mempty},
-          pcOptPrintConsumedUTxOs = False,
-          pcOptPrintRemainingUTxOs = True
-        }
-    )
-    . runMockChainDef
-
-We define a run which does nothing
---}
-
-demoRun :: StagedMockChain ()
-demoRun = return ()
-
-{--
-We run it using "printAndRun".
-It's not too impressive, as there's nothing there.
-Let's add some initial assets.
---}
-
-demoRunForceOutputs :: StagedMockChain ()
-demoRunForceOutputs =
-  forceOutputs_
-    [ wallet 2 `receives` Value (ada 10),
-      wallet 1 `receives` ReferenceScript (trueMPScript @()),
-      wallet 1 `receives` InlineDatum (20 :: Integer),
-      wallet 2 `receives` VisibleHashedDatum (10 :: Integer)
-    ]
-
-{--
-WE RUN IT
-
-Notice that there are hashes everywhere. Let's make some aliases
-to improve readability of the mockchain state. We will do two things:
-\* add aliases
-\* change the running option to have the default hashmap
---}
-
-demoRunForceOutputsAliases :: StagedMockChain ()
-demoRunForceOutputsAliases = do
-  alice <- define "alice" $ wallet 1
-  bob <- define "bob" $ wallet 2
-  trueScript <- define "trueScript" $ trueMPScript @()
-  forceOutputs_
-    [ bob `receives` Value (ada 10),
-      alice `receives` ReferenceScript trueScript,
-      alice `receives` InlineDatum (20 :: Integer),
-      bob `receives` VisibleHashedDatum (10 :: Integer)
-    ]
-
-{--
-
-Notice that cooked already made some adjustments to the value of an input (min ADA accounted for).
-We can actually ask cooked to show the adjustement it mades during the run.
-(we change the opt in the runner above)
-
-WE RUN IT
-
-However, we could also tell cooked not to do any adjustment, which would result in a
-UTxO which could not exist on-chain.
-
-WE SKIP IT
-
-In practice, there is no insight to do that in such cases, but during audits it can often be useful to
-check that the computations were done right in the offchain code.
-
-Let's now move on to some more complex and interesting initial values.
---}
-
-demoRunFullForcedOutputs :: StagedMockChain ()
-demoRunFullForcedOutputs = do
-  alice <- define "alice" $ wallet 1
-  trueScript <- define "trueScript" $ trueMPScript @()
-  quick <- define "quick" $ Api.TokenName "quick"
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_ $
-    replicate 4 (alice `receives` Value (ada 10))
-      ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
-           alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
-           alice `receives` Value (quickValue 4),
-           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
-           alice `receives` Value (quickValue 12) <&&> VisibleHashedDatum (12 :: Integer),
-           alice `receives` InlineDatum (20 :: Integer)
-         ]
-
-{--
-While the aliasing is perfect, it relies on static data for now, and data manually written.
-There are many cases where this should rely on dynamic data / data coming from the client
-codebase. Thankfully, a StagedMockChain can be extended to integrate arbritrary effects, such
-as a State or a Reader effect, within a bundle (if several effects are used) placed at the
-right location within the effect stack. Let's rewrite the above using this capability.
---}
-
-data Environment = Environment
-  { alice :: Wallet,
-    bob :: Wallet,
-    trueScript :: MultiPurposeScript (),
-    falseScript :: MultiPurposeScript (),
-    permanent :: Api.TokenName,
-    quick :: Api.TokenName
-  }
-
-initialEnvironment :: Environment
-initialEnvironment =
-  Environment
-    (wallet 1)
-    (wallet 2)
-    trueMPScript
-    falseMPScript
-    (Api.TokenName "permanent")
-    (Api.TokenName "quick")
-
-demoRunNicknamesEnv :: ExtendedStagedMockChain (Reader Environment) ()
-demoRunNicknamesEnv = do
-  alice <- asks alice >>= define "alice"
-  trueScript <- asks trueScript >>= define "trueScript"
-  quick <- asks quick >>= define "quick"
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_ $
-    replicate 4 (alice `receives` Value (ada 10))
-      ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
-           alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (15 :: Integer),
-           alice `receives` Value (quickValue 4),
-           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (25 :: Integer),
-           alice `receives` Value (quickValue 12) <&&> VisibleHashedDatum (10 :: Integer),
-           alice `receives` InlineDatum (0 :: Integer)
-         ]
-
-instance InterpretAlone (Reader Environment) where
-  runInterpretAlone = runReader initialEnvironment
-
-{--
-RUN IT
-
-HIDE THE LOG
-
-Now, let's make some assertions, searches and traces
---}
-
-demoRunSearches :: ExtendedStagedMockChain (Reader Environment) ()
-demoRunSearches = do
-  alice <- asks alice >>= define "alice"
-  trueScript <- asks trueScript >>= define "trueScript"
-  quick <- asks quick >>= define "quick"
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  outputs <-
-    forceOutputs $
-      replicate 4 (alice `receives` Value (ada 10))
-        ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
-             alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
-             alice `receives` Value (quickValue 4),
-             alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
-             alice `receives` InlineDatum (0 :: Integer)
-           ]
-  noteS "We have given a few assets to Alice at the beginning of the run"
-  -- Ensuring that "Alice" got 10 utxos out of the "forceOutputs" call
-  aliceUtxos <-
-    beginSearchP outputs
-      & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
-  assert "Alice has the right amount of utxos" $ length aliceUtxos == 9
-  forM_ (zip [(1 :: Integer) ..] aliceUtxos) $ \(i, (_, output)) -> noteL ("Alice UTxO number " <> show i) output
-  -- Ensuring that Alice has 2 utxos with quick values with the right amount
-  aliceQuickValueExtracts <-
-    getExtracts $
-      beginSearchP outputs
-        & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
-        . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
-  assert "We properly extracted the quick tokens from Alice's utxos" $ aliceQuickValueExtracts == ((`HCons` HEmpty) <$> [3, 5, 4, 10])
-  -- Ensuring that Alice has 2 utxos created with hashed datums with permanent
-  -- values, and retrieving the typed content of those datums.
-  aliceHashedDatums <-
-    getExtracts $
-      beginSearchP outputs
-        & ensureAFoldIs (txSkelOutOwnerL % userTypedAF @Wallet % filtered (== alice))
-        . extractAFold (txSkelOutValueL % valueAssetClassAmountP trueScript quick)
-        . extractAFold (txSkelOutDatumL % txSkelOutDatumKindAT % datumKindResolvedP)
-        . extractAFold (txSkelOutDatumL % txSkelOutDatumTypedAT @Integer)
-  assert "We properly extracted more info from Alice's utxos" $
-    aliceHashedDatums
-      == [ HCons 5 (HCons NotResolved (HCons 5 HEmpty)),
-           HCons 10 (HCons Resolved (HCons 10 HEmpty))
-         ]
-
-{--
-So now that we've seen those features, let's clear out the field and
-start using those UTxOs we've created.
-Speak about signatory and balancing.
-
-Make sure the log is visible.
-Enable show consumed utxos
-
-RUN IT
-
---}
-
-demoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
-demoRunFirstTransaction = do
-  alice <- asks alice >>= define "alice"
-  bob <- asks bob >>= define "bob"
-  trueScript <- asks trueScript >>= define "trueScript"
-  quick <- asks quick >>= define "quick"
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_ $
-    replicate 4 (alice `receives` Value (ada 10))
-      ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
-           alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
-           alice `receives` Value (quickValue 4),
-           alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
-           alice `receives` InlineDatum (0 :: Integer)
-         ]
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        txSkelOuts = [bob `receives` Value (quickValue 2)]
-      }
-
-{--
-
-Remove line  alice `receives` Value (quickValue 4)
-
-RUN IT
-
-Balancing fails.
-Add manual UTxOs for balancing using.
-
-  txSkelOpts = def {txSkelOptBalancingUtxos = BalancingUtxosFromSet $ Set.fromList (fst <$> outputs)}
-
-Notice, thanks to the "consumed utxos", that one UTxO with a datum has been used.
-This makes sense considering the options we provided.
-Maybe a better solution here would be to manually provide the UTxO to spend and preserve the datum in the residual payment.
-
-  txSkelOuts =
-    [ bob `receives` Value (quickValue 2),
-      snd (outputs !! 6) & txSkelOutValueL % valueAssetClassAmountL trueScript quick %~ (+ (-2))
-    ],
-  txSkelIns = Map.singleton (fst (outputs !! 6)) emptyTxSkelRedeemer
-
---}
-
-demoRunFirstTransaction2 :: ExtendedStagedMockChain (Reader Environment) ()
-demoRunFirstTransaction2 = do
-  alice <- asks alice >>= define "alice"
-  bob <- asks bob >>= define "bob"
-  trueScript <- asks trueScript >>= define "trueScript"
-  quick <- asks quick >>= define "quick"
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  outputs <-
-    forceOutputs $
-      replicate 4 (alice `receives` Value (ada 10))
-        ++ [ alice `receives` Value (quickValue 3) <&&> InlineDatum (3 :: Integer),
-             alice `receives` Value (quickValue 5) <&&> HiddenHashedDatum (5 :: Integer),
-             -- alice `receives` Value (quickValue 4),
-             alice `receives` Value (quickValue 10) <&&> VisibleHashedDatum (10 :: Integer),
-             alice `receives` Value (quickValue 12) <&&> VisibleHashedDatum (12 :: Integer),
-             alice `receives` InlineDatum (0 :: Integer)
-           ]
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        -- txSkelOuts = [bob `receives` Value (quickValue 2)],
-        txSkelOuts =
-          [ bob `receives` Value (quickValue 2),
-            snd (outputs !! 6) & txSkelOutValueL % valueAssetClassAmountL trueScript quick %~ (+ (-2))
-          ],
-        txSkelIns = Map.singleton (fst (outputs !! 6)) emptyTxSkelRedeemer
-        -- txSkelOpts = def {txSkelOptBalancingUtxos = BalancingUtxosFromSet $ Set.fromList (fst <$> outputs)}
-      }
-
-{--
-Now, what if we want to quickly change the target of the payment from bob to wallet 3?
-Of course, we don't want to manually change the nominal transaction.
-
-Let's use our first tweak !
---}
-
-tweakedDemoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
-tweakedDemoRunFirstTransaction = withTweak demoRunFirstTransaction $ do
-  carol <- define "carol" (wallet 3)
-  setTweak (txSkelOutsL % traversed % txSkelOutOwnerL) (UserPubKey carol)
-
-{--
-We can see that carol hit the jackpot ! She got both UTxOs for herself. Something
-went wrong, all we wanted to do was redirect the output initially targeted to bob.
-Let's do better and use ... the DatumHijackingAttack !
-
-Take a look at the various parameters.
-
-RUN IT !
---}
-
-dhDemoRunFirstTransaction :: ExtendedStagedMockChain (Reader Environment) ()
-dhDemoRunFirstTransaction = withTweak demoRunFirstTransaction $ do
-  carol <- define "carol" $ wallet 3
-  bob <- asks bob
-  datumHijackingAttack $ ownedByDatumHijackingParams bob carol
-
-{--
-Show that the Skeleton has been labelled in the log
-
-This is already nice, but attempting a DH attack when no script is involved is a bit lame.
-
-Let's start fresh from a new trace, and have some scripts be executed first.
-We can invoke a minting policy for the sake of it.
---}
-
-demoRunFirstScripts :: StagedMockChain ()
-demoRunFirstScripts = do
-  alice <- define "alice" $ wallet 1
-  trueScript <- define "trueScript" $ trueMPScript @()
-  quick <- define "quick" $ Api.TokenName "quick"
-  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_ [alice `receives` Value (ada 100)]
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
-        txSkelOuts =
-          [ inlineScript `receives` Value (quickValue 1),
-            trueScript `receives` Value (quickValue 1)
-          ]
-      }
-
-{--
-We can see that the fee for the transaction is .396 ADA. This is not that huge
-but maybe we can do even better. How about we use a reference script?
---}
-
-demoRunReferenceScript :: StagedMockChain ()
-demoRunReferenceScript = do
-  alice <- define "alice" $ wallet 1
-  trueScript <- define "trueScript" $ trueMPScript @()
-  quick <- define "quick" $ Api.TokenName "quick"
-  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_
-    [ alice `receives` Value (ada 100),
-      alice `receives` ReferenceScript trueScript
-    ]
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
-        txSkelOuts =
-          [ inlineScript `receives` Value (quickValue 1),
-            trueScript `receives` Value (quickValue 1)
-          ]
-      }
-
-{--
-We can see that cooked automatically attached the reference script input.
-Not too bad, even for a small script like the always true script, we now
-only have to pay .192 ADA
-
-Of course this can be disabled. And manual utxos can be provided.
-
-Now let's try to consume those UTxOs we've created at the script addresses.
-
---}
-
-demoRunScriptUtxos :: StagedMockChain ()
-demoRunScriptUtxos = do
-  alice <- define "alice" $ wallet 1
-  trueScript <- define "trueScript" $ trueMPScript @()
-  quick <- define "quick" $ Api.TokenName "quick"
-  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_
-    [ alice `receives` Value (ada 100),
-      alice `receives` ReferenceScript trueScript
-    ]
-  (isORef, isOutput) : (tsORef, tsOutput) : _ <-
-    validateTxSkel' $
-      txSkelTemplate
-        { txSkelSignatories = txSkelSignatoriesFromList [alice],
-          txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
-          txSkelOuts =
-            [ inlineScript `receives` Value (quickValue 1),
-              trueScript `receives` Value (quickValue 1)
-            ]
-        }
-
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        txSkelIns = Map.singleton tsORef emptyTxSkelRedeemer,
-        txSkelOuts = [tsOutput]
-      }
-
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        txSkelIns = Map.singleton isORef emptyTxSkelRedeemer,
-        txSkelOuts = [isOutput]
-      }
-
-{--
-It does not work ! We have a phase 2 validation error, because the inline validator
-requires ... an inline datum in its continuing output. Let's fix this.
---}
-
-demoRunScriptUtxosFixed :: StagedMockChain ()
-demoRunScriptUtxosFixed = do
-  alice <- define "alice" $ wallet 1
-  trueScript <- define "trueScript" $ trueMPScript @()
-  quick <- define "quick" $ Api.TokenName "quick"
-  inlineScript <- define "inlineScript" requireInlineDatumInOutputValidator
-  let quickValue = review (valueAssetClassAmountP trueScript quick)
-  forceOutputs_
-    [ alice `receives` Value (ada 100),
-      alice `receives` ReferenceScript trueScript
-    ]
-  (isORef, isOutput) : (tsORef, tsOutput) : _ <-
-    validateTxSkel' $
-      txSkelTemplate
-        { txSkelSignatories = txSkelSignatoriesFromList [alice],
-          txSkelMints = txSkelMintsFromList [mint trueScript () quick 2],
-          txSkelOuts =
-            [ inlineScript `receives` Value (quickValue 1),
-              trueScript `receives` Value (quickValue 1)
-            ]
-        }
-
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        txSkelIns = Map.singleton tsORef emptyTxSkelRedeemer,
-        txSkelOuts = [tsOutput]
-      }
-
-  validateTxSkel_ $
-    txSkelTemplate
-      { txSkelSignatories = txSkelSignatoriesFromList [alice],
-        txSkelIns = Map.singleton isORef emptyTxSkelRedeemer,
-        txSkelOuts = [set txSkelOutDatumL (SomeTxSkelOutDatum () Inline) isOutput] -- ,
-        -- txSkelLabels = Set.fromList [label "Spending inlineScript"]
-      }
-
-{--
-From here onwards, deactivate the log and the consumed UTXOs
-
-Let spice things up a little bit.
-
-We notice that spending the inline validator only requires an inline datum, no
-matter the content of the utxo.
-
-Let's label the interesting transaction (WE DO IT) and target it for a nice attack.
---}
-
-demoRunInlineDatumHijacking :: StagedMockChain ()
-demoRunInlineDatumHijacking =
-  (`whenAble` demoRunScriptUtxosFixed) $ labelled' "Spending inlineScript" $ do
-    void $ datumHijackingAttack (ownedByDatumHijackingParams requireInlineDatumInOutputValidator (wallet 1))
-    overTweak txSkelOutsL ((requireInlineDatumInOutputValidator `receives` InlineDatum ()) :)
-
-tests :: TestTree
-tests = testCooked "Full staged run" $ mustSucceedTest @_ @StagedEffs (return ())

From c93753e2381484a8a5ebf8836f3e5f856a52d3f4 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Mon, 16 Feb 2026 22:53:55 +0100
Subject: [PATCH 77/96] fixing doc comments

---
 src/Cooked/MockChain/Testing.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Cooked/MockChain/Testing.hs b/src/Cooked/MockChain/Testing.hs
index 985d0d60c..f9d9a4d6b 100644
--- a/src/Cooked/MockChain/Testing.hs
+++ b/src/Cooked/MockChain/Testing.hs
@@ -276,8 +276,8 @@ testCooked ::
   HU.TestTree
 testCooked name = HU.testCase name . testToProp
 
--- Same as `testCooked` but first assigns the initial distribution template as a
--- starting point to the test
+-- | Same as `testCooked` but first assigns the initial distribution template as
+-- a starting point to the test
 testCookedFromInitDistTemplate ::
   forall effs a b.
   (Show b) =>
@@ -296,8 +296,8 @@ testCookedQC ::
   HU.TestTree
 testCookedQC name = QC.testProperty name . testToProp
 
--- Same as `testCookedQC` but first assigns the initial distribution template as a
--- starting point to the test
+-- | Same as `testCookedQC` but first assigns the initial distribution template
+-- as a starting point to the test
 testCookedQCFromInitDistTemplate ::
   forall effs a b.
   (Show b) =>

From c5185e417cd5f1f86cc9311410ec5d6c74c7b33b Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Wed, 18 Feb 2026 15:45:42 +0100
Subject: [PATCH 78/96] balancing use min extra size

---
 src/Cooked/MockChain/Balancing.hs             | 386 +++++++++++-------
 src/Cooked/MockChain/Common.hs                |   6 +-
 src/Cooked/MockChain/Error.hs                 |   2 +-
 src/Cooked/MockChain/GenerateTx/Body.hs       |  10 +-
 src/Cooked/MockChain/GenerateTx/Collateral.hs |  68 ++-
 src/Cooked/MockChain/Log.hs                   |   2 +-
 src/Cooked/MockChain/Write.hs                 |  14 +-
 src/Cooked/Pretty/MockChain.hs                |   8 +-
 tests/Spec/Balancing.hs                       |   4 +-
 9 files changed, 275 insertions(+), 225 deletions(-)

diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index e1e2511dc..1d211f633 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -9,28 +9,30 @@ module Cooked.MockChain.Balancing
 where
 
 import Cardano.Api qualified as Cardano
-import Cardano.Ledger.BaseTypes qualified as Cardano
+import Cardano.Api.Ledger qualified as Cardano
 import Cardano.Ledger.Conway.Core qualified as Conway
 import Cardano.Ledger.Conway.PParams qualified as Conway
-import Cardano.Ledger.Plutus.ExUnits qualified as Cardano
 import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
 import Control.Monad
 import Cooked.MockChain.AutoFilling
 import Cooked.MockChain.Common
 import Cooked.MockChain.Error
 import Cooked.MockChain.GenerateTx.Body
+import Cooked.MockChain.GenerateTx.Output
 import Cooked.MockChain.Log
 import Cooked.MockChain.Read
 import Cooked.MockChain.UtxoSearch
 import Cooked.Skeleton
-import Data.Bifunctor
+import Data.ByteString qualified as BS
 import Data.Function
-import Data.List (find, partition, sortBy)
+import Data.List (find, partition)
 import Data.Map qualified as Map
 import Data.Maybe (fromMaybe)
 import Data.Ratio qualified as Rat
 import Data.Set qualified as Set
 import Ledger.Tx qualified as Ledger
+import Ledger.Tx.CardanoAPI qualified as Ledger
+import Lens.Micro.Extras qualified as Micro
 import Lens.Micro.Extras qualified as MicroLens
 import Optics.Core
 import Optics.Core.Extras
@@ -52,43 +54,51 @@ import Polysemy.Fail
 balanceTxSkel ::
   (Members '[MockChainRead, MockChainLog, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   TxSkel ->
-  Sem effs (TxSkel, Fee, Collaterals)
+  Sem effs (TxSkel, Fee, Maybe Collaterals)
 balanceTxSkel skelUnbal@TxSkel {..} = do
   -- We retrieve the possible balancing user. Any extra payment will be
-  -- redirected to them, and utxos will be taken from their user if associated
-  -- with the BalancingUtxosFromBalancingUser policy
+  -- redirected to them, and utxos will be taken from their wallet if associated
+  -- with the @BalancingUtxosFromBalancingUser@ policy
   balancingUser <- case txSkelOptBalancingPolicy txSkelOpts of
     BalanceWithFirstSignatory -> case txSkelSignatories of
-      [] -> throw $ MCEMissingBalancingUser "The list of signatories is empty, but the balancing user is supposed to be the first signatory."
-      bw : _ -> return $ Just $ UserPubKey $ view txSkelSignatoryPubKeyHashL bw
+      [] -> throw MCEMissingBalancingUser
+      bw : _ -> return $ Just $ UserPubKey bw
     BalanceWith bUser -> return $ Just $ UserPubKey bUser
     DoNotBalance -> return Nothing
 
-  -- We retrieve the number of scripts involved in the transaction
+  -- We retrieve the number of scripts involved in the transaction. This is used
+  -- to compute the maximum possible fee, as each of those script with
+  -- contribute, through its execution units, to the cost of the transaction.
   nbOfScripts <- fromIntegral . length <$> txSkelAllScripts skelUnbal
 
   -- The protocol parameters indirectly dictate a minimal and maximal value for a
   -- single transaction fee, which we retrieve.
   (minFee, maxFee) <- getMinAndMaxFee nbOfScripts
 
-  -- We collect collateral inputs candidates. They might be directly provided in
-  -- the skeleton, or should be retrieved from a given user. They are
-  -- associated with a return collateral user, which we retrieve as well. All
-  -- of this is wrapped in a `Maybe` type to represent the case when the
-  -- transaction does not involve script and should not have any kind of
-  -- collaterals attached to it.
+  -- We collect potential collateral inputs candidates, and return collateral
+  -- user. They will be absent when the transaction does not involve script and
+  -- thus does not require collaterals.
   mCollaterals <- do
-    -- The transaction will only require collaterals when involving scripts
     case (nbOfScripts == 0, txSkelOptCollateralUtxos txSkelOpts) of
+      -- No script involved, but manual collateral UTxOs provided
       (True, CollateralUtxosFromSet utxos _) -> logEvent (MCLogUnusedCollaterals $ Right utxos) >> return Nothing
+      -- No script involved, but manual collateral user provided
       (True, CollateralUtxosFromUser cUser) -> logEvent (MCLogUnusedCollaterals $ Left $ UserPubKey cUser) >> return Nothing
+      -- No script involved, and no particular collateral option provided
       (True, CollateralUtxosFromBalancingUser) -> return Nothing
+      -- Some scripts involved, and a specific set of UTxOs, alongside a
+      -- collateral user provided. In this case, we just return them.
       (False, CollateralUtxosFromSet utxos rUser) -> return $ Just (utxos, UserPubKey rUser)
+      -- Some scripts involved, and a specific collateral user provided.
+      -- We fetch vanilla UTxOs from this user and return them.
       (False, CollateralUtxosFromUser (Script.toPubKeyHash -> cUser)) ->
         Just . (,UserPubKey cUser) . Set.fromList
           <$> getTxOutRefs (utxosAtSearch cUser ensureOnlyValueOutputs)
+      -- Some scripts involved, and no specific collateral options provided.
       (False, CollateralUtxosFromBalancingUser) -> case balancingUser of
-        Nothing -> throw $ MCEMissingBalancingUser "Collateral utxos should be taken from the balancing user, but it does not exist."
+        -- If no balancing wallet exists, we throw an error
+        Nothing -> throw MCEMissingBalancingUser
+        -- If a balancing wallet exists, we use it as collateral user
         Just bUser -> Just . (,bUser) . Set.fromList <$> getTxOutRefs (utxosAtSearch bUser ensureOnlyValueOutputs)
 
   -- At this point, the presence (or absence) of balancing user dictates
@@ -100,7 +110,7 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
       let fee = case txSkelOptFeePolicy txSkelOpts of
             AutoFeeComputation -> maxFee
             ManualFee fee' -> fee'
-       in (skelUnbal,fee,) <$> collateralsFromFees fee mCollaterals
+       in (skelUnbal,fee,) <$> collateralsFromFee fee mCollaterals
     Just bUser -> do
       -- The balancing should be performed. We collect the candidates balancing
       -- utxos based on the associated policy
@@ -125,7 +135,7 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
         -- If fee are provided manually, we adjust the collaterals and the
         -- skeleton around them directly.
         ManualFee fee -> do
-          adjustedColsAndUser <- collateralsFromFees fee mCollaterals
+          adjustedColsAndUser <- collateralsFromFee fee mCollaterals
           attemptedSkel <- computeBalancedTxSkel bUser balancingUtxos skelUnbal fee
           return (attemptedSkel, fee, adjustedColsAndUser)
 
@@ -156,18 +166,18 @@ getMinAndMaxFee nbOfScripts = do
       (Cardano.unboundRational -> refScriptFeePerByte) = MicroLens.view Conway.ppMinFeeRefScriptCostPerByteL params
   -- We compute the components of the maximum possible fee, starting with the
   -- maximum fee associated with the transaction size
-  let txSizeMaxFees = maxTxSize * txFeePerByte
+  let txSizeMaxFee = maxTxSize * txFeePerByte
   -- maximum fee associated with the number of execution steps for scripts
-  let eStepsMaxFees = (eSteps * Rat.numerator priceESteps) `div` Rat.denominator priceESteps
+  let eStepsMaxFee = (eSteps * Rat.numerator priceESteps) `div` Rat.denominator priceESteps
   -- maximum fee associated with the number of execution memory for scripts
-  let eMemMaxFees = (eMem * Rat.numerator priceEMem) `div` Rat.denominator priceEMem
+  let eMemMaxFee = (eMem * Rat.numerator priceEMem) `div` Rat.denominator priceEMem
   -- maximum fee associated with the size of all reference scripts
-  let refScriptsMaxFees = (maxTxSize * Rat.numerator refScriptFeePerByte) `div` Rat.denominator refScriptFeePerByte
+  let refScriptsMaxFee = (maxTxSize * Rat.numerator refScriptFeePerByte) `div` Rat.denominator refScriptFeePerByte
   return
     ( -- Minimal fee is just the fixed portion of the fee
       txFeeFixed,
       -- Maximal fee is the fixed portion plus all the other maximum fees
-      txFeeFixed + txSizeMaxFees + nbOfScripts * (eStepsMaxFees + eMemMaxFees) + refScriptsMaxFees
+      txFeeFixed + txSizeMaxFee + nbOfScripts * (eStepsMaxFee + eMemMaxFee) + refScriptsMaxFee
     )
 
 -- | Computes optimal fee for a given skeleton and balances it around those fees.
@@ -178,9 +188,9 @@ computeFeeAndBalance ::
   Fee ->
   Fee ->
   Utxos ->
-  Collaterals ->
+  Maybe (CollateralIns, Peer) ->
   TxSkel ->
-  Sem effs (TxSkel, Fee, Collaterals)
+  Sem effs (TxSkel, Fee, Maybe Collaterals)
 computeFeeAndBalance _ minFee maxFee _ _ _
   | minFee > maxFee =
       fail "Unreachable case, please report a bug at https://github.com/tweag/cooked-validators/issues"
@@ -239,25 +249,30 @@ attemptBalancingAndCollaterals ::
   Peer ->
   Utxos ->
   Fee ->
-  Collaterals ->
+  Maybe (CollateralIns, Peer) ->
   TxSkel ->
-  Sem effs (Collaterals, TxSkel)
+  Sem effs (Maybe Collaterals, TxSkel)
 attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel = do
-  adjustedCollateralIns <- collateralsFromFees fee mCollaterals
   attemptedSkel <- computeBalancedTxSkel balancingUser balancingUtxos skel fee
-  return (adjustedCollateralIns, attemptedSkel)
+  collaterals <- collateralsFromFee fee mCollaterals
+  return (collaterals, attemptedSkel)
 
 -- | This selects a subset of suitable collateral inputs from a given set while
 -- accounting for the ratio to respect between fees and total collaterals, the
 -- min ada requirements in the associated return collateral and the maximum
 -- number of collateral inputs authorized by protocol parameters.
-collateralInsFromFees ::
+collateralsFromFee ::
   (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  -- | The fee from which these collaterals should be computed
   Fee ->
-  CollateralIns ->
-  Peer ->
-  Sem effs CollateralIns
-collateralInsFromFees fee collateralIns returnCollateralUser = do
+  -- | The optional candidate UTxOs to be used as collaterals, alongside the
+  -- peer who should receive the return collateral output
+  Maybe (CollateralIns, Peer) ->
+  -- | Returns the collaterals computed from the above. Raises an error if no
+  -- such collateral can be found.
+  Sem effs (Maybe Collaterals)
+collateralsFromFee _ Nothing = return Nothing
+collateralsFromFee fee (Just (collateralIns, returnCollateralUser)) = do
   -- We retrieve the protocal parameters
   params <- Emulator.pEmulatorPParams <$> getParams
   -- We retrieve the max number of collateral inputs, with a default of 10. In
@@ -272,79 +287,147 @@ collateralInsFromFees fee collateralIns returnCollateralUser = do
   -- Collateral tx outputs sorted by decreasing ada amount
   collateralTxOuts <- getTxOutRefsAndOutputs $ txSkelOutByRefSearch' $ Set.toList collateralIns
   -- Candidate subsets of utxos to be used as collaterals
-  let candidatesRaw = reachValue collateralTxOuts totalCollateral nbMax
-  -- Preparing a possible collateral error
-  let noSuitableCollateralError = MCENoSuitableCollateral fee percentage totalCollateral
-  -- Retrieving and returning the best candidate as a utxo set
-  Set.fromList . fst <$> getOptimalCandidate candidatesRaw returnCollateralUser noSuitableCollateralError
-
--- | This adjusts collateral inputs when necessary
-collateralsFromFees ::
-  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
-  Fee ->
-  Collaterals ->
-  Sem effs Collaterals
-collateralsFromFees _ Nothing = return Nothing
-collateralsFromFees fee (Just (collateralIns, returnCollateralUser)) =
-  Just . (,returnCollateralUser) <$> collateralInsFromFees fee collateralIns returnCollateralUser
+  reachedValue <- reachValue collateralTxOuts totalCollateral nbMax $ Right returnCollateralUser
+  -- A value might, or might not have been reached
+  case reachedValue of
+    -- If no value was reached, the input UTxOs are insufficient to provide
+    -- the necessary collaterals, and thus an error is raised
+    Nothing -> throw $ MCENoSuitableCollateral fee percentage totalCollateral
+    -- If a value was reached, we return it alongside the return collaterals
+    Just (oRefs, returnOutput) -> return $ Just (Set.fromList oRefs, returnOutput)
 
--- | The main computing function for optimal balancing and collaterals. It
--- computes the subsets of a set of UTxOs that sum up to a certain target. It
--- stops when the target is reached, not adding superfluous UTxOs. Despite
--- optimizations, this function is theoretically in 2^n where n is the number of
--- candidate UTxOs. Use with caution.
 reachValue ::
+  forall effs.
+  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
   -- | The Utxos available to reach the value
   Utxos ->
   -- | The target value to reach
   Api.Value ->
-  -- | The maximum number of Utxos allowed to reach the target
+  -- | The maximum number of Utxos allowed to reach the target. This is used
+  -- when there is a hard limit (for collaterals for instance) or when the
+  -- amount of input UTxOs is huge and thus the search needs to be limited.
   Integer ->
-  -- | A list of lists of Utxos sufficient to reach the target, with the
-  -- exceeding amount between their total sum and the target.
-  [(Utxos, Api.Value)]
-reachValue utxos = go utxos (mconcat $ view txSkelOutValueL . snd <$> utxos)
+  -- | Either the output to which the generated surplus needs to be attached, or
+  -- the users to which this surplus should be sent
+  Either TxSkelOut Peer ->
+  -- | Returns a possible solution. The solution is a list of new inputs, and
+  -- the surplus output, which is either built from scratch or from the provided
+  -- surplus output, if any.
+  Sem effs (Maybe ([Api.TxOutRef], Maybe TxSkelOut))
+reachValue utxos target fuel outputOrUser = do
+  -- We retrieve the current protocol version, which is going to be used to
+  -- compute the size of the inputs and outputs added by this function
+  Cardano.ProtVer majorVersion _ <- Micro.view Conway.ppProtocolVersionL . Emulator.emulatorPParams <$> getParams
+  -- We annotate @outputOrUser@ with the size of the existing output, if any
+  outputOrUser' <- case outputOrUser of
+    Left output -> Left . (output,) <$> outputSize majorVersion output
+    Right user -> return $ Right user
+  -- We annotate each of the provided inputs with their sizes
+  utxos' <- forM utxos $ \(oRef, output) -> (oRef,,view txSkelOutValueL output) <$> inputSize majorVersion oRef
+  -- We call the main computing function, @go@, by feeding it an initial
+  -- available amount, computed from the available inputs. This will avoid any
+  -- unnecessary recomputation of this value.
+  fmap (\(oRefs, mOut, _) -> (oRefs, mOut))
+    <$> go majorVersion utxos' target fuel outputOrUser' (mconcat ((\(_, _, val) -> val) <$> utxos'))
   where
-    go :: Utxos -> Api.Value -> Api.Value -> Integer -> [(Utxos, Api.Value)]
-    -- Target is smaller than the empty value (which means in only contains negative
-    -- entries), we stop looking as adding more elements would be superfluous.
-    go _ _ target _ | target `Api.leq` mempty = [([], PlutusTx.negate target)]
-    -- The fuel has been fully consumed, and the target is not yet reached.
-    go _ _ _ fuel | fuel <= 0 = []
-    -- The target is not reached, and cannot possibly be reached, as the remaining
-    -- candidates do not sum up to the target.
-    go _ available target _ | not $ target `Api.leq` available = []
-    -- There is no more elements to go through and the target has not been
-    -- reached. Encompassed by the previous case, but needed by GHC.
-    go [] _ _ _ = []
-    -- Main recursive case, where we either pick or drop the head. We only pick the
-    -- head if it contributes to reaching the target, i.e. if its intersection with
-    -- the positive part of the target is not empty.
-    go (h@(_, view txSkelOutValueL -> hVal) : t) ((<> PlutusTx.negate hVal) -> available') target fuel =
-      go t available' target fuel
-        ++ if snd (Api.split target) PlutusTx./\ hVal == mempty
-          then []
-          else first (h :) <$> go t available' (target <> PlutusTx.negate hVal) (fuel - 1)
+    go ::
+      -- Current protocol major version
+      Cardano.Version ->
+      -- Currently available UTxOs, decreasing in recursive calls
+      [(Api.TxOutRef, Integer, Api.Value)] ->
+      -- Target value
+      Api.Value ->
+      -- Fuel (max number of UTxOs to pick)
+      Integer ->
+      -- Existing output where the surplus needs to be appended, or the peer
+      -- to whom this surplus should be paid
+      Either (TxSkelOut, Integer) Peer ->
+      -- Total value of the available inputs
+      Api.Value ->
+      -- Returns a solution when one exists. This solution contains the inputs
+      -- to add, the possible surplus payment and the total size added by these
+      -- elements to the transaction.
+      Sem effs (Maybe ([Api.TxOutRef], Maybe TxSkelOut, Integer))
+    -- The target is reached. There might be surplus which we have to handle.
+    go majorVersion goUtxos goTarget goFuel goOutputOrUser goAvailable | goTarget `Api.leq` mempty = do
+      let remainder = PlutusTx.negate goTarget
+          newOutput = either (over txSkelOutValueL (<> remainder) . fst) (`receives` Value remainder) goOutputOrUser
+          newOutputValue = view txSkelOutValueL newOutput
+      minAda <- Api.Lovelace <$> getTxSkelOutMinAda newOutput
+      case newOutputValue of
+        -- There is no surplus
+        newVal | newVal == mempty -> return $ Just ([], Nothing, 0)
+        -- There is a surplus and it contains enough ADA
+        newVal | view valueLovelaceL newVal >= minAda -> do
+          -- We compute the cost of the new output
+          newCost <- outputSize majorVersion newOutput
+          -- And compare it with the cost of the existing output
+          return $ Just ([], Just newOutput, either ((newCost -) . snd) (const newCost) goOutputOrUser)
+        -- There is a surplus which does not contain enough ADA
+        (Script.toValue . (minAda -) . view valueLovelaceL -> missingAdaValue) -> do
+          -- We need to run a new search with a target increased by the missing
+          -- amount of ADA. For that purpose, we also need to increase the
+          -- surplus payment with the same amout, to keep everything balanced.
+          -- As a consequence, we also need to add bytes to the transaction.
+          (sizeAdded, goOutputOrUser') <- case goOutputOrUser of
+            -- If the surplus already exist, we add @missingAdaValue@ to it
+            Left (output, existingSize) -> do
+              let enlargedOutput = over txSkelOutValueL (<> missingAdaValue) output
+              newSize <- outputSize majorVersion enlargedOutput
+              return (newSize - existingSize, Left (enlargedOutput, newSize))
+            -- If it does not, we create it and couple it with its size
+            Right user -> do
+              let output = user `receives` Value missingAdaValue
+              size <- outputSize majorVersion output
+              return (size, Left (output, size))
+          -- We keep looking with a greater target, surplus and size
+          over (_Just % _3) (+ sizeAdded)
+            <$> go majorVersion goUtxos (goTarget <> missingAdaValue) goFuel goOutputOrUser' goAvailable
+    -- We have not reached a solution, but we don't have fuel anymore
+    go _ _ _ goFuel _ _ | goFuel <= 0 = return Nothing
+    -- We have not reached a soultion, but no more UTxOs are available
+    go _ [] _ _ _ _ = return Nothing
+    -- We have not reached a solution, but the total available value is
+    -- insufficient to ever find one
+    go _ _ goTarget _ _ goAvailable | not $ goTarget `Api.leq` goAvailable = return Nothing
+    -- We have not yet found a solution, but there are still available UTxOs
+    go majorVersion ((hOref, hSize, hValue) : t) goTarget goFuel goOutputOrUser ((<> PlutusTx.negate hValue) -> goAvailable) = do
+      -- We try to find a solution by dropping the head
+      dropH <- go majorVersion t goTarget goFuel goOutputOrUser goAvailable
+      -- We also try to find a solution by picking the head
+      pickH <-
+        -- We try to see if the head contributes to reaching the value, i.e. if
+        -- it contains assets that help building towards the target.
+        if snd (Api.split goTarget) PlutusTx./\ hValue == mempty
+          -- If not, we don't bother trying to pick the head
+          then return Nothing
+          -- If it does, we actually try to pick the head. This means decreasing
+          -- most of the recursive parameters of @go@ accordingly
+          else do
+            pickH' <- go majorVersion t (goTarget <> PlutusTx.negate hValue) (goFuel - 1) goOutputOrUser goAvailable
+            return $ (\(oRefs, mOut, size) -> (hOref : oRefs, mOut, hSize + size)) <$> pickH'
+      -- We find the optimal solution by comparing both solutions
+      return $ case (dropH, pickH) of
+        -- Only picking the head yielded a solution, we return it
+        (Nothing, _) -> pickH
+        -- Only dropping the head yielded a solution, we return it
+        (_, Nothing) -> dropH
+        -- Both pickding and dropping the head yielded a solution, so we keep
+        -- the one that produces the least increase in the transaction size
+        (Just (_, _, sizeDrop), Just (_, _, sizePick)) -> if sizeDrop <= sizePick then dropH else pickH
 
--- | A helper function to grab an optimal candidate in terms of having a minimal
--- enough amount of ada to sustain itself meant to be used after calling
--- `reachValue`. This throws an error when there are no suitable candidates.
-getOptimalCandidate ::
-  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
-  [(Utxos, Api.Value)] ->
-  Peer ->
-  MockChainError ->
-  Sem effs ([Api.TxOutRef], Api.Value)
-getOptimalCandidate candidates paymentTarget mceError = do
-  -- We decorate the candidates with their current ada and min ada requirements
-  candidatesDecorated <- forM candidates $ \(output, val) ->
-    (output,val,Api.lovelaceValueOf val,) <$> getTxSkelOutMinAda (paymentTarget `receives` Value val)
-  -- We filter the candidates that have enough ada to sustain themselves
-  let candidatesFiltered = [(minLv, (fst <$> l, val)) | (l, val, Api.Lovelace lv, minLv) <- candidatesDecorated, minLv <= lv]
-  case sortBy (compare `on` fst) candidatesFiltered of
-    -- If the list of candidates is empty, we throw an error
-    [] -> throw mceError
-    (_, ret) : _ -> return ret
+    -- This computes the size of anything that can be serialized
+    computeSize majorVersion = fromIntegral . BS.length . Cardano.serialize' majorVersion
+
+    -- This computes the size of a `TxSkelOut`
+    outputSize :: Cardano.Version -> TxSkelOut -> Sem effs Integer
+    outputSize majorVersion = fmap (computeSize majorVersion . Cardano.toShelleyTxOutAny Cardano.ShelleyBasedEraConway) . toCardanoTxOut
+
+    -- This computes the size of an `Api.TxOutRef` which is almost always
+    -- gonna be the same, but can theoretically vary if coming from a
+    -- transaction with many outputs.
+    inputSize :: Cardano.Version -> Api.TxOutRef -> Sem effs Integer
+    inputSize majorVersion = fmap (computeSize majorVersion . Cardano.toShelleyTxIn) . fromEither . Ledger.toCardanoTxIn
 
 -- | Estimates the required fee for a given skeleton with a given initial fee
 -- and collaterals
@@ -352,7 +435,7 @@ estimateTxSkelFee ::
   (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   TxSkel ->
   Fee ->
-  Collaterals ->
+  Maybe Collaterals ->
   Sem effs Fee
 estimateTxSkelFee skel fee mCollaterals = do
   -- We retrieve the necessary data to generate the transaction body
@@ -387,71 +470,60 @@ computeBalancedTxSkel balancingUser balancingUtxos txSkel@TxSkel {..} (Script.lo
   certificatesDepositedValue <- Script.toValue <$> txSkelDepositedValueInCertificates txSkel
   proposalsDepositedValue <- Script.toValue <$> txSkelDepositedValueInProposals txSkel
   -- We compute the values missing in the left and right side of the equation
-  let (missingRight, missingLeft) =
+  let (missingRight', missingLeft') =
         Api.split $
-          outValue
-            <> burnedValue
-            <> feeValue
-            <> proposalsDepositedValue
-            <> certificatesDepositedValue
-            <> PlutusTx.negate (inValue <> mintedValue <> withdrawnValue)
-  -- We compute the minimal ada requirement of the missing payment
-  rightMinAda <- getTxSkelOutMinAda $ balancingUser `receives` Value missingRight
-  -- We compute the current ada of the missing payment. If the missing payment
-  -- is not empty and the minimal ada is not present, some value is missing.
-  let Api.Lovelace rightAda = missingRight ^. valueLovelaceL
-      missingAda = rightMinAda - rightAda
-      missingAdaValue = if missingRight /= mempty && missingAda > 0 then Script.lovelace missingAda else mempty
-  -- The actual missing value on the left might needs to account for any missing
-  -- min ada on the missing payment of the transaction skeleton. This also has
-  -- to be repercuted on the missing value on the right.
-  let missingLeft' = missingLeft <> missingAdaValue
-      missingRight' = missingRight <> missingAdaValue
-  -- At this point, we only need to account for the possible case were the
-  -- inputs are empty and there is nothing missing on the left, as the ledger
-  -- does not allow for transaction to have no inputs. When this is the case, we
-  -- artificially add a requirement of 1 lovelace to force the consumption of a
-  -- dummy input.
+          mconcat
+            [ outValue,
+              burnedValue,
+              feeValue,
+              proposalsDepositedValue,
+              certificatesDepositedValue,
+              PlutusTx.negate inValue,
+              PlutusTx.negate mintedValue,
+              PlutusTx.negate withdrawnValue
+            ]
+  -- We need to account for the possible corner case were the inputs are empty
+  -- and there is nothing missing on the left, as the ledger does not allow for
+  -- transaction to have no inputs. When this is the case, we artificially add a
+  -- requirement of 1 lovelace to force the consumption of a dummy input.
   let noInputs = inValue == mempty && missingLeft' == mempty
-      missingLeft'' = if noInputs then Script.lovelace 1 else missingLeft'
-      missingRight'' = if noInputs then missingRight' <> Script.lovelace 1 else missingRight'
-  -- We retrieve the maximum number of Utxos that can be used for balancing
+      missingLeft = if noInputs then Script.lovelace 1 else missingLeft'
+      missingRight = if noInputs then missingRight' <> Script.lovelace 1 else missingRight'
+  -- We compute the possible existing output that will need to be extended by
+  -- the extra surplus created by the balancing. This output is created from
+  -- both the extra value on the right, and a possible existing output at the
+  -- balancing wallet address when required with @AdjustExistingOutput@.
+  let surplusOutputOrUser = case txSkelOptBalanceOutputPolicy txSkelOpts of
+        AdjustExistingOutput
+          | Just txSkelOut <-
+              find ((== Script.toCredential balancingUser) . view txSkelOutCredentialG) txSkelOuts ->
+              Left (over txSkelOutValueL (<> missingRight) txSkelOut)
+        _ | missingRight == mempty -> Right balancingUser
+        _ -> Left (balancingUser `receives` Value missingRight)
+  -- We call the main actual balancing algorithm to fetch missing piece, and
+  -- retrieve the possible solution, which might not exist.
   let maxNbOfBalancingUtxos = fromMaybe (toInteger $ length balancingUtxos) (txSkelOptMaxNbOfBalancingUtxos txSkelOpts)
-  -- This gives us what we need to run our `reachValue` algorithm and append to
-  -- the resulting values whatever payment was missing in the initial skeleton
-  let candidatesRaw = second (<> missingRight'') <$> reachValue balancingUtxos missingLeft'' maxNbOfBalancingUtxos
-  -- We prepare a possible balancing error with the difference between the
-  -- requested amount and the maximum amount provided by the balancing user
-  let totalValue = mconcat $ view txSkelOutValueL . snd <$> balancingUtxos
-      difference = snd $ Api.split $ missingLeft' <> PlutusTx.negate totalValue
-      balancingError = MCEUnbalanceable balancingUser difference
-  -- Which one of our candidates should be picked depends on three factors
-  -- - Whether there exists a perfect candidate set with empty surplus value
-  -- - The `BalancingOutputPolicy` in the skeleton options
-  -- - The presence of an existing output at the balancing user address
-  (additionalInsTxOutRefs, newTxSkelOuts) <- case find ((== mempty) . snd) candidatesRaw of
-    -- There exists a perfect candidate, this is the rarest and easiest
+  solution <- reachValue balancingUtxos missingLeft maxNbOfBalancingUtxos surplusOutputOrUser
+  -- Based on the solution, we compute extra inputs and the new output
+  (additionalInsTxOutRefs, newTxSkelOuts) <- case solution of
+    -- There is no solution with the provided parameters
+    Nothing -> do
+      let totalValue = mconcat $ view txSkelOutValueL . snd <$> balancingUtxos
+          difference = snd $ Api.split $ missingLeft <> PlutusTx.negate totalValue
+      throw $ MCEUnbalanceable balancingUser difference
+    -- There exists a perfect solution, this is the rarest and easiest
     -- scenario, as the outputs will not change due to balancing. This means
     -- that there was no missing value on the right and the balancing utxos
     -- exactly account for what was missing on the left.
-    Just (txOutRefs, _) -> return (fst <$> txOutRefs, txSkelOuts)
+    Just (newORefs, Nothing) -> return (newORefs, txSkelOuts)
     -- There in an existing output at the owner's address and the balancing
     -- policy allows us to adjust it with additional value.
-    Nothing
-      | (before, txSkelOut : after) <- break ((== Script.toCredential balancingUser) . view txSkelOutCredentialG) txSkelOuts,
-        AdjustExistingOutput <- txSkelOptBalanceOutputPolicy txSkelOpts -> do
-          -- We get the optimal candidate based on an updated value. We update
-          -- the `txSkelOuts` by replacing the value content of the selected
-          -- output. We keep intact the orders of those outputs.
-          let candidatesRaw' = second (<> txSkelOut ^. txSkelOutValueL) <$> candidatesRaw
-          (txOutRefs, val) <- getOptimalCandidate candidatesRaw' balancingUser balancingError
-          return (txOutRefs, before ++ (txSkelOut & txSkelOutValueL .~ val) : after)
+    Just (newORefs, Just newTxSkelOut)
+      | AdjustExistingOutput <- txSkelOptBalanceOutputPolicy txSkelOpts,
+        (before, _ : after) <- break ((== Script.toCredential balancingUser) . view txSkelOutCredentialG) txSkelOuts ->
+          return (newORefs, before ++ (newTxSkelOut : after))
     -- There is no output at the balancing user address, or the balancing
     -- policy forces us to create a new output, both yielding the same result.
-    _ -> do
-      -- We get the optimal candidate, and update the `txSkelOuts` by appending
-      -- a new output at the end of the list, to keep the order intact.
-      (txOutRefs, val) <- getOptimalCandidate candidatesRaw balancingUser balancingError
-      return (txOutRefs, txSkelOuts ++ [balancingUser `receives` Value val])
+    Just (newORefs, Just newTxSkelOut) -> return (newORefs, txSkelOuts ++ [newTxSkelOut])
   let newTxSkelIns = txSkelIns <> Map.fromList ((,emptyTxSkelRedeemer) <$> additionalInsTxOutRefs)
   return $ (txSkel & txSkelOutsL .~ newTxSkelOuts) & txSkelInsL .~ newTxSkelIns
diff --git a/src/Cooked/MockChain/Common.hs b/src/Cooked/MockChain/Common.hs
index 1ad8b71cd..e8429773a 100644
--- a/src/Cooked/MockChain/Common.hs
+++ b/src/Cooked/MockChain/Common.hs
@@ -10,7 +10,6 @@ module Cooked.MockChain.Common
 where
 
 import Cooked.Skeleton.Output
-import Cooked.Skeleton.User
 import Data.Set (Set)
 import PlutusLedgerApi.V3 qualified as Api
 
@@ -22,8 +21,9 @@ type Fee = Integer
 -- | An alias for sets of utxos used as collateral inputs
 type CollateralIns = Set Api.TxOutRef
 
--- | An alias for optional pairs of collateral inputs and return collateral peer
-type Collaterals = Maybe (CollateralIns, Peer)
+-- | An alias for optional pairs of collateral inputs and optional return
+-- collateral output
+type Collaterals = (CollateralIns, Maybe TxSkelOut)
 
 -- | An alias for an output and its reference
 type Utxo = (Api.TxOutRef, TxSkelOut)
diff --git a/src/Cooked/MockChain/Error.hs b/src/Cooked/MockChain/Error.hs
index 0a93a11a4..91968d23e 100644
--- a/src/Cooked/MockChain/Error.hs
+++ b/src/Cooked/MockChain/Error.hs
@@ -25,7 +25,7 @@ data MockChainError
   | -- | The balancing user does not have enough funds
     MCEUnbalanceable Peer Api.Value
   | -- | The balancing user is required but missing
-    MCEMissingBalancingUser String
+    MCEMissingBalancingUser
   | -- | No suitable collateral could be associated with a skeleton
     MCENoSuitableCollateral Integer Integer Api.Value
   | -- | Translating a skeleton element to its Cardano counterpart failed
diff --git a/src/Cooked/MockChain/GenerateTx/Body.hs b/src/Cooked/MockChain/GenerateTx/Body.hs
index 2f6b27788..ed13e27c4 100644
--- a/src/Cooked/MockChain/GenerateTx/Body.hs
+++ b/src/Cooked/MockChain/GenerateTx/Body.hs
@@ -41,12 +41,12 @@ txSkelToTxBodyContent ::
   (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   TxSkel ->
   Fee ->
-  Collaterals ->
+  Maybe Collaterals ->
   Sem effs (Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra)
 txSkelToTxBodyContent skel@TxSkel {..} fee mCollaterals = do
   txIns <- mapM toTxInAndWitness $ Map.toList txSkelIns
   txInsReference <- toInsReference skel
-  (txInsCollateral, txTotalCollateral, txReturnCollateral) <- toCollateralTriplet fee mCollaterals
+  (txInsCollateral, txTotalCollateral, txReturnCollateral) <- toCollateralTriplet mCollaterals
   txOuts <- mapM toCardanoTxOut txSkelOuts
   (txValidityLowerBound, txValidityUpperBound) <- fromEither $ Ledger.toCardanoValidityRange txSkelValidityRange
   txMintValue <- toMintValue txSkelMints
@@ -85,7 +85,7 @@ txBodyContentToTxBody txBodyContent = do
 txSkelToIndex ::
   (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
   TxSkel ->
-  Collaterals ->
+  Maybe Collaterals ->
   Sem effs (Cardano.UTxO Cardano.ConwayEra)
 txSkelToIndex txSkel mCollaterals = do
   -- We build the index of UTxOs which are known to this skeleton. This includes
@@ -106,7 +106,7 @@ txSkelToTxBody ::
   (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   TxSkel ->
   Fee ->
-  Collaterals ->
+  Maybe Collaterals ->
   Sem effs (Cardano.TxBody Cardano.ConwayEra)
 txSkelToTxBody txSkel fee mCollaterals = do
   -- We create a first body content and body, without execution units
@@ -150,7 +150,7 @@ txSkelToCardanoTx ::
   (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   TxSkel ->
   Fee ->
-  Collaterals ->
+  Maybe Collaterals ->
   Sem effs (Cardano.Tx Cardano.ConwayEra)
 txSkelToCardanoTx txSkel fee =
   fmap (txSignatoriesAndBodyToCardanoTx (txSkelSignatories txSkel))
diff --git a/src/Cooked/MockChain/GenerateTx/Collateral.hs b/src/Cooked/MockChain/GenerateTx/Collateral.hs
index d441936dd..3b6751106 100644
--- a/src/Cooked/MockChain/GenerateTx/Collateral.hs
+++ b/src/Cooked/MockChain/GenerateTx/Collateral.hs
@@ -3,76 +3,54 @@
 module Cooked.MockChain.GenerateTx.Collateral where
 
 import Cardano.Api qualified as Cardano
-import Cardano.Ledger.Conway.Core qualified as Conway
-import Cardano.Node.Emulator.Internal.Node qualified as Emulator
-import Control.Monad
 import Cooked.MockChain.Common
+import Cooked.MockChain.GenerateTx.Output
 import Cooked.MockChain.Read
 import Cooked.Skeleton.Output
+import Cooked.Skeleton.Value
+import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Ledger.Tx.CardanoAPI qualified as Ledger
-import Lens.Micro.Extras qualified as MicroLens
-import Plutus.Script.Utils.Address qualified as Script
-import Plutus.Script.Utils.Value qualified as Script
-import PlutusTx.Numeric qualified as PlutusTx
+import Optics.Core
+import PlutusLedgerApi.V3 qualified as Api
 import Polysemy
 import Polysemy.Error
 
--- | Computes the collateral triplet from the fees and the collateral inputs in
--- the context. What we call a collateral triplet is composed of:
+-- | Computes the collateral triplet from the potential collaterals. What we
+-- call a collateral triplet is composed of:
+--
 -- * The set of collateral inputs
+--
 -- * The total collateral paid by the transaction in case of phase 2 failure
+--
 -- * An output returning excess collateral value when collaterals are used
+--
 -- These quantity should satisfy the equation (in terms of their values):
 -- collateral inputs = total collateral + return collateral
 toCollateralTriplet ::
   (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
-  Fee ->
-  Collaterals ->
+  Maybe Collaterals ->
   Sem
     effs
     ( Cardano.TxInsCollateral Cardano.ConwayEra,
       Cardano.TxTotalCollateral Cardano.ConwayEra,
       Cardano.TxReturnCollateral Cardano.CtxTx Cardano.ConwayEra
     )
-toCollateralTriplet _ Nothing = return (Cardano.TxInsCollateralNone, Cardano.TxTotalCollateralNone, Cardano.TxReturnCollateralNone)
-toCollateralTriplet fee (Just (Set.toList -> collateralInsList, returnCollateralUser)) = do
+toCollateralTriplet Nothing = return (Cardano.TxInsCollateralNone, Cardano.TxTotalCollateralNone, Cardano.TxReturnCollateralNone)
+toCollateralTriplet (Just (Set.toList -> collateralInsList, mReturnCollateral)) = do
   -- We build the collateral inputs from this list
   txInsCollateral <-
     case collateralInsList of
       [] -> return Cardano.TxInsCollateralNone
       l -> fromEither $ Cardano.TxInsCollateral Cardano.AlonzoEraOnwardsConway <$> mapM Ledger.toCardanoTxIn l
-  -- Retrieving the total value in collateral inputs. This fails if one of the
-  -- collateral inputs has not been successfully resolved.
-  collateralInsValue <-
-    foldM (\val -> ((val <>) <$>) . viewByRef txSkelOutValueL) mempty collateralInsList
-  -- We retrieve the collateral percentage compared to fees. By default, we use
-  -- 150% which is the current value in the parameters, although the default
-  -- value should never be used here, as the call is supposed to always succeed.
-  collateralPercentage <- toInteger . MicroLens.view Conway.ppCollateralPercentageL . Emulator.pEmulatorPParams <$> getParams
-  -- The total collateral corresponds to the fees multiplied by the collateral
-  -- percentage. We add 1 because the ledger apparently rounds up this value.
-  let coinTotalCollateral = 1 + (fee * collateralPercentage) `div` 100
-  -- We create the total collateral based on the computed value
-  let txTotalCollateral = Cardano.TxTotalCollateral Cardano.BabbageEraOnwardsConway $ Cardano.Coin coinTotalCollateral
-  -- We compute a return collateral value by subtracting the total collateral to
-  -- the value in collateral inputs
-  let returnCollateralValue = collateralInsValue <> PlutusTx.negate (Script.lovelace coinTotalCollateral)
-  -- The return collateral is then computed
+  -- We collect the amount of lovelace in the collateral inputs
+  Api.Lovelace collateralInsLovelace <- foldOf (folded % txSkelOutValueL % valueLovelaceL) . Map.elems <$> lookupUtxos collateralInsList
+  -- We collect the amount of lovelace in the return collateral output
+  let Api.Lovelace returnCollateralLovelace = maybe 0 (view (txSkelOutValueL % valueLovelaceL)) mReturnCollateral
+  -- The total collateral is the difference between the two
+  let txTotalCollateral = Cardano.TxTotalCollateral Cardano.BabbageEraOnwardsConway $ Cardano.Coin $ collateralInsLovelace - returnCollateralLovelace
   txReturnCollateral <-
-    -- If the total collateral equal what the inputs provide, we return
-    -- `TxReturnCollateralNone`, otherwise, we compute the new output
-    if returnCollateralValue == mempty
-      then return Cardano.TxReturnCollateralNone
-      else do
-        -- The value is a translation of the remaining value
-        txReturnCollateralValue <- Ledger.toCardanoTxOutValue <$> fromEither (Ledger.toCardanoValue returnCollateralValue)
-        -- The address is the one from the return collateral user, which is
-        -- required to exist here.
-        networkId <- Emulator.pNetworkId <$> getParams
-        address <- fromEither $ Ledger.toCardanoAddressInEra networkId (Script.toAddress returnCollateralUser)
-        -- The return collateral is built up from those elements
-        return $
-          Cardano.TxReturnCollateral Cardano.BabbageEraOnwardsConway $
-            Cardano.TxOut address txReturnCollateralValue Cardano.TxOutDatumNone Cardano.ReferenceScriptNone
+    case mReturnCollateral of
+      Nothing -> return Cardano.TxReturnCollateralNone
+      Just collateralOut -> Cardano.TxReturnCollateral Cardano.BabbageEraOnwardsConway <$> toCardanoTxOut collateralOut
   return (txInsCollateral, txTotalCollateral, txReturnCollateral)
diff --git a/src/Cooked/MockChain/Log.hs b/src/Cooked/MockChain/Log.hs
index 173eb1807..766163257 100644
--- a/src/Cooked/MockChain/Log.hs
+++ b/src/Cooked/MockChain/Log.hs
@@ -32,7 +32,7 @@ data MockChainLogEntry
     MCLogSubmittedTxSkel TxSkel
   | -- | Logging a Skeleton as it has been adjusted by the balancing mechanism,
     -- alongside fee, and possible collateral utxos and return collateral user.
-    MCLogAdjustedTxSkel TxSkel Fee Collaterals
+    MCLogAdjustedTxSkel TxSkel Fee (Maybe Collaterals)
   | -- | Logging the successful validation of a new transaction, with its id and
     -- number of produced outputs.
     MCLogNewTx Api.TxId Integer
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index 6c676588b..fa51e98ac 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -193,18 +193,16 @@ runMockChainWrite = interpret $ \case
     newOutputs <- case Emulator.validateCardanoTx newParams eLedgerState cardanoTx of
       -- In case of a phase 1 error, we give back the same index
       (_, Ledger.FailPhase1 _ err) -> throw $ MCEValidationError Ledger.Phase1 err
-      (newELedgerState, Ledger.FailPhase2 _ err _) | Just (colInputs, retColUser) <- mCollaterals -> do
+      (newELedgerState, Ledger.FailPhase2 _ err _) | Just (colInputs, mRetColOutput) <- mCollaterals -> do
         -- We update the emulated ledger state
         modify' (set mcstLedgerStateL newELedgerState)
         -- We remove the collateral utxos from our own stored outputs
         forM_ colInputs $ modify' . removeOutput
-        -- We add the returned collateral to our outputs (in practice this map
-        -- either contains no element, or a single one)
-        forM_ (Map.toList $ Ledger.getCardanoTxProducedReturnCollateral cardanoTx) $ \(txIn, txOut) ->
-          modify' $
-            addOutput
-              (Ledger.fromCardanoTxIn txIn)
-              (retColUser `receives` Value (Api.txOutValue . Ledger.fromCardanoTxOutToPV2TxInfoTxOut . Ledger.getTxOut $ txOut))
+        -- We add the returned collateral to our outputs when it exists
+        case (mRetColOutput, Map.toList $ Ledger.getCardanoTxProducedReturnCollateral cardanoTx) of
+          (Nothing, []) -> return ()
+          (Just retColOutput, [(txIn, _)]) -> modify' $ addOutput (Ledger.fromCardanoTxIn txIn) retColOutput
+          _ -> fail "Unreachable case when processing return collaterals, please report a bug at https://github.com/tweag/cooked-validators/issues"
         -- We throw a mockchain error
         throw $ MCEValidationError Ledger.Phase2 err
       -- In case of success, we update the index with all inputs and outputs
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index eb087a52e..339c5c5dd 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -70,7 +70,7 @@ instance PrettyCooked Peer where
 instance PrettyCooked MockChainError where
   prettyCookedOpt opts (MCEValidationError plutusPhase plutusError) =
     PP.vsep ["Validation error " <+> prettyCookedOpt opts plutusPhase, PP.indent 2 (prettyCookedOpt opts plutusError)]
-  prettyCookedOpt _ (MCEMissingBalancingUser msg) = "Missing balancing user:" <+> PP.pretty msg
+  prettyCookedOpt _ MCEMissingBalancingUser = "Missing balancing user"
   prettyCookedOpt opts (MCEUnbalanceable balUser missingValue) =
     prettyItemize
       opts
@@ -136,9 +136,11 @@ instance PrettyCooked (Contextualized MockChainLogEntry) where
           ++ ( ("Fee:" <+> prettyCookedOpt opts (Script.lovelace fee))
                  : maybe
                    ["No collateral required"]
-                   ( \(collaterals, returnUser) ->
+                   ( \(collaterals, mRetColOutput) ->
                        [ prettyItemize opts "Collateral inputs:" "-" (Contextualized outputs . CollateralInput <$> Set.toList collaterals),
-                         "Return collateral target:" <+> prettyCookedOpt opts returnUser
+                         case mRetColOutput of
+                           Nothing -> "No return collateral output"
+                           Just retColOutput -> prettyItemize opts "Return collateral output:" "-" retColOutput
                        ]
                    )
                    mCollaterals
diff --git a/tests/Spec/Balancing.hs b/tests/Spec/Balancing.hs
index 43ba21b7b..af43ad79f 100644
--- a/tests/Spec/Balancing.hs
+++ b/tests/Spec/Balancing.hs
@@ -37,7 +37,7 @@ initialDistributionBalancing =
     alice `receives` FixedValue (Script.ada 105 <> banana 2) <&&> VisibleHashedDatum ()
   ]
 
-type TestBalancingOutcome = (TxSkel, TxSkel, Fee, Collaterals, [Api.TxOutRef])
+type TestBalancingOutcome = (TxSkel, TxSkel, Fee, Maybe Collaterals, [Api.TxOutRef])
 
 spendsScriptUtxo :: Bool -> FullMockChain (Map Api.TxOutRef TxSkelRedeemer)
 spendsScriptUtxo False = return Map.empty
@@ -241,7 +241,7 @@ failsAtCollaterals MCENoSuitableCollateral {} = testBool True
 failsAtCollaterals _ = testBool False
 
 failsLackOfCollateralWallet :: MockChainError -> Assertion
-failsLackOfCollateralWallet (MCEMissingBalancingUser msg) = "Collateral utxos should be taken from the balancing user, but it does not exist." .==. msg
+failsLackOfCollateralWallet MCEMissingBalancingUser = testBool True
 failsLackOfCollateralWallet _ = testBool False
 
 testBalancingFailsWith :: (Show a) => String -> (MockChainError -> Assertion) -> FullMockChain a -> TestTree

From ce610b5e0c915f047b47184c511a06292b259d27 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Wed, 18 Feb 2026 21:35:38 +0100
Subject: [PATCH 79/96] balancing give back the body

---
 src/Cooked/MockChain/Balancing.hs | 240 ++++++++++++++++--------------
 src/Cooked/MockChain/Error.hs     |  28 +++-
 src/Cooked/MockChain/Write.hs     |   5 +-
 src/Cooked/Pretty/MockChain.hs    |  29 ++--
 tests/Spec/Balancing.hs           |  21 +--
 5 files changed, 180 insertions(+), 143 deletions(-)

diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 1d211f633..514794541 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -2,7 +2,8 @@
 -- computation of fees and collaterals because their computation cannot be
 -- separated from the balancing.
 module Cooked.MockChain.Balancing
-  ( balanceTxSkel,
+  ( ExtendedTxSkel (..),
+    balanceTxSkel,
     getMinAndMaxFee,
     estimateTxSkelFee,
   )
@@ -45,6 +46,20 @@ import Polysemy
 import Polysemy.Error
 import Polysemy.Fail
 
+type Body = Cardano.TxBody Cardano.ConwayEra
+
+-- | A `TxSkel` with extra pieces of information produced during balancing
+data ExtendedTxSkel = ExtendedTxSkel
+  { -- | The skeleton itself
+    eSkel :: TxSkel,
+    -- | The fee associated with this skeleton
+    eFee :: Fee,
+    -- | The optional collateras associated with this skeleton
+    eMCollaterals :: Maybe Collaterals,
+    -- | The Cardano body generated from this skeleton
+    eMBody :: Body
+  }
+
 -- | This is the main entry point of our balancing mechanism. This function
 -- takes a skeleton and returns a (possibly) balanced skeleton alongside the
 -- associated fee, collateral inputs and return collateral user, which might
@@ -54,14 +69,14 @@ import Polysemy.Fail
 balanceTxSkel ::
   (Members '[MockChainRead, MockChainLog, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   TxSkel ->
-  Sem effs (TxSkel, Fee, Maybe Collaterals)
+  Sem effs ExtendedTxSkel
 balanceTxSkel skelUnbal@TxSkel {..} = do
   -- We retrieve the possible balancing user. Any extra payment will be
   -- redirected to them, and utxos will be taken from their wallet if associated
   -- with the @BalancingUtxosFromBalancingUser@ policy
   balancingUser <- case txSkelOptBalancingPolicy txSkelOpts of
     BalanceWithFirstSignatory -> case txSkelSignatories of
-      [] -> throw MCEMissingBalancingUser
+      [] -> throw $ MCEBalancingError MissingBalancingUser
       bw : _ -> return $ Just $ UserPubKey bw
     BalanceWith bUser -> return $ Just $ UserPubKey bUser
     DoNotBalance -> return Nothing
@@ -97,20 +112,22 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
       -- Some scripts involved, and no specific collateral options provided.
       (False, CollateralUtxosFromBalancingUser) -> case balancingUser of
         -- If no balancing wallet exists, we throw an error
-        Nothing -> throw MCEMissingBalancingUser
+        Nothing -> throw $ MCEBalancingError MissingBalancingUser
         -- If a balancing wallet exists, we use it as collateral user
         Just bUser -> Just . (,bUser) . Set.fromList <$> getTxOutRefs (utxosAtSearch bUser ensureOnlyValueOutputs)
 
   -- At this point, the presence (or absence) of balancing user dictates
   -- whether the transaction should be automatically balanced or not.
-  (txSkelBal, fee, adjustedColsAndUser) <- case balancingUser of
-    Nothing ->
+  case balancingUser of
+    Nothing -> do
       -- The balancing should not be performed. We still adjust the collaterals
       -- though around a provided fee, or the maximum fee.
       let fee = case txSkelOptFeePolicy txSkelOpts of
             AutoFeeComputation -> maxFee
             ManualFee fee' -> fee'
-       in (skelUnbal,fee,) <$> collateralsFromFee fee mCollaterals
+      mCols <- collateralsFromFee fee mCollaterals
+      cBody <- txSkelToTxBody skelUnbal fee mCols
+      return $ ExtendedTxSkel skelUnbal fee mCols cBody
     Just bUser -> do
       -- The balancing should be performed. We collect the candidates balancing
       -- utxos based on the associated policy
@@ -135,51 +152,15 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
         -- If fee are provided manually, we adjust the collaterals and the
         -- skeleton around them directly.
         ManualFee fee -> do
-          adjustedColsAndUser <- collateralsFromFee fee mCollaterals
-          attemptedSkel <- computeBalancedTxSkel bUser balancingUtxos skelUnbal fee
-          return (attemptedSkel, fee, adjustedColsAndUser)
-
-  return (txSkelBal, fee, adjustedColsAndUser)
+          mCols <- collateralsFromFee fee mCollaterals
+          balancedSkel <- computeBalancedTxSkel bUser balancingUtxos skelUnbal fee
+          cBody <- txSkelToTxBody balancedSkel fee mCols
+          return $ ExtendedTxSkel balancedSkel fee mCols cBody
   where
     filterAndWarn f s l
       | (ok, toInteger . length -> koLength) <- partition f l =
           unless (koLength == 0) (logEvent $ MCLogDiscardedUtxos koLength s) >> return ok
 
--- | This computes the minimum and maximum possible fee a transaction can cost
--- based on the current protocol parameters and its number of scripts.
--- In the Dijsktra era, this will be modified with new protocol parameters.
--- See https://github.com/IntersectMBO/cardano-ledger/blob/master/docs/adr/2024-08-14_009-refscripts-fee-change.md
--- for more information
-getMinAndMaxFee ::
-  (Members '[MockChainRead] effs) =>
-  Integer ->
-  Sem effs (Fee, Fee)
-getMinAndMaxFee nbOfScripts = do
-  -- We retrieve the necessary parameters to compute the maximum possible fee
-  -- for a transaction. There are quite a few of them.
-  params <- Emulator.pEmulatorPParams <$> getParams
-  let maxTxSize = toInteger $ MicroLens.view Conway.ppMaxTxSizeL params
-      Cardano.Coin txFeePerByte = MicroLens.view Conway.ppMinFeeAL params
-      Cardano.Coin txFeeFixed = MicroLens.view Conway.ppMinFeeBL params
-      Cardano.Prices (Cardano.unboundRational -> priceESteps) (Cardano.unboundRational -> priceEMem) = MicroLens.view Conway.ppPricesL params
-      Cardano.ExUnits (toInteger -> eSteps) (toInteger -> eMem) = MicroLens.view Conway.ppMaxTxExUnitsL params
-      (Cardano.unboundRational -> refScriptFeePerByte) = MicroLens.view Conway.ppMinFeeRefScriptCostPerByteL params
-  -- We compute the components of the maximum possible fee, starting with the
-  -- maximum fee associated with the transaction size
-  let txSizeMaxFee = maxTxSize * txFeePerByte
-  -- maximum fee associated with the number of execution steps for scripts
-  let eStepsMaxFee = (eSteps * Rat.numerator priceESteps) `div` Rat.denominator priceESteps
-  -- maximum fee associated with the number of execution memory for scripts
-  let eMemMaxFee = (eMem * Rat.numerator priceEMem) `div` Rat.denominator priceEMem
-  -- maximum fee associated with the size of all reference scripts
-  let refScriptsMaxFee = (maxTxSize * Rat.numerator refScriptFeePerByte) `div` Rat.denominator refScriptFeePerByte
-  return
-    ( -- Minimal fee is just the fixed portion of the fee
-      txFeeFixed,
-      -- Maximal fee is the fixed portion plus all the other maximum fees
-      txFeeFixed + txSizeMaxFee + nbOfScripts * (eStepsMaxFee + eMemMaxFee) + refScriptsMaxFee
-    )
-
 -- | Computes optimal fee for a given skeleton and balances it around those fees.
 -- This uses a dichotomic search for an optimal "balanceable around" fee.
 computeFeeAndBalance ::
@@ -190,72 +171,71 @@ computeFeeAndBalance ::
   Utxos ->
   Maybe (CollateralIns, Peer) ->
   TxSkel ->
-  Sem effs (TxSkel, Fee, Maybe Collaterals)
+  Sem effs ExtendedTxSkel
 computeFeeAndBalance _ minFee maxFee _ _ _
   | minFee > maxFee =
       fail "Unreachable case, please report a bug at https://github.com/tweag/cooked-validators/issues"
-computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals skel
-  | minFee == maxFee = do
-      -- The fee interval is reduced to a single element, we balance around it
-      (adjustedColsAndUser, attemptedSkel) <- attemptBalancingAndCollaterals balancingUser balancingUtxos minFee mCollaterals skel
-      return (attemptedSkel, minFee, adjustedColsAndUser)
-computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals skel
-  | fee <- (minFee + maxFee) `div` 2 = do
-      -- The fee interval is larger than a single element. We attempt to balance
-      -- around its central point, which can fail due to missing value in
-      -- balancing utxos or collateral utxos.
-      attemptedBalancing <- catch
-        (Just <$> attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel)
-        $ \case
-          -- If it fails, and the remaining fee interval is not reduced to the
-          -- current fee attempt, we return `Nothing` which signifies that we
-          -- need to keep searching. Otherwise, the whole balancing process
-          -- fails and we spread the error.
-          MCEUnbalanceable {} | fee - minFee > 0 -> return Nothing
-          MCENoSuitableCollateral {} | fee - minFee > 0 -> return Nothing
-          err -> throw err
+computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals skel = do
+  let fee = (minFee + maxFee) `div` 2
+  -- The fee interval is non-empty. We attempt to balance around its central
+  -- point, and handle possible failures.
+  attemptedBalancing <- catch
+    (Just <$> attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel)
+    $ \case
+      -- If it fails, and the remaining fee interval is not reduced to the
+      -- current fee attempt, we return `Nothing` which signifies that we
+      -- need to keep searching. Otherwise, the whole balancing process
+      -- fails and we spread the error.
+      MCEBalancingError {} | fee > minFee -> return Nothing
+      err -> throw err
 
-      (newMinFee, newMaxFee) <- case attemptedBalancing of
-        -- The skeleton was not balanceable, we try strictly smaller fee
-        Nothing -> return (minFee, fee - 1)
-        -- The skeleton was balanceable, we compute and analyse the resulting
-        -- fee to seach upwards or downwards for an optimal solution
-        Just (adjustedColsAndUser, attemptedSkel) -> do
-          newFee <- estimateTxSkelFee attemptedSkel fee adjustedColsAndUser
-          return $ case fee - newFee of
-            -- Current fee is insufficient, we look on the right (strictly)
-            n | n < 0 -> (fee + 1, maxFee)
-            -- Current fee is sufficient, but the set of balancing utxos cannot
-            -- necessarily account for less fee, since it was (magically)
-            -- exactly enough to compensate for the missing value. Reducing the
-            -- fee would ruin this perfect balancing and force an output to be
-            -- created at the balancing user address, thus we cannot assume
-            -- the actual estimated fee can be accounted for with the current
-            -- set of balancing utxos and we cannot speed up search.
-            _ | txSkelValueInOutputs attemptedSkel == txSkelValueInOutputs skel -> (minFee, fee)
-            -- Current fee is sufficient, and the set of utxo could account for
-            -- less fee by feeding into whatever output already goes back to the
-            -- balancing user. We can speed up search, because the current
-            -- attempted skeleton could necessarily account for the estimated
-            -- fee of the input skeleton.
-            _ -> (minFee, newFee)
+  case attemptedBalancing of
+    -- The skeleton was not balanceable, we try strictly smaller fee
+    Nothing -> computeFeeAndBalance balancingUser minFee (fee - 1) balancingUtxos mCollaterals skel
+    -- The skeleton was balanceable, we cannot try smaller fee, and
+    -- the used fee is sufficient for the generated body. All good!
+    Just extendedTxSkel | minFee == maxFee, eFee extendedTxSkel <= fee -> return extendedTxSkel
+    -- The skeleton was balanceable, we cannot try smaller fee, but
+    -- the used fee is insufficient for the generated body
+    Just _ | minFee == maxFee -> throw $ MCEBalancingError $ NotEnoughFundForProperFee balancingUser
+    -- Current fee is insufficient, we look on the right (strictly)
+    Just extendedTxSkel
+      | eFee extendedTxSkel > fee ->
+          computeFeeAndBalance balancingUser (fee + 1) maxFee balancingUtxos mCollaterals skel
+    -- Current fee is sufficient, but the set of balancing utxos cannot
+    -- necessarily account for less fee, since it was (magically) exactly enough
+    -- to compensate for the missing value. Reducing the fee would ruin this
+    -- perfect balancing and force an output to be created at the balancing user
+    -- address, thus we cannot assume the actual estimated fee can be accounted
+    -- for with the current set of balancing utxos and cannot speed up search.
+    Just extendedSkel
+      | txSkelValueInOutputs (eSkel extendedSkel) == txSkelValueInOutputs skel ->
+          computeFeeAndBalance balancingUser minFee fee balancingUtxos mCollaterals skel
+    -- Current fee is sufficient, and the set of utxo could account for
+    -- less fee by feeding into whatever output already goes back to the
+    -- balancing user. We can speed up search, because the current
+    -- attempted skeleton could necessarily account for the estimated
+    -- fee of the input skeleton.
+    Just extendedSkel ->
+      computeFeeAndBalance balancingUser minFee (eFee extendedSkel) balancingUtxos mCollaterals skel
 
-      computeFeeAndBalance balancingUser newMinFee newMaxFee balancingUtxos mCollaterals skel
-
--- | Helper function to group the two real steps of the balancing: balance a
--- skeleton around a given fee, and compute the associated collateral inputs
+-- | Helper function to group the three real steps of the balancing: balance a
+-- skeleton around a given fee, compute the associated collateral inputs, and
+-- compute the new fee from those elements. It the process, also returns the
+-- generated body for the new skeleton.
 attemptBalancingAndCollaterals ::
-  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
+  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
   Peer ->
   Utxos ->
   Fee ->
   Maybe (CollateralIns, Peer) ->
   TxSkel ->
-  Sem effs (Maybe Collaterals, TxSkel)
+  Sem effs ExtendedTxSkel
 attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel = do
-  attemptedSkel <- computeBalancedTxSkel balancingUser balancingUtxos skel fee
-  collaterals <- collateralsFromFee fee mCollaterals
-  return (collaterals, attemptedSkel)
+  newSkel <- computeBalancedTxSkel balancingUser balancingUtxos skel fee
+  mCols <- collateralsFromFee fee mCollaterals
+  (body, newFee) <- estimateTxSkelFee newSkel fee mCols
+  return $ ExtendedTxSkel newSkel newFee mCols body
 
 -- | This selects a subset of suitable collateral inputs from a given set while
 -- accounting for the ratio to respect between fees and total collaterals, the
@@ -292,7 +272,7 @@ collateralsFromFee fee (Just (collateralIns, returnCollateralUser)) = do
   case reachedValue of
     -- If no value was reached, the input UTxOs are insufficient to provide
     -- the necessary collaterals, and thus an error is raised
-    Nothing -> throw $ MCENoSuitableCollateral fee percentage totalCollateral
+    Nothing -> throw $ MCEBalancingError $ NoSuitableCollateral fee percentage totalCollateral
     -- If a value was reached, we return it alongside the return collaterals
     Just (oRefs, returnOutput) -> return $ Just (Set.fromList oRefs, returnOutput)
 
@@ -436,19 +416,20 @@ estimateTxSkelFee ::
   TxSkel ->
   Fee ->
   Maybe Collaterals ->
-  Sem effs Fee
+  Sem effs (Body, Fee)
 estimateTxSkelFee skel fee mCollaterals = do
   -- We retrieve the necessary data to generate the transaction body
-  params <- getParams
+  params <- Emulator.pEmulatorPParams <$> getParams
   -- We build the index known to the skeleton
   index <- txSkelToIndex skel mCollaterals
   -- We build the transaction body
   txBody <- txSkelToTxBody skel fee mCollaterals
-  -- We finally can the fee estimate function
-  return $
-    Cardano.unCoin $
-      Cardano.calculateMinTxFee Cardano.ShelleyBasedEraConway (Emulator.pEmulatorPParams params) index txBody $
-        fromIntegral (length $ txSkelSignatories skel)
+  -- We retrieve the amount of signatories
+  let nbOfSignatories = fromIntegral $ length $ txSkelSignatories skel
+  -- We compute the estimated fee
+  let Cardano.Coin newFee = Cardano.calculateMinTxFee Cardano.ShelleyBasedEraConway params index txBody nbOfSignatories
+  -- We return both the new fee and generated body
+  return (txBody, newFee)
 
 -- | This creates a balanced skeleton from a given skeleton and fee. In other
 -- words, this ensures that the following equation holds: input value + minted
@@ -510,7 +491,11 @@ computeBalancedTxSkel balancingUser balancingUtxos txSkel@TxSkel {..} (Script.lo
     Nothing -> do
       let totalValue = mconcat $ view txSkelOutValueL . snd <$> balancingUtxos
           difference = snd $ Api.split $ missingLeft <> PlutusTx.negate totalValue
-      throw $ MCEUnbalanceable balancingUser difference
+      throw $
+        MCEBalancingError $
+          if difference == mempty
+            then NotEnoughFundForExtraMinAda balancingUser
+            else NotEnoughFund balancingUser difference
     -- There exists a perfect solution, this is the rarest and easiest
     -- scenario, as the outputs will not change due to balancing. This means
     -- that there was no missing value on the right and the balancing utxos
@@ -527,3 +512,38 @@ computeBalancedTxSkel balancingUser balancingUtxos txSkel@TxSkel {..} (Script.lo
     Just (newORefs, Just newTxSkelOut) -> return (newORefs, txSkelOuts ++ [newTxSkelOut])
   let newTxSkelIns = txSkelIns <> Map.fromList ((,emptyTxSkelRedeemer) <$> additionalInsTxOutRefs)
   return $ (txSkel & txSkelOutsL .~ newTxSkelOuts) & txSkelInsL .~ newTxSkelIns
+
+-- | This computes the minimum and maximum possible fee a transaction can cost
+-- based on the current protocol parameters and its number of scripts.
+-- In the Dijsktra era, this will be modified with new protocol parameters.
+-- See https://github.com/IntersectMBO/cardano-ledger/blob/master/docs/adr/2024-08-14_009-refscripts-fee-change.md
+-- for more information
+getMinAndMaxFee ::
+  (Members '[MockChainRead] effs) =>
+  Integer ->
+  Sem effs (Fee, Fee)
+getMinAndMaxFee nbOfScripts = do
+  -- We retrieve the necessary parameters to compute the maximum possible fee
+  -- for a transaction. There are quite a few of them.
+  params <- Emulator.pEmulatorPParams <$> getParams
+  let maxTxSize = toInteger $ MicroLens.view Conway.ppMaxTxSizeL params
+      Cardano.Coin txFeePerByte = MicroLens.view Conway.ppMinFeeAL params
+      Cardano.Coin txFeeFixed = MicroLens.view Conway.ppMinFeeBL params
+      Cardano.Prices (Cardano.unboundRational -> priceESteps) (Cardano.unboundRational -> priceEMem) = MicroLens.view Conway.ppPricesL params
+      Cardano.ExUnits (toInteger -> eSteps) (toInteger -> eMem) = MicroLens.view Conway.ppMaxTxExUnitsL params
+      (Cardano.unboundRational -> refScriptFeePerByte) = MicroLens.view Conway.ppMinFeeRefScriptCostPerByteL params
+  -- We compute the components of the maximum possible fee, starting with the
+  -- maximum fee associated with the transaction size
+  let txSizeMaxFee = maxTxSize * txFeePerByte
+  -- maximum fee associated with the number of execution steps for scripts
+  let eStepsMaxFee = (eSteps * Rat.numerator priceESteps) `div` Rat.denominator priceESteps
+  -- maximum fee associated with the number of execution memory for scripts
+  let eMemMaxFee = (eMem * Rat.numerator priceEMem) `div` Rat.denominator priceEMem
+  -- maximum fee associated with the size of all reference scripts
+  let refScriptsMaxFee = (maxTxSize * Rat.numerator refScriptFeePerByte) `div` Rat.denominator refScriptFeePerByte
+  return
+    ( -- Minimal fee is just the fixed portion of the fee
+      txFeeFixed,
+      -- Maximal fee is the fixed portion plus all the other maximum fees
+      txFeeFixed + txSizeMaxFee + nbOfScripts * (eStepsMaxFee + eMemMaxFee) + refScriptsMaxFee
+    )
diff --git a/src/Cooked/MockChain/Error.hs b/src/Cooked/MockChain/Error.hs
index 91968d23e..d0b2c9e7f 100644
--- a/src/Cooked/MockChain/Error.hs
+++ b/src/Cooked/MockChain/Error.hs
@@ -1,6 +1,7 @@
 -- | This module exposes the errors that can be raised during a mockchain run
 module Cooked.MockChain.Error
   ( -- * Mockchain errors
+    BalancingError (..),
     MockChainError (..),
 
     -- * Interpretating effects into `Error MockChainError`
@@ -18,16 +19,31 @@ import Polysemy
 import Polysemy.Error
 import Polysemy.Fail
 
+-- | Errors that can be produced during balancing
+data BalancingError
+  = -- | The balancing user theoretically has enough funds to balancing the
+    -- trasaction, but this balancing results in a surplus payment which they
+    -- cannot afford ADA-wise.
+    NotEnoughFundForExtraMinAda Peer
+  | -- | The balancing does not have enough funds to sustain the fee required to
+    -- balance the transaction.
+    NotEnoughFundForProperFee Peer
+  | -- | The balancing wallet does not have enough funds to balance the
+    -- transaction
+    NotEnoughFund Peer Api.Value
+  | -- | The provided of collateral UTxOs does not have enough funds to cover
+    -- the potential collateral cost
+    NoSuitableCollateral Integer Integer Api.Value
+  | -- | The balancing user has not be provided, but the balancing requires it
+    MissingBalancingUser
+  deriving (Show, Eq)
+
 -- | Errors that can be produced by the blockchain
 data MockChainError
   = -- | Validation errors, either in Phase 1 or Phase 2
     MCEValidationError Ledger.ValidationPhase Ledger.ValidationError
-  | -- | The balancing user does not have enough funds
-    MCEUnbalanceable Peer Api.Value
-  | -- | The balancing user is required but missing
-    MCEMissingBalancingUser
-  | -- | No suitable collateral could be associated with a skeleton
-    MCENoSuitableCollateral Integer Integer Api.Value
+  | -- | Balancing errors
+    MCEBalancingError BalancingError
   | -- | Translating a skeleton element to its Cardano counterpart failed
     MCEToCardanoError Ledger.ToCardanoError
   | -- | The required reference script is missing from a witness utxo
diff --git a/src/Cooked/MockChain/Write.hs b/src/Cooked/MockChain/Write.hs
index fa51e98ac..39f50b255 100644
--- a/src/Cooked/MockChain/Write.hs
+++ b/src/Cooked/MockChain/Write.hs
@@ -178,12 +178,13 @@ runMockChainWrite = interpret $ \case
     autoFillWithdrawalAmounts
     -- We balance the skeleton when requested in the skeleton option, and get
     -- the associated fee, collateral inputs and return collateral user
-    (finalTxSkel, fee, mCollaterals) <- viewTweak simple >>= balanceTxSkel
+    ExtendedTxSkel finalTxSkel fee mCollaterals body <- viewTweak simple >>= balanceTxSkel
     -- We log the adjusted skeleton
     logEvent $ MCLogAdjustedTxSkel finalTxSkel fee mCollaterals
     -- We generate the transaction asscoiated with the skeleton, and apply on it
     -- the modifications from the skeleton options
-    cardanoTx <- Ledger.CardanoEmulatorEraTx . txSkelOptModTx <$> txSkelToCardanoTx finalTxSkel fee mCollaterals
+    signatories <- viewTweak txSkelSignatoriesL
+    let cardanoTx = Ledger.CardanoEmulatorEraTx $ txSkelOptModTx $ txSignatoriesAndBodyToCardanoTx signatories body
     -- To run transaction validation we need a minimal ledger state
     eLedgerState <- gets mcstLedgerState
     -- We finally run the emulated validation. We update our internal state
diff --git a/src/Cooked/Pretty/MockChain.hs b/src/Cooked/Pretty/MockChain.hs
index 339c5c5dd..c313cc18d 100644
--- a/src/Cooked/Pretty/MockChain.hs
+++ b/src/Cooked/Pretty/MockChain.hs
@@ -67,21 +67,15 @@ instance (Show a) => PrettyCooked (MockChainReturn a) where
 instance PrettyCooked Peer where
   prettyCookedOpt opts = prettyHash opts . Script.toPubKeyHash
 
-instance PrettyCooked MockChainError where
-  prettyCookedOpt opts (MCEValidationError plutusPhase plutusError) =
-    PP.vsep ["Validation error " <+> prettyCookedOpt opts plutusPhase, PP.indent 2 (prettyCookedOpt opts plutusError)]
-  prettyCookedOpt _ MCEMissingBalancingUser = "Missing balancing user"
-  prettyCookedOpt opts (MCEUnbalanceable balUser missingValue) =
-    prettyItemize
-      opts
-      "Unbalanceable:"
-      "-"
-      [ prettyCookedOpt opts balUser <+> "does not have enough funds",
-        if missingValue == mempty
-          then "Not enough funds to sustain the minimal ada of the return utxo"
-          else "Unable to find" <+> prettyCookedOpt opts missingValue
-      ]
-  prettyCookedOpt opts (MCENoSuitableCollateral fee percentage colVal) =
+instance PrettyCooked BalancingError where
+  prettyCookedOpt opts (NotEnoughFundForExtraMinAda peer) =
+    prettyCookedOpt opts peer <+> "does not have enough funds to account for the min ADA of the surplus payment"
+  prettyCookedOpt opts (NotEnoughFundForProperFee peer) =
+    prettyCookedOpt opts peer <+> "does not have enough funds to account for the minimum required fee"
+  prettyCookedOpt opts (NotEnoughFund peer missingValue) =
+    prettyCookedOpt opts peer <+> "does not have enough funds to account for this missing value:" <+> prettyCookedOpt opts missingValue
+  prettyCookedOpt _ MissingBalancingUser = "Missing balancing user"
+  prettyCookedOpt opts (NoSuitableCollateral fee percentage colVal) =
     prettyItemize
       opts
       "No suitable collateral"
@@ -90,6 +84,11 @@ instance PrettyCooked MockChainError where
         "Percentage in params was" <+> prettyCookedOpt opts percentage,
         "Resulting minimal collateral value was" <+> prettyCookedOpt opts colVal
       ]
+
+instance PrettyCooked MockChainError where
+  prettyCookedOpt opts (MCEValidationError plutusPhase plutusError) =
+    PP.vsep ["Validation error " <+> prettyCookedOpt opts plutusPhase, PP.indent 2 (prettyCookedOpt opts plutusError)]
+  prettyCookedOpt opts (MCEBalancingError err) = prettyCookedOpt opts err
   prettyCookedOpt _ (MCEToCardanoError cardanoError) =
     "Transaction generation error:" <+> PP.pretty cardanoError
   prettyCookedOpt opts (MCEUnknownOutRef txOutRef) = "Unknown transaction output ref:" <+> prettyCookedOpt opts txOutRef
diff --git a/tests/Spec/Balancing.hs b/tests/Spec/Balancing.hs
index af43ad79f..cba4150a0 100644
--- a/tests/Spec/Balancing.hs
+++ b/tests/Spec/Balancing.hs
@@ -92,7 +92,7 @@ testingBalancingTemplate toBobValue toAliceValue spendSearch balanceSearch colla
                   },
             txSkelSignatories = txSkelSignatoriesFromList [alice]
           }
-  (skel', fee, mCols) <- balanceTxSkel skel
+  ExtendedTxSkel skel' fee mCols _ <- balanceTxSkel skel
   validateTxSkel_ skel
   nonOnlyValueUtxos <- aliceNonOnlyValueUtxos
   return (skel, skel', fee, mCols, nonOnlyValueUtxos)
@@ -161,8 +161,8 @@ balanceReduceFee = do
           { txSkelOuts = [bob `receives` Value (Script.ada 50)],
             txSkelSignatories = txSkelSignatoriesFromList [alice]
           }
-  (skelBalanced, feeBalanced, mCols) <- balanceTxSkel skelAutoFee
-  feeBalanced' <- estimateTxSkelFee skelBalanced feeBalanced mCols
+  ExtendedTxSkel skelBalanced feeBalanced mCols _ <- balanceTxSkel skelAutoFee
+  (_, feeBalanced') <- estimateTxSkelFee skelBalanced feeBalanced mCols
   let skelManualFee =
         skelAutoFee
           { txSkelOpts =
@@ -170,8 +170,8 @@ balanceReduceFee = do
                 { txSkelOptFeePolicy = ManualFee (feeBalanced - 1)
                 }
           }
-  (skelBalancedManual, feeBalancedManual, mColsManual) <- balanceTxSkel skelManualFee
-  feeBalancedManual' <- estimateTxSkelFee skelBalancedManual feeBalancedManual mColsManual
+  ExtendedTxSkel skelBalancedManual feeBalancedManual mColsManual _ <- balanceTxSkel skelManualFee
+  (_, feeBalancedManual') <- estimateTxSkelFee skelBalancedManual feeBalancedManual mColsManual
   return (feeBalanced, feeBalanced', feeBalancedManual, feeBalancedManual')
 
 reachingMagic :: FullMockChain ()
@@ -213,11 +213,12 @@ testBalancingSucceedsWith msg props run =
       `withResultProp` \res -> testConjoin (($ res) <$> props)
 
 failsAtBalancingWith :: Api.Value -> Wallet -> MockChainError -> Assertion
-failsAtBalancingWith val' wal' (MCEUnbalanceable wal val) = testBool $ val' == val && Script.toPubKeyHash wal' == Script.toPubKeyHash wal
+failsAtBalancingWith val' wal' (MCEBalancingError (NotEnoughFund wal val)) = testBool $ val' == val && Script.toPubKeyHash wal' == Script.toPubKeyHash wal
 failsAtBalancingWith _ _ _ = testBool False
 
 failsAtBalancing :: MockChainError -> Assertion
-failsAtBalancing MCEUnbalanceable {} = testBool True
+failsAtBalancing (MCEBalancingError (NotEnoughFund {})) = testBool True
+failsAtBalancing (MCEBalancingError (NotEnoughFundForExtraMinAda {})) = testBool True
 failsAtBalancing _ = testBool False
 
 failsWithTooLittleFee :: MockChainError -> Assertion
@@ -233,15 +234,15 @@ failsWithEmptyTxIns (MCEValidationError Ledger.Phase1 (Ledger.CardanoLedgerValid
 failsWithEmptyTxIns _ = testBool False
 
 failsAtCollateralsWith :: Integer -> MockChainError -> Assertion
-failsAtCollateralsWith fee' (MCENoSuitableCollateral fee percentage val) = testBool $ fee == fee' && val == Script.lovelace (1 + (fee * percentage) `div` 100)
+failsAtCollateralsWith fee' (MCEBalancingError (NoSuitableCollateral fee percentage val)) = testBool $ fee == fee' && val == Script.lovelace (1 + (fee * percentage) `div` 100)
 failsAtCollateralsWith _ _ = testBool False
 
 failsAtCollaterals :: MockChainError -> Assertion
-failsAtCollaterals MCENoSuitableCollateral {} = testBool True
+failsAtCollaterals (MCEBalancingError (NoSuitableCollateral {})) = testBool True
 failsAtCollaterals _ = testBool False
 
 failsLackOfCollateralWallet :: MockChainError -> Assertion
-failsLackOfCollateralWallet MCEMissingBalancingUser = testBool True
+failsLackOfCollateralWallet (MCEBalancingError MissingBalancingUser) = testBool True
 failsLackOfCollateralWallet _ = testBool False
 
 testBalancingFailsWith :: (Show a) => String -> (MockChainError -> Assertion) -> FullMockChain a -> TestTree

From 3cf7932795244bc3aac9a9ea4e279343f9de03c5 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Wed, 18 Feb 2026 22:41:45 +0100
Subject: [PATCH 80/96] simplifying main balancing function

---
 src/Cooked/MockChain/Balancing.hs | 87 ++++++++++++-------------------
 1 file changed, 34 insertions(+), 53 deletions(-)

diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 514794541..905a1e479 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -179,64 +179,45 @@ computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals ske
   let fee = (minFee + maxFee) `div` 2
   -- The fee interval is non-empty. We attempt to balance around its central
   -- point, and handle possible failures.
-  attemptedBalancing <- catch
-    (Just <$> attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel)
+  catch
+    ( do
+        newSkel <- computeBalancedTxSkel balancingUser balancingUtxos skel fee
+        mCols <- collateralsFromFee fee mCollaterals
+        (newFee, body) <- estimateTxSkelFee newSkel fee mCols
+        if
+          -- The skeleton was balanceable, we cannot try smaller fee, but
+          -- the used fee is sufficient for the generated body
+          | minFee == maxFee && newFee <= fee -> return $ ExtendedTxSkel newSkel newFee mCols body
+          -- The skeleton was balanceable, we cannot try smaller fee, but
+          -- the used fee is insufficient for the generated body
+          | minFee == maxFee -> throw $ MCEBalancingError $ NotEnoughFundForProperFee balancingUser
+          -- Current fee is insufficient, we look on the right (strictly)
+          | newFee > fee -> computeFeeAndBalance balancingUser (fee + 1) maxFee balancingUtxos mCollaterals skel
+          -- Current fee is sufficient, but the set of balancing utxos cannot
+          -- necessarily account for less fee, since it was (magically) exactly enough
+          -- to compensate for the missing value. Reducing the fee would ruin this
+          -- perfect balancing and force an output to be created at the balancing user
+          -- address, thus we cannot assume the actual estimated fee can be accounted
+          -- for with the current set of balancing utxos and cannot speed up search.
+          | txSkelValueInOutputs newSkel == txSkelValueInOutputs skel -> computeFeeAndBalance balancingUser minFee fee balancingUtxos mCollaterals skel
+          -- Current fee is sufficient, and the set of utxo could account for
+          -- less fee by feeding into whatever output already goes back to the
+          -- balancing user. We can speed up search, because the current
+          -- attempted skeleton could necessarily account for the estimated
+          -- fee of the input skeleton.
+          | otherwise -> computeFeeAndBalance balancingUser minFee newFee balancingUtxos mCollaterals skel
+    )
     $ \case
       -- If it fails, and the remaining fee interval is not reduced to the
       -- current fee attempt, we return `Nothing` which signifies that we
       -- need to keep searching. Otherwise, the whole balancing process
       -- fails and we spread the error.
-      MCEBalancingError {} | fee > minFee -> return Nothing
+      MCEBalancingError {}
+        | fee > minFee ->
+            -- The skeleton was not balanceable, we try strictly smaller fee
+            computeFeeAndBalance balancingUser minFee (fee - 1) balancingUtxos mCollaterals skel
       err -> throw err
 
-  case attemptedBalancing of
-    -- The skeleton was not balanceable, we try strictly smaller fee
-    Nothing -> computeFeeAndBalance balancingUser minFee (fee - 1) balancingUtxos mCollaterals skel
-    -- The skeleton was balanceable, we cannot try smaller fee, and
-    -- the used fee is sufficient for the generated body. All good!
-    Just extendedTxSkel | minFee == maxFee, eFee extendedTxSkel <= fee -> return extendedTxSkel
-    -- The skeleton was balanceable, we cannot try smaller fee, but
-    -- the used fee is insufficient for the generated body
-    Just _ | minFee == maxFee -> throw $ MCEBalancingError $ NotEnoughFundForProperFee balancingUser
-    -- Current fee is insufficient, we look on the right (strictly)
-    Just extendedTxSkel
-      | eFee extendedTxSkel > fee ->
-          computeFeeAndBalance balancingUser (fee + 1) maxFee balancingUtxos mCollaterals skel
-    -- Current fee is sufficient, but the set of balancing utxos cannot
-    -- necessarily account for less fee, since it was (magically) exactly enough
-    -- to compensate for the missing value. Reducing the fee would ruin this
-    -- perfect balancing and force an output to be created at the balancing user
-    -- address, thus we cannot assume the actual estimated fee can be accounted
-    -- for with the current set of balancing utxos and cannot speed up search.
-    Just extendedSkel
-      | txSkelValueInOutputs (eSkel extendedSkel) == txSkelValueInOutputs skel ->
-          computeFeeAndBalance balancingUser minFee fee balancingUtxos mCollaterals skel
-    -- Current fee is sufficient, and the set of utxo could account for
-    -- less fee by feeding into whatever output already goes back to the
-    -- balancing user. We can speed up search, because the current
-    -- attempted skeleton could necessarily account for the estimated
-    -- fee of the input skeleton.
-    Just extendedSkel ->
-      computeFeeAndBalance balancingUser minFee (eFee extendedSkel) balancingUtxos mCollaterals skel
-
--- | Helper function to group the three real steps of the balancing: balance a
--- skeleton around a given fee, compute the associated collateral inputs, and
--- compute the new fee from those elements. It the process, also returns the
--- generated body for the new skeleton.
-attemptBalancingAndCollaterals ::
-  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
-  Peer ->
-  Utxos ->
-  Fee ->
-  Maybe (CollateralIns, Peer) ->
-  TxSkel ->
-  Sem effs ExtendedTxSkel
-attemptBalancingAndCollaterals balancingUser balancingUtxos fee mCollaterals skel = do
-  newSkel <- computeBalancedTxSkel balancingUser balancingUtxos skel fee
-  mCols <- collateralsFromFee fee mCollaterals
-  (body, newFee) <- estimateTxSkelFee newSkel fee mCols
-  return $ ExtendedTxSkel newSkel newFee mCols body
-
 -- | This selects a subset of suitable collateral inputs from a given set while
 -- accounting for the ratio to respect between fees and total collaterals, the
 -- min ada requirements in the associated return collateral and the maximum
@@ -416,7 +397,7 @@ estimateTxSkelFee ::
   TxSkel ->
   Fee ->
   Maybe Collaterals ->
-  Sem effs (Body, Fee)
+  Sem effs (Fee, Body)
 estimateTxSkelFee skel fee mCollaterals = do
   -- We retrieve the necessary data to generate the transaction body
   params <- Emulator.pEmulatorPParams <$> getParams
@@ -429,7 +410,7 @@ estimateTxSkelFee skel fee mCollaterals = do
   -- We compute the estimated fee
   let Cardano.Coin newFee = Cardano.calculateMinTxFee Cardano.ShelleyBasedEraConway params index txBody nbOfSignatories
   -- We return both the new fee and generated body
-  return (txBody, newFee)
+  return (newFee, txBody)
 
 -- | This creates a balanced skeleton from a given skeleton and fee. In other
 -- words, this ensures that the following equation holds: input value + minted

From aa0ea3b8c754c7cf304ac4e85b076da63e7e6ae8 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 19 Feb 2026 11:21:59 +0100
Subject: [PATCH 81/96] fixing optimization bug

---
 src/Cooked/MockChain/Balancing.hs | 22 ++++++++++------------
 tests/Spec/Balancing.hs           |  4 ++--
 2 files changed, 12 insertions(+), 14 deletions(-)

diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 905a1e479..33534aa61 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -54,10 +54,10 @@ data ExtendedTxSkel = ExtendedTxSkel
     eSkel :: TxSkel,
     -- | The fee associated with this skeleton
     eFee :: Fee,
-    -- | The optional collateras associated with this skeleton
+    -- | The optional collaterals associated with this skeleton
     eMCollaterals :: Maybe Collaterals,
     -- | The Cardano body generated from this skeleton
-    eMBody :: Body
+    eBody :: Body
   }
 
 -- | This is the main entry point of our balancing mechanism. This function
@@ -192,7 +192,7 @@ computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals ske
           -- the used fee is insufficient for the generated body
           | minFee == maxFee -> throw $ MCEBalancingError $ NotEnoughFundForProperFee balancingUser
           -- Current fee is insufficient, we look on the right (strictly)
-          | newFee > fee -> computeFeeAndBalance balancingUser (fee + 1) maxFee balancingUtxos mCollaterals skel
+          | newFee > fee -> computeFeeAndBalance balancingUser newFee maxFee balancingUtxos mCollaterals skel
           -- Current fee is sufficient, but the set of balancing utxos cannot
           -- necessarily account for less fee, since it was (magically) exactly enough
           -- to compensate for the missing value. Reducing the fee would ruin this
@@ -209,13 +209,11 @@ computeFeeAndBalance balancingUser minFee maxFee balancingUtxos mCollaterals ske
     )
     $ \case
       -- If it fails, and the remaining fee interval is not reduced to the
-      -- current fee attempt, we return `Nothing` which signifies that we
-      -- need to keep searching. Otherwise, the whole balancing process
-      -- fails and we spread the error.
-      MCEBalancingError {}
-        | fee > minFee ->
-            -- The skeleton was not balanceable, we try strictly smaller fee
-            computeFeeAndBalance balancingUser minFee (fee - 1) balancingUtxos mCollaterals skel
+      -- current fee attempt, we can still hope for a solution by trying with
+      -- smaller fee.
+      MCEBalancingError {} | fee > minFee -> computeFeeAndBalance balancingUser minFee (fee - 1) balancingUtxos mCollaterals skel
+      -- Otherwise, the whole balancing process fails and we spread the error:
+      -- the skeleton was not balanceable.
       err -> throw err
 
 -- | This selects a subset of suitable collateral inputs from a given set while
@@ -462,8 +460,8 @@ computeBalancedTxSkel balancingUser balancingUtxos txSkel@TxSkel {..} (Script.lo
               Left (over txSkelOutValueL (<> missingRight) txSkelOut)
         _ | missingRight == mempty -> Right balancingUser
         _ -> Left (balancingUser `receives` Value missingRight)
-  -- We call the main actual balancing algorithm to fetch missing piece, and
-  -- retrieve the possible solution, which might not exist.
+  -- We call the main actual balancing algorithm to fetch missing pieces, and
+  -- retrieve the possible solution
   let maxNbOfBalancingUtxos = fromMaybe (toInteger $ length balancingUtxos) (txSkelOptMaxNbOfBalancingUtxos txSkelOpts)
   solution <- reachValue balancingUtxos missingLeft maxNbOfBalancingUtxos surplusOutputOrUser
   -- Based on the solution, we compute extra inputs and the new output
diff --git a/tests/Spec/Balancing.hs b/tests/Spec/Balancing.hs
index cba4150a0..dce04b4e1 100644
--- a/tests/Spec/Balancing.hs
+++ b/tests/Spec/Balancing.hs
@@ -162,7 +162,7 @@ balanceReduceFee = do
             txSkelSignatories = txSkelSignatoriesFromList [alice]
           }
   ExtendedTxSkel skelBalanced feeBalanced mCols _ <- balanceTxSkel skelAutoFee
-  (_, feeBalanced') <- estimateTxSkelFee skelBalanced feeBalanced mCols
+  (feeBalanced', _) <- estimateTxSkelFee skelBalanced feeBalanced mCols
   let skelManualFee =
         skelAutoFee
           { txSkelOpts =
@@ -171,7 +171,7 @@ balanceReduceFee = do
                 }
           }
   ExtendedTxSkel skelBalancedManual feeBalancedManual mColsManual _ <- balanceTxSkel skelManualFee
-  (_, feeBalancedManual') <- estimateTxSkelFee skelBalancedManual feeBalancedManual mColsManual
+  (feeBalancedManual', _) <- estimateTxSkelFee skelBalancedManual feeBalancedManual mColsManual
   return (feeBalanced, feeBalanced', feeBalancedManual, feeBalancedManual')
 
 reachingMagic :: FullMockChain ()

From 76c1467c7937fbe662da284d45706fc22a2e1689 Mon Sep 17 00:00:00 2001
From: Mathieu Montin <mathieu.montin@moduscreate.com>
Date: Mon, 19 Jan 2026 16:46:57 +0100
Subject: [PATCH 82/96] cherry-picking-v8-release

---
 CHANGELOG.md            | Bin 36610 -> 36609 bytes
 README.md               | 219 ++++++++++++++++++++++++++++------------
 cooked-validators.cabal |   2 +-
 package.yaml            |   2 +-
 4 files changed, 156 insertions(+), 67 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index cb5ad7308e15e962c0f6bbd0b308085a6fe0c62c..665bd3faaa5ab5e443d77849948a61edd8684df8 100644
GIT binary patch
delta 14
VcmZpg$J98FX@d{rW?#mwy#Og#1%v<q

delta 16
XcmZpi$J8{BX@d_VBg1AN#;v^oFWLo!

diff --git a/README.md b/README.md
index 8d861363b..c11a57508 100644
--- a/README.md
+++ b/README.md
@@ -1,46 +1,58 @@
 # [Cooked Validators](https://github.com/tweag/cooked-validators/)
 
-Copyright Tweag I/O 2025
-
-`cooked-validators` is a Haskell library to conveniently and efficiently write
-off-chain code for Cardano smart contracts. This offchain code will be
-specifically geared to testing and auditing the smart contract in question with
-further builtin capabilities of the library.
-
-In particular, `cooked-validators` allows the user to:
-- interact with smart contracts written in Plutus or any other language that
-  compiles to [UPLC](https://plutonomicon.github.io/plutonomicon/uplc), like for
-  example [Plutarch](https://github.com/Plutonomicon/plutarch-plutus) or
-  [Aiken](https://aiken-lang.org/), by loading contracts from byte strings
-- define transactions in a high level, type-retaining data structure
-- submit transactions for validation, while automatically taking care of missing
-  inputs and outputs, balancing, minimum-Ada constraints, collaterals and fees
-- construct sequences of transactions in an easy-to-understand abstraction of
-  "the blockchain", which can be instantiated to different actual
-  implementations
-- run sequences of transactions in a simulated blockchain
-- apply "tweaks" to transactions right before submitting them, where "tweaks"
-  are modifications that are aware of the current state of the simulated
-  blockchain
-- compose and deploy tweaks with flexible idioms inspired by linear temporal
-  logic, in order to turn one sequence of transactions into many sequences that
-  might be useful test cases, generalized in
-  [Graft](https://github.com/tweag/graft)
-- deploy automated attacks over existing sequences of transactions, such as
-  datum hijacking or double satisfaction attacks, in an attempt to uncover
-  vulnerabilities
-
-You are free to copy, modify, and distribute `cooked-validators` under the terms
-of the MIT license. We provide `cooked-validators` as a research prototype under
-active development, and it comes _as is_ with no guarantees whatsoever. Check
-the [license](LICENSE) for details.
+Copyright Tweag I/O 2026
+
+`cooked-validators` is a Haskell library for writing reliable, concise, and
+expressive off-chain code for Cardano smart contracts, with a primary focus on
+testing, auditing, and behavioral exploration.
+
+It allows you to describe transactions at a high level (via what we call
+transaction skeletons) and automatically turn them into complete, valid
+transactions by handling all mechanical aspects such UTxO selection, balancing,
+minimum-Ada constraints, collaterals or fees.
+
+The library is designed to:
+- drastically reduce off-chain boilerplate,
+- make test scenarios more readable and maintainable,
+- facilitate adversarial testing and vulnerability discovery.
+
+Importantly, `cooked-validators` is non-opinionated: everything it automates can
+also be done manually if needed, allowing users to retain full control over
+transaction construction when desired.
+
+## Core features
+
+With `cooked-validators`, you can:
+- Interact with smart contracts written in Plutus or any language that compiles
+to [UPLC](https://plutonomicon.github.io/plutonomicon/uplc), such as
+[Plutarch](https://github.com/Plutonomicon/plutarch-plutus) or
+[Aiken](https://aiken-lang.org/), by loading contracts from bytestrings.
+- Define transactions using a high-level, type-preserving data structure.
+- Submit transactions for validation while the library automatically:
+    * fills in missing inputs and outputs,
+    * performs balancing,
+    * enforces minimum-Ada constraints,
+    * computes and attaches optimal collaterals and fees,
+	* automatically adds script witnesses, including from reference inputs.
+- Construct sequences of transactions in a clear, implementation-independent
+  abstraction of the blockchain.
+- Run transaction sequences in an emulated blockchain.
+- Define modifications aware of the current blockchain state (tweaks), and apply
+  them to transactions just before submission.
+- Compose and deploy tweaks on sequences of transactions using idioms inspired
+  by linear temporal logic.
+- Deploy automated attacks on existing transaction sequences, such as datum
+  hijacking or double satisfaction attacks, to uncover vulnerabilities.
+- Express expected outcomes on the result of running a trace in a precise and
+  declarative way, for example by:
+    * specifying the expected number of outcomes in case branching occurred,
+    * asserting exact error messages in case of failure,
+	* ensuring a specific event was triggered during the run,
+    * checking that some specific assets are present at a given address in the
+      final blockchain state.
 
 ## How to integrate `cooked-validators` in a project
 
-To use `cooked-validators`, you need
-- [GHC](https://www.haskell.org/ghc/download_ghc_9_6_6.html) version 9.6.6
-- [Cabal](https://www.haskell.org/cabal) version 3.10 or later
-
 1. `cooked-validators` depends on
 [cardano-haskell-packages](https://github.com/input-output-hk/cardano-haskell-packages)
 to get cardano-related packages and on
@@ -59,40 +71,84 @@ the `packages` stanza.
      subdir:
        .
    ```
-   where `myTag` is either a commit hash in the repo, or a tag, such as v7.0.0
+   where `myTag` is either a commit hash in the repo, or a tag, such as v8.0.0
    (see [available
    releases](https://github.com/tweag/cooked-validators/releases)).
 
+3. Each release of `cooked-validators` is pinned to a specific version of
+   [`cardano-api`](https://github.com/IntersectMBO/cardano-api) which in turn
+   pins the versions of all other Cardano-related dependencies (including
+   Plutus). Make sure your project relies on the same version.
+
 ## Example
    
-1. Make your project
-   [depend](https://cabal.readthedocs.io/en/stable/getting-started.html#adding-dependencies)
-   on `cooked-validators` and `plutus-script-utils`
-   
-2. Enter a Cabal read-eval-print-loop (with `cabal repl`)
-   and create and validate a transaction which transfers 10 Ada
-   from wallet 1 to wallet 2:
-   ```haskell
+This example shows how to create and validate a simple transaction that
+transfers 10 Ada from wallet 1 to wallet 2, without manually handling fees or
+balancing.
+
+1. Enter a Cabal read-eval-print-loop (with `cabal repl`)
+
+2. Import your required dependencies
+   ``` haskell
    > import Cooked
    > import qualified Plutus.Script.Utils.Value as Script
-   > printCooked . runMockChain . validateTxSkel $
-         txSkelTemplate
-           { txSkelOuts = [wallet 2 `receives` Value (Script.ada 10)],
-             txSkelSigners = [wallet 1]
-           }
-   [...]
-   - UTxO state:
-     • pubkey wallet 1
-       - Lovelace: 89_828_471
-       - (×4) Lovelace: 100_000_000
-     • pubkey wallet 2
-       - Lovelace: 10_000_000
-       - (×5) Lovelace: 100_000_000
-     • pubkey wallet 3
-       - (×5) Lovelace: 100_000_000
-     • pubkey wallet 4
-       - (×5) Lovelace: 100_000_000
-   [...]
+   ```
+
+3. Define a transaction which transfers 10 Ada from wallet 1 to wallet 2
+   ``` haskell
+   let myTransaction = txSkelTemplate {txSkelOuts = [wallet 2 `receives` Value (Script.ada 10)], txSkelSignatories = txSkelSignatoriesFromList [wallet 1]}
+   ```
+
+4. Send the transaction for validation, and request the printing of the run
+   ``` haskell
+   printCooked . runMockChain . validateTxSkel_ $ myTransaction 
+   ```
+
+5. Observe the log of the run, including:
+    - The original skeleton, and its balanced counterpart
+	- The associated fee and collaterals
+	- The final mockchain state, with every wallet's assets (notice the 10 ADA
+      payment owned by wallet 2)
+	- The value returned by the run (here `()` as we used `validateTxSkel_`)
+   ```haskell
+   📖 MockChain run log:
+	 ⁍ New raw skeleton submitted to the adjustment pipeline:
+	   - Validity interval: (-∞ , +∞)
+	   - Signatories:
+		 - wallet 1 [balancing]
+	   - Outputs:
+		 - Pays to pubkey wallet 2
+		   - Lovelace: 10_000_000
+	 ⁍ New adjusted skeleton submitted for validation:
+	   - Validity interval: (-∞ , +∞)
+	   - Signatories:
+		 - wallet 1 [balancing]
+	   - Inputs:
+		 - Spends #4480b35!3 from pubkey wallet 1
+		   - Redeemer ()
+		   - Lovelace: 100_000_000
+	   - Outputs:
+		 - Pays to pubkey wallet 2
+		   - Lovelace: 10_000_000
+		 - Pays to pubkey wallet 1
+		   - Lovelace: 89_828_383
+	   - Fee: Lovelace: 171_617
+	   - No collateral required
+	 ⁍ New transaction successfully validated:
+	   - Transaction id: #c095342
+	   - Number of new outputs: 2
+   ✅ UTxO state:
+	 • pubkey wallet 1
+	   - Lovelace: 89_828_383
+	   - (×3) Lovelace: 100_000_000
+	 • pubkey wallet 2
+	   - Lovelace: 10_000_000
+	   - (×4) Lovelace: 100_000_000
+	 • pubkey wallet 3
+	   - (×4) Lovelace: 100_000_000
+	 • pubkey wallet 4
+	   - (×4) Lovelace: 100_000_000
+   🟢 Returned value: () 
    ```
 
 ## Documentation
@@ -115,6 +171,32 @@ the `packages` stanza.
 - The [OPTICS](doc/OPTICS.md) file describes our usage of optics to navigate our
   data structures.
 
+## Blog posts
+
+Several blog posts have been written about `cooked-validators`. As the library
+evolves, some code snippets in these posts may have become outdated. However,
+the core philosophy remains unchanged, and these articles still provide valuable
+insight into how to use the library.
+
+1. [An article](https://www.tweag.io/blog/2023-05-11-audit-smart-contract/)
+   explaining how we use `cooked-validators` to conduct smart contract audits.
+   
+2. [An
+   article](https://www.tweag.io/blog/2025-02-20-transaction-generation-automation-with-cooked-validators/)
+   describing how transaction skeletons are built in `cooked-validators` and how
+   the library constructs complete transactions from them.
+
+3. [An
+   article](https://www.tweag.io/blog/2022-01-26-property-based-testing-of-monadic-code/)
+   presenting the original idea of using temporal modalities to modify sequences
+   of transactions.
+
+
+4. [An article](https://www.tweag.io/blog/2022-10-14-ltl-attacks/) explaining
+   how [linear temporal
+   logic](https://en.wikipedia.org/wiki/Linear_temporal_logic) is used in
+   `cooked-validators` to deploy modifications over time.
+
 ## Additional resources
 
 - We have a [repository](https://github.com/tweag/cooked-smart-contracts) of
@@ -135,3 +217,10 @@ the `packages` stanza.
 - `cooked-validators` comes with a [template
   repository](https://github.com/tweag/cooked-template) which can be used to
   develop offchain code and/or audit code with the tool.
+
+## License
+
+You are free to copy, modify, and distribute `cooked-validators` under the terms
+of the MIT license. We provide `cooked-validators` as a research prototype under
+active development, and it comes _as is_ with no guarantees whatsoever. Check
+the [license](LICENSE) for details.
diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index a72a511ba..f9e989702 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -5,7 +5,7 @@ cabal-version: 3.4
 -- see: https://github.com/sol/hpack
 
 name:           cooked-validators
-version:        7.0.0
+version:        8.0.0
 license:        MIT
 license-file:   LICENSE
 build-type:     Simple
diff --git a/package.yaml b/package.yaml
index 281bba37c..d89d3f69d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -2,7 +2,7 @@ verbatim:
   cabal-version: 3.4
 
 name: cooked-validators
-version: 7.0.0
+version: 8.0.0
 
 dependencies:
   - QuickCheck

From c5c0abaff08856c98f66e9fc98342ab70060d1ac Mon Sep 17 00:00:00 2001
From: Mathieu Montin <mathieu.montin@moduscreate.com>
Date: Mon, 16 Feb 2026 12:08:23 +0100
Subject: [PATCH 83/96] cherry-picking-cne-chap-update

---
 cabal.project | 13 ++-----------
 1 file changed, 2 insertions(+), 11 deletions(-)

diff --git a/cabal.project b/cabal.project
index 96f8dcdd0..cad3e0369 100644
--- a/cabal.project
+++ b/cabal.project
@@ -17,7 +17,7 @@ repository cardano-haskell-packages
 
 index-state:
   , hackage.haskell.org 2025-11-05T09:40:54Z
-  , cardano-haskell-packages 2025-12-16T19:03:49Z
+  , cardano-haskell-packages 2026-02-13T00:00:02Z
   
 -- We never, ever, want this.
 write-ghc-environment-files: never
@@ -47,15 +47,6 @@ package cardano-crypto-praos
   
 constraints:
   , cardano-api == 10.18.1.0
-  , plutus-ledger-api == 1.45.0.0
+  , cardano-node-emulator == 1.4.1.0  
   , polysemy == 1.9.2.0
   , polysemy-plugin == 0.4.5.3
-
-source-repository-package
-    type: git
-    location: https://github.com/intersectMBO/cardano-node-emulator
-    tag: c6e2071bfe1004de2e2ebb9875b5b3b049405a9c
-    subdir:
-      plutus-script-utils
-      plutus-ledger
-      cardano-node-emulator

From 60273286f3c0ab29bc6d24dbc19b16373b20bc41 Mon Sep 17 00:00:00 2001
From: Mathieu Montin <mathieu.montin@moduscreate.com>
Date: Mon, 16 Feb 2026 20:19:44 +0100
Subject: [PATCH 84/96] Create CODEOWNERS (#517)

---
 CODEOWNERS | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100644 CODEOWNERS

diff --git a/CODEOWNERS b/CODEOWNERS
new file mode 100644
index 000000000..eba289f1f
--- /dev/null
+++ b/CODEOWNERS
@@ -0,0 +1,5 @@
+# Repository owner   Tweag's High Assurance Software Group
+*                    @tweag/high-assurance-software-group
+
+# Developer          Mathieu
+*                    @mmontin

From f7fbd4d3e513deff577289cb432f9a83ca9438e6 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 19 Feb 2026 16:36:55 +0100
Subject: [PATCH 85/96] reverting changelog

---
 CHANGELOG.md | 670 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 670 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index e69de29bb..7e4b73540 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -0,0 +1,670 @@
+# Changelog
+
+## Unreleased
+
+### Added
+- New `LtlNot` primtive, to negate `Ltl` expressions. This allows to ensure a
+  specific tweak will result in `mzero` and marks a new milestone in the
+  expressiveness of the Tweak/Attack DSL.
+- New `Ltl` combinators resulting from the addition of `LtlNot`, such as
+  `nowhere`, `whenAble`, ...
+
+### Removed
+
+### Changed
+
+- The datum hijacking attack has been updated: all the sub-tweaks directly set
+  the new outputs, and they all return only the modified outputs.
+- The module Ltl.Combinators has been integrated to Ltl. The combinators have
+  been enriched and renamed to better match the rest of the Ltl API.
+
+### Fixed
+
+## [[8.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v8.0.0) - 2026-01-19
+
+### Added
+
+- `viewByRef` and `previewByRef` which call `txSkelOutByRef` and apply a getter
+  and an affine fold on it, respectively.
+- Optics working on values in `Cooked.Skeleton.Output`
+- Missing instance of `IsTxSkelOutAllowedOwner` for `Versioned Script`
+- A new documentation file around optics, in `doc/OPTICS.md`
+- New `forceOutputs` primitives to force the creation of new utxos from a list
+  of `TxSkel`. Initial distributions are now handled using this primitive.
+- Added `somewhere'`, `everywhere'` and `there'` which accept arbitrary `Ltl`
+  expressions. 
+- Added `labelled[T][']` tweaks, to apply a tweak to transactions with a
+  specific label.
+- Added `label` and as `IsString` instance for `TxSkelLabel` to make adding 
+  labels easier.
+- Added `Cooked.Ltl.Combinators` with `anyOf[']` and `allOf[']` helpers to 
+  make combining multiple `Ltl` expressions together simpler.
+- `delay[']` delays an Ltl formula by n timestamps. 
+- `there`, `everywhere` and `somewhere` is now implemented
+  in terms of `Cooked.Ltl.Combinators`.
+- Module `Cooked.MockChain.AutoFilling` to gather all automated filling of
+  skeleton parts performed during pre-validation phase. This include the new
+  automated assignment of withdrawn amounts, and automated assignment of
+  constitution script.
+- Log events `MCLogAutoFilledConstitution` and `MCLogAutoFilledWithdrawalAmount`
+  to log the respective auto filling occurrences.
+- Handling certificates
+- A notion of `User`, now used widely in the library, in module
+  `Cooked.Skeleton.User`, alongside relevant type families around the type, in
+  module `Cooked.Skeleton.Families`.
+- Aliases for fees (`Fee`), collaterals (`CollateralIns`, `Collaterals`) and
+  list of utxos (`Utxos`).
+- `TxSkelSignatory` in module `Cooked.Skeleton.Signatory`. Signatories are no
+  longer forced to expose a private key, in which case they will be in required
+  signer, but will not sign the transaction. This opens up the possibility to
+  delay signatures.
+- Primitive `getCurrentReward` to retrieve the current rewards of a staking
+  credential, which will always be 0 at this point.
+- Functions to fetch, from the protocol parameters, the current deposits values
+  (`dRepDeposit`, `stakeAddressDeposit` and `stakePoolDeposit`).
+- Function `txSkelDepositedValueInCertificates` to fetch the total value
+  deposited in certificates (which can be negative in case of deregistration).
+- Anchors have their own builtin depiction and generation function.
+- `txSkelMintsPolicyTokensL` to focus on the submap of a specific currency
+  symbol within a `TxSkelMints`.
+- Module `Cooked.Skeleton.Value` which exposes useful optics around values.
+- New function `txSkelCertifyingScripts` collecting all certifying script from a
+  skeleton.
+- Balancing will now automatically attach an input utxo when there are not and
+  the balancing is in favour of the output, to avoid sending transaction with no
+  inputs.
+  
+### Removed
+
+- Module `Cooked.Skeleton.Value`. `TxSkelOutValue` no longer exists and has been
+  replaced by two fields for `TxSkelOut`, `txSkelOutValue` and
+  `txSkelOutValueAutoAdjust`.
+- `unsafeTxOutByRef` which is now the default behavior for `txOutByRef`
+- Dedicated lookup functions for part of `TxSkelOut` such as
+  `typedDatumFromTxOutRef` as they have been replaced by `viewByRef` or
+  `previewByRef`.
+- `DatumContent`. In a `TxSkelOutDatum` the datum is now stored as is, and a new
+  type, `UtxoPayloadDatum` is used to store datum in utxo payloads.
+- Module `Cooked.Attack.DupToken`, now regrouped with `Cooked.Attack.AddToken`
+- Module `Cooked.MockChain.GenerateTx`, whose content can now be found in
+  `Cooked.MockChain.GenerateTx.Body`
+- Modules `Cooked.MockChain.MinAda`, `Cooked.MockChain.AutoReferenceScript`,
+  regrouped in module `Cooked.MockChain.AutoFilling`
+- Primitive `registerStakingCred` from the `MonadBlockChain` class, no longer
+  needed thanks to the handling of certificates.
+- Module `Cooked.Skeleton.Payable`, spread across `Cooked.Skeleton.Output` and
+  `Cooked.Skeleton.Families`.
+- Module `Cooked.Skeleton.ReferenceScript`, now directly handled in
+  `Cooked.Skeleton.Output`.
+
+### Changed
+
+- `TxOpts` replaced by `TxSkelOpts` and field names changed likewise.
+- `TxLabel` replaced by `TxSkelLabel`
+- `txOutByRef` replaced by `txSkelOutByRef`. It now throws an error if the
+  output is not found and thus it returns `m TxSkelOut` instead of `m (Maybe
+  TxSkelOut)`
+- Complete overhaul of the optics within skeleton. Their names has been made
+  consistent, the missing ones have been added and they are used more
+  consistently throughout the codebase.
+- `TxSkelMints` has been improved and clarified.
+- Transaction modifications in options are now called `txSkelModTx` and is now a
+  simple unwrapped function.
+- Parameters modifications in options are now called `txSkelModParams` and is
+  now a simple unwrapped function.
+- `ToCredential` is no longer a requirement for an owner of a `TxSkelOut`,
+  instead it is derived from `IsTxSkelOutAllowedOwner`
+- Some helpers, like `txSkelOutValue` are gone, as part of the optics overhaul,
+  and are replaced by their optics counterpart, such as `view txSkelOuValueL`. 
+- `addMintTweak` replaced by `addMintsTweak` which can add multiple mint
+  constraints in one go.
+- Improved, and regrouped, token duplication and token addition attacks.
+- Fully reworked datum hijacking attacks, with a new `DatumHijackingParams` type
+  to pilot how the datum hijacking should be performed.
+- Wallets are no longer integral to cooked. They are still present but only for
+  testing purposes. They have been replaced by relevant replacements, in
+  particular `User` where applicable.
+- `txSkelSigners` has been replaced by `txSkelSignatories`, which is a list of
+  `TxSkelSignatory`. It can still be built by lists of wallets using
+  `txSkelSignatoriesFromList`. All occurrences of 'signer' in the codebase have
+  been replaced by 'signatory'.
+- `txSkelInputsValidators` renamed to `txSkelInputScripts`
+- `txSkelProposalsDeposit` renamed to `txSkelDepositedValueInProposals`
+- Functions to run a `MockChainT` have been revisited to be more flexible. A
+  type `MockChainConf` has been added to pilot the run. It contains an initial
+  state, an initial distribution of funds, and a function to apply on the raw
+  result of the run.
+- Testing functions `isInWallets` and `isInWallet` have been changed and renamed
+  to `isAtAddress` and `possesses`.
+- Full upgrade and reworking of the withdrawals. 
+- Module `Cooked` now exposes much more of the library. The idea is to hide as
+  few definitions as possible, only those that are really not meant to be used,
+  such as unsafe constructors.
+- Versions of our nix dependencies, hackage and chap index states, and Cardano
+  library have been updated. In particular, the current version of cardano-api
+  is now 10.18.1.0, the last one before Dijsktra.
+
+### Fixed
+
+## [[7.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v7.0.0) - 2025-07-08
+
+### Added
+
+- Module `Cooked.Skeleton.ReferenceScript`, exposing `ReferenceScriptConstrs`
+  (type constraints for reference scripts), `TxSkelOutReferenceScript` (type of
+  references scripts, with constructors `TxSkelOutNoReferenceScript` and
+  `TxSkelOutSomeReferenceScript`), and functions `txSkelOutTypedRefScriptAT`,
+  `txSkelOutRefScriptVersioned` and `txSkelOutRefScriptHash`.
+- New mockchain error `MCEMissingBalancingWallet` which is thrown when a
+  balancing wallet is required but cannot be found (empty signers list).
+- Function `txSkelToIndex` which builds the index of UTxOs known by a given
+  skeleton. This computation is no longer performed in `Balancing.hs` only.
+- Function `unsafeTxOutByRef` which throw an error when `txOutByRef` failed to
+  retrieve an output (it returned `Nothing`).
+- Functions `unsafeOutputDatumFromTxOutRef`, `unsafeDatumFromTxOutRef`,
+  `unsafeTypedDatumFromTxOutRef`, and `unsafeValueFromTxOutRef` which rely on
+  `unsafeTxOutByRef` under the hood.
+- Function `txSkelAllScripts` which extracts all scripts from a `TxSkel`.
+- Error `UnsupportedFeature`, which is more informative than `FailWith`. The
+  monadfail instance usage is now limited to the bare minimum.
+- Full support for constitution (proposing) scripts. This is achieved through
+  primitives `setConstitutionScript` and `getConstitutionScript`.
+- Proposal now have an option `txSkelProposalAutoConstitution` which allows the
+  current official constitution to be automatically attached to the proposal.
+- The automated attachment of constitution scripts is performed on all proposals
+  when required in function `validateTxSkel`.
+- Full support for rewarding (withdrawing) scripts. This is achieved through
+  primitive `registerStakingCred`.
+- `MinFeeRefScriptCostPerByte` has been added to possible changed parameters.
+- Function `toKeyWitness` which creates a key witness from a credential. This
+  homogenizes witness creation with the rest of the generation API.
+- Instances of `ToHash` for `BuiltinByteString`, `Datum` and `BuiltinData`.
+- New pretty printed option `pcOptPrintConsumedUTxOs` which allows to print a
+  second utxo state with consumed utxos, `False` by default.
+- Functions `txSkelWithdrawingScripts`, `txSkelProposingScripts` and
+  `txSkelMintingScripts` to collect certain kinds of scripts from a skeleton.
+- `txSkelMintVersionedScript` to retrieve the script from a mint constraint.
+- Functions `txSkelOutReferenceScriptL`, `txSkelOutStakingCredentialL`,
+  `txSkelOutReferenceScriptHash`, `txSkelOutAddress`, `txSkelOutPKHash` and
+  `txSkelOutTypedOwnerAT` to manipulate `TxSkelOut`s.
+- Functions `txSkelProposalAutoConstitutionL`, `withConstitution` and
+  `updateConsitution` to work with the constitution script of a
+  `TxSkelProposal`.
+
+### Removed
+
+- Module `Cooked.Output` and all its content.
+- Primitives `datumFromHash` and `scriptFromHash` are gone, as it is no longer
+  necessary to resolve datums and scripts, since we carry them around fully in
+  `TxSkelOut`s and don't translate it back from `TxOut`. Their associated errors
+  `MCEUnknownValidator` and `MCEUnknownDatum` are gone too.
+- Functions `resolvedDatum`, `resolvedTypedDatum`, `resolveValidator`,
+  `resolveReferenceScript` as they are no longer relevant.
+- Functions `txSkelInputUtxos`, `txSkelReferenceInputUtxos`,
+  `txSkelInputDataAsHashes` as they are no longer relevant.
+- Functions `txOutRefToTxSkelOut` and `txOutRefToTxSkelOut` as `TxSkelOut`s are
+  directly stored and no longer need to be rebuilt from `TxOut`s.
+- Function `txSkelDataInOutputs` as it is no longer relevant.
+- Functions `txSkelOutOwnerTypeP` and `txSkelOutputDatumTypeAT`.
+
+### Changed
+
+- `MockChainSt` (the type and constructor) have been renamed `MockChainState`
+  while `mockChainSt0From` has been renamed `mockChainState0From`.
+- The content of `MockChainState` has been fully updated. It now relies directly
+  on an `EmulatedLedgerState` that is automatically updated by the emulator
+  (`mcstLedgerState`); it still contains the emulator parameters (`mcstParams`);
+  it not longer contains a slot which is handled by the emulator; it now
+  contains a map from `TxOutRef` to `TxSkelOut` alongside a boolean stating if
+  this output is already consumed or not (`mcstOutputs`); and it now contains
+  the current constitution script (`mcstConstitution`).
+- The whole computation of the initial state is done through function
+  `mockChainState0From` instead of various function such as `scriptMap0From`
+  which no longer exist.
+- All occurrences of `ConcreteOutput` have been replaced by `TxSkelOut` while
+  constraints `IsTxInOutput` and `IsAbstractOutput` have been replaced by
+  dedicated constraints on outputs parts such as `OwnerConstrs`.
+- Default initial distributions have been lightened to 4 wallets and 4 utxos per
+  wallet. This provides a more concise default `UtxoState` to pretty print.
+- `UtxoState` now contains a map of available UTxO `availableUtxos` and already
+  consumed ones `consumedUtxos`. These replace `utxoState`.
+- `GenerateTxError` is replaced by native `MCEToCardanoError` as `TxBodyError`
+  can no longer occur, and `GenerateTxErrorGeneral` has been replaced either by
+  dedicated errors or by calls to `FailWith`.
+- Error `MCEUnbalanceable` no longer takes a `TxSkel` as parameter as it was
+  never used by the caller (in practice the pretty printer).
+- The return type of our direct mockchain `MockChainReturn` is no longer a
+  simple alias to a type but is now more informative. It contains the returned
+  value, the final map of `TxSkelOut` (consumed, or not), the final `UtxoState`
+  built from this map, the final log entries emitted during the run and the
+  dynamic aliases registered by the user. They are now named fields: `mcrValue`,
+  `mcrOutputs`, `mcrUtxoState`, `mcrJournal` and `mcrAliases`.
+- A mockchain run now always return a `UtxoState`, not only in case of a
+  successful run. This means that it is not possible, when conducting tests, to
+  predicate over the resulting state in case of failure. In the test API, this
+  is reflected by type `StateProp` and by function `withStateProp`.
+- `utxosAtSearch` has been replaced by `utxosOwnedBySearch` and all utxo
+  searches have be reworked to return `TxSkelOut`s and be more accessible and
+  relevant.
+- The pretty printer has been heavily improved and now directly receives all
+  outputs (consumed or not) when pretty printing a `MockChainReturn`. This means
+  that skeleton emitted in journal events can have their context recreated from
+  said `MockChainReturn`.
+- `TxSkelOutDatum`s have been heavily refactored, to split their content (now
+  called `DatumContent`) from their transaction generation options (now called
+  `DatumKind`). The module exposes a variety of new functions to extract
+  information from these new components. The `DatumContent` is now directly fed
+  to the `UtxoState` from the `MockChainReturn`.
+- `TxSkelOut` has been fully reworked, no longer relying on an abstract output,
+  but instead having dedicated types for each of its components (`tsoOwner`,
+  `tsoSCred`, `tsoDatum`, `tsoValue` and `tsoRefSc`).
+- Functions `walletPKHash` and `walletStakingCredential` have been replaced by
+  instances of `ToPubKeyHash` and `ToMaybeStakingCredential` respectively.
+- Tests for withdrawals and proposals have been updated.
+- functions `currentTime`, `awaitDurationFromLowerBound`,
+  `awaitDurationFromUpperBound` and `slotToTimeInterval` have been replaced
+  respectively by `currentMSRange`, `waitNMSFromSlotLowerBound`,
+  `waitNMSFromSlotUpperBound` and `slotToMSRange`.
+- `currentSlot` and `awaitSlot` are not longer primitives from the mockchain,
+  instead they are derived from `waitNSlots` which has become a primitive
+  itself.
+- A new mockchain error, `MCEPastSlot`, is thrown when attempting to jump back
+  in time.
+
+### Fixed
+
+- A bug where the maximum execution units from the protocol parameters (and thus
+  maximal fees) were not scaled to the number of scripts a skeleton uses.
+- An imprecision where the required number of signers for a skeleton was
+  estimated by cardano-api while it is in fact found in the skeleton itself.
+- A bug where the execution units of the scripts were not computed and fed to
+  the transaction body.
+- An imprecision where reference inputs in redeemers that also appear in inputs
+  would be kept in the reference inputs list during generation.
+
+## [[6.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v6.0.0) - 2025-05-15
+
+### Added
+
+- Module `Cooked.Pretty.Hashable` has been brought back from
+  `Cooked.Conversion.ToHash` since it has no purpose being in
+  `plutus-script-utils`.
+- It is now possible to use `TxSkelOutNoDatum` when paying to scripts, as
+  PlutusV3 allows for it. As a consequence, providing no datum in a `Payable` will
+  result in the generation of `TxSkelOutDatum ()` for scripts of version 1 or 2,
+  and in the generation of `TxSkelOutNoDatum` for scripts of version 3.
+- New `define` primitive in `MonadBlockChainBalancing` which allows to bind an
+  alias while defining a variable. This is used by the pretty printer to render
+  names that are dynamic, i.e. depend on on-chain data, like utxos.
+- The list of `MockChainLogEntry` has been integrated into a `MockChainBook`
+  which also stores the aliases exported using `define`.
+- The testing framewok now allows to predicate over the number of resulting
+  traces using new Test field `testSizeProp` and new helper `withExactSize`.
+- Support for multi-purpose scripts post CIP69 and Chang hard fork.
+- A test over multi-purpose scripts with Minting + Spending purposes.
+- Constructor `Mint` with smart constructors `mint` and `burn` to populate the
+  `TxSkelMints` field of our skeleton.
+- New helper `addHashNames` to add alias in the pretty cooked options without
+  overriding the existing default names.
+- `OwnerConstraints` and `ReferenceScriptConstraints` for output to clarify some
+  types and allow to reuse those constraints in other parts of the code, such as
+  attacks or tweaks.
+- New helper `txSkelOutReferenceScript` to retrieve the optional reference script
+  from an output.
+- New testing helpers `isInWallets` and `isInWallet` to ensure wallets have the
+  right amount of certain tokens at the end of a mockchain run. New testing
+  helpers `happened` and `didNotHappen` to test for the occurrence of a specific
+  log event.
+
+### Removed
+
+- Modules `Validators.hs` and `Currencies.hs`. Their content has been moved to
+  `plutus-script-utils` directly with some improvements and adaptations.
+- Modules `Cooked.Conversion.***` which have been integrated to
+  `plutus-script-utils`. 
+- Two helpers from `Skeleton.hs` that were only used once in `MockChain.Direct`:
+  `txSkelValidatorsInOutputs`, `txSkelReferenceScripts`
+- `walletCredential`, `walletAddress` replaced by `toCredential` and
+  `toAddress` from the classes `ToCredential` and `ToAddress`.
+- `txOptAutoReferenceScripts` replaced by local option `txSkelRedeemerAutoFill`
+  which can be turned on and off in each `TxSkelRedeemer`.
+
+### Changed
+
+- Update cardano-api to version 10.10, post Chang hard fork.
+- Datum hijacking attack now branches on each modified outputs.
+- Datum hijacking attack has a simpler interface, no longer relying on optics.
+- Datum hijacking can now redirect output to any suitable party, the type of can
+  be different from the original owner of the utxo.
+- The link to explicit typed validators, validators and minting policies has
+  been reduced, relying on conversion type classes whenever possible.
+- `TxSkelMints` is now built from a list of dedicated `Mint` constructs instead
+  of tuples. This allows to use any kind of scripts that can be seen as
+  versioned minting policies, such as multipurpose scripts.
+- The default way of building `TxSkelMints` now does not pushes for specifying
+  multiple redeemers for the same minting policy.
+- `validatorFromHash` changed to `scriptFromHash`
+- Token names can now be seen as hashables by the pretty printer and thus giving
+  a dynamic alias during mockchain runs using `define`.
+- Default hash names map in the pretty printer option have been updated.
+- The `removeLabelTweak` now fails if the label is absent from the skeleton.
+- `TxSkelRedeemer` has been improved: it directly contains a redeemer content
+  (no longer needed type `Redeemer`) and it now contains locally an option to
+  either automatically assign a reference input or not.
+- The CI now ensures the documentation is filled up properly.
+- Modules under `Pretty.Cooked` have been revamped. All pretty functions are now
+  instances of either `PrettyCooked`, `PrettyCookedList` or `PrettyCookedMaybe`
+  and are adequately placed in the `Pretty.Cooked.XXX` submodules. This offers
+  both more consistency and flexibility to define `Pretty` instances for cooked.
+- The testing framework has been slightly improved and homogenized.
+
+### Fixed
+
+- A bug where reference inputs given in the withdrawal redeemer would not be put
+  in the set of reference inputs of the generated transaction.
+- A bug where hashes were not properly displayed by pretty cooked when involving
+  leading zeros in the hexadecimal conversion of their digits.
+- Size of reference scripts is now taken into account when computing the maximal
+  possible fee for a transaction. As a consequence, our dychotomic balancing
+  mechanism now iterates within the proper fee bounds for Conway.
+- A bug where `awaitDurationFromUpperBound` would actually wait from the lower
+  bound of the slot, similarly to `awaitDurationFromLowerBound`.
+
+## [[5.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v5.0.0) - 2025-03-17
+
+### Added
+
+- `quickCurrencyPolicyV3` and `permanentCurrencyPolicyV3` which should be the
+  most commonly used.
+- All kinds of scripts can now be used as reference scripts.
+- `validateTxSkel_` which validates a skeleton and ignores the output.
+- `txSkelMintsFromList'` which only allows one redeemer per minting policy.
+- `validatorToTypedValidatorV2`
+- `walletPKHashToWallet` that retrives a wallet from a pkh. It used to be
+  present but somehow disapeared.
+- It is now possible to reference an output which has a hashed datum.
+- `txSkelHashedData` the gives all the datum hashes in inputs and reference inputs.
+- Partial support for withdrawals in txSkels. The rewarding scripts will be run
+  and assets will be transferred. However, these withdrawals are not properly
+  constrained yet.
+- PrettyCooked option `pcOptPrintLog`, which is a boolean, to turn on or off the log
+  display in the pretty printer. The default value is `True`.
+- Reference inputs with the right reference scripts are now automatically
+  attached to redeemers when such input exists. This can be turned on using
+  `txOptAutoReferenceScripts`. If disabled, the helper `withReferenceInput` can
+  be used on a redeemer to manually attach a reference input (which does not
+  necessarily have to contain the right reference script).
+- Capability to test the result of a mockchain run based on the log entries.
+- `txOutRefToTxSkelOut` helper to query the mock chain for recreating a
+  `TxSkelOut` from a `TxOutRef`. This is very useful when using `Tweaks` that
+  need to pay back an existing output with a slight modification.
+- A new tweak `modifySpendRedeemersOfTypeTweak` to apply an optional
+  modification of all redeemers of a certain type within the skeleton inputs.
+- New setters for the various outputs fields.
+- The `Payable` structure to properly define, compose, and later pay, payable
+  elements with `receive`.
+- The `receive` smart constructor for payments that allows to compose payable
+  elements (datums, values, staking credential and reference scripts) and
+  associate them to a recipient.
+- `TxSkelOutValue` which encompasses both a value and whether it can be tampered
+  with through min ada adjustment. It comes with the constructors
+  `Value` and `FixedValue` from the `Payable` type.
+
+### Removed
+
+- `positivePart` and `negativePart` in `ValueUtils.hs`. Replaced by `Api.split`.
+- Redundant logging of errors in mockchain runs.
+- Useless minting of non-ADA value in the dummy initial transaction.
+- Payment helpers (such as `PaysPK`, `withDatum` ...). Replaced by `receives`.
+- `txOptEnsureMinAda`, replaced by a field of `TxSkelOutValue`
+
+### Changed
+
+- GHC bumped to 9.6.6
+- Internal representation of redeemers have changed, and are similar for any
+  supported script purpose (minting, spending or proposing).
+- Redeemers should now be built using one of the two following smart
+  constructors: `someTxSkelRedeemer`, `emptyTxSkelRedeemer`
+- `mkProposingScript` changed to `mkScript`
+- `withDatumHashed` changed to `withUnresolvedDatumHash`
+- `paysScriptDatumHashed` changed to `paysScriptUnresolvedDatumHash`
+- `txSkelInputData` changed to `txSkelInputDataAsHashes`
+- Pretty printing of hashed datum now includes the hash (and not only the
+  resolved datum).
+- Logging has been reworked: 
+  * it is no longer limited to `StagedMockChain` runs
+  * it is now a component of `MonadBlockChainBalancing`
+  * it can be turned on/off in pretty-printing options
+  * it now displays the discarding of utxos during balancing.
+  * it now displays when the user specifies useless collateral utxos.
+  * it is not visible from outside of `cooked-validators`
+- Dependency to cardano-api bumped to 8.46.
+- The whole testing API has been revamped
+- File `AddInputsAndOutputs.hs` has been split into `Inputs.hs`, `Outputs.hs`
+  and `Mint.hs`. File `TamperDatum.hs` has been updated and integrated into
+  `Output.hs`.
+- File `Skeleton.hs` has been split into sub-files in the `Skeleton` folder.
+- Default language extensions and compilation options have been updated.
+- Transaction generation now directly lives in `MonadMockChainBalancing`.
+- Initial distributions are now handled as a first action in the `MockChain`.
+
+### Fixed
+
+- A bug where the script hashes would not be computed properly for early plutus
+  version (V1 and V2).
+- A bug where balancing would fail with excessive inputs and not enough min ada
+  in the excess.
+- Transactions that do not involve script are now properly generated without any
+- All kinds of scripts can now be used as reference scripts.
+- A bug where scripts being paid to in the initial distribution would not be
+  stored in the MockChain.
+
+## [[4.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v4.0.0) - 2024-06-28
+
+### Added
+- File [IMPORTS](doc/IMPORTS.md) to specify how modules should be imported and prefixed
+- Instaured a standard for naming imports, homogenized all modules accordingly
+- Default language extensions in package.yaml
+- A new set of tests `Cooked.BasicUsageSpec` to cover basic use cases
+- A new validate function `validateTxSkel'` that directly returns a list of utxos
+- An actual content to `hie.yaml` (automatically generated by `gen-hie`)
+- Support for collaterals in skeleton options, with three options: auto from
+  first signer, auto from given wallet, or given set of utxos.
+- Top-level comments to all modules
+- `currencySymbolFromLanguageAndMP` to get the right Currency symbol based on a
+  plutus version and a minting policy
+- `setParams` in `MonadBlockChainWithoutValidation` to account for future
+  changes of parameters following votes.
+- `txOptCollateralUtxos` to control which utxos should be used as collaterals
+- Missing `Eq` instance for `MockChainError`
+- Full support in `ShowBS` for printing into bytestring the whole transaction
+  context within on-chain code
+- `validatorToTypedValidator` which does what its name indicates
+- Adding support for `PrettyCooked` for `TxLbl`
+- A set of modules (in `Conversion`) that each defines a typeclass of elements
+  that can be converted to a certain type. For example `ToPubKeyHash` or
+  `ToAddress`.
+- New utxos searches `vanillaOutputsAtSearch`, `scriptOutputsSearch`,
+  `onlyValueOutputsAtSearch` and `referenceScriptOutputsSearch`
+- A test file `Cooked/BalancingSpec.hs` that covers the new balancing mechanism
+  extensively.
+- A new module `Cooked/MockChain/MinAda.hs` to separate min ada computation from
+  the balancing mechanism.
+- A new documentation file `doc/BALANCING.md` that extensively describes the new
+  balancing mechanism and the available options.
+- A new skeleton option to manage fees called `FeePolicy`. It makes it possible
+  to successfully validate transactions that have not been automatically
+  balanced.
+- Auto computation of total and return collaterals based on fees and protocol
+  parameters now fully handled during balancing and transaction generation.
+- Two filters in `Output.hs`, `isScriptOutput` and `isPKOutput`
+- A new helper function to get the full output value of a skeleton,
+  `txSkelOutputsValue`
+- Proposal procedures can now be issued and described in transaction
+  skeletons. If they contain parameter changes or treasury withdrawals, a
+  witness script can be attached and will be run.
+- `TxSkelRedeemer` is now used for all kinds of scripts.
+- File [CONWAY](doc/CONWAY.md) to document which Conway features are currently
+  supported.
+- A new option `txOptAnchorResolution` to decide whether to resolve urls
+  locally or on the web (unsafe). The default is to resolve them locally with a
+  given map from urls to page content as bytestring.
+
+### Removed
+- Extraneous dependencies in package.yaml
+- File `Cooked.TestUtils`, its content has been added to `Cooked.MockChain.Testing`
+- Support for importing scripts from bytestring in module Cooked.RawUPLC, to be
+  added back later on
+- Deprecated skeleton option: `txOptAwaitTxConfirmed`
+- Deprecated use of `*` instead of `Type`
+- Many unused pragmas
+- Orphan default instance for `Ledger.Slot`
+- `MintsRedeemer` (replaced by `TxSkelRedeemer`)
+
+### Changed
+- Default era from Babbage to Conway
+- No longer rely on deprecated plutus-apps, but instead
+  [cardano-node-emulator](https://github.com/IntersectMBO/cardano-node-emulator)
+- From GHC 8.10.4 to 9.6.5 and associated versions of HLS
+- Rely mostly on
+  [CHaP](https://github.com/IntersectMBO/cardano-haskell-packages?tab=readme-ov-file)
+  instead of direct git sources
+- Update the cheatsheet to account for various small changes + collaterals
+- `ImportQualifiedPost` by default
+- `MockChainEnv` is gone, replaced by the new mcstParams field in `MockChainSt`
+- The structure of the various steps around transaction validation (fee
+  generation, ensuring min ada...)
+- Regrouped all important validation steps, including modifications requested in
+  skeleton options in the direct implementation of `validateTxSkel`.
+- Homogenized and simplified the functions to generate transaction parts from a
+  `TxSkel` by using a reader monad over various parameters.
+- Fully reworked the balancing process and associated balancing options.
+  See in the dedicated [documentation](doc/BALANCING.md).
+- Reworked `MockChain` errors related to balancing.
+
+### Fixed
+- A bug where the ledger state would not be updated by consumed collaterals
+- A curious choice where parameter changes for single transactions would be
+  applied several times instead of one
+- Various warnings around incomplete pattern matches when selecting utxos for
+  balancing, with more suitable algorithms
+
+## [[3.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v3.0.0) - 2024-03-22
+
+### Added
+
+- Modifiers to ease specification of payments in transaction skeletons:
+  - `withDatum`, `withInlineDatum`, and `withDatumHash` to add or override
+    datums in payments, regardless of whether the type matches the validator
+    type in case of scripts
+  - `paysScriptNoDatum` to be used with `withDatum`, `withInlineDatum` and
+    `withDatumHash`.
+  - `withReferenceScript` and `withStakingCredential` to add a reference script
+    or staking credential to a payment
+- Export `Cooked.UtxoState`
+- A module `Cooked.ShowBS` to provide a Plutus-level analogue of `Show` with
+  `BuiltinString` as its codomain. This is very inefficient due to limitations
+  of `BuiltinString`, but potentially useful for "printf-debugging" of scripts.
+- An option `txOptEmulatorParamsModification` to temporarily change protocol
+  parameters for balancing and validation of a transaction
+- A function `combineModsTweak` to construct branching tweaks depending on the
+  different combinations of foci of an optic on `TxSkel`
+- New `PrettyCooked` instances for common Plutus types
+- Tweaks on signers in the non-lens tweak API
+- A function `resolveTypedDatum` to recover typed data on UTxOs in
+  `MonadBlockChainBalancing`.
+- A `UtxoSearch` that starts from a list of `TxOutRef`s
+- A transaction option to choose which UTxOs can be spent for balancing
+- Lenses for the fields of `TxOpts`
+- [Cheatsheet](doc/CHEATSHEET.md)
+- API now exposes: `Cooked.Tweak.ValidityRange`, `interpretAndRun`,
+  `interpretAndRunWith`, `runTweak`, `runTweakFrom` and `datumHijackingTarget`
+- `there` modifier to apply a tweak at a precise place in a trace
+- New tweaks to change the start or end of the transaction validity range:
+  `setValidityStartTweak` and `setValidityEndTweak`
+- UTxo searches with predicates over values, including only ada, or not only
+  ada: `filterWithValuePred`, `filterWithOnlyAda` and `filterWithNotOnlyAda`
+- New pretty-printing options related to hashes in `pcOptHashes` including the
+  possibility to assign human readable names to hashes (pubkeys, scripts,
+  minting policies)
+- Initial distributions of funds can now include arbitrary payments instead of
+  only consisting of values belonging to wallets. In particular, we can now
+  initially pay to scripts and have utxos with datums and reference scripts. We
+  can still create an initial distribution in the old fashion way with
+  `distributionFromList` or directly provide a list of payments with
+  `InitialDistribution`.
+- Dummy pre-existing validators in `Cooked.Validators` to be used for testing
+  purposes mainly but also as targets for attacks and tweaks.
+- Small QOL helpers (`ada`, `lovelace` and `adaAssetClass`) to create values in
+  `Cooked.ValueUtils`.
+
+### Removed
+
+- `paysPKWithReferenceScript` (superseded by the `withReferenceScript` modifier)
+- Do not export `Cooked.UtxoPayloadSet`
+
+### Changed
+
+- `Cooked.holdingInState` is relpaced by `Cooked.holdsInState` which takes an
+  address instead of a wallet as argument.
+- Failure testing is slightly modified so that every test has to check that the
+  right error is thrown
+  * `Cooked.testFailsFrom'` is renamed to `Cooked.testFailsFrom`
+  * `Cooked.testFails` is (the new) `Cooked.testFailsFrom` with the default
+    distribution.
+
+  To update their code, users must
+  1. Adapt invokations of `Cooked.testFails` and `Cooked.testFailsFrom` adding a
+     predicate that must hold on the error returned by running the transaction,
+  2. Rename `Cooked.testFailsFrom'` into `Cooked.testFailsFrom`.
+  3. (Bonus) simplify, knowing that ``Cooked.testFailsFrom o x def ==
+     Cooked.testFails o x``
+- Quick and permanent value minting policies have been migrated to PlutusV2.
+- Default initial distribution only provides 5 UTxOs per wallet instead of 10.
+
+### Fixes
+
+- Add forgotten export of `permanentValue`
+- In `MockChainT`: don't delete data on transaction inputs if there are still
+  UTxOs with that datum around. (See PR #354)
+- Prettyprint unresolved transaction inputs
+
+## [[2.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v2.0.0) - 2023-02-28
+
+This major update overhauls the entire library to: handle Plutus V2 features,
+improve transaction generation, the API, and the internal module structure and
+code quality.
+
+### New features
+
+- Reference inputs can be declared in transaction skeletons.
+- Reference scripts can be declared in outputs of transaction skeletons and one
+  can spend inputs from a script that a transaction references.
+- Datums in outputs of transaction skeletons can be declared as
+   - inlined,
+   - hashed, with the resolved datum included on the transaction (i.e. as in
+     Plutus V1), or
+   - hashed, without the resolved datum on the transaction.
+- New framework to search for UTxOs in the state using chainable filters that
+  bring more type information.
+- Parameterizable and revamped pretty-printing relying on `prettyprinter`
+
+### Changes
+
+- Transaction skeletons are now defined declaratively, no longer using lists of
+  constraints.
+- Balancing and transaction generation no longer rely on `plutus-apps`, they are
+  performed entirely by cooked.
+- Transaction skeletons need an explicit signer (no longer signed by a default
+  wallet).
+- Modules have been reorganized in a flatter tree and cleaned up.
+
+## [[1.0.1]](https://github.com/tweag/cooked-validators/releases/tag/v1.0.1) - 2023-02-17
+
+### Fixes
+
+- Fixes wrong version number in the `.cabal` files
+
+## [[1.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v1.0.0) - 2023-01-04
+
+Stable release covering Plutus V1.

From 52b65e128b609b032019b7ded4f49755a7dc5bd1 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 19 Feb 2026 16:47:24 +0100
Subject: [PATCH 86/96] attempting another config

---
 flake.lock | 29 +++++++++++++++++++++++------
 flake.nix  | 14 +++++++++-----
 2 files changed, 32 insertions(+), 11 deletions(-)

diff --git a/flake.lock b/flake.lock
index 0bf532c57..efccd7a1c 100644
--- a/flake.lock
+++ b/flake.lock
@@ -57,11 +57,27 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1769300771,
-        "narHash": "sha256-MI1YHDj3a4B3Tl4y8xXQUfOMmp1/+89ZAERztmmMCpI=",
+        "lastModified": 1766062740,
+        "narHash": "sha256-U9KVTNs7PvyND7gisDMiluOfwT5hvOlMH2LTYfAYpNk=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "b2286b474056786a86863bd3efd9f5ab36d030b6",
+        "rev": "6dc87b326cef973e51ed3d2ffbdbe6240917a7be",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "6dc87b326cef973e51ed3d2ffbdbe6240917a7be",
+        "type": "github"
+      }
+    },
+    "nixpkgs-haskell": {
+      "locked": {
+        "lastModified": 1771497924,
+        "narHash": "sha256-6GqZK85m6FIQdKw3iIka9GwQrf/PL0wN8nCUK6UYP/k=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "bae984db2d1159823fd40397804ff62b973275cc",
         "type": "github"
       },
       "original": {
@@ -80,11 +96,11 @@
         ]
       },
       "locked": {
-        "lastModified": 1769069492,
-        "narHash": "sha256-Efs3VUPelRduf3PpfPP2ovEB4CXT7vHf8W+xc49RL/U=",
+        "lastModified": 1770726378,
+        "narHash": "sha256-kck+vIbGOaM/dHea7aTBxdFYpeUl/jHOy5W3eyRvVx8=",
         "owner": "cachix",
         "repo": "pre-commit-hooks.nix",
-        "rev": "a1ef738813b15cf8ec759bdff5761b027e3e1d23",
+        "rev": "5eaaedde414f6eb1aea8b8525c466dc37bba95ae",
         "type": "github"
       },
       "original": {
@@ -97,6 +113,7 @@
       "inputs": {
         "flake-utils": "flake-utils",
         "nixpkgs": "nixpkgs",
+        "nixpkgs-haskell": "nixpkgs-haskell",
         "pre-commit-hooks": "pre-commit-hooks"
       }
     },
diff --git a/flake.nix b/flake.nix
index deceda322..d5f59d517 100644
--- a/flake.nix
+++ b/flake.nix
@@ -1,13 +1,17 @@
 {
-  inputs.nixpkgs.url = "github:NixOS/nixpkgs/haskell-updates";
-  inputs.flake-utils.url = "github:numtide/flake-utils";
-  inputs.pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix";
-  inputs.pre-commit-hooks.inputs.nixpkgs.follows = "nixpkgs";
+  inputs = {
+    nixpkgs.url = "github:NixOS/nixpkgs/6dc87b326cef973e51ed3d2ffbdbe6240917a7be";
+    nixpkgs-haskell.url = "github:NixOS/nixpkgs/haskell-updates";
+    flake-utils.url = "github:numtide/flake-utils";
+    pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix";
+    pre-commit-hooks.inputs.nixpkgs.follows = "nixpkgs";
+  };
 
   outputs =
     {
       self,
       nixpkgs,
+      nixpkgs-haskell,
       flake-utils,
       pre-commit-hooks,
     }:
@@ -15,7 +19,7 @@
       system:
       let
         pkgs = nixpkgs.legacyPackages.${system};
-        hpkgs = pkgs.haskell.packages.ghc96;
+        hpkgs = nixpkgs-haskell.legacyPackages.${system}.haskell.packages.ghc96;
 
         ## We change the way 'blst' is built so that it takes into
         ## account the current architecture of the processor. This

From 2295bf09d41e0b07e3fad4b0af617bfbddeb186c Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Thu, 19 Feb 2026 16:53:18 +0100
Subject: [PATCH 87/96] cabal file

---
 cooked-validators.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index f9e989702..ef397c893 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.4
 
--- This file has been generated from package.yaml by hpack version 0.38.3.
+-- This file has been generated from package.yaml by hpack version 0.38.2.
 --
 -- see: https://github.com/sol/hpack
 

From 643511fbc0a173a5a09e1b2d382a376f08942c44 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 20 Feb 2026 00:28:14 +0100
Subject: [PATCH 88/96] beginning of changelog + cleanup packages

---
 CHANGELOG.md            | 18 ++++++++
 cooked-validators.cabal | 37 +--------------
 package.yaml            | 99 ++++++++++++++++++++++-------------------
 3 files changed, 72 insertions(+), 82 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 7e4b73540..4a40b5855 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -8,15 +8,33 @@
   expressiveness of the Tweak/Attack DSL.
 - New `Ltl` combinators resulting from the addition of `LtlNot`, such as
   `nowhere`, `whenAble`, ...
+- Module `Cooked.MockChain.Common` which exposes several type aliases.
 
 ### Removed
 
+- File `Cooked.MockChain.BlockChain` and all of its content.
+
 ### Changed
 
 - The datum hijacking attack has been updated: all the sub-tweaks directly set
   the new outputs, and they all return only the modified outputs.
 - The module Ltl.Combinators has been integrated to Ltl. The combinators have
   been enriched and renamed to better match the rest of the Ltl API.
+- cooked-validators has been fully migrated from mtl to polysemy. Type class
+  `MonadBlockChain` and its variants have been replaced by `DirectMockChain`,
+  `StagedMockChain`, `ExtendedStagedMockChain` and `FullMockChain`.
+- Some datum hijacking params have been changed. `ownedByDatumHijackingParams`
+  now takes a specific user as parameter, while its old behavior is now given by
+  `typedByDatumHijackingParams`. Also, `txSkelOutPredDatumHijackingParams` has
+  been renamed `outPredDatumHijackingParams`.
+- The whole file tree has been updated, in particular under
+  `Cooked.MockChain`. Each effect is given its own file, such as
+  `Cooked.MockChain.Read`, `Cooked.MockChain.Error` ...
+- Generation functions which use to live under
+  `Cooked.MockChain.GenerateTx.Witness` now live in their own
+  `Cooked.MockChain.GenerateTx.Credential` file.
+- All the auto adjustment made by cooked are now implemented using tweaks, such
+  as autofilling of min ada, auto assignement of reference script...
 
 ### Fixed
 
diff --git a/cooked-validators.cabal b/cooked-validators.cabal
index ef397c893..c56d437ae 100644
--- a/cooked-validators.cabal
+++ b/cooked-validators.cabal
@@ -120,8 +120,6 @@ library
     , bytestring
     , cardano-api
     , cardano-crypto
-    , cardano-data
-    , cardano-ledger-alonzo
     , cardano-ledger-conway
     , cardano-ledger-core
     , cardano-ledger-shelley
@@ -131,33 +129,25 @@ library
     , data-default
     , either
     , exceptions
-    , flat
     , http-conduit
     , lens
-    , list-t
     , microlens
-    , monad-control
-    , mtl
     , optics-core
     , optics-th
     , ordered-containers
-    , plutus-core
     , plutus-ledger
     , plutus-ledger-api
     , plutus-script-utils
     , plutus-tx
-    , plutus-tx-plugin
     , polysemy
     , polysemy-plugin
     , prettyprinter
     , random
     , random-shuffle
-    , strict-sop-core
     , tasty
     , tasty-hunit
     , tasty-quickcheck
     , text
-    , transformers
   default-language: Haskell2010
 
 test-suite spec
@@ -231,33 +221,12 @@ test-suite spec
       ViewPatterns
   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-missed-extra-shared-lib -fobject-code -fno-ignore-interface-pragmas -fignore-hpc-changes -fno-omit-interface-pragmas -fplugin-opt PlutusTx.Plugin:defer-errors -fplugin-opt PlutusTx.Plugin:conservative-optimisation -fplugin=Polysemy.Plugin
   build-depends:
-      QuickCheck
-    , base >=4.9 && <5
-    , bytestring
+      base >=4.9 && <5
     , cardano-api
-    , cardano-crypto
-    , cardano-data
-    , cardano-ledger-alonzo
-    , cardano-ledger-conway
-    , cardano-ledger-core
-    , cardano-ledger-shelley
-    , cardano-node-emulator
-    , cardano-strict-containers
     , containers
     , cooked-validators
     , data-default
-    , either
-    , exceptions
-    , flat
-    , http-conduit
-    , lens
-    , list-t
-    , microlens
-    , monad-control
-    , mtl
     , optics-core
-    , optics-th
-    , ordered-containers
     , plutus-core
     , plutus-ledger
     , plutus-ledger-api
@@ -267,12 +236,8 @@ test-suite spec
     , polysemy
     , polysemy-plugin
     , prettyprinter
-    , random
-    , random-shuffle
-    , strict-sop-core
     , tasty
     , tasty-hunit
     , tasty-quickcheck
     , text
-    , transformers
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
index d89d3f69d..691a2872f 100644
--- a/package.yaml
+++ b/package.yaml
@@ -3,54 +3,43 @@ verbatim:
 
 name: cooked-validators
 version: 8.0.0
-
-dependencies:
-  - QuickCheck
-  - base >= 4.9 && < 5
-  - bytestring
-  - cardano-api
-  - cardano-crypto
-  - cardano-data
-  - cardano-ledger-alonzo
-  - cardano-ledger-core
-  - cardano-ledger-shelley
-  - cardano-ledger-conway
-  - cardano-node-emulator
-  - cardano-strict-containers
-  - containers
-  - data-default
-  - either
-  - exceptions
-  - flat
-  - http-conduit
-  - lens
-  - list-t
-  - microlens
-  - monad-control
-  - mtl
-  - optics-core
-  - optics-th
-  - ordered-containers
-  - plutus-core
-  - plutus-ledger
-  - plutus-ledger-api
-  - plutus-script-utils
-  - plutus-tx
-  - plutus-tx-plugin
-  - polysemy
-  - polysemy-plugin
-  - prettyprinter
-  - random
-  - random-shuffle
-  - strict-sop-core
-  - tasty
-  - tasty-hunit
-  - tasty-quickcheck
-  - text
-  - transformers
     
 library:
   source-dirs: src
+  dependencies:
+    - QuickCheck
+    - base >= 4.9 && < 5
+    - bytestring
+    - cardano-api
+    - cardano-crypto
+    - cardano-ledger-core
+    - cardano-ledger-shelley
+    - cardano-ledger-conway
+    - cardano-node-emulator
+    - cardano-strict-containers
+    - containers
+    - data-default
+    - either
+    - exceptions
+    - http-conduit
+    - lens
+    - microlens
+    - optics-core
+    - optics-th
+    - ordered-containers
+    - plutus-ledger
+    - plutus-ledger-api
+    - plutus-script-utils
+    - plutus-tx
+    - polysemy
+    - polysemy-plugin
+    - prettyprinter
+    - random
+    - random-shuffle
+    - tasty
+    - tasty-hunit
+    - tasty-quickcheck
+    - text
   ghc-options: &ghc-options
     -Wall
     -Wcompat
@@ -99,7 +88,25 @@ tests:
     main: Spec.hs
     source-dirs:
       - tests/
-    ghc-options: *ghc-options  
     dependencies:
+      - base >= 4.9 && < 5
+      - cardano-api
+      - containers
       - cooked-validators
+      - data-default
+      - optics-core
+      - plutus-core
+      - plutus-ledger
+      - plutus-ledger-api
+      - plutus-script-utils
+      - plutus-tx
+      - plutus-tx-plugin
+      - polysemy
+      - polysemy-plugin
+      - prettyprinter
+      - tasty
+      - tasty-hunit
+      - tasty-quickcheck
+      - text
+    ghc-options: *ghc-options        
     default-extensions: *default-extensions

From 4161311a29c0c495d4407ab79cb2100699e26b3a Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 20 Feb 2026 01:05:30 +0100
Subject: [PATCH 89/96] CHANGELOG

---
 CHANGELOG.md | 41 +++++++++++++++++++++++++++++++++++++++--
 1 file changed, 39 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 4a40b5855..22c0b7bfa 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -8,11 +8,27 @@
   expressiveness of the Tweak/Attack DSL.
 - New `Ltl` combinators resulting from the addition of `LtlNot`, such as
   `nowhere`, `whenAble`, ...
-- Module `Cooked.MockChain.Common` which exposes several type aliases.
+- `ExtendedStagedMockChain`: It is not possible to extend a mockchain run with
+  arbitrary effects, while the associated tweaks will also have access to the
+  added effects.
+- A new capability in a mockchain run, which allows to take note (basically log)
+  anything. Functions `Note(|p|s|w|l)` support this functionality.
+- A new capability in a mockchain run, which allows to make assertions which
+  will be displayed in the final result, and taken into account during
+  tests. Functions `assert(|')` support his functionality.
+- A new `testBoolMsg` function which outputs an error message when given
+  `False`.
+- Functions `testCookedFromInitDistTemplate` and
+  `testCookedQCFromInitDistTemplate` to build tests from the initial
+  distribution template (the old default initial distribution).
+- The ability to enable/disable everything from the printing of the final result
+  of running a mockchain. The pretty printer has also been improved;
+- The `HList` type for heterogeneous lists.
 
 ### Removed
 
-- File `Cooked.MockChain.BlockChain` and all of its content.
+- Tweaks can no longer issue write action such as waiting a certain amount of
+  time. As a consequence, `waitUntilValidTweak` has been removed.
 
 ### Changed
 
@@ -35,6 +51,27 @@
   `Cooked.MockChain.GenerateTx.Credential` file.
 - All the auto adjustment made by cooked are now implemented using tweaks, such
   as autofilling of min ada, auto assignement of reference script...
+- Initial distributions have been downgraded from a first class citizen to a
+  mere helping structure equivalent to using `forceOutputs`. By default, the
+  mockchain runs now have an empty state, and non-empty initial distribution can
+  be fed to runs in one of the following 3 ways: 1. use `forceOutputs` at the
+  beginning of a run. 2. Use `runMockChainFromConf` or
+  `runMockChainFromInitiDist` while running a trace. 3. use `withInitDist` when
+  running tests. The old default initial distribution still exists as
+  `initialDistributionTemplate` and is simply directly a list of outputs.
+- The UTxO searches have been fully reworked. They now happen in 3
+  steps: 1. bootstrap the search with a set of UTxOs (`beginSearch` and
+  `beginSearchP`) 2. filter (`ensure`, `ensurePure`, `ensureAFoldIs` and
+  `ensureAFoldIsn't`) and/or extract elements from the selected outputs
+  (`extract`, `extractPure`,`extractAFold`, `extractTotal`, `extractPureTotal`
+  and `extractGetter`) in an type-retaining heterogeneous list. 2. retrieve the
+  result of the search (`getOutputs`, `getOutputsAndExtracts`, `getExtracts`,
+  `getTxOutRefs` and `getTxOutRefandOutputs`). Some additional helpers are
+  provided for basic searches (`utxosAtSearch`, `allUtxosSearch`,
+  `txSkelOutByRefSearch` and `txSkelOutByRefSearch'`) and for basic filters
+  (`ensureOnlyValueOutputs`, `ensureVanillaOutputs` and
+  `ensureProperReferenceScript`).
+- `txSkelLabel` has been renamed `txSkelLabels`
 
 ### Fixed
 

From 06194652868fa82c59e38734a53cb89a09630232 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Fri, 20 Feb 2026 11:35:22 +0100
Subject: [PATCH 90/96] Updating the README

---
 README.md     | 205 +++++++++++++++++++++++++++++++++-----------------
 cabal.project |   3 -
 2 files changed, 138 insertions(+), 70 deletions(-)

diff --git a/README.md b/README.md
index c11a57508..044c6b8ad 100644
--- a/README.md
+++ b/README.md
@@ -53,16 +53,38 @@ to [UPLC](https://plutonomicon.github.io/plutonomicon/uplc), such as
 
 ## How to integrate `cooked-validators` in a project
 
-1. `cooked-validators` depends on
-[cardano-haskell-packages](https://github.com/input-output-hk/cardano-haskell-packages)
-to get cardano-related packages and on
-[cardano-node-emulator](https://github.com/tweag/cardano-node-emulator-forked)
-directly. If you have no constraint on the version of this package, copy the
-file [`cabal.project`](./cabal.project) to your project and
-[adapt](https://cabal.readthedocs.io/en/stable/cabal-project-description-file.html#specifying-the-local-packages)
-the `packages` stanza.
+There are two ways for this integration:
+
+1. `cooked-validators`, and all its dependencies, are available on
+   [cardano-haskel-packages
+   (CHaP)](https://github.com/IntersectMBO/cardano-haskell-packages). To rely
+   on a release available there, add the following stanza to your
+   `cabal.project`:
+   
+   ```cabal.project
+   repository cardano-haskell-packages
+	 url: https://chap.intersectmbo.org/
+	 secure: True
+	 root-keys:
+	   3e0cce471cf09815f930210f7827266fd09045445d65923e6d0238a6cd15126f
+	   443abb7fb497a134c343faf52f0b659bd7999bc06b7f63fa76dc99d631f9bea1
+	   a86a1f6ce86c449c46666bda44268677abf29b5b2d2eb5ec7af903ec2f117a82
+	   bcec67e8e99cabfa7764d75ad9b158d72bfacf70ca1d0ec8bc6b4406d1bf8413
+	   c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56
+	   d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
+
+   index-state:
+	 , cardano-haskell-packages 2026-02-13T00:00:02Z
+   ```
    
-2. Add the following stanza to the file `cabal.project`
+   To find the appropriate index state to fill above, look for
+   `cooked-validators` on [CHaP's packages
+   list](https://chap.intersectmbo.org/all-packages/).
+
+2. Alternatively, if you want to rely on a specific commit or branch not
+   available on CHaP, you can import `cooked-validators` directly from GitHub
+   with the following stanza:
+
    ```cabal.project
    source-repository-package
      type: git
@@ -71,86 +93,135 @@ the `packages` stanza.
      subdir:
        .
    ```
+   
    where `myTag` is either a commit hash in the repo, or a tag, such as v8.0.0
    (see [available
    releases](https://github.com/tweag/cooked-validators/releases)).
+   
+   Note that, should you do that, you would likely still need CHaP for all the
+   other dependencies.
 
-3. Each release of `cooked-validators` is pinned to a specific version of
-   [`cardano-api`](https://github.com/IntersectMBO/cardano-api) which in turn
-   pins the versions of all other Cardano-related dependencies (including
-   Plutus). Make sure your project relies on the same version.
+ Each release of `cooked-validators` is pinned to a specific version of
+ [`cardano-api`](https://github.com/IntersectMBO/cardano-api) which in turn pins
+ the versions of all other Cardano-related dependencies (including Plutus). Make
+ sure your project relies on the same version.
 
 ## Example
    
 This example shows how to create and validate a simple transaction that
-transfers 10 Ada from wallet 1 to wallet 2, without manually handling fees or
-balancing.
+transfers 10 Ada from Alice (wallet 1) to Bob (wallet 2), without manually
+handling fees or balancing.
 
-1. Enter a Cabal read-eval-print-loop (with `cabal repl`)
+1. Create a new Haskell module, for example `Demo.hs`
 
 2. Import your required dependencies
    ``` haskell
-   > import Cooked
-   > import qualified Plutus.Script.Utils.Value as Script
+   import Cooked
+   import Plutus.Script.Utils.Value qualified as Script
    ```
 
-3. Define a transaction which transfers 10 Ada from wallet 1 to wallet 2
+3. Start the definition of a `MockChain` run:
+   ``` haskell
+   myDemoRun :: StagedMockChain ()
+   myDemoRun = do
+   ```
+   
+4. Define aliases for Alice and Bob:
    ``` haskell
-   let myTransaction = txSkelTemplate {txSkelOuts = [wallet 2 `receives` Value (Script.ada 10)], txSkelSignatories = txSkelSignatoriesFromList [wallet 1]}
+     alice <- define "Alice" $ wallet 1
+     bob <- define "Bob" $ wallet 2
+   ```
+   
+5. Give some initial funds to Alice:
+   ``` haskell
+     forceOutputs_ $ replicate 3 $ alice `receives` Value (Script.ada 10)
+   ```
+   
+5. Take some notes:
+   ``` haskell
+     noteS "Alice is sending 10 ADA to Bob"
+     noteS "I let cooked-validators do the heavy lifting for me"
    ```
 
-4. Send the transaction for validation, and request the printing of the run
+6. Submit the transaction:
    ``` haskell
-   printCooked . runMockChain . validateTxSkel_ $ myTransaction 
+     validateTxSkel_
+       txSkelTemplate
+         { txSkelOuts = [bob `receives` Value (Script.ada 10)],
+           txSkelSignatories = txSkelSignatoriesFromList [wallet 1]
+         }
    ```
 
-5. Observe the log of the run, including:
-    - The original skeleton, and its balanced counterpart
-	- The associated fee and collaterals
-	- The final mockchain state, with every wallet's assets (notice the 10 ADA
-      payment owned by wallet 2)
-	- The value returned by the run (here `()` as we used `validateTxSkel_`)
-   ```haskell
-   📖 MockChain run log:
-	 ⁍ New raw skeleton submitted to the adjustment pipeline:
-	   - Validity interval: (-∞ , +∞)
-	   - Signatories:
-		 - wallet 1 [balancing]
-	   - Outputs:
-		 - Pays to pubkey wallet 2
-		   - Lovelace: 10_000_000
-	 ⁍ New adjusted skeleton submitted for validation:
-	   - Validity interval: (-∞ , +∞)
-	   - Signatories:
-		 - wallet 1 [balancing]
-	   - Inputs:
-		 - Spends #4480b35!3 from pubkey wallet 1
-		   - Redeemer ()
-		   - Lovelace: 100_000_000
-	   - Outputs:
-		 - Pays to pubkey wallet 2
-		   - Lovelace: 10_000_000
-		 - Pays to pubkey wallet 1
-		   - Lovelace: 89_828_383
-	   - Fee: Lovelace: 171_617
-	   - No collateral required
-	 ⁍ New transaction successfully validated:
-	   - Transaction id: #c095342
-	   - Number of new outputs: 2
-   ✅ UTxO state:
-	 • pubkey wallet 1
-	   - Lovelace: 89_828_383
-	   - (×3) Lovelace: 100_000_000
-	 • pubkey wallet 2
-	   - Lovelace: 10_000_000
-	   - (×4) Lovelace: 100_000_000
-	 • pubkey wallet 3
-	   - (×4) Lovelace: 100_000_000
-	 • pubkey wallet 4
-	   - (×4) Lovelace: 100_000_000
-   🟢 Returned value: () 
+7. Lookup for the UTxOs now owned by Bob, and assert that he indeed possesses 1:
+   ``` haskell 
+      bobUtxos <- utxosAt bob
+      assert "Bob now has 1 utxo" $ length bobUtxos == 1
    ```
 
+8. Enter a `cabal repl`, run and print the trace:
+   ``` haskell
+   > printCooked $ runMockChainDef myDemoRun
+   ```
+
+5. Observe the output of printing the run, including:
+   - The notes you've taken:
+	 ```
+	 📔 Notes:
+	   - Alice is going to send 10 ADA to Bob
+	   - I let cooked-validators do the heavy lifting for me
+     ```
+   - The execution log, including: the original submitted skeleton, 
+	 the adjusted skeleton, and the computed fee and collaterals:	 
+	 ```
+	 📖 MockChain run log:
+	   ⁍ New raw skeleton submitted to the adjustment pipeline:
+		 - Validity interval: (-∞ , +∞)
+		 - Signatories:
+		   - Alice [balancing]
+		 - Outputs:
+		   - Pays to pubkey Bob
+			 - Lovelace: 10_000_000
+	   ⁍ New adjusted skeleton submitted for validation:
+		 - Validity interval: (-∞ , +∞)
+		 - Signatories:
+		   - Alice [balancing]
+		 - Inputs:
+		   - Spends #d769532!1 from pubkey Alice
+			 - Redeemer ()
+			 - Lovelace: 10_000_000
+		   - Spends #d769532!2 from pubkey Alice
+			 - Redeemer ()
+			 - Lovelace: 10_000_000
+		 - Outputs:
+		   - Pays to pubkey Bob
+			 - Lovelace: 10_000_000
+		   - Pays to pubkey Alice
+			 - Lovelace: 9_826_799
+		 - Fee: Lovelace: 173_201
+		 - No collateral required
+	   ⁍ New transaction successfully validated:
+		 - Transaction id: #bff7a56
+		 - Number of new outputs: 2
+	 ```
+   - The evaluation of the assertions:
+	 ```
+	 ✅ Assertions:
+	   - ✔ Bob now has 1 utxo
+     ```
+   - The final mockchain state:
+	 ```
+	 💰 UTxO state:
+	   • pubkey Alice
+		 - Lovelace: 9_826_799
+		 - Lovelace: 10_000_000
+	   • pubkey Bob
+		 - Lovelace: 10_000_000
+	 ```
+   - The outcome and return value of the run:
+	 ```
+	 🟢 Success with returned value: ()
+	 ```
+
 ## Documentation
 
 - The rendered Haddock for the current `main` branch can be found
diff --git a/cabal.project b/cabal.project
index cad3e0369..6c99127ec 100644
--- a/cabal.project
+++ b/cabal.project
@@ -46,7 +46,4 @@ package cardano-crypto-praos
   flags: -external-libsodium-vrf
   
 constraints:
-  , cardano-api == 10.18.1.0
   , cardano-node-emulator == 1.4.1.0  
-  , polysemy == 1.9.2.0
-  , polysemy-plugin == 0.4.5.3

From 898e9063017d65c18f83e5c511a33d1c245d67af Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 24 Mar 2026 12:02:31 +0100
Subject: [PATCH 91/96] reworking cheatsheet

---
 doc/CHEATSHEET.md | 424 +++++++++++++++++++++++++++++-----------------
 1 file changed, 266 insertions(+), 158 deletions(-)

diff --git a/doc/CHEATSHEET.md b/doc/CHEATSHEET.md
index 8ed4e23eb..5da2b2e74 100644
--- a/doc/CHEATSHEET.md
+++ b/doc/CHEATSHEET.md
@@ -1,25 +1,113 @@
 # Cheatsheet
 
-* This cheastsheet is quick reminder, not a tutorial about `cooked-validators`.
-* Minimum prior knowledge (Cardano, general idea of what `cooked-validators` is about) is expected.
-* It reminds how to use or help discover `cooked-validators` features.
-* This does not go in depth into all features, instead it give an overview of their most basic usage.
-* Code snippets are not usable as is, they give intuition and direction. Adapt them to your use case.
+Welcome to `cooked-validators`' **Cheatsheet** 
 
-## Basics
+You will find here code snippets to help you use the library, which can, and
+should, be adapted to your use cases! Learn how to write transactions, fetch
+information from the blockchain, submit these transactions as part of a trace,
+and run those traces in tests or in a `repl` environement!
 
-### Run a trace
+While this is not a tutorial, this document should be helpful to new users to
+get accustomed to `cooked-validators` as well as old users looking to remember
+how things are done in `cooked-validators` !
 
-* In a test
-    * `testCooked "foo" $ mustSucceedTest foo`
-    * `testCookedQC "foo" $ mustFailTest foo`
-* In the REPL
-    * `printCooked $ interpretAndRun foo` for all traces
-    * `printCooked $ runMockChain foo` for `MonadBlockChain` traces only
+## Traces 
 
-### Custom initial distributions of UTxOs
+### Define a trace
 
-#### Creation
+A `mockchain` is an emulated blockchain. A trace is a sequence of instructions
+in one of our builtin monadic environement representing this `mockchain`:
+- `DirectMockChain`: basic capabilities of the mockchain
+- `StagedMockChain`: basic capabilities of the mockchain, with the addition of
+  branching and temporal modifications. This is the go-to environement !
+- `FullMockChain`: all effects available, including low-level effects such as
+  builtin-errors, to be used for maximum level of granularity
+- `ExtendedStagedMockChain eff`: same as `StagedMockChain` with additional
+  custom effects embedded in `eff`, to work in your own dedicated environement !
+
+* In a fixed mockchain:
+```haskell
+myTrace :: [Direct|Staged|Full]MockChain ()
+myTrace = do
+  ...
+```
+
+* In a mockChain extended with a single effect:
+```haskell
+myTrace :: ExtendedStagedMockChain FirstEff ()
+myTrace = do
+  ...
+  actionInFirstEff
+  ...
+```
+
+* In a mockchain extended with several effects (using `Polysemy`'s bundle capability):
+```haskell
+myTrace :: ExtendedStagedMockChain (Bundle '[FirstEff, SecondEff,..]) ()
+myTrace = do
+  ...
+  sendBundle $ actionInFirstEff
+  ...
+  sendBundle $ actionInSecondEff
+  ...
+```
+
+* In a direct set of capabilities:
+```haskell
+myTrace :: (Members '[MockChainLog, MockChainRead, ...] effs) => Sem effs ()
+myTrace = do
+  ...
+```
+
+### Execute the trace in a `cabal repl`
+
+* With a default mockchain state: 
+  `printCooked $ runMockChainDef myTrace`
+* With a custom mockchain state: 
+  `printCooked $ runMockChain myState myTrace`
+* With a custom initial list of payments (or `InitialDistribution`):
+  `printCooked $ runMockChainFromInitDist myPaymentsList myTrace`
+* With a default configuration (initial state, initial list of payments, and custom function on returned value): 
+  `printCooked $ runMockChainFromConf myConf myTrace`
+
+### Use the trace as part of a test
+
+* Expect a successful outcome from a trace:
+  `mustSucceedTest myTrace`
+* Expect a failure from a trace:
+  `mustFailTest myTrace`
+* Expect a failure within a specific validation phase/with a specific error message:
+  `mustFailInPhase[1|2](withMessage?) (expectedMessage?) myTrace`
+* Manually customize the:
+  * initial distribution: `withInitiDist myPaymentsList`
+  * pretty printing options: `withPrettyOpts myOptions`
+  * expectations on the log: `withLogProp myLogProp`
+  * expectations on the resulting state: `withStateProp myStateProp`
+  * expectations on the successful outcome: `withSuccessProp mySuccessProp`
+  * expectations on the returned value: `withResultProp myResultProp`
+  * expectations on the number of results: `withSizeProp mySizeProp`
+  * expectations on the failure output: `withFailureProp myFailureProp`
+  * expectations on the possible error: `withErrorProp myError prop`
+* Wrap the test in a quickcheck/tasty test case:
+  * `testCooked` "myTastyTest" $ myTastyTest
+  * `testCookedQC` "myQuickCheckTest" $ myQuickCheckTest
+* Example:
+```haskell
+testCooked $ 
+  mustSucceedTest myTrace 
+    `withInitDist` myListOfPayments -- giving a custom initial distribution
+    `withSizeProp` isOfSize 3 -- expecting 3 outputs
+    `withResultProp` (== 42) -- each returned value should be 42
+    `withLogProp` happened "MCLogAddedReferenceScript" -- a reference script was automatically added
+    `withStateProp` possesses alice myAssetClass 10 -- alice possesses 10 custom tokens in the resulting state
+```
+
+## Custom initial distributions of UTxOs
+
+Initial distributions of funds are lists of payment used to populate the
+blockchain without needing a transaction.
+
+### Creation
 
 * With values only
   ```haskell
@@ -33,22 +121,27 @@
 * With arbitrary payments (more details on the payments content in the dedicated section)
   ```haskell
   initDist :: InitialDistribution
-  initDist = InitialDistribution
+  initDist = 
 	[ wallet 3 `receives` Value (ada 6)
     , fooTypedValidator `receives` Value (myToken 6) <&&> InlineDatum fooTypedDatum
 	, wallet 2 `receives` Value (ada 2) <&&> VisibleHashedDatum fooDatum
 	, wallet 1 `receives` Value (ada 10) <&&> ReferenceScript fooValidator <&&> StakingCredential cred
 	]
   ```
-#### Usage
+### Usage
+
+* In a test: ``testCooked "foo" $ mustSucceedTest foo `withInitDist` myInitiDist``
+* In a `repl`: `printCooked $ runMockChainFromInitDist myInitDist foo`
+* Within a trace: `forceOutputs myInitDist`
 
-* In a test ``testCooked "foo" $ mustSucceedTest foo `withInitDist` myInitiDist``
-* In the REPL `printCooked $ interpretAndRunWith (runMockChainTFromInitDist initDist) foo`
+## Give human-readable aliases to hashable data (scripts, wallets, ...)
 
-### Give human-readable names to pubkey/script/minting hashes
+It is possible to define aliases for everything that is hashable, for pretty
+printing/debugging purposes at the end of a run.
 
-* Outside the mockchain, for static names in the pretty options direclty:
+### Aliases for static data
 
+Aliases for static data can be defined outside a mockchain run, in the pretty options direclty:
 ```haskell
 walletNames :: [(Wallet, String)]
 walletNames = [(wallet 1, "Alice"), (wallet 2, "Bob"), (wallet 3, "Carie")]
@@ -69,111 +162,175 @@ pcOpts =
     def
 ```
 
-* Inside the mockchain, for dynamic names (depending on on-chain data, such as `TxOutRef`s):
+### Aliases for dynamic data
 
+Aliases for dynamic data (depending on on-chain elements such as `TxOutRef`s)
+can be defined directly within a mockchain run:
+
+* Result of a pure call:
 ```haskell
-myScript <- define "myScript" $ generateScript txOutRef
+myTrace = do
+  ...
+  myScript <- define "myScript" $ scriptFromTxOutRef txOutRef
+  ...
 ```
 
+* Result of an impure call:
 ```haskell
-myScript <- defineM "myValidator" $ do
+myTrace = do
+  ...
+  myScript <- defineM "myValidator" $ do
+    ...
+    return $ scriptFromTxOutRef txOutRef
   ...
-  return $ generateScript txOutRef
 ```
 
-### Write a trace or endpoint
+## Handling time
 
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    transactionOrEndpoint1
-    transactionOrEndpoint2
-    transactionOrEndpoint3
-```
+Time can be querried/set within a mockchain run, to account for transaction with
+specific validity interval/temporal constraints.
 
-### Get the current time
+### Querrying time
 
+* The current slot can be querried directly:
 ```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    ...
-    slot <- currentSlot
-    ...
+myTrace = do
+  ...
+  slot <- currentSlot
+  ...
 ```
 
-
+* An interval of ms can be querried as well, deduced from the slot:
 ```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    ...
-    (firstMsOfCurrentSlot, lastMsOfCurrentSlot) <- currentTime
-    ...
+myTrace = do
+  ...
+  (firstMsOfCurrentSlot, lastMsOfCurrentSlot) <- currentMSRange
+  ...
 ```
 
-### Wait for at least some amount of time
+* No single ms point can be querried, as it does not exist!
+
+* The slot containing a given ms point can be querried: `getEnclosingSlot`
+
+### Jumping in time
 
+* Waiting a certain amount of slots
 ```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    ...
-    (firstMsOfCurrentSlot, lastMsOfCurrentSlot) <- currentMSRange
-    targetSlot <- getEnclosingSlot $ lastMsOfCurrentSlot + 3_600_000 -- 1 hour
-    awaitSlot targetSlot
-    ...
+myTrace = do
+  ...
+  waitNSlots 3
+  ...
 ```
+* Similarly, we can:
+  * jump to a given slot: `awaitSlot`
+  * jump to the slot enclosing a given ms point: `awaitEnclosingSlot`
+  * wait a certain amount of ms from the first ms of the current slot: `waitNMSFromSlotLowerBound`
+  * wait a certain amount of ms from the last ms of the current slot: `waitNMSFromSlotUpperBound`
 
-### Submit a transaction for validation and...
+### Return `TxOutRef`s from transaction outputs from...
 
-* ... get the validated Cardano transaction
-  ```haskell
-  foo :: MonadBlockChain m => m ()
-  foo = do
-          ...
-		  cardanoTx <-
-            validateTxSkel $
-			  txSkelTemplate
-			    { txSkelIns = ...,
-                  ... 
-		        }
-		  ...
-  ```
-* ... get the generated `TxOutRef`s
+* ... the Cardano transaction
   ```haskell
-  foo :: MonadBlockChain m => m ()
-  foo = do
-          ...
-		  txOutRefs <-
-            validateTxSkel' $
-		  	  txSkelTemplate
-			    { txSkelIns = ...,
-                  ...
-                }
-          ...
+  endpointFoo :: MonadBlockChain m => m (Api.TxOutRef, Api.TxOutRef)
+  endpointFoo = do
+    cTx <- validateTxSkel $ txSkelTemplate { ..., ... }
+    let (txOutRef1, _) : (txOutRef2, _) : _ = utxosFromCardanoTx cTx
+    return (txOutRef1, txOutRef2)
   ```
-* ... ignore any returned value
+* ... the returned `TxOutRef`s
   ```haskell
-  foo :: MonadBlockChain m => m ()
-  foo = do
-          ...
-          validateTxSkel_ $
-		    txSkelTemplate
-		      { txSkelIns = ...,
-                ...
-              }
-          ...
+  endpointFoo :: MonadBlockChain m => m (Api.TxOutRef, Api.TxOutRef)
+  endpointFoo = do
+    txOutRef1 : txOutRef2 : _ <- validateTxSkel' $ txSkelTemplate { ..., ... }
+    return (txOutRef1, txOutRef2)
   ```
 
-### Use wallets
+### Resolve all or parts of a `TxOutRef` (get the corresponding `TxSkelOut` elements)
+
+* Get the full `TxSkelOut` from a `TxOutRef`
+```haskell
+foo :: MonadBlockChain m => Api.TxOutRef -> m ()
+foo txOutRef = do
+  txSkelOut <- txSkelOutByRef txOutRef
+  ...
+```
+
+* Get a certain part of a `TxSkelOut` from a `TxOutRef` and an optic
+```haskell
+foo :: MonadBlockChain m => Api.TxOutRef -> m ()
+foo txOutRef = do
+  -- A value is always present, use 'viewByRef'
+  value <- viewByRef txSkelOutValueL txOutRef
+  -- A datum of a given type might not be present, use 'previewByRef'
+  Just typedDatum <- previewByRef (txSkelOutDatumL % txSkelOutDatumTypedAT @MyDatumType) txOutRef
+  ...
+```
+
+## Transaction skeletons
+
+Transaction skeletons are abstractions over real transactions, allowing to
+define minimal content proper to each concern. 
+
+### Defining a transaction skeleton
+
+A transaction skeleton is composed of transaction elements and transaction
+options. It is built upon a transaction skeleton template. Each field can then
+be overridden.
+
+```haskell
+myTxSkel = txSkelTemplate 
+  { txSkelIns = ...,
+	txSkelOuts = ...,
+	txSkelOpts = ...,
+	...
+  }
+```
+
+### Submitting transaction skeletons for validation
+
+Transaction skeletons can be submitted for validation and...
+
+* ... get the validated Cardano transaction
+```haskell
+myTrace = do
+  ...
+  cardanoTx <- validateTxSkel myTxSkel
+  ...
+```
+
+* ... get the generated `TxOutRef`s: `validateTxSkel'`
 
-* 10 wallets: `wallet 1` to `wallet 10`
-* `import Plutus.Script.Utils.Address qualified as Script`
-* `Script.toAddress (wallet 3)`
-* `Script.toPubKeyHash (wallet 2)`
+* ... ignore any returned value: `validateTxSkel_`
 
-### Sign a transaction
+## Wallets
 
-* With one or more wallets, including their private key. They will both be part
-  of the required, and actual signers of the transaction.
+Wallets are dummy peers that can be used for testing purposes. There are 10
+wallets, from `wallet 1` to `wallet 10`.
+
+```haskell
+import Plutus.Script.Utils.Address qualified as Script
+import PlutusLedgerApi.V3
+
+alice :: Wallet 
+alice = wallet 1
+
+aliceAddress :: Address
+aliceAddress = Script.toAddress alice
+
+alicePKHash :: PubKeyHash 
+alicePKHash = Script.toPubKeyHash alice
+```
+
+Other wallet queries:
+* `walletSK`
+* `walletPK`
+* `walletStakingPK`
+* ...
+
+## Signatories
+
+Transaction can be signed with one of more wallets. They will both be part of
+the required and actual signers of the transaction.
 
 ```haskell
 txSkelTemplate
@@ -183,12 +340,11 @@ txSkelTemplate
     }
 ```
 
-* With anything that has a pubkey (including wallets) . The will only be part of
-  the required signatories, but the actual signatories are postponed for later.
+Transactions can also be signed by anything that has a pubkey. They will only be part of the required signatories, and a private key will be required later on.
   
 ```haskell
 instance Script.ToPubKeyHash MyType where
-	... 
+  toPubKeyHash = ... 
 
 myUser1 myUser2 :: MyType
 myUser1 = ...
@@ -201,16 +357,7 @@ txSkelTemplate
     }
 ```
 
-* With direct signatories:
-```haskell
-txSkelTemplate
-    { ...
-      txSkelSignatories = [TxSkelSignatory myUser (Just privateKey) , TxSkelSignatory myUser2 Nothing , ...]
-      ...
-    }
-```
-
-### Pay (transaction output)
+## Payments
 
 * A simple value to a wallet: ```wallet 3 `receives` Value (ada 3)```
 * A value and an inline datum to a script: ```fooTypedValidator `receives` (InlineDatum FooTypedDatum <&&> Value (myToken 4 <> lovelace 160_000))```
@@ -226,7 +373,7 @@ txSkelTemplate
     }
 ```
 
-### Build redeemers
+## Redeemers
 
 * No redeemer, auto fill of reference script: `emptyTxSkelRedeemer`
 * No redeemer, forbid auto fill of reference script: `emptyTxSkelRedeemerNoAutoFill`
@@ -244,57 +391,18 @@ myRedeemer =
     }
 ```
 
-### Spend some UTxOs
+## Inputs
 
 ```haskell
 txSkelTemplate
-    { ...
-      txSkelIns = Map.fromList [
-	      (txOutRef1, someTxSkelRedeemer red), 
-		  (txOutRef2, emptyTxSkelRedeemer `withReferenceInput` txOutRef),
-		  (txOutRef3, someTxSkelRedeemerNoAutoFill red2)
-	    ]
-      ...
-    }
-```
-
-### Return `TxOutRef`s from transaction outputs from...
-
-* ... the Cardano transaction
-  ```haskell
-  endpointFoo :: MonadBlockChain m => m (Api.TxOutRef, Api.TxOutRef)
-  endpointFoo = do
-    cTx <- validateTxSkel $ txSkelTemplate { ..., ... }
-    let (txOutRef1, _) : (txOutRef2, _) : _ = utxosFromCardanoTx cTx
-    return (txOutRef1, txOutRef2)
-  ```
-* ... the returned `TxOutRef`s
-  ```haskell
-  endpointFoo :: MonadBlockChain m => m (Api.TxOutRef, Api.TxOutRef)
-  endpointFoo = do
-    txOutRef1 : txOutRef2 : _ <- validateTxSkel' $ txSkelTemplate { ..., ... }
-    return (txOutRef1, txOutRef2)
-  ```
-
-### Resolve all or parts of a `TxOutRef` (get the corresponding `TxSkelOut` elements)
-
-* Get the full `TxSkelOut` from a `TxOutRef`
-```haskell
-foo :: MonadBlockChain m => Api.TxOutRef -> m ()
-foo txOutRef = do
-  txSkelOut <- txSkelOutByRef txOutRef
-  ...
-```
-
-* Get a certain part of a `TxSkelOut` from a `TxOutRef` and an optic
-```haskell
-foo :: MonadBlockChain m => Api.TxOutRef -> m ()
-foo txOutRef = do
-  -- A value is always present, use 'viewByRef'
-  value <- viewByRef txSkelOutValueL txOutRef
-  -- A datum of a given type might not be present, use 'previewByRef'
-  Just typedDatum <- previewByRef (txSkelOutDatumL % txSkelOutDatumTypedAT @MyDatumType) txOutRef
-  ...
+  { ...
+    txSkelIns = Map.fromList 
+	  [ (txOutRef1, someTxSkelRedeemer red), 
+        (txOutRef2, emptyTxSkelRedeemer `withReferenceInput` txOutRef),
+	    (txOutRef3, someTxSkelRedeemerNoAutoFill red2)
+	  ]
+    ...
+  }
 ```
 
 ### Mint or burn tokens

From ffe722a7344895b5db83199cc3fe6e83a25e3290 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 24 Mar 2026 17:50:14 +0100
Subject: [PATCH 92/96] more cheatsheet

---
 doc/CHEATSHEET.md | 586 ++++++++++++++++++++++++++--------------------
 1 file changed, 332 insertions(+), 254 deletions(-)

diff --git a/doc/CHEATSHEET.md b/doc/CHEATSHEET.md
index 5da2b2e74..30aa74b28 100644
--- a/doc/CHEATSHEET.md
+++ b/doc/CHEATSHEET.md
@@ -1,22 +1,71 @@
-# Cheatsheet
-
 Welcome to `cooked-validators`' **Cheatsheet** 
 
-You will find here code snippets to help you use the library, which can, and
-should, be adapted to your use cases! Learn how to write transactions, fetch
-information from the blockchain, submit these transactions as part of a trace,
-and run those traces in tests or in a `repl` environement!
-
-While this is not a tutorial, this document should be helpful to new users to
-get accustomed to `cooked-validators` as well as old users looking to remember
-how things are done in `cooked-validators` !
-
-## Traces 
-
-### Define a trace
-
-A `mockchain` is an emulated blockchain. A trace is a sequence of instructions
-in one of our builtin monadic environement representing this `mockchain`:
+You will find here code snippets to help you use the library! Among other
+things, you will Learn how to:
+- write transactions
+- fetch information from the blockchain
+- submit these transactions for validation as part of a trace
+- run those traces in tests or in a `repl` environement!
+
+While this is not a complete tutorial, this document should be helpful to new
+users to get accustomed to `cooked-validators` as well as old users looking to
+see how things have evolved and are currently done in `cooked-validators`!
+
+- [Mockchain runs](#mockchain-runs)
+  - [Mockchains](#mockchains)
+  - [Traces](#traces)
+    - [Define a trace](#define-a-trace)
+    - [Execute the trace in a `cabal repl`](#execute-the-trace-in-a-cabal-repl)
+    - [Use the trace as part of a test](#use-the-trace-as-part-of-a-test)
+  - [Initial distributions of UTxOs](#initial-distributions-of-utxos)
+    - [Creation](#creation)
+    - [Usage](#usage)
+- [Miscellaneous mockchain capabilities](#miscellaneous-mockchain-capabilities)
+  - [Wallets](#wallets)
+  - [Aliases](#aliases)
+    - [Aliases for static data](#aliases-for-static-data)
+    - [Aliases for dynamic data](#aliases-for-dynamic-data)
+  - [Notes](#notes)
+  - [Assertions](#assertions)
+- [Basic mockchain capabilities](#basic-mockchain-capabilities)
+  - [Time handling](#time-handling)
+    - [Querrying time](#querrying-time)
+    - [Jumping in time](#jumping-in-time)
+  - [Utxos queries](#utxos-queries)
+    - [Direct queries](#direct-queries)
+    - [Searches](#searches)
+- [Transactions](#transactions)
+  - [Transaction skeletons](#transaction-skeletons)
+    - [Defining a transaction skeleton](#defining-a-transaction-skeleton)
+    - [Submitting transaction skeletons for validation](#submitting-transaction-skeletons-for-validation)
+  - [Signatories](#signatories)
+  - [Outputs](#outputs)
+  - [Redeemers](#redeemers)
+  - [Inputs](#inputs)
+  - [Minted value](#minted-value)
+  - [Reference inputs](#reference-inputs)
+  - [Balancing](#balancing)
+    - [Pick which user provides UTxOs to balance a transaction](#pick-which-user-provides-utxos-to-balance-a-transaction)
+    - [Do not automatically balance](#do-not-automatically-balance)
+  - [Collaterals](#collaterals)
+  - [Proposal procedures](#proposal-procedures)
+    - [Tamper with the official constitution script](#tamper-with-the-official-constitution-script)
+    - [Attach a Proposal Procedure to a transaction](#attach-a-proposal-procedure-to-a-transaction)
+  - [Withdrawals](#withdrawals)
+  - [Certificates](#certificates)
+- [Transaction modifications](#transaction-modifications)
+  - [Tweaks: modify transactions](#tweaks-modify-transactions)
+    - [Apply a modification](#apply-a-modification)
+    - [Add or remove inputs and outputs](#add-or-remove-inputs-and-outputs)
+    - [Modify signers](#modify-signers)
+    - [Modify skeleton (inputs, outputs, options, etc.) using lenses](#modify-skeleton-inputs-outputs-options-etc-using-lenses)
+
+# Mockchain runs
+
+## Mockchains
+
+A `mockchain` is an abstraction of the Cardano blockchain. `cooked-validators`
+provides several monadic environments to instantiate this concept:
 - `DirectMockChain`: basic capabilities of the mockchain
 - `StagedMockChain`: basic capabilities of the mockchain, with the addition of
   branching and temporal modifications. This is the go-to environement !
@@ -25,36 +74,42 @@ in one of our builtin monadic environement representing this `mockchain`:
 - `ExtendedStagedMockChain eff`: same as `StagedMockChain` with additional
   custom effects embedded in `eff`, to work in your own dedicated environement !
 
-* In a fixed mockchain:
+## Traces 
+
+### Define a trace
+
+A trace is a sequence of instructions in one of our `mockchain` instances:
+
+* In a fixed existing `mockchain` intance:
 ```haskell
 myTrace :: [Direct|Staged|Full]MockChain ()
 myTrace = do
   ...
 ```
 
-* In a mockChain extended with a single effect:
+* In a mockchain extended with a single user-defined effect:
 ```haskell
-myTrace :: ExtendedStagedMockChain FirstEff ()
+myTrace :: ExtendedStagedMockChain MyEff ()
 myTrace = do
   ...
-  actionInFirstEff
+  actionInMyEff
   ...
 ```
 
 * In a mockchain extended with several effects (using `Polysemy`'s bundle capability):
 ```haskell
-myTrace :: ExtendedStagedMockChain (Bundle '[FirstEff, SecondEff,..]) ()
+myTrace :: ExtendedStagedMockChain (Bundle '[MyFirstEff, MySecondEff,..]) ()
 myTrace = do
   ...
-  sendBundle $ actionInFirstEff
+  sendBundle $ actionInMyFirstEff
   ...
-  sendBundle $ actionInSecondEff
+  sendBundle $ actionInMySecondEff
   ...
 ```
 
-* In a direct set of capabilities:
+* In a direct set of custom or builtin effects:
 ```haskell
-myTrace :: (Members '[MockChainLog, MockChainRead, ...] effs) => Sem effs ()
+myTrace :: (Members '[MockChainLog, MockChainRead, MyFirstEff, ...] effs) => Sem effs ()
 myTrace = do
   ...
 ```
@@ -62,13 +117,21 @@ myTrace = do
 ### Execute the trace in a `cabal repl`
 
 * With a default mockchain state: 
-  `printCooked $ runMockChainDef myTrace`
+```haskell
+printCooked $ runMockChainDef myTrace
+```
 * With a custom mockchain state: 
-  `printCooked $ runMockChain myState myTrace`
+```haskell
+printCooked $ runMockChain myState myTrace
+```
 * With a custom initial list of payments (or `InitialDistribution`):
-  `printCooked $ runMockChainFromInitDist myPaymentsList myTrace`
+```haskell
+printCooked $ runMockChainFromInitDist myPaymentsList myTrace
+```
 * With a default configuration (initial state, initial list of payments, and custom function on returned value): 
-  `printCooked $ runMockChainFromConf myConf myTrace`
+```haskell
+printCooked $ runMockChainFromConf myConf myTrace
+```
 
 ### Use the trace as part of a test
 
@@ -89,8 +152,8 @@ myTrace = do
   * expectations on the failure output: `withFailureProp myFailureProp`
   * expectations on the possible error: `withErrorProp myError prop`
 * Wrap the test in a quickcheck/tasty test case:
-  * `testCooked` "myTastyTest" $ myTastyTest
-  * `testCookedQC` "myQuickCheckTest" $ myQuickCheckTest
+  * `testCooked "myTastyTest" $ myTastyTest`
+  * `testCookedQC "myQuickCheckTest" $ myQuickCheckTest`
 * Example:
 ```haskell
 testCooked $ 
@@ -102,7 +165,7 @@ testCooked $
     `withStateProp` possesses alice myAssetClass 10 -- alice possesses 10 custom tokens in the resulting state
 ```
 
-## Custom initial distributions of UTxOs
+## Initial distributions of UTxOs
 
 Initial distributions of funds are lists of payment used to populate the
 blockchain without needing a transaction.
@@ -110,31 +173,72 @@ blockchain without needing a transaction.
 ### Creation
 
 * With values only
-  ```haskell
-  initDist :: InitialDistribution
-  initDist = distributionFromList $
-	  [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
-	  , (wallet 2 , [ ada 10 ])
-	  , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
-	  ]
-  ```
-* With arbitrary payments (more details on the payments content in the dedicated section)
-  ```haskell
-  initDist :: InitialDistribution
-  initDist = 
-	[ wallet 3 `receives` Value (ada 6)
-    , fooTypedValidator `receives` Value (myToken 6) <&&> InlineDatum fooTypedDatum
-	, wallet 2 `receives` Value (ada 2) <&&> VisibleHashedDatum fooDatum
-	, wallet 1 `receives` Value (ada 10) <&&> ReferenceScript fooValidator <&&> StakingCredential cred
-	]
-  ```
+```haskell
+initDist :: InitialDistribution
+initDist = distributionFromList $
+    [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
+    , (wallet 2 , [ ada 10 ])
+    , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
+    ]
+```
+* With arbitrary payments
+```haskell
+initDist :: InitialDistribution
+initDist = 
+  [ wallet 3 `receives` Value (ada 6)
+  , fooTypedValidator `receives` Value (myToken 6) <&&> InlineDatum fooTypedDatum
+  , wallet 2 `receives` Value (ada 2) <&&> VisibleHashedDatum fooDatum
+  , wallet 1 `receives` Value (ada 10) <&&> ReferenceScript fooValidator <&&> StakingCredential cred
+  ]
+```
 ### Usage
 
-* In a test: ``testCooked "foo" $ mustSucceedTest foo `withInitDist` myInitiDist``
-* In a `repl`: `printCooked $ runMockChainFromInitDist myInitDist foo`
-* Within a trace: `forceOutputs myInitDist`
+* In a test:
+```haskell
+testCooked "foo" $ mustSucceedTest foo `withInitDist` myInitiDist
+```
+* In a `repl`:
+```haskell
+printCooked $ runMockChainFromInitDist myInitDist foo
+```
+* Within a trace:
+```haskell
+myTrace = do
+  forceOutputs myInitDist
+  ...
+```
+
+# Miscellaneous mockchain capabilities
 
-## Give human-readable aliases to hashable data (scripts, wallets, ...)
+`cooked-validators` provides various quality of life capabilities to be used
+during a mockchain run.
+
+## Wallets
+
+Wallets are dummy peers that can be used for testing purposes. There are 10
+wallets, from `wallet 1` to `wallet 10`.
+
+```haskell
+import Plutus.Script.Utils.Address qualified as Script
+import PlutusLedgerApi.V3
+
+alice :: Wallet 
+alice = wallet 1
+
+aliceAddress :: Address
+aliceAddress = Script.toAddress alice
+
+alicePKHash :: PubKeyHash 
+alicePKHash = Script.toPubKeyHash alice
+```
+
+Other wallet queries:
+* `walletSK`
+* `walletPK`
+* `walletStakingPK`
+* ...
+
+## Aliases
 
 It is possible to define aliases for everything that is hashable, for pretty
 printing/debugging purposes at the end of a run.
@@ -185,7 +289,29 @@ myTrace = do
   ...
 ```
 
-## Handling time
+## Notes 
+
+Notes correspond to user logs during a mockchain run. We can take note of...
+* Anything that can be pretty printed, alongside some pretty printing options
+  using `note`.
+* Anything that can be pretty printed, while using the current pretty options
+  for rendering using `noteP`.
+* Anything that can be pretty printed as a list, with a title, using `noteL`.
+* Anything that can be shown, using `noteW`
+* A string, using `noteS`.
+
+## Assertions
+
+Assertions can be made anywhere in a mockchain run. Assertions will be evaluated
+during the run, used for testing purposes, and displayed in the final printing
+of the mockchain run.
+
+* Named assertions: `assert`
+* Assertions with default name "Assertion": `assert'`
+
+# Basic mockchain capabilities
+
+## Time handling
 
 Time can be querried/set within a mockchain run, to account for transaction with
 specific validity interval/temporal constraints.
@@ -227,45 +353,90 @@ myTrace = do
   * wait a certain amount of ms from the first ms of the current slot: `waitNMSFromSlotLowerBound`
   * wait a certain amount of ms from the last ms of the current slot: `waitNMSFromSlotUpperBound`
 
-### Return `TxOutRef`s from transaction outputs from...
+## Utxos queries 
 
-* ... the Cardano transaction
-  ```haskell
-  endpointFoo :: MonadBlockChain m => m (Api.TxOutRef, Api.TxOutRef)
-  endpointFoo = do
-    cTx <- validateTxSkel $ txSkelTemplate { ..., ... }
-    let (txOutRef1, _) : (txOutRef2, _) : _ = utxosFromCardanoTx cTx
-    return (txOutRef1, txOutRef2)
-  ```
-* ... the returned `TxOutRef`s
-  ```haskell
-  endpointFoo :: MonadBlockChain m => m (Api.TxOutRef, Api.TxOutRef)
-  endpointFoo = do
-    txOutRef1 : txOutRef2 : _ <- validateTxSkel' $ txSkelTemplate { ..., ... }
-    return (txOutRef1, txOutRef2)
-  ```
+The mockchain state contains, among other elements, the unspent outputs, which
+can be queried/searched for. They are associated with the payments that created
+them, in the form of a `TxSkelOut`.
 
-### Resolve all or parts of a `TxOutRef` (get the corresponding `TxSkelOut` elements)
+### Direct queries
 
-* Get the full `TxSkelOut` from a `TxOutRef`
+* Retrieve all UTxOs available in the mockchain state:
 ```haskell
-foo :: MonadBlockChain m => Api.TxOutRef -> m ()
-foo txOutRef = do
-  txSkelOut <- txSkelOutByRef txOutRef
+myTrace = do
+  ...
+  knownUtxos <- allUtxos -- knownUtxos :: [(TxOutRef, TxSkelOut)]
+  ...
+```
+
+* Retrieve all UTxOs at a given address:
+```haskell
+myTrace = do
+  ...
+  aliceUtxos <- utxosAt alice -- aliceUtxos :: [(TxOutRef, TxSkelOut)]
+  ...
+```
+
+* Fetch the `TxSkelOut` associated with a `TxOutRef`:
+```haskell
+myTrace = do
+  ...
+  txSkelOut <- txSkelOutByRef myTxOutRef
   ...
 ```
 
 * Get a certain part of a `TxSkelOut` from a `TxOutRef` and an optic
 ```haskell
-foo :: MonadBlockChain m => Api.TxOutRef -> m ()
-foo txOutRef = do
+myTrace = do
+  ...
   -- A value is always present, use 'viewByRef'
-  value <- viewByRef txSkelOutValueL txOutRef
+  value <- viewByRef txSkelOutValueL myTxOutRef
   -- A datum of a given type might not be present, use 'previewByRef'
-  Just typedDatum <- previewByRef (txSkelOutDatumL % txSkelOutDatumTypedAT @MyDatumType) txOutRef
+  Just typedDatum <- previewByRef (txSkelOutDatumL % txSkelOutDatumTypedAT @MyDatumType) myTxOutRef
   ...
 ```
 
+### Searches
+
+Utxo searches are lists of UTxOs that can be manipulated conveniently. 
+
+1. Utxo searches are created using:
+  * `beginSearch` from a monadic call returning a list of UTxOs such as `allUtxos`
+  * `beginSearchP` from a pure call returning a list of UTxOs
+
+2. Some existing UTxO searches are provided builtin such as `utxosAtSearch`,
+   `allUtxosSearch` or `txSkelOutByRefSearch`.
+
+3. UTxO searches can be filtered using...
+  * a monadic predicate over a `TxSkelOut` using `ensure`
+  * a pure predicate over a `TxSkelOut` using `ensurePure`
+  * the presence, or absence of the target of an affine fold using either
+    `ensureAFoldIs` or `ensureAFoldIsn't` respectively.
+
+4. Some builtin filters are provided, such as `ensureVanillaOutputs` or
+   `ensureProperReferenceScript`.
+   
+5. UTxO searches can be refined by extracting sub-elements from the `TxSkelOut`s using...
+  * a monadic function which might fail (returning `Maybe b`), which will
+    extract `b` when it exists, or remove the output when it does not.
+  * several variants: `extractPure`, `extractAFold`, ...
+  
+6. UTxO searches are made of the targetted outputs, alongside any piece of
+   information that was extracted from them, in a type retaining way. Pieces of
+   these searches can be retrieved, using `getOutputs`, `getExtracts`, ...
+   
+7. Example:
+```haskell
+myTrace = do
+  ...
+  oRefs <- getTxOutRefs $ -- only retrieve the TxOutRef
+    utxosAtSearch alice $ -- use UTxOs at alice's address only
+	  ensureAFoldIs (txSkelOutValueL % filtered (banana 1 `Api.leq`)) -- only take UTxOs containing at least a banana
+  ...
+```
+
+# Transactions
+
 ## Transaction skeletons
 
 Transaction skeletons are abstractions over real transactions, allowing to
@@ -302,31 +473,6 @@ myTrace = do
 
 * ... ignore any returned value: `validateTxSkel_`
 
-## Wallets
-
-Wallets are dummy peers that can be used for testing purposes. There are 10
-wallets, from `wallet 1` to `wallet 10`.
-
-```haskell
-import Plutus.Script.Utils.Address qualified as Script
-import PlutusLedgerApi.V3
-
-alice :: Wallet 
-alice = wallet 1
-
-aliceAddress :: Address
-aliceAddress = Script.toAddress alice
-
-alicePKHash :: PubKeyHash 
-alicePKHash = Script.toPubKeyHash alice
-```
-
-Other wallet queries:
-* `walletSK`
-* `walletPK`
-* `walletStakingPK`
-* ...
-
 ## Signatories
 
 Transaction can be signed with one of more wallets. They will both be part of
@@ -357,7 +503,7 @@ txSkelTemplate
     }
 ```
 
-## Payments
+## Outputs
 
 * A simple value to a wallet: ```wallet 3 `receives` Value (ada 3)```
 * A value and an inline datum to a script: ```fooTypedValidator `receives` (InlineDatum FooTypedDatum <&&> Value (myToken 4 <> lovelace 160_000))```
@@ -373,6 +519,10 @@ txSkelTemplate
     }
 ```
 
+* allow min ADA adjustment, by providing a value: ```party `receives` (Value (myToken 5))```
+* allow min ADA adjustment, by providing no value: ```party `receives` (Datum myDatum)```
+* forbid min ADA adjustment: ```party `receives` (FixedValue $ ada 10) ```
+
 ## Redeemers
 
 * No redeemer, auto fill of reference script: `emptyTxSkelRedeemer`
@@ -405,7 +555,7 @@ txSkelTemplate
   }
 ```
 
-### Mint or burn tokens
+## Minted value
 
 * Mint tokens: positive amount
 * Burn tokens: negative amount
@@ -426,13 +576,7 @@ txSkelTemplate
   }
 ```
 
-### Min Ada adjustment to an output
-
-* allow min ADA adjustment, by providing a value: ```party `receives` (Value (myToken 5))```
-* allow min ADA adjustment, by providing no value: ```party `receives` (Datum myDatum)```
-* forbid min ADA adjustment: ```party `receives` (FixedValue $ ada 10) ```
-
-### Use reference inputs in a transaction
+## Reference inputs
 
 * Within redeemers automatically `myTxSkelRedeemer`
 * Within redeemers manually ``myTxSkelRedeemer `withReferenceInput` myRefInput``
@@ -447,10 +591,9 @@ txSkelTemplate
 
 ## Balancing
 
-### Choose which user provides UTxOs to balance a transaction
-
-First signatory (default):
+### Pick which user provides UTxOs to balance a transaction
 
+* First signatory (default):
 ```haskell
 txSkelTemplate
   { ...
@@ -459,8 +602,7 @@ txSkelTemplate
   }
 ```
 
-Another signatory:
-
+* Another signatory:
 ```haskell
 txSkelTemplate
   { ...
@@ -480,10 +622,9 @@ txSkelTemplate
   }
 ```
 
-## Provide collaterals
-
-From first signer (default):
+## Collaterals
 
+* From first signer (default):
 ```
 txSkelTemplate
   { ...
@@ -492,8 +633,7 @@ txSkelTemplate
   }
 ```
 
-From another wallet:
-
+* From another wallet:
 ```
 txSkelTemplate
   { ...
@@ -503,8 +643,7 @@ txSkelTemplate
   }
 ```
 
-From a direct Utxo list (make sure the owner of these utxo sign the transaction):
-
+* From a direct UTxO list (make sure the owner of these utxo sign the transaction):
 ```
 txSkelTemplate
   { ...
@@ -513,114 +652,6 @@ txSkelTemplate
   }
 ```
 
-## Search through UTxOs on the ledger
-
-### Fetch all UTxOs on the ledger
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    ...
-    -- searchResults :: [(Api.TxOutRef, TxSkelOut)]
-    searchResults <- runUtxoSearch $ allUtxos
-    ...
-```
-
-### Fetch all UTxOs belonging to a certain owner
-
-```haskell
-foo :: MonadBlockChain m => m () 
-foo = do                  
-    ...
-    -- searchResults, searchResults' :: [(Api.TxOutRef, TxSkelOut)]
-    searchResults <- runUtxoSearch $ utxosOwnedBy (wallet 2)
-	searchResults' <- runUtxoSearch $ utxosOwnerBy myValidator
-    ...
-```
-
-### Search for UTxOs satisfying a predicate
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    ...
-    searchResults <-
-      runUtxoSearch $
-        allUtxos `filterWithPred` ((== ada 10) . view txSkelOutValueL)
-    ...
-```
-
-### Search for UTxOs without datum
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    ...
-    searchResults <- runUtxoSearch $ allUtxos `filterWithPureRev` preview (txSkelOutDatumL % txSkelOutDatumContentAT)
-    ...
-```
-
-### Combine filters in a UTxOs search
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    ...
-    searchResults <-
-      runUtxoSearch $
-        utxosOwnedBy (wallet 2)
-		  `filterWithPureRev` preview (txSkelOutDatumL % txSkelOutDatumContentAT)
-          `filterWithPred` ((== ada 10) . view txSkelOutValueL)
-    ...
-```
-
-## Tweaks: modify traces and endpoints
-
-### Apply a modification
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    bar `withTweak` modification
-```
-
-### Add or remove inputs and outputs
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    bar `withTweak` ( do
-                        addOutputTweak $ bazValidator `receives` bazPayment
-                        removeOutputTweak (\(Pays out) -> somePredicate out)
-                        addInputTweak somePkTxOutRef txSkelEmptyRedeemer
-                        removeInputTweak (\txOutRef redeemer -> somePredicate txOutRef redeemer)
-                    )
-```
-
-### Modify signers
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    bar `withTweak` ( do
-                        addSignatoriesTweak [signatory1, signatory2]
-                        replaceFirstSigner signatory3
-                        removeSigners [signatory2]
-                    )
-```
-
-### Modify skeleton (inputs, outputs, options, etc.) using lenses
-
-```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    bar `withTweak` ( do
-                        C.overTweak
-                          (txSkelOutsL % ix 1 % txSkelOutValueL) -- Value of first output
-                          (<> assetClassValue bazAssetClass 10) -- Add 10 baz tokens
-                    )
-```
-
 ## Proposal procedures
 
 ### Tamper with the official constitution script
@@ -695,14 +726,14 @@ txSkelTemplate
 * Automatic withdrawal of the available rewards
 
 ```haskell 
-    txSkelTemplate
-      { txSkelWithdrawals = txSkelWithdrawalsFromList 
-	      [ scriptWithdrawal myWithdrawingScript myTxSkelRedeemer,
-		    pubKeyWithdrawal myWithdrawingPubKey,
-		    ...
-	      ]
+txSkelTemplate
+  { txSkelWithdrawals = txSkelWithdrawalsFromList 
+      [ scriptWithdrawal myWithdrawingScript myTxSkelRedeemer,
+	    pubKeyWithdrawal myWithdrawingPubKey,
 	    ...
-      }
+      ]
+    ...
+  }
 ```	
 
 * Manual withdrawal of a certain amount (for testing purposes only)
@@ -721,23 +752,70 @@ txSkelTemplate
 
 * Build certificate actions
 
-```
-	myCertificateAction = CommitteResign ...
-	myCertificateAction2 = DRepUpdate ...
-	...
+```haskell
+myCertificateAction = CommitteResign ...
+myCertificateAction2 = DRepUpdate ...
 ```
 
 * Add certificates to transactions. Make sure the kind of certificate
   corresponds to the kind of allowed user.
 
 ```haskell
-    txSkelTemplate
-      { txSkelCertificates = 
-	      [ TxSkelCertificate myUser myCertificateAction,
-		    pubKeyCertificate myPubKey myCertificateAction1,
-			scriptCertificate myScript myRedeemer myCertificateAction2
-		  ],
-        ... 
-      }
+txSkelTemplate
+  { txSkelCertificates = 
+      [ TxSkelCertificate myUser myCertificateAction,
+	    pubKeyCertificate myPubKey myCertificateAction1,
+		scriptCertificate myScript myRedeemer myCertificateAction2
+	  ],
+    ... 
+  }
+```
+
+# Transaction modifications
+
+## Tweaks: modify transactions
+
+### Apply a modification
+
+```haskell
+foo :: MonadBlockChain m => m ()
+foo = do
+    bar `withTweak` modification
+```
+
+### Add or remove inputs and outputs
+
+```haskell
+foo :: MonadBlockChain m => m ()
+foo = do
+    bar `withTweak` ( do
+                        addOutputTweak $ bazValidator `receives` bazPayment
+                        removeOutputTweak (\(Pays out) -> somePredicate out)
+                        addInputTweak somePkTxOutRef txSkelEmptyRedeemer
+                        removeInputTweak (\txOutRef redeemer -> somePredicate txOutRef redeemer)
+                    )
 ```
 
+### Modify signers
+
+```haskell
+foo :: MonadBlockChain m => m ()
+foo = do
+    bar `withTweak` ( do
+                        addSignatoriesTweak [signatory1, signatory2]
+                        replaceFirstSigner signatory3
+                        removeSigners [signatory2]
+                    )
+```
+
+### Modify skeleton (inputs, outputs, options, etc.) using lenses
+
+```haskell
+foo :: MonadBlockChain m => m ()
+foo = do
+    bar `withTweak` ( do
+                        C.overTweak
+                          (txSkelOutsL % ix 1 % txSkelOutValueL) -- Value of first output
+                          (<> assetClassValue bazAssetClass 10) -- Add 10 baz tokens
+                    )
+```

From e81c5ba4b7116dc683149d1c6c979d28bd8e3f20 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 24 Mar 2026 17:57:41 +0100
Subject: [PATCH 93/96] full table of contents

---
 doc/CHEATSHEET.md | 86 +++++++++++++++++++++++++++--------------------
 1 file changed, 49 insertions(+), 37 deletions(-)

diff --git a/doc/CHEATSHEET.md b/doc/CHEATSHEET.md
index 30aa74b28..f037e54c7 100644
--- a/doc/CHEATSHEET.md
+++ b/doc/CHEATSHEET.md
@@ -1,3 +1,5 @@
+# CHEATSHEET
+
 Welcome to `cooked-validators`' **Cheatsheet** 
 
 You will find here code snippets to help you use the library! Among other
@@ -11,6 +13,7 @@ While this is not a complete tutorial, this document should be helpful to new
 users to get accustomed to `cooked-validators` as well as old users looking to
 see how things have evolved and are currently done in `cooked-validators`!
 
+- [CHEATSHEET](#cheatsheet)
 - [Mockchain runs](#mockchain-runs)
   - [Mockchains](#mockchains)
   - [Traces](#traces)
@@ -44,21 +47,24 @@ see how things have evolved and are currently done in `cooked-validators`!
   - [Inputs](#inputs)
   - [Minted value](#minted-value)
   - [Reference inputs](#reference-inputs)
-  - [Balancing](#balancing)
-    - [Pick which user provides UTxOs to balance a transaction](#pick-which-user-provides-utxos-to-balance-a-transaction)
-    - [Do not automatically balance](#do-not-automatically-balance)
   - [Collaterals](#collaterals)
   - [Proposal procedures](#proposal-procedures)
     - [Tamper with the official constitution script](#tamper-with-the-official-constitution-script)
     - [Attach a Proposal Procedure to a transaction](#attach-a-proposal-procedure-to-a-transaction)
   - [Withdrawals](#withdrawals)
   - [Certificates](#certificates)
+  - [Balancing](#balancing)
+    - [Pick which user provides UTxOs to balance a transaction](#pick-which-user-provides-utxos-to-balance-a-transaction)
+    - [Do not automatically balance](#do-not-automatically-balance)
 - [Transaction modifications](#transaction-modifications)
   - [Tweaks: modify transactions](#tweaks-modify-transactions)
     - [Apply a modification](#apply-a-modification)
     - [Add or remove inputs and outputs](#add-or-remove-inputs-and-outputs)
     - [Modify signers](#modify-signers)
     - [Modify skeleton (inputs, outputs, options, etc.) using lenses](#modify-skeleton-inputs-outputs-options-etc-using-lenses)
+  - [Temporal modifications](#temporal-modifications)
+    - [Builtin formulas](#builtin-formulas)
+    - [Custom formulas](#custom-formulas)
 
 # Mockchain runs
 
@@ -589,39 +595,6 @@ txSkelTemplate
     }
 ```
 
-## Balancing
-
-### Pick which user provides UTxOs to balance a transaction
-
-* First signatory (default):
-```haskell
-txSkelTemplate
-  { ...
-    txSkelSignatories = [signatory1, signatory2]
-    ...
-  }
-```
-
-* Another signatory:
-```haskell
-txSkelTemplate
-  { ...
-    txSkelSignatories = [signatory1, signatory2],
-    txOpts = def {txOptBalancingPolicy = BalanceWith (wallet 2)}
-    ...
-  }
-```
-
-### Do not automatically balance
-
-```haskell
-txSkelTemplate
-  { ...
-    txOpts = def {txOptBalancingPolicy = DoNotBalance}
-    ...
-  }
-```
-
 ## Collaterals
 
 * From first signer (default):
@@ -741,7 +714,7 @@ txSkelTemplate
 ```haskell 
     txSkelTemplate
       { txSkelWithdrawals = txSkelWithdrawalsFromList 
-	      [ TxSkelWithdrawal myWithdraingPeer (Just 2_000_000),
+	      [ TxSkelWithdrawal myWithdrawingPeer (Just 2_000_000),
 		    ...
 	      ]
 	    ...
@@ -771,6 +744,39 @@ txSkelTemplate
   }
 ```
 
+## Balancing
+
+### Pick which user provides UTxOs to balance a transaction
+
+* First signatory (default):
+```haskell
+txSkelTemplate
+  { ...
+    txSkelSignatories = [signatory1, signatory2]
+    ...
+  }
+```
+
+* Another signatory:
+```haskell
+txSkelTemplate
+  { ...
+    txSkelSignatories = [signatory1, signatory2],
+    txOpts = def {txOptBalancingPolicy = BalanceWith (wallet 2)}
+    ...
+  }
+```
+
+### Do not automatically balance
+
+```haskell
+txSkelTemplate
+  { ...
+    txOpts = def {txOptBalancingPolicy = DoNotBalance}
+    ...
+  }
+```
+
 # Transaction modifications
 
 ## Tweaks: modify transactions
@@ -819,3 +825,9 @@ foo = do
                           (<> assetClassValue bazAssetClass 10) -- Add 10 baz tokens
                     )
 ```
+
+## Temporal modifications
+
+### Builtin formulas
+
+### Custom formulas

From 5fbecbfa75f5d513cd866856cab67493f7816b60 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 24 Mar 2026 18:29:58 +0100
Subject: [PATCH 94/96] finalizing cheatsheet

---
 doc/CHEATSHEET.md | 237 ++++++++++++++++++++++++++++++++++------------
 1 file changed, 179 insertions(+), 58 deletions(-)

diff --git a/doc/CHEATSHEET.md b/doc/CHEATSHEET.md
index f037e54c7..f144b31eb 100644
--- a/doc/CHEATSHEET.md
+++ b/doc/CHEATSHEET.md
@@ -43,6 +43,9 @@ see how things have evolved and are currently done in `cooked-validators`!
     - [Submitting transaction skeletons for validation](#submitting-transaction-skeletons-for-validation)
   - [Signatories](#signatories)
   - [Outputs](#outputs)
+    - [Building payments:](#building-payments)
+    - [Adjusting payments:](#adjusting-payments)
+    - [Attaching payments to transactions](#attaching-payments-to-transactions)
   - [Redeemers](#redeemers)
   - [Inputs](#inputs)
   - [Minted value](#minted-value)
@@ -56,12 +59,10 @@ see how things have evolved and are currently done in `cooked-validators`!
   - [Balancing](#balancing)
     - [Pick which user provides UTxOs to balance a transaction](#pick-which-user-provides-utxos-to-balance-a-transaction)
     - [Do not automatically balance](#do-not-automatically-balance)
-- [Transaction modifications](#transaction-modifications)
-  - [Tweaks: modify transactions](#tweaks-modify-transactions)
-    - [Apply a modification](#apply-a-modification)
-    - [Add or remove inputs and outputs](#add-or-remove-inputs-and-outputs)
-    - [Modify signers](#modify-signers)
-    - [Modify skeleton (inputs, outputs, options, etc.) using lenses](#modify-skeleton-inputs-outputs-options-etc-using-lenses)
+- [Tweaks](#tweaks)
+  - [Defining tweaks](#defining-tweaks)
+  - [Tweaks: modify single transactions](#tweaks-modify-single-transactions)
+  - [Examples](#examples)
   - [Temporal modifications](#temporal-modifications)
     - [Builtin formulas](#builtin-formulas)
     - [Custom formulas](#custom-formulas)
@@ -486,10 +487,10 @@ the required and actual signers of the transaction.
 
 ```haskell
 txSkelTemplate
-    { ...
-      txSkelSignatories = txSkelSignatoriesFromList [wallet 1, ...]
-      ...
-    }
+  { ...
+    txSkelSignatories = txSkelSignatoriesFromList [wallet 1, ...]
+    ...
+  }
 ```
 
 Transactions can also be signed by anything that has a pubkey. They will only be part of the required signatories, and a private key will be required later on.
@@ -503,34 +504,63 @@ myUser1 = ...
 myUser2 = ...
 
 txSkelTemplate
-    { ...
-      txSkelSignatories = signatoryPubKey <$> [myUser1, myUser2, ...]
-      ...
-    }
+  { ...
+    txSkelSignatories = signatoryPubKey <$> [myUser1, myUser2, ...]
+    ...
+  }
 ```
 
 ## Outputs
 
-* A simple value to a wallet: ```wallet 3 `receives` Value (ada 3)```
-* A value and an inline datum to a script: ```fooTypedValidator `receives` (InlineDatum FooTypedDatum <&&> Value (myToken 4 <> lovelace 160_000))```
-* Hashed datums (visible to the transaction or hidden from it): `... <&&> (VisibleHashedDatum dat)` or `... <&&> (HiddenHashedDatum dat)`
-* A reference script: `(... <&&> ReferenceScript dat)`
-* A staking credential: `(... <&&> StakingCredential dat)`
+### Building payments:
 
+There are several payable elements, attached to a recipient to create a payment:
+* A simple value to a wallet: 
 ```haskell
-txSkelTemplate
-    { ...
-      txSkelOuts = [party1 `receives` payment1, party2 `receives` payment2, ...]
-      ...
-    }
+wallet 3 `receives` Value (ada 3)
 ```
+* A value and an inline datum to a script:
+```haskell
+fooScript `receives` (InlineDatum FooTypedDatum <&&> Value (myToken 4 <> lovelace 160_000))
+```
+* Hashed datums (visible to the transaction or hidden from it): 
+```haskell
+... <&&> (VisibleHashedDatum dat) -- resolved in the transaction
+... <&&> (HiddenHashedDatum dat) -- unresolved in the transaction
+```
+* A reference script: 
+```haskell
+... <&&> (ReferenceScript dat)
+```
+* A staking credential:
+```haskell
+... <&&> (StakingCredential dat)`
+```
+
+### Adjusting payments:
 
+Payments can automatically be adjusted in terms of minimal ADA requirements:
 * allow min ADA adjustment, by providing a value: ```party `receives` (Value (myToken 5))```
 * allow min ADA adjustment, by providing no value: ```party `receives` (Datum myDatum)```
 * forbid min ADA adjustment: ```party `receives` (FixedValue $ ada 10) ```
 
+### Attaching payments to transactions
+
+Payments are given in the transaction using the `txSkelOuts` field:
+```haskell
+txSkelTemplate
+  { ...
+    txSkelOuts = [party1 `receives` payment1, party2 `receives` payment2, ...]
+    ...
+  }
+```
+
 ## Redeemers
 
+Redeemers are provided whenever a script is invoked, regardless of its
+purpose. `cooked-validators` will automatically fetch a proper reference inputs
+when applicable.
+
 * No redeemer, auto fill of reference script: `emptyTxSkelRedeemer`
 * No redeemer, forbid auto fill of reference script: `emptyTxSkelRedeemerNoAutoFill`
 * Some redeemer, auto fill of reference script: `someTxSkelRedeemer myRedeemer`
@@ -589,14 +619,17 @@ txSkelTemplate
 * Additional reference inputs not bound to redeemers:
 ```haskell
 txSkelTemplate
-    { ...
-      txSkelInsReference = Set.fromList [txOutRef1, txOutRef2, ...]
-      ...
-    }
+  { ...
+    txSkelInsReference = Set.fromList [txOutRef1, txOutRef2, ...]
+    ...
+  }
 ```
 
 ## Collaterals
 
+Collaterals are usually selected by `cooked-validators` automatically, but can
+also be provided manually.
+
 * From first signer (default):
 ```
 txSkelTemplate
@@ -777,57 +810,145 @@ txSkelTemplate
   }
 ```
 
-# Transaction modifications
+# Tweaks
 
-## Tweaks: modify transactions
+## Defining tweaks
 
-### Apply a modification
+Tweaks are state-aware modifications applied to transactions, which can fail. In
+a tweak, one can:
+* issue any action available in the encompassing mockchain environment
+* modify a `TxSkel` through dedicated primitives
+Tweaks cannot be used in `DirectMockChain`.
 
+Example:
 ```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    bar `withTweak` modification
+myTweak :: TypedTweak effs ()
+myTweak = do
+  myActionInEffs
+  ...
+  setTxSkel ...
+  overTweak ...
+  myOtherActionInEffs
+  ...
 ```
 
-### Add or remove inputs and outputs
+## Tweaks: modify single transactions
 
+* Apply a tweak on a given transaction
 ```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    bar `withTweak` ( do
-                        addOutputTweak $ bazValidator `receives` bazPayment
-                        removeOutputTweak (\(Pays out) -> somePredicate out)
-                        addInputTweak somePkTxOutRef txSkelEmptyRedeemer
-                        removeInputTweak (\txOutRef redeemer -> somePredicate txOutRef redeemer)
-                    )
+myTrace = do
+  ...
+  myModifiedTxSkel <- execTweak myTxSkel myTweak
+  ...
 ```
 
-### Modify signers
+* Apply a tweak on the first transaction of a trace
+```haskell
+myTrace = do
+  ...
+  withTweak myTrace myTweak
+  ...
+```
 
+* Apply a tweak on the nth transaction of a trace (0-indexed)
 ```haskell
-foo :: MonadBlockChain m => m ()
-foo = do
-    bar `withTweak` ( do
-                        addSignatoriesTweak [signatory1, signatory2]
-                        replaceFirstSigner signatory3
-                        removeSigners [signatory2]
-                    )
+myTrace = do
+  ...
+  there 3 myTrace myTweak
+  ...
 ```
 
-### Modify skeleton (inputs, outputs, options, etc.) using lenses
+## Examples
+
+* Tamper with inputs and outputs 
+```haskell
+foo = do
+  addOutputTweak $ bazValidator `receives` bazPayment
+  removeOutputTweak (\(Pays out) -> somePredicate out)
+  addInputTweak somePkTxOutRef txSkelEmptyRedeemer
+  removeInputTweak (\txOutRef redeemer -> somePredicate txOutRef redeemer)
+```
 
+* Tamper with signatories
 ```haskell
-foo :: MonadBlockChain m => m ()
 foo = do
-    bar `withTweak` ( do
-                        C.overTweak
-                          (txSkelOutsL % ix 1 % txSkelOutValueL) -- Value of first output
-                          (<> assetClassValue bazAssetClass 10) -- Add 10 baz tokens
-                    )
+   addSignatoriesTweak [signatory1, signatory2]
+   replaceFirstSigner signatory3
+   removeSigners [signatory2]
+```
+
+* Using optics in tweaks
+```haskell
+foo = C.overTweak
+  (txSkelOutsL % ix 1 % txSkelOutValueL) -- Value of first output
+  (<> assetClassValue bazAssetClass 10) -- Add 10 baz tokens
 ```
 
 ## Temporal modifications
 
+Tweaks can be deployed "on-time" using various temporal combinators inspired by
+Linear Temporal Logics formulas (LTL) in traces composed of several transactions. 
+
 ### Builtin formulas
 
+* Apply a tweak on all transactions in a trace, where it must never fail:
+```haskell
+myTrace = do
+  ...
+  everywhere myTweak myTrace
+  ...
+```
+
+* Apply a tweak whenever possible, branching for each position where it applies:
+```haskell
+myTrace = do
+  ...
+  somewhere myTweak myTrace
+  ...
+```
+
+* Apply a tweak whenever it applies, skipping transactions when it does not:
+```haskell
+myTrace = do
+  ...
+  whenAble myTweak myTrace
+  ...
+```
+
+* Apply a tweak to all transactions with a given text label:
+```haskell
+myTrace = do
+  ...
+  whenAble (labelled' myLabel myTweak) myTrace
+  ...
+```
+
+* Ensure a tweak cannot be applied in any transaction of a trace:
+```haskell
+myTrace = do
+  ...
+  never myTweak myTrace
+  ...
+```
+
 ### Custom formulas
+
+Custom LTL formulas can be used for more advanced use case. 
+
+* Wrap a tweak into an atomic LTL formula:
+```haskell
+myAtom = LtlAtom $ UntypedTweak myTweak
+```
+
+* Build an LTL formula from atomic modifications: 
+```haskell
+myFormula = myAtom1 `LtlAnd` (myAtom2 `LtlOr` (myAtom3 `ltlImplies` myAtom4))
+```
+
+* Modify a computation with the built formula:
+```haskell
+myTrace = do
+  ...
+  modifyLtl myFormula myTrace
+  ...
+```

From a2f70631223f19af512f5a5032dece6962afdf99 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Tue, 24 Mar 2026 18:30:52 +0100
Subject: [PATCH 95/96] querried

---
 doc/CHEATSHEET.md | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/doc/CHEATSHEET.md b/doc/CHEATSHEET.md
index f144b31eb..69bde7967 100644
--- a/doc/CHEATSHEET.md
+++ b/doc/CHEATSHEET.md
@@ -32,7 +32,7 @@ see how things have evolved and are currently done in `cooked-validators`!
   - [Assertions](#assertions)
 - [Basic mockchain capabilities](#basic-mockchain-capabilities)
   - [Time handling](#time-handling)
-    - [Querrying time](#querrying-time)
+    - [Querying time](#querying-time)
     - [Jumping in time](#jumping-in-time)
   - [Utxos queries](#utxos-queries)
     - [Direct queries](#direct-queries)
@@ -320,12 +320,12 @@ of the mockchain run.
 
 ## Time handling
 
-Time can be querried/set within a mockchain run, to account for transaction with
+Time can be queried/set within a mockchain run, to account for transaction with
 specific validity interval/temporal constraints.
 
-### Querrying time
+### Querying time
 
-* The current slot can be querried directly:
+* The current slot can be queried directly:
 ```haskell
 myTrace = do
   ...
@@ -333,7 +333,7 @@ myTrace = do
   ...
 ```
 
-* An interval of ms can be querried as well, deduced from the slot:
+* An interval of ms can be queried as well, deduced from the slot:
 ```haskell
 myTrace = do
   ...
@@ -341,9 +341,9 @@ myTrace = do
   ...
 ```
 
-* No single ms point can be querried, as it does not exist!
+* No single ms point can be queried, as it does not exist!
 
-* The slot containing a given ms point can be querried: `getEnclosingSlot`
+* The slot containing a given ms point can be queried: `getEnclosingSlot`
 
 ### Jumping in time
 

From 64365f80bfbeb4c4f35631800171ec93363971e2 Mon Sep 17 00:00:00 2001
From: mmontin <o.montin@gmail.com>
Date: Wed, 25 Mar 2026 11:21:39 +0100
Subject: [PATCH 96/96] fixing haddock warnings

---
 src/Cooked/MockChain/Balancing.hs |  4 +++-
 src/Cooked/Skeleton/Option.hs     | 12 ++++++------
 2 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
index 33534aa61..f49da44aa 100644
--- a/src/Cooked/MockChain/Balancing.hs
+++ b/src/Cooked/MockChain/Balancing.hs
@@ -2,7 +2,8 @@
 -- computation of fees and collaterals because their computation cannot be
 -- separated from the balancing.
 module Cooked.MockChain.Balancing
-  ( ExtendedTxSkel (..),
+  ( Body,
+    ExtendedTxSkel (..),
     balanceTxSkel,
     getMinAndMaxFee,
     estimateTxSkelFee,
@@ -46,6 +47,7 @@ import Polysemy
 import Polysemy.Error
 import Polysemy.Fail
 
+-- | A transaction body
 type Body = Cardano.TxBody Cardano.ConwayEra
 
 -- | A `TxSkel` with extra pieces of information produced during balancing
diff --git a/src/Cooked/Skeleton/Option.hs b/src/Cooked/Skeleton/Option.hs
index 61353350b..f40bf6987 100644
--- a/src/Cooked/Skeleton/Option.hs
+++ b/src/Cooked/Skeleton/Option.hs
@@ -204,15 +204,15 @@ data TxSkelOpts = TxSkelOpts
     -- early as possible, typically during balancing when the execution units
     -- are computed. This will shortcut the whole balancing process which
     -- iterates the body generation, and thus increase performances (by 40%). As
-    -- a result, the balanced `TxSkel` will never be computed and thus will be
-    -- absent from the log, which is the only downside.
+    -- a result, the balanced `Cooked.Skeleton.TxSkel` will never be computed
+    -- and thus will be absent from the log, which is the only downside.
     --
     -- When set to @True@: the phase 2 validation erros will be ignored during
     -- the balancing process. This will result in a worst performance (40%), but
-    -- will allow the log to display a balanced version of the failing `TxSkel`,
-    -- which might be useful. Only use this when debugging complicated phase 2
-    -- failures which require a precise view of the balanced `TxSkel` sent for
-    -- validation.
+    -- will allow the log to display a balanced version of the failing
+    -- `Cooked.Skeleton.TxSkel`, which might be useful. Only use this when
+    -- debugging complicated phase 2 failures which require a precise view of
+    -- the balanced `Cooked.Skeleton.TxSkel` sent for validation.
     --
     -- Default is `False`
     txSkelOptDeferPhase2FailuresDuringBalancing :: Bool,