db-sync: Log an error if excessive rollback is required on startup

Since version 6.0.0, db-sync has two data stores; PostgreSQL and a
snapshot of ledger state stored on disk. There are a couple of
potential problems with this:
* If the 'db-sync' software version changes, the ledger state written by
  the old version may not be readable by the new version.
* If the ledger state is missing (eg accidentally deleted).

In both of these cases 'db-sync' will try to rollback the database to
block zero. Unfortunately, the current version of the Haskell/Persistent
library is unable to do fast efficient rollbacks, and rolling back from
mainnet tip to block zero is likely to take several days.

This commit logs an error message when the rollback is likely to be
slow. It does not halt the rollback, just logs the following error:

   Rollback block count is high and therefore rollback is likley to be incredibly
   slow. Dropping the database and resyncing from scratch will be faster.

It is up to the operator to drop the database and restart.

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

@@ -264,10 +264,10 @@ logDbState :: Trace IO Text -> IO ()
 logDbState trce = do
     mblk <- DB.runDbNoLogging DB.queryLatestBlock
     case mblk of
-      Nothing -> logInfo trce "Cardano.Db is empty"
+      Nothing -> logInfo trce "Database is empty"
       Just block ->
-          logInfo trce $ Text.concat
-                  [ "Cardano.Db tip is at "
+          logInfo trce $ mconcat
+                  [ "Database tip is at "
                   , Text.pack (showTip block)
                   ]
   where

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

@@ -7,7 +7,7 @@ module Cardano.DbSync.Rollback
 
 import           Cardano.Prelude
 
-import           Cardano.BM.Trace (Trace, logInfo)
+import           Cardano.BM.Trace (Trace, logError, logInfo)
 
 import qualified Cardano.Db as DB
 import           Cardano.DbSync.Error
@@ -33,6 +33,13 @@ rollbackToSlot trce slotNo =
               [ "Rolling back to slot ", textShow (unSlotNo slotNo), ", hash "
               , maybe (if unSlotNo slotNo == 0 then "genesis" else "unknown") renderByteArray mHash
               ]
+        count <- lift $ DB.queryBlocksAfterSlot (unSlotNo slotNo)
+        when (count > 50000) .
+          liftIO . logError trce $
+            mconcat
+              [ "Rollback block count is high and therefore rollback is likely to be incredibly slow. "
+              , "Dropping the database and resyncing from scratch will be faster."
+              ]
         xs <- lift $ DB.querySlotNosGreaterThan (unSlotNo slotNo)
         liftIO . logInfo trce $
             mconcat

cardano-db/src/Cardano/Db/Query.hs

@@ -11,6 +11,7 @@ module Cardano.Db.Query
   , queryBlockNo
   , queryMainBlock
   , queryBlockTxCount
+  , queryBlocksAfterSlot
   , queryCalcEpochEntry
   , queryCheckPoints
   , queryDepositUpToBlockNo
@@ -157,6 +158,13 @@ queryBlockTxCount blkId = do
             pure countRows
   pure $ maybe 0 unValue (listToMaybe res)
 
+queryBlocksAfterSlot :: MonadIO m => Word64 -> ReaderT SqlBackend m Int
+queryBlocksAfterSlot slotNo = do
+  res <- select . from $ \ blk -> do
+            where_ (blk ^. BlockSlotNo >. just (val slotNo))
+            pure countRows
+  pure $ maybe 0 unValue (listToMaybe res)
+
 -- | Calculate the Epoch table entry for the specified epoch.
 -- When syncing the chain or filling an empty table, this is called at each epoch boundary to
 -- calculate the Epcoh entry for the last epoch.