{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE StandaloneKindSignatures   #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeData                   #-}
{-# LANGUAGE TypeFamilies               #-}

-- | Various types related to ledger peers.  This module is re-exported from
-- "Ouroboros.Network.PeerSelection.LedgerPeers".
--
module Ouroboros.Network.PeerSelection.LedgerPeers.Type
  ( PoolStake (..)
  , AccPoolStake (..)
  , IsLedgerPeer (..)
  , IsBigLedgerPeer (..)
  , LedgerPeersConsensusInterface (..)
  , getRelayAccessPointsFromLedger
  , mapExtraAPI
  , UseLedgerPeers (..)
  , AfterSlot (..)
  , LedgerPeersKind (..)
  , SingLedgerPeersKind (..)
  , SomeLedgerPeersKind (..)
  , LedgerPeerSnapshot (..)
  , ledgerPeerSnapshotKind
  , SomeLedgerPeerSnapshot (..)
  , someLedgerPeerSnapshotKind
  , RawBlockHash (..)
  , LedgerPeerSnapshotSRVSupport (..)
  , encodeLedgerPeerSnapshot
  , decodeLedgerPeerSnapshot
  , encodeWithOrigin
  , decodeWithOrigin
  , encodeLedgerPeerSnapshotPoint
  , decodeLedgerPeerSnapshotPoint
  , encodeBigStakePools
  , decodeBigStakePools
  , encodeAllStakePools
  , decodeAllStakePools
  , getRelayAccessPointsFromBigLedgerPeersSnapshot
  , getRelayAccessPointsFromAllLedgerPeersSnapshot
  , isLedgerPeersEnabled
    -- * Re-exports
  , SRVPrefix
  , RelayAccessPoint (..)
  , LedgerRelayAccessPoint (..)
  , prefixLedgerRelayAccessPoint
  ) where


import Control.Applicative ((<|>))
import Control.Concurrent.Class.MonadSTM
import Control.DeepSeq (NFData (..))
import Control.Monad (forM)
import Data.Aeson hiding (decode, encode)
import Data.Bifunctor (second)
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Short (ShortByteString)
import Data.ByteString.Short qualified as SBS
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text.Encoding qualified as Text
import GHC.Generics (Generic)
import NoThunks.Class

-- TODO: remove `FromCBOR` and `ToCBOR` instances when ntc V22 is no longer supported
import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Binary qualified as Codec
import Ouroboros.Network.Block
import Ouroboros.Network.Magic
import Ouroboros.Network.PeerSelection.RelayAccessPoint
import Ouroboros.Network.Point


-- | Used by functions to indicate what kind of ledger peer to process
--
type data LedgerPeersKind = AllLedgerPeers | BigLedgerPeers

-- | Singletons for `LedgerPeersKinds`.
--
type SingLedgerPeersKind :: LedgerPeersKind -> Type
data SingLedgerPeersKind k where
  SingAllLedgerPeers :: SingLedgerPeersKind AllLedgerPeers
  SingBigLedgerPeers :: SingLedgerPeersKind BigLedgerPeers

deriving instance Show (SingLedgerPeersKind k)
deriving instance Eq   (SingLedgerPeersKind k)

-- | Existentially quantified `SingLedgerPeersKinds`.
--
data SomeLedgerPeersKind where
  SomeLedgerPeersKind :: forall (k :: LedgerPeersKind).
                         SingLedgerPeersKind k
                      -> SomeLedgerPeersKind

deriving instance Show SomeLedgerPeersKind


-- | A snapshot of ledger peers extracted from the ledger state at some point
--
data LedgerPeerSnapshot (a :: LedgerPeersKind) where
  LedgerPeerSnapshotV2
    :: (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
    -> LedgerPeerSnapshot BigLedgerPeers
  LedgerBigPeerSnapshotV23
    :: !(Point RawBlockHash)
    -> !NetworkMagic
    -> ![(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
    -> LedgerPeerSnapshot BigLedgerPeers
  LedgerAllPeerSnapshotV23
    :: !(Point RawBlockHash)
    -> !NetworkMagic
    -> ![(PoolStake, NonEmpty LedgerRelayAccessPoint)]
    -> LedgerPeerSnapshot AllLedgerPeers

deriving instance Eq (LedgerPeerSnapshot a)
deriving instance Show (LedgerPeerSnapshot a)

ledgerPeerSnapshotKind :: LedgerPeerSnapshot a -> SingLedgerPeersKind a
ledgerPeerSnapshotKind :: forall (a :: LedgerPeersKind).
LedgerPeerSnapshot a -> SingLedgerPeersKind a
ledgerPeerSnapshotKind LedgerPeerSnapshotV2 {}     = SingLedgerPeersKind a
SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers
ledgerPeerSnapshotKind LedgerBigPeerSnapshotV23 {} = SingLedgerPeersKind a
SingLedgerPeersKind BigLedgerPeers
SingBigLedgerPeers
ledgerPeerSnapshotKind LedgerAllPeerSnapshotV23 {} = SingLedgerPeersKind a
SingLedgerPeersKind AllLedgerPeers
SingAllLedgerPeers

-- | The raw block hash to be passed into the Consensus layer and
--   reified into a 'HeaderHash blk' using the 'ConvertRawHash'
--   type class from the 'Ouroboros.Consensus.Block.Abstract' module.
--
newtype RawBlockHash = RawBlockHash ShortByteString
  deriving newtype (RawBlockHash -> ()
(RawBlockHash -> ()) -> NFData RawBlockHash
forall a. (a -> ()) -> NFData a
$crnf :: RawBlockHash -> ()
rnf :: RawBlockHash -> ()
NFData, RawBlockHash -> RawBlockHash -> Bool
(RawBlockHash -> RawBlockHash -> Bool)
-> (RawBlockHash -> RawBlockHash -> Bool) -> Eq RawBlockHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawBlockHash -> RawBlockHash -> Bool
== :: RawBlockHash -> RawBlockHash -> Bool
$c/= :: RawBlockHash -> RawBlockHash -> Bool
/= :: RawBlockHash -> RawBlockHash -> Bool
Eq, Eq RawBlockHash
Eq RawBlockHash =>
(RawBlockHash -> RawBlockHash -> Ordering)
-> (RawBlockHash -> RawBlockHash -> Bool)
-> (RawBlockHash -> RawBlockHash -> Bool)
-> (RawBlockHash -> RawBlockHash -> Bool)
-> (RawBlockHash -> RawBlockHash -> Bool)
-> (RawBlockHash -> RawBlockHash -> RawBlockHash)
-> (RawBlockHash -> RawBlockHash -> RawBlockHash)
-> Ord RawBlockHash
RawBlockHash -> RawBlockHash -> Bool
RawBlockHash -> RawBlockHash -> Ordering
RawBlockHash -> RawBlockHash -> RawBlockHash
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 :: RawBlockHash -> RawBlockHash -> Ordering
compare :: RawBlockHash -> RawBlockHash -> Ordering
$c< :: RawBlockHash -> RawBlockHash -> Bool
< :: RawBlockHash -> RawBlockHash -> Bool
$c<= :: RawBlockHash -> RawBlockHash -> Bool
<= :: RawBlockHash -> RawBlockHash -> Bool
$c> :: RawBlockHash -> RawBlockHash -> Bool
> :: RawBlockHash -> RawBlockHash -> Bool
$c>= :: RawBlockHash -> RawBlockHash -> Bool
>= :: RawBlockHash -> RawBlockHash -> Bool
$cmax :: RawBlockHash -> RawBlockHash -> RawBlockHash
max :: RawBlockHash -> RawBlockHash -> RawBlockHash
$cmin :: RawBlockHash -> RawBlockHash -> RawBlockHash
min :: RawBlockHash -> RawBlockHash -> RawBlockHash
Ord, Int -> RawBlockHash -> ShowS
[RawBlockHash] -> ShowS
RawBlockHash -> String
(Int -> RawBlockHash -> ShowS)
-> (RawBlockHash -> String)
-> ([RawBlockHash] -> ShowS)
-> Show RawBlockHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawBlockHash -> ShowS
showsPrec :: Int -> RawBlockHash -> ShowS
$cshow :: RawBlockHash -> String
show :: RawBlockHash -> String
$cshowList :: [RawBlockHash] -> ShowS
showList :: [RawBlockHash] -> ShowS
Show, Context -> RawBlockHash -> IO (Maybe ThunkInfo)
Proxy RawBlockHash -> String
(Context -> RawBlockHash -> IO (Maybe ThunkInfo))
-> (Context -> RawBlockHash -> IO (Maybe ThunkInfo))
-> (Proxy RawBlockHash -> String)
-> NoThunks RawBlockHash
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> RawBlockHash -> IO (Maybe ThunkInfo)
noThunks :: Context -> RawBlockHash -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RawBlockHash -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RawBlockHash -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy RawBlockHash -> String
showTypeOf :: Proxy RawBlockHash -> String
NoThunks, Typeable RawBlockHash
Typeable RawBlockHash =>
(forall s. Decoder s RawBlockHash)
-> (Proxy RawBlockHash -> Text) -> FromCBOR RawBlockHash
Proxy RawBlockHash -> Text
forall s. Decoder s RawBlockHash
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s RawBlockHash
fromCBOR :: forall s. Decoder s RawBlockHash
$clabel :: Proxy RawBlockHash -> Text
label :: Proxy RawBlockHash -> Text
FromCBOR)

instance ToJSON RawBlockHash where
  toJSON :: RawBlockHash -> Value
toJSON (RawBlockHash ShortByteString
sbs) =
    Text -> Value
String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
SBS.fromShort ShortByteString
sbs

instance FromJSON RawBlockHash where
  parseJSON :: Value -> Parser RawBlockHash
parseJSON = String
-> (Text -> Parser RawBlockHash) -> Value -> Parser RawBlockHash
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RawBlockHash" ((Text -> Parser RawBlockHash) -> Value -> Parser RawBlockHash)
-> (Text -> Parser RawBlockHash) -> Value -> Parser RawBlockHash
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
Text.encodeUtf8 Text
t) of
      Right ByteString
bs -> RawBlockHash -> Parser RawBlockHash
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawBlockHash -> Parser RawBlockHash)
-> RawBlockHash -> Parser RawBlockHash
forall a b. (a -> b) -> a -> b
$ ShortByteString -> RawBlockHash
RawBlockHash (ByteString -> ShortByteString
SBS.toShort ByteString
bs)
      Left String
err -> String -> Parser RawBlockHash
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser RawBlockHash) -> String -> Parser RawBlockHash
forall a b. (a -> b) -> a -> b
$ String
"Invalid hex string for RawBlockHash: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err

--- we need these since `Point` is parameterised with `RawBlockHash`
--- in the snapshot
type instance HeaderHash RawBlockHash = RawBlockHash
instance StandardHash RawBlockHash

-- | facility for encoding the snapshot in CBOR for backwards compatibility
--
data SomeLedgerPeerSnapshot = forall k. SomeLedgerPeerSnapshot !(LedgerPeerSnapshot k)

instance Eq SomeLedgerPeerSnapshot where
  (SomeLedgerPeerSnapshot LedgerPeerSnapshot k
u) == :: SomeLedgerPeerSnapshot -> SomeLedgerPeerSnapshot -> Bool
== (SomeLedgerPeerSnapshot LedgerPeerSnapshot k
v) =
    case (LedgerPeerSnapshot k
u, LedgerPeerSnapshot k
v) of
      (LedgerPeerSnapshotV2 {}, LedgerPeerSnapshotV2 {})         -> LedgerPeerSnapshot k
u LedgerPeerSnapshot k -> LedgerPeerSnapshot k -> Bool
forall a. Eq a => a -> a -> Bool
== LedgerPeerSnapshot k
LedgerPeerSnapshot k
v
      (LedgerAllPeerSnapshotV23 {}, LedgerAllPeerSnapshotV23 {}) -> LedgerPeerSnapshot k
u LedgerPeerSnapshot k -> LedgerPeerSnapshot k -> Bool
forall a. Eq a => a -> a -> Bool
== LedgerPeerSnapshot k
LedgerPeerSnapshot k
v
      (LedgerBigPeerSnapshotV23 {}, LedgerBigPeerSnapshotV23 {}) -> LedgerPeerSnapshot k
u LedgerPeerSnapshot k -> LedgerPeerSnapshot k -> Bool
forall a. Eq a => a -> a -> Bool
== LedgerPeerSnapshot k
LedgerPeerSnapshot k
v
      (LedgerPeerSnapshot k, LedgerPeerSnapshot k)
_otherwise                                                 -> Bool
False

deriving instance Show SomeLedgerPeerSnapshot

someLedgerPeerSnapshotKind :: SomeLedgerPeerSnapshot -> SomeLedgerPeersKind
someLedgerPeerSnapshotKind :: SomeLedgerPeerSnapshot -> SomeLedgerPeersKind
someLedgerPeerSnapshotKind (SomeLedgerPeerSnapshot LedgerPeerSnapshot k
a) = SingLedgerPeersKind k -> SomeLedgerPeersKind
forall (k :: LedgerPeersKind).
SingLedgerPeersKind k -> SomeLedgerPeersKind
SomeLedgerPeersKind (LedgerPeerSnapshot k -> SingLedgerPeersKind k
forall (a :: LedgerPeersKind).
LedgerPeerSnapshot a -> SingLedgerPeersKind a
ledgerPeerSnapshotKind LedgerPeerSnapshot k
a)

getRelayAccessPointsFromBigLedgerPeersSnapshot
  :: SRVPrefix
  -> LedgerPeerSnapshot BigLedgerPeers
  -> (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
getRelayAccessPointsFromBigLedgerPeersSnapshot :: ByteString
-> LedgerPeerSnapshot BigLedgerPeers
-> (WithOrigin SlotNo,
    [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
getRelayAccessPointsFromBigLedgerPeersSnapshot ByteString
srvPrefix = \case
  LedgerPeerSnapshotV2 (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
as ->
    ([(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
 -> [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-> (WithOrigin SlotNo,
    [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> (WithOrigin SlotNo,
    [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
forall a b.
(a -> b) -> (WithOrigin SlotNo, a) -> (WithOrigin SlotNo, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
 -> (AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint)))
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> (PoolStake, NonEmpty RelayAccessPoint))
-> (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
-> (AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))
forall a b. (a -> b) -> (AccPoolStake, a) -> (AccPoolStake, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint)
-> (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> (PoolStake, NonEmpty RelayAccessPoint)
forall a b. (a -> b) -> (PoolStake, a) -> (PoolStake, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LedgerRelayAccessPoint -> RelayAccessPoint)
-> NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint ByteString
srvPrefix))))) (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
as
  LedgerBigPeerSnapshotV23 Point RawBlockHash
pt NetworkMagic
_magic [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
as ->
    let as' :: [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
as' = ((AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
 -> (AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint)))
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> (PoolStake, NonEmpty RelayAccessPoint))
-> (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
-> (AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))
forall a b. (a -> b) -> (AccPoolStake, a) -> (AccPoolStake, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint)
-> (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> (PoolStake, NonEmpty RelayAccessPoint)
forall a b. (a -> b) -> (PoolStake, a) -> (PoolStake, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LedgerRelayAccessPoint -> RelayAccessPoint)
-> NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint ByteString
srvPrefix)))) [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
as
     in  (Point RawBlockHash -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point RawBlockHash
pt, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
as')


getRelayAccessPointsFromAllLedgerPeersSnapshot
  :: SRVPrefix
  -> LedgerPeerSnapshot AllLedgerPeers
  -> (WithOrigin SlotNo, [(PoolStake, NonEmpty RelayAccessPoint)])
getRelayAccessPointsFromAllLedgerPeersSnapshot :: ByteString
-> LedgerPeerSnapshot AllLedgerPeers
-> (WithOrigin SlotNo, [(PoolStake, NonEmpty RelayAccessPoint)])
getRelayAccessPointsFromAllLedgerPeersSnapshot ByteString
srvPrefix = \case
  LedgerAllPeerSnapshotV23 Point RawBlockHash
pt NetworkMagic
_magic [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
as ->
    let as' :: [(PoolStake, NonEmpty RelayAccessPoint)]
as' = ((PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> (PoolStake, NonEmpty RelayAccessPoint))
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> [(PoolStake, NonEmpty RelayAccessPoint)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint)
-> (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> (PoolStake, NonEmpty RelayAccessPoint)
forall a b. (a -> b) -> (PoolStake, a) -> (PoolStake, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LedgerRelayAccessPoint -> RelayAccessPoint)
-> NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint ByteString
srvPrefix))) [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
as
     in  (Point RawBlockHash -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point RawBlockHash
pt, [(PoolStake, NonEmpty RelayAccessPoint)]
as')


instance ToJSON (LedgerPeerSnapshot a) where
  toJSON :: LedgerPeerSnapshot a -> Value
toJSON (LedgerPeerSnapshotV2 (WithOrigin SlotNo
slot, [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
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
2 :: 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 LedgerRelayAccessPoint -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty LedgerRelayAccessPoint
relays
                                   ]
                                 | (AccPoolStake Rational
accStake, (PoolStake Rational
relStake, NonEmpty LedgerRelayAccessPoint
relays)) <- [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools
                                 ]
           ]
  toJSON (LedgerAllPeerSnapshotV23 Point RawBlockHash
pt NetworkMagic
magic [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
pools) =
    [Pair] -> Value
object [ Key
"NodeToClientVersion" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int
23 :: Int)
           , Key
"Point" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Point RawBlockHash -> Value
forall a. ToJSON a => a -> Value
toJSON Point RawBlockHash
pt
           , Key
"NetworkMagic" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkMagic -> Word32
unNetworkMagic NetworkMagic
magic
           , Key
"allLedgerPools" 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
"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 LedgerRelayAccessPoint -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty LedgerRelayAccessPoint
relays
                                   ]
                                 | (PoolStake Rational
relStake, NonEmpty LedgerRelayAccessPoint
relays) <- [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
pools
                                 ]
           ]
  toJSON (LedgerBigPeerSnapshotV23 Point RawBlockHash
pt NetworkMagic
magic [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools) =
    [Pair] -> Value
object [ Key
"NodeToClientVersion" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int
23 :: Int)
           , Key
"Point" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Point RawBlockHash -> Value
forall a. ToJSON a => a -> Value
toJSON Point RawBlockHash
pt
           , Key
"NetworkMagic" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkMagic -> Word32
unNetworkMagic NetworkMagic
magic
           , 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 LedgerRelayAccessPoint -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty LedgerRelayAccessPoint
relays
                                   ]
                                 | (AccPoolStake Rational
accStake, (PoolStake Rational
relStake, NonEmpty LedgerRelayAccessPoint
relays)) <- [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools
                                 ]
           ]

instance FromJSON (LedgerPeerSnapshot AllLedgerPeers) where
  parseJSON :: Value -> Parser (LedgerPeerSnapshot AllLedgerPeers)
parseJSON = String
-> (Object -> Parser (LedgerPeerSnapshot AllLedgerPeers))
-> Value
-> Parser (LedgerPeerSnapshot AllLedgerPeers)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LedgerPeerSnapshot" \Object
v -> do
    -- TODO: remove "version" key after NtC V22 support is removed
    vNum :: Int <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version" Parser Int -> Parser Int -> Parser Int
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"NodeToClientVersion"
    allPools    <- v .: "allLedgerPools"
    case vNum of
      Int
23 -> do
       point     <- Object
v Object -> Key -> Parser (Point RawBlockHash)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Point"
       magic     <- v .: "NetworkMagic"
       allPools' <- forM (zip [0 :: Int ..] allPools) \(Int
idx, Object
poolO) -> do
                      let f :: Object -> Parser (a, b)
f Object
poolV = do
                              reStake  <- Object
poolV Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relativeStake"
                              relays   <- poolV .: "relays"
                              return (reStake, relays)
                      String
-> (Object -> Parser (PoolStake, NonEmpty LedgerRelayAccessPoint))
-> Value
-> Parser (PoolStake, NonEmpty LedgerRelayAccessPoint)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"allLedgerPools[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
idx String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") Object -> Parser (PoolStake, NonEmpty LedgerRelayAccessPoint)
forall {a} {b}. (FromJSON a, FromJSON b) => Object -> Parser (a, b)
f (Object -> Value
Object Object
poolO)

       return $ LedgerAllPeerSnapshotV23 point (NetworkMagic magic) allPools'
      Int
_ ->
        String -> Parser (LedgerPeerSnapshot AllLedgerPeers)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (LedgerPeerSnapshot AllLedgerPeers))
-> String -> Parser (LedgerPeerSnapshot AllLedgerPeers)
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

instance FromJSON (LedgerPeerSnapshot BigLedgerPeers) where
  parseJSON :: Value -> Parser (LedgerPeerSnapshot BigLedgerPeers)
parseJSON = String
-> (Object -> Parser (LedgerPeerSnapshot BigLedgerPeers))
-> Value
-> Parser (LedgerPeerSnapshot BigLedgerPeers)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LedgerPeerSnapshot" \Object
v -> do
    -- TODO: remove "version" key after NtC V22 support is removed
    vNum :: Int <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version" Parser Int -> Parser Int -> Parser Int
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"NodeToClientVersion"
    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 (zip [0 :: Int ..] bigPools) \(Int
idx, Object
poolO) -> do
                       let f :: Object -> Parser (a, (a, f LedgerRelayAccessPoint))
f Object
poolV = do
                               accStake <- Object
poolV Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accumulatedStake"
                               reStake  <- poolV .: "relativeStake"
                               -- decode using `LedgerRelayAccessPointV1` instance
                               relays <- fmap getLedgerRelayAccessPointV1 <$> poolV .: "relays"
                               return (accStake, (reStake, relays))
                       String
-> (Object
    -> Parser
         (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint)))
-> Value
-> Parser
     (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"bigLedgerPools[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
idx String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") Object
-> Parser
     (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
forall {f :: * -> *} {a} {a}.
(Functor f, FromJSON a, FromJSON a,
 FromJSON (f LedgerRelayAccessPointV1)) =>
Object -> Parser (a, (a, f LedgerRelayAccessPoint))
f (Object -> Value
Object Object
poolO)

        return $ LedgerPeerSnapshotV2 (slot, bigPools')
      Int
2 -> do
        slot      <- Object
v Object -> Key -> Parser (WithOrigin SlotNo)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slotNo"
        bigPools  <- v .: "bigLedgerPools"
        bigPools' <- forM (zip [0 :: Int ..] bigPools) \(Int
idx, Object
poolO) -> do
                       let f :: Object -> Parser (a, (a, b))
f Object
poolV = do
                               accStake <- Object
poolV Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accumulatedStake"
                               reStake  <- poolV .: "relativeStake"
                               relays   <- poolV .: "relays"
                               return (accStake, (reStake, relays))
                       String
-> (Object
    -> Parser
         (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint)))
-> Value
-> Parser
     (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"bigLedgerPools[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
idx String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") Object
-> Parser
     (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
forall {a} {a} {b}.
(FromJSON a, FromJSON a, FromJSON b) =>
Object -> Parser (a, (a, b))
f (Object -> Value
Object Object
poolO)

        return $ LedgerPeerSnapshotV2 (slot, bigPools')
      Int
23 -> do
        point     <- Object
v Object -> Key -> Parser (Point RawBlockHash)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Point"
        magic     <- v .: "NetworkMagic"
        bigPools  <- v .: "bigLedgerPools"
        bigPools' <- forM (zip [0 :: Int ..] bigPools) \(Int
idx, Object
poolO) -> do
                       let f :: Object -> Parser (a, (a, b))
f Object
poolV = do
                               accStake <- Object
poolV Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accumulatedStake"
                               reStake  <- poolV .: "relativeStake"
                               relays   <- poolV .: "relays"
                               return (accStake, (reStake, relays))
                       String
-> (Object
    -> Parser
         (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint)))
-> Value
-> Parser
     (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"bigLedgerPools[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
idx String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") Object
-> Parser
     (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
forall {a} {a} {b}.
(FromJSON a, FromJSON a, FromJSON b) =>
Object -> Parser (a, (a, b))
f (Object -> Value
Object Object
poolO)

        return $ LedgerBigPeerSnapshotV23 point (NetworkMagic magic) bigPools'
      Int
_ ->
        String -> Parser (LedgerPeerSnapshot BigLedgerPeers)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (LedgerPeerSnapshot BigLedgerPeers))
-> String -> Parser (LedgerPeerSnapshot BigLedgerPeers)
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


data LedgerPeerSnapshotSRVSupport
  = LedgerPeerSnapshotSupportsSRV
  -- ^ since `NodeToClientV_22`
  | LedgerPeerSnapshotDoesntSupportSRV
  deriving (Int -> LedgerPeerSnapshotSRVSupport -> ShowS
[LedgerPeerSnapshotSRVSupport] -> ShowS
LedgerPeerSnapshotSRVSupport -> String
(Int -> LedgerPeerSnapshotSRVSupport -> ShowS)
-> (LedgerPeerSnapshotSRVSupport -> String)
-> ([LedgerPeerSnapshotSRVSupport] -> ShowS)
-> Show LedgerPeerSnapshotSRVSupport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerPeerSnapshotSRVSupport -> ShowS
showsPrec :: Int -> LedgerPeerSnapshotSRVSupport -> ShowS
$cshow :: LedgerPeerSnapshotSRVSupport -> String
show :: LedgerPeerSnapshotSRVSupport -> String
$cshowList :: [LedgerPeerSnapshotSRVSupport] -> ShowS
showList :: [LedgerPeerSnapshotSRVSupport] -> ShowS
Show, LedgerPeerSnapshotSRVSupport
-> LedgerPeerSnapshotSRVSupport -> Bool
(LedgerPeerSnapshotSRVSupport
 -> LedgerPeerSnapshotSRVSupport -> Bool)
-> (LedgerPeerSnapshotSRVSupport
    -> LedgerPeerSnapshotSRVSupport -> Bool)
-> Eq LedgerPeerSnapshotSRVSupport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerPeerSnapshotSRVSupport
-> LedgerPeerSnapshotSRVSupport -> Bool
== :: LedgerPeerSnapshotSRVSupport
-> LedgerPeerSnapshotSRVSupport -> Bool
$c/= :: LedgerPeerSnapshotSRVSupport
-> LedgerPeerSnapshotSRVSupport -> Bool
/= :: LedgerPeerSnapshotSRVSupport
-> LedgerPeerSnapshotSRVSupport -> Bool
Eq)


encodeLedgerPeerSnapshot :: LedgerPeerSnapshotSRVSupport -> LedgerPeerSnapshot a -> Codec.Encoding
encodeLedgerPeerSnapshot :: forall (a :: LedgerPeersKind).
LedgerPeerSnapshotSRVSupport -> LedgerPeerSnapshot a -> Encoding
encodeLedgerPeerSnapshot LedgerPeerSnapshotSRVSupport
LedgerPeerSnapshotDoesntSupportSRV (LedgerPeerSnapshotV2 (WithOrigin SlotNo
wOrigin, [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools)) =
     Word -> Encoding
Codec.encodeListLen Word
2
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
1 -- internal version
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
Codec.encodeListLen Word
2
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> WithOrigin SlotNo -> Encoding
encodeWithOrigin WithOrigin SlotNo
wOrigin
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools'
  where
    pools' :: [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools' =
      [(AccPoolStake
accPoolStake, (PoolStake
relStake, [LedgerRelayAccessPoint] -> NonEmpty LedgerRelayAccessPoint
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [LedgerRelayAccessPoint]
relays))
      | (AccPoolStake
accPoolStake, (PoolStake
relStake, [LedgerRelayAccessPoint]
relays)) <-
          -- filter out SRV domains, not supported by `< NodeToClientV_22`
          ((AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
 -> (AccPoolStake, (PoolStake, [LedgerRelayAccessPoint])))
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> [(AccPoolStake, (PoolStake, [LedgerRelayAccessPoint]))]
forall a b. (a -> b) -> [a] -> [b]
map
            (((PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> (PoolStake, [LedgerRelayAccessPoint]))
-> (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
-> (AccPoolStake, (PoolStake, [LedgerRelayAccessPoint]))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (((PoolStake, NonEmpty LedgerRelayAccessPoint)
  -> (PoolStake, [LedgerRelayAccessPoint]))
 -> (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
 -> (AccPoolStake, (PoolStake, [LedgerRelayAccessPoint])))
-> ((PoolStake, NonEmpty LedgerRelayAccessPoint)
    -> (PoolStake, [LedgerRelayAccessPoint]))
-> (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
-> (AccPoolStake, (PoolStake, [LedgerRelayAccessPoint]))
forall a b. (a -> b) -> a -> b
$ (NonEmpty LedgerRelayAccessPoint -> [LedgerRelayAccessPoint])
-> (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> (PoolStake, [LedgerRelayAccessPoint])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((NonEmpty LedgerRelayAccessPoint -> [LedgerRelayAccessPoint])
 -> (PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> (PoolStake, [LedgerRelayAccessPoint]))
-> (NonEmpty LedgerRelayAccessPoint -> [LedgerRelayAccessPoint])
-> (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> (PoolStake, [LedgerRelayAccessPoint])
forall a b. (a -> b) -> a -> b
$ (LedgerRelayAccessPoint -> Bool)
-> NonEmpty LedgerRelayAccessPoint -> [LedgerRelayAccessPoint]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NonEmpty.filter
              (\case
                  LedgerRelayAccessSRVDomain {} -> Bool
False
                  LedgerRelayAccessPoint
_ -> Bool
True)
            )
          [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools
      , Bool -> Bool
not ([LedgerRelayAccessPoint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LedgerRelayAccessPoint]
relays)
      ]

encodeLedgerPeerSnapshot LedgerPeerSnapshotSRVSupport
LedgerPeerSnapshotSupportsSRV (LedgerPeerSnapshotV2 (WithOrigin SlotNo
wOrigin, [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools)) =
     Word -> Encoding
Codec.encodeListLen Word
2
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
1 -- internal version
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
Codec.encodeListLen Word
2
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> WithOrigin SlotNo -> Encoding
encodeWithOrigin WithOrigin SlotNo
wOrigin
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools

encodeLedgerPeerSnapshot LedgerPeerSnapshotSRVSupport
_LedgerPeerSnapshotSupportsSRV (LedgerBigPeerSnapshotV23 Point RawBlockHash
pt NetworkMagic
magic [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools) =
     Word -> Encoding
Codec.encodeListLen Word
2
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
2 -- internal version
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
Codec.encodeListLen Word
3
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point RawBlockHash -> Encoding
encodeLedgerPeerSnapshotPoint Point RawBlockHash
pt
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
Codec.encodeWord32 (NetworkMagic -> Word32
unNetworkMagic NetworkMagic
magic)
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> Encoding
encodeBigStakePools [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools

encodeLedgerPeerSnapshot LedgerPeerSnapshotSRVSupport
_LedgerPeerSnapshotSupportsSRV (LedgerAllPeerSnapshotV23 Point RawBlockHash
pt NetworkMagic
magic [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
pools) =
     Word -> Encoding
Codec.encodeListLen Word
2
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
3 -- internal version
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
Codec.encodeListLen Word
3
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point RawBlockHash -> Encoding
encodeLedgerPeerSnapshotPoint Point RawBlockHash
pt
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
Codec.encodeWord32 (NetworkMagic -> Word32
unNetworkMagic NetworkMagic
magic)
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [(PoolStake, NonEmpty LedgerRelayAccessPoint)] -> Encoding
encodeAllStakePools [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
pools


decodeLedgerPeerSnapshot :: forall s (ledgerPeersKind :: LedgerPeersKind).
                            SingLedgerPeersKind ledgerPeersKind
                         -> Codec.Decoder s (LedgerPeerSnapshot ledgerPeersKind)
decodeLedgerPeerSnapshot :: forall s (ledgerPeersKind :: LedgerPeersKind).
SingLedgerPeersKind ledgerPeersKind
-> Decoder s (LedgerPeerSnapshot ledgerPeersKind)
decodeLedgerPeerSnapshot SingLedgerPeersKind ledgerPeersKind
ledgerPeerKind = 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 (ledgerPeerKind, version) of
      (SingLedgerPeersKind ledgerPeersKind
SingBigLedgerPeers, Word8
1) -> do
        _ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
2
        LedgerPeerSnapshotV2 <$> ((,) <$> decodeWithOrigin <*> fromCBOR)
      (SingLedgerPeersKind ledgerPeersKind
SingBigLedgerPeers, Word8
2) -> do
        _ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
3
        (LedgerBigPeerSnapshotV23 <$> decodeLedgerPeerSnapshotPoint
                                  <*> (NetworkMagic <$> Codec.decodeWord32)
                                  <*> decodeBigStakePools)
      (SingLedgerPeersKind ledgerPeersKind
SingAllLedgerPeers, Word8
3) -> do
        _ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
3
        (LedgerAllPeerSnapshotV23 <$> decodeLedgerPeerSnapshotPoint
                                  <*> (NetworkMagic <$> Codec.decodeWord32)
                                  <*> decodeAllStakePools)
      (SingLedgerPeersKind ledgerPeersKind, Word8)
_ -> String -> Decoder s (LedgerPeerSnapshot ledgerPeersKind)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (LedgerPeerSnapshot ledgerPeersKind))
-> String -> Decoder s (LedgerPeerSnapshot ledgerPeersKind)
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


encodeWithOrigin :: WithOrigin SlotNo -> Codec.Encoding
encodeWithOrigin :: WithOrigin SlotNo -> Encoding
encodeWithOrigin 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
encodeWithOrigin (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


decodeWithOrigin :: Codec.Decoder s (WithOrigin SlotNo)
decodeWithOrigin :: forall s. Decoder s (WithOrigin SlotNo)
decodeWithOrigin = do
    listLen <- Decoder s Int
forall s. Decoder s Int
Codec.decodeListLen
    tag     <- Codec.decodeWord8
    case (listLen, tag) of
      (Int
1, Word8
0) -> WithOrigin SlotNo -> Decoder s (WithOrigin SlotNo)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin SlotNo
forall t. WithOrigin t
Origin
      (Int
1, Word8
_) -> String -> Decoder s (WithOrigin SlotNo)
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) -> SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
At (SlotNo -> WithOrigin SlotNo)
-> Decoder s SlotNo -> Decoder s (WithOrigin SlotNo)
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 (WithOrigin SlotNo)
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 (WithOrigin SlotNo)
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"


encodeLedgerPeerSnapshotPoint :: Point RawBlockHash
                              -> Codec.Encoding
encodeLedgerPeerSnapshotPoint :: Point RawBlockHash -> Encoding
encodeLedgerPeerSnapshotPoint = \case
  Point RawBlockHash
GenesisPoint -> Word -> Encoding
Codec.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
Codec.encodeWord8 Word8
0
  BlockPoint { SlotNo
atSlot :: SlotNo
atSlot :: forall {k} (block :: k). Point block -> SlotNo
atSlot, withHash :: forall {k} (block :: k). Point block -> HeaderHash block
withHash = RawBlockHash ShortByteString
hash } ->
       Word -> Encoding
Codec.encodeListLen Word
3 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
Codec.toCBOR SlotNo
atSlot Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShortByteString
hash


decodeLedgerPeerSnapshotPoint :: forall s.
                                 Codec.Decoder s (Point RawBlockHash)
decodeLedgerPeerSnapshotPoint :: forall s. Decoder s (Point RawBlockHash)
decodeLedgerPeerSnapshotPoint = do
  listLen <- Decoder s Int
forall s. Decoder s Int
Codec.decodeListLen
  tag     <- Codec.decodeWord8
  case (tag, listLen) of
    (Word8
0, Int
1) -> Point RawBlockHash -> Decoder s (Point RawBlockHash)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point RawBlockHash -> Decoder s (Point RawBlockHash))
-> Point RawBlockHash -> Decoder s (Point RawBlockHash)
forall a b. (a -> b) -> a -> b
$ WithOrigin (Block SlotNo (HeaderHash RawBlockHash))
-> Point RawBlockHash
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
Point WithOrigin (Block SlotNo (HeaderHash RawBlockHash))
WithOrigin (Block SlotNo RawBlockHash)
forall t. WithOrigin t
Origin
    (Word8
0, Int
n) -> String -> Decoder s (Point RawBlockHash)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Point RawBlockHash))
-> String -> Decoder s (Point RawBlockHash)
forall a b. (a -> b) -> a -> b
$ String
"LedgerPeers.Type: invalid listLen for Origin tag, expected 1 got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
    (Word8
1, Int
3) -> WithOrigin (Block SlotNo (HeaderHash RawBlockHash))
-> Point RawBlockHash
WithOrigin (Block SlotNo RawBlockHash) -> Point RawBlockHash
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
Point (WithOrigin (Block SlotNo RawBlockHash) -> Point RawBlockHash)
-> (Block SlotNo RawBlockHash
    -> WithOrigin (Block SlotNo RawBlockHash))
-> Block SlotNo RawBlockHash
-> Point RawBlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block SlotNo RawBlockHash -> WithOrigin (Block SlotNo RawBlockHash)
forall t. t -> WithOrigin t
At (Block SlotNo RawBlockHash -> Point RawBlockHash)
-> Decoder s (Block SlotNo RawBlockHash)
-> Decoder s (Point RawBlockHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SlotNo -> RawBlockHash -> Block SlotNo RawBlockHash
forall slot hash. slot -> hash -> Block slot hash
Block (SlotNo -> RawBlockHash -> Block SlotNo RawBlockHash)
-> Decoder s SlotNo
-> Decoder s (RawBlockHash -> Block SlotNo RawBlockHash)
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 Decoder s (RawBlockHash -> Block SlotNo RawBlockHash)
-> Decoder s RawBlockHash -> Decoder s (Block SlotNo RawBlockHash)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s RawBlockHash
forall s. Decoder s RawBlockHash
forall a s. FromCBOR a => Decoder s a
fromCBOR)
    (Word8
1, Int
n) -> String -> Decoder s (Point RawBlockHash)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Point RawBlockHash))
-> String -> Decoder s (Point RawBlockHash)
forall a b. (a -> b) -> a -> b
$ String
"LedgerPeers.Type: invalid listLen for At tag, expected 3 got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
    (Word8, Int)
_      -> String -> Decoder s (Point RawBlockHash)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"LedgerPeers.Type: Unrecognized CBOR encoding of Point for LedgerPeerSnapshot"


encodeBigStakePools :: [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
                    -> Codec.Encoding
encodeBigStakePools :: [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> Encoding
encodeBigStakePools [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools =
     Encoding
Codec.encodeListLenIndef
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ((AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
 -> Encoding)
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(AccPoolStake Rational
accPoolStake, (PoolStake Rational
poolStake, NonEmpty LedgerRelayAccessPoint
relays)) ->
                  Word -> Encoding
Codec.encodeListLen Word
3
               Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
accPoolStake
               Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
poolStake
               Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonEmpty LedgerRelayAccessPoint -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NonEmpty LedgerRelayAccessPoint
relays
             )
             [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
Codec.encodeBreak


decodeBigStakePools :: Codec.Decoder s [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
decodeBigStakePools :: forall s.
Decoder
  s [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
decodeBigStakePools = do
  Decoder s ()
forall s. Decoder s ()
Codec.decodeListLenIndef
  ([(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
 -> (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
 -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> ([(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
    -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> Decoder
     s (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
-> Decoder
     s [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
Codec.decodeSequenceLenIndef
         (((AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
 -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
 -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> (AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
forall a. [a] -> [a]
reverse
         do
           Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
3
           accPoolStake <- Rational -> AccPoolStake
AccPoolStake (Rational -> AccPoolStake)
-> Decoder s Rational -> Decoder s AccPoolStake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall s. Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR
           poolStake    <- PoolStake <$> fromCBOR
           relays       <- fromCBOR
           return (accPoolStake, (poolStake, relays))


encodeAllStakePools :: [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
                    -> Codec.Encoding
encodeAllStakePools :: [(PoolStake, NonEmpty LedgerRelayAccessPoint)] -> Encoding
encodeAllStakePools [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
pools =
     Encoding
Codec.encodeListLenIndef
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ((PoolStake, NonEmpty LedgerRelayAccessPoint) -> Encoding)
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(PoolStake Rational
poolStake, NonEmpty LedgerRelayAccessPoint
relays) ->
                  Word -> Encoding
Codec.encodeListLen Word
2
               Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Rational -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Rational
poolStake
               Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonEmpty LedgerRelayAccessPoint -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NonEmpty LedgerRelayAccessPoint
relays
             )
             [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
pools
  Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
Codec.encodeBreak


decodeAllStakePools :: Codec.Decoder s [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
decodeAllStakePools :: forall s. Decoder s [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
decodeAllStakePools = do
  Decoder s ()
forall s. Decoder s ()
Codec.decodeListLenIndef
  ([(PoolStake, NonEmpty LedgerRelayAccessPoint)]
 -> (PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> [(PoolStake, NonEmpty LedgerRelayAccessPoint)])
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> ([(PoolStake, NonEmpty LedgerRelayAccessPoint)]
    -> [(PoolStake, NonEmpty LedgerRelayAccessPoint)])
-> Decoder s (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> Decoder s [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
Codec.decodeSequenceLenIndef
         (((PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
 -> [(PoolStake, NonEmpty LedgerRelayAccessPoint)])
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
forall a. [a] -> [a]
reverse
         do
           Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
2
           poolStake    <- Rational -> PoolStake
PoolStake (Rational -> PoolStake)
-> Decoder s Rational -> Decoder s PoolStake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall s. Decoder s Rational
forall a s. FromCBOR a => Decoder s a
fromCBOR
           relays       <- fromCBOR
           return (poolStake, relays)


-- | 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, Maybe PoolStake
Value -> Parser [PoolStake]
Value -> Parser PoolStake
(Value -> Parser PoolStake)
-> (Value -> Parser [PoolStake])
-> Maybe PoolStake
-> FromJSON PoolStake
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PoolStake
parseJSON :: Value -> Parser PoolStake
$cparseJSONList :: Value -> Parser [PoolStake]
parseJSONList :: Value -> Parser [PoolStake]
$comittedField :: Maybe PoolStake
omittedField :: Maybe PoolStake
FromJSON, [PoolStake] -> Value
[PoolStake] -> Encoding
PoolStake -> Bool
PoolStake -> Value
PoolStake -> Encoding
(PoolStake -> Value)
-> (PoolStake -> Encoding)
-> ([PoolStake] -> Value)
-> ([PoolStake] -> Encoding)
-> (PoolStake -> Bool)
-> ToJSON PoolStake
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PoolStake -> Value
toJSON :: PoolStake -> Value
$ctoEncoding :: PoolStake -> Encoding
toEncoding :: PoolStake -> Encoding
$ctoJSONList :: [PoolStake] -> Value
toJSONList :: [PoolStake] -> Value
$ctoEncodingList :: [PoolStake] -> Encoding
toEncodingList :: [PoolStake] -> Encoding
$comitField :: PoolStake -> Bool
omitField :: PoolStake -> Bool
ToJSON, Typeable PoolStake
Typeable PoolStake =>
(PoolStake -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy PoolStake -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PoolStake] -> Size)
-> ToCBOR PoolStake
PoolStake -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolStake] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy PoolStake -> 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 :: PoolStake -> Encoding
toCBOR :: PoolStake -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PoolStake -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy PoolStake -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolStake] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolStake] -> Size
ToCBOR, Typeable PoolStake
Typeable PoolStake =>
(forall s. Decoder s PoolStake)
-> (Proxy PoolStake -> Text) -> FromCBOR PoolStake
Proxy PoolStake -> Text
forall s. Decoder s PoolStake
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s PoolStake
fromCBOR :: forall s. Decoder s PoolStake
$clabel :: Proxy PoolStake -> Text
label :: Proxy PoolStake -> Text
FromCBOR)
  -- the ToCBOR and FromCBOR instances can be removed once V22 is no longer supported


-- | 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, AccPoolStake -> ()
(AccPoolStake -> ()) -> NFData AccPoolStake
forall a. (a -> ()) -> NFData a
$crnf :: AccPoolStake -> ()
rnf :: AccPoolStake -> ()
NFData, Maybe AccPoolStake
Value -> Parser [AccPoolStake]
Value -> Parser AccPoolStake
(Value -> Parser AccPoolStake)
-> (Value -> Parser [AccPoolStake])
-> Maybe AccPoolStake
-> FromJSON AccPoolStake
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AccPoolStake
parseJSON :: Value -> Parser AccPoolStake
$cparseJSONList :: Value -> Parser [AccPoolStake]
parseJSONList :: Value -> Parser [AccPoolStake]
$comittedField :: Maybe AccPoolStake
omittedField :: Maybe AccPoolStake
FromJSON, [AccPoolStake] -> Value
[AccPoolStake] -> Encoding
AccPoolStake -> Bool
AccPoolStake -> Value
AccPoolStake -> Encoding
(AccPoolStake -> Value)
-> (AccPoolStake -> Encoding)
-> ([AccPoolStake] -> Value)
-> ([AccPoolStake] -> Encoding)
-> (AccPoolStake -> Bool)
-> ToJSON AccPoolStake
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AccPoolStake -> Value
toJSON :: AccPoolStake -> Value
$ctoEncoding :: AccPoolStake -> Encoding
toEncoding :: AccPoolStake -> Encoding
$ctoJSONList :: [AccPoolStake] -> Value
toJSONList :: [AccPoolStake] -> Value
$ctoEncodingList :: [AccPoolStake] -> Encoding
toEncodingList :: [AccPoolStake] -> Encoding
$comitField :: AccPoolStake -> Bool
omitField :: AccPoolStake -> Bool
ToJSON, Typeable AccPoolStake
Typeable AccPoolStake =>
(forall s. Decoder s AccPoolStake)
-> (Proxy AccPoolStake -> Text) -> FromCBOR AccPoolStake
Proxy AccPoolStake -> Text
forall s. Decoder s AccPoolStake
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s AccPoolStake
fromCBOR :: forall s. Decoder s AccPoolStake
$clabel :: Proxy AccPoolStake -> Text
label :: Proxy AccPoolStake -> Text
FromCBOR, Typeable AccPoolStake
Typeable AccPoolStake =>
(AccPoolStake -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy AccPoolStake -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [AccPoolStake] -> Size)
-> ToCBOR AccPoolStake
AccPoolStake -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AccPoolStake] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy AccPoolStake -> 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 :: AccPoolStake -> Encoding
toCBOR :: AccPoolStake -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy AccPoolStake -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy AccPoolStake -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AccPoolStake] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AccPoolStake] -> Size
ToCBOR)
  -- the ToCBOR and FromCBOR instances can be removed once V22 is no longer supported


-- | 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)

-- | 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, Int -> IsBigLedgerPeer -> ShowS
[IsBigLedgerPeer] -> ShowS
IsBigLedgerPeer -> String
(Int -> IsBigLedgerPeer -> ShowS)
-> (IsBigLedgerPeer -> String)
-> ([IsBigLedgerPeer] -> ShowS)
-> Show IsBigLedgerPeer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsBigLedgerPeer -> ShowS
showsPrec :: Int -> IsBigLedgerPeer -> ShowS
$cshow :: IsBigLedgerPeer -> String
show :: IsBigLedgerPeer -> String
$cshowList :: [IsBigLedgerPeer] -> ShowS
showList :: [IsBigLedgerPeer] -> ShowS
Show)

-- | Return ledger state information and ledger peers.
--
data LedgerPeersConsensusInterface extraAPI m = LedgerPeersConsensusInterface {
    forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m
-> STM m (WithOrigin SlotNo)
lpGetLatestSlot  :: STM m (WithOrigin SlotNo)
  , forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m
-> STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
lpGetLedgerPeers :: STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
    -- | Extension point so that third party users can add more actions
  , forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m -> extraAPI
lpExtraAPI       :: extraAPI
  }

getRelayAccessPointsFromLedger
  :: MonadSTM m
  => SRVPrefix
  -> LedgerPeersConsensusInterface extraAPI m
  -> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
getRelayAccessPointsFromLedger :: forall (m :: * -> *) extraAPI.
MonadSTM m =>
ByteString
-> LedgerPeersConsensusInterface extraAPI m
-> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
getRelayAccessPointsFromLedger
  ByteString
srvPrefix
  LedgerPeersConsensusInterface {STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
lpGetLedgerPeers :: forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m
-> STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
lpGetLedgerPeers :: STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
lpGetLedgerPeers}
  =
  ([(PoolStake, NonEmpty LedgerRelayAccessPoint)]
 -> [(PoolStake, NonEmpty RelayAccessPoint)])
-> STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
forall a b. (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((PoolStake, NonEmpty LedgerRelayAccessPoint)
 -> (PoolStake, NonEmpty RelayAccessPoint))
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> [(PoolStake, NonEmpty RelayAccessPoint)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint)
-> (PoolStake, NonEmpty LedgerRelayAccessPoint)
-> (PoolStake, NonEmpty RelayAccessPoint)
forall a b. (a -> b) -> (PoolStake, a) -> (PoolStake, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LedgerRelayAccessPoint -> RelayAccessPoint)
-> NonEmpty LedgerRelayAccessPoint -> NonEmpty RelayAccessPoint
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint ByteString
srvPrefix)))) STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
lpGetLedgerPeers


mapExtraAPI :: (a -> b) -> LedgerPeersConsensusInterface a m -> LedgerPeersConsensusInterface b m
mapExtraAPI :: forall a b (m :: * -> *).
(a -> b)
-> LedgerPeersConsensusInterface a m
-> LedgerPeersConsensusInterface b m
mapExtraAPI a -> b
f lpci :: LedgerPeersConsensusInterface a m
lpci@LedgerPeersConsensusInterface{ lpExtraAPI :: forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m -> extraAPI
lpExtraAPI = a
api } =
  LedgerPeersConsensusInterface a m
lpci { lpExtraAPI = f api }