2118-epoch out_sum/fees corruption from numeric decoders

Author: Cmdv

cardano-db/cardano-db.cabal

@@ -143,6 +143,7 @@ test-suite test
                       , cardano-ledger-core
                       , cardano-ledger-mary
                       , hedgehog
+                      , scientific
                       , wide-word
 
 test-suite test-db
@@ -151,7 +152,8 @@ test-suite test-db
   main-is:              test-db.hs
   hs-source-dirs:       test
 
-  other-modules:        Test.IO.Cardano.Db.Insert
+  other-modules:        Test.IO.Cardano.Db.EpochCalc
+                        Test.IO.Cardano.Db.Insert
                         Test.IO.Cardano.Db.Migration
                         Test.IO.Cardano.Db.Rollback
                         Test.IO.Cardano.Db.TotalSupply
@@ -179,6 +181,7 @@ test-suite test-db
                       , tasty-hunit
                       , text
                       , time
+                      , wide-word
 
 -- test-suite schema-rollback
 --   default-language:     Haskell2010

cardano-db/src/Cardano/Db/Schema/Core/Base.hs

@@ -247,6 +247,12 @@ instance DbInfo TxIn where
     , ("redeemer_id", "bigint[]")
     ]
 
+entityTxInDecoder :: D.Row (Entity TxIn)
+entityTxInDecoder =
+  Entity
+    <$> idDecoder TxInId
+    <*> txInDecoder
+
 txInDecoder :: D.Row TxIn
 txInDecoder =
   TxIn
@@ -621,6 +627,12 @@ data Withdrawal = Withdrawal
 type instance Key Withdrawal = WithdrawalId
 instance DbInfo Withdrawal
 
+entityWithdrawalDecoder :: D.Row (Entity Withdrawal)
+entityWithdrawalDecoder =
+  Entity
+    <$> idDecoder WithdrawalId
+    <*> withdrawalDecoder
+
 withdrawalDecoder :: D.Row Withdrawal
 withdrawalDecoder =
   Withdrawal

cardano-db/src/Cardano/Db/Schema/Core/EpochAndProtocol.hs

@@ -70,6 +70,12 @@ type instance Key Epoch = EpochId
 instance DbInfo Epoch where
   uniqueFields _ = ["no"]
 
+entityEpochDecoder :: D.Row (Entity Epoch)
+entityEpochDecoder =
+  Entity
+    <$> idDecoder EpochId
+    <*> epochDecoder
+
 epochDecoder :: D.Row Epoch
 epochDecoder =
   Epoch

cardano-db/src/Cardano/Db/Schema/Core/StakeDelegation.hs

@@ -16,7 +16,7 @@ import Hasql.Encoders as E
 import Cardano.Db.Schema.Ids
 import Cardano.Db.Schema.Types (textDecoder)
 import Cardano.Db.Statement.Function.Core (bulkEncoder)
-import Cardano.Db.Statement.Types (DbInfo (..), Key)
+import Cardano.Db.Statement.Types (DbInfo (..), Entity (..), Key)
 import Cardano.Db.Types (
   DbLovelace (..),
   RewardSource,
@@ -45,6 +45,12 @@ type instance Key StakeAddress = StakeAddressId
 instance DbInfo StakeAddress where
   uniqueFields _ = ["hash_raw"]
 
+entityStakeAddressDecoder :: D.Row (Entity StakeAddress)
+entityStakeAddressDecoder =
+  Entity
+    <$> idDecoder StakeAddressId
+    <*> stakeAddressDecoder
+
 stakeAddressDecoder :: D.Row StakeAddress
 stakeAddressDecoder =
   StakeAddress
@@ -142,6 +148,12 @@ data Delegation = Delegation
 type instance Key Delegation = DelegationId
 instance DbInfo Delegation
 
+entityDelegationDecoder :: D.Row (Entity Delegation)
+entityDelegationDecoder =
+  Entity
+    <$> idDecoder DelegationId
+    <*> delegationDecoder
+
 delegationDecoder :: D.Row Delegation
 delegationDecoder =
   Delegation

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

@@ -1414,7 +1414,7 @@ queryTxInRedeemerStmt =
           , " FROM " <> tableN
           , " WHERE redeemer_id IS NOT NULL"
           ]
-    decoder = HsqlD.rowList SCB.txInDecoder
+    decoder = HsqlD.rowList (entityVal <$> SCB.entityTxInDecoder)
 
 queryTxInRedeemer :: HasCallStack => DbM [SCB.TxIn]
 queryTxInRedeemer =
@@ -1438,7 +1438,7 @@ queryTxInFailedTxStmt =
           , " ON tx_in.tx_in_id = tx.id"
           , " WHERE tx.valid_contract = FALSE"
           ]
-    decoder = HsqlD.rowList SCB.txInDecoder
+    decoder = HsqlD.rowList (entityVal <$> SCB.entityTxInDecoder)
 
 queryTxInFailedTx :: HasCallStack => DbM [SCB.TxIn]
 queryTxInFailedTx = runSession mkDbCallStack $ HsqlSes.statement () queryTxInFailedTxStmt
@@ -1469,7 +1469,7 @@ queryWithdrawalScriptStmt =
           , " FROM " <> tableN
           , " WHERE redeemer_id IS NOT NULL"
           ]
-    decoder = HsqlD.rowList SCB.withdrawalDecoder
+    decoder = HsqlD.rowList (entityVal <$> SCB.entityWithdrawalDecoder)
 
 queryWithdrawalScript :: HasCallStack => DbM [SCB.Withdrawal]
 queryWithdrawalScript = runSession mkDbCallStack $ HsqlSes.statement () queryWithdrawalScriptStmt

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

@@ -32,7 +32,7 @@ import qualified Cardano.Db.Schema.Variants.TxOutCore as SVC
 import Cardano.Db.Statement.Function.Core (runSession, runSessionEntity)
 import Cardano.Db.Statement.Function.Query (countAll, countWhere, parameterisedCountWhere)
 import Cardano.Db.Statement.Types (DbInfo (..), Entity (..), tableName)
-import Cardano.Db.Types (Ada, DbM, RewardSource, rewardSourceDecoder, word64ToAda)
+import Cardano.Db.Types (Ada, DbM, RewardSource, rewardSourceDecoder, scientificToWord64, word64ToAda)
 
 queryEpochParamWithEpochNoStmt :: HsqlStmt.Statement Word64 (Maybe (Entity SCE.EpochParam))
 queryEpochParamWithEpochNoStmt =
@@ -311,7 +311,7 @@ queryTreasuryDonationsStmt =
           , " FROM " <> txTableN
           ]
 
-    decoder = HsqlD.singleRow (HsqlD.column $ HsqlD.nonNullable $ fromIntegral <$> HsqlD.int8)
+    decoder = HsqlD.singleRow (HsqlD.column $ HsqlD.nonNullable $ scientificToWord64 <$> HsqlD.numeric)
 
 queryTreasuryDonations :: DbM Word64
 queryTreasuryDonations =
@@ -477,7 +477,7 @@ queryTxFeeDepositStmt =
           ]
     encoder = fromIntegral >$< HsqlE.param (HsqlE.nonNullable HsqlE.int8)
     decoder = HsqlD.rowMaybe $ do
-      fee <- HsqlD.column (HsqlD.nonNullable $ fromIntegral <$> HsqlD.int8)
+      fee <- HsqlD.column (HsqlD.nonNullable $ scientificToWord64 <$> HsqlD.numeric)
       deposit <- HsqlD.column (HsqlD.nullable HsqlD.int8)
       pure (word64ToAda fee, fromMaybe 0 deposit)
 
@@ -618,7 +618,7 @@ queryTxWithdrawalStmt =
 
     encoder = fromIntegral >$< HsqlE.param (HsqlE.nonNullable HsqlE.int8)
     decoder = HsqlD.singleRow $ do
-      amount <- HsqlD.column (HsqlD.nonNullable $ fromIntegral <$> HsqlD.int8)
+      amount <- HsqlD.column (HsqlD.nonNullable $ scientificToWord64 <$> HsqlD.numeric)
       pure $ word64ToAda amount
 
 -- | It is probably not possible to have two withdrawals in a single Tx.

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

@@ -9,7 +9,6 @@ import Data.Functor.Contravariant ((>$<))
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as TextEnc
 import Data.Time (UTCTime)
-import Data.WideWord (Word128 (..))
 import qualified Hasql.Decoders as HsqlD
 import qualified Hasql.Encoders as HsqlE
 import qualified Hasql.Session as HsqlSes
@@ -23,7 +22,7 @@ import Cardano.Db.Statement.Function.Core (ResultType (..), runSession, runSessi
 import Cardano.Db.Statement.Function.Insert (insert, insertCheckUnique, insertReplace)
 import Cardano.Db.Statement.Function.Query (countAll, replace, selectByFieldFirst)
 import Cardano.Db.Statement.Types (Entity (..), tableName)
-import Cardano.Db.Types (DbLovelace (..), DbM)
+import Cardano.Db.Types (DbLovelace (..), DbM, scientificToWord128, scientificToWord64)
 
 --------------------------------------------------------------------------------
 -- CostModel
@@ -129,7 +128,7 @@ queryEpochEntryStmt =
   HsqlStmt.Statement sql encoder decoder True
   where
     encoder = HsqlE.param (HsqlE.nonNullable $ fromIntegral >$< HsqlE.int8)
-    decoder = HsqlD.rowMaybe SEnP.epochDecoder
+    decoder = HsqlD.rowMaybe (entityVal <$> SEnP.entityEpochDecoder)
     sql =
       TextEnc.encodeUtf8 $
         Text.concat
@@ -185,8 +184,8 @@ queryCalcEpochEntryStmt =
       blockCount <- HsqlD.column (HsqlD.nonNullable $ fromIntegral <$> HsqlD.int8)
       minTime <- HsqlD.column (HsqlD.nullable utcTimeAsTimestampDecoder)
       maxTime <- HsqlD.column (HsqlD.nullable utcTimeAsTimestampDecoder)
-      outSum <- HsqlD.column (HsqlD.nonNullable HsqlD.int8) -- Decode as single int8
-      feeSum <- HsqlD.column (HsqlD.nonNullable HsqlD.int8)
+      outSum <- HsqlD.column (HsqlD.nonNullable (scientificToWord128 <$> HsqlD.numeric))
+      feeSum <- HsqlD.column (HsqlD.nonNullable (scientificToWord64 <$> HsqlD.numeric))
       txCount <- HsqlD.column (HsqlD.nonNullable $ fromIntegral <$> HsqlD.int8)
 
       pure $ case (blockCount, minTime, maxTime) of
@@ -196,8 +195,8 @@ queryCalcEpochEntryStmt =
             then convertBlk epochNo (blockCount, Just start, Just end)
             else
               SEnP.Epoch
-                { SEnP.epochOutSum = Word128 0 (fromIntegral outSum) -- Construct Word128 from single value
-                , SEnP.epochFees = DbLovelace $ fromIntegral feeSum
+                { SEnP.epochOutSum = outSum
+                , SEnP.epochFees = DbLovelace feeSum
                 , SEnP.epochTxCount = txCount
                 , SEnP.epochBlkCount = blockCount
                 , SEnP.epochNo = epochNo
@@ -269,7 +268,7 @@ queryLatestEpochStmt =
           , " WHERE no = (SELECT MAX(no) FROM epoch)"
           ]
 
-    decoder = HsqlD.rowMaybe SEnP.epochDecoder
+    decoder = HsqlD.rowMaybe (entityVal <$> SEnP.entityEpochDecoder)
 
 -- | Get the most recent epoch in the Epoch DB table.
 queryLatestEpoch :: DbM (Maybe SEnP.Epoch)

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

@@ -253,16 +253,14 @@ queryStatementCacheSize :: HasCallStack => DbM Int
 queryStatementCacheSize =
   runSession mkDbCallStack $ HsqlSes.statement () queryStatementCacheStmt
 
--- Decoder for Ada amounts from database int8 values
 adaDecoder :: HsqlD.Row Ada
 adaDecoder = do
   amount <- HsqlD.column (HsqlD.nonNullable HsqlD.int8)
   pure $ lovelaceToAda (fromIntegral amount)
 
--- Decoder for summed Ada amounts with null handling
 adaSumDecoder :: HsqlD.Row Ada
 adaSumDecoder = do
-  amount <- HsqlD.column (HsqlD.nullable HsqlD.int8)
+  amount <- HsqlD.column (HsqlD.nullable HsqlD.numeric)
   case amount of
-    Just value -> pure $ lovelaceToAda (fromIntegral value)
+    Just value -> pure $ lovelaceToAda (floor value)
     Nothing -> pure $ Ada 0

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

@@ -28,7 +28,7 @@ import Cardano.Db.Statement.Function.Core (ResultType (..), ResultTypeBulk (..),
 import Cardano.Db.Statement.Function.Insert (insert, insertCheckUnique)
 import Cardano.Db.Statement.Function.InsertBulk (insertBulk, insertBulkMaybeIgnore, insertBulkMaybeIgnoreWithConstraint)
 import Cardano.Db.Statement.Function.Query (adaSumDecoder, countAll)
-import Cardano.Db.Statement.Types (DbInfo (..))
+import Cardano.Db.Statement.Types (DbInfo (..), Entity (..))
 import Cardano.Db.Types (Ada, DbLovelace, DbM, RewardSource, dbLovelaceDecoder, rewardSourceDecoder, rewardSourceEncoder)
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Credential (Ptr (..), SlotNo32 (..))
@@ -61,7 +61,7 @@ queryDelegationScriptStmt =
           , " FROM " <> tableN
           , " WHERE redeemer_id IS NOT NULL"
           ]
-    decoder = HsqlD.rowList SS.delegationDecoder
+    decoder = HsqlD.rowList (entityVal <$> SS.entityDelegationDecoder)
 
 queryDelegationScript :: DbM [SS.Delegation]
 queryDelegationScript =
@@ -486,7 +486,7 @@ queryStakeAddressScriptStmt =
           , " FROM " <> tableN
           , " WHERE script_hash IS NOT NULL"
           ]
-    decoder = HsqlD.rowList SS.stakeAddressDecoder
+    decoder = HsqlD.rowList (entityVal <$> SS.entityStakeAddressDecoder)
 
 queryStakeAddressScript :: DbM [SS.StakeAddress]
 queryStakeAddressScript =

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

@@ -28,7 +28,7 @@ import Data.Fixed (Micro, showFixed)
 import Data.Functor.Contravariant ((>$<))
 import Data.Int (Int64)
 import Data.Pool (Pool)
-import Data.Scientific (Scientific (..), coefficient, scientific, toBoundedInteger)
+import Data.Scientific (Scientific (..), scientific, toBoundedInteger)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.WideWord (Word128 (..))
@@ -176,12 +176,10 @@ newtype DbWord64 = DbWord64 {unDbWord64 :: Word64}
   deriving (Eq, Generic, Num)
   deriving (Read, Show) via (Quiet DbWord64)
 
--- Helper to replicate the original Persistent fromPersistValue behavior for DbWord64
--- This matches the PersistRational case: fromIntegral $ numerator r
 scientificToWord64 :: Scientific -> Word64
 scientificToWord64 s = case toBoundedInteger @Word64 s of
   Just w64 -> w64
-  Nothing -> fromIntegral $ coefficient s -- Fallback to coefficient for out-of-bounds values
+  Nothing -> fromInteger (floor s)
 
 -- Value encoder for DbWord64 using numeric (matches word64type domain)
 dbWord64ValueEncoder :: HsqlE.Value DbWord64
@@ -530,10 +528,28 @@ integerToDbInt65 i
   | otherwise = toDbInt65 (fromIntegral i)
 
 word128Encoder :: HsqlE.Value Word128
-word128Encoder = fromInteger . toInteger >$< HsqlE.numeric
+word128Encoder = word128ToScientific >$< HsqlE.numeric
 
 word128Decoder :: HsqlD.Value Word128
-word128Decoder = fromInteger . fromIntegral . coefficient <$> HsqlD.numeric
+word128Decoder = scientificToWord128 <$> HsqlD.numeric
+
+-- | Convert a 'Word128' to a 'Scientific' for storage in a PostgreSQL @numeric@ column.
+-- This is exposed for testing the encoder/decoder pair without a database connection.
+word128ToScientific :: Word128 -> Scientific
+word128ToScientific = fromInteger . toInteger
+
+-- | Convert a 'Scientific' read from a PostgreSQL @numeric@ column back to a 'Word128'.
+--
+-- PostgreSQL strips trailing zeros in its binary @numeric@ representation, so a
+-- value like @380_000_000_000_000_000@ may come back as @Scientific 38 16@
+-- (coefficient @38@, @base10Exponent = 16@). 'coefficient' alone would drop
+-- the exponent, so we use 'floor' on the full 'Scientific' which is exact for
+-- non-negative integral values - the only shape we ever encode here, since
+-- 'Word128' is non-negative and stored in @numeric(39,0)@.
+--
+-- This is exposed for testing the encoder/decoder pair without a database connection.
+scientificToWord128 :: Scientific -> Word128
+scientificToWord128 = fromInteger . floor
 
 lovelaceToAda :: Integer -> Ada
 lovelaceToAda ll =