Update and improve validation

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

@@ -10,6 +10,7 @@ import           Data.Time.Clock (UTCTime)
 
 import           Cardano.Db
 
+import           Data.ByteString.Char8 (ByteString)
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 import           Data.Text (Text)
@@ -21,13 +22,7 @@ import           System.IO (IOMode (..), withFile)
 
 utxoSetAtSlot :: Word64 -> IO ()
 utxoSetAtSlot slotNo = do
-  (genesisSupply, utxoSet, fees, eUtcTime) <-
-        -- Run the following queries in a single transaction.
-        runDbNoLogging $ do
-            (,,,) <$> queryGenesisSupply
-                    <*> queryUtxoAtSlotNo slotNo
-                    <*> queryFeesUpToSlotNo slotNo
-                    <*> querySlotUtcTime slotNo
+  (genesisSupply, utxoSet, fees, eUtcTime) <- queryAtSlot slotNo
 
   let supply = utxoSetSum utxoSet
   let aggregated = aggregateUtxos utxoSet
@@ -88,6 +83,15 @@ partitionUtxos =
     accept (addr, _) =
       Text.length addr <= 180 && not (isRedeemTextAddress addr)
 
+queryAtSlot :: Word64 -> IO (Ada, [(TxOut, ByteString)], Ada, Either LookupFail UTCTime)
+queryAtSlot slotNo =
+  -- Run the following queries in a single transaction.
+  runDbNoLogging $ do
+    (,,,) <$> queryGenesisSupply
+            <*> queryUtxoAtSlotNo slotNo
+            <*> queryFeesUpToSlotNo slotNo
+             <*> querySlotUtcTime slotNo
+
 reportSlotDate :: Word64 -> Either a UTCTime -> IO ()
 reportSlotDate slotNo eUtcTime = do
   case eUtcTime of

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

@@ -19,7 +19,7 @@ import           Database.Persist.Sql (SqlBackend)
 
 validateAllPoolsHaveOwners :: IO ()
 validateAllPoolsHaveOwners = do
-  putStrF $ "All pools have owners :"
+  putStrF $ "All pools have owners : "
   count <- runDbNoLogging queryPoolsWithoutOwners
   if count == 0
     then putStrLn $ greenText "ok"
@@ -28,7 +28,7 @@ validateAllPoolsHaveOwners = do
 -- -----------------------------------------------------------------------------
 
 -- select * from pool_hash
---  where not exists (select * from pool_owner where pool_owner.pool_id = pool_hash.id) ;
+--  where not exists (select * from pool_owner where pool_owner.pool_hash_id = pool_hash.id) ;
 
 queryPoolsWithoutOwners :: MonadIO m => ReaderT SqlBackend m Int
 queryPoolsWithoutOwners = do

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE StrictData #-}
 module Cardano.Db.App.Validate.TotalSupply
   ( validateTotalSupplyDecreasing
   ) where
@@ -17,30 +18,28 @@ validateTotalSupplyDecreasing :: IO ()
 validateTotalSupplyDecreasing = do
     test <- genTestParameters
 
-    putStrF $ "Total supply + fees + deposit at block " ++ show (testFirstBlockNo test)
+    putStrF $ "Total supply + fees + deposit - withdrawals at block " ++ show (testBlockNo test)
             ++ " is same as genesis supply: "
-    (fee1, depost1, supply1)
-                    <- runDbNoLogging $ do
-                        (,,) <$> queryFeesUpToBlockNo (testFirstBlockNo test)
-                              <*> queryDepositUpToBlockNo (testFirstBlockNo test)
-                              <*> fmap2 utxoSetSum queryUtxoAtBlockNo (testFirstBlockNo test)
-    if genesisSupply test == supply1 + fee1 + depost1
-      then putStrLn $ greenText "ok"
-      else error $ redText (show (genesisSupply test) ++ " /= " ++ show (supply1 + fee1 + depost1))
 
-    putStrF $ "Validate total supply decreasing from block " ++ show (testFirstBlockNo test)
-            ++ " to block " ++ show (testSecondBlockNo test) ++ ": "
+    accounting <- queryInitialSupply (testBlockNo test)
+
+    let total = accSupply accounting + accFees accounting + accDeposit accounting - accWithdrawals accounting
 
-    supply2 <- runDbNoLogging $ fmap2 utxoSetSum queryUtxoAtBlockNo (testSecondBlockNo test)
-    if supply1 >= supply2
+    if genesisSupply test == total
       then putStrLn $ greenText "ok"
-      else error $ redText (show supply1 ++ " < " ++ show supply2)
+      else error $ redText (show (genesisSupply test) ++ " /= " ++ show total)
 
 -- -----------------------------------------------------------------------------
 
+data Accounting = Accounting
+  { accFees :: Ada
+  , accDeposit :: Ada
+  , accWithdrawals :: Ada
+  , accSupply :: Ada
+  }
+
 data TestParams = TestParams
-  { testFirstBlockNo :: Word64
-  , testSecondBlockNo :: Word64
+  { testBlockNo :: Word64
   , genesisSupply :: Ada
   }
 
@@ -49,8 +48,18 @@ genTestParameters = do
   mlatest <- runDbNoLogging queryLatestBlockNo
   case mlatest of
     Nothing -> error "Cardano.Db.App.Validation: Empty database"
-    Just latest -> do
-      block1 <- randomRIO (1, latest - 1)
-      TestParams block1
-          <$> randomRIO (block1, latest)
+    Just latest ->
+      TestParams
+          <$> randomRIO (1, latest - 1)
           <*> runDbNoLogging queryGenesisSupply
+
+
+queryInitialSupply :: Word64 -> IO Accounting
+queryInitialSupply blkNo =
+  -- Run all queries in a single transaction.
+  runDbNoLogging $
+    Accounting
+      <$> queryFeesUpToBlockNo blkNo
+      <*> queryDepositUpToBlockNo blkNo
+      <*> queryWithdrawalsUpToBlockNo blkNo
+      <*> fmap2 utxoSetSum queryUtxoAtBlockNo blkNo

cardano-db/cardano-db.cabal

@@ -103,6 +103,7 @@ executable cardano-db-tool
                         Cardano.Db.App.Validate.Util
 
   build-depends:        base                            >= 4.12         && < 4.13
+                      , bytestring
                       , ansi-terminal
                       , cardano-db
                       , cardano-ledger

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

@@ -43,6 +43,7 @@ module Cardano.Db.Query
   , queryTxOutValue
   , queryUtxoAtBlockNo
   , queryUtxoAtSlotNo
+  , queryWithdrawalsUpToBlockNo
 
   , entityPair
   , isFullySynced
@@ -231,15 +232,13 @@ queryCheckPoints limitCount = do
         else [ end, end - 2 .. 1 ]
 
 queryDepositUpToBlockNo :: MonadIO m => Word64 -> ReaderT SqlBackend m Ada
-queryDepositUpToBlockNo slotNo = do
+queryDepositUpToBlockNo blkNo = do
   res <- select . from $ \ (tx `InnerJoin` blk) -> do
             on (tx ^. TxBlock ==. blk ^. BlockId)
-            where_ (isJust $ blk ^. BlockSlotNo)
-            where_ (blk ^. BlockSlotNo <=. just (val slotNo))
+            where_ (blk ^. BlockBlockNo <=. just (val blkNo))
             pure $ sum_ (tx ^. TxDeposit)
   pure $ unValueSumAda (listToMaybe res)
 
-
 queryEpochEntry :: MonadIO m => Word64 -> ReaderT SqlBackend m (Either LookupFail Epoch)
 queryEpochEntry epochNum = do
     res <- select . from $ \ epoch -> do
@@ -261,7 +260,6 @@ queryFeesUpToBlockNo :: MonadIO m => Word64 -> ReaderT SqlBackend m Ada
 queryFeesUpToBlockNo blkNo = do
   res <- select . from $ \ (tx `InnerJoin` blk) -> do
             on (tx ^. TxBlock ==. blk ^. BlockId)
-            where_ (isJust $ blk ^. BlockBlockNo)
             where_ (blk ^. BlockBlockNo <=. just (val blkNo))
             pure $ sum_ (tx ^. TxFee)
   pure $ unValueSumAda (listToMaybe res)
@@ -488,6 +486,15 @@ queryUtxoAtSlotNo slotNo = do
                 pure (blk ^. BlockId)
   maybe (pure []) queryUtxoAtBlockId $ fmap unValue (listToMaybe eblkId)
 
+queryWithdrawalsUpToBlockNo :: MonadIO m => Word64 -> ReaderT SqlBackend m Ada
+queryWithdrawalsUpToBlockNo blkNo = do
+  res <- select . from $ \ (tx `InnerJoin` blk `InnerJoin` withDraw) -> do
+            on (tx ^. TxId ==. withDraw ^. WithdrawalTxId)
+            on (tx ^. TxBlock ==. blk ^. BlockId)
+            where_ (blk ^. BlockBlockNo <=. just (val blkNo))
+            pure $ sum_ (withDraw ^. WithdrawalAmount)
+  pure $ unValueSumAda (listToMaybe res)
+
 -- -----------------------------------------------------------------------------
 -- SqlQuery predicates