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

module Cardano.Chain.Delegation.Validation.Activation (
  -- * Activation
  State (..),
  activateDelegation,
) where

import Cardano.Chain.Common (KeyHash)
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.Delegation.Validation.Scheduling (ScheduledDelegation (..))
import Cardano.Chain.Slotting (SlotNumber (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude hiding (State)
import qualified Data.Map.Strict as M
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- Activation
--------------------------------------------------------------------------------

-- | Maps containing, for each delegator, the active delegation and the slot it
--   became active in.
data State = State
  { State -> Map
delegationMap :: !Delegation.Map
  , State -> Map KeyHash SlotNumber
delegationSlots :: !(Map KeyHash SlotNumber)
  }
  deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State -> State -> Bool
== :: State -> State -> Bool
$c/= :: State -> State -> Bool
/= :: 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
$cshowsPrec :: Int -> State -> ShowS
showsPrec :: Int -> State -> ShowS
$cshow :: State -> String
show :: State -> String
$cshowList :: [State] -> ShowS
showList :: [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
$cfrom :: forall x. State -> Rep State x
from :: forall x. State -> Rep State x
$cto :: forall x. Rep State x -> State
to :: forall x. Rep State x -> State
Generic, State -> ()
(State -> ()) -> NFData State
forall a. (a -> ()) -> NFData a
$crnf :: State -> ()
rnf :: 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
$cnoThunks :: Context -> State -> IO (Maybe ThunkInfo)
noThunks :: Context -> State -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> State -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> State -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy State -> String
showTypeOf :: Proxy State -> String
NoThunks)

instance ToCBOR State where
  toCBOR :: State -> Encoding
toCBOR = State -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

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

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

instance EncCBOR State where
  encCBOR :: State -> Encoding
encCBOR State
s =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (State -> Map
delegationMap State
s)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map KeyHash SlotNumber -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (State -> Map KeyHash SlotNumber
delegationSlots State
s)

-- | Activate a 'ScheduledDelegation' if its activation slot is less than the
--   previous delegation slot for this delegate, otherwise discard it. This is
--   an implementation of the delegation activation rule in the ledger
--   specification.
activateDelegation :: State -> ScheduledDelegation -> State
activateDelegation :: State -> ScheduledDelegation -> State
activateDelegation State
as ScheduledDelegation
delegation
  | (KeyHash
delegate KeyHash -> Map -> Bool
`Delegation.notMemberR` Map
delegationMap)
      Bool -> Bool -> Bool
&& (SlotNumber
prevDelegationSlot SlotNumber -> SlotNumber -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNumber
slot Bool -> Bool -> Bool
|| SlotNumber -> Word64
unSlotNumber SlotNumber
slot Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) =
      State
        { delegationMap :: Map
delegationMap = KeyHash -> KeyHash -> Map -> Map
Delegation.insert KeyHash
delegator KeyHash
delegate Map
delegationMap
        , delegationSlots :: Map KeyHash SlotNumber
delegationSlots = KeyHash
-> SlotNumber -> Map KeyHash SlotNumber -> Map KeyHash SlotNumber
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert KeyHash
delegator SlotNumber
slot Map KeyHash SlotNumber
delegationSlots
        }
  | Bool
otherwise = State
as
  where
    State {Map
delegationMap :: State -> Map
delegationMap :: Map
delegationMap, Map KeyHash SlotNumber
delegationSlots :: State -> Map KeyHash SlotNumber
delegationSlots :: Map KeyHash SlotNumber
delegationSlots} = State
as
    ScheduledDelegation SlotNumber
slot KeyHash
delegator KeyHash
delegate = ScheduledDelegation
delegation

    prevDelegationSlot :: SlotNumber
prevDelegationSlot =
      SlotNumber -> Maybe SlotNumber -> SlotNumber
forall a. a -> Maybe a -> a
fromMaybe (Word64 -> SlotNumber
SlotNumber Word64
0) (Maybe SlotNumber -> SlotNumber) -> Maybe SlotNumber -> SlotNumber
forall a b. (a -> b) -> a -> b
$ KeyHash -> Map KeyHash SlotNumber -> Maybe SlotNumber
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeyHash
delegator Map KeyHash SlotNumber
delegationSlots