Merge pull request #46 from input-output-hk/erikd/corner-case

Fix a corner case in Epoch table update

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

@@ -84,13 +84,15 @@ epochPluginInsertBlock trce rawBlk _tip =
       let epochNum = epochNumber blk slotsPerEpoch
           lastCachedEpoch = fromMaybe 0 mLatestCachedEpoch
 
-      if  | epochNum == chainTipEpoch ->
+      if  | epochNum == chainTipEpoch && lastCachedEpoch == chainTipEpoch ->
               -- Following the chain quite closely.
               updateEpochNum epochNum trce
           | epochNum > 0 && mLatestCachedEpoch == Nothing ->
               updateEpochNum 0 trce
           | epochNum >= lastCachedEpoch + 2 ->
               updateEpochNum (lastCachedEpoch + 1) trce
+          | epochNum == chainTipEpoch && lastCachedEpoch < chainTipEpoch ->
+              updateEpochNum (lastCachedEpoch + 1) trce
           | otherwise ->
               pure $ Right ()
 

cardano-db/app/Cardano/Db/App/Validate/EpochTable.hs

@@ -4,41 +4,45 @@ module Cardano.Db.App.Validate.EpochTable
 
 import           Cardano.Db.App.Validate.Util
 
-import           Control.Monad (replicateM_)
+import           Control.Monad (when)
 
 import           Data.Word (Word64)
 
 import           Cardano.Db
 
-import           System.Random (randomRIO)
-
 
 -- | Validate that the total supply is decreasing.
 -- This is only true for the Byron error where transaction fees are burnt.
-validateEpochTable :: Word -> IO ()
-validateEpochTable count =
-  replicateM_ (fromIntegral count) $ do
-    mTestEpoch <- genRandomEpochNo
-    case mTestEpoch of
-      Nothing -> putStrLn "Epoch table is empty"
-      Just testEpoch -> do
-        putStrF $ "Epoch table entry for epoch " ++ show testEpoch
-                ++ " is correct: "
-        -- Recalculate the epoch entry
-        recalc <- runDbNoLogging $ queryCalcEpochEntry testEpoch
-        -- Get the table entry
-        value <- runDbNoLogging $ queryEpochEntry testEpoch
-
-        if recalc == value
-          then putStrLn $ greenText "ok"
-          else error $ redText (show recalc ++ " /= " ++ show value)
+validateEpochTable :: IO ()
+validateEpochTable =
+  maybe (putStrLn "Epoch table is empty") validate =<< getStableEpochCount
+
+validate :: Word64 -> IO ()
+validate lastEpoch = do
+    putStrF $ "Epoch table entries for epochs [0.." ++ show lastEpoch
+                ++ "] are correct: "
+    recurse 0
+  where
+    recurse :: Word64 -> IO ()
+    recurse current
+      | current > lastEpoch = putStrLn $ greenText "ok"
+      | otherwise = do
+          -- Recalculate the epoch entry
+          recalc <- runDbNoLogging $ queryCalcEpochEntry current
+          -- Get the table entry
+          value <- runDbNoLogging $ queryEpochEntry current
+
+          when (recalc /= value) .
+            error $ redText (show recalc ++ " /= " ++ show value)
+          recurse (current + 1)
 
 -- -----------------------------------------------------------------------------
 
-genRandomEpochNo :: IO (Maybe Word64)
-genRandomEpochNo = do
+getStableEpochCount :: IO (Maybe Word64)
+getStableEpochCount = do
   -- May return Nothing if the EPoch table is empty.
-  latest <- runDbNoLogging queryLatestEpochNo
-  if latest == 0
-    then pure Nothing
-    else Just <$> randomRIO (0, latest - 1)
+  mLatest <- runDbNoLogging queryLatestCachedEpochNo
+  case mLatest of
+    Nothing -> pure Nothing
+    Just 0 -> pure Nothing
+    Just latest -> pure $ Just (latest - 1)

cardano-db/app/Cardano/Db/App/Validation.hs

@@ -8,4 +8,4 @@ import           Cardano.Db.App.Validate.TotalSupply (validateTotalSupplyDecreas
 runValidation :: Word -> IO ()
 runValidation count = do
   validateTotalSupplyDecreasing count
-  validateEpochTable (10 * count)
+  validateEpochTable

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

@@ -21,6 +21,7 @@ module Cardano.Db.Query
   , queryGenesisSupply
   , queryIsFullySynced
   , queryLatestBlock
+  , queryLatestCachedEpochNo
   , queryLatestEpochNo
   , queryLatestBlockId
   , queryLatestBlockNo
@@ -321,6 +322,14 @@ queryLatestBlock = do
                 pure $ blk
   pure $ fmap entityVal (listToMaybe res)
 
+queryLatestCachedEpochNo :: MonadIO m => ReaderT SqlBackend m (Maybe Word64)
+queryLatestCachedEpochNo = do
+  res <- select . from $ \ epoch -> do
+            orderBy [desc (epoch ^. EpochNo)]
+            limit 1
+            pure (epoch ^. EpochNo)
+  pure $ unValue <$> listToMaybe res
+
 queryLatestEpochNo :: MonadIO m => ReaderT SqlBackend m Word64
 queryLatestEpochNo = do
   res <- select . from $ \ blk -> do