{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Chain.Update.Validation.Endorsement
  ( Environment (..),
    State (..),
    Endorsement (..),
    CandidateProtocolUpdate (..),
    register,
    Error (..),
  )
where

import Cardano.Binary
  ( DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeWord8,
    encodeListLen,
    enforceSize,
  )
import Cardano.Chain.Common (BlockCount, KeyHash)
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.ProtocolConstants (kSlotSecurityParam)
import Cardano.Chain.Slotting (SlotNumber, addSlotCount)
import Cardano.Chain.Update.Proposal (UpId)
import Cardano.Chain.Update.ProtocolParameters (ProtocolParameters)
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import qualified Cardano.Chain.Update.Validation.Registration as Registration
import Cardano.Prelude hiding (State)
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import NoThunks.Class (NoThunks (..))

data Environment = Environment
  { -- | Chain stability parameter.
    Environment -> BlockCount
k :: !BlockCount,
    Environment -> SlotNumber
currentSlot :: !SlotNumber,
    Environment -> Int
adoptionThreshold :: !Int,
    Environment -> Map
delegationMap :: !Delegation.Map,
    Environment -> Map UpId SlotNumber
confirmedProposals :: !(Map UpId SlotNumber),
    Environment -> ProtocolUpdateProposals
registeredProtocolUpdateProposals :: !Registration.ProtocolUpdateProposals
  }

data State = State
  { State -> [CandidateProtocolUpdate]
candidateProtocolVersions :: ![CandidateProtocolUpdate],
    State -> Set Endorsement
registeredEndorsements :: !(Set Endorsement)
  }

data CandidateProtocolUpdate = CandidateProtocolUpdate
  { -- | Slot at which this protocol version and parameters gathered enough
    -- endorsements and became a candidate. This is used to check which
    -- versions became candidates 2k slots before the end of an epoch (and only
    -- those can be adopted at that epoch). Versions that became candidates
    -- later than 2k slots before the end of an epoch can be adopted in
    -- following epochs.
    CandidateProtocolUpdate -> SlotNumber
cpuSlot :: !SlotNumber,
    CandidateProtocolUpdate -> ProtocolVersion
cpuProtocolVersion :: !ProtocolVersion,
    CandidateProtocolUpdate -> ProtocolParameters
cpuProtocolParameters :: !ProtocolParameters
  }
  deriving (CandidateProtocolUpdate -> CandidateProtocolUpdate -> Bool
(CandidateProtocolUpdate -> CandidateProtocolUpdate -> Bool)
-> (CandidateProtocolUpdate -> CandidateProtocolUpdate -> Bool)
-> Eq CandidateProtocolUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CandidateProtocolUpdate -> CandidateProtocolUpdate -> Bool
$c/= :: CandidateProtocolUpdate -> CandidateProtocolUpdate -> Bool
== :: CandidateProtocolUpdate -> CandidateProtocolUpdate -> Bool
$c== :: CandidateProtocolUpdate -> CandidateProtocolUpdate -> Bool
Eq, Int -> CandidateProtocolUpdate -> ShowS
[CandidateProtocolUpdate] -> ShowS
CandidateProtocolUpdate -> String
(Int -> CandidateProtocolUpdate -> ShowS)
-> (CandidateProtocolUpdate -> String)
-> ([CandidateProtocolUpdate] -> ShowS)
-> Show CandidateProtocolUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CandidateProtocolUpdate] -> ShowS
$cshowList :: [CandidateProtocolUpdate] -> ShowS
show :: CandidateProtocolUpdate -> String
$cshow :: CandidateProtocolUpdate -> String
showsPrec :: Int -> CandidateProtocolUpdate -> ShowS
$cshowsPrec :: Int -> CandidateProtocolUpdate -> ShowS
Show, (forall x.
 CandidateProtocolUpdate -> Rep CandidateProtocolUpdate x)
-> (forall x.
    Rep CandidateProtocolUpdate x -> CandidateProtocolUpdate)
-> Generic CandidateProtocolUpdate
forall x. Rep CandidateProtocolUpdate x -> CandidateProtocolUpdate
forall x. CandidateProtocolUpdate -> Rep CandidateProtocolUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CandidateProtocolUpdate x -> CandidateProtocolUpdate
$cfrom :: forall x. CandidateProtocolUpdate -> Rep CandidateProtocolUpdate x
Generic)
  deriving anyclass (CandidateProtocolUpdate -> ()
(CandidateProtocolUpdate -> ()) -> NFData CandidateProtocolUpdate
forall a. (a -> ()) -> NFData a
rnf :: CandidateProtocolUpdate -> ()
$crnf :: CandidateProtocolUpdate -> ()
NFData, Context -> CandidateProtocolUpdate -> IO (Maybe ThunkInfo)
Proxy CandidateProtocolUpdate -> String
(Context -> CandidateProtocolUpdate -> IO (Maybe ThunkInfo))
-> (Context -> CandidateProtocolUpdate -> IO (Maybe ThunkInfo))
-> (Proxy CandidateProtocolUpdate -> String)
-> NoThunks CandidateProtocolUpdate
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy CandidateProtocolUpdate -> String
$cshowTypeOf :: Proxy CandidateProtocolUpdate -> String
wNoThunks :: Context -> CandidateProtocolUpdate -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CandidateProtocolUpdate -> IO (Maybe ThunkInfo)
noThunks :: Context -> CandidateProtocolUpdate -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CandidateProtocolUpdate -> IO (Maybe ThunkInfo)
NoThunks)

instance FromCBOR CandidateProtocolUpdate where
  fromCBOR :: Decoder s CandidateProtocolUpdate
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"CandidateProtocolUpdate" Int
3
    SlotNumber
-> ProtocolVersion -> ProtocolParameters -> CandidateProtocolUpdate
CandidateProtocolUpdate
      (SlotNumber
 -> ProtocolVersion
 -> ProtocolParameters
 -> CandidateProtocolUpdate)
-> Decoder s SlotNumber
-> Decoder
     s
     (ProtocolVersion -> ProtocolParameters -> CandidateProtocolUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SlotNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (ProtocolVersion -> ProtocolParameters -> CandidateProtocolUpdate)
-> Decoder s ProtocolVersion
-> Decoder s (ProtocolParameters -> CandidateProtocolUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ProtocolVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (ProtocolParameters -> CandidateProtocolUpdate)
-> Decoder s ProtocolParameters
-> Decoder s CandidateProtocolUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ProtocolParameters
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR CandidateProtocolUpdate where
  toCBOR :: CandidateProtocolUpdate -> Encoding
toCBOR CandidateProtocolUpdate
cpu =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (CandidateProtocolUpdate -> SlotNumber
cpuSlot CandidateProtocolUpdate
cpu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (CandidateProtocolUpdate -> ProtocolVersion
cpuProtocolVersion CandidateProtocolUpdate
cpu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolParameters -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (CandidateProtocolUpdate -> ProtocolParameters
cpuProtocolParameters CandidateProtocolUpdate
cpu)

data Endorsement = Endorsement
  { Endorsement -> ProtocolVersion
endorsementProtocolVersion :: !ProtocolVersion,
    Endorsement -> KeyHash
endorsementKeyHash :: !KeyHash
  }
  deriving (Endorsement -> Endorsement -> Bool
(Endorsement -> Endorsement -> Bool)
-> (Endorsement -> Endorsement -> Bool) -> Eq Endorsement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endorsement -> Endorsement -> Bool
$c/= :: Endorsement -> Endorsement -> Bool
== :: Endorsement -> Endorsement -> Bool
$c== :: Endorsement -> Endorsement -> Bool
Eq, Int -> Endorsement -> ShowS
[Endorsement] -> ShowS
Endorsement -> String
(Int -> Endorsement -> ShowS)
-> (Endorsement -> String)
-> ([Endorsement] -> ShowS)
-> Show Endorsement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endorsement] -> ShowS
$cshowList :: [Endorsement] -> ShowS
show :: Endorsement -> String
$cshow :: Endorsement -> String
showsPrec :: Int -> Endorsement -> ShowS
$cshowsPrec :: Int -> Endorsement -> ShowS
Show, Eq Endorsement
Eq Endorsement
-> (Endorsement -> Endorsement -> Ordering)
-> (Endorsement -> Endorsement -> Bool)
-> (Endorsement -> Endorsement -> Bool)
-> (Endorsement -> Endorsement -> Bool)
-> (Endorsement -> Endorsement -> Bool)
-> (Endorsement -> Endorsement -> Endorsement)
-> (Endorsement -> Endorsement -> Endorsement)
-> Ord Endorsement
Endorsement -> Endorsement -> Bool
Endorsement -> Endorsement -> Ordering
Endorsement -> Endorsement -> Endorsement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Endorsement -> Endorsement -> Endorsement
$cmin :: Endorsement -> Endorsement -> Endorsement
max :: Endorsement -> Endorsement -> Endorsement
$cmax :: Endorsement -> Endorsement -> Endorsement
>= :: Endorsement -> Endorsement -> Bool
$c>= :: Endorsement -> Endorsement -> Bool
> :: Endorsement -> Endorsement -> Bool
$c> :: Endorsement -> Endorsement -> Bool
<= :: Endorsement -> Endorsement -> Bool
$c<= :: Endorsement -> Endorsement -> Bool
< :: Endorsement -> Endorsement -> Bool
$c< :: Endorsement -> Endorsement -> Bool
compare :: Endorsement -> Endorsement -> Ordering
$ccompare :: Endorsement -> Endorsement -> Ordering
$cp1Ord :: Eq Endorsement
Ord, (forall x. Endorsement -> Rep Endorsement x)
-> (forall x. Rep Endorsement x -> Endorsement)
-> Generic Endorsement
forall x. Rep Endorsement x -> Endorsement
forall x. Endorsement -> Rep Endorsement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Endorsement x -> Endorsement
$cfrom :: forall x. Endorsement -> Rep Endorsement x
Generic)
  deriving anyclass (Endorsement -> ()
(Endorsement -> ()) -> NFData Endorsement
forall a. (a -> ()) -> NFData a
rnf :: Endorsement -> ()
$crnf :: Endorsement -> ()
NFData, Context -> Endorsement -> IO (Maybe ThunkInfo)
Proxy Endorsement -> String
(Context -> Endorsement -> IO (Maybe ThunkInfo))
-> (Context -> Endorsement -> IO (Maybe ThunkInfo))
-> (Proxy Endorsement -> String)
-> NoThunks Endorsement
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Endorsement -> String
$cshowTypeOf :: Proxy Endorsement -> String
wNoThunks :: Context -> Endorsement -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Endorsement -> IO (Maybe ThunkInfo)
noThunks :: Context -> Endorsement -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Endorsement -> IO (Maybe ThunkInfo)
NoThunks)

instance FromCBOR Endorsement where
  fromCBOR :: Decoder s Endorsement
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Endorsement" Int
2
    ProtocolVersion -> KeyHash -> Endorsement
Endorsement
      (ProtocolVersion -> KeyHash -> Endorsement)
-> Decoder s ProtocolVersion -> Decoder s (KeyHash -> Endorsement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ProtocolVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (KeyHash -> Endorsement)
-> Decoder s KeyHash -> Decoder s Endorsement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s KeyHash
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR Endorsement where
  toCBOR :: Endorsement -> Encoding
toCBOR Endorsement
sh =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Endorsement -> ProtocolVersion
endorsementProtocolVersion Endorsement
sh)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Endorsement -> KeyHash
endorsementKeyHash Endorsement
sh)

data Error
  = -- | Multiple proposals were found, which propose an update to the same
    -- protocol version.
    MultipleProposalsForProtocolVersion ProtocolVersion
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

instance ToCBOR Error where
  toCBOR :: Error -> Encoding
toCBOR (MultipleProposalsForProtocolVersion ProtocolVersion
protocolVersion) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ProtocolVersion
protocolVersion

instance FromCBOR Error where
  fromCBOR :: Decoder s Error
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Endorsement.Error" Int
2
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> ProtocolVersion -> Error
MultipleProposalsForProtocolVersion (ProtocolVersion -> Error)
-> Decoder s ProtocolVersion -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ProtocolVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
_ -> DecoderError -> Decoder s Error
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s Error)
-> DecoderError -> Decoder s Error
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Endorsement.Error" Word8
tag

-- | Register an endorsement.
--
-- This corresponds to the @UPEND@ rule.
register ::
  MonadError Error m => Environment -> State -> Endorsement -> m State
register :: Environment -> State -> Endorsement -> m State
register Environment
env State
st Endorsement
endorsement =
  case ProtocolUpdateProposals -> [(UpId, ProtocolUpdateProposal)]
forall k a. Map k a -> [(k, a)]
M.toList
    ( (ProtocolUpdateProposal -> Bool)
-> ProtocolUpdateProposals -> ProtocolUpdateProposals
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter
        ((ProtocolVersion -> ProtocolVersion -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolVersion
pv) (ProtocolVersion -> Bool)
-> (ProtocolUpdateProposal -> ProtocolVersion)
-> ProtocolUpdateProposal
-> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ProtocolUpdateProposal -> ProtocolVersion
Registration.pupProtocolVersion)
        ProtocolUpdateProposals
registeredProtocolUpdateProposals
    ) of
    -- We ignore endorsement of proposals that aren't registered
    [] -> State -> m State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
st
    -- Try to register the endorsement and check if we can adopt the proposal
    [(UpId
upId, Registration.ProtocolUpdateProposal ProtocolVersion
_ ProtocolParameters
pps')] ->
      if UpId -> Bool
isConfirmedAndStable UpId
upId
        then
          if Int
numberOfEndorsements Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
adoptionThreshold
            then -- Register the endorsement and adopt the proposal in the next epoch
            do
              let cpu :: CandidateProtocolUpdate
cpu =
                    CandidateProtocolUpdate :: SlotNumber
-> ProtocolVersion -> ProtocolParameters -> CandidateProtocolUpdate
CandidateProtocolUpdate
                      { cpuSlot :: SlotNumber
cpuSlot = SlotNumber
currentSlot,
                        cpuProtocolVersion :: ProtocolVersion
cpuProtocolVersion = ProtocolVersion
pv,
                        cpuProtocolParameters :: ProtocolParameters
cpuProtocolParameters = ProtocolParameters
pps'
                      }
                  cpus' :: [CandidateProtocolUpdate]
cpus' =
                    [CandidateProtocolUpdate]
-> CandidateProtocolUpdate -> [CandidateProtocolUpdate]
updateCandidateProtocolUpdates [CandidateProtocolUpdate]
candidateProtocolVersions CandidateProtocolUpdate
cpu
              State -> m State
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State -> m State) -> State -> m State
forall a b. (a -> b) -> a -> b
$
                State :: [CandidateProtocolUpdate] -> Set Endorsement -> State
State
                  { candidateProtocolVersions :: [CandidateProtocolUpdate]
candidateProtocolVersions = [CandidateProtocolUpdate]
cpus',
                    registeredEndorsements :: Set Endorsement
registeredEndorsements = Set Endorsement
registeredEndorsements'
                  }
            else -- Just register the endorsement if we cannot adopt
              State -> m State
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State -> m State) -> State -> m State
forall a b. (a -> b) -> a -> b
$ State
st {registeredEndorsements :: Set Endorsement
registeredEndorsements = Set Endorsement
registeredEndorsements'}
        else -- Ignore the endorsement if the registration isn't stable
          State -> m State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
st
    -- Throw an error if there are multiple proposals for this protocol version
    [(UpId, ProtocolUpdateProposal)]
_ -> Error -> m State
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> m State) -> Error -> m State
forall a b. (a -> b) -> a -> b
$ ProtocolVersion -> Error
MultipleProposalsForProtocolVersion ProtocolVersion
pv
  where
    Environment
      { BlockCount
k :: BlockCount
k :: Environment -> BlockCount
k,
        SlotNumber
currentSlot :: SlotNumber
currentSlot :: Environment -> SlotNumber
currentSlot,
        Int
adoptionThreshold :: Int
adoptionThreshold :: Environment -> Int
adoptionThreshold,
        Map
delegationMap :: Map
delegationMap :: Environment -> Map
delegationMap,
        Map UpId SlotNumber
confirmedProposals :: Map UpId SlotNumber
confirmedProposals :: Environment -> Map UpId SlotNumber
confirmedProposals,
        ProtocolUpdateProposals
registeredProtocolUpdateProposals :: ProtocolUpdateProposals
registeredProtocolUpdateProposals :: Environment -> ProtocolUpdateProposals
registeredProtocolUpdateProposals
      } = Environment
env

    isConfirmedAndStable :: UpId -> Bool
isConfirmedAndStable UpId
upId = UpId
upId UpId -> Map UpId SlotNumber -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map UpId SlotNumber
scps
      where
        -- Stable and confirmed proposals.
        scps :: Map UpId SlotNumber
scps = (SlotNumber -> Bool) -> Map UpId SlotNumber -> Map UpId SlotNumber
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (\SlotNumber
x -> SlotCount -> SlotNumber -> SlotNumber
addSlotCount (BlockCount -> SlotCount
kSlotSecurityParam BlockCount
k) SlotNumber
x SlotNumber -> SlotNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNumber
currentSlot) Map UpId SlotNumber
confirmedProposals

    numberOfEndorsements :: Int
    numberOfEndorsements :: Int
numberOfEndorsements =
      Set Endorsement -> Int
forall a. HasLength a => a -> Int
length (Set Endorsement -> Int) -> Set Endorsement -> Int
forall a b. (a -> b) -> a -> b
$
        (Endorsement -> Bool) -> Set Endorsement -> Set Endorsement
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
          ((ProtocolVersion -> ProtocolVersion -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolVersion
pv) (ProtocolVersion -> Bool)
-> (Endorsement -> ProtocolVersion) -> Endorsement -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Endorsement -> ProtocolVersion
endorsementProtocolVersion)
          Set Endorsement
registeredEndorsements'

    pv :: ProtocolVersion
pv = Endorsement -> ProtocolVersion
endorsementProtocolVersion Endorsement
endorsement

    State {[CandidateProtocolUpdate]
candidateProtocolVersions :: [CandidateProtocolUpdate]
candidateProtocolVersions :: State -> [CandidateProtocolUpdate]
candidateProtocolVersions, Set Endorsement
registeredEndorsements :: Set Endorsement
registeredEndorsements :: State -> Set Endorsement
registeredEndorsements} = State
st

    registeredEndorsements' :: Set Endorsement
registeredEndorsements' = case KeyHash -> Map -> Maybe KeyHash
Delegation.lookupR KeyHash
vk Map
delegationMap of
      Just KeyHash
vkS -> Endorsement -> Set Endorsement -> Set Endorsement
forall a. Ord a => a -> Set a -> Set a
Set.insert (ProtocolVersion -> KeyHash -> Endorsement
Endorsement ProtocolVersion
epv KeyHash
vkS) Set Endorsement
registeredEndorsements
      Maybe KeyHash
Nothing -> Set Endorsement
registeredEndorsements
      where
        -- Note that we do not throw an error if there is no corresponding
        -- delegate for the given endorsement keyHash. This is consistent
        -- with the @UPEND@ rules. The check that there is a delegator should be
        -- done in the rule that checks that the block issuer is a delegate of a
        -- genesis key.

        vk :: KeyHash
vk = Endorsement -> KeyHash
endorsementKeyHash Endorsement
endorsement
        epv :: ProtocolVersion
epv = Endorsement -> ProtocolVersion
endorsementProtocolVersion Endorsement
endorsement

-- | Add a newly endorsed protocol version to the 'CandidateProtocolUpdate's
--
--   We only add it to the list if the 'ProtocolVersion' is strictly greater
--   than all other `CandidateProtocolUpdate`s
--
-- This corresponds to the @FADS@ rule.
updateCandidateProtocolUpdates ::
  [CandidateProtocolUpdate] ->
  CandidateProtocolUpdate ->
  [CandidateProtocolUpdate]
updateCandidateProtocolUpdates :: [CandidateProtocolUpdate]
-> CandidateProtocolUpdate -> [CandidateProtocolUpdate]
updateCandidateProtocolUpdates [] CandidateProtocolUpdate
cpu = [CandidateProtocolUpdate
cpu]
updateCandidateProtocolUpdates cpus :: [CandidateProtocolUpdate]
cpus@(CandidateProtocolUpdate
cpu : [CandidateProtocolUpdate]
_) CandidateProtocolUpdate
cpu'
  | CandidateProtocolUpdate -> ProtocolVersion
cpuProtocolVersion CandidateProtocolUpdate
cpu ProtocolVersion -> ProtocolVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CandidateProtocolUpdate -> ProtocolVersion
cpuProtocolVersion CandidateProtocolUpdate
cpu' = CandidateProtocolUpdate
cpu' CandidateProtocolUpdate
-> [CandidateProtocolUpdate] -> [CandidateProtocolUpdate]
forall a. a -> [a] -> [a]
: [CandidateProtocolUpdate]
cpus
  | Bool
otherwise = [CandidateProtocolUpdate]
cpus