From d651fe61f9a7346446f5e6461b99129e14cbbc25 Mon Sep 17 00:00:00 2001 From: Kostas Dermentzis Date: Sun, 22 Oct 2023 13:57:15 +0300 Subject: [PATCH] Workaround a ledger issue with unregistered pools Issue at https://github.com/input-output-hk/cardano-ledger/issues/3802 --- .../src/Cardano/DbSync/Era/Shelley/Genesis.hs | 2 +- .../src/Cardano/DbSync/Era/Shelley/Insert.hs | 31 ++++++++++++++----- 2 files changed, 24 insertions(+), 9 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 97c0ec756..b32e5eb00 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Genesis.hs @@ -292,7 +292,7 @@ insertStaking tracer cache blkId genesis = do let stakes = zip [0 ..] $ ListMap.toList (sgsStake $ sgStaking genesis) forM_ stakes $ \(n, (keyStaking, keyPool)) -> do insertStakeRegistration (EpochNo 0) txId (2 * n) (Generic.annotateStakingCred network (KeyHashObj keyStaking)) - insertDelegation cache network 0 0 txId (2 * n + 1) Nothing (KeyHashObj keyStaking) keyPool + insertDelegation tracer cache network 0 0 txId (2 * n + 1) Nothing (KeyHashObj keyStaking) keyPool -- ----------------------------------------------------------------------------- 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 f853c1417..edcd6aebf 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -516,7 +516,7 @@ insertCertificate tracer cache isMember network blkId txId epochNo slotNo redeem Left (ShelleyTxCertMir mir) -> insertMirCert tracer cache network txId idx mir Left (ShelleyTxCertGenesisDeleg _gen) -> liftIO $ logWarning tracer "insertCertificate: Unhandled DCertGenesis certificate" - Right (ConwayTxCertDeleg deleg) -> insertConwayDelegCert cache network txId idx mRedeemerId epochNo slotNo deleg + Right (ConwayTxCertDeleg deleg) -> insertConwayDelegCert tracer cache network txId idx mRedeemerId epochNo slotNo deleg Right (ConwayTxCertPool pool) -> insertPoolCert tracer cache isMember network epochNo blkId txId idx pool Right (ConwayTxCertGov c) -> case c of ConwayRegDRep cred coin anchor -> @@ -629,14 +629,15 @@ insertDelegCert :: SlotNo -> ShelleyDelegCert StandardCrypto -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertDelegCert _tracer cache network txId idx mRedeemerId epochNo slotNo dCert = +insertDelegCert tracer cache network txId idx mRedeemerId epochNo slotNo dCert = case dCert of ShelleyRegCert cred -> insertStakeRegistration epochNo txId idx $ Generic.annotateStakingCred network cred ShelleyUnRegCert cred -> insertStakeDeregistration cache network epochNo txId idx mRedeemerId cred - ShelleyDelegCert cred poolkh -> insertDelegation cache network epochNo slotNo txId idx mRedeemerId cred poolkh + ShelleyDelegCert cred poolkh -> insertDelegation tracer cache network epochNo slotNo txId idx mRedeemerId cred poolkh insertConwayDelegCert :: (MonadBaseControl IO m, MonadIO m) => + Trace IO Text -> Cache -> Ledger.Network -> DB.TxId -> @@ -646,7 +647,7 @@ insertConwayDelegCert :: SlotNo -> ConwayDelegCert StandardCrypto -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertConwayDelegCert cache network txId idx mRedeemerId epochNo slotNo dCert = +insertConwayDelegCert trce cache network txId idx mRedeemerId epochNo slotNo dCert = case dCert of ConwayRegCert cred _dep -> insertStakeRegistration epochNo txId idx $ Generic.annotateStakingCred network cred ConwayUnRegCert cred _dep -> insertStakeDeregistration cache network epochNo txId idx mRedeemerId cred @@ -656,10 +657,10 @@ insertConwayDelegCert cache network txId idx mRedeemerId epochNo slotNo dCert = insertDeleg cred delegatee where insertDeleg cred = \case - DelegStake poolkh -> insertDelegation cache network epochNo slotNo txId idx mRedeemerId cred poolkh + DelegStake poolkh -> insertDelegation trce cache network epochNo slotNo txId idx mRedeemerId cred poolkh DelegVote drep -> insertDelegationVote cache network txId idx cred drep DelegStakeVote poolkh drep -> do - insertDelegation cache network epochNo slotNo txId idx mRedeemerId cred poolkh + insertDelegation trce cache network epochNo slotNo txId idx mRedeemerId cred poolkh insertDelegationVote cache network txId idx cred drep insertPoolRegister :: @@ -860,6 +861,7 @@ insertStakeDeregistration cache network epochNo txId idx mRedeemerId cred = do insertDelegation :: (MonadBaseControl IO m, MonadIO m) => + Trace IO Text -> Cache -> Ledger.Network -> EpochNo -> @@ -870,9 +872,22 @@ insertDelegation :: StakeCred -> Ledger.KeyHash 'Ledger.StakePool StandardCrypto -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertDelegation cache network (EpochNo epoch) slotNo txId idx mRedeemerId cred poolkh = do +insertDelegation trce cache network (EpochNo epoch) slotNo txId idx mRedeemerId cred poolkh = do addrId <- liftLookupFail "insertDelegation" $ queryStakeAddrWithCache cache CacheNew network cred - poolHashId <- liftLookupFail "insertDelegation" $ queryPoolKeyWithCache cache CacheNew poolkh + -- poolHashId <- liftLookupFail "insertDelegation" $ queryPoolKeyWithCache cache CacheNew poolkh + poolHashId <- do + mpoolHashId <- lift $ queryPoolKeyWithCache cache CacheNew poolkh + case mpoolHashId of + Left _err -> do + liftIO $ logWarning trce $ + mconcat + ["insertDelegation to an unregistered pool " + , textShow poolkh + , ". We will assume that the pool exists and move on." + , " See issue https://github.com/input-output-hk/cardano-ledger/issues/3802" + ] + lift $ insertPoolKeyWithCache cache CacheNew poolkh + Right poolHashId -> pure poolHashId void . lift . DB.insertDelegation $ DB.Delegation { DB.delegationAddrId = addrId