{-# 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
  }

-- | 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-specs/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 -> 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