Robustify handling of the Lovelace type

PostgreSQL does not natively support the Haskell 'Word64' type. Using
the Postgres 'bigint' type was sufficient for the '[0 .. maxLovelace]' range
(which fits in the psoitive part of 'Int64'), but ledger-specs allows fields
in 'PoolUpdate' like 'pledge' and 'fixedCost' to exceed 'maxLovelace'. In
order to accomodate this we need to use the Postgres 'numeric' type with
range constraints to limit it to 'Word64'.

Switching from Postgres 'bitint' to 'numeric' has caused a 10-20% sync
speed degradation.

cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs

@@ -169,8 +169,8 @@ insertTxOuts blkId (address, value) = do
               { DB.txHash = Byron.unTxHash $ txHashOfAddress address
               , DB.txBlock = blkId
               , DB.txBlockIndex = 0
-              , DB.txOutSum = Byron.unsafeGetLovelace value
-              , DB.txFee = 0
+              , DB.txOutSum = DB.DbLovelace (Byron.unsafeGetLovelace value)
+              , DB.txFee = DB.DbLovelace 0
               , DB.txDeposit = 0
               , DB.txSize = 0 -- Genesis distribution address to not have a size.
               }
@@ -181,7 +181,7 @@ insertTxOuts blkId (address, value) = do
               , DB.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 address
               , DB.txOutAddressRaw = Binary.serialize' address
               , DB.txOutPaymentCred = Nothing
-              , DB.txOutValue = Byron.unsafeGetLovelace value
+              , DB.txOutValue = DB.DbLovelace (Byron.unsafeGetLovelace value)
               }
 
 -- -----------------------------------------------------------------------------

cardano-db-sync/src/Cardano/DbSync/Era/Byron/Insert.hs

@@ -30,6 +30,8 @@ import qualified Cardano.Chain.UTxO as Byron
 
 import qualified Cardano.Crypto as Crypto (serializeCborHash)
 
+import           Cardano.Db (DbLovelace (..))
+
 import           Cardano.DbSync.Types
 
 import           Cardano.Prelude
@@ -54,8 +56,8 @@ import           Ouroboros.Consensus.Byron.Ledger (ByronBlock (..))
 
 -- Trivial local data type for use in place of a tuple.
 data ValueFee = ValueFee
-  { vfValue :: !Word64
-  , vfFee :: !Word64
+  { vfValue :: !DbLovelace
+  , vfFee :: !DbLovelace
   }
 
 insertByronBlock
@@ -212,7 +214,7 @@ insertTxOut _tracer txId index txout =
               , DB.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 (Byron.txOutAddress txout)
               , DB.txOutAddressRaw = Binary.serialize' (Byron.txOutAddress txout)
               , DB.txOutPaymentCred = Nothing -- Byron does not have a payment credential.
-              , DB.txOutValue = Byron.unsafeGetLovelace $ Byron.txOutValue txout
+              , DB.txOutValue = DbLovelace (Byron.unsafeGetLovelace $ Byron.txOutValue txout)
               }
 
 
@@ -237,10 +239,10 @@ calculateTxFee tx =
       outval <- firstExceptT (\e -> NEError $ "calculateTxFee: " <> textShow e) $ hoistEither output
       when (null inputs) $
         dbSyncNodeError "calculateTxFee: List of transaction inputs is zero."
-      inval <- sum <$> mapMExceptT (liftLookupFail "calculateTxFee" . DB.queryTxOutValue) inputs
+      inval <- sum . map unDbLovelace <$> mapMExceptT (liftLookupFail "calculateTxFee" . DB.queryTxOutValue) inputs
       if inval < outval
         then dbSyncInvariant "calculateTxFee" $ EInvInOut inval outval
-        else pure $ ValueFee outval (inval - outval)
+        else pure $ ValueFee (DbLovelace outval) (DbLovelace $ inval - outval)
   where
     -- [(Hash of tx, index within tx)]
     inputs :: [(ByteString, Word16)]

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs

@@ -174,8 +174,8 @@ insertTxOuts blkId (Shelley.TxIn txInId _, txOut) = do
               { DB.txHash = Shelley.unTxHash txInId
               , DB.txBlock = blkId
               , DB.txBlockIndex = 0
-              , DB.txOutSum = fromIntegral $ Shelley.unCoin (txOutCoin txOut)
-              , DB.txFee = 0
+              , DB.txOutSum = Shelley.coinToDbLovelace (txOutCoin txOut)
+              , DB.txFee = DB.DbLovelace 0
               , DB.txDeposit = 0
               , DB.txSize = 0 -- Genesis distribution address to not have a size.
               }
@@ -186,7 +186,7 @@ insertTxOuts blkId (Shelley.TxIn txInId _, txOut) = do
               , DB.txOutAddress = Shelley.renderAddress (txOutAddress txOut)
               , DB.txOutAddressRaw = Shelley.serialiseAddr (txOutAddress txOut)
               , DB.txOutPaymentCred = Shelley.maybePaymentCred (txOutAddress txOut)
-              , DB.txOutValue = fromIntegral $ Shelley.unCoin (txOutCoin txOut)
+              , DB.txOutValue = Shelley.coinToDbLovelace (txOutCoin txOut)
               }
   where
     txOutAddress :: ShelleyTxOut -> ShelleyAddress

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs

@@ -17,7 +17,7 @@ import           Cardano.Prelude
 
 import           Cardano.BM.Trace (Trace, logDebug, logInfo, logWarning)
 
-import           Cardano.Db (DbWord64 (..))
+import           Cardano.Db (DbLovelace (..), DbWord64 (..))
 
 import           Control.Monad.Extra (whenJust)
 import           Control.Monad.Logger (LoggingT)
@@ -146,15 +146,15 @@ insertTx tracer env blkId epochNo blockIndex tx = do
     let fees = Shelley.txFee tx
         outSum = Shelley.txOutputSum tx
         withdrawalSum = Shelley.txWithdrawalSum tx
-    inSum <- lift $ queryTxInputSum (Shelley.txInputList tx)
+    inSum <- unDbLovelace <$> lift (queryTxInputSum $ Shelley.txInputList tx)
     -- Insert transaction and get txId from the DB.
     txId <- lift . DB.insertTx $
               DB.Tx
                 { DB.txHash = Shelley.txHash tx
                 , DB.txBlock = blkId
                 , DB.txBlockIndex = blockIndex
-                , DB.txOutSum = outSum
-                , DB.txFee = fees
+                , DB.txOutSum = DB.DbLovelace outSum
+                , DB.txFee = DB.DbLovelace fees
                 , DB.txDeposit = fromIntegral (inSum + withdrawalSum) - fromIntegral (outSum + fees)
                 , DB.txSize = fromIntegral $ LBS.length (Shelley.txFullBytes tx)
                 }
@@ -189,7 +189,7 @@ insertTxOut _tracer txId (index, Shelley.TxOut addr value) =
               , DB.txOutAddress = Shelley.renderAddress addr
               , DB.txOutAddressRaw = Shelley.serialiseAddr addr
               , DB.txOutPaymentCred = Shelley.maybePaymentCred addr
-              , DB.txOutValue = fromIntegral $ Shelley.unCoin value
+              , DB.txOutValue = Shelley.coinToDbLovelace value
               }
 
 insertTxIn
@@ -419,7 +419,7 @@ insertMirCert _tracer env txId idx mcert = do
           { DB.reserveAddrId = addrId
           , DB.reserveCertIndex = idx
           , DB.reserveTxId = txId
-          , DB.reserveAmount = fromIntegral $ Shelley.unCoin coin
+          , DB.reserveAmount = Shelley.coinToDbLovelace coin
           }
 
     insertMirTreasury
@@ -433,7 +433,7 @@ insertMirCert _tracer env txId idx mcert = do
           { DB.treasuryAddrId = addrId
           , DB.treasuryCertIndex = idx
           , DB.treasuryTxId = txId
-          , DB.treasuryAmount = fromIntegral $ Shelley.unCoin coin
+          , DB.treasuryAmount = Shelley.coinToDbLovelace coin
           }
 
 insertWithdrawals
@@ -448,7 +448,7 @@ insertWithdrawals _tracer txId (account, coin) = do
     DB.Withdrawal
       { DB.withdrawalAddrId = addrId
       , DB.withdrawalTxId = txId
-      , DB.withdrawalAmount = fromIntegral $ Shelley.unCoin coin
+      , DB.withdrawalAmount = Shelley.coinToDbLovelace coin
       }
 
 insertPoolRelay
@@ -507,8 +507,8 @@ insertParamProposal _tracer txId (Shelley.Update (Shelley.ProposedPPUpdates umap
           , DB.paramProposalMaxBlockSize = fromIntegral <$> strictMaybeToMaybe (Shelley._maxBBSize pmap)
           , DB.paramProposalMaxTxSize = fromIntegral <$> strictMaybeToMaybe (Shelley._maxTxSize pmap)
           , DB.paramProposalMaxBhSize = fromIntegral <$> strictMaybeToMaybe (Shelley._maxBHSize pmap)
-          , DB.paramProposalKeyDeposit = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._keyDeposit pmap)
-          , DB.paramProposalPoolDeposit = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._poolDeposit pmap)
+          , DB.paramProposalKeyDeposit = Shelley.coinToDbLovelace <$> strictMaybeToMaybe (Shelley._keyDeposit pmap)
+          , DB.paramProposalPoolDeposit = Shelley.coinToDbLovelace <$> strictMaybeToMaybe (Shelley._poolDeposit pmap)
           , DB.paramProposalMaxEpoch = unEpochNo <$> strictMaybeToMaybe (Shelley._eMax pmap)
           , DB.paramProposalOptimalPoolCount = fromIntegral <$> strictMaybeToMaybe (Shelley._nOpt pmap)
           , DB.paramProposalInfluence = fromRational <$> strictMaybeToMaybe (Shelley._a0 pmap)
@@ -517,8 +517,8 @@ insertParamProposal _tracer txId (Shelley.Update (Shelley.ProposedPPUpdates umap
           , DB.paramProposalDecentralisation = Shelley.unitIntervalToDouble <$> strictMaybeToMaybe (Shelley._d pmap)
           , DB.paramProposalEntropy = Shelley.nonceToBytes =<< strictMaybeToMaybe (Shelley._extraEntropy pmap)
           , DB.paramProposalProtocolVersion = strictMaybeToMaybe (Shelley._protocolVersion pmap)
-          , DB.paramProposalMinUtxoValue = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._minUTxOValue pmap)
-          , DB.paramProposalMinPoolCost = fromIntegral . Shelley.unCoin <$> strictMaybeToMaybe (Shelley._minPoolCost pmap)
+          , DB.paramProposalMinUtxoValue = Shelley.coinToDbLovelace <$> strictMaybeToMaybe (Shelley._minUTxOValue pmap)
+          , DB.paramProposalMinPoolCost = Shelley.coinToDbLovelace <$> strictMaybeToMaybe (Shelley._minPoolCost pmap)
           , DB.paramProposalRegisteredTxId = txId
           }
 
@@ -582,7 +582,7 @@ insertRewards _tracer env blkId epoch rewards =
       void . lift . DB.insertReward $
         DB.Reward
           { DB.rewardAddrId = saId
-          , DB.rewardAmount = fromIntegral (Shelley.unCoin coin)
+          , DB.rewardAmount = Shelley.coinToDbLovelace coin
           , DB.rewardEpochNo = unEpochNo epoch
           , DB.rewardPoolId = poolId
           , DB.rewardBlockId = blkId
@@ -601,8 +601,8 @@ insertEpochParam _tracer blkId (EpochNo epoch) params =
       , DB.epochParamMaxBlockSize = fromIntegral (Shelley._maxBBSize params)
       , DB.epochParamMaxTxSize = fromIntegral (Shelley._maxTxSize params)
       , DB.epochParamMaxBhSize = fromIntegral (Shelley._maxBHSize params)
-      , DB.epochParamKeyDeposit = fromIntegral $ Shelley.unCoin (Shelley._keyDeposit params)
-      , DB.epochParamPoolDeposit = fromIntegral $ Shelley.unCoin (Shelley._poolDeposit params)
+      , DB.epochParamKeyDeposit = Shelley.coinToDbLovelace (Shelley._keyDeposit params)
+      , DB.epochParamPoolDeposit = Shelley.coinToDbLovelace (Shelley._poolDeposit params)
       , DB.epochParamMaxEpoch = unEpochNo (Shelley._eMax params)
       , DB.epochParamOptimalPoolCount = fromIntegral (Shelley._nOpt params)
       , DB.epochParamInfluence = fromRational (Shelley._a0 params)
@@ -611,8 +611,8 @@ insertEpochParam _tracer blkId (EpochNo epoch) params =
       , DB.epochParamDecentralisation = Shelley.unitIntervalToDouble (Shelley._d params)
       , DB.epochParamEntropy = Shelley.nonceToBytes $ Shelley._extraEntropy params
       , DB.epochParamProtocolVersion = Shelley._protocolVersion params
-      , DB.epochParamMinUtxoValue = fromIntegral $ Shelley.unCoin (Shelley._minUTxOValue params)
-      , DB.epochParamMinPoolCost = fromIntegral $ Shelley.unCoin (Shelley._minPoolCost params)
+      , DB.epochParamMinUtxoValue = Shelley.coinToDbLovelace (Shelley._minUTxOValue params)
+      , DB.epochParamMinPoolCost = Shelley.coinToDbLovelace (Shelley._minPoolCost params)
       , DB.epochParamBlockId = blkId
       }
 
@@ -636,7 +636,7 @@ insertEpochStake _tracer env blkId (EpochNo epoch) smap =
         DB.EpochStake
           { DB.epochStakeAddrId = saId
           , DB.epochStakePoolId = poolId
-          , DB.epochStakeAmount = fromIntegral $ Shelley.unCoin coin
+          , DB.epochStakeAmount = Shelley.coinToDbLovelace coin
           , DB.epochStakeEpochNo = epoch + 1 -- The epoch where this delegation becomes valid.
           , DB.epochStakeBlockId = blkId
           }

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs

@@ -81,10 +81,10 @@ queryStakePoolKeyHash kh = do
             pure (poolHash ^. PoolHashId)
   pure $ maybeToEither (DbLookupMessage "StakePoolKeyHash") unValue (listToMaybe res)
 
-queryTxInputSum :: MonadIO m => [ShelleyTxIn] -> ReaderT SqlBackend m Word64
+queryTxInputSum :: MonadIO m => [ShelleyTxIn] -> ReaderT SqlBackend m DbLovelace
 queryTxInputSum txins =
-    sum <$> mapM queryTxInputValue txins
+    DbLovelace . sum . map unDbLovelace <$> mapM queryTxInputValue txins
   where
-    queryTxInputValue :: MonadIO m => ShelleyTxIn -> ReaderT SqlBackend m Word64
+    queryTxInputValue :: MonadIO m => ShelleyTxIn -> ReaderT SqlBackend m DbLovelace
     queryTxInputValue (Shelley.TxIn (Shelley.TxId hash) index) =
-      fromRight 0 <$> queryTxOutValue (Crypto.hashToBytes hash, fromIntegral index)
+      fromRight (DbLovelace 0) <$> queryTxOutValue (Crypto.hashToBytes hash, fromIntegral index)

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Util.hs

@@ -16,6 +16,7 @@ module Cardano.DbSync.Era.Shelley.Util
   , blockOpCert
   , blockVrfKeyView
   , blockCreatorPoolHash
+  , coinToDbLovelace
   , epochNumber
   , fakeGenesisHash
   , maybePaymentCred
@@ -51,6 +52,7 @@ import qualified Cardano.Api.Typed as Api
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Crypto.KES.Class as KES
 
+import           Cardano.Db (DbLovelace (..))
 import qualified Cardano.Db as Db
 import           Cardano.DbSync.Config
 import           Cardano.DbSync.Types
@@ -129,6 +131,9 @@ blockOpCert = KES.rawSerialiseVerKeyKES . Shelley.ocertVkHot . Shelley.bheaderOC
 blockVrfKeyView :: ShelleyBlock -> Text
 blockVrfKeyView = Api.serialiseToBech32 . Api.VrfVerificationKey . Shelley.bheaderVrfVk . blockBody
 
+coinToDbLovelace :: Coin -> DbLovelace
+coinToDbLovelace = DbLovelace . fromIntegral . unCoin
+
 epochNumber :: ShelleyBlock -> Word64 -> Word64
 epochNumber blk slotsPerEpoch = slotNumber blk `div` slotsPerEpoch
 

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

@@ -146,7 +146,7 @@ updateEpochNum epochNum trce = do
     calcEpochFromHistory :: IO DB.Epoch
     calcEpochFromHistory = do
       now <- Time.getCurrentTime
-      pure $ DB.Epoch 0 0 0 0 epochNum now now
+      pure $ DB.Epoch 0 (DB.DbLovelace 0) 0 0 epochNum now now
 
 -- -------------------------------------------------------------------------------------------------
 

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

@@ -65,7 +65,7 @@ aggregateUtxos xs =
   List.sortOn (Text.length . fst)
     . Map.toList
     . Map.fromListWith (+)
-    $ map (\(x, _) -> (txOutAddress x, txOutValue x)) xs
+    $ map (\(x, _) -> (txOutAddress x, unDbLovelace (txOutValue x))) xs
 
 isRedeemTextAddress :: Text -> Bool
 isRedeemTextAddress addr =
@@ -113,7 +113,7 @@ textShow = Text.pack . show
 
 utxoSetSum :: [(TxOut, a)] -> Ada
 utxoSetSum xs =
-  word64ToAda . sum $ map (txOutValue . fst) xs
+  word64ToAda . sum $ map (unDbLovelace . txOutValue . fst) xs
 
 writeUtxos :: FilePath -> [(Text, Word64)] -> IO ()
 writeUtxos fname xs = do

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

@@ -40,4 +40,4 @@ putStrF s = putStr s >> hFlush stdout
 
 utxoSetSum :: [(TxOut, a)] -> Ada
 utxoSetSum xs =
-  word64ToAda . sum $ map (txOutValue . fst) xs
+  word64ToAda . sum $ map (unDbLovelace . txOutValue . fst) xs

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

@@ -179,14 +179,14 @@ queryCalcEpochEntry epochNum = do
     convertAll (blkCount, b, c) (d, e, txCount) =
       case (b, c, d, e) of
         (Just start, Just end, Just outSum, Just fees) ->
-          Just $ Epoch (fromIntegral $ numerator outSum) (fromIntegral $ numerator fees)
+          Just $ Epoch (fromIntegral $ numerator outSum) (DbLovelace . fromIntegral $ numerator fees)
                         txCount blkCount epochNum start end
         _otherwise -> Nothing
 
     convertBlk :: (Word64, Maybe UTCTime, Maybe UTCTime) -> Maybe Epoch
     convertBlk (blkCount, b, c) =
       case (b, c) of
-        (Just start, Just end) -> Just (Epoch 0 0 0 blkCount epochNum start end)
+        (Just start, Just end) -> Just (Epoch 0 (DbLovelace 0) 0 blkCount epochNum start end)
         _otherwise -> Nothing
 
 queryCheckPoints :: MonadIO m => Word64 -> ReaderT SqlBackend m [(Word64, ByteString)]
@@ -434,7 +434,7 @@ queryTxOutCount = do
 
 -- | Give a (tx hash, index) pair, return the TxOut value.
 -- It can return 0 if the output does not exist.
-queryTxOutValue :: MonadIO m => (ByteString, Word16) -> ReaderT SqlBackend m (Either LookupFail Word64)
+queryTxOutValue :: MonadIO m => (ByteString, Word16) -> ReaderT SqlBackend m (Either LookupFail DbLovelace)
 queryTxOutValue (hash, index) = do
   res <- select . from $ \ (tx `InnerJoin` txOut) -> do
             on (tx ^. TxId ==. txOut ^. TxOutTxId)