Count epoch block txs by id and clamp block-range sampling

cardano-db-tool/src/Cardano/DbTool/Validate/BlockProperties.hs

@@ -51,16 +51,24 @@ validateBlockTimesInPast = do
     showFirst (mEpoch, mBlockNo, time) =
       mconcat ["epoch ", show mEpoch, " block ", show mBlockNo, " time ", show time]
 
+-- The random start block and how many blocks to sample, clamped so the range
+-- never underflows on a database with fewer than testBlocks blocks.
+sampleWindow :: Word64 -> Word64 -> (Word64, Word64)
+sampleWindow blkCount testBlocks =
+  let count = min testBlocks blkCount
+   in (blkCount - count, count)
+
 validataBlockNosContiguous :: Word64 -> IO ()
 validataBlockNosContiguous blkCount = do
-  startBlock <- Random.randomRIO (0, blkCount - testBlocks)
+  let (maxStart, count) = sampleWindow blkCount testBlocks
+  startBlock <- Random.randomRIO (0, maxStart)
   putStrF $
     "Block numbers ["
       ++ show startBlock
       ++ " .. "
-      ++ show (startBlock + testBlocks)
+      ++ show (startBlock + count)
       ++ "] are contiguous: "
-  blockNos <- DB.runDbStandaloneSilent $ DB.queryBlockNoList startBlock testBlocks
+  blockNos <- DB.runDbStandaloneSilent $ DB.queryBlockNoList startBlock count
   case checkContinguous blockNos of
     Nothing -> putStrLn $ greenText "ok"
     Just xs -> error $ redText "failed: " ++ show xs
@@ -79,14 +87,15 @@ validataBlockNosContiguous blkCount = do
 
 validateTimestampsOrdered :: Word64 -> IO ()
 validateTimestampsOrdered blkCount = do
-  startBlock <- Random.randomRIO (0, blkCount - testBlocks)
+  let (maxStart, count) = sampleWindow blkCount testBlocks
+  startBlock <- Random.randomRIO (0, maxStart)
   putStrF $
     "Block time stamps for blocks ["
       ++ show startBlock
       ++ " .. "
-      ++ show (startBlock + testBlocks)
+      ++ show (startBlock + count)
       ++ "] are ordered: "
-  ts <- DB.runDbStandaloneSilent $ DB.queryBlockTimestamps startBlock testBlocks
+  ts <- DB.runDbStandaloneSilent $ DB.queryBlockTimestamps startBlock count
   if List.nubOrd ts == ts
     then putStrLn $ greenText "ok"
     else error $ redText "failed: " ++ show ts

cardano-db-tool/src/Cardano/DbTool/Validate/BlockTxs.hs

@@ -51,9 +51,9 @@ validateBlockTxs epoch = do
                 ++ show (veTxCountActual ve)
             )
 
-validateBlockCount :: (Word64, Word64) -> DB.DbM (Either ValidateError ())
-validateBlockCount (blockNo, txCountExpected) = do
-  txCountActual <- DB.queryBlockTxCount $ DB.BlockId $ fromIntegral blockNo
+validateBlockCount :: (DB.BlockId, Word64, Word64) -> DB.DbM (Either ValidateError ())
+validateBlockCount (blockId, blockNo, txCountExpected) = do
+  txCountActual <- DB.queryBlockTxCount blockId
   pure $
     if txCountActual == txCountExpected
       then Right ()

cardano-db/cardano-db.cabal

@@ -152,7 +152,8 @@ test-suite test-db
   main-is:              test-db.hs
   hs-source-dirs:       test
 
-  other-modules:        Test.IO.Cardano.Db.EpochCalc
+  other-modules:        Test.IO.Cardano.Db.EpochBlockTxs
+                        Test.IO.Cardano.Db.EpochCalc
                         Test.IO.Cardano.Db.Insert
                         Test.IO.Cardano.Db.Migration
                         Test.IO.Cardano.Db.Rollback

cardano-db/src/Cardano/Db/Statement/DbTool.hs

@@ -871,7 +871,7 @@ queryOutputsAddress saId =
 
 --------------------------------------------------------------------------------
 
-queryEpochBlockNumbersStmt :: HsqlStmt.Statement Word64 [(Word64, Word64)]
+queryEpochBlockNumbersStmt :: HsqlStmt.Statement Word64 [(Id.BlockId, Word64, Word64)]
 queryEpochBlockNumbersStmt =
   HsqlStmt.Statement sql encoder decoder True
   where
@@ -880,18 +880,19 @@ queryEpochBlockNumbersStmt =
     sql =
       TextEnc.encodeUtf8 $
         Text.concat
-          [ "SELECT COALESCE(block_no, 0), tx_count"
+          [ "SELECT id, COALESCE(block_no, 0), tx_count"
           , " FROM " <> blockTableN
           , " WHERE epoch_no = $1"
           ]
 
     encoder = fromIntegral >$< HsqlE.param (HsqlE.nonNullable HsqlE.int8)
 
     decoder = HsqlD.rowList $ do
+      blockId <- Id.idDecoder Id.BlockId
       blockNo <- HsqlD.column (HsqlD.nonNullable $ fromIntegral <$> HsqlD.int8)
       txCount <- HsqlD.column (HsqlD.nonNullable $ fromIntegral <$> HsqlD.int8)
-      pure (blockNo, txCount)
+      pure (blockId, blockNo, txCount)
 
-queryEpochBlockNumbers :: Word64 -> DbM [(Word64, Word64)]
+queryEpochBlockNumbers :: Word64 -> DbM [(Id.BlockId, Word64, Word64)]
 queryEpochBlockNumbers epoch =
   runSession mkDbCallStack $ HsqlSes.statement epoch queryEpochBlockNumbersStmt

cardano-db/test/Test/IO/Cardano/Db/EpochBlockTxs.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.IO.Cardano.Db.EpochBlockTxs (
+  tests,
+) where
+
+import Cardano.Db
+import Control.Monad (void)
+import Test.IO.Cardano.Db.Util
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase)
+
+tests :: TestTree
+tests =
+  testGroup
+    "EpochBlockTxs"
+    [ testCase "epoch block tx count is looked up by block id" epochBlockTxCountUsesId
+    ]
+
+-- block_no and the surrogate block.id diverge on a real chain (an EBB has a null
+-- block_no but a positive id). The epoch block-tx check must count transactions
+-- by block.id, not by block_no, or it reads the wrong (or no) block.
+epochBlockTxCountUsesId :: IO ()
+epochBlockTxCountUsesId =
+  runDbStandaloneSilent $ do
+    deleteAllBlocks
+    slid <- insertSlotLeader testSlotLeader
+    let blk = (mkBlock 0 slid) {blockTxCount = 1}
+    bid <- insertCheckUniqueBlock blk
+    case mkTxs bid 1 of
+      (tx : _) -> void $ insertTx tx
+      [] -> error "mkTxs returned empty list"
+    rows <- queryEpochBlockNumbers 0
+    case rows of
+      [(blockId, _blockNo, expected)] -> do
+        actual <- queryBlockTxCount blockId
+        assertBool
+          ("expected tx count " ++ show expected ++ " but got " ++ show actual)
+          (actual == expected)
+      _ -> assertBool ("expected one block row, got " ++ show (length rows)) False

cardano-db/test/test-db.hs

@@ -5,6 +5,7 @@ import Data.Maybe (isNothing)
 import System.Directory (getCurrentDirectory)
 import System.Environment (lookupEnv, setEnv)
 import System.FilePath ((</>))
+import qualified Test.IO.Cardano.Db.EpochBlockTxs
 import qualified Test.IO.Cardano.Db.EpochCalc
 import qualified Test.IO.Cardano.Db.Insert
 import qualified Test.IO.Cardano.Db.Migration
@@ -26,6 +27,7 @@ main = do
     testGroup
       "Database"
       [ Test.IO.Cardano.Db.Migration.tests
+      , Test.IO.Cardano.Db.EpochBlockTxs.tests
       , Test.IO.Cardano.Db.Insert.tests
       , Test.IO.Cardano.Db.TotalSupply.tests
       , Test.IO.Cardano.Db.Rollback.tests