diff --git a/cardano-ledger/src/Cardano/Chain/Block/Validation.hs b/cardano-ledger/src/Cardano/Chain/Block/Validation.hs index 9774785b..61f07915 100644 --- a/cardano-ledger/src/Cardano/Chain/Block/Validation.hs +++ b/cardano-ledger/src/Cardano/Chain/Block/Validation.hs @@ -497,7 +497,7 @@ updateHeader bvmode env st h = do `orThrowError` ChainValidationHeaderTooLarge maxHeaderSize (headerLength h) -- Perform epoch transition - epochTransition epochEnv st (headerSlot h) + pure $! epochTransition epochEnv st (headerSlot h) where maxHeaderSize = Update.ppMaxHeaderSize $ UPI.adoptedProtocolParameters st @@ -530,16 +530,13 @@ data EpochEnvironment = EpochEnvironment -- confirmed proposals and cleans up the state. This corresponds to the EPOCH -- rules from the Byron chain specification. epochTransition - :: MonadError ChainValidationError m - => EpochEnvironment + :: EpochEnvironment -> UPI.State -> SlotNumber - -> m UPI.State + -> UPI.State epochTransition env st slot = if nextEpoch > currentEpoch - then - UPI.registerEpoch updateEnv st nextEpoch - `wrapError` ChainValidationUpdateError - else pure st + then UPI.registerEpoch updateEnv st nextEpoch + else st where EpochEnvironment { protocolMagic, k, numGenKeys, delegationMap, currentEpoch } = env diff --git a/cardano-ledger/src/Cardano/Chain/Update/Validation/Interface.hs b/cardano-ledger/src/Cardano/Chain/Update/Validation/Interface.hs index bd220b27..813d1a0b 100644 --- a/cardano-ledger/src/Cardano/Chain/Update/Validation/Interface.hs +++ b/cardano-ledger/src/Cardano/Chain/Update/Validation/Interface.hs @@ -368,12 +368,11 @@ registerEndorsement env st endorsement = do -- -- This corresponds to the @UPIEC@ rules in the Byron ledger specification. registerEpoch - :: MonadError Error m - => Environment + :: Environment -> State -> EpochNumber -- ^ Epoch seen on the block. - -> m State + -> State registerEpoch env st lastSeenEpoch = do let PVBump.State currentEpoch' @@ -387,22 +386,21 @@ registerEpoch env st lastSeenEpoch = do -- therefore the protocol parameters cannot change) or there are no -- update proposals that can be adopted (either because there are no -- candidates or they do not fulfill the requirements for adoption). - pure $! st + st else -- We have a new protocol version, so we update the current protocol -- version and parameters, and we perform a cleanup of the state -- variables. - pure $! - st { currentEpoch = currentEpoch' - , adoptedProtocolVersion = adoptedProtocolVersion' - , adoptedProtocolParameters = nextProtocolParameters' - , candidateProtocolUpdates = [] - , registeredProtocolUpdateProposals = M.empty - , confirmedProposals = M.empty - , proposalVotes = M.empty - , registeredEndorsements = S.empty - , proposalRegistrationSlot = M.empty - } + st { currentEpoch = currentEpoch' + , adoptedProtocolVersion = adoptedProtocolVersion' + , adoptedProtocolParameters = nextProtocolParameters' + , candidateProtocolUpdates = [] + , registeredProtocolUpdateProposals = M.empty + , confirmedProposals = M.empty + , proposalVotes = M.empty + , registeredEndorsements = S.empty + , proposalRegistrationSlot = M.empty + } where subEnv = PVBump.Environment k currentSlot candidateProtocolUpdates