Merge #911

911: Small improvements requested by Duncan r=dcoutts a=mrBliss This will require a change in `cardano-node`: https://github.com/input-output-hk/cardano-node/blob/24e3feec29ec4f124e8184e9151657d86a04dc59/app/Tracers.hs#L87 Co-authored-by: Thomas Winant <[email protected]>
IntersectMBO · Aug 9, 2019 · ae57f8d · ae57f8d
2 parents 26a3d58 + 433b4c5
commit ae57f8d
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 2 deletions.
diff --git a/ouroboros-consensus/src/Ouroboros/Storage/Common.hs b/ouroboros-consensus/src/Ouroboros/Storage/Common.hs
@@ -28,6 +28,8 @@ import           GHC.Generics
 
 import           Ouroboros.Network.Block (Point, genesisPoint)
 
+import           Ouroboros.Consensus.Util.Condense
+
 {-------------------------------------------------------------------------------
   Epochs
 -------------------------------------------------------------------------------}
@@ -54,6 +56,10 @@ type SlotOffset = Word64
 data Tip r = Tip r | TipGen
   deriving (Show, Eq, Generic)
 
+instance Condense r => Condense (Tip r) where
+  condense TipGen  = "genesis"
+  condense (Tip r) = condense r
+
 tipIsGenesis :: Tip r -> Bool
 tipIsGenesis TipGen  = True
 tipIsGenesis (Tip _) = False

diff --git a/ouroboros-consensus/src/Ouroboros/Storage/LedgerDB/OnDisk.hs b/ouroboros-consensus/src/Ouroboros/Storage/LedgerDB/OnDisk.hs
@@ -194,7 +194,7 @@ initLedgerDB replayTracer tracer hasFS decLedger decRef policy conf streamAPI =
         case ml of
           Left err -> do
             deleteSnapshot hasFS s
-            traceWith tracer $ InvalidSnapshot err
+            traceWith tracer $ InvalidSnapshot s err
             tryNewestFirst (acc . InitFailure s err) ss
           Right (r, l) ->
             return (acc (InitFromSnapshot s r), l)
@@ -366,7 +366,7 @@ snapshotFromPath = fmap DiskSnapshot . readMaybe
 -------------------------------------------------------------------------------}
 
 data TraceEvent r
-  = InvalidSnapshot (InitFailure r)
+  = InvalidSnapshot DiskSnapshot (InitFailure r)
     -- ^ An on disk snapshot was skipped because it was invalid.
   | TookSnapshot DiskSnapshot (Tip r)
     -- ^ A snapshot was written to disk.