diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal
index 8a923a85c93..81c65b6ef57 100644
--- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal
+++ b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal
@@ -69,11 +69,12 @@ library
     , delta-types
     , fingertree
     , io-classes
-    , microlens
+    , lens
     , monoidal-containers
     , mtl
     , mwc-random
     , OddWord
+    , operational
     , random
     , text
     , time
@@ -94,6 +95,9 @@ library
     Cardano.Wallet.Deposit.Pure.Submissions
     Cardano.Wallet.Deposit.Pure.UTxO
     Cardano.Wallet.Deposit.Read
+    Cardano.Wallet.Deposit.Testing.DSL
+    Cardano.Wallet.Deposit.Testing.DSL.ByTime
+    Cardano.Wallet.Deposit.Testing.DSL.Types
     Cardano.Wallet.Deposit.Time
     Cardano.Wallet.Deposit.Write
 
@@ -113,7 +117,7 @@ test-suite scenario
     , contra-tracer
     , customer-deposit-wallet
     , delta-store
-    , hspec                      >=2.8.2
+    , hspec
 
   other-modules:
     Test.Scenario.Blockchain
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Map.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Map.hs
index 1e5f3e1c478..a7bb9c3612c 100644
--- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Map.hs
+++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Map.hs
@@ -46,6 +46,7 @@ module Cardano.Wallet.Deposit.Map
       -- * Modification
     , onMap
     , onFinger
+    , Peel
     )
 where
 
@@ -298,3 +299,8 @@ onFinger
     -> (TimedSeq k (Map ks a) -> TimedSeq k (Map ks a))
     -> Map (F w k : ks) a
 onFinger (Finger w m) f = Finger w $ f m
+
+type family Peel x where
+    Peel (Map (W w k : xs) v) =  Map xs v
+    Peel (Map (F w k : xs) v) =  Map xs v
+    Peel (Map '[] v) = v
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs
index b11e134a2ad..99a0e440f99 100644
--- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs
+++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/Balance.hs
@@ -34,7 +34,9 @@ import Cardano.Wallet.Deposit.Read
     , TxId
     )
 import Cardano.Wallet.Read
-    ( getTxId, IsEra, Block
+    ( Block
+    , IsEra
+    , getTxId
     )
 import Control.Monad
     ( guard
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL.hs
new file mode 100644
index 00000000000..fa537619e1e
--- /dev/null
+++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Wallet.Deposit.Testing.DSL where
+
+import Prelude
+
+import Cardano.Wallet.Deposit.Pure
+    ( Customer
+    , WalletState
+    )
+import Cardano.Wallet.Deposit.Pure.API.TxHistory
+    ( ByTime
+    )
+import Cardano.Wallet.Deposit.Read
+    ( Address
+    )
+import Cardano.Wallet.Deposit.Testing.DSL.ByTime
+    ( ByTimeM
+    , at
+    , deposited
+    , forCustomer
+    , inTx
+    , newTimes
+    , withdrawn
+    )
+import Cardano.Wallet.Deposit.Testing.DSL.Types
+    ( BlockI (..)
+    , TxI (..)
+    , UnspentI (..)
+    )
+import Cardano.Wallet.Deposit.Write
+    ( TxBody
+    , addTxIn
+    , addTxOut
+    , emptyTxBody
+    , mkAda
+    , mkTx
+    , mkTxOut
+    )
+import Cardano.Wallet.Read
+    ( Slot
+    , WithOrigin (At, Origin)
+    , getTxId
+    , pattern TxIn
+    )
+import Control.Lens
+    ( _2
+    , zoom
+    )
+import Control.Monad
+    ( (>=>)
+    )
+import Control.Monad.Operational
+    ( ProgramT
+    , ProgramViewT (..)
+    , singleton
+    , viewT
+    )
+import Control.Monad.State
+    ( MonadState (..)
+    , MonadTrans (..)
+    , StateT
+    , execStateT
+    )
+import Data.Map
+    ( Map
+    )
+import Data.Time
+    ( UTCTime
+    )
+
+import qualified Data.Map as Map
+
+data Scenario p a where
+    ExistsTx :: Scenario p TxI
+    Deposit :: TxI -> Customer -> Int -> Scenario p UnspentI
+    Withdrawal :: TxI -> UnspentI -> Scenario p ()
+    CreateBlock :: Slot -> [TxI] -> Scenario p BlockI
+    RollForward :: [BlockI] -> Scenario p ()
+    RollBackward :: Slot -> Scenario p ()
+    HistoryByTime :: Scenario p ByTime
+    NewHistoryByTime :: ByTimeM m ByTime -> Scenario p ByTime
+    Assert :: p -> Scenario p ()
+
+type ScenarioP p m = ProgramT (Scenario p) m
+
+existsTx :: ScenarioP p m TxI
+existsTx = singleton ExistsTx
+
+deposit :: TxI -> Customer -> Int -> ScenarioP p m UnspentI
+deposit tx customer value = singleton (Deposit tx customer value)
+
+withdrawal :: TxI -> UnspentI -> ScenarioP p m ()
+withdrawal tx unspent = singleton (Withdrawal tx unspent)
+
+block :: Slot -> [TxI] -> ScenarioP p m BlockI
+block slot txs = singleton (CreateBlock slot txs)
+
+rollForward :: [BlockI] -> ScenarioP p m ()
+rollForward blocks = singleton (RollForward blocks)
+
+rollBackward :: Slot -> ScenarioP p m ()
+rollBackward slot = singleton (RollBackward slot)
+
+historyByTime :: ScenarioP p m ByTime
+historyByTime = singleton HistoryByTime
+
+newHistoryByTime :: ByTimeM m ByTime -> ScenarioP p m ByTime
+newHistoryByTime = singleton . NewHistoryByTime
+
+assert :: p -> ScenarioP p m ()
+assert = singleton . Assert
+
+example
+    :: Monad m
+    => (forall a . Eq a => a -> a -> p)
+    -> ProgramT (Scenario p) m ()
+example assertEq = do
+    h0 <- historyByTime
+    h0' <- newHistoryByTime $ pure mempty
+    assert $ assertEq h0 h0'
+    tx1 <- existsTx
+    unspent1 <- deposit tx1 1 100
+    _ <- deposit tx1 2 200
+    b1 <- block Origin [tx1]
+    tx2 <- existsTx
+    _ <- deposit tx2 1 200
+    withdrawal tx2 unspent1
+    b2 <- block (At 1) [tx2]
+    rollForward [b1, b2]
+    h1 <- historyByTime
+    h1' <- newHistoryByTime $ newTimes $ do
+        at Origin $ do
+            forCustomer 1 $ do
+                inTx tx1 $ deposited 100
+            forCustomer 2 $ do
+                inTx tx1 $ deposited 200
+        at (At 1) $ do
+            forCustomer 1 $ do
+                inTx tx2 $ do
+                    deposited 200
+                    withdrawn 100
+    assert $ assertEq h1 h1'
+    rollBackward (At 1)
+    rollForward [b2]
+    h2 <- historyByTime
+    assert $ assertEq h1 h2
+
+newTxId :: Monad m => StateT (Map TxI TxBody) m TxI
+newTxId = do
+    txs <- get
+    let TxI z = fst $ Map.findMax txs
+        txId = TxI (z + 1)
+    put $ Map.insert txId emptyTxBody txs
+    return txId
+
+interpret
+    :: Monad m
+    => (Customer -> Address)
+    -> (Slot -> WithOrigin UTCTime)
+    -> ScenarioP
+        p
+        (StateT (WalletState, Map TxI TxBody) m)
+        ()
+    -> StateT WalletState m ()
+interpret customerAddresses _slotTimes p = do
+    walletState <- get
+    (walletState', _) <- lift $ execStateT (go p) (walletState, mempty)
+    put walletState'
+  where
+    go = viewT >=> eval
+    -- eval :: Monad m => ProgramViewT (ScenarioP p m) m a -> m a
+    eval (Return x) = return x
+    eval (ExistsTx :>>= k) = do
+        txId <- zoom _2 newTxId
+        go $ k txId
+    eval (Deposit tx customer value :>>= k) = do
+        let v = mkAda $ fromIntegral value
+            txOut = mkTxOut (customerAddresses customer) v
+        (w, txs) <- get
+        let txBody = txs Map.! tx
+            (txBody', ix) = addTxOut txOut txBody
+        put (w, Map.insert tx txBody' txs)
+
+        go $ k $ UnspentI (tx, ix)
+    eval (Withdrawal tx (UnspentI (tx', ix)) :>>= k) = do
+        (w, txs) <- get
+        let txInBody = txs Map.! tx'
+            txId = getTxId $ mkTx txInBody
+        let txBody = txs Map.! tx
+            txIn = TxIn (txId) ix
+            txBody' = addTxIn txIn txBody
+        put (w, Map.insert tx txBody' txs)
+        go $ k ()
+    -- eval (CreateBlock slot txs :>>= k) = do
+    --     (w, txs) <- get
+    --     let txs' = Map.restrictKeys txs (Map.fromList txs)
+    --     put (w, txs')
+    --     go $ k $ BlockI slot
+    eval _ = error "Not implemented"
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL/ByTime.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL/ByTime.hs
new file mode 100644
index 00000000000..9beba479f48
--- /dev/null
+++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL/ByTime.hs
@@ -0,0 +1,218 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Wallet.Deposit.Testing.DSL.ByTime where
+
+import Prelude
+
+import Cardano.Wallet.Deposit.Map
+    ( Map (Map, Value)
+    , W
+    , toFinger
+    )
+import Cardano.Wallet.Deposit.Pure
+    ( Customer
+    , ValueTransfer (received, spent)
+    )
+import Cardano.Wallet.Deposit.Pure.API.TxHistory
+    ( ByTime
+    , DownTime
+    , firstJust
+    )
+import Cardano.Wallet.Deposit.Read
+    ( Address
+    )
+import Cardano.Wallet.Deposit.Testing.DSL.Types
+    ( TxI
+    )
+import Cardano.Wallet.Deposit.Write
+    ( mkAda
+    )
+import Cardano.Wallet.Read
+    ( Slot
+    , TxId
+    , WithOrigin (..)
+    )
+import Control.Monad.Reader
+    ( MonadReader (..)
+    , ReaderT (..)
+    , asks
+    , withReaderT
+    )
+import Control.Monad.State
+    ( StateT
+    , execStateT
+    , modify'
+    )
+import Control.Monad.Trans
+    ( MonadTrans (..)
+    )
+import Data.Map.Monoidal.Strict
+    ( MonoidalMap
+    )
+import Data.Monoid
+    ( First
+    )
+import Data.Ord
+    ( Down (..)
+    )
+import Data.Time
+    ( UTCTime
+    )
+
+import qualified Data.Map.Monoidal.Strict as MonoidalMap
+
+-- -------------------------------------------------------------------------------
+-- -- AtTime
+-- -------------------------------------------------------------------------------
+
+type ByTimeM =
+    ReaderT
+        ( (TxI -> TxId, Customer -> Address)
+        , Slot -> WithOrigin UTCTime
+        )
+
+at
+    :: Monad m
+    => Slot
+    -> StateT
+        (MonoidalMap Customer (Map '[W (First Address) TxId] ValueTransfer))
+        (ReaderT (TxI -> TxId, Customer -> Address) m)
+        ()
+    -> StateT
+        ( MonoidalMap
+            DownTime
+            (Map '[W (First Slot) Customer, W (First Address) TxId] ValueTransfer)
+        )
+        (ByTimeM m)
+        ()
+at t v = do
+    timeOf <- asks snd
+    txs <- lift $ withReaderT fst $ newCustomers t v
+    modify' $ MonoidalMap.insert (Down $ timeOf t) txs
+
+newTimes
+    :: Monad m
+    => StateT
+        ( MonoidalMap
+            DownTime
+            (Map '[W (First Slot) Customer, W (First Address) TxId] ValueTransfer)
+        )
+        (ByTimeM m)
+        ()
+    -> ByTimeM m ByTime
+newTimes v = toFinger . Map () <$> execStateT v mempty
+
+-- -------------------------------------------------------------------------------
+-- -- Customer
+-- -------------------------------------------------------------------------------
+
+forCustomer
+    :: Monad m
+    => Customer
+    -> StateT
+        (MonoidalMap TxId (Map '[] ValueTransfer))
+        (ReaderT (TxI -> TxId) m)
+        ()
+    -> StateT
+        (MonoidalMap Customer (Map '[W (First Address) TxId] ValueTransfer))
+        (ReaderT (TxI -> TxId, Customer -> Address) m)
+        ()
+forCustomer c v = do
+    addrOf <- asks snd
+    txs <- lift $ withReaderT fst $ newTxIds (addrOf c) v
+    modify' $ MonoidalMap.insert c txs
+
+newCustomers
+    :: Monad m
+    => Slot
+    -> StateT
+        (MonoidalMap Customer (Map '[W (First Address) TxId] ValueTransfer))
+        (ReaderT (TxI -> TxId, Customer -> Address) m)
+        ()
+    -> ReaderT
+        (TxI -> TxId, Customer -> Address)
+        m
+        (Map '[W (First Slot) Customer, W (First Address) TxId] ValueTransfer)
+newCustomers slot v = Map (firstJust slot) <$> execStateT v mempty
+
+-------------------------------------------------------------------------------
+-- Tx
+-------------------------------------------------------------------------------
+
+inTx
+    :: Monad m
+    => TxI
+    -> StateT ValueTransfer m ()
+    -> StateT
+        (MonoidalMap TxId (Map '[] ValueTransfer))
+        (ReaderT (TxI -> TxId) m)
+        ()
+inTx tx v = do
+    w <- lift . lift $ newValueTransferP v
+    txIdOf <- ask
+    modify' $ MonoidalMap.insert (txIdOf tx) w
+
+newTxIds
+    :: Monad m
+    => Address
+    -> StateT
+        (MonoidalMap TxId (Map '[] ValueTransfer))
+        (ReaderT (TxI -> TxId) m)
+        ()
+    -> ReaderT (TxI -> TxId) m (Map '[W (First Address) TxId] ValueTransfer)
+newTxIds addr v = Map (firstJust addr) <$> execStateT v mempty
+
+-------------------------------------------------------------------------------
+-- Value transfer
+-------------------------------------------------------------------------------
+
+deposited :: Monad m => Int -> StateT ValueTransfer m ()
+deposited n = modify' $ \s -> s{received = mkAda $ fromIntegral n}
+
+withdrawn :: Monad m => Int -> StateT ValueTransfer m ()
+withdrawn n = modify' $ \s -> s{spent = mkAda $ fromIntegral n}
+
+newValueTransferP
+    :: forall m
+     . Monad m
+    => StateT ValueTransfer m ()
+    -> m (Map '[] ValueTransfer)
+newValueTransferP v = Value <$> execStateT v mempty
+
+-------------------------------------------------------------------------------
+-- Example
+-------------------------------------------------------------------------------
+-- >>> ex (TxI 1) (TxI 2)
+-- No instance for `Show
+--                    (ReaderT
+--                       ((TxI -> TxId, Customer -> Address), WithOrigin UTCTime -> Slot)
+--                       m0_aCM2Y[tau:0]
+--                       ByTime)'
+--   arising from a use of `evalPrint'
+-- In a stmt of an interactive GHCi command: evalPrint it_aCM0w
+ex
+    :: Monad m
+    => TxI
+    -> TxI
+    -> ( ByTimeM
+            m
+            ByTime
+       )
+ex tx1 tx2 = newTimes $ do
+    at Origin $ do
+        forCustomer 1 $ do
+            inTx tx1 $ do
+                deposited 1
+        forCustomer 2 $ do
+            inTx tx1 $ do
+                deposited 1
+                withdrawn 2
+    at (At 1) $ do
+        forCustomer 1 $ do
+            inTx tx2 $ do
+                withdrawn 1
+            inTx tx2 $ do
+                deposited 1
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL/Types.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL/Types.hs
new file mode 100644
index 00000000000..da92b7ce845
--- /dev/null
+++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL/Types.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Wallet.Deposit.Testing.DSL.Types where
+
+import Prelude
+
+import Cardano.Wallet.Deposit.Read
+    ( Ix
+    )
+
+newtype TxI = TxI Int
+    deriving (Eq, Ord, Show)
+
+newtype UnspentI = UnspentI (TxI, Ix)
+    deriving (Eq, Ord, Show)
+
+newtype BlockI = BlockI Int
+    deriving (Eq, Ord, Show)
+
+newtype TimeI = TimeI Int
+    deriving (Eq, Ord, Show)
diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs
index 77f1717a918..f6d6ed92e17 100644
--- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs
+++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+
 -- | Indirection module that re-exports types
 -- used for writing transactions to the blockchain,
 -- in the most recent and the next future eras.
@@ -6,9 +10,7 @@
 module Cardano.Wallet.Deposit.Write
     ( -- * Basic types
       Address
-
     , Value
-
     , TxId
     , Tx
     , mkTx
@@ -16,7 +18,7 @@ module Cardano.Wallet.Deposit.Write
     , TxIn
     , TxOut
 
-    -- * Transaction balancing
+      -- * Transaction balancing
     , Write.IsRecentEra
     , Write.Conway
     , L.PParams
@@ -32,12 +34,16 @@ module Cardano.Wallet.Deposit.Write
     , Write.ErrBalanceTx (..)
     , Write.balanceTx
 
-    -- ** Time interpreter
+      -- ** Time interpreter
     , Write.TimeTranslation
-    -- * Helper functions
+
+      -- * Helper functions
     , mkAda
     , mkTxOut
     , toConwayTx
+    , emptyTxBody
+    , addTxOut
+    , addTxIn
     ) where
 
 import Prelude
@@ -56,6 +62,13 @@ import Cardano.Wallet.Deposit.Read
 import Cardano.Wallet.Read.Tx
     ( toConwayOutput
     )
+import Control.Lens
+    ( Lens'
+    , lens
+    , makeLenses
+    , (&)
+    , (.~)
+    )
 import Data.Map
     ( Map
     )
@@ -70,10 +83,6 @@ import Data.Sequence.Strict
 import Data.Set
     ( Set
     )
-import Lens.Micro
-    ( (&)
-    , (.~)
-    )
 
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.Api.Tx.In as L
@@ -96,6 +105,26 @@ data TxBody = TxBody
     }
     deriving (Show)
 
+txOutsL :: Lens' TxBody (Map Ix TxOut)
+txOutsL = lens txouts (\s a -> s { txouts = a })
+
+makeLenses ''TxBody
+
+nextIx :: TxBody -> Ix
+nextIx = maybe minBound (succ . fst) . Map.lookupMax . txouts
+
+addTxOut :: TxOut -> TxBody -> (TxBody, Ix)
+addTxOut txout txbody = (txBody', txIx)
+    where
+        txBody' = txbody & txOutsL .~ Map.insert txIx txout (txouts txbody)
+        txIx = nextIx txbody
+
+addTxIn :: TxIn -> TxBody -> TxBody
+addTxIn txin txbody = txbody { spendInputs = Set.insert txin (spendInputs txbody) }
+
+emptyTxBody :: TxBody
+emptyTxBody = TxBody mempty mempty mempty Nothing
+
 mkAda :: Integer -> Value
 mkAda = Read.injectCoin . Read.CoinC
 
@@ -116,9 +145,9 @@ mkTx txbody = Read.Tx $ L.mkBasicTx txBody
                 .~ Set.map toLedgerTxIn (collInputs txbody)
                 )
             & (L.outputsTxBodyL .~ toLedgerTxOuts (txouts txbody))
-            & (L.collateralReturnTxBodyL
-                .~ toLedgerMaybeTxOut (collRet txbody)
-                )
+            & ( L.collateralReturnTxBodyL
+                    .~ toLedgerMaybeTxOut (collRet txbody)
+              )
 
 toLedgerTxIn :: TxIn -> L.TxIn L.StandardCrypto
 toLedgerTxIn = id