db-sync: Improve handling of ledger state files

Ledger state file names now include the slot number and part of the
ledger state tips block hash.

This provides a more robust and trustworthy solution to the issue
433.

Closes: #433

cardano-db-sync/src/Cardano/DbSync.hs

@@ -27,7 +27,7 @@ import           Control.Tracer (Tracer)
 
 import           Cardano.BM.Data.Tracer (ToLogObject (..))
 import qualified Cardano.BM.Setup as Logging
-import           Cardano.BM.Trace (Trace, appendName, logError, logInfo, logWarning)
+import           Cardano.BM.Trace (Trace, appendName, logError, logInfo)
 import qualified Cardano.BM.Trace as Logging
 
 import qualified Cardano.Chain.Genesis as Byron
@@ -38,7 +38,6 @@ import           Cardano.Db (LogFileDir (..))
 import qualified Cardano.Db as DB
 import           Cardano.DbSync.Config
 import           Cardano.DbSync.Database
-import           Cardano.DbSync.DbAction
 import           Cardano.DbSync.Era
 import           Cardano.DbSync.Error
 import           Cardano.DbSync.LedgerState
@@ -148,6 +147,7 @@ runDbSyncNode plugin enp =
           GenesisCardano _ bCfg _sCfg -> do
             ledgerVar <- initLedgerStateVar genCfg
 
+            saveCurrentLedgerState (envLedgerStateDir genesisEnv) ledgerVar
             latestSlot <- SlotNo <$> DB.runDbNoLogging DB.queryLatestSlotNo
             deleteNewerLedgerStateFiles (envLedgerStateDir genesisEnv) latestSlot
 
@@ -383,25 +383,18 @@ chainSyncClient trce env queryVar metrics latestPoints currentTip actionQueue =
       ClientStNext
         { recvMsgRollForward = \blk tip ->
               logException trce "recvMsgRollForward: " $ do
-                if withOrigin 0 unBlockNo (getTipBlockNo tip) == 0
-                  then do
-                    -- https://github.com/input-output-hk/cardano-db-sync/issues/433
-                    liftIO $ logWarning trce "Node has not yet received blocks from the network. Sleeping for 1 minute."
-                    threadDelay (60 * 1000 * 1000)
-                  else do
-                    Gauge.set (withOrigin 0 (fromIntegral . unBlockNo) (getTipBlockNo tip)) (mNodeHeight metrics)
-                    details <- getSlotDetails trce env queryVar (cardanoBlockSlotNo blk)
-                    newSize <- atomically $ do
+                Gauge.set (withOrigin 0 (fromIntegral . unBlockNo) (getTipBlockNo tip)) (mNodeHeight metrics)
+                details <- getSlotDetails trce env queryVar (cardanoBlockSlotNo blk)
+                newSize <- atomically $ do
                                 writeDbActionQueue actionQueue $ mkDbApply blk details
                                 lengthDbActionQueue actionQueue
-                    Gauge.set (fromIntegral newSize) $ mQueuePostWrite metrics
+                Gauge.set (fromIntegral newSize) $ mQueuePostWrite metrics
                 pure $ finish (At (blockNo blk)) tip
         , recvMsgRollBackward = \point tip ->
               logException trce "recvMsgRollBackward: " $ do
                 -- This will get the current tip rather than what we roll back to
                 -- but will only be incorrect for a short time span.
-                let slot = toRollbackSlot point
-                atomically $ writeDbActionQueue actionQueue (mkDbRollback slot)
+                atomically $ writeDbActionQueue actionQueue (mkDbRollback point)
                 newTip <- getCurrentTipBlockNo
                 pure $ finish newTip tip
         }

cardano-db-sync/src/Cardano/DbSync/Database.hs

@@ -85,9 +85,9 @@ runActions trce env plugin ledgerState actions = do
       case spanDbApply xs of
         ([], DbFinish:_) -> do
             pure Done
-        ([], DbRollBackToPoint sn:ys) -> do
-            runRollbacks trce plugin sn
-            liftIO $ loadLedgerStateAtSlot (envLedgerStateDir env) ledgerState sn
+        ([], DbRollBackToPoint pt:ys) -> do
+            runRollbacks trce plugin (dbpSlot pt)
+            liftIO $ loadLedgerStateAtPoint (envLedgerStateDir env) ledgerState pt
             dbAction Continue ys
         (ys, zs) -> do
           insertBlockList trce env ledgerState plugin ys

cardano-db-sync/src/Cardano/DbSync/DbAction.hs

@@ -1,58 +1,62 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.DbSync.DbAction
   ( DbAction (..)
+  , DbPoint (..)
   , DbActionQueue (..)
   , blockingFlushDbActionQueue
   , lengthDbActionQueue
   , mkDbApply
   , mkDbRollback
   , newDbActionQueue
-  , toRollbackSlot
   , writeDbActionQueue
   ) where
 
 import           Cardano.Prelude
 
 import           Cardano.DbSync.Types
-import           Cardano.Slotting.Slot (SlotNo (..), withOrigin)
+import           Cardano.Slotting.Slot (SlotNo (..), WithOrigin (..))
 
 import qualified Control.Concurrent.STM as STM
 import           Control.Concurrent.STM.TBQueue (TBQueue)
 import qualified Control.Concurrent.STM.TBQueue as TBQ
 
-import           Ouroboros.Network.Block (Point (..), pointSlot)
+import           Ouroboros.Consensus.Block.Abstract (ConvertRawHash (..))
 
+import           Ouroboros.Network.Block (Point (..))
+import           Ouroboros.Network.Point (Block (..), blockPointHash)
 
 data DbAction
   = DbApplyBlock !BlockDetails
-  | DbRollBackToPoint !SlotNo
+  | DbRollBackToPoint !DbPoint
   | DbFinish
 
+-- Define a db-sync specific Point type because the one in ouroborous-network
+-- is parameterised over era which makes it a huge pain in the neck to use.
+data DbPoint = DbPoint
+  { dbpSlot :: !SlotNo
+  , dbpHash :: !ByteString
+  }
 
 newtype DbActionQueue = DbActionQueue
   { dbActQueue :: TBQueue DbAction
   }
 
-
 mkDbApply :: CardanoBlock -> SlotDetails -> DbAction
 mkDbApply cblk details =
   DbApplyBlock (BlockDetails cblk details)
 
-mkDbRollback :: SlotNo -> DbAction
-mkDbRollback = DbRollBackToPoint
-
-
--- The Point data type is probably really convenient in the libraries where it is defined
--- and used but is a huge pain in the neck here in db-sync.
--- A Point contains a SlotNo and a hash, but the hashes on Byron and Shelley are different
--- and its an incredible pain in the neck extracting the hash in a way that works for
--- Byron, Shelley and Cardano/HFC. Since the hash was only used for the log message anyway
--- its easier to just drop it.
-toRollbackSlot :: Point blk -> SlotNo
-toRollbackSlot = withOrigin (SlotNo 0) identity . pointSlot
+mkDbRollback :: Point CardanoBlock -> DbAction
+mkDbRollback pt =
+  case getPoint pt of
+    Origin -> DbRollBackToPoint $ DbPoint (SlotNo 0) "genesis"
+    At blk -> DbRollBackToPoint $
+                DbPoint
+                  (blockPointSlot blk)
+                  (toRawHash (Proxy @CardanoBlock) $ blockPointHash blk)
 
 lengthDbActionQueue :: DbActionQueue -> STM Natural
 lengthDbActionQueue (DbActionQueue q) = STM.lengthTBQueue q