-- | Types used by `Ouroboros.Network.PeerSelection.LedgerPeers` and
-- `Ouroboros.Network.PeerSelection.RootPeersDNS.LedgerPeers`
--
module Ouroboros.Network.PeerSelection.LedgerPeers.Common where

import Control.Monad.Class.MonadTime.SI
import Data.Word (Word16)
import Text.Printf

import Data.List.NonEmpty (NonEmpty)
import Network.DNS qualified as DNS
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
import Ouroboros.Network.PeerSelection.RelayAccessPoint

newtype NumberOfPeers = NumberOfPeers { NumberOfPeers -> Word16
getNumberOfPeers :: Word16 }
  deriving Int -> NumberOfPeers -> ShowS
[NumberOfPeers] -> ShowS
NumberOfPeers -> String
(Int -> NumberOfPeers -> ShowS)
-> (NumberOfPeers -> String)
-> ([NumberOfPeers] -> ShowS)
-> Show NumberOfPeers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumberOfPeers -> ShowS
showsPrec :: Int -> NumberOfPeers -> ShowS
$cshow :: NumberOfPeers -> String
show :: NumberOfPeers -> String
$cshowList :: [NumberOfPeers] -> ShowS
showList :: [NumberOfPeers] -> ShowS
Show

-- | Identifies a peer as coming from ledger or not
data IsLedgerPeer = IsLedgerPeer
                  -- ^ a ledger peer.
                  | IsNotLedgerPeer
  deriving (IsLedgerPeer -> IsLedgerPeer -> Bool
(IsLedgerPeer -> IsLedgerPeer -> Bool)
-> (IsLedgerPeer -> IsLedgerPeer -> Bool) -> Eq IsLedgerPeer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsLedgerPeer -> IsLedgerPeer -> Bool
== :: IsLedgerPeer -> IsLedgerPeer -> Bool
$c/= :: IsLedgerPeer -> IsLedgerPeer -> Bool
/= :: IsLedgerPeer -> IsLedgerPeer -> Bool
Eq, Int -> IsLedgerPeer -> ShowS
[IsLedgerPeer] -> ShowS
IsLedgerPeer -> String
(Int -> IsLedgerPeer -> ShowS)
-> (IsLedgerPeer -> String)
-> ([IsLedgerPeer] -> ShowS)
-> Show IsLedgerPeer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsLedgerPeer -> ShowS
showsPrec :: Int -> IsLedgerPeer -> ShowS
$cshow :: IsLedgerPeer -> String
show :: IsLedgerPeer -> String
$cshowList :: [IsLedgerPeer] -> ShowS
showList :: [IsLedgerPeer] -> ShowS
Show)

-- | Ledger Peer request result
--
data LedgerPeers = LedgerPeers LedgerStateJudgement -- ^ Current ledger state
                               [(PoolStake, NonEmpty RelayAccessPoint)]
                               -- ^ Ledger peers
                 | BeforeSlot -- ^ No result because the node is still
                              -- before the configured UseLedgerAfter slot
                              -- number
  deriving (LedgerPeers -> LedgerPeers -> Bool
(LedgerPeers -> LedgerPeers -> Bool)
-> (LedgerPeers -> LedgerPeers -> Bool) -> Eq LedgerPeers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerPeers -> LedgerPeers -> Bool
== :: LedgerPeers -> LedgerPeers -> Bool
$c/= :: LedgerPeers -> LedgerPeers -> Bool
/= :: LedgerPeers -> LedgerPeers -> Bool
Eq, Int -> LedgerPeers -> ShowS
[LedgerPeers] -> ShowS
LedgerPeers -> String
(Int -> LedgerPeers -> ShowS)
-> (LedgerPeers -> String)
-> ([LedgerPeers] -> ShowS)
-> Show LedgerPeers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerPeers -> ShowS
showsPrec :: Int -> LedgerPeers -> ShowS
$cshow :: LedgerPeers -> String
show :: LedgerPeers -> String
$cshowList :: [LedgerPeers] -> ShowS
showList :: [LedgerPeers] -> ShowS
Show)

-- | Trace LedgerPeers events.
data TraceLedgerPeers =
      PickedBigLedgerPeer RelayAccessPoint AccPoolStake PoolStake
      -- ^ Trace for a significant ledger peer picked with accumulated and relative stake of its pool.
    | PickedLedgerPeer RelayAccessPoint AccPoolStake PoolStake
      -- ^ Trace for a ledger peer picked with accumulated and relative stake of its pool.
    | PickedBigLedgerPeers NumberOfPeers [RelayAccessPoint]
    | PickedLedgerPeers    NumberOfPeers [RelayAccessPoint]
      -- ^ Trace for the number of peers and we wanted to pick and the list of peers picked.
    | FetchingNewLedgerState Int Int
      -- ^ Trace for fetching a new list of peers from the ledger. The first Int
      -- is the number of ledger peers returned the latter is the number of big
      -- ledger peers.
    | TraceLedgerPeersDomains [DomainAccessPoint]
    | TraceLedgerPeersResult  DNS.Domain [(IP, DNS.TTL)]
    | TraceLedgerPeersFailure DNS.Domain DNS.DNSError
    | DisabledLedgerPeers
      -- ^ Trace for when getting peers from the ledger is disabled, that is DontUseLedgerPeers.
    | TraceUseLedgerPeers UseLedgerPeers
      -- ^ Trace UseLedgerPeers value
    | WaitingOnRequest
    | RequestForPeers NumberOfPeers
    | ReusingLedgerState Int DiffTime
    | FallingBackToPublicRootPeers
    | NotEnoughBigLedgerPeers NumberOfPeers Int
    | NotEnoughLedgerPeers NumberOfPeers Int
    | UsingBigLedgerPeerSnapshot


instance Show TraceLedgerPeers where
    show :: TraceLedgerPeers -> String
show (PickedBigLedgerPeer RelayAccessPoint
addr AccPoolStake
ackStake PoolStake
stake) =
        String -> String -> String -> Double -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"PickedBigLedgerPeer %s ack stake %s ( %.04f) relative stake %s ( %.04f )"
            (RelayAccessPoint -> String
forall a. Show a => a -> String
show RelayAccessPoint
addr)
            (Rational -> String
forall a. Show a => a -> String
show (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ AccPoolStake -> Rational
unAccPoolStake AccPoolStake
ackStake)
            (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (AccPoolStake -> Rational
unAccPoolStake AccPoolStake
ackStake) :: Double)
            (Rational -> String
forall a. Show a => a -> String
show (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ PoolStake -> Rational
unPoolStake PoolStake
stake)
            (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (PoolStake -> Rational
unPoolStake PoolStake
stake) :: Double)
    show (PickedLedgerPeer RelayAccessPoint
addr AccPoolStake
ackStake PoolStake
stake) =
        String -> String -> String -> Double -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"PickedLedgerPeer %s ack stake %s ( %.04f) relative stake %s ( %.04f )"
            (RelayAccessPoint -> String
forall a. Show a => a -> String
show RelayAccessPoint
addr)
            (Rational -> String
forall a. Show a => a -> String
show (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ AccPoolStake -> Rational
unAccPoolStake AccPoolStake
ackStake)
            (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (AccPoolStake -> Rational
unAccPoolStake AccPoolStake
ackStake) :: Double)
            (Rational -> String
forall a. Show a => a -> String
show (Rational -> String) -> Rational -> String
forall a b. (a -> b) -> a -> b
$ PoolStake -> Rational
unPoolStake PoolStake
stake)
            (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (PoolStake -> Rational
unPoolStake PoolStake
stake) :: Double)
    show (PickedBigLedgerPeers (NumberOfPeers Word16
n) [RelayAccessPoint]
peers) =
        String -> Word16 -> ShowS
forall r. PrintfType r => String -> r
printf String
"PickedBigLedgerPeers %d %s" Word16
n ([RelayAccessPoint] -> String
forall a. Show a => a -> String
show [RelayAccessPoint]
peers)
    show (PickedLedgerPeers (NumberOfPeers Word16
n) [RelayAccessPoint]
peers) =
        String -> Word16 -> ShowS
forall r. PrintfType r => String -> r
printf String
"PickedLedgerPeers %d %s" Word16
n ([RelayAccessPoint] -> String
forall a. Show a => a -> String
show [RelayAccessPoint]
peers)
    show (FetchingNewLedgerState Int
cnt Int
bigCnt) =
        String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Fetching new ledgerstate, %d registered pools, %d registered big ledger pools"
            Int
cnt Int
bigCnt
    show (TraceUseLedgerPeers UseLedgerPeers
ulp) =
        String -> ShowS
forall r. PrintfType r => String -> r
printf String
"UseLedgerPeers state %s"
            (UseLedgerPeers -> String
forall a. Show a => a -> String
show UseLedgerPeers
ulp)
    show TraceLedgerPeers
WaitingOnRequest = String
"WaitingOnRequest"
    show (RequestForPeers (NumberOfPeers Word16
cnt)) = String -> Word16 -> String
forall r. PrintfType r => String -> r
printf String
"RequestForPeers %d" Word16
cnt
    show (ReusingLedgerState Int
cnt DiffTime
age) =
        String -> Int -> ShowS
forall r. PrintfType r => String -> r
printf String
"ReusingLedgerState %d peers age %s"
          Int
cnt
          (DiffTime -> String
forall a. Show a => a -> String
show DiffTime
age)
    show TraceLedgerPeers
FallingBackToPublicRootPeers = String
"Falling back to public root peers"
    show TraceLedgerPeers
DisabledLedgerPeers = String
"LedgerPeers is disabled"
    show (NotEnoughBigLedgerPeers (NumberOfPeers Word16
n) Int
numOfBigLedgerPeers) =
      String -> Word16 -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Not enough big ledger peers to pick %d out of %d" Word16
n Int
numOfBigLedgerPeers
    show (NotEnoughLedgerPeers (NumberOfPeers Word16
n) Int
numOfLedgerPeers) =
      String -> Word16 -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Not enough ledger peers to pick %d out of %d" Word16
n Int
numOfLedgerPeers

    show (TraceLedgerPeersDomains [DomainAccessPoint]
domains) = String
"Resolving " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [DomainAccessPoint] -> String
forall a. Show a => a -> String
show [DomainAccessPoint]
domains
    show (TraceLedgerPeersResult Domain
domain [(IP, TTL)]
l) =
      String
"Resolution success " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Domain -> String
forall a. Show a => a -> String
show Domain
domain String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(IP, TTL)] -> String
forall a. Show a => a -> String
show [(IP, TTL)]
l
    show (TraceLedgerPeersFailure Domain
domain DNSError
err) =
      String
"Resolution failed " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Domain -> String
forall a. Show a => a -> String
show Domain
domain String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DNSError -> String
forall a. Show a => a -> String
show DNSError
err
    show TraceLedgerPeers
UsingBigLedgerPeerSnapshot = String
"Using peer snapshot for big ledger peers"