From b549059d80ecdf39e153b5c77da2bae30181c7d3 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Sun, 16 Jan 2022 12:50:18 +1100 Subject: [PATCH] wip --- .../src/Cardano/DbSync/Era/Shelley/Genesis.hs | 8 ++--- .../src/Cardano/DbSync/Era/Shelley/Insert.hs | 14 ++++---- .../src/Cardano/DbSync/Era/Shelley/Query.hs | 32 +++++++++++++++---- 3 files changed, 38 insertions(+), 16 deletions(-) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs index 8ab6945a7..e04cf1a73 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs +++ b/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 diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs index e9c5bb775..2ba5fd49e 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/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 diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs index 1ec4f6ca3..b1fa76e67 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Query.hs +++ b/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