{-# LANGUAGE NamedFieldPuns #-}

module Cardano.Chain.Update.Validation.Interface.ProtocolVersionBump
  ( Environment (..),
    State (..),
    tryBumpVersion,
  )
where

import Cardano.Chain.Common.BlockCount (BlockCount)
import Cardano.Chain.ProtocolConstants (kUpdateStabilityParam)
import Cardano.Chain.Slotting (SlotNumber, addSlotCount)
import Cardano.Chain.Update.ProtocolParameters (ProtocolParameters)
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import Cardano.Chain.Update.Validation.Endorsement
  ( CandidateProtocolUpdate (CandidateProtocolUpdate),
    cpuProtocolParameters,
    cpuProtocolVersion,
    cpuSlot,
  )
import Cardano.Prelude hiding (State)

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
  }

-- | Change the protocol version when an epoch change is detected, and there is
-- a candidate protocol update that was confirmed at least @4 * k@ slots before
-- the start of the new epoch, where @k@ is the chain security parameter.
--
-- For a full history of why this is required, see
-- https://github.com/input-output-hk/cardano-ledger/issues/1288
--
-- This corresponds to the @PVBUMP@ rules in the Byron ledger specification.
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
x -> SlotCount -> SlotNumber -> SlotNumber
addSlotCount (BlockCount -> SlotCount
kUpdateStabilityParam BlockCount
k) SlotNumber
x SlotNumber -> SlotNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= 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