{-# 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/intersectmbo/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 =
      forall a. (a -> Bool) -> [a] -> [a]
filter
        ((\SlotNumber
x -> SlotCount -> SlotNumber -> SlotNumber
addSlotCount (BlockCount -> SlotCount
kUpdateStabilityParam BlockCount
k) SlotNumber
x forall a. Ord a => a -> a -> Bool
<= SlotNumber
epochFirstSlot) 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