Fix reward tests

Author: kderme

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Reward.hs

@@ -52,7 +52,7 @@ import Test.Cardano.Db.Mock.UnifiedApi (
   withAlonzoFindLeaderAndSubmit,
   withAlonzoFindLeaderAndSubmitTx,
  )
-import Test.Cardano.Db.Mock.Validate (assertBlockNoBackoff, assertRewardCount, assertRewardCounts)
+import Test.Cardano.Db.Mock.Validate (assertBlockNoBackoff, assertInstantRewardCount, assertRewardCount, assertRewardCounts)
 import Test.Tasty.HUnit (Assertion)
 
 simpleRewards :: IOManager -> [(Text, Text)] -> Assertion
@@ -481,6 +481,6 @@ singleMIRCertMultiOut =
     b <- fillUntilNextEpoch interpreter mockServer
 
     assertBlockNoBackoff dbSync (2 + length a + length b)
-    assertRewardCount dbSync 4
+    assertInstantRewardCount dbSync 4
   where
     testLabel = "singleMIRCertMultiOut-alonzo"

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Reward.hs

@@ -51,6 +51,7 @@ import Test.Cardano.Db.Mock.UnifiedApi (
 import Test.Cardano.Db.Mock.Validate (
   assertBlockNoBackoff,
   assertCurrentEpoch,
+  assertInstantRewardCount,
   assertRewardCount,
   assertRewardCounts,
  )
@@ -566,6 +567,6 @@ singleMIRCertMultiOut =
     b <- fillUntilNextEpoch interpreter mockServer
 
     assertBlockNoBackoff dbSync (2 + length a + length b)
-    assertRewardCount dbSync 4
+    assertInstantRewardCount dbSync 4
   where
     testLabel = "singleMIRCertMultiOut"

cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs

@@ -14,6 +14,7 @@ module Test.Cardano.Db.Mock.Validate (
   assertTxInCount,
   assertUnspentTx,
   assertRewardCount,
+  assertInstantRewardCount,
   assertBlockNoBackoff,
   assertBlockNoBackoffTimes,
   assertEqQuery,
@@ -79,7 +80,7 @@ import Database.Esqueleto.Legacy (
   (==.),
   (^.),
  )
-import Database.Persist.Sql (Entity, SqlBackend, entityVal)
+import Database.Persist.Sql (Entity, SqlBackend)
 import Database.PostgreSQL.Simple (SqlError (..))
 import Ouroboros.Consensus.Cardano.Block
 import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
@@ -112,6 +113,10 @@ assertRewardCount :: DBSyncEnv -> Word64 -> IO ()
 assertRewardCount env n =
   assertEqBackoff env queryRewardCount n defaultDelays "Unexpected rewards count"
 
+assertInstantRewardCount :: DBSyncEnv -> Word64 -> IO ()
+assertInstantRewardCount env n =
+  assertEqBackoff env queryInstantRewardCount n defaultDelays "Unexpected instant rewards count"
+
 assertBlockNoBackoff :: DBSyncEnv -> Int -> IO ()
 assertBlockNoBackoff = assertBlockNoBackoffTimes defaultDelays
 
@@ -242,7 +247,7 @@ assertRewardCounts env st filterAddr mEpoch expected = do
     expectedMap :: Map ByteString (Word64, Word64, Word64, Word64, Word64)
     expectedMap = Map.fromList $ fmap (first mkDBStakeAddress) expected
 
-    groupByAddress :: [(Reward, ByteString)] -> Map ByteString (Word64, Word64, Word64, Word64, Word64)
+    groupByAddress :: [(RewardSource, ByteString)] -> Map ByteString (Word64, Word64, Word64, Word64, Word64)
     groupByAddress rewards =
       let res = foldr updateMap Map.empty rewards
        in if filterAddr
@@ -255,39 +260,46 @@ assertRewardCounts env st filterAddr mEpoch expected = do
       Right cred -> Ledger.serialiseRewardAcnt $ Ledger.RewardAcnt Testnet cred
 
     updateAddrCounters ::
-      Reward ->
+      RewardSource ->
       Maybe (Word64, Word64, Word64, Word64, Word64) ->
       (Word64, Word64, Word64, Word64, Word64)
-    updateAddrCounters reward Nothing = updateCounters reward (0, 0, 0, 0, 0)
-    updateAddrCounters reward (Just cs) = updateCounters reward cs
+    updateAddrCounters rs Nothing = updateCounters rs (0, 0, 0, 0, 0)
+    updateAddrCounters rs (Just cs) = updateCounters rs cs
 
     updateCounters ::
-      Reward ->
+      RewardSource ->
       (Word64, Word64, Word64, Word64, Word64) ->
       (Word64, Word64, Word64, Word64, Word64)
-    updateCounters reward (a, b, c, d, e) = case rewardType reward of
+    updateCounters rs (a, b, c, d, e) = case rs of
       RwdLeader -> (a + 1, b, c, d, e)
       RwdMember -> (a, b + 1, c, d, e)
       RwdReserves -> (a, b, c + 1, d, e)
       RwdTreasury -> (a, b, c, d + 1, e)
       RwdDepositRefund -> (a, b, c, d, e + 1)
 
     updateMap ::
-      (Reward, ByteString) ->
+      (RewardSource, ByteString) ->
       Map ByteString (Word64, Word64, Word64, Word64, Word64) ->
       Map ByteString (Word64, Word64, Word64, Word64, Word64)
-    updateMap (rew, addr) = Map.alter (Just . updateAddrCounters rew) addr
+    updateMap (rs, addr) = Map.alter (Just . updateAddrCounters rs) addr
 
     filterEpoch rw = case mEpoch of
       Nothing -> val True
       Just e -> rw ^. RewardSpendableEpoch ==. val e
+    filterEpoch' rw = case mEpoch of
+      Nothing -> val True
+      Just e -> rw ^. InstantRewardSpendableEpoch ==. val e
 
     q = do
-      res <- select . from $ \(reward `InnerJoin` stake_addr) -> do
+      res1 <- select . from $ \(reward `InnerJoin` stake_addr) -> do
         on (reward ^. RewardAddrId ==. stake_addr ^. StakeAddressId)
         where_ (filterEpoch reward)
-        pure (reward, stake_addr ^. StakeAddressHashRaw)
-      pure $ fmap (bimap entityVal unValue) res
+        pure (reward ^. RewardType, stake_addr ^. StakeAddressHashRaw)
+      res2 <- select . from $ \(ireward `InnerJoin` stake_addr) -> do
+        on (ireward ^. InstantRewardAddrId ==. stake_addr ^. StakeAddressId)
+        where_ (filterEpoch' ireward)
+        pure (ireward ^. InstantRewardType, stake_addr ^. StakeAddressHashRaw)
+      pure $ fmap (bimap unValue unValue) (res1 <> res2)
 
 assertEpochStake :: DBSyncEnv -> Word64 -> IO ()
 assertEpochStake env expected =

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

@@ -89,6 +89,7 @@ module Cardano.Db.Query (
   -- queries used only in tests
   queryAddressOutputs,
   queryRewardCount,
+  queryInstantRewardCount,
   queryTxInCount,
   queryEpochCount,
   queryCostModel,
@@ -1199,6 +1200,13 @@ queryRewardCount = do
     pure countRows
   pure $ maybe 0 unValue (listToMaybe res)
 
+queryInstantRewardCount :: MonadIO m => ReaderT SqlBackend m Word64
+queryInstantRewardCount = do
+  res <- select $ do
+    _ <- from $ table @InstantReward
+    pure countRows
+  pure $ maybe 0 unValue (listToMaybe res)
+
 -- | Count the number of transactions in the Tx table.
 queryTxInCount :: MonadIO m => ReaderT SqlBackend m Word
 queryTxInCount = do

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

@@ -316,9 +316,6 @@ share
     amount              DbLovelace          sqltype=lovelace
     earnedEpoch         Word64 generated="(CASE WHEN spendable_epoch >= 1 then spendable_epoch-1 else 0 end)"
     spendableEpoch      Word64
-    -- Here used to lie a unique constraint which would slow down inserts when in syncing mode
-    -- Now the constraint is set manually inside of `applyAndInsertBlockMaybe` once the tip of
-    -- the chain has been reached.
     UniqueInstantReward addrId earnedEpoch type
     deriving Show