{-# LANGUAGE NamedFieldPuns #-}
module Cardano.Chain.Update.Validation.Interface.ProtocolVersionBump
( Environment (..)
, State (..)
, tryBumpVersion
)
where
import Cardano.Prelude hiding (State)
import Cardano.Chain.ProtocolConstants (kUpdateStabilityParam)
import Cardano.Chain.Common.BlockCount (BlockCount)
import Cardano.Chain.Slotting (SlotNumber, subSlotCount)
import Cardano.Chain.Update.ProtocolParameters (ProtocolParameters)
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import Cardano.Chain.Update.Validation.Endorsement
( CandidateProtocolUpdate(CandidateProtocolUpdate)
, cpuProtocolParameters
, cpuProtocolVersion
, cpuSlot
)
data Environment = Environment
{ Environment -> BlockCount
k :: !BlockCount
, Environment -> SlotNumber
epochFirstSlot :: !SlotNumber
, Environment -> [CandidateProtocolUpdate]
candidateProtocolVersions :: ![CandidateProtocolUpdate]
}
data State = State
{ State -> ProtocolVersion
nextProtocolVersion :: !ProtocolVersion
, State -> ProtocolParameters
nextProtocolParameters :: !ProtocolParameters
}
tryBumpVersion
:: Environment
-> State
-> State
tryBumpVersion :: Environment -> State -> State
tryBumpVersion Environment
env State
st =
case [CandidateProtocolUpdate]
stableCandidates of
(CandidateProtocolUpdate
newestStable:[CandidateProtocolUpdate]
_) ->
let CandidateProtocolUpdate
{ ProtocolVersion
cpuProtocolVersion :: ProtocolVersion
cpuProtocolVersion :: CandidateProtocolUpdate -> ProtocolVersion
cpuProtocolVersion
, ProtocolParameters
cpuProtocolParameters :: ProtocolParameters
cpuProtocolParameters :: CandidateProtocolUpdate -> ProtocolParameters
cpuProtocolParameters
} = CandidateProtocolUpdate
newestStable
in
State
st { nextProtocolVersion :: ProtocolVersion
nextProtocolVersion = ProtocolVersion
cpuProtocolVersion
, nextProtocolParameters :: ProtocolParameters
nextProtocolParameters = ProtocolParameters
cpuProtocolParameters
}
[CandidateProtocolUpdate]
_ -> State
st
where
Environment { BlockCount
k :: BlockCount
k :: Environment -> BlockCount
k, SlotNumber
epochFirstSlot :: SlotNumber
epochFirstSlot :: Environment -> SlotNumber
epochFirstSlot, [CandidateProtocolUpdate]
candidateProtocolVersions :: [CandidateProtocolUpdate]
candidateProtocolVersions :: Environment -> [CandidateProtocolUpdate]
candidateProtocolVersions } = Environment
env
stableCandidates :: [CandidateProtocolUpdate]
stableCandidates =
(CandidateProtocolUpdate -> Bool)
-> [CandidateProtocolUpdate] -> [CandidateProtocolUpdate]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SlotNumber -> SlotNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotCount -> SlotNumber -> SlotNumber
subSlotCount (BlockCount -> SlotCount
kUpdateStabilityParam BlockCount
k) SlotNumber
epochFirstSlot) (SlotNumber -> Bool)
-> (CandidateProtocolUpdate -> SlotNumber)
-> CandidateProtocolUpdate
-> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CandidateProtocolUpdate -> SlotNumber
cpuSlot) [CandidateProtocolUpdate]
candidateProtocolVersions