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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] =?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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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 []