{-# 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.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.Ledger.Binary (
  Annotated (..),
  DecCBOR (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeListLen,
  decodeWord8,
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  matchSize,
  toByronCBOR,
 )
import Cardano.Prelude hiding (State, cborError)
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
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
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. 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 -> ()
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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: State -> ()
$crnf :: State -> ()
NFData, Context -> State -> IO (Maybe ThunkInfo)
Proxy State -> String
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 ToCBOR State where
  toCBOR :: State -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR State where
  fromCBOR :: forall s. Decoder s State
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

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

instance EncCBOR State where
  encCBOR :: State -> Encoding
encCBOR State
s =
    Word -> Encoding
encodeListLen Word
2
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (State -> Seq ScheduledDelegation
scheduledDelegations State
s))
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScheduledDelegation -> ()
$crnf :: ScheduledDelegation -> ()
NFData, Context -> ScheduledDelegation -> IO (Maybe ThunkInfo)
Proxy ScheduledDelegation -> String
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 ToCBOR ScheduledDelegation where
  toCBOR :: ScheduledDelegation -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR ScheduledDelegation where
  fromCBOR :: forall s. Decoder s ScheduledDelegation
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance DecCBOR ScheduledDelegation where
  decCBOR :: forall s. Decoder s ScheduledDelegation
decCBOR = do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ScheduledDelegation" Int
3
    SlotNumber -> KeyHash -> KeyHash -> ScheduledDelegation
ScheduledDelegation
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR ScheduledDelegation where
  encCBOR :: ScheduledDelegation -> Encoding
encCBOR ScheduledDelegation
sd =
    Word -> Encoding
encodeListLen Word
3
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ScheduledDelegation -> SlotNumber
sdSlot ScheduledDelegation
sd)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ScheduledDelegation -> KeyHash
sdDelegator ScheduledDelegation
sd)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (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
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
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 = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Error where
  fromCBOR :: forall s. Decoder s Error
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR Error where
  encCBOR :: Error -> Encoding
encCBOR Error
err = case Error
err of
    Error
InvalidCertificate ->
      Word -> Encoding
encodeListLen Word
1
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8)
    MultipleDelegationsForEpoch EpochNumber
epochNumber KeyHash
keyHash ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR EpochNumber
epochNumber
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash
keyHash
    MultipleDelegationsForSlot SlotNumber
slotNumber KeyHash
keyHash ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR SlotNumber
slotNumber
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash
keyHash
    NonGenesisDelegator KeyHash
keyHash ->
      Word -> Encoding
encodeListLen Word
2
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash
keyHash
    WrongEpoch EpochNumber
currentEpoch EpochNumber
delegationEpoch ->
      Word -> Encoding
encodeListLen Word
3
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
4 :: Word8)
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR EpochNumber
currentEpoch
        forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR EpochNumber
delegationEpoch

instance DecCBOR Error where
  decCBOR :: forall s. Decoder s Error
decCBOR = do
    Int
len <- forall s. Decoder s Int
decodeListLen
    let checkSize :: Int -> Decoder s ()
        checkSize :: forall s. Int -> Decoder s ()
checkSize Int
size = forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"Scheduling.Error" Int
size Int
len
    Word8
tag <- forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> forall s. Int -> Decoder s ()
checkSize Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
InvalidCertificate
      Word8
1 -> forall s. Int -> Decoder s ()
checkSize Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EpochNumber -> KeyHash -> Error
MultipleDelegationsForEpoch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
2 -> forall s. Int -> Decoder s ()
checkSize Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SlotNumber -> KeyHash -> Error
MultipleDelegationsForSlot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
3 -> forall s. Int -> Decoder s ()
checkSize Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyHash -> Error
NonGenesisDelegator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
4 -> forall s. Int -> Decoder s ()
checkSize Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EpochNumber -> EpochNumber -> Error
WrongEpoch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
_ -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError 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 :: forall (m :: * -> *).
MonadError Error m =>
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
    forall a. Ord a => a -> Set a -> Bool
`Set.member` Set KeyHash
allowedDelegators
    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
    forall a. Ord a => a -> a -> Bool
<= EpochNumber
delegationEpoch
    Bool -> Bool -> Bool
&& EpochNumber
delegationEpoch
    forall a. Ord a => a -> a -> Bool
<= EpochNumber
currentEpoch
    forall a. Num a => a -> a -> a
+ EpochNumber
1
    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)
    forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (EpochNumber, KeyHash)
keyEpochDelegations
    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
  forall a. Maybe a -> Bool
isNothing (forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL ScheduledDelegation -> Bool
delegatesThisSlot Seq ScheduledDelegation
scheduledDelegations)
    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 forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Error
InvalidCertificate

  -- Schedule the new delegation and register the epoch/delegator pair
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ State
      { scheduledDelegations :: Seq ScheduledDelegation
scheduledDelegations = Seq ScheduledDelegation
scheduledDelegations forall a. Seq a -> a -> Seq a
|> ScheduledDelegation
delegation
      , keyEpochDelegations :: Set (EpochNumber, KeyHash)
keyEpochDelegations =
          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 forall a b. (a -> b) -> a -> b
$ forall a. ACertificate a -> VerificationKey
Certificate.issuerVK ACertificate ByteString
cert
    delegateHash :: KeyHash
delegateHash = VerificationKey -> KeyHash
hashKey forall a b. (a -> b) -> a -> b
$ forall a. ACertificate a -> VerificationKey
Certificate.delegateVK ACertificate ByteString
cert

    delegationEpoch :: EpochNumber
delegationEpoch = 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 forall a. Eq a => a -> a -> Bool
== SlotNumber
activationSlot Bool -> Bool -> Bool
&& ScheduledDelegation -> KeyHash
sdDelegator ScheduledDelegation
sd forall a. Eq a => a -> a -> Bool
== KeyHash
delegatorHash

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