Merge pull request IntersectMBO#1200 from input-output-hk/erikd/check-ledger-state-file-count

Add an error message when no ledger state files are found

Author: erikd

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

@@ -50,6 +50,7 @@ import           Cardano.DbSync.Util
 import           Control.Monad.Class.MonadSTM.Strict (StrictTVar, TBQueue, newTBQueueIO, newTVarIO,
                    readTVar, readTVarIO, writeTVar)
 import           Control.Monad.Trans.Maybe (MaybeT (..))
+
 import qualified Data.Strict.Maybe as Strict
 import           Data.Time.Clock (UTCTime, getCurrentTime)
 
@@ -160,12 +161,10 @@ getDbLatestBlockInfo backend = do
             }
 
 getDbTipBlockNo :: SyncEnv -> IO (Point.WithOrigin BlockNo)
-getDbTipBlockNo env = do
-  backend <- getBackend env
-  maybeTip <- getDbLatestBlockInfo backend
-  case maybeTip of
-    Just tip -> pure $ Point.At (bBlockNo tip)
-    Nothing -> pure Point.Origin
+getDbTipBlockNo env =
+  getBackend env >>=
+    getDbLatestBlockInfo <&>
+    maybe Point.Origin (Point.At . bBlockNo)
 
 logDbState :: SyncEnv -> IO ()
 logDbState env = do
@@ -245,17 +244,18 @@ mkSyncEnvFromConfig trce connSring syncOptions dir genCfg =
 
 getLatestPoints :: SyncEnv -> IO [CardanoPoint]
 getLatestPoints env = do
-    if hasLedgerState env then do
-      files <- listLedgerStateFilesOrdered $ leDir (envLedger env)
-      verifyFilePoints env files
-    else do
-      -- Brings the 5 latest.
-      dbBackend <- getBackend env
-      lastPoints <- DB.runDbIohkNoLogging dbBackend DB.queryLatestPoints
-      pure $ mapMaybe convert' lastPoints
+    if hasLedgerState env
+      then do
+        files <- listLedgerStateFilesOrdered $ leDir (envLedger env)
+        verifyFilePoints env files
+      else do
+        -- Brings the 5 latest.
+        dbBackend <- getBackend env
+        lastPoints <- DB.runDbIohkNoLogging dbBackend DB.queryLatestPoints
+        pure $ mapMaybe convert lastPoints
   where
-    convert' (Nothing, _) = Nothing
-    convert' (Just slot, bs) = convert (SlotNo slot) bs
+    convert (Nothing, _) = Nothing
+    convert (Just slot, bs) = convertToPoint (SlotNo slot) bs
 
 verifyFilePoints :: SyncEnv -> [LedgerStateFile] -> IO [CardanoPoint]
 verifyFilePoints env files =
@@ -267,11 +267,11 @@ verifyFilePoints env files =
         hashes <- getSlotHash backend (lsfSlotNo lsf)
         let valid  = find (\(_, h) -> lsfHash lsf == hashToAnnotation h) hashes
         case valid of
-          Just (slot, hash) | slot == lsfSlotNo lsf -> pure $ convert slot hash
+          Just (slot, hash) | slot == lsfSlotNo lsf -> pure $ convertToPoint slot hash
           _ -> pure Nothing
 
-convert :: SlotNo -> ByteString -> Maybe CardanoPoint
-convert slot hashBlob =
+convertToPoint :: SlotNo -> ByteString -> Maybe CardanoPoint
+convertToPoint slot hashBlob =
     Point . Point.block slot <$> convertHashBlob hashBlob
   where
     convertHashBlob :: ByteString -> Maybe (HeaderHash CardanoBlock)

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

@@ -27,6 +27,7 @@ import           Cardano.DbSync.Default
 import           Cardano.DbSync.Error
 import           Cardano.DbSync.LedgerState
 import           Cardano.DbSync.Metrics
+import           Cardano.DbSync.Rollback (rollbackToPoint)
 import           Cardano.DbSync.Types
 import           Cardano.DbSync.Util hiding (whenJust)
 
@@ -89,15 +90,15 @@ runActions env actions = do
         ([], DbFinish:_) -> do
             pure Done
         ([], DbRollBackToPoint pt resultVar : ys) -> do
-            runRollbacksDB env pt
+            newExceptT $ rollbackToPoint env pt
             points <- if hasLedgerState env
               then lift $ rollbackLedger env pt
               else pure Nothing
             blockNo <- lift $ getDbTipBlockNo env
             lift $ atomically $ putTMVar resultVar (points, blockNo)
             dbAction Continue ys
         (ys, zs) -> do
-          insertBlockList env ys
+          newExceptT $ insertListBlocks env ys
           if null zs
             then pure Continue
             else dbAction Continue zs
@@ -118,7 +119,6 @@ rollbackLedger env point = do
       Left lsfs ->
         Just <$> verifyFilePoints env lsfs
   where
-
     checkDBWithState :: CardanoPoint -> Maybe TipInfo -> IO ()
     checkDBWithState pnt dbTipInfo =
       if compareTips pnt dbTipInfo
@@ -134,22 +134,10 @@ compareTips = go
   where
     go (Point Origin) Nothing = True
     go (Point (At blk)) (Just tip) =
-         getHeaderHash (blockPointHash blk) == bHash tip
-      && blockPointSlot blk == bSlotNo tip
+        getHeaderHash (blockPointHash blk) == bHash tip
+          && blockPointSlot blk == bSlotNo tip
     go  _ _ = False
 
-runRollbacksDB
-    :: SyncEnv -> CardanoPoint
-    -> ExceptT SyncNodeError IO ()
-runRollbacksDB env point =
-  newExceptT $ rollbackToPoint env point
-
-insertBlockList
-    :: SyncEnv -> [CardanoBlock]
-    -> ExceptT SyncNodeError IO ()
-insertBlockList env blks =
-  newExceptT $ insertListBlocks env blks
-
 -- | Split the DbAction list into a prefix containing blocks to apply and a postfix.
 spanDbApply :: [DbAction] -> ([CardanoBlock], [DbAction])
 spanDbApply lst =

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

@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Cardano.DbSync.Default
   ( insertListBlocks
-  , rollbackToPoint
   ) where
 
 
@@ -29,7 +28,6 @@ import           Cardano.DbSync.Error
 import           Cardano.DbSync.LedgerState (ApplyResult (..), LedgerEvent (..),
                    applyBlockAndSnapshot, defaultApplyResult)
 import           Cardano.DbSync.LocalStateQuery
-import           Cardano.DbSync.Rollback (rollbackToPoint)
 import           Cardano.DbSync.Types
 import           Cardano.DbSync.Util
 

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

@@ -30,13 +30,13 @@ import           Cardano.Prelude hiding (Meta, Nat, option, (%))
 import           Control.Tracer (Tracer)
 
 import           Cardano.BM.Data.Tracer (ToLogObject (..), ToObject)
-import           Cardano.BM.Trace (Trace, appendName, logInfo)
+import           Cardano.BM.Trace (Trace, appendName, logError, logInfo)
 import qualified Cardano.BM.Trace as Logging
 
 import           Cardano.Client.Subscription (subscribe)
 import qualified Cardano.Crypto as Crypto
 
-import           Cardano.Slotting.Slot (EpochNo (..), WithOrigin (..))
+import           Cardano.Slotting.Slot (EpochNo (..), WithOrigin (..), withOriginToMaybe)
 
 import qualified Cardano.Db as Db
 
@@ -231,6 +231,15 @@ dbSyncProtocols trce env metricsSetters _version codecs _connectionId =
           -- threads
           latestPoints <- getLatestPoints env
           currentTip <- getCurrentTipBlockNo env
+
+          when (null latestPoints && currentTip /= Origin) $ do
+            logError trce $ mconcat
+                                [ "No ledger state files found, but current tip is "
+                                , textShow (withOriginToMaybe currentTip)
+                                ]
+            logError trce "This will require that the database is rolled back to genesis."
+            panicAbort "This is probably not what you want."
+
           logDbState env
           -- communication channel between datalayer thread and chainsync-client thread
           actionQueue <- newDbActionQueue
@@ -293,16 +302,16 @@ chainSyncClient metricsSetters trce latestPoints currentTip actionQueue = do
     clientPipelinedStIdle
         :: WithOrigin BlockNo -> [CardanoPoint]
         -> ClientPipelinedStIdle 'Z CardanoBlock (Point CardanoBlock) (Tip CardanoBlock) IO ()
-    clientPipelinedStIdle clintTip points =
+    clientPipelinedStIdle clientTip points =
       -- Notify the core node about the our latest points at which we are
       -- synchronised.  This client is not persistent and thus it just
       -- synchronises from the genesis block.  A real implementation should send
       -- a list of points up to a point which is k blocks deep.
       SendMsgFindIntersect
         (if null points then [genesisPoint] else points)
         ClientPipelinedStIntersect
-          { recvMsgIntersectFound = \ _hdr tip -> pure $ go policy Zero clintTip (getTipBlockNo tip) Nothing
-          , recvMsgIntersectNotFound = \tip -> pure $ goTip policy Zero clintTip tip Nothing
+          { recvMsgIntersectFound = \ _hdr tip -> pure $ go policy Zero clientTip (getTipBlockNo tip) Nothing
+          , recvMsgIntersectNotFound = \tip -> pure $ goTip policy Zero clientTip tip Nothing
           }
 
     policy :: MkPipelineDecision