Expose traces for node

Author: jasagredo

ouroboros-consensus/src/ouroboros-consensus-lmdb/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/LMDB.hs

@@ -22,6 +22,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB
     LMDB
   , Backend (..)
   , Args (LMDBBackingStoreArgs)
+  , Trace (OnDiskBackingStoreInitialise, OnDiskBackingStoreTrace)
   , LMDBLimits (LMDBLimits, lmdbMapSize, lmdbMaxDatabases, lmdbMaxReaders)
   , mkLMDBArgs
 
@@ -832,7 +833,7 @@ instance
   where
   data Args m LMDB
     = LMDBBackingStoreArgs FilePath LMDBLimits (Dict.Dict MonadIOPrim m)
-  data Trace m LMDB
+  data Trace LMDB
     = OnDiskBackingStoreInitialise LMDB.Limits
     | OnDiskBackingStoreTrace BackingStoreTrace
     deriving (Eq, Show)

ouroboros-consensus/src/ouroboros-consensus-lsm/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs

@@ -25,6 +25,8 @@ module Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
     LSM
   , Backend (..)
   , Args (LSMArgs)
+  , Trace (LSMTreeTrace)
+  , LSM.LSMTreeTrace (..)
   , mkLSMArgs
   , stdMkBlockIOFS
 
@@ -571,7 +573,7 @@ instance
     }
     deriving Generic
 
-  data Trace m LSM
+  data Trace LSM
     = LSMTreeTrace !LSM.LSMTreeTrace
     deriving Show
 

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs

@@ -32,6 +32,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore
 import Cardano.Slotting.Slot
 import Control.Tracer
 import Data.Proxy
+import Data.Typeable
 import Ouroboros.Consensus.Ledger.Basics
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API
@@ -67,15 +68,15 @@ data SomeBackendArgs m l where
   SomeBackendArgs :: Backend m backend l => Args m backend -> SomeBackendArgs m l
 
 data SomeBackendTrace where
-  SomeBackendTrace :: Show (Trace m backend) => Trace m backend -> SomeBackendTrace
+  SomeBackendTrace :: (Show (Trace backend), Typeable backend) => Trace backend -> SomeBackendTrace
 
 instance Show SomeBackendTrace where
   show (SomeBackendTrace tr) = show tr
 
 class Backend m backend l where
   data Args m backend
 
-  data Trace m backend
+  data Trace backend
 
   isRightBackendForSnapshot ::
     Proxy l ->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs

@@ -360,7 +360,7 @@ instance
   Backend m Mem l
   where
   data Args m Mem = InMemArgs
-  data Trace m Mem
+  data Trace Mem
     = InMemoryBackingStoreInitialise
     | InMemoryBackingStoreTrace BackingStoreTrace
     deriving (Eq, Show)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs

@@ -23,6 +23,7 @@ import Control.Monad.Except
 import Control.ResourceRegistry
 import Control.Tracer
 import Data.Proxy
+import Data.Typeable
 import NoThunks.Class
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Ledger.Abstract
@@ -41,7 +42,7 @@ class NoThunks (Resources m backend) => Backend m backend blk where
   data Resources m backend
 
   -- | A trace dependent on the particular backend.
-  data Trace m backend
+  data Trace backend
 
   -- | Transform 'Args' into 'Resources', with some context made up of
   -- 'LedgerDbArgs'.
@@ -89,7 +90,8 @@ class NoThunks (Resources m backend) => Backend m backend blk where
 -------------------------------------------------------------------------------}
 
 data SomeBackendTrace where
-  SomeBackendTrace :: Show (Trace m backend) => Trace m backend -> SomeBackendTrace
+  SomeBackendTrace ::
+    (Show (Trace backend), Typeable backend) => Trace backend -> SomeBackendTrace
 
 instance Show SomeBackendTrace where
   show (SomeBackendTrace tr) = show tr

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs

@@ -18,6 +18,7 @@
 module Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
   ( Backend (..)
   , Args (InMemArgs)
+  , Trace (NoTrace)
   , Mem
   , YieldArgs (YieldInMemory)
   , SinkArgs (SinkInMemory)
@@ -359,7 +360,7 @@ instance
   data Args m Mem = InMemArgs
   newtype Resources m Mem = Resources (SomeHasFS m)
     deriving newtype NoThunks
-  newtype Trace m Mem = NoTrace Void
+  newtype Trace Mem = NoTrace Void
     deriving newtype Show
 
   mkResources _ _ _ _ = pure . Resources