wip

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

@@ -137,7 +137,7 @@ insertValidateGenesisDist backend tracer networkName cfg shelleyInitiation = do
                             , DB.blockOpCert = Nothing
                             , DB.blockOpCertCounter = Nothing
                             }
-                lift $ mapM_ (insertTxOuts bid) $ genesisUtxOs cfg
+                lift $ mapM_ (insertTxOuts tracer bid) $ genesisUtxOs cfg
                 liftIO . logInfo tracer $ "Initial genesis distribution populated. Hash "
                                 <> renderByteArray (configGenesisHash cfg)
                 when hasStakes $
@@ -195,9 +195,9 @@ validateGenesisDistribution tracer networkName cfg bid expectedTxCount =
 
 insertTxOuts
     :: (MonadBaseControl IO m, MonadIO m)
-    => DB.BlockId -> (ShelleyTx.TxIn (Crypto StandardShelley), Shelley.TxOut StandardShelley)
+    => Trace IO Text -> DB.BlockId -> (ShelleyTx.TxIn (Crypto StandardShelley), Shelley.TxOut StandardShelley)
     -> ReaderT SqlBackend m ()
-insertTxOuts blkId (ShelleyTx.TxIn txInId _, txOut) = do
+insertTxOuts trce blkId (ShelleyTx.TxIn txInId _, txOut) = do
   -- Each address/value pair of the initial coin distribution comes from an artifical transaction
   -- with a hash generated by hashing the address.
   txId <- DB.insertTx $
@@ -214,7 +214,7 @@ insertTxOuts blkId (ShelleyTx.TxIn txInId _, txOut) = do
               , DB.txValidContract = True
               , DB.txScriptSize = 0
               }
-  _ <- insertStakeAddressRefIfMissing txId (txOutAddress txOut)
+  _ <- insertStakeAddressRefIfMissing trce txId (txOutAddress txOut)
   void . DB.insertTxOut $
             DB.TxOut
               { DB.txOutTxId = txId

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

@@ -24,7 +24,7 @@ import           Cardano.Api (SerialiseAsCBOR (..))
 import           Cardano.Api.Shelley (TxMetadataValue (..), makeTransactionMetadata,
                    metadataValueToJsonNoSchema)
 
-import           Cardano.BM.Trace (Trace, logDebug, logInfo, logWarning)
+import           Cardano.BM.Trace (Trace, logDebug, logError, logInfo, logWarning)
 
 import qualified Cardano.Crypto.Hash as Crypto
 
@@ -258,7 +258,7 @@ prepareTxOut
     => Trace IO Text -> (DB.TxId, ByteString) -> Generic.TxOut
     -> ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut])
 prepareTxOut tracer (txId, txHash) (Generic.TxOut index addr addrRaw value maMap dataHash) = do
-    mSaId <- lift $ insertStakeAddressRefIfMissing txId addr
+    mSaId <- lift $ insertStakeAddressRefIfMissing tracer txId addr
     let txOut = DB.TxOut
                   { DB.txOutTxId = txId
                   , DB.txOutIndex = index
@@ -449,9 +449,9 @@ insertStakeAddress txId rewardAddr =
 -- whether it is newly inserted or it is already there, we retrun the `StakeAddressId`.
 insertStakeAddressRefIfMissing
     :: (MonadBaseControl IO m, MonadIO m)
-    => DB.TxId -> Ledger.Addr StandardCrypto
+    => Trace IO Text -> DB.TxId -> Ledger.Addr StandardCrypto
     -> ReaderT SqlBackend m (Maybe DB.StakeAddressId)
-insertStakeAddressRefIfMissing txId addr =
+insertStakeAddressRefIfMissing trce txId addr =
     maybe insertSAR (pure . Just) =<< queryStakeAddressRef addr
   where
     insertSAR :: (MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m (Maybe DB.StakeAddressId)
@@ -462,8 +462,10 @@ insertStakeAddressRefIfMissing txId addr =
           case sref of
             Ledger.StakeRefBase cred ->
               Just <$> insertStakeAddress txId (Shelley.RewardAcnt nw cred)
-            Ledger.StakeRefPtr ptr ->
-              queryStakeRefPtr ptr
+            Ledger.StakeRefPtr ptr -> do
+              mid <- queryStakeRefPtr ptr
+              liftIO . logError trce $ "insertStakeRefIfMissing: " <> textShow ptr <> " " <> textShow mid
+              pure mid
             Ledger.StakeRefNull -> pure Nothing
 
 insertPoolOwner

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

@@ -37,6 +37,8 @@ import           Database.Persist.Sql (SqlBackend)
 
 import           Ouroboros.Consensus.Cardano.Block (StandardCrypto)
 
+{- HLINT ignore "Reduce duplication" -}
+
 
 queryPoolHashId :: MonadIO m => ByteString -> ReaderT SqlBackend m (Maybe PoolHashId)
 queryPoolHashId hash = do
@@ -83,8 +85,26 @@ queryStakeAddressRef addr =
           StakeRefBase cred -> do
             eres <- queryStakeAddress $ Ledger.serialiseRewardAcnt (Ledger.RewardAcnt nw cred)
             pure $ either (const Nothing) Just eres
-          StakeRefPtr ptr -> queryStakeRefPtr ptr
+          StakeRefPtr ptr -> queryStakeDelegation ptr
           StakeRefNull -> pure Nothing
+  where
+    queryStakeDelegation
+        :: MonadIO m
+        => Ptr
+        -> ReaderT SqlBackend m (Maybe StakeAddressId)
+    queryStakeDelegation (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
 
 queryResolveInput :: MonadIO m => Generic.TxIn -> ReaderT SqlBackend m (Either LookupFail (TxId, DbLovelace))
 queryResolveInput txIn =
@@ -105,18 +125,18 @@ queryStakeAddressIdPair cred@(Generic.StakeCred bs) = do
     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)
+queryStakeRefPtr (Ptr (SlotNo slot) txIx _certIx) = do
+  res <- select . from $ \ (blk `InnerJoin` tx `InnerJoin` sa) -> do
+            on (tx ^. TxId ==. sa ^. StakeAddressRegisteredTxId)
             on (blk ^. BlockId ==. tx ^. TxBlockId)
             where_ (blk ^. BlockSlotNo ==. just (val slot))
             where_ (tx ^. TxBlockIndex ==. val (fromIntegral txIx))
-            where_ (dlg ^. DelegationCertIndex ==. val (fromIntegral certIx))
+            -- where_ (sa ^. 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 (sa ^. StakeAddressId)
   pure $ unValue <$> listToMaybe res
 
 queryPoolHashIdPair