{-# 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.Prelude hiding (State)
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import NoThunks.Class (NoThunks (..))
import Cardano.Chain.ProtocolConstants (kSlotSecurityParam)
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.Slotting (SlotNumber, subSlotCount)
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
data Environment = Environment
{ 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
{ 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
= 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
:: 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
[] -> State -> m State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
st
[(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 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 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 State -> m State
forall (f :: * -> *) a. Applicative f => a -> f a
pure State
st
[(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
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 -> SlotNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNumber
stableAt) Map UpId SlotNumber
confirmedProposals
stableAt :: SlotNumber
stableAt = SlotCount -> SlotNumber -> SlotNumber
subSlotCount (BlockCount -> SlotCount
kSlotSecurityParam BlockCount
k) SlotNumber
currentSlot
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
vk :: KeyHash
vk = Endorsement -> KeyHash
endorsementKeyHash Endorsement
endorsement
epv :: ProtocolVersion
epv = Endorsement -> ProtocolVersion
endorsementProtocolVersion Endorsement
endorsement
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