Extract tracers used in tests into Test.Util.Tracer

ouroboros-consensus/ouroboros-consensus.cabal

@@ -324,6 +324,7 @@ test-suite test-storage
                     Test.Util.RefEnv
                     Test.Util.TestBlock
                     Test.Util.TestTx
+                    Test.Util.Tracer
   build-depends:    base,
                     cardano-crypto-class,
                     ouroboros-network,

ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/Iterator.hs

@@ -42,6 +42,7 @@ import qualified Ouroboros.Storage.ImmutableDB as ImmDB
 import qualified Ouroboros.Storage.Util.ErrorHandling as EH
 import qualified Ouroboros.Storage.VolatileDB as VolDB
 
+import           Test.Util.Tracer (recordingTracerTVar)
 
 import           Test.Ouroboros.Storage.ChainDB.TestBlock
 import qualified Test.Ouroboros.Storage.ImmutableDB.Mock as ImmDB (openDBMock)
@@ -219,7 +220,7 @@ runIterator
   -> StreamTo   TestBlock
   -> ([TraceIteratorEvent TestBlock], IterRes)
 runIterator setup from to = runSimOrThrow $ do
-    (tracer, getTrace) <- recordTrace
+    (tracer, getTrace) <- recordingTracerTVar
     itEnv <- initIteratorEnv setup tracer
     res <- runExceptT $ do
       it <- ExceptT $ newIterator itEnv ($ itEnv) from to
@@ -239,12 +240,6 @@ runIterator setup from to = runSimOrThrow $ do
         iteratorClose it
         return []
 
-recordTrace :: MonadSTM m => m (Tracer m ev, m [ev])
-recordTrace = newTVarM [] >>= \ref -> return
-    ( Tracer $ \ev -> atomically $ modifyTVar' ref (ev:)
-    , atomically $ reverse <$> readTVar ref
-    )
-
 {-------------------------------------------------------------------------------
   Setting up a mock IteratorEnv
 -------------------------------------------------------------------------------}

ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs

@@ -33,7 +33,6 @@ import           Data.Bifunctor
 import qualified Data.Bifunctor.TH as TH
 import           Data.Bitraversable
 import           Data.Functor.Classes (Eq1, Show1)
-import           Data.IORef
 import           Data.List (sortOn)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
@@ -103,7 +102,7 @@ import           Test.Ouroboros.Storage.Util ((=:=))
 
 import           Test.Util.RefEnv (RefEnv)
 import qualified Test.Util.RefEnv as RE
-
+import           Test.Util.Tracer (recordingTracerIORef)
 
 {-------------------------------------------------------------------------------
   Abstract model
@@ -1008,12 +1007,6 @@ internalUnused = error "ChainDB.Internal used during command generation"
 smUnused :: StateMachine (Model Blk IO) (At Cmd Blk IO) IO (At Resp Blk IO)
 smUnused = sm dbUnused internalUnused genBlk testCfg testInitLedger
 
-recordTrace :: IO (Tracer IO ev, IO [ev])
-recordTrace = newIORef [] >>= \ref -> return
-    ( Tracer $ \ev -> atomicModifyIORef' ref $ \evs -> (ev:evs, ())
-    , reverse <$> readIORef ref
-    )
-
 prop_sequential :: Property
 prop_sequential = forAllCommands smUnused Nothing $ \cmds -> QC.monadicIO $ do
     (hist, prop) <- test cmds
@@ -1026,7 +1019,7 @@ prop_sequential = forAllCommands smUnused Nothing $ \cmds -> QC.monadicIO $ do
             , Property
             )
     test cmds = do
-      (tracer, getTrace) <- QC.run recordTrace
+      (tracer, getTrace) <- QC.run recordingTracerIORef
       registry           <- QC.run $ atomically ThreadRegistry.new
       args               <- QC.run $ mkArgs
                                        testCfg

ouroboros-consensus/test-util/Test/Util/Tracer.hs

@@ -0,0 +1,29 @@
+module Test.Util.Tracer
+  ( recordingTracerIORef
+  , recordingTracerTVar
+  ) where
+
+import           Data.IORef
+
+import           Control.Monad.Class.MonadSTM
+
+import           Control.Tracer
+
+
+-- | Create a 'Tracer' that stores all events in an 'IORef' that is atomically
+-- updated. The second return value lets you obtain the events recorded so far
+-- (from oldest to newest). Obtaining the events does not erase them.
+recordingTracerIORef :: IO (Tracer IO ev, IO [ev])
+recordingTracerIORef = newIORef [] >>= \ref -> return
+    ( Tracer $ \ev -> atomicModifyIORef' ref $ \evs -> (ev:evs, ())
+    , reverse <$> readIORef ref
+    )
+
+-- | Create a 'Tracer' that stores all events in a 'TVar' that is atomically
+-- updated. The second return value lets you obtain the events recorded so far
+-- (from oldest to newest). Obtaining the events does not erase them.
+recordingTracerTVar :: MonadSTM m => m (Tracer m ev, m [ev])
+recordingTracerTVar = newTVarM [] >>= \ref -> return
+    ( Tracer $ \ev -> atomically $ modifyTVar' ref (ev:)
+    , atomically $ reverse <$> readTVar ref
+    )