{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Cardano.Network.PeerSelection.Governor.PeerSelectionState where

import Control.Monad.Class.MonadTime.SI (Time (..))
import Data.Aeson (FromJSON)

import Cardano.Network.ConsensusMode (ConsensusMode)
import Cardano.Network.LedgerStateJudgement
import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))


-- | Minimum number of hot big ledger peers in Genesis mode
--   for trusted state to be signalled to Consensus. This number
--   should be smaller than the `targetNumberOfActiveBigLedgerPeers`
--   but greater than 1. In Genesis, we may demote a big ledger peer
--   for underperformance, but not promote a replacement immediately
--   to guard against adversaries which may want to slow down our
--   progress.
--
newtype NumberOfBigLedgerPeers =
  NumberOfBigLedgerPeers { NumberOfBigLedgerPeers -> Int
getNumberOfBigLedgerPeers :: Int }
  deriving stock (NumberOfBigLedgerPeers -> NumberOfBigLedgerPeers -> Bool
(NumberOfBigLedgerPeers -> NumberOfBigLedgerPeers -> Bool)
-> (NumberOfBigLedgerPeers -> NumberOfBigLedgerPeers -> Bool)
-> Eq NumberOfBigLedgerPeers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumberOfBigLedgerPeers -> NumberOfBigLedgerPeers -> Bool
== :: NumberOfBigLedgerPeers -> NumberOfBigLedgerPeers -> Bool
$c/= :: NumberOfBigLedgerPeers -> NumberOfBigLedgerPeers -> Bool
/= :: NumberOfBigLedgerPeers -> NumberOfBigLedgerPeers -> Bool
Eq, Int -> NumberOfBigLedgerPeers -> ShowS
[NumberOfBigLedgerPeers] -> ShowS
NumberOfBigLedgerPeers -> String
(Int -> NumberOfBigLedgerPeers -> ShowS)
-> (NumberOfBigLedgerPeers -> String)
-> ([NumberOfBigLedgerPeers] -> ShowS)
-> Show NumberOfBigLedgerPeers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumberOfBigLedgerPeers -> ShowS
showsPrec :: Int -> NumberOfBigLedgerPeers -> ShowS
$cshow :: NumberOfBigLedgerPeers -> String
show :: NumberOfBigLedgerPeers -> String
$cshowList :: [NumberOfBigLedgerPeers] -> ShowS
showList :: [NumberOfBigLedgerPeers] -> ShowS
Show)
  deriving newtype (Maybe NumberOfBigLedgerPeers
Value -> Parser [NumberOfBigLedgerPeers]
Value -> Parser NumberOfBigLedgerPeers
(Value -> Parser NumberOfBigLedgerPeers)
-> (Value -> Parser [NumberOfBigLedgerPeers])
-> Maybe NumberOfBigLedgerPeers
-> FromJSON NumberOfBigLedgerPeers
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser NumberOfBigLedgerPeers
parseJSON :: Value -> Parser NumberOfBigLedgerPeers
$cparseJSONList :: Value -> Parser [NumberOfBigLedgerPeers]
parseJSONList :: Value -> Parser [NumberOfBigLedgerPeers]
$comittedField :: Maybe NumberOfBigLedgerPeers
omittedField :: Maybe NumberOfBigLedgerPeers
FromJSON)



-- | Cardano Node PeerSelection State extension data type.
-- It contain specific PeerSelection state parameters to guide the Outbound
-- Governor.
--
data ExtraState =
  ExtraState {
    -- | Current ledger state judgement
    ExtraState -> LedgerStateJudgement
ledgerStateJudgement      :: !LedgerStateJudgement

    -- | Flag whether to sync in genesis mode when ledgerStateJudgement == TooOld
    -- this comes from node configuration and should be treated as read-only
    --
  , ExtraState -> ConsensusMode
consensusMode             :: !ConsensusMode

    -- | Current value of 'UseBootstrapPeers'.
    --
  , ExtraState -> UseBootstrapPeers
bootstrapPeersFlag        :: !UseBootstrapPeers

    -- | Has the governor fully reset its state
    --
  , ExtraState -> Bool
hasOnlyBootstrapPeers     :: !Bool

    -- | Has the governor fully reset its state
    -- TODO: Use strict Maybe type from cardano-base
  , ExtraState -> Maybe Time
bootstrapPeersTimeout     :: !(Maybe Time)

    -- | Use in Genesis mode to check whether we can signal to
    --   consensus that we met criteria of trusted state to enter
    --   deadline mode. This parameter comes from node configuration,
    --   with a default value in the `Configuration` module.
    --
  , ExtraState -> NumberOfBigLedgerPeers
minNumberOfBigLedgerPeers :: NumberOfBigLedgerPeers
  }
  deriving (ExtraState -> ExtraState -> Bool
(ExtraState -> ExtraState -> Bool)
-> (ExtraState -> ExtraState -> Bool) -> Eq ExtraState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtraState -> ExtraState -> Bool
== :: ExtraState -> ExtraState -> Bool
$c/= :: ExtraState -> ExtraState -> Bool
/= :: ExtraState -> ExtraState -> Bool
Eq, Int -> ExtraState -> ShowS
[ExtraState] -> ShowS
ExtraState -> String
(Int -> ExtraState -> ShowS)
-> (ExtraState -> String)
-> ([ExtraState] -> ShowS)
-> Show ExtraState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtraState -> ShowS
showsPrec :: Int -> ExtraState -> ShowS
$cshow :: ExtraState -> String
show :: ExtraState -> String
$cshowList :: [ExtraState] -> ShowS
showList :: [ExtraState] -> ShowS
Show)

empty :: ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
empty :: ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
empty ConsensusMode
cm NumberOfBigLedgerPeers
minActiveBigLedgerPeers =
    ExtraState {
      ledgerStateJudgement :: LedgerStateJudgement
ledgerStateJudgement      = LedgerStateJudgement
TooOld,
      consensusMode :: ConsensusMode
consensusMode             = ConsensusMode
cm,
      bootstrapPeersFlag :: UseBootstrapPeers
bootstrapPeersFlag        = UseBootstrapPeers
DontUseBootstrapPeers,
      hasOnlyBootstrapPeers :: Bool
hasOnlyBootstrapPeers     = Bool
False,
      bootstrapPeersTimeout :: Maybe Time
bootstrapPeersTimeout     = Maybe Time
forall a. Maybe a
Nothing,
      minNumberOfBigLedgerPeers :: NumberOfBigLedgerPeers
minNumberOfBigLedgerPeers = NumberOfBigLedgerPeers
minActiveBigLedgerPeers
    }

data DebugPeerSelectionState =
  DebugPeerSelectionState {
    DebugPeerSelectionState -> LedgerStateJudgement
debugLedgerStateJudgement :: !LedgerStateJudgement
  }
  deriving Int -> DebugPeerSelectionState -> ShowS
[DebugPeerSelectionState] -> ShowS
DebugPeerSelectionState -> String
(Int -> DebugPeerSelectionState -> ShowS)
-> (DebugPeerSelectionState -> String)
-> ([DebugPeerSelectionState] -> ShowS)
-> Show DebugPeerSelectionState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DebugPeerSelectionState -> ShowS
showsPrec :: Int -> DebugPeerSelectionState -> ShowS
$cshow :: DebugPeerSelectionState -> String
show :: DebugPeerSelectionState -> String
$cshowList :: [DebugPeerSelectionState] -> ShowS
showList :: [DebugPeerSelectionState] -> ShowS
Show