module Hydra.HeadLogic.SnapshotOutcome where

import Data.List (elemIndex)
import Hydra.Chain (HeadParameters (..))
import Hydra.Party (Party)
import Hydra.Prelude
import Hydra.Snapshot (SnapshotNumber)

-- * Snapshot helper functions

data SnapshotOutcome tx
  = ShouldSnapshot SnapshotNumber [tx] -- TODO(AB) : should really be a Set (TxId tx)
  | ShouldNotSnapshot NoSnapshotReason
  deriving stock (SnapshotOutcome tx -> SnapshotOutcome tx -> Bool
(SnapshotOutcome tx -> SnapshotOutcome tx -> Bool)
-> (SnapshotOutcome tx -> SnapshotOutcome tx -> Bool)
-> Eq (SnapshotOutcome tx)
forall tx.
Eq tx =>
SnapshotOutcome tx -> SnapshotOutcome tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
Eq tx =>
SnapshotOutcome tx -> SnapshotOutcome tx -> Bool
== :: SnapshotOutcome tx -> SnapshotOutcome tx -> Bool
$c/= :: forall tx.
Eq tx =>
SnapshotOutcome tx -> SnapshotOutcome tx -> Bool
/= :: SnapshotOutcome tx -> SnapshotOutcome tx -> Bool
Eq, Int -> SnapshotOutcome tx -> ShowS
[SnapshotOutcome tx] -> ShowS
SnapshotOutcome tx -> String
(Int -> SnapshotOutcome tx -> ShowS)
-> (SnapshotOutcome tx -> String)
-> ([SnapshotOutcome tx] -> ShowS)
-> Show (SnapshotOutcome tx)
forall tx. Show tx => Int -> SnapshotOutcome tx -> ShowS
forall tx. Show tx => [SnapshotOutcome tx] -> ShowS
forall tx. Show tx => SnapshotOutcome tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. Show tx => Int -> SnapshotOutcome tx -> ShowS
showsPrec :: Int -> SnapshotOutcome tx -> ShowS
$cshow :: forall tx. Show tx => SnapshotOutcome tx -> String
show :: SnapshotOutcome tx -> String
$cshowList :: forall tx. Show tx => [SnapshotOutcome tx] -> ShowS
showList :: [SnapshotOutcome tx] -> ShowS
Show, (forall x. SnapshotOutcome tx -> Rep (SnapshotOutcome tx) x)
-> (forall x. Rep (SnapshotOutcome tx) x -> SnapshotOutcome tx)
-> Generic (SnapshotOutcome tx)
forall x. Rep (SnapshotOutcome tx) x -> SnapshotOutcome tx
forall x. SnapshotOutcome tx -> Rep (SnapshotOutcome tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (SnapshotOutcome tx) x -> SnapshotOutcome tx
forall tx x. SnapshotOutcome tx -> Rep (SnapshotOutcome tx) x
$cfrom :: forall tx x. SnapshotOutcome tx -> Rep (SnapshotOutcome tx) x
from :: forall x. SnapshotOutcome tx -> Rep (SnapshotOutcome tx) x
$cto :: forall tx x. Rep (SnapshotOutcome tx) x -> SnapshotOutcome tx
to :: forall x. Rep (SnapshotOutcome tx) x -> SnapshotOutcome tx
Generic)

data NoSnapshotReason
  = NotLeader SnapshotNumber
  | SnapshotInFlight SnapshotNumber
  | NoTransactionsToSnapshot
  deriving stock (NoSnapshotReason -> NoSnapshotReason -> Bool
(NoSnapshotReason -> NoSnapshotReason -> Bool)
-> (NoSnapshotReason -> NoSnapshotReason -> Bool)
-> Eq NoSnapshotReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoSnapshotReason -> NoSnapshotReason -> Bool
== :: NoSnapshotReason -> NoSnapshotReason -> Bool
$c/= :: NoSnapshotReason -> NoSnapshotReason -> Bool
/= :: NoSnapshotReason -> NoSnapshotReason -> Bool
Eq, Int -> NoSnapshotReason -> ShowS
[NoSnapshotReason] -> ShowS
NoSnapshotReason -> String
(Int -> NoSnapshotReason -> ShowS)
-> (NoSnapshotReason -> String)
-> ([NoSnapshotReason] -> ShowS)
-> Show NoSnapshotReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoSnapshotReason -> ShowS
showsPrec :: Int -> NoSnapshotReason -> ShowS
$cshow :: NoSnapshotReason -> String
show :: NoSnapshotReason -> String
$cshowList :: [NoSnapshotReason] -> ShowS
showList :: [NoSnapshotReason] -> ShowS
Show, (forall x. NoSnapshotReason -> Rep NoSnapshotReason x)
-> (forall x. Rep NoSnapshotReason x -> NoSnapshotReason)
-> Generic NoSnapshotReason
forall x. Rep NoSnapshotReason x -> NoSnapshotReason
forall x. NoSnapshotReason -> Rep NoSnapshotReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NoSnapshotReason -> Rep NoSnapshotReason x
from :: forall x. NoSnapshotReason -> Rep NoSnapshotReason x
$cto :: forall x. Rep NoSnapshotReason x -> NoSnapshotReason
to :: forall x. Rep NoSnapshotReason x -> NoSnapshotReason
Generic)

isLeader :: HeadParameters -> Party -> SnapshotNumber -> Bool
isLeader :: HeadParameters -> Party -> SnapshotNumber -> Bool
isLeader HeadParameters{[Party]
parties :: [Party]
$sel:parties:HeadParameters :: HeadParameters -> [Party]
parties} Party
p SnapshotNumber
sn =
  case Party
p Party -> [Party] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Party]
parties of
    Just Int
i -> ((SnapshotNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral SnapshotNumber
sn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
parties) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
    Maybe Int
_ -> Bool
False