db-sync: Fix query that gets and deletes orphaned rewards

This is now correct for everything other than pool deposit refunds.
The query is still slow and needs to be cleaned up, but is is correct
which is an important first step.

Closes: #796

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

@@ -53,17 +53,17 @@ adjustEpochRewards tracer epochNo = do
                 , textShow (length addrs), " orphaned rewards removed ("
                 , textShow ada, " ADA)"
                 ]
-    -- liftIO . logInfo tracer $ "adjustEpochRewards: " <> textShow (sort $ map (unSqlBackendKey . Db.unStakeAddressKey) addrs)
-    deleteOrphanedRewards addrs
+    deleteOrphanedRewards epochNo addrs
 
 -- ------------------------------------------------------------------------------------------------
 
 -- TODO: When we know this is correct, the query and the delete should be composed so that
 -- the list of StakeAddressIds does not need to be returned to Haskell land.
 
-deleteOrphanedRewards :: MonadIO m => [Db.StakeAddressId] -> ReaderT SqlBackend m ()
-deleteOrphanedRewards xs =
-  delete . from $ \ rwd ->
+deleteOrphanedRewards :: MonadIO m => EpochNo -> [Db.StakeAddressId] -> ReaderT SqlBackend m ()
+deleteOrphanedRewards (EpochNo epochNo) xs =
+  delete . from $ \ rwd -> do
+    where_ (rwd ^. Db.RewardSpendableEpoch >=. val (epochNo + 2))
     where_ (rwd ^. Db.RewardAddrId `in_` valList xs)
 
 -- TODO: This query is slow and inefficient. Need to replace it with something better.

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

@@ -173,18 +173,28 @@ insertRewards epoch icache rewardsChunk = do
                   { DB.rewardAddrId = saId
                   , DB.rewardType = Generic.rewardSource rwd
                   , DB.rewardAmount = Generic.coinToDbLovelace (Generic.rewardAmount rwd)
-                  , DB.rewardEarnedEpoch = unEpochNo epoch
-                  , DB.rewardSpendableEpoch = unEpochNo epoch + spendableEpoch (Generic.rewardSource rwd)
+                  , DB.rewardEarnedEpoch = earnedEpoch (Generic.rewardSource rwd)
+                  , DB.rewardSpendableEpoch = spendableEpoch (Generic.rewardSource rwd)
                   , DB.rewardPoolId = lookupPoolIdPairMaybe (Generic.rewardPool rwd) icache
                   }
 
+    earnedEpoch :: DB.RewardSource -> Word64
+    earnedEpoch src =
+      unEpochNo epoch +
+        case src of
+          DB.RwdMember -> 0
+          DB.RwdLeader -> 0
+          DB.RwdReserves -> 1
+          DB.RwdTreasury -> 1
+
     spendableEpoch :: DB.RewardSource -> Word64
     spendableEpoch src =
-      case src of
-        DB.RwdMember -> 2
-        DB.RwdLeader -> 2
-        DB.RwdReserves -> 1
-        DB.RwdTreasury -> 1
+      unEpochNo epoch +
+        case src of
+          DB.RwdMember -> 2
+          DB.RwdLeader -> 2
+          DB.RwdReserves -> 2
+          DB.RwdTreasury -> 2
 
 -- -------------------------------------------------------------------------------------------------
 

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

@@ -40,20 +40,20 @@ validateEpochRewards
     :: (MonadBaseControl IO m, MonadIO m)
     => Trace IO Text -> Network -> EpochNo -> Map (Ledger.StakeCredential c) Coin
     -> ReaderT SqlBackend m ()
-validateEpochRewards tracer nw epochNo rmap = do
-    actual <- queryEpochRewardTotal epochNo
+validateEpochRewards tracer nw currentEpoch rmap = do
+    actual <- queryEpochRewardTotal currentEpoch
     if actual /= expected
         then do
           liftIO . logWarning tracer $ mconcat
-                      [ "validateEpochRewards: rewards earned in epoch "
-                      , textShow (unEpochNo epochNo), " expected total of ", textShow expected
+                      [ "validateEpochRewards: rewards spendable in epoch "
+                      , textShow (unEpochNo currentEpoch), " expected total of ", textShow expected
                       , " ADA but got " , textShow actual, " ADA"
                       ]
-          logFullRewardMap epochNo (convertRewardMap nw rmap)
+          logFullRewardMap currentEpoch (convertRewardMap nw rmap)
         else
           liftIO . logInfo tracer $ mconcat
                       [ "validateEpochRewards: total rewards that become spendable in epoch "
-                      , textShow (2 + unEpochNo epochNo), " is ", textShow actual, " ADA"
+                      , textShow (unEpochNo currentEpoch), " is ", textShow actual, " ADA"
                       ]
   where
     expected :: Db.Ada
@@ -66,7 +66,7 @@ queryEpochRewardTotal
     => EpochNo -> ReaderT SqlBackend m Db.Ada
 queryEpochRewardTotal (EpochNo epochNo) = do
   res <- select . from $ \ rwd -> do
-            where_ (rwd ^. Db.RewardEarnedEpoch ==. val epochNo)
+            where_ (rwd ^. Db.RewardSpendableEpoch ==. val epochNo)
             pure (sum_ $ rwd ^. Db.RewardAmount)
   pure $ Db.unValueSumAda (listToMaybe res)
 
@@ -91,10 +91,10 @@ queryRewardMap
 queryRewardMap (EpochNo epochNo) = do
     res <- select . from $ \ (rwd `InnerJoin` saddr) -> do
               on (rwd ^. Db.RewardAddrId ==. saddr ^. Db.StakeAddressId)
-              where_ (rwd ^. Db.RewardEarnedEpoch ==. val epochNo)
+              where_ (rwd ^. Db.RewardSpendableEpoch ==. val epochNo)
               -- Need this orderBy so that the `groupOn` below works correctly.
               orderBy [desc (saddr ^. Db.StakeAddressHashRaw)]
-              pure (saddr ^. Db.StakeAddressHashRaw, rwd ^. Db.RewardType, rwd ^.Db.RewardAmount)
+              pure (saddr ^. Db.StakeAddressHashRaw, rwd ^. Db.RewardType, rwd ^. Db.RewardAmount)
     pure . Map.fromList . map collapse $ List.groupOn fst (map convert res)
   where
     convert :: (Value ByteString, Value RewardSource, Value DbLovelace) -> (Generic.StakeCred, (RewardSource, DbLovelace))
@@ -173,7 +173,7 @@ queryRewardEntries
 queryRewardEntries (EpochNo epochNo) (Generic.StakeCred cred) = do
   res <- select . from $ \ (rwd `InnerJoin` saddr) -> do
             on (rwd ^. Db.RewardAddrId ==. saddr ^. Db.StakeAddressId)
-            where_ (rwd ^. Db.RewardEarnedEpoch ==. val epochNo)
+            where_ (rwd ^. Db.RewardSpendableEpoch ==. val epochNo)
             where_ (saddr ^. Db.StakeAddressHashRaw ==. val cred)
             pure countRows
   pure $ maybe 0 unValue (listToMaybe res)

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

@@ -181,7 +181,7 @@ stashPoolRewards tracer lenv epoch rmap = do
     Nothing ->
       liftIO . atomically $ putTMVar (lePoolRewards lenv) (epoch, rmap)
     Just mirMap ->
-      validateEpochRewards tracer (leNetwork lenv) (epoch - 2) (Map.unionWith plusCoin rmap mirMap)
+      validateEpochRewards tracer (leNetwork lenv) epoch (Map.unionWith plusCoin rmap mirMap)
 
 stashMirRewards
     :: (MonadBaseControl IO m, MonadIO m)
@@ -193,4 +193,4 @@ stashMirRewards tracer lenv mirMap = do
       Nothing ->
         liftIO . atomically $ putTMVar (leMirRewards lenv) mirMap
       Just (epoch, rmap) ->
-        validateEpochRewards tracer (leNetwork lenv) (epoch - 2) (Map.unionWith plusCoin rmap mirMap)
+        validateEpochRewards tracer (leNetwork lenv) epoch (Map.unionWith plusCoin rmap mirMap)