{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TypeFamilies       #-}

module Ouroboros.Consensus.Protocol.LeaderSchedule (
    LeaderSchedule (..)
  , leaderScheduleFor
  ) where

import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Set (Set)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.NodeId (CoreNodeId (..), fromCoreNodeId)
import           Ouroboros.Consensus.Util.Condense (Condense (..))

{-------------------------------------------------------------------------------
  Leader schedule

  The leader schedule allows us to define, in tests, precisely when each node
  is meant to lead. Unlike in, say, Praos, where this is determined by a single
  random seed, this gives us the ability to construct test cases in an
  inspectable and shrinkable manner.
-------------------------------------------------------------------------------}

newtype LeaderSchedule = LeaderSchedule {
        LeaderSchedule -> Map SlotNo [CoreNodeId]
getLeaderSchedule :: Map SlotNo [CoreNodeId]
      }
    deriving stock    (Int -> LeaderSchedule -> ShowS
[LeaderSchedule] -> ShowS
LeaderSchedule -> String
(Int -> LeaderSchedule -> ShowS)
-> (LeaderSchedule -> String)
-> ([LeaderSchedule] -> ShowS)
-> Show LeaderSchedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeaderSchedule] -> ShowS
$cshowList :: [LeaderSchedule] -> ShowS
show :: LeaderSchedule -> String
$cshow :: LeaderSchedule -> String
showsPrec :: Int -> LeaderSchedule -> ShowS
$cshowsPrec :: Int -> LeaderSchedule -> ShowS
Show, LeaderSchedule -> LeaderSchedule -> Bool
(LeaderSchedule -> LeaderSchedule -> Bool)
-> (LeaderSchedule -> LeaderSchedule -> Bool) -> Eq LeaderSchedule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LeaderSchedule -> LeaderSchedule -> Bool
$c/= :: LeaderSchedule -> LeaderSchedule -> Bool
== :: LeaderSchedule -> LeaderSchedule -> Bool
$c== :: LeaderSchedule -> LeaderSchedule -> Bool
Eq, Eq LeaderSchedule
Eq LeaderSchedule
-> (LeaderSchedule -> LeaderSchedule -> Ordering)
-> (LeaderSchedule -> LeaderSchedule -> Bool)
-> (LeaderSchedule -> LeaderSchedule -> Bool)
-> (LeaderSchedule -> LeaderSchedule -> Bool)
-> (LeaderSchedule -> LeaderSchedule -> Bool)
-> (LeaderSchedule -> LeaderSchedule -> LeaderSchedule)
-> (LeaderSchedule -> LeaderSchedule -> LeaderSchedule)
-> Ord LeaderSchedule
LeaderSchedule -> LeaderSchedule -> Bool
LeaderSchedule -> LeaderSchedule -> Ordering
LeaderSchedule -> LeaderSchedule -> LeaderSchedule
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 :: LeaderSchedule -> LeaderSchedule -> LeaderSchedule
$cmin :: LeaderSchedule -> LeaderSchedule -> LeaderSchedule
max :: LeaderSchedule -> LeaderSchedule -> LeaderSchedule
$cmax :: LeaderSchedule -> LeaderSchedule -> LeaderSchedule
>= :: LeaderSchedule -> LeaderSchedule -> Bool
$c>= :: LeaderSchedule -> LeaderSchedule -> Bool
> :: LeaderSchedule -> LeaderSchedule -> Bool
$c> :: LeaderSchedule -> LeaderSchedule -> Bool
<= :: LeaderSchedule -> LeaderSchedule -> Bool
$c<= :: LeaderSchedule -> LeaderSchedule -> Bool
< :: LeaderSchedule -> LeaderSchedule -> Bool
$c< :: LeaderSchedule -> LeaderSchedule -> Bool
compare :: LeaderSchedule -> LeaderSchedule -> Ordering
$ccompare :: LeaderSchedule -> LeaderSchedule -> Ordering
$cp1Ord :: Eq LeaderSchedule
Ord, (forall x. LeaderSchedule -> Rep LeaderSchedule x)
-> (forall x. Rep LeaderSchedule x -> LeaderSchedule)
-> Generic LeaderSchedule
forall x. Rep LeaderSchedule x -> LeaderSchedule
forall x. LeaderSchedule -> Rep LeaderSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LeaderSchedule x -> LeaderSchedule
$cfrom :: forall x. LeaderSchedule -> Rep LeaderSchedule x
Generic)
    deriving anyclass (Context -> LeaderSchedule -> IO (Maybe ThunkInfo)
Proxy LeaderSchedule -> String
(Context -> LeaderSchedule -> IO (Maybe ThunkInfo))
-> (Context -> LeaderSchedule -> IO (Maybe ThunkInfo))
-> (Proxy LeaderSchedule -> String)
-> NoThunks LeaderSchedule
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy LeaderSchedule -> String
$cshowTypeOf :: Proxy LeaderSchedule -> String
wNoThunks :: Context -> LeaderSchedule -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeaderSchedule -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeaderSchedule -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> LeaderSchedule -> IO (Maybe ThunkInfo)
NoThunks)

-- | The 'Slots' a given node is supposed to lead in
leaderScheduleFor :: CoreNodeId -> LeaderSchedule -> Set SlotNo
leaderScheduleFor :: CoreNodeId -> LeaderSchedule -> Set SlotNo
leaderScheduleFor CoreNodeId
nid =
      Map SlotNo [CoreNodeId] -> Set SlotNo
forall k a. Map k a -> Set k
Map.keysSet
    (Map SlotNo [CoreNodeId] -> Set SlotNo)
-> (LeaderSchedule -> Map SlotNo [CoreNodeId])
-> LeaderSchedule
-> Set SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CoreNodeId] -> Bool)
-> Map SlotNo [CoreNodeId] -> Map SlotNo [CoreNodeId]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (CoreNodeId -> [CoreNodeId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem CoreNodeId
nid)
    (Map SlotNo [CoreNodeId] -> Map SlotNo [CoreNodeId])
-> (LeaderSchedule -> Map SlotNo [CoreNodeId])
-> LeaderSchedule
-> Map SlotNo [CoreNodeId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeaderSchedule -> Map SlotNo [CoreNodeId]
getLeaderSchedule

instance Semigroup LeaderSchedule where
    LeaderSchedule Map SlotNo [CoreNodeId]
l <> :: LeaderSchedule -> LeaderSchedule -> LeaderSchedule
<> LeaderSchedule Map SlotNo [CoreNodeId]
r =
        Map SlotNo [CoreNodeId] -> LeaderSchedule
LeaderSchedule (Map SlotNo [CoreNodeId] -> LeaderSchedule)
-> Map SlotNo [CoreNodeId] -> LeaderSchedule
forall a b. (a -> b) -> a -> b
$
        ([CoreNodeId] -> [CoreNodeId] -> [CoreNodeId])
-> Map SlotNo [CoreNodeId]
-> Map SlotNo [CoreNodeId]
-> Map SlotNo [CoreNodeId]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [CoreNodeId] -> [CoreNodeId] -> [CoreNodeId]
forall a. Eq a => [a] -> [a] -> [a]
comb Map SlotNo [CoreNodeId]
l Map SlotNo [CoreNodeId]
r
      where
        comb :: [a] -> [a] -> [a]
comb [a]
ls [a]
rs = [a]
ls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
ls) [a]
rs

instance Condense LeaderSchedule where
    condense :: LeaderSchedule -> String
condense (LeaderSchedule Map SlotNo [CoreNodeId]
m) = [(SlotNo, [NodeId])] -> String
forall a. Condense a => a -> String
condense
                                ([(SlotNo, [NodeId])] -> String) -> [(SlotNo, [NodeId])] -> String
forall a b. (a -> b) -> a -> b
$ ((SlotNo, [CoreNodeId]) -> (SlotNo, [NodeId]))
-> [(SlotNo, [CoreNodeId])] -> [(SlotNo, [NodeId])]
forall a b. (a -> b) -> [a] -> [b]
map (\(SlotNo
s, [CoreNodeId]
ls) -> (SlotNo
s, (CoreNodeId -> NodeId) -> [CoreNodeId] -> [NodeId]
forall a b. (a -> b) -> [a] -> [b]
map CoreNodeId -> NodeId
fromCoreNodeId [CoreNodeId]
ls))
                                ([(SlotNo, [CoreNodeId])] -> [(SlotNo, [NodeId])])
-> [(SlotNo, [CoreNodeId])] -> [(SlotNo, [NodeId])]
forall a b. (a -> b) -> a -> b
$ Map SlotNo [CoreNodeId] -> [(SlotNo, [CoreNodeId])]
forall k a. Map k a -> [(k, a)]
Map.toList Map SlotNo [CoreNodeId]
m