{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}

{-# OPTIONS_GHC -fno-warn-orphans       #-}

-- | Various types related to ledger peers.  This module is re-exported from
-- "Ouroboros.Network.PeerSelection.LedgerPeers".
--
module Ouroboros.Network.PeerSelection.LedgerPeers.Type
  ( PoolStake (..)
  , AccPoolStake (..)
  , IsBigLedgerPeer (..)
  , LedgerStateJudgement (..)
  , LedgerPeersConsensusInterface (..)
  , UseLedgerPeers (..)
  , AfterSlot (..)
  , LedgerPeersKind (..)
  , LedgerPeerSnapshot (.., LedgerPeerSnapshot)
  , MinBigLedgerPeersForTrustedState (..)
  , isLedgerPeersEnabled
  , compareLedgerPeerSnapshotApproximate
  ) where

import Control.Monad (forM)
import Data.ByteString.Char8 qualified as BS
import Data.List.NonEmpty (NonEmpty)
import Data.Text.Encoding (decodeUtf8)
import GHC.Generics (Generic)
import Text.Read (readMaybe)

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Binary qualified as Codec
import Cardano.Slotting.Slot (SlotNo (..), WithOrigin (..))
import Control.Concurrent.Class.MonadSTM
import Control.DeepSeq (NFData (..))
import Data.Aeson
import Data.Aeson.Types
import NoThunks.Class
import Ouroboros.Network.PeerSelection.RelayAccessPoint

-- | 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 MinBigLedgerPeersForTrustedState =
  MinBigLedgerPeersForTrustedState { MinBigLedgerPeersForTrustedState -> Int
getMinBigLedgerPeersForTrustedState :: Int }
  deriving stock (MinBigLedgerPeersForTrustedState
-> MinBigLedgerPeersForTrustedState -> Bool
(MinBigLedgerPeersForTrustedState
 -> MinBigLedgerPeersForTrustedState -> Bool)
-> (MinBigLedgerPeersForTrustedState
    -> MinBigLedgerPeersForTrustedState -> Bool)
-> Eq MinBigLedgerPeersForTrustedState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinBigLedgerPeersForTrustedState
-> MinBigLedgerPeersForTrustedState -> Bool
== :: MinBigLedgerPeersForTrustedState
-> MinBigLedgerPeersForTrustedState -> Bool
$c/= :: MinBigLedgerPeersForTrustedState
-> MinBigLedgerPeersForTrustedState -> Bool
/= :: MinBigLedgerPeersForTrustedState
-> MinBigLedgerPeersForTrustedState -> Bool
Eq, Int -> MinBigLedgerPeersForTrustedState -> ShowS
[MinBigLedgerPeersForTrustedState] -> ShowS
MinBigLedgerPeersForTrustedState -> String
(Int -> MinBigLedgerPeersForTrustedState -> ShowS)
-> (MinBigLedgerPeersForTrustedState -> String)
-> ([MinBigLedgerPeersForTrustedState] -> ShowS)
-> Show MinBigLedgerPeersForTrustedState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinBigLedgerPeersForTrustedState -> ShowS
showsPrec :: Int -> MinBigLedgerPeersForTrustedState -> ShowS
$cshow :: MinBigLedgerPeersForTrustedState -> String
show :: MinBigLedgerPeersForTrustedState -> String
$cshowList :: [MinBigLedgerPeersForTrustedState] -> ShowS
showList :: [MinBigLedgerPeersForTrustedState] -> ShowS
Show)
  deriving newtype (Maybe MinBigLedgerPeersForTrustedState
Value -> Parser [MinBigLedgerPeersForTrustedState]
Value -> Parser MinBigLedgerPeersForTrustedState
(Value -> Parser MinBigLedgerPeersForTrustedState)
-> (Value -> Parser [MinBigLedgerPeersForTrustedState])
-> Maybe MinBigLedgerPeersForTrustedState
-> FromJSON MinBigLedgerPeersForTrustedState
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MinBigLedgerPeersForTrustedState
parseJSON :: Value -> Parser MinBigLedgerPeersForTrustedState
$cparseJSONList :: Value -> Parser [MinBigLedgerPeersForTrustedState]
parseJSONList :: Value -> Parser [MinBigLedgerPeersForTrustedState]
$comittedField :: Maybe MinBigLedgerPeersForTrustedState
omittedField :: Maybe MinBigLedgerPeersForTrustedState
FromJSON)

-- |The type of big ledger peers that is serialised or later
-- provided by node configuration for the networking layer
-- to connect to when syncing.
--
data LedgerPeerSnapshot =
  LedgerPeerSnapshotV1 (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
  -- ^ Internal use for version 1, use pattern synonym for public API
  deriving (LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool
(LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool)
-> (LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool)
-> Eq LedgerPeerSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool
== :: LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool
$c/= :: LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool
/= :: LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool
Eq, Int -> LedgerPeerSnapshot -> ShowS
[LedgerPeerSnapshot] -> ShowS
LedgerPeerSnapshot -> String
(Int -> LedgerPeerSnapshot -> ShowS)
-> (LedgerPeerSnapshot -> String)
-> ([LedgerPeerSnapshot] -> ShowS)
-> Show LedgerPeerSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerPeerSnapshot -> ShowS
showsPrec :: Int -> LedgerPeerSnapshot -> ShowS
$cshow :: LedgerPeerSnapshot -> String
show :: LedgerPeerSnapshot -> String
$cshowList :: [LedgerPeerSnapshot] -> ShowS
showList :: [LedgerPeerSnapshot] -> ShowS
Show)

-- |Public API to access snapshot data. Currently access to only most recent version is available.
-- Nonetheless, serialisation from the node into JSON is supported for older versions via internal
-- api so that newer CLI can still support older node formats.
--
pattern LedgerPeerSnapshot :: (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
                           -> LedgerPeerSnapshot
pattern $bLedgerPeerSnapshot :: (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> LedgerPeerSnapshot
$mLedgerPeerSnapshot :: forall {r}.
LedgerPeerSnapshot
-> ((WithOrigin SlotNo,
     [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
    -> r)
-> ((# #) -> r)
-> r
LedgerPeerSnapshot payload <- LedgerPeerSnapshotV1 payload where
  LedgerPeerSnapshot (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
payload = (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> LedgerPeerSnapshot
LedgerPeerSnapshotV1 (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
payload

{-# COMPLETE LedgerPeerSnapshot #-}

-- | Since ledger peer snapshot is serialised with all domain names
--   fully qualified, and all stake values are approximate in floating
--   point, comparison is necessarily approximate as well.
--   The candidate argument is processed here to simulate a round trip
--   by the serialisation mechanism and then compared to the baseline
--   argument, which is assumed that it was actually processed this way
--   when a snapshot was created earlier, and hence it is approximate as well.
--   The two approximate values should be equal if they were created
--   from the same 'faithful' data.
--
compareLedgerPeerSnapshotApproximate :: LedgerPeerSnapshot
                                     -> LedgerPeerSnapshot
                                     -> Bool
compareLedgerPeerSnapshotApproximate :: LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool
compareLedgerPeerSnapshotApproximate LedgerPeerSnapshot
baseline LedgerPeerSnapshot
candidate =
  case Result LedgerPeerSnapshot
tripIt of
    Success LedgerPeerSnapshot
candidate' -> LedgerPeerSnapshot
candidate' LedgerPeerSnapshot -> LedgerPeerSnapshot -> Bool
forall a. Eq a => a -> a -> Bool
== LedgerPeerSnapshot
baseline
    Error String
_            -> Bool
False
  where
    tripIt :: Result LedgerPeerSnapshot
tripIt = Value -> Result LedgerPeerSnapshot
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result LedgerPeerSnapshot)
-> (LedgerPeerSnapshot -> Value)
-> LedgerPeerSnapshot
-> Result LedgerPeerSnapshot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerPeerSnapshot -> Value
forall a. ToJSON a => a -> Value
toJSON (LedgerPeerSnapshot -> Result LedgerPeerSnapshot)
-> LedgerPeerSnapshot -> Result LedgerPeerSnapshot
forall a b. (a -> b) -> a -> b
$ LedgerPeerSnapshot
candidate

-- | In case the format changes in the future, this function provides a migration functionality
-- when possible.
--
migrateLedgerPeerSnapshot :: LedgerPeerSnapshot
                          -> Maybe (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
migrateLedgerPeerSnapshot :: LedgerPeerSnapshot
-> Maybe
     (WithOrigin SlotNo,
      [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
migrateLedgerPeerSnapshot (LedgerPeerSnapshotV1 (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
lps) = (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> Maybe
     (WithOrigin SlotNo,
      [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
forall a. a -> Maybe a
Just (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
lps

instance ToJSON LedgerPeerSnapshot where
  toJSON :: LedgerPeerSnapshot -> Value
toJSON (LedgerPeerSnapshotV1 (WithOrigin SlotNo
slot, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
pools)) =
    [Pair] -> Value
object [ Key
"version" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int
1 :: Int)
           , Key
"slotNo" Key -> WithOrigin SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= WithOrigin SlotNo
slot
           , Key
"bigLedgerPools" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [ [Pair] -> Value
object [ Key
"accumulatedStake" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. Fractional a => Rational -> a
fromRational @Double Rational
accStake
                                          , Key
"relativeStake"  Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. Fractional a => Rational -> a
fromRational @Double Rational
relStake
                                          , Key
"relays"   Key -> NonEmpty RelayAccessPointCoded -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty RelayAccessPointCoded
relays']
                                 | (AccPoolStake Rational
accStake, (PoolStake Rational
relStake, NonEmpty RelayAccessPoint
relays)) <- [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
pools
                                 , let relays' :: NonEmpty RelayAccessPointCoded
relays' = (RelayAccessPoint -> RelayAccessPointCoded)
-> NonEmpty RelayAccessPoint -> NonEmpty RelayAccessPointCoded
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelayAccessPoint -> RelayAccessPointCoded
RelayAccessPointCoded NonEmpty RelayAccessPoint
relays]]

instance FromJSON LedgerPeerSnapshot where
  parseJSON :: Value -> Parser LedgerPeerSnapshot
parseJSON = String
-> (Object -> Parser LedgerPeerSnapshot)
-> Value
-> Parser LedgerPeerSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LedgerPeerSnapshot" ((Object -> Parser LedgerPeerSnapshot)
 -> Value -> Parser LedgerPeerSnapshot)
-> (Object -> Parser LedgerPeerSnapshot)
-> Value
-> Parser LedgerPeerSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    vNum :: Int <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
    parsedSnapshot <-
      case vNum of
        Int
1 -> do
          slot <- Object
v Object -> Key -> Parser (WithOrigin SlotNo)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slotNo"
          bigPools <- v .: "bigLedgerPools"
          bigPools' <- (forM bigPools . withObject "bigLedgerPools" $ \Object
poolV -> do
            AccPoolStakeCoded accStake <- Object
poolV Object -> Key -> Parser AccPoolStakeCoded
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accumulatedStake"
            PoolStakeCoded reStake <- poolV .: "relativeStake"
            relays <- fmap unRelayAccessPointCoded <$> poolV .: "relays"
            return (accStake, (reStake, relays))) <?> Key "bigLedgerPools"

          return $ LedgerPeerSnapshotV1 (slot, bigPools')
        Int
_ -> String -> Parser LedgerPeerSnapshot
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser LedgerPeerSnapshot)
-> String -> Parser LedgerPeerSnapshot
forall a b. (a -> b) -> a -> b
$ String
"Network.LedgerPeers.Type: parseJSON: failed to parse unsupported version " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
vNum
    case migrateLedgerPeerSnapshot parsedSnapshot of
      Just (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
payload -> LedgerPeerSnapshot -> Parser LedgerPeerSnapshot
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerPeerSnapshot -> Parser LedgerPeerSnapshot)
-> LedgerPeerSnapshot -> Parser LedgerPeerSnapshot
forall a b. (a -> b) -> a -> b
$ (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> LedgerPeerSnapshot
LedgerPeerSnapshot (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
payload
      Maybe
  (WithOrigin SlotNo,
   [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
Nothing      -> String -> Parser LedgerPeerSnapshot
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Network.LedgerPeers.Type: parseJSON: failed to migrate big ledger peer snapshot"

-- | cardano-slotting provides its own {To,From}CBOR instances for WithOrigin a
-- but to pin down the encoding for CDDL we provide a wrapper with custom
-- instances
--
newtype WithOriginCoded = WithOriginCoded (WithOrigin SlotNo)

-- | Hand cranked CBOR instances to facilitate CDDL spec
--
instance ToCBOR WithOriginCoded where
  toCBOR :: WithOriginCoded -> Encoding
toCBOR (WithOriginCoded WithOrigin SlotNo
Origin) = Word -> Encoding
Codec.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
0
  toCBOR (WithOriginCoded (At SlotNo
slotNo)) = Word -> Encoding
Codec.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SlotNo
slotNo

instance FromCBOR WithOriginCoded where
  fromCBOR :: forall s. Decoder s WithOriginCoded
fromCBOR = do
    listLen <- Decoder s Int
forall s. Decoder s Int
Codec.decodeListLen
    tag <- Codec.decodeWord8
    case (listLen, tag) of
      (Int
1, Word8
0) -> WithOriginCoded -> Decoder s WithOriginCoded
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithOriginCoded -> Decoder s WithOriginCoded)
-> WithOriginCoded -> Decoder s WithOriginCoded
forall a b. (a -> b) -> a -> b
$ WithOrigin SlotNo -> WithOriginCoded
WithOriginCoded WithOrigin SlotNo
forall t. WithOrigin t
Origin
      (Int
1, Word8
_) -> String -> Decoder s WithOriginCoded
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LedgerPeers.Type: Expected tag for Origin constructor"
      (Int
2, Word8
1) -> WithOrigin SlotNo -> WithOriginCoded
WithOriginCoded (WithOrigin SlotNo -> WithOriginCoded)
-> (SlotNo -> WithOrigin SlotNo) -> SlotNo -> WithOriginCoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
At (SlotNo -> WithOriginCoded)
-> Decoder s SlotNo -> Decoder s WithOriginCoded
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int
2, Word8
_) -> String -> Decoder s WithOriginCoded
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LedgerPeers.Type: Expected tag for At constructor"
      (Int, Word8)
_      -> String -> Decoder s WithOriginCoded
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LedgerPeers.Type: Unrecognized list length while decoding WithOrigin SlotNo"

instance ToCBOR LedgerPeerSnapshot where
  toCBOR :: LedgerPeerSnapshot -> Encoding
toCBOR (LedgerPeerSnapshotV1 (WithOrigin SlotNo
wOrigin, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
pools)) =
       Word -> Encoding
Codec.encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
1
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (WithOriginCoded,
 [(AccPoolStakeCoded,
   (PoolStakeCoded, NonEmpty RelayAccessPointCoded))])
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (WithOrigin SlotNo -> WithOriginCoded
WithOriginCoded WithOrigin SlotNo
wOrigin, [(AccPoolStakeCoded,
  (PoolStakeCoded, NonEmpty RelayAccessPointCoded))]
pools')
    where
      pools' :: [(AccPoolStakeCoded,
  (PoolStakeCoded, NonEmpty RelayAccessPointCoded))]
pools' =
        [(AccPoolStake -> AccPoolStakeCoded
AccPoolStakeCoded AccPoolStake
accPoolStake, (PoolStake -> PoolStakeCoded
PoolStakeCoded PoolStake
relStake, NonEmpty RelayAccessPointCoded
neRelayAccessPointCoded))
        | (AccPoolStake
accPoolStake, (PoolStake
relStake, NonEmpty RelayAccessPoint
relays)) <- [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
pools
        , let neRelayAccessPointCoded :: NonEmpty RelayAccessPointCoded
neRelayAccessPointCoded = (RelayAccessPoint -> RelayAccessPointCoded)
-> NonEmpty RelayAccessPoint -> NonEmpty RelayAccessPointCoded
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelayAccessPoint -> RelayAccessPointCoded
RelayAccessPointCoded NonEmpty RelayAccessPoint
relays]

instance FromCBOR LedgerPeerSnapshot where
  fromCBOR :: forall s. Decoder s LedgerPeerSnapshot
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
2
    version <- Decoder s Word8
forall s. Decoder s Word8
Codec.decodeWord8
    case version of
      Word8
1 -> (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> LedgerPeerSnapshot
LedgerPeerSnapshotV1 ((WithOrigin SlotNo,
  [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
 -> LedgerPeerSnapshot)
-> Decoder
     s
     (WithOrigin SlotNo,
      [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> Decoder s LedgerPeerSnapshot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
             (WithOriginCoded wOrigin, pools) <- Decoder
  s
  (WithOriginCoded,
   [(AccPoolStakeCoded,
     (PoolStakeCoded, NonEmpty RelayAccessPointCoded))])
forall s.
Decoder
  s
  (WithOriginCoded,
   [(AccPoolStakeCoded,
     (PoolStakeCoded, NonEmpty RelayAccessPointCoded))])
forall a s. FromCBOR a => Decoder s a
fromCBOR
             let pools' = [(AccPoolStake
accStake, (PoolStake
relStake, NonEmpty RelayAccessPoint
relays'))
                          | (AccPoolStakeCoded AccPoolStake
accStake, (PoolStakeCoded PoolStake
relStake, NonEmpty RelayAccessPointCoded
relays)) <- [(AccPoolStakeCoded,
  (PoolStakeCoded, NonEmpty RelayAccessPointCoded))]
pools
                          , let relays' :: NonEmpty RelayAccessPoint
relays' = RelayAccessPointCoded -> RelayAccessPoint
unRelayAccessPointCoded (RelayAccessPointCoded -> RelayAccessPoint)
-> NonEmpty RelayAccessPointCoded -> NonEmpty RelayAccessPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty RelayAccessPointCoded
relays]
             return (wOrigin, pools')
      Word8
_ -> String -> Decoder s LedgerPeerSnapshot
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s LedgerPeerSnapshot)
-> String -> Decoder s LedgerPeerSnapshot
forall a b. (a -> b) -> a -> b
$ String
"LedgerPeers.Type: no decoder could be found for version " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
version

-- | Which ledger peers to pick.
--
data LedgerPeersKind = AllLedgerPeers | BigLedgerPeers
  deriving Int -> LedgerPeersKind -> ShowS
[LedgerPeersKind] -> ShowS
LedgerPeersKind -> String
(Int -> LedgerPeersKind -> ShowS)
-> (LedgerPeersKind -> String)
-> ([LedgerPeersKind] -> ShowS)
-> Show LedgerPeersKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerPeersKind -> ShowS
showsPrec :: Int -> LedgerPeersKind -> ShowS
$cshow :: LedgerPeersKind -> String
show :: LedgerPeersKind -> String
$cshowList :: [LedgerPeersKind] -> ShowS
showList :: [LedgerPeersKind] -> ShowS
Show

-- | Only use the ledger after the given slot number.
data UseLedgerPeers = DontUseLedgerPeers
                    | UseLedgerPeers AfterSlot
                    deriving (UseLedgerPeers -> UseLedgerPeers -> Bool
(UseLedgerPeers -> UseLedgerPeers -> Bool)
-> (UseLedgerPeers -> UseLedgerPeers -> Bool) -> Eq UseLedgerPeers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UseLedgerPeers -> UseLedgerPeers -> Bool
== :: UseLedgerPeers -> UseLedgerPeers -> Bool
$c/= :: UseLedgerPeers -> UseLedgerPeers -> Bool
/= :: UseLedgerPeers -> UseLedgerPeers -> Bool
Eq, Int -> UseLedgerPeers -> ShowS
[UseLedgerPeers] -> ShowS
UseLedgerPeers -> String
(Int -> UseLedgerPeers -> ShowS)
-> (UseLedgerPeers -> String)
-> ([UseLedgerPeers] -> ShowS)
-> Show UseLedgerPeers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UseLedgerPeers -> ShowS
showsPrec :: Int -> UseLedgerPeers -> ShowS
$cshow :: UseLedgerPeers -> String
show :: UseLedgerPeers -> String
$cshowList :: [UseLedgerPeers] -> ShowS
showList :: [UseLedgerPeers] -> ShowS
Show, (forall x. UseLedgerPeers -> Rep UseLedgerPeers x)
-> (forall x. Rep UseLedgerPeers x -> UseLedgerPeers)
-> Generic UseLedgerPeers
forall x. Rep UseLedgerPeers x -> UseLedgerPeers
forall x. UseLedgerPeers -> Rep UseLedgerPeers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UseLedgerPeers -> Rep UseLedgerPeers x
from :: forall x. UseLedgerPeers -> Rep UseLedgerPeers x
$cto :: forall x. Rep UseLedgerPeers x -> UseLedgerPeers
to :: forall x. Rep UseLedgerPeers x -> UseLedgerPeers
Generic, Context -> UseLedgerPeers -> IO (Maybe ThunkInfo)
Proxy UseLedgerPeers -> String
(Context -> UseLedgerPeers -> IO (Maybe ThunkInfo))
-> (Context -> UseLedgerPeers -> IO (Maybe ThunkInfo))
-> (Proxy UseLedgerPeers -> String)
-> NoThunks UseLedgerPeers
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UseLedgerPeers -> IO (Maybe ThunkInfo)
noThunks :: Context -> UseLedgerPeers -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UseLedgerPeers -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UseLedgerPeers -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UseLedgerPeers -> String
showTypeOf :: Proxy UseLedgerPeers -> String
NoThunks)

-- | Only use the ledger after the given slot number.
data AfterSlot = Always
               | After SlotNo
               deriving (AfterSlot -> AfterSlot -> Bool
(AfterSlot -> AfterSlot -> Bool)
-> (AfterSlot -> AfterSlot -> Bool) -> Eq AfterSlot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AfterSlot -> AfterSlot -> Bool
== :: AfterSlot -> AfterSlot -> Bool
$c/= :: AfterSlot -> AfterSlot -> Bool
/= :: AfterSlot -> AfterSlot -> Bool
Eq, Int -> AfterSlot -> ShowS
[AfterSlot] -> ShowS
AfterSlot -> String
(Int -> AfterSlot -> ShowS)
-> (AfterSlot -> String)
-> ([AfterSlot] -> ShowS)
-> Show AfterSlot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AfterSlot -> ShowS
showsPrec :: Int -> AfterSlot -> ShowS
$cshow :: AfterSlot -> String
show :: AfterSlot -> String
$cshowList :: [AfterSlot] -> ShowS
showList :: [AfterSlot] -> ShowS
Show, (forall x. AfterSlot -> Rep AfterSlot x)
-> (forall x. Rep AfterSlot x -> AfterSlot) -> Generic AfterSlot
forall x. Rep AfterSlot x -> AfterSlot
forall x. AfterSlot -> Rep AfterSlot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AfterSlot -> Rep AfterSlot x
from :: forall x. AfterSlot -> Rep AfterSlot x
$cto :: forall x. Rep AfterSlot x -> AfterSlot
to :: forall x. Rep AfterSlot x -> AfterSlot
Generic)
               deriving anyclass Context -> AfterSlot -> IO (Maybe ThunkInfo)
Proxy AfterSlot -> String
(Context -> AfterSlot -> IO (Maybe ThunkInfo))
-> (Context -> AfterSlot -> IO (Maybe ThunkInfo))
-> (Proxy AfterSlot -> String)
-> NoThunks AfterSlot
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> AfterSlot -> IO (Maybe ThunkInfo)
noThunks :: Context -> AfterSlot -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AfterSlot -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> AfterSlot -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy AfterSlot -> String
showTypeOf :: Proxy AfterSlot -> String
NoThunks

isLedgerPeersEnabled :: UseLedgerPeers -> Bool
isLedgerPeersEnabled :: UseLedgerPeers -> Bool
isLedgerPeersEnabled UseLedgerPeers
DontUseLedgerPeers = Bool
False
isLedgerPeersEnabled UseLedgerPeers {}  = Bool
True

-- | The relative stake of a stakepool in relation to the total amount staked.
-- A value in the [0, 1] range.
--
newtype PoolStake = PoolStake { PoolStake -> Rational
unPoolStake :: Rational }
  deriving (PoolStake -> PoolStake -> Bool
(PoolStake -> PoolStake -> Bool)
-> (PoolStake -> PoolStake -> Bool) -> Eq PoolStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PoolStake -> PoolStake -> Bool
== :: PoolStake -> PoolStake -> Bool
$c/= :: PoolStake -> PoolStake -> Bool
/= :: PoolStake -> PoolStake -> Bool
Eq, Eq PoolStake
Eq PoolStake =>
(PoolStake -> PoolStake -> Ordering)
-> (PoolStake -> PoolStake -> Bool)
-> (PoolStake -> PoolStake -> Bool)
-> (PoolStake -> PoolStake -> Bool)
-> (PoolStake -> PoolStake -> Bool)
-> (PoolStake -> PoolStake -> PoolStake)
-> (PoolStake -> PoolStake -> PoolStake)
-> Ord PoolStake
PoolStake -> PoolStake -> Bool
PoolStake -> PoolStake -> Ordering
PoolStake -> PoolStake -> PoolStake
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
$ccompare :: PoolStake -> PoolStake -> Ordering
compare :: PoolStake -> PoolStake -> Ordering
$c< :: PoolStake -> PoolStake -> Bool
< :: PoolStake -> PoolStake -> Bool
$c<= :: PoolStake -> PoolStake -> Bool
<= :: PoolStake -> PoolStake -> Bool
$c> :: PoolStake -> PoolStake -> Bool
> :: PoolStake -> PoolStake -> Bool
$c>= :: PoolStake -> PoolStake -> Bool
>= :: PoolStake -> PoolStake -> Bool
$cmax :: PoolStake -> PoolStake -> PoolStake
max :: PoolStake -> PoolStake -> PoolStake
$cmin :: PoolStake -> PoolStake -> PoolStake
min :: PoolStake -> PoolStake -> PoolStake
Ord, Int -> PoolStake -> ShowS
[PoolStake] -> ShowS
PoolStake -> String
(Int -> PoolStake -> ShowS)
-> (PoolStake -> String)
-> ([PoolStake] -> ShowS)
-> Show PoolStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PoolStake -> ShowS
showsPrec :: Int -> PoolStake -> ShowS
$cshow :: PoolStake -> String
show :: PoolStake -> String
$cshowList :: [PoolStake] -> ShowS
showList :: [PoolStake] -> ShowS
Show)
  deriving newtype (Num PoolStake
Num PoolStake =>
(PoolStake -> PoolStake -> PoolStake)
-> (PoolStake -> PoolStake)
-> (Rational -> PoolStake)
-> Fractional PoolStake
Rational -> PoolStake
PoolStake -> PoolStake
PoolStake -> PoolStake -> PoolStake
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: PoolStake -> PoolStake -> PoolStake
/ :: PoolStake -> PoolStake -> PoolStake
$crecip :: PoolStake -> PoolStake
recip :: PoolStake -> PoolStake
$cfromRational :: Rational -> PoolStake
fromRational :: Rational -> PoolStake
Fractional, Integer -> PoolStake
PoolStake -> PoolStake
PoolStake -> PoolStake -> PoolStake
(PoolStake -> PoolStake -> PoolStake)
-> (PoolStake -> PoolStake -> PoolStake)
-> (PoolStake -> PoolStake -> PoolStake)
-> (PoolStake -> PoolStake)
-> (PoolStake -> PoolStake)
-> (PoolStake -> PoolStake)
-> (Integer -> PoolStake)
-> Num PoolStake
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PoolStake -> PoolStake -> PoolStake
+ :: PoolStake -> PoolStake -> PoolStake
$c- :: PoolStake -> PoolStake -> PoolStake
- :: PoolStake -> PoolStake -> PoolStake
$c* :: PoolStake -> PoolStake -> PoolStake
* :: PoolStake -> PoolStake -> PoolStake
$cnegate :: PoolStake -> PoolStake
negate :: PoolStake -> PoolStake
$cabs :: PoolStake -> PoolStake
abs :: PoolStake -> PoolStake
$csignum :: PoolStake -> PoolStake
signum :: PoolStake -> PoolStake
$cfromInteger :: Integer -> PoolStake
fromInteger :: Integer -> PoolStake
Num, PoolStake -> ()
(PoolStake -> ()) -> NFData PoolStake
forall a. (a -> ()) -> NFData a
$crnf :: PoolStake -> ()
rnf :: PoolStake -> ()
NFData)

newtype PoolStakeCoded = PoolStakeCoded PoolStake
  deriving (Typeable PoolStakeCoded
Typeable PoolStakeCoded =>
(PoolStakeCoded -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy PoolStakeCoded -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PoolStakeCoded] -> Size)
-> ToCBOR PoolStakeCoded
PoolStakeCoded -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolStakeCoded] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PoolStakeCoded -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: PoolStakeCoded -> Encoding
toCBOR :: PoolStakeCoded -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PoolStakeCoded -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PoolStakeCoded -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolStakeCoded] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolStakeCoded] -> Size
ToCBOR, Typeable PoolStakeCoded
Typeable PoolStakeCoded =>
(forall s. Decoder s PoolStakeCoded)
-> (Proxy PoolStakeCoded -> Text) -> FromCBOR PoolStakeCoded
Proxy PoolStakeCoded -> Text
forall s. Decoder s PoolStakeCoded
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s PoolStakeCoded
fromCBOR :: forall s. Decoder s PoolStakeCoded
$clabel :: Proxy PoolStakeCoded -> Text
label :: Proxy PoolStakeCoded -> Text
FromCBOR, Maybe PoolStakeCoded
Value -> Parser [PoolStakeCoded]
Value -> Parser PoolStakeCoded
(Value -> Parser PoolStakeCoded)
-> (Value -> Parser [PoolStakeCoded])
-> Maybe PoolStakeCoded
-> FromJSON PoolStakeCoded
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PoolStakeCoded
parseJSON :: Value -> Parser PoolStakeCoded
$cparseJSONList :: Value -> Parser [PoolStakeCoded]
parseJSONList :: Value -> Parser [PoolStakeCoded]
$comittedField :: Maybe PoolStakeCoded
omittedField :: Maybe PoolStakeCoded
FromJSON, [PoolStakeCoded] -> Value
[PoolStakeCoded] -> Encoding
PoolStakeCoded -> Bool
PoolStakeCoded -> Value
PoolStakeCoded -> Encoding
(PoolStakeCoded -> Value)
-> (PoolStakeCoded -> Encoding)
-> ([PoolStakeCoded] -> Value)
-> ([PoolStakeCoded] -> Encoding)
-> (PoolStakeCoded -> Bool)
-> ToJSON PoolStakeCoded
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PoolStakeCoded -> Value
toJSON :: PoolStakeCoded -> Value
$ctoEncoding :: PoolStakeCoded -> Encoding
toEncoding :: PoolStakeCoded -> Encoding
$ctoJSONList :: [PoolStakeCoded] -> Value
toJSONList :: [PoolStakeCoded] -> Value
$ctoEncodingList :: [PoolStakeCoded] -> Encoding
toEncodingList :: [PoolStakeCoded] -> Encoding
$comitField :: PoolStakeCoded -> Bool
omitField :: PoolStakeCoded -> Bool
ToJSON) via Rational

-- | The accumulated relative stake of a stake pool, like PoolStake but it also includes the
-- relative stake of all preceding pools. A value in the range [0, 1].
--
newtype AccPoolStake = AccPoolStake { AccPoolStake -> Rational
unAccPoolStake :: Rational }
    deriving (AccPoolStake -> AccPoolStake -> Bool
(AccPoolStake -> AccPoolStake -> Bool)
-> (AccPoolStake -> AccPoolStake -> Bool) -> Eq AccPoolStake
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccPoolStake -> AccPoolStake -> Bool
== :: AccPoolStake -> AccPoolStake -> Bool
$c/= :: AccPoolStake -> AccPoolStake -> Bool
/= :: AccPoolStake -> AccPoolStake -> Bool
Eq, Eq AccPoolStake
Eq AccPoolStake =>
(AccPoolStake -> AccPoolStake -> Ordering)
-> (AccPoolStake -> AccPoolStake -> Bool)
-> (AccPoolStake -> AccPoolStake -> Bool)
-> (AccPoolStake -> AccPoolStake -> Bool)
-> (AccPoolStake -> AccPoolStake -> Bool)
-> (AccPoolStake -> AccPoolStake -> AccPoolStake)
-> (AccPoolStake -> AccPoolStake -> AccPoolStake)
-> Ord AccPoolStake
AccPoolStake -> AccPoolStake -> Bool
AccPoolStake -> AccPoolStake -> Ordering
AccPoolStake -> AccPoolStake -> AccPoolStake
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
$ccompare :: AccPoolStake -> AccPoolStake -> Ordering
compare :: AccPoolStake -> AccPoolStake -> Ordering
$c< :: AccPoolStake -> AccPoolStake -> Bool
< :: AccPoolStake -> AccPoolStake -> Bool
$c<= :: AccPoolStake -> AccPoolStake -> Bool
<= :: AccPoolStake -> AccPoolStake -> Bool
$c> :: AccPoolStake -> AccPoolStake -> Bool
> :: AccPoolStake -> AccPoolStake -> Bool
$c>= :: AccPoolStake -> AccPoolStake -> Bool
>= :: AccPoolStake -> AccPoolStake -> Bool
$cmax :: AccPoolStake -> AccPoolStake -> AccPoolStake
max :: AccPoolStake -> AccPoolStake -> AccPoolStake
$cmin :: AccPoolStake -> AccPoolStake -> AccPoolStake
min :: AccPoolStake -> AccPoolStake -> AccPoolStake
Ord, Int -> AccPoolStake -> ShowS
[AccPoolStake] -> ShowS
AccPoolStake -> String
(Int -> AccPoolStake -> ShowS)
-> (AccPoolStake -> String)
-> ([AccPoolStake] -> ShowS)
-> Show AccPoolStake
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccPoolStake -> ShowS
showsPrec :: Int -> AccPoolStake -> ShowS
$cshow :: AccPoolStake -> String
show :: AccPoolStake -> String
$cshowList :: [AccPoolStake] -> ShowS
showList :: [AccPoolStake] -> ShowS
Show)
    deriving newtype (Num AccPoolStake
Num AccPoolStake =>
(AccPoolStake -> AccPoolStake -> AccPoolStake)
-> (AccPoolStake -> AccPoolStake)
-> (Rational -> AccPoolStake)
-> Fractional AccPoolStake
Rational -> AccPoolStake
AccPoolStake -> AccPoolStake
AccPoolStake -> AccPoolStake -> AccPoolStake
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: AccPoolStake -> AccPoolStake -> AccPoolStake
/ :: AccPoolStake -> AccPoolStake -> AccPoolStake
$crecip :: AccPoolStake -> AccPoolStake
recip :: AccPoolStake -> AccPoolStake
$cfromRational :: Rational -> AccPoolStake
fromRational :: Rational -> AccPoolStake
Fractional, Integer -> AccPoolStake
AccPoolStake -> AccPoolStake
AccPoolStake -> AccPoolStake -> AccPoolStake
(AccPoolStake -> AccPoolStake -> AccPoolStake)
-> (AccPoolStake -> AccPoolStake -> AccPoolStake)
-> (AccPoolStake -> AccPoolStake -> AccPoolStake)
-> (AccPoolStake -> AccPoolStake)
-> (AccPoolStake -> AccPoolStake)
-> (AccPoolStake -> AccPoolStake)
-> (Integer -> AccPoolStake)
-> Num AccPoolStake
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: AccPoolStake -> AccPoolStake -> AccPoolStake
+ :: AccPoolStake -> AccPoolStake -> AccPoolStake
$c- :: AccPoolStake -> AccPoolStake -> AccPoolStake
- :: AccPoolStake -> AccPoolStake -> AccPoolStake
$c* :: AccPoolStake -> AccPoolStake -> AccPoolStake
* :: AccPoolStake -> AccPoolStake -> AccPoolStake
$cnegate :: AccPoolStake -> AccPoolStake
negate :: AccPoolStake -> AccPoolStake
$cabs :: AccPoolStake -> AccPoolStake
abs :: AccPoolStake -> AccPoolStake
$csignum :: AccPoolStake -> AccPoolStake
signum :: AccPoolStake -> AccPoolStake
$cfromInteger :: Integer -> AccPoolStake
fromInteger :: Integer -> AccPoolStake
Num)

newtype AccPoolStakeCoded = AccPoolStakeCoded AccPoolStake
  deriving (Typeable AccPoolStakeCoded
Typeable AccPoolStakeCoded =>
(AccPoolStakeCoded -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy AccPoolStakeCoded -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [AccPoolStakeCoded] -> Size)
-> ToCBOR AccPoolStakeCoded
AccPoolStakeCoded -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AccPoolStakeCoded] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy AccPoolStakeCoded -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: AccPoolStakeCoded -> Encoding
toCBOR :: AccPoolStakeCoded -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy AccPoolStakeCoded -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy AccPoolStakeCoded -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AccPoolStakeCoded] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AccPoolStakeCoded] -> Size
ToCBOR, Typeable AccPoolStakeCoded
Typeable AccPoolStakeCoded =>
(forall s. Decoder s AccPoolStakeCoded)
-> (Proxy AccPoolStakeCoded -> Text) -> FromCBOR AccPoolStakeCoded
Proxy AccPoolStakeCoded -> Text
forall s. Decoder s AccPoolStakeCoded
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s AccPoolStakeCoded
fromCBOR :: forall s. Decoder s AccPoolStakeCoded
$clabel :: Proxy AccPoolStakeCoded -> Text
label :: Proxy AccPoolStakeCoded -> Text
FromCBOR, Maybe AccPoolStakeCoded
Value -> Parser [AccPoolStakeCoded]
Value -> Parser AccPoolStakeCoded
(Value -> Parser AccPoolStakeCoded)
-> (Value -> Parser [AccPoolStakeCoded])
-> Maybe AccPoolStakeCoded
-> FromJSON AccPoolStakeCoded
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AccPoolStakeCoded
parseJSON :: Value -> Parser AccPoolStakeCoded
$cparseJSONList :: Value -> Parser [AccPoolStakeCoded]
parseJSONList :: Value -> Parser [AccPoolStakeCoded]
$comittedField :: Maybe AccPoolStakeCoded
omittedField :: Maybe AccPoolStakeCoded
FromJSON, [AccPoolStakeCoded] -> Value
[AccPoolStakeCoded] -> Encoding
AccPoolStakeCoded -> Bool
AccPoolStakeCoded -> Value
AccPoolStakeCoded -> Encoding
(AccPoolStakeCoded -> Value)
-> (AccPoolStakeCoded -> Encoding)
-> ([AccPoolStakeCoded] -> Value)
-> ([AccPoolStakeCoded] -> Encoding)
-> (AccPoolStakeCoded -> Bool)
-> ToJSON AccPoolStakeCoded
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AccPoolStakeCoded -> Value
toJSON :: AccPoolStakeCoded -> Value
$ctoEncoding :: AccPoolStakeCoded -> Encoding
toEncoding :: AccPoolStakeCoded -> Encoding
$ctoJSONList :: [AccPoolStakeCoded] -> Value
toJSONList :: [AccPoolStakeCoded] -> Value
$ctoEncodingList :: [AccPoolStakeCoded] -> Encoding
toEncodingList :: [AccPoolStakeCoded] -> Encoding
$comitField :: AccPoolStakeCoded -> Bool
omitField :: AccPoolStakeCoded -> Bool
ToJSON) via Rational

-- | A boolean like type.  Big ledger peers are the largest SPOs which control
-- 90% of staked stake.
--
-- Note that 'IsBigLedgerPeer' indicates a role that peer plays in the eclipse
-- evasion, e.g. that a peer was explicitly selected as a big ledger peer, e.g.
-- 'IsNotBigLedgerPeer' does not necessarily mean that the peer isn't a big
-- ledger peer.  This is because we select root peers from all ledger peers
-- (including big ones).
--
data IsBigLedgerPeer
   = IsBigLedgerPeer
   | IsNotBigLedgerPeer
  deriving IsBigLedgerPeer -> IsBigLedgerPeer -> Bool
(IsBigLedgerPeer -> IsBigLedgerPeer -> Bool)
-> (IsBigLedgerPeer -> IsBigLedgerPeer -> Bool)
-> Eq IsBigLedgerPeer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsBigLedgerPeer -> IsBigLedgerPeer -> Bool
== :: IsBigLedgerPeer -> IsBigLedgerPeer -> Bool
$c/= :: IsBigLedgerPeer -> IsBigLedgerPeer -> Bool
/= :: IsBigLedgerPeer -> IsBigLedgerPeer -> Bool
Eq

-- | Wether the node is caught up or fell too far behind the chain
data LedgerStateJudgement = YoungEnough | TooOld
  deriving (LedgerStateJudgement -> LedgerStateJudgement -> Bool
(LedgerStateJudgement -> LedgerStateJudgement -> Bool)
-> (LedgerStateJudgement -> LedgerStateJudgement -> Bool)
-> Eq LedgerStateJudgement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerStateJudgement -> LedgerStateJudgement -> Bool
== :: LedgerStateJudgement -> LedgerStateJudgement -> Bool
$c/= :: LedgerStateJudgement -> LedgerStateJudgement -> Bool
/= :: LedgerStateJudgement -> LedgerStateJudgement -> Bool
Eq, Int -> LedgerStateJudgement -> ShowS
[LedgerStateJudgement] -> ShowS
LedgerStateJudgement -> String
(Int -> LedgerStateJudgement -> ShowS)
-> (LedgerStateJudgement -> String)
-> ([LedgerStateJudgement] -> ShowS)
-> Show LedgerStateJudgement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerStateJudgement -> ShowS
showsPrec :: Int -> LedgerStateJudgement -> ShowS
$cshow :: LedgerStateJudgement -> String
show :: LedgerStateJudgement -> String
$cshowList :: [LedgerStateJudgement] -> ShowS
showList :: [LedgerStateJudgement] -> ShowS
Show, (forall x. LedgerStateJudgement -> Rep LedgerStateJudgement x)
-> (forall x. Rep LedgerStateJudgement x -> LedgerStateJudgement)
-> Generic LedgerStateJudgement
forall x. Rep LedgerStateJudgement x -> LedgerStateJudgement
forall x. LedgerStateJudgement -> Rep LedgerStateJudgement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LedgerStateJudgement -> Rep LedgerStateJudgement x
from :: forall x. LedgerStateJudgement -> Rep LedgerStateJudgement x
$cto :: forall x. Rep LedgerStateJudgement x -> LedgerStateJudgement
to :: forall x. Rep LedgerStateJudgement x -> LedgerStateJudgement
Generic, Context -> LedgerStateJudgement -> IO (Maybe ThunkInfo)
Proxy LedgerStateJudgement -> String
(Context -> LedgerStateJudgement -> IO (Maybe ThunkInfo))
-> (Context -> LedgerStateJudgement -> IO (Maybe ThunkInfo))
-> (Proxy LedgerStateJudgement -> String)
-> NoThunks LedgerStateJudgement
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LedgerStateJudgement -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerStateJudgement -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LedgerStateJudgement -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerStateJudgement -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LedgerStateJudgement -> String
showTypeOf :: Proxy LedgerStateJudgement -> String
NoThunks)

-- | Return ledger state information and ledger peers.
--
data LedgerPeersConsensusInterface m = LedgerPeersConsensusInterface {
    forall (m :: * -> *).
LedgerPeersConsensusInterface m -> STM m (WithOrigin SlotNo)
lpGetLatestSlot           :: STM m (WithOrigin SlotNo),
    forall (m :: * -> *).
LedgerPeersConsensusInterface m -> STM m LedgerStateJudgement
lpGetLedgerStateJudgement :: STM m LedgerStateJudgement,
    forall (m :: * -> *).
LedgerPeersConsensusInterface m
-> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
lpGetLedgerPeers          :: STM m [(PoolStake, NonEmpty RelayAccessPoint)]
  }

instance ToJSON RelayAccessPointCoded where
  toJSON :: RelayAccessPointCoded -> Value
toJSON (RelayAccessPointCoded (RelayAccessDomain Domain
domain PortNumber
port)) =
    [Pair] -> Value
object
      [ Key
"domain" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Domain -> Text
decodeUtf8 Domain
domain
      , Key
"port"   Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port :: Int)]

  toJSON (RelayAccessPointCoded (RelayAccessAddress IP
ip PortNumber
port)) =
    [Pair] -> Value
object
      [ Key
"address" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IP -> String
forall a. Show a => a -> String
show IP
ip
      , Key
"port" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port :: Int)]

instance FromJSON RelayAccessPointCoded where
  parseJSON :: Value -> Parser RelayAccessPointCoded
parseJSON = String
-> (Object -> Parser RelayAccessPointCoded)
-> Value
-> Parser RelayAccessPointCoded
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RelayAccessPointCoded" ((Object -> Parser RelayAccessPointCoded)
 -> Value -> Parser RelayAccessPointCoded)
-> (Object -> Parser RelayAccessPointCoded)
-> Value
-> Parser RelayAccessPointCoded
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    domain <- (String -> Domain) -> Maybe String -> Maybe Domain
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Domain
BS.pack (Maybe String -> Maybe Domain)
-> Parser (Maybe String) -> Parser (Maybe Domain)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"domain"
    port <- fromIntegral @Int <$> v .: "port"
    case domain of
      Maybe Domain
Nothing ->
            Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
        Parser String
-> (String -> Parser RelayAccessPointCoded)
-> Parser RelayAccessPointCoded
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               Maybe IP
Nothing -> String -> Parser RelayAccessPointCoded
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"RelayAccessPointCoded: invalid IP address"
               Just IP
addr ->
                 RelayAccessPointCoded -> Parser RelayAccessPointCoded
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelayAccessPointCoded -> Parser RelayAccessPointCoded)
-> (RelayAccessPoint -> RelayAccessPointCoded)
-> RelayAccessPoint
-> Parser RelayAccessPointCoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelayAccessPoint -> RelayAccessPointCoded
RelayAccessPointCoded (RelayAccessPoint -> Parser RelayAccessPointCoded)
-> RelayAccessPoint -> Parser RelayAccessPointCoded
forall a b. (a -> b) -> a -> b
$ IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
addr PortNumber
port
            (Maybe IP -> Parser RelayAccessPointCoded)
-> (String -> Maybe IP) -> String -> Parser RelayAccessPointCoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe

      Just Domain
domain'
        | Just (Domain
_, Char
'.') <- Domain -> Maybe (Domain, Char)
BS.unsnoc Domain
domain' ->
          RelayAccessPointCoded -> Parser RelayAccessPointCoded
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelayAccessPointCoded -> Parser RelayAccessPointCoded)
-> (RelayAccessPoint -> RelayAccessPointCoded)
-> RelayAccessPoint
-> Parser RelayAccessPointCoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelayAccessPoint -> RelayAccessPointCoded
RelayAccessPointCoded (RelayAccessPoint -> Parser RelayAccessPointCoded)
-> RelayAccessPoint -> Parser RelayAccessPointCoded
forall a b. (a -> b) -> a -> b
$ Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
domain' PortNumber
port
        | Bool
otherwise ->
          let fullyQualified :: Domain
fullyQualified = Domain
domain' Domain -> Char -> Domain
`BS.snoc` Char
'.'
          in RelayAccessPointCoded -> Parser RelayAccessPointCoded
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelayAccessPointCoded -> Parser RelayAccessPointCoded)
-> (RelayAccessPoint -> RelayAccessPointCoded)
-> RelayAccessPoint
-> Parser RelayAccessPointCoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelayAccessPoint -> RelayAccessPointCoded
RelayAccessPointCoded (RelayAccessPoint -> Parser RelayAccessPointCoded)
-> RelayAccessPoint -> Parser RelayAccessPointCoded
forall a b. (a -> b) -> a -> b
$ Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
fullyQualified PortNumber
port