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

module Cardano.Chain.Delegation.Validation.Scheduling
  ( -- * Scheduling
    Environment (..),
    State (..),
    Error (..),
    ScheduledDelegation (..),
    scheduleCertificate,
  )
where

import Cardano.Binary
  ( Annotated (..),
    Decoder,
    DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeListLen,
    decodeWord8,
    encodeListLen,
    enforceSize,
    matchSize,
  )
import Cardano.Chain.Common (BlockCount, KeyHash, hashKey)
import Cardano.Chain.Delegation.Certificate (ACertificate)
import qualified Cardano.Chain.Delegation.Certificate as Certificate
import Cardano.Chain.ProtocolConstants (kSlotSecurityParam)
import Cardano.Chain.Slotting
  ( EpochNumber,
    SlotNumber (..),
    addSlotCount,
  )
import Cardano.Crypto (ProtocolMagicId)
import Cardano.Prelude hiding (State)
import Data.Sequence ((|>))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- Scheduling
--------------------------------------------------------------------------------

data Environment = Environment
  { Environment -> Annotated ProtocolMagicId ByteString
protocolMagic :: !(Annotated ProtocolMagicId ByteString),
    Environment -> Set KeyHash
allowedDelegators :: !(Set KeyHash),
    Environment -> EpochNumber
currentEpoch :: !EpochNumber,
    Environment -> SlotNumber
currentSlot :: !SlotNumber,
    Environment -> BlockCount
k :: !BlockCount
  }
  deriving (Environment -> Environment -> Bool
(Environment -> Environment -> Bool)
-> (Environment -> Environment -> Bool) -> Eq Environment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show, (forall x. Environment -> Rep Environment x)
-> (forall x. Rep Environment x -> Environment)
-> Generic Environment
forall x. Rep Environment x -> Environment
forall x. Environment -> Rep Environment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Environment x -> Environment
$cfrom :: forall x. Environment -> Rep Environment x
Generic, Environment -> ()
(Environment -> ()) -> NFData Environment
forall a. (a -> ()) -> NFData a
rnf :: Environment -> ()
$crnf :: Environment -> ()
NFData)

data State = State
  { State -> Seq ScheduledDelegation
scheduledDelegations :: !(Seq ScheduledDelegation),
    State -> Set (EpochNumber, KeyHash)
keyEpochDelegations :: !(Set (EpochNumber, KeyHash))
  }
  deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show, (forall x. State -> Rep State x)
-> (forall x. Rep State x -> State) -> Generic State
forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic, State -> ()
(State -> ()) -> NFData State
forall a. (a -> ()) -> NFData a
rnf :: State -> ()
$crnf :: State -> ()
NFData, Context -> State -> IO (Maybe ThunkInfo)
Proxy State -> String
(Context -> State -> IO (Maybe ThunkInfo))
-> (Context -> State -> IO (Maybe ThunkInfo))
-> (Proxy State -> String)
-> NoThunks State
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy State -> String
$cshowTypeOf :: Proxy State -> String
wNoThunks :: Context -> State -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> State -> IO (Maybe ThunkInfo)
noThunks :: Context -> State -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> State -> IO (Maybe ThunkInfo)
NoThunks)

instance FromCBOR State where
  fromCBOR :: Decoder s State
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"State" Int
2
    Seq ScheduledDelegation -> Set (EpochNumber, KeyHash) -> State
State
      (Seq ScheduledDelegation -> Set (EpochNumber, KeyHash) -> State)
-> Decoder s (Seq ScheduledDelegation)
-> Decoder s (Set (EpochNumber, KeyHash) -> State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ScheduledDelegation] -> Seq ScheduledDelegation
forall a. [a] -> Seq a
Seq.fromList ([ScheduledDelegation] -> Seq ScheduledDelegation)
-> Decoder s [ScheduledDelegation]
-> Decoder s (Seq ScheduledDelegation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [ScheduledDelegation]
forall a s. FromCBOR a => Decoder s a
fromCBOR)
      Decoder s (Set (EpochNumber, KeyHash) -> State)
-> Decoder s (Set (EpochNumber, KeyHash)) -> Decoder s State
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Set (EpochNumber, KeyHash))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR State where
  toCBOR :: State -> Encoding
toCBOR State
s =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [ScheduledDelegation] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Seq ScheduledDelegation -> [ScheduledDelegation]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (State -> Seq ScheduledDelegation
scheduledDelegations State
s))
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (EpochNumber, KeyHash) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (State -> Set (EpochNumber, KeyHash)
keyEpochDelegations State
s)

data ScheduledDelegation = ScheduledDelegation
  { ScheduledDelegation -> SlotNumber
sdSlot :: !SlotNumber,
    ScheduledDelegation -> KeyHash
sdDelegator :: !KeyHash,
    ScheduledDelegation -> KeyHash
sdDelegate :: !KeyHash
  }
  deriving (ScheduledDelegation -> ScheduledDelegation -> Bool
(ScheduledDelegation -> ScheduledDelegation -> Bool)
-> (ScheduledDelegation -> ScheduledDelegation -> Bool)
-> Eq ScheduledDelegation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScheduledDelegation -> ScheduledDelegation -> Bool
$c/= :: ScheduledDelegation -> ScheduledDelegation -> Bool
== :: ScheduledDelegation -> ScheduledDelegation -> Bool
$c== :: ScheduledDelegation -> ScheduledDelegation -> Bool
Eq, Int -> ScheduledDelegation -> ShowS
[ScheduledDelegation] -> ShowS
ScheduledDelegation -> String
(Int -> ScheduledDelegation -> ShowS)
-> (ScheduledDelegation -> String)
-> ([ScheduledDelegation] -> ShowS)
-> Show ScheduledDelegation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScheduledDelegation] -> ShowS
$cshowList :: [ScheduledDelegation] -> ShowS
show :: ScheduledDelegation -> String
$cshow :: ScheduledDelegation -> String
showsPrec :: Int -> ScheduledDelegation -> ShowS
$cshowsPrec :: Int -> ScheduledDelegation -> ShowS
Show, (forall x. ScheduledDelegation -> Rep ScheduledDelegation x)
-> (forall x. Rep ScheduledDelegation x -> ScheduledDelegation)
-> Generic ScheduledDelegation
forall x. Rep ScheduledDelegation x -> ScheduledDelegation
forall x. ScheduledDelegation -> Rep ScheduledDelegation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScheduledDelegation x -> ScheduledDelegation
$cfrom :: forall x. ScheduledDelegation -> Rep ScheduledDelegation x
Generic, ScheduledDelegation -> ()
(ScheduledDelegation -> ()) -> NFData ScheduledDelegation
forall a. (a -> ()) -> NFData a
rnf :: ScheduledDelegation -> ()
$crnf :: ScheduledDelegation -> ()
NFData, Context -> ScheduledDelegation -> IO (Maybe ThunkInfo)
Proxy ScheduledDelegation -> String
(Context -> ScheduledDelegation -> IO (Maybe ThunkInfo))
-> (Context -> ScheduledDelegation -> IO (Maybe ThunkInfo))
-> (Proxy ScheduledDelegation -> String)
-> NoThunks ScheduledDelegation
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ScheduledDelegation -> String
$cshowTypeOf :: Proxy ScheduledDelegation -> String
wNoThunks :: Context -> ScheduledDelegation -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ScheduledDelegation -> IO (Maybe ThunkInfo)
noThunks :: Context -> ScheduledDelegation -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ScheduledDelegation -> IO (Maybe ThunkInfo)
NoThunks)

instance FromCBOR ScheduledDelegation where
  fromCBOR :: Decoder s ScheduledDelegation
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ScheduledDelegation" Int
3
    SlotNumber -> KeyHash -> KeyHash -> ScheduledDelegation
ScheduledDelegation
      (SlotNumber -> KeyHash -> KeyHash -> ScheduledDelegation)
-> Decoder s SlotNumber
-> Decoder s (KeyHash -> KeyHash -> ScheduledDelegation)
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 (KeyHash -> KeyHash -> ScheduledDelegation)
-> Decoder s KeyHash -> Decoder s (KeyHash -> ScheduledDelegation)
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
      Decoder s (KeyHash -> ScheduledDelegation)
-> Decoder s KeyHash -> Decoder s ScheduledDelegation
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 ScheduledDelegation where
  toCBOR :: ScheduledDelegation -> Encoding
toCBOR ScheduledDelegation
sd =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ScheduledDelegation -> SlotNumber
sdSlot ScheduledDelegation
sd)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ScheduledDelegation -> KeyHash
sdDelegator ScheduledDelegation
sd)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ScheduledDelegation -> KeyHash
sdDelegate ScheduledDelegation
sd)

data Error
  = -- | The delegation certificate has an invalid signature
    InvalidCertificate
  | -- | This delegator has already delegated for the given epoch
    MultipleDelegationsForEpoch EpochNumber KeyHash
  | -- | This delegator has already delgated in this slot
    MultipleDelegationsForSlot SlotNumber KeyHash
  | -- | This delegator is not one of the allowed genesis keys
    NonGenesisDelegator KeyHash
  | -- | This delegation is for a past or for a too future epoch
    WrongEpoch EpochNumber EpochNumber
  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 Error
err = case Error
err of
    Error
InvalidCertificate ->
      Word -> Encoding
encodeListLen Word
1
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
    MultipleDelegationsForEpoch EpochNumber
epochNumber KeyHash
keyHash ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochNumber
epochNumber
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash
keyHash
    MultipleDelegationsForSlot SlotNumber
slotNumber KeyHash
keyHash ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
2 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SlotNumber
slotNumber
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash
keyHash
    NonGenesisDelegator KeyHash
keyHash ->
      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
3 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash
keyHash
    WrongEpoch EpochNumber
currentEpoch EpochNumber
delegationEpoch ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
4 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochNumber
currentEpoch
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochNumber
delegationEpoch

instance FromCBOR Error where
  fromCBOR :: Decoder s Error
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    let checkSize :: Int -> Decoder s ()
        checkSize :: Int -> Decoder s ()
checkSize Int
size = Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"Scheduling.Error" Int
size Int
len
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
1 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Error -> Decoder s Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
InvalidCertificate
      Word8
1 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EpochNumber -> KeyHash -> Error
MultipleDelegationsForEpoch (EpochNumber -> KeyHash -> Error)
-> Decoder s EpochNumber -> Decoder s (KeyHash -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s EpochNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (KeyHash -> Error)
-> Decoder s KeyHash -> Decoder s Error
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
      Word8
2 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SlotNumber -> KeyHash -> Error
MultipleDelegationsForSlot (SlotNumber -> KeyHash -> Error)
-> Decoder s SlotNumber -> Decoder s (KeyHash -> Error)
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 (KeyHash -> Error)
-> Decoder s KeyHash -> Decoder s Error
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
      Word8
3 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyHash -> Error
NonGenesisDelegator (KeyHash -> Error) -> Decoder s KeyHash -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s KeyHash
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
4 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EpochNumber -> EpochNumber -> Error
WrongEpoch (EpochNumber -> EpochNumber -> Error)
-> Decoder s EpochNumber -> Decoder s (EpochNumber -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s EpochNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (EpochNumber -> Error)
-> Decoder s EpochNumber -> Decoder s Error
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s EpochNumber
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
"Scheduling.Error" Word8
tag

-- | Update the delegation 'State' with a 'Certificate' if it passes
--   all the validation rules. This is an implementation of the delegation
--   scheduling inference rule from the ledger specification.
scheduleCertificate ::
  MonadError Error m =>
  Environment ->
  State ->
  ACertificate ByteString ->
  m State
scheduleCertificate :: Environment -> State -> ACertificate ByteString -> m State
scheduleCertificate Environment
env State
st ACertificate ByteString
cert = do
  -- Check that the delegator is a genesis key
  KeyHash
delegatorHash KeyHash -> Set KeyHash -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set KeyHash
allowedDelegators
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` KeyHash -> Error
NonGenesisDelegator KeyHash
delegatorHash

  -- Check that the delegation epoch refers to the current or to the next epoch
  EpochNumber
currentEpoch EpochNumber -> EpochNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNumber
delegationEpoch Bool -> Bool -> Bool
&& EpochNumber
delegationEpoch EpochNumber -> EpochNumber -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNumber
currentEpoch EpochNumber -> EpochNumber -> EpochNumber
forall a. Num a => a -> a -> a
+ EpochNumber
1
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` EpochNumber -> EpochNumber -> Error
WrongEpoch EpochNumber
currentEpoch EpochNumber
delegationEpoch

  -- Check that the delegator hasn't already delegated in 'delegationEpoch'
  (EpochNumber
delegationEpoch, KeyHash
delegatorHash) (EpochNumber, KeyHash) -> Set (EpochNumber, KeyHash) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (EpochNumber, KeyHash)
keyEpochDelegations
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` EpochNumber -> KeyHash -> Error
MultipleDelegationsForEpoch EpochNumber
delegationEpoch KeyHash
delegatorHash

  -- Check that the delegator hasn't issued a certificate in this slot
  Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing ((ScheduledDelegation -> Bool)
-> Seq ScheduledDelegation -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL ScheduledDelegation -> Bool
delegatesThisSlot Seq ScheduledDelegation
scheduledDelegations)
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` SlotNumber -> KeyHash -> Error
MultipleDelegationsForSlot SlotNumber
currentSlot KeyHash
delegatorHash

  -- Check that the delegation certificate is valid
  Annotated ProtocolMagicId ByteString
-> ACertificate ByteString -> Bool
Certificate.isValid Annotated ProtocolMagicId ByteString
protocolMagic ACertificate ByteString
cert Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Error
InvalidCertificate

  -- Schedule the new delegation and register the epoch/delegator pair
  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 :: Seq ScheduledDelegation -> Set (EpochNumber, KeyHash) -> State
State
      { scheduledDelegations :: Seq ScheduledDelegation
scheduledDelegations = Seq ScheduledDelegation
scheduledDelegations Seq ScheduledDelegation
-> ScheduledDelegation -> Seq ScheduledDelegation
forall a. Seq a -> a -> Seq a
|> ScheduledDelegation
delegation,
        keyEpochDelegations :: Set (EpochNumber, KeyHash)
keyEpochDelegations =
          (EpochNumber, KeyHash)
-> Set (EpochNumber, KeyHash) -> Set (EpochNumber, KeyHash)
forall a. Ord a => a -> Set a -> Set a
Set.insert
            (EpochNumber
delegationEpoch, KeyHash
delegatorHash)
            Set (EpochNumber, KeyHash)
keyEpochDelegations
      }
  where
    Environment {Annotated ProtocolMagicId ByteString
protocolMagic :: Annotated ProtocolMagicId ByteString
protocolMagic :: Environment -> Annotated ProtocolMagicId ByteString
protocolMagic, Set KeyHash
allowedDelegators :: Set KeyHash
allowedDelegators :: Environment -> Set KeyHash
allowedDelegators, EpochNumber
currentEpoch :: EpochNumber
currentEpoch :: Environment -> EpochNumber
currentEpoch, SlotNumber
currentSlot :: SlotNumber
currentSlot :: Environment -> SlotNumber
currentSlot, BlockCount
k :: BlockCount
k :: Environment -> BlockCount
k} =
      Environment
env

    State {Seq ScheduledDelegation
scheduledDelegations :: Seq ScheduledDelegation
scheduledDelegations :: State -> Seq ScheduledDelegation
scheduledDelegations, Set (EpochNumber, KeyHash)
keyEpochDelegations :: Set (EpochNumber, KeyHash)
keyEpochDelegations :: State -> Set (EpochNumber, KeyHash)
keyEpochDelegations} = State
st

    delegatorHash :: KeyHash
delegatorHash = VerificationKey -> KeyHash
hashKey (VerificationKey -> KeyHash) -> VerificationKey -> KeyHash
forall a b. (a -> b) -> a -> b
$ ACertificate ByteString -> VerificationKey
forall a. ACertificate a -> VerificationKey
Certificate.issuerVK ACertificate ByteString
cert
    delegateHash :: KeyHash
delegateHash = VerificationKey -> KeyHash
hashKey (VerificationKey -> KeyHash) -> VerificationKey -> KeyHash
forall a b. (a -> b) -> a -> b
$ ACertificate ByteString -> VerificationKey
forall a. ACertificate a -> VerificationKey
Certificate.delegateVK ACertificate ByteString
cert

    delegationEpoch :: EpochNumber
delegationEpoch = ACertificate ByteString -> EpochNumber
forall a. ACertificate a -> EpochNumber
Certificate.epoch ACertificate ByteString
cert

    activationSlot :: SlotNumber
activationSlot = SlotCount -> SlotNumber -> SlotNumber
addSlotCount (BlockCount -> SlotCount
kSlotSecurityParam BlockCount
k) SlotNumber
currentSlot

    delegatesThisSlot :: ScheduledDelegation -> Bool
delegatesThisSlot ScheduledDelegation
sd =
      ScheduledDelegation -> SlotNumber
sdSlot ScheduledDelegation
sd SlotNumber -> SlotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== SlotNumber
activationSlot Bool -> Bool -> Bool
&& ScheduledDelegation -> KeyHash
sdDelegator ScheduledDelegation
sd KeyHash -> KeyHash -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash
delegatorHash

    delegation :: ScheduledDelegation
delegation = SlotNumber -> KeyHash -> KeyHash -> ScheduledDelegation
ScheduledDelegation SlotNumber
activationSlot KeyHash
delegatorHash KeyHash
delegateHash