From b44eb735fe64fe4e8079935df722d0a32a41c2a4 Mon Sep 17 00:00:00 2001 From: Kostas Dermentzis Date: Thu, 7 Sep 2023 12:26:16 +0300 Subject: [PATCH] Integrate node changes Signed-off-by: Kostas Dermentzis --- cardano-db-sync/cardano-db-sync.cabal | 1 + .../src/Cardano/DbSync/Config/Cardano.hs | 113 ++++++++++-------- .../DbSync/Era/Shelley/Generic/ProtoParams.hs | 3 +- .../DbSync/Era/Shelley/Generic/Tx/Alonzo.hs | 13 +- .../DbSync/Era/Shelley/Generic/Tx/Conway.hs | 3 +- .../DbSync/Era/Shelley/Generic/Tx/Types.hs | 2 +- .../DbSync/Era/Shelley/Generic/Util.hs | 5 +- .../src/Cardano/DbSync/Era/Shelley/Insert.hs | 89 ++++++++------ .../src/Cardano/DbSync/Fix/PlutusScripts.hs | 3 +- .../src/Cardano/DbSync/Ledger/State.hs | 17 +-- 10 files changed, 136 insertions(+), 113 deletions(-) diff --git a/cardano-db-sync/cardano-db-sync.cabal b/cardano-db-sync/cardano-db-sync.cabal index f81ece9e3..e21671866 100644 --- a/cardano-db-sync/cardano-db-sync.cabal +++ b/cardano-db-sync/cardano-db-sync.cabal @@ -166,6 +166,7 @@ library , containers , contra-tracer , directory + , data-default-class , either , esqueleto , extra diff --git a/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs b/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs index c3470bc4c..23442ce1c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Config/Cardano.hs @@ -26,14 +26,14 @@ import Cardano.DbSync.Types import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis) import Cardano.Ledger.Binary.Version import Cardano.Ledger.Conway.Genesis -import Cardano.Ledger.Keys import Cardano.Ledger.Shelley.Translation (emptyFromByronTranslationContext) import Control.Monad.Trans.Except (ExceptT) +import Data.Default.Class (Default (def)) import Data.Word (Word64) import Ouroboros.Consensus.Block.Forging import Ouroboros.Consensus.Cardano (Nonce (..), ProtVer (ProtVer)) import qualified Ouroboros.Consensus.Cardano as Consensus -import qualified Ouroboros.Consensus.Cardano.Node as Consensus +import Ouroboros.Consensus.Cardano.Node import Ouroboros.Consensus.Config (TopLevelConfig (..)) import Ouroboros.Consensus.Ledger.Basics (LedgerConfig) import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits @@ -41,7 +41,6 @@ import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo) import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..)) -import qualified Ouroboros.Consensus.Shelley.Node.Praos as Consensus -- Usually only one constructor, but may have two when we are preparing for a HFC event. data GenesisConfig @@ -84,53 +83,67 @@ mkProtocolInfoCardano :: GenesisConfig -> [Consensus.ShelleyLeaderCredentials StandardCrypto] -> -- this is not empty only in tests (ProtocolInfo CardanoBlock, IO [BlockForging IO CardanoBlock]) -mkProtocolInfoCardano ge shelleyCred = - case ge of - GenesisCardano dnc byronGenesis shelleyGenesis alonzoGenesis -> - Consensus.protocolInfoCardano - Consensus.ProtocolParamsByron - { Consensus.byronGenesis = byronGenesis - , Consensus.byronPbftSignatureThreshold = Consensus.PBftSignatureThreshold <$> dncPBftSignatureThreshold dnc - , Consensus.byronProtocolVersion = dncByronProtocolVersion dnc - , Consensus.byronSoftwareVersion = mkByronSoftwareVersion - , Consensus.byronLeaderCredentials = Nothing - , Consensus.byronMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure - } - Consensus.ProtocolParamsShelleyBased - { Consensus.shelleyBasedGenesis = scConfig shelleyGenesis - , Consensus.shelleyBasedInitialNonce = shelleyPraosNonce shelleyGenesis - , Consensus.shelleyBasedLeaderCredentials = shelleyCred - } - Consensus.ProtocolParamsShelley - { Consensus.shelleyProtVer = mkProtVer 3 0 - , Consensus.shelleyMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure - } - Consensus.ProtocolParamsAllegra - { Consensus.allegraProtVer = mkProtVer 4 0 - , Consensus.allegraMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure - } - Consensus.ProtocolParamsMary - { Consensus.maryProtVer = mkProtVer 5 0 - , Consensus.maryMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure - } - Consensus.ProtocolParamsAlonzo - { Consensus.alonzoProtVer = mkProtVer 7 0 - , Consensus.alonzoMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure - } - Consensus.ProtocolParamsBabbage - { Consensus.babbageProtVer = mkProtVer 9 0 - , Consensus.babbageMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure - } - Consensus.ProtocolParamsConway - { Consensus.conwayProtVer = mkProtVer 10 0 - , Consensus.conwayMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure -- TODO: Conway - } - (Consensus.ProtocolTransitionParamsShelleyBased emptyFromByronTranslationContext $ dncShelleyHardFork dnc) -- TODO: Conway Fix - (Consensus.ProtocolTransitionParamsShelleyBased () $ dncAllegraHardFork dnc) - (Consensus.ProtocolTransitionParamsShelleyBased () $ dncMaryHardFork dnc) - (Consensus.ProtocolTransitionParamsShelleyBased alonzoGenesis $ dncAlonzoHardFork dnc) - (Consensus.ProtocolTransitionParamsShelleyBased () $ dncBabbageHardFork dnc) - (Consensus.ProtocolTransitionParamsShelleyBased (ConwayGenesis (GenDelegs mempty)) $ dncConwayHardFork dnc) -- TODO: Conway Fix +mkProtocolInfoCardano (GenesisCardano dnc bGenesis shelleyGenesis alonzoGenesis) shelleyCred = + protocolInfoCardano $ + CardanoProtocolParams + { paramsByron = + Consensus.ProtocolParamsByron + { Consensus.byronGenesis = bGenesis + , Consensus.byronPbftSignatureThreshold = Consensus.PBftSignatureThreshold <$> dncPBftSignatureThreshold dnc + , Consensus.byronProtocolVersion = dncByronProtocolVersion dnc + , Consensus.byronSoftwareVersion = mkByronSoftwareVersion + , Consensus.byronLeaderCredentials = Nothing + , Consensus.byronMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure + } + , paramsShelleyBased = + Consensus.ProtocolParamsShelleyBased + { Consensus.shelleyBasedGenesis = scConfig shelleyGenesis + , Consensus.shelleyBasedInitialNonce = shelleyPraosNonce shelleyGenesis + , Consensus.shelleyBasedLeaderCredentials = shelleyCred + } + , paramsShelley = + Consensus.ProtocolParamsShelley + { Consensus.shelleyProtVer = mkProtVer 3 0 + , Consensus.shelleyMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure + } + , paramsAllegra = + Consensus.ProtocolParamsAllegra + { Consensus.allegraProtVer = mkProtVer 4 0 + , Consensus.allegraMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure + } + , paramsMary = + Consensus.ProtocolParamsMary + { Consensus.maryProtVer = mkProtVer 5 0 + , Consensus.maryMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure + } + , paramsAlonzo = + Consensus.ProtocolParamsAlonzo + { Consensus.alonzoProtVer = mkProtVer 7 0 + , Consensus.alonzoMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure + } + , paramsBabbage = + Consensus.ProtocolParamsBabbage + { Consensus.babbageProtVer = mkProtVer 9 0 + , Consensus.babbageMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure + } + , paramsConway = + Consensus.ProtocolParamsConway + { Consensus.conwayProtVer = mkProtVer 10 0 + , Consensus.conwayMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure -- TODO: Conway + } + , transitionParamsByronToShelley = + Consensus.ProtocolTransitionParamsByronToShelley emptyFromByronTranslationContext (dncShelleyHardFork dnc) -- TODO: Conway Fix + , transitionParamsShelleyToAllegra = + Consensus.ProtocolTransitionParamsIntraShelley () (dncAllegraHardFork dnc) + , transitionParamsAllegraToMary = + Consensus.ProtocolTransitionParamsIntraShelley () (dncMaryHardFork dnc) + , transitionParamsMaryToAlonzo = + Consensus.ProtocolTransitionParamsIntraShelley alonzoGenesis (dncAlonzoHardFork dnc) + , transitionParamsAlonzoToBabbage = + Consensus.ProtocolTransitionParamsIntraShelley () (dncBabbageHardFork dnc) + , transitionParamsBabbageToConway = + Consensus.ProtocolTransitionParamsIntraShelley (ConwayGenesis def) (dncConwayHardFork dnc) -- TODO: Conway Fix + } shelleyPraosNonce :: ShelleyConfig -> Nonce shelleyPraosNonce sCfg = Nonce (Crypto.castHash . unGenesisHashShelley $ scGenesisHash sCfg) diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs index 7f8be96e5..b45449f08 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs @@ -70,9 +70,10 @@ epochProtoParams lstate = LedgerStateConway st -> Just $ fromConwayParams $ getProtoParams st getProtoParams :: + EraGov era => LedgerState (ShelleyBlock p era) -> PParams era -getProtoParams = Shelley.esPp . Shelley.nesEs . Consensus.shelleyLedgerState +getProtoParams st = Shelley.nesEs (Consensus.shelleyLedgerState st) ^. Shelley.curPParamsEpochStateL -- ------------------------------------------------------------------------------------------------- diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs index 7fe2c3c23..e4c68f7bc 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Alonzo.hs @@ -37,7 +37,7 @@ import Cardano.DbSync.Era.Shelley.Generic.Witness import Cardano.DbSync.Types (DataHash) import qualified Cardano.Ledger.Address as Ledger import qualified Cardano.Ledger.Alonzo.Language as Alonzo -import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), txscriptfee) +import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), txscriptfee, unBinaryPlutus) import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), getAlonzoTxAuxDataScripts) @@ -64,6 +64,7 @@ import qualified Data.Set as Set #if __GLASGOW_HASKELL__ >= 906 import Data.Type.Equality (type (~)) #endif +import Cardano.Ledger.Language (Plutus (..)) import Lens.Micro import Ouroboros.Consensus.Cardano.Block (EraCrypto, StandardAlonzo, StandardCrypto) @@ -295,9 +296,9 @@ mkTxScript (hsh, script) = getScriptType = case script of Alonzo.TimelockScript {} -> Timelock - Alonzo.PlutusScript Alonzo.PlutusV1 _s -> PlutusV1 - Alonzo.PlutusScript Alonzo.PlutusV2 _s -> PlutusV2 - Alonzo.PlutusScript Alonzo.PlutusV3 _s -> PlutusV3 + Alonzo.PlutusScript (Plutus Alonzo.PlutusV1 _s) -> PlutusV1 + Alonzo.PlutusScript (Plutus Alonzo.PlutusV2 _s) -> PlutusV2 + Alonzo.PlutusScript (Plutus Alonzo.PlutusV3 _s) -> PlutusV3 timelockJsonScript :: Maybe ByteString timelockJsonScript = @@ -310,7 +311,7 @@ mkTxScript (hsh, script) = plutusCborScript = case script of Alonzo.TimelockScript {} -> Nothing - plutusScript -> Just $ Ledger.originalBytes plutusScript + plScript -> Just $ Ledger.originalBytes plScript getPlutusSizes :: forall era. @@ -330,7 +331,7 @@ getPlutusScriptSize :: Alonzo.AlonzoScript era -> Maybe Word64 getPlutusScriptSize script = case script of Alonzo.TimelockScript {} -> Nothing - Alonzo.PlutusScript _lang sbs -> Just $ fromIntegral (SBS.length sbs) + Alonzo.PlutusScript (Plutus _lang sbs) -> Just $ fromIntegral (SBS.length $ unBinaryPlutus sbs) txDataWitness :: (Core.TxWits era ~ Alonzo.AlonzoTxWits era, Core.EraTx era, EraCrypto era ~ StandardCrypto) => diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs index 3998bab81..c45525b7f 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Conway.hs @@ -18,6 +18,7 @@ import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import Cardano.Ledger.Babbage.Core as Core hiding (Tx, TxOut) import Cardano.Ledger.BaseTypes +import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.TxBody import qualified Cardano.Ledger.Core as Core import Cardano.Prelude @@ -65,7 +66,7 @@ fromConwayTx ioExtraPlutus mprices (blkIndex, tx) = , txScriptSizes = getPlutusSizes tx , txScripts = getScripts tx , txExtraKeyWitnesses = extraKeyWits txBody - , txVotingProcedure = toList $ ctbVotingProcedures txBody + , txVotingProcedure = Map.toList $ fmap Map.toList (unVotingProcedures $ ctbVotingProcedures txBody) , txProposalProcedure = toList $ ctbProposalProcedures txBody } where diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs index 454d99b88..d247c0d2c 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Tx/Types.hs @@ -61,7 +61,7 @@ data Tx = Tx , txScriptSizes :: [Word64] -- this contains only the sizes of plutus scripts in witnesses , txScripts :: [TxScript] , txExtraKeyWitnesses :: ![ByteString] - , txVotingProcedure :: ![VotingProcedure StandardConway] + , txVotingProcedure :: ![(Voter StandardCrypto, [(GovActionId StandardCrypto, VotingProcedure StandardConway)])] , txProposalProcedure :: ![ProposalProcedure StandardConway] } diff --git a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs index 808d37a12..bf3ad2c30 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Util.hs @@ -43,7 +43,6 @@ import qualified Cardano.Ledger.Address as Ledger import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Coin (Coin (..), DeltaCoin) import Cardano.Ledger.Conway.Governance -import qualified Cardano.Ledger.Conway.Governance as Ledger import qualified Cardano.Ledger.Credential as Ledger import qualified Cardano.Ledger.Keys as Ledger import Cardano.Ledger.Mary.Value (AssetName (..)) @@ -157,10 +156,10 @@ unAssetName = SBS.fromShort . assetName dataHashToBytes :: DataHash -> ByteString dataHashToBytes = Crypto.hashToBytes . Ledger.extractHash -achorHashToBytes :: Ledger.SafeHash StandardCrypto Ledger.AnchorDataHash -> ByteString +achorHashToBytes :: Ledger.SafeHash StandardCrypto Ledger.AnchorData -> ByteString achorHashToBytes = Crypto.hashToBytes . Ledger.extractHash -toGovAction :: GovernanceAction StandardConway -> Db.GovActionType +toGovAction :: GovAction StandardConway -> Db.GovActionType toGovAction = \case ParameterChange {} -> Db.ParameterChange HardForkInitiation {} -> Db.HardForkInitiation 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 0684fbd27..8d6392c55 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Insert.hs @@ -207,12 +207,12 @@ insertShelleyBlock syncEnv shouldLog withinTwoMins withinHalfHour blk details is | otherwise = logDebug renderInsertName :: Generic.BlockEra -> Text - renderInsertName eraName = - mconcat ["Insert ", textShow eraName, " Block"] + renderInsertName eraText = + mconcat ["Insert ", textShow eraText, " Block"] renderErrorMessage :: Generic.BlockEra -> Text - renderErrorMessage eraName = - case eraName of + renderErrorMessage eraText = + case eraText of Generic.Shelley -> "insertShelleyBlock" other -> mconcat ["insertShelleyBlock(", textShow other, ")"] @@ -346,7 +346,7 @@ insertTx syncEnv isMember blkId epochNo slotNo depositsMap blockIndex tx grouped mapM_ (insertExtraKeyWitness tracer txId) $ Generic.txExtraKeyWitnesses tx mapM_ (lift . insertGovernanceAction cache network blkId txId) $ zip [0 ..] (Generic.txProposalProcedure tx) - mapM_ (insertVotingProcedure cache txId) $ zip [0 ..] (Generic.txVotingProcedure tx) + mapM_ (insertVotingProcedures cache txId) (Generic.txVotingProcedure tx) let !txIns = map (prepareTxIn txId redeemers) resolvedInputs pure (grouped <> BlockGroupedData txIns txOutsGrouped txMetadata maTxMint fees outSum) @@ -507,8 +507,9 @@ insertCertificate tracer cache isMember network blkId txId epochNo slotNo redeem liftIO $ logWarning tracer "insertCertificate: Unhandled DCertGenesis certificate" Right (ConwayTxCertDeleg deleg) -> insertConwayDelegCert cache network txId idx mRedeemerId epochNo slotNo deleg Right (ConwayTxCertPool pool) -> insertPoolCert tracer cache isMember network epochNo blkId txId idx pool - Right (ConwayTxCertCommittee c) -> case c of - ConwayRegDRep cred coin -> + Right (ConwayTxCertGov c) -> case c of + ConwayRegDRep cred coin _anchor -> + -- TODO: Conway handle anchor lift $ insertDrepRegistration txId idx cred coin ConwayUnRegDRep cred coin -> lift $ insertDrepDeRegistration txId idx cred coin @@ -516,6 +517,8 @@ insertCertificate tracer cache isMember network blkId txId epochNo slotNo redeem lift $ insertCommitteeRegistration txId idx khCold khHot ConwayResignCommitteeColdKey khCold -> lift $ insertCommitteeDeRegistration txId idx khCold + ConwayUpdateDRep {} -> + liftIO $ logWarning tracer "insertCertificate: Unhandled ConwayUpdateDRep certificate" where mRedeemerId = mlookup ridx redeemers @@ -523,37 +526,37 @@ insertCommitteeRegistration :: (MonadBaseControl IO m, MonadIO m) => DB.TxId -> Word16 -> - KeyHash 'CommitteeColdKey c -> - KeyHash 'CommitteeHotKey c -> + Ledger.Credential 'ColdCommitteeRole StandardCrypto -> + Ledger.Credential 'HotCommitteeRole StandardCrypto -> ReaderT SqlBackend m () insertCommitteeRegistration txId idx khCold khHot = do void . DB.insertCommitteeRegistration $ DB.CommitteeRegistration { DB.committeeRegistrationTxId = txId , DB.committeeRegistrationCertIndex = idx - , DB.committeeRegistrationColdKey = Generic.unKeyHashRaw khCold - , DB.committeeRegistrationHotKey = Generic.unKeyHashRaw khHot + , DB.committeeRegistrationColdKey = Generic.unCredentialHash khCold + , DB.committeeRegistrationHotKey = Generic.unCredentialHash khHot } insertCommitteeDeRegistration :: (MonadBaseControl IO m, MonadIO m) => DB.TxId -> Word16 -> - KeyHash 'CommitteeColdKey c -> + Ledger.Credential 'ColdCommitteeRole StandardCrypto -> ReaderT SqlBackend m () insertCommitteeDeRegistration txId idx khCold = do void . DB.insertCommitteeDeRegistration $ DB.CommitteeDeRegistration { DB.committeeDeRegistrationTxId = txId , DB.committeeDeRegistrationCertIndex = idx - , DB.committeeDeRegistrationHotKey = Generic.unKeyHashRaw khCold + , DB.committeeDeRegistrationHotKey = Generic.unCredentialHash khCold } insertDrepRegistration :: (MonadBaseControl IO m, MonadIO m) => DB.TxId -> Word16 -> - Ledger.Credential 'Voting StandardCrypto -> + Ledger.Credential 'DRepRole StandardCrypto -> Coin -> ReaderT SqlBackend m () insertDrepRegistration txId idx cred coin = do @@ -570,7 +573,7 @@ insertDrepDeRegistration :: (MonadBaseControl IO m, MonadIO m) => DB.TxId -> Word16 -> - Ledger.Credential 'Voting StandardCrypto -> + Ledger.Credential 'DRepRole StandardCrypto -> Coin -> ReaderT SqlBackend m () insertDrepDeRegistration txId idx cred coin = do @@ -1378,14 +1381,13 @@ insertGovernanceAction :: DB.TxId -> (Word64, ProposalProcedure StandardConway) -> ReaderT SqlBackend m () -insertGovernanceAction cache network blkId txId (index, pp) = do +insertGovernanceAction cache _network blkId txId (index, pp) = do addrId <- - insertStakeAddressWithCache cache CacheNew txId $ - Generic.annotateStakingCred network (Ledger.KeyHashObj $ pProcReturnAddr pp) - votingAnchorId <- whenMaybe (strictMaybeToMaybe $ pProcAnchor pp) $ insertAnchor txId + insertStakeAddressWithCache cache CacheNew txId $ pProcReturnAddr pp + votingAnchorId <- insertAnchor txId $ pProcAnchor pp mParamProposalId <- - case pProcGovernanceAction pp of - ParameterChange pparams -> + case pProcGovAction pp of + ParameterChange _ pparams -> Just <$> insertParamProposal blkId txId (convertConwayParamProposal pparams) _ -> pure Nothing governanceAction <- @@ -1395,24 +1397,23 @@ insertGovernanceAction cache network blkId txId (index, pp) = do , DB.governanceActionIndex = index , DB.governanceActionDeposit = Generic.coinToDbLovelace $ pProcDeposit pp , DB.governanceActionReturnAddress = addrId - , DB.governanceActionVotingAnchorId = votingAnchorId - , DB.governanceActionType = Generic.toGovAction $ pProcGovernanceAction pp - , DB.governanceActionDescription = textShow $ pProcGovernanceAction pp + , DB.governanceActionVotingAnchorId = Just votingAnchorId + , DB.governanceActionType = Generic.toGovAction $ pProcGovAction pp + , DB.governanceActionDescription = textShow $ pProcGovAction pp , DB.governanceActionParamProposal = mParamProposalId , DB.governanceActionRatifiedEpoch = Nothing , DB.governanceActionEnactedEpoch = Nothing , DB.governanceActionDroppedEpoch = Nothing , DB.governanceActionExpiredEpoch = Nothing } - case pProcGovernanceAction pp of + case pProcGovAction pp of TreasuryWithdrawals mp -> mapM_ (insertTreasuryWithdrawal governanceAction) (Map.toList mp) - NewCommittee st quorum -> insertNewCommittee governanceAction st quorum + NewCommittee _ st committee -> insertNewCommittee governanceAction st committee _ -> pure () where insertTreasuryWithdrawal gaId (cred, coin) = do addrId <- - insertStakeAddressWithCache cache CacheNew txId $ - Generic.annotateStakingCred network cred + insertStakeAddressWithCache cache CacheNew txId cred DB.insertTreasuryWithdrawal $ DB.TreasuryWithdrawal { DB.treasuryWithdrawalGovernanceActionId = gaId @@ -1420,11 +1421,11 @@ insertGovernanceAction cache network blkId txId (index, pp) = do , DB.treasuryWithdrawalAmount = Generic.coinToDbLovelace coin } - insertNewCommittee gaId st quorum = do + insertNewCommittee gaId st committee = do void . DB.insertNewCommittee $ DB.NewCommittee { DB.newCommitteeGovernanceActionId = gaId - , DB.newCommitteeQuorum = realToFrac quorum + , DB.newCommitteeQuorum = Generic.unitIntervalToDouble $ committeeQuorum committee , DB.newCommitteeMembers = textShow st } @@ -1437,16 +1438,26 @@ insertAnchor txId anchor = , DB.votingAnchorDataHash = Generic.achorHashToBytes $ anchorDataHash anchor } +insertVotingProcedures :: + (MonadIO m, MonadBaseControl IO m) => + Cache -> + DB.TxId -> + (Voter StandardCrypto, [(GovActionId StandardCrypto, VotingProcedure StandardConway)]) -> + ExceptT SyncNodeError (ReaderT SqlBackend m) () +insertVotingProcedures cache txId (voter, actions) = + mapM_ (insertVotingProcedure cache txId voter) (zip [0 ..] actions) + insertVotingProcedure :: (MonadIO m, MonadBaseControl IO m) => Cache -> DB.TxId -> - (Word16, VotingProcedure StandardConway) -> + Voter StandardCrypto -> + (Word16, (GovActionId StandardCrypto, VotingProcedure StandardConway)) -> ExceptT SyncNodeError (ReaderT SqlBackend m) () -insertVotingProcedure cache txId (index, vp) = do - govActionId <- resolveGovernanceAction (vProcGovActionId vp) +insertVotingProcedure cache txId voter (index, (gaId, vp)) = do + govActionId <- resolveGovernanceAction gaId votingAnchorId <- whenMaybe (strictMaybeToMaybe $ vProcAnchor vp) $ lift . insertAnchor txId - (mComitteeVoter, mDRepVoter, mStakePoolVoter) <- case vProcVoter vp of + (mComitteeVoter, mDRepVoter, mStakePoolVoter) <- case voter of CommitteeVoter cred -> pure (Just $ Generic.unCredentialHash cred, Nothing, Nothing) DRepVoter cred -> do @@ -1463,14 +1474,14 @@ insertVotingProcedure cache txId (index, vp) = do , DB.votingProcedureComitteeVoter = mComitteeVoter , DB.votingProcedureDrepVoter = mDRepVoter , DB.votingProcedurePoolVoter = mStakePoolVoter - , DB.votingProcedureVoterRole = Generic.toVoterRole $ vProcVoter vp + , DB.votingProcedureVoterRole = Generic.toVoterRole voter , DB.votingProcedureVote = Generic.toVote $ vProcVote vp , DB.votingProcedureVotingAnchorId = votingAnchorId } resolveGovernanceAction :: MonadIO m => - GovernanceActionId StandardCrypto -> + GovActionId StandardCrypto -> ExceptT SyncNodeError (ReaderT SqlBackend m) DB.GovernanceActionId resolveGovernanceAction gaId = do gaTxId <- @@ -1478,9 +1489,9 @@ resolveGovernanceAction gaId = do DB.queryTxId $ Generic.unTxHash $ gaidTxId gaId - let (GovernanceActionIx index) = gaidGovActionIx gaId + let (GovActionIx index) = gaidGovActionIx gaId liftLookupFail "resolveGovernanceAction.queryGovernanceActionId" $ - DB.queryGovernanceActionId gaTxId index + DB.queryGovernanceActionId gaTxId (fromIntegral index) -- TODO: Use Word32? insertDrep :: (MonadBaseControl IO m, MonadIO m) => DRep StandardCrypto -> ReaderT SqlBackend m DB.DrepHashId insertDrep = \case @@ -1500,7 +1511,7 @@ insertDrep = \case , DB.drepHashHasScript = False } -insertCredDrepHash :: (MonadBaseControl IO m, MonadIO m) => Ledger.Credential 'Voting StandardCrypto -> ReaderT SqlBackend m DB.DrepHashId +insertCredDrepHash :: (MonadBaseControl IO m, MonadIO m) => Ledger.Credential 'DRepRole StandardCrypto -> ReaderT SqlBackend m DB.DrepHashId insertCredDrepHash cred = do DB.insertDrepHash DB.DrepHash diff --git a/cardano-db-sync/src/Cardano/DbSync/Fix/PlutusScripts.hs b/cardano-db-sync/src/Cardano/DbSync/Fix/PlutusScripts.hs index 37f470050..ccbba09ac 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Fix/PlutusScripts.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Fix/PlutusScripts.hs @@ -49,6 +49,7 @@ import Ouroboros.Consensus.Cardano.Block (HardForkBlock (BlockAllegra, BlockAlon import Ouroboros.Consensus.Shelley.Eras import Cardano.DbSync.Fix.PlutusDataBytes +import Cardano.Ledger.Language (Plutus (..)) newtype FixPlutusScripts = FixPlutusScripts {scriptsInfo :: [FixPlutusInfo]} @@ -109,7 +110,7 @@ findWrongPlutusScripts tracer = hashPlutusScript dbScript = do lang <- getLang bytes <- maybeToEither "No bytes found for plutus script" id $ DB_V_13_0.scriptBytes dbScript - let script :: AlonzoScript StandardAlonzo = PlutusScript lang (SBS.toShort bytes) + let script :: AlonzoScript StandardAlonzo = PlutusScript (Plutus lang (BinaryPlutus $ SBS.toShort bytes)) let hsh :: Ledger.ScriptHash StandardCrypto = Ledger.hashScript @StandardAlonzo script Right $ Generic.unScriptHash hsh where diff --git a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs index 755c9be4d..9f535fd21 100644 --- a/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs +++ b/cardano-db-sync/src/Cardano/DbSync/Ledger/State.hs @@ -45,7 +45,6 @@ import Cardano.Ledger.Alonzo.Scripts import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Era (EraCrypto) import Cardano.Ledger.Shelley.AdaPots (AdaPots) -import Cardano.Ledger.Shelley.LedgerState (EpochState (..)) import qualified Cardano.Ledger.Shelley.LedgerState as Shelley import Cardano.Prelude hiding (atomically) import Cardano.Slotting.Block (BlockNo (..)) @@ -787,19 +786,15 @@ getPrices :: CardanoLedgerState -> Strict.Maybe Prices getPrices st = case ledgerState $ clsState st of LedgerStateAlonzo als -> Strict.Just - ( esPp - ( Shelley.nesEs $ - Consensus.shelleyLedgerState als - ) - ^. Alonzo.ppPricesL + ( Shelley.nesEs (Consensus.shelleyLedgerState als) + ^. Shelley.curPParamsEpochStateL + . Alonzo.ppPricesL ) LedgerStateBabbage bls -> Strict.Just - ( esPp - ( Shelley.nesEs $ - Consensus.shelleyLedgerState bls - ) - ^. Alonzo.ppPricesL + ( Shelley.nesEs (Consensus.shelleyLedgerState bls) + ^. Shelley.curPParamsEpochStateL + . Alonzo.ppPricesL ) _ -> Strict.Nothing