db-sync: Fix handling of StakeRefPtr

Previously `insertStakeAddressRefIfMissing` was returning `Nothing` if it received a stake address of type `StakeRefPtr`. Now it returns a proper `StakeAddressId`. Closes: #1016
IntersectMBO · Jan 18, 2022 · 35ed0f6 · 35ed0f6
1 parent aa821d2
commit 35ed0f6
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 24 deletions.
diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs
@@ -462,10 +462,8 @@ insertStakeAddressRefIfMissing txId addr =
           case sref of
             Ledger.StakeRefBase cred ->
               Just <$> insertStakeAddress txId (Shelley.RewardAcnt nw cred)
-            Ledger.StakeRefPtr {} ->
-              -- This happens when users pay to payment addresses that refer to a stake addresses
-              -- by pointer, but where the pointer does not refer to a registered stake address.
-              pure Nothing
+            Ledger.StakeRefPtr ptr ->
+              queryStakeRefPtr ptr
             Ledger.StakeRefNull -> pure Nothing
 
 insertPoolOwner

diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs
@@ -8,6 +8,7 @@ module Cardano.DbSync.Era.Shelley.Query
   ( queryPoolHashId
   , queryStakeAddress
   , queryStakePoolKeyHash
+  , queryStakeRefPtr
   , queryStakeAddressRef
   , queryResolveInput
   , queryResolveInputCredentials
@@ -17,7 +18,7 @@ module Cardano.DbSync.Era.Shelley.Query
   , queryPoolUpdateByBlock
   ) where
 
-import           Cardano.Prelude hiding (from, maybeToEither, on)
+import           Cardano.Prelude hiding (Ptr, from, maybeToEither, on)
 
 import           Cardano.Db
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
@@ -82,26 +83,8 @@ queryStakeAddressRef addr =
           StakeRefBase cred -> do
             eres <- queryStakeAddress $ Ledger.serialiseRewardAcnt (Ledger.RewardAcnt nw cred)
             pure $ either (const Nothing) Just eres
-          StakeRefPtr (Ptr slotNo txIx certIx) -> queryStakeDelegation slotNo (fromIntegral txIx) (fromIntegral certIx)
+          StakeRefPtr ptr -> queryStakeRefPtr ptr
           StakeRefNull -> pure Nothing
-  where
-    queryStakeDelegation
-        :: MonadIO m
-        => SlotNo -> Natural -> Natural
-        -> ReaderT SqlBackend m (Maybe StakeAddressId)
-    queryStakeDelegation (SlotNo slot) txIx certIx = do
-      res <- select . from $ \ (blk `InnerJoin` tx `InnerJoin` dlg) -> do
-                on (tx ^. TxId ==. dlg ^. DelegationTxId)
-                on (blk ^. BlockId ==. tx ^. TxBlockId)
-                where_ (blk ^. BlockSlotNo ==. just (val slot))
-                where_ (tx ^. TxBlockIndex ==. val (fromIntegral txIx))
-                where_ (dlg ^. DelegationCertIndex ==. val (fromIntegral certIx))
-                -- Need to order by BlockSlotNo descending for correct behavior when there are two
-                -- or more delegation certificates in a single epoch.
-                orderBy [desc (blk ^. BlockSlotNo)]
-                limit 1
-                pure (dlg ^. DelegationAddrId)
-      pure $ unValue <$> listToMaybe res
 
 queryResolveInput :: MonadIO m => Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail (TxId, DbLovelace))
 queryResolveInput txIn =
@@ -121,6 +104,21 @@ queryStakeAddressIdPair cred@(Generic.StakeCred bs) = do
     convert :: Value StakeAddressId -> (Generic.StakeCred, StakeAddressId)
     convert (Value said) = (cred, said)
 
+queryStakeRefPtr :: MonadIO m => Ptr -> ReaderT SqlBackend m (Maybe StakeAddressId)
+queryStakeRefPtr (Ptr (SlotNo slot) txIx certIx) = do
+  res <- select . from $ \ (blk `InnerJoin` tx `InnerJoin` dlg) -> do
+            on (tx ^. TxId ==. dlg ^. DelegationTxId)
+            on (blk ^. BlockId ==. tx ^. TxBlockId)
+            where_ (blk ^. BlockSlotNo ==. just (val slot))
+            where_ (tx ^. TxBlockIndex ==. val (fromIntegral txIx))
+            where_ (dlg ^. DelegationCertIndex ==. val (fromIntegral certIx))
+            -- Need to order by BlockSlotNo descending for correct behavior when there are two
+            -- or more delegation certificates in a single epoch.
+            orderBy [desc (blk ^. BlockSlotNo)]
+            limit 1
+            pure (dlg ^. DelegationAddrId)
+  pure $ unValue <$> listToMaybe res
+
 queryPoolHashIdPair
     :: MonadIO m
     => Generic.StakePoolKeyHash