diff --git a/hydra-node/test/Hydra/Model.hs b/hydra-node/test/Hydra/Model.hs
index a15776e6f74..f114324689e 100644
--- a/hydra-node/test/Hydra/Model.hs
+++ b/hydra-node/test/Hydra/Model.hs
@@ -191,7 +191,12 @@ instance StateModel WorldState where
           [ (5, genCommit pendingCommits)
           , (1, genAbort)
           ]
-      Open{} -> genNewTx
+      Open{} -> do
+        -- FIXME: Generation of arbitrary NewTx disabled as we don't control
+        -- rollbacks in the MockChain and the hydra-node purges L2 state when
+        -- rolling back "past open".
+        void genNewTx
+        pure $ Error "NewTx disabled because of rollbacks past open"
       _ -> fmap Some genSeed
    where
     genCommit pending = do
@@ -587,16 +592,7 @@ performNewTx party tx = do
   nodes <- gets nodes
   let thisNode = nodes ! party
 
-  let waitForOpen = do
-        outs <- lift $ serverOutputs thisNode
-        -- TODO refactor with headIsOpen
-        let matchHeadIsOpen = \case
-              HeadIsOpen{} -> True
-              _ -> False
-        case find matchHeadIsOpen outs of
-          Nothing -> lift (threadDelay 0.1) >> waitForOpen
-          Just{} -> pure ()
-  waitForOpen
+  waitForOpen thisNode
 
   (i, o) <-
     lift (waitForUTxOToSpend mempty (from tx) (value tx) thisNode) >>= \case
@@ -618,6 +614,31 @@ performNewTx party tx = do
       err@TxInvalid{} -> error ("expected tx to be valid: " <> show err)
       _ -> False
 
+-- | Wait for the head to be open. Search from the beginning of history and make
+-- sure there is no RolledBack after the last HeadIsOpen. Wait and retry forever
+-- otherwise.
+waitForOpen :: MonadDelay m => TestHydraNode tx m -> RunMonad m ()
+waitForOpen node = do
+  outs <- lift $ serverOutputs node
+  go outs
+ where
+  go = \case
+    [] -> waitAndRetry
+    (x : xs) -> case x of
+      HeadIsOpen{}
+        | not $ containsRolledBack xs -> found
+      _ -> go xs
+
+  containsRolledBack = any matchRolledBack
+
+  found = pure ()
+
+  waitAndRetry = lift (threadDelay 0.1) >> waitForOpen node
+
+  matchRolledBack = \case
+    RolledBack{} -> True
+    _ -> False
+
 sendsInput :: (MonadSTM m, MonadThrow m) => Party -> ClientInput Tx -> RunMonad m ()
 sendsInput party command = do
   nodes <- gets nodes
diff --git a/hydra-node/test/Hydra/Model/MockChain.hs b/hydra-node/test/Hydra/Model/MockChain.hs
index f91fc905d10..3345dc25ac8 100644
--- a/hydra-node/test/Hydra/Model/MockChain.hs
+++ b/hydra-node/test/Hydra/Model/MockChain.hs
@@ -175,19 +175,16 @@ mockChainAndNetwork tr seedKeys nodes cp = do
         atomically $ writeTVar chain (slotNum, position + 1, blocks)
       Nothing ->
         pure ()
-  sendRollBackward chain nbBlocks =
-    if False --inhibiting the rollback until we can support it in the code
-      then do
-        (slotNum, position, blocks) <- atomically $ readTVar chain
-        case Seq.lookup (position - nbBlocks) blocks of
-          Just block -> do
-            allHandlers <- fmap chainHandler <$> readTVarIO nodes
-            let point = blockPoint block
-            forM_ allHandlers (`onRollBackward` point)
-            atomically $ writeTVar chain (slotNum, position - nbBlocks + 1, blocks)
-          Nothing ->
-            pure ()
-      else pure ()
+  sendRollBackward chain nbBlocks = do
+    (slotNum, position, blocks) <- atomically $ readTVar chain
+    case Seq.lookup (position - nbBlocks) blocks of
+      Just block -> do
+        allHandlers <- fmap chainHandler <$> readTVarIO nodes
+        let point = blockPoint block
+        forM_ allHandlers (`onRollBackward` point)
+        atomically $ writeTVar chain (slotNum, position - nbBlocks + 1, blocks)
+      Nothing ->
+        pure ()
 
   addNewBlockToChain chain transactions =
     atomically $ modifyTVar chain $ \(slotNum, position, blocks) -> appendToChain (mkBlock transactions (fromIntegral $ slotNum + blockTime) (fromIntegral position)) (slotNum + blockTime, position, blocks)