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

-- | 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 (..)
  , LedgerPeerSnapshot (..)
  , LedgerPeerSnapshotWithBlock (..)
  , SomeLedgerPeerSnapshot (..)
  , SomeHashableBlock (..)
  , LedgerPeerSnapshotSRVSupport (..)
  , encodeLedgerPeerSnapshot
  , 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.Functor ((<&>))
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Typeable
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

-- | 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 SomeHashableBlock)
    -> !NetworkMagic
    -> ![(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
    -> LedgerPeerSnapshot BigLedgerPeers
  LedgerAllPeerSnapshotV23
    :: !(Point SomeHashableBlock)
    -> !NetworkMagic
    -> ![(PoolStake, NonEmpty LedgerRelayAccessPoint)]
    -> LedgerPeerSnapshot AllLedgerPeers

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


-- | We hide the block type to avoid parametrizing ouroboros-network with it
--
data SomeHashableBlock =
  forall blk. ( StandardHash blk
              , ToCBOR (HeaderHash blk)
              , FromCBOR (HeaderHash blk)
              , ToJSON (HeaderHash blk)
              , Typeable blk) => SomeHashableBlock !(Proxy blk) !(HeaderHash blk)

type instance HeaderHash SomeHashableBlock = SomeHashableBlock

-- we need this since `Point` is parameterised with `SomeHashableBlock`
-- in the snapshot
instance StandardHash SomeHashableBlock

-- superclass constraints of `StandardHash` require the following
instance Eq SomeHashableBlock where
  == :: SomeHashableBlock -> SomeHashableBlock -> Bool
(==) (SomeHashableBlock (Proxy blk
_ :: Proxy blk1) HeaderHash blk
h1) (SomeHashableBlock (Proxy blk
_ :: Proxy blk2) HeaderHash blk
h2) =
    case Maybe (HeaderHash blk :~: HeaderHash blk)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (HeaderHash blk1 :~: HeaderHash blk2) of
      Just HeaderHash blk :~: HeaderHash blk
Refl -> HeaderHash blk
h1 HeaderHash blk -> HeaderHash blk -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderHash blk
HeaderHash blk
h2
      Maybe (HeaderHash blk :~: HeaderHash blk)
Nothing   -> String -> Bool
forall a. HasCallStack => String -> a
error String
"impossible! Distinct (HeaderHash blk) types"

instance Show SomeHashableBlock where
  show :: SomeHashableBlock -> String
show (SomeHashableBlock Proxy blk
_ HeaderHash blk
sbh) = HeaderHash blk -> String
forall a. Show a => a -> String
show HeaderHash blk
sbh

instance Ord SomeHashableBlock where
  compare :: SomeHashableBlock -> SomeHashableBlock -> Ordering
compare (SomeHashableBlock (Proxy blk
_ :: Proxy blk1) HeaderHash blk
h1) (SomeHashableBlock (Proxy blk
_ :: Proxy blk2) HeaderHash blk
h2) =
    case Maybe (blk :~: blk)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (blk1 :~: blk2) of
      Just blk :~: blk
Refl -> HeaderHash blk -> HeaderHash blk -> Ordering
forall a. Ord a => a -> a -> Ordering
compare HeaderHash blk
h1 HeaderHash blk
HeaderHash blk
h2
      Maybe (blk :~: blk)
Nothing   -> String -> Ordering
forall a. HasCallStack => String -> a
error String
"impossible! Distinct (HeaderHash blk) types"

instance NoThunks SomeHashableBlock where
  wNoThunks :: Context -> SomeHashableBlock -> IO (Maybe ThunkInfo)
wNoThunks Context
ctx (SomeHashableBlock Proxy blk
_ HeaderHash blk
sbh) = Context -> HeaderHash blk -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctx HeaderHash blk
sbh
  showTypeOf :: Proxy SomeHashableBlock -> String
showTypeOf Proxy SomeHashableBlock
_proxy = String
"SomeHashableBlock"

instance ToJSON SomeHashableBlock where
  toJSON :: SomeHashableBlock -> Value
toJSON (SomeHashableBlock Proxy blk
_proxy HeaderHash blk
hash) = HeaderHash blk -> Value
forall a. ToJSON a => a -> Value
toJSON HeaderHash blk
hash


-- | facility for encoding the snapshot in CBOR for backwards compatibility
--

data SomeLedgerPeerSnapshot = forall k. Typeable k => SomeLedgerPeerSnapshot !(Proxy k) !(LedgerPeerSnapshot k)

instance Eq SomeLedgerPeerSnapshot where
  == :: SomeLedgerPeerSnapshot -> SomeLedgerPeerSnapshot -> Bool
(==) (SomeLedgerPeerSnapshot (Proxy k
_ :: Proxy k1) LedgerPeerSnapshot k
s1) (SomeLedgerPeerSnapshot (Proxy k
_ :: Proxy k2) LedgerPeerSnapshot k
s2) =
    case Maybe (k :~: k)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (k1 :~: k2) of
      Just k :~: k
Refl -> LedgerPeerSnapshot k
s1 LedgerPeerSnapshot k -> LedgerPeerSnapshot k -> Bool
forall a. Eq a => a -> a -> Bool
== LedgerPeerSnapshot k
LedgerPeerSnapshot k
s2
      Maybe (k :~: k)
Nothing   -> String -> Bool
forall a. HasCallStack => String -> a
error String
"impossible! Distinct k types"

deriving instance Show SomeLedgerPeerSnapshot

-- | facility to aid JSON decode instances
--
newtype LedgerPeerSnapshotWithBlock blk a =
  LedgerPeerSnapshotWithBlock { forall blk (a :: LedgerPeersKind).
LedgerPeerSnapshotWithBlock blk a -> LedgerPeerSnapshot a
parseLedgerPeerSnapshotWithBlock :: LedgerPeerSnapshot a }


getRelayAccessPointsFromBigLedgerPeersSnapshot
  :: SRVPrefix
  -> LedgerPeerSnapshot BigLedgerPeers
  -> (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
getRelayAccessPointsFromBigLedgerPeersSnapshot :: SRVPrefix
-> LedgerPeerSnapshot 'BigLedgerPeers
-> (WithOrigin SlotNo,
    [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
getRelayAccessPointsFromBigLedgerPeersSnapshot SRVPrefix
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 (SRVPrefix -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint SRVPrefix
srvPrefix))))) (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
as
  LedgerBigPeerSnapshotV23 Point SomeHashableBlock
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 (SRVPrefix -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint SRVPrefix
srvPrefix)))) [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
as
     in  (Point SomeHashableBlock -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point SomeHashableBlock
pt, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]
as')


getRelayAccessPointsFromAllLedgerPeersSnapshot
  :: SRVPrefix
  -> LedgerPeerSnapshot AllLedgerPeers
  -> (WithOrigin SlotNo, [(PoolStake, NonEmpty RelayAccessPoint)])
getRelayAccessPointsFromAllLedgerPeersSnapshot :: SRVPrefix
-> LedgerPeerSnapshot 'AllLedgerPeers
-> (WithOrigin SlotNo, [(PoolStake, NonEmpty RelayAccessPoint)])
getRelayAccessPointsFromAllLedgerPeersSnapshot SRVPrefix
srvPrefix = \case
  LedgerAllPeerSnapshotV23 Point SomeHashableBlock
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 (SRVPrefix -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint SRVPrefix
srvPrefix))) [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
as
     in  (Point SomeHashableBlock -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point SomeHashableBlock
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 SomeHashableBlock
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 SomeHashableBlock -> Value
forall a. ToJSON a => a -> Value
toJSON Point SomeHashableBlock
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 SomeHashableBlock
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 SomeHashableBlock -> Value
forall a. ToJSON a => a -> Value
toJSON Point SomeHashableBlock
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 ( StandardHash blk
         , ToJSON (HeaderHash blk)
         , FromJSON (HeaderHash blk)
         , FromCBOR (HeaderHash blk)
         , ToCBOR (HeaderHash blk)
         , Typeable blk
         ) => FromJSON (LedgerPeerSnapshotWithBlock blk AllLedgerPeers) where
  parseJSON :: Value -> Parser (LedgerPeerSnapshotWithBlock blk 'AllLedgerPeers)
parseJSON = String
-> (Object
    -> Parser (LedgerPeerSnapshotWithBlock blk 'AllLedgerPeers))
-> Value
-> Parser (LedgerPeerSnapshotWithBlock blk '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 blk)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Point" Parser (Point blk)
-> (Point blk -> Point SomeHashableBlock)
-> Parser (Point SomeHashableBlock)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Point blk
pt :: Point blk) ->
         WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
-> Point SomeHashableBlock
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
Point (WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
 -> Point SomeHashableBlock)
-> WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
-> Point SomeHashableBlock
forall a b. (a -> b) -> a -> b
$ Point blk -> WithOrigin (Block SlotNo (HeaderHash blk))
forall {k} (block :: k).
Point block -> WithOrigin (Block SlotNo (HeaderHash block))
getPoint Point blk
pt WithOrigin (Block SlotNo (HeaderHash blk))
-> (Block SlotNo (HeaderHash blk)
    -> Block SlotNo SomeHashableBlock)
-> WithOrigin (Block SlotNo SomeHashableBlock)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Block SlotNo (HeaderHash blk)
blk->
           Block SlotNo (HeaderHash blk)
blk { blockPointHash = SomeHashableBlock (Proxy :: Proxy blk) (blockPointHash blk) }
       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 . LedgerPeerSnapshotWithBlock $ LedgerAllPeerSnapshotV23 point (NetworkMagic magic) allPools'
      Int
_ ->
        String -> Parser (LedgerPeerSnapshotWithBlock blk 'AllLedgerPeers)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser (LedgerPeerSnapshotWithBlock blk 'AllLedgerPeers))
-> String
-> Parser (LedgerPeerSnapshotWithBlock blk '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 ( StandardHash blk
         , FromJSON (HeaderHash blk)
         , ToJSON (HeaderHash blk)
         -- The CBOR instances are only needed to satisfy these constraints
         -- when constructing `SomeHashableBlock` here.
         , FromCBOR (HeaderHash blk)
         , ToCBOR (HeaderHash blk)
         , Typeable blk
         ) => FromJSON (LedgerPeerSnapshotWithBlock blk BigLedgerPeers) where
  parseJSON :: Value -> Parser (LedgerPeerSnapshotWithBlock blk 'BigLedgerPeers)
parseJSON = String
-> (Object
    -> Parser (LedgerPeerSnapshotWithBlock blk 'BigLedgerPeers))
-> Value
-> Parser (LedgerPeerSnapshotWithBlock blk '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 getLedgerReelayAccessPointV1 <$> 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 . LedgerPeerSnapshotWithBlock $ 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 . LedgerPeerSnapshotWithBlock $ LedgerPeerSnapshotV2 (slot, bigPools')
      Int
23 -> do
        point     <- Object
v Object -> Key -> Parser (Point blk)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Point" Parser (Point blk)
-> (Point blk -> Point SomeHashableBlock)
-> Parser (Point SomeHashableBlock)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Point blk
pt :: Point blk) ->
          WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
-> Point SomeHashableBlock
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
Point (WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
 -> Point SomeHashableBlock)
-> WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
-> Point SomeHashableBlock
forall a b. (a -> b) -> a -> b
$ Point blk -> WithOrigin (Block SlotNo (HeaderHash blk))
forall {k} (block :: k).
Point block -> WithOrigin (Block SlotNo (HeaderHash block))
getPoint Point blk
pt WithOrigin (Block SlotNo (HeaderHash blk))
-> (Block SlotNo (HeaderHash blk)
    -> Block SlotNo SomeHashableBlock)
-> WithOrigin (Block SlotNo SomeHashableBlock)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Block SlotNo (HeaderHash blk)
blk->
            Block SlotNo (HeaderHash blk)
blk { blockPointHash = SomeHashableBlock (Proxy :: Proxy blk) (blockPointHash blk) }
        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 . LedgerPeerSnapshotWithBlock $ LedgerBigPeerSnapshotV23 point (NetworkMagic magic) bigPools'
      Int
_ ->
        String -> Parser (LedgerPeerSnapshotWithBlock blk 'BigLedgerPeers)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Parser (LedgerPeerSnapshotWithBlock blk 'BigLedgerPeers))
-> String
-> Parser (LedgerPeerSnapshotWithBlock blk '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 -> SomeLedgerPeerSnapshot -> Codec.Encoding
encodeLedgerPeerSnapshot' :: LedgerPeerSnapshotSRVSupport -> SomeLedgerPeerSnapshot -> Encoding
encodeLedgerPeerSnapshot' LedgerPeerSnapshotSRVSupport
srvSupport (SomeLedgerPeerSnapshot Proxy k
_ LedgerPeerSnapshot k
lps) = LedgerPeerSnapshotSRVSupport -> LedgerPeerSnapshot k -> Encoding
forall (a :: LedgerPeersKind).
LedgerPeerSnapshotSRVSupport -> LedgerPeerSnapshot a -> Encoding
encodeLedgerPeerSnapshot LedgerPeerSnapshotSRVSupport
srvSupport LedgerPeerSnapshot k
lps
{-# INLINE encodeLedgerPeerSnapshot' #-}


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 SomeHashableBlock
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 SomeHashableBlock -> Encoding
encodeLedgerPeerSnapshotPoint Point SomeHashableBlock
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 SomeHashableBlock
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 SomeHashableBlock -> Encoding
encodeLedgerPeerSnapshotPoint Point SomeHashableBlock
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 blk.
                            ( FromCBOR (HeaderHash blk)
                            , ToCBOR (HeaderHash blk)
                            , ToJSON (HeaderHash blk)
                            , StandardHash blk
                            , Typeable blk)
                         => Proxy blk
                         -> Codec.Decoder s (SomeLedgerPeerSnapshot)
decodeLedgerPeerSnapshot :: forall s blk.
(FromCBOR (HeaderHash blk), ToCBOR (HeaderHash blk),
 ToJSON (HeaderHash blk), StandardHash blk, Typeable blk) =>
Proxy blk -> Decoder s SomeLedgerPeerSnapshot
decodeLedgerPeerSnapshot Proxy blk
proxy = 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 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
2 Decoder s ()
-> Decoder s SomeLedgerPeerSnapshot
-> Decoder s SomeLedgerPeerSnapshot
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Proxy 'BigLedgerPeers
-> LedgerPeerSnapshot 'BigLedgerPeers -> SomeLedgerPeerSnapshot
forall (k :: LedgerPeersKind).
Typeable k =>
Proxy k -> LedgerPeerSnapshot k -> SomeLedgerPeerSnapshot
SomeLedgerPeerSnapshot Proxy 'BigLedgerPeers
forall {k} (t :: k). Proxy t
Proxy (LedgerPeerSnapshot 'BigLedgerPeers -> SomeLedgerPeerSnapshot)
-> ((WithOrigin SlotNo,
     [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
    -> LedgerPeerSnapshot 'BigLedgerPeers)
-> (WithOrigin SlotNo,
    [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> SomeLedgerPeerSnapshot
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             (WithOrigin SlotNo,
 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> LedgerPeerSnapshot 'BigLedgerPeers
LedgerPeerSnapshotV2 ((WithOrigin SlotNo,
  [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
 -> SomeLedgerPeerSnapshot)
-> Decoder
     s
     (WithOrigin SlotNo,
      [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
-> Decoder s SomeLedgerPeerSnapshot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (WithOrigin SlotNo
 -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
 -> (WithOrigin SlotNo,
     [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]))
-> Decoder s (WithOrigin SlotNo)
-> Decoder
     s
     ([(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
      -> (WithOrigin SlotNo,
          [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (WithOrigin SlotNo)
forall s. Decoder s (WithOrigin SlotNo)
decodeWithOrigin Decoder
  s
  ([(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
   -> (WithOrigin SlotNo,
       [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]))
-> Decoder
     s [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> Decoder
     s
     (WithOrigin SlotNo,
      [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))])
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 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
forall s.
Decoder
  s [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
forall a s. FromCBOR a => Decoder s a
fromCBOR)
      Word8
2 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
3 Decoder s ()
-> Decoder s SomeLedgerPeerSnapshot
-> Decoder s SomeLedgerPeerSnapshot
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Proxy 'BigLedgerPeers
-> LedgerPeerSnapshot 'BigLedgerPeers -> SomeLedgerPeerSnapshot
forall (k :: LedgerPeersKind).
Typeable k =>
Proxy k -> LedgerPeerSnapshot k -> SomeLedgerPeerSnapshot
SomeLedgerPeerSnapshot Proxy 'BigLedgerPeers
forall {k} (t :: k). Proxy t
Proxy (LedgerPeerSnapshot 'BigLedgerPeers -> SomeLedgerPeerSnapshot)
-> Decoder s (LedgerPeerSnapshot 'BigLedgerPeers)
-> Decoder s SomeLedgerPeerSnapshot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             (Point SomeHashableBlock
-> NetworkMagic
-> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> LedgerPeerSnapshot 'BigLedgerPeers
LedgerBigPeerSnapshotV23 (Point SomeHashableBlock
 -> NetworkMagic
 -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
 -> LedgerPeerSnapshot 'BigLedgerPeers)
-> Decoder s (Point SomeHashableBlock)
-> Decoder
     s
     (NetworkMagic
      -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
      -> LedgerPeerSnapshot 'BigLedgerPeers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy blk -> Decoder s (Point SomeHashableBlock)
forall blk s.
(FromCBOR (HeaderHash blk), ToCBOR (HeaderHash blk),
 ToJSON (HeaderHash blk), Typeable blk, StandardHash blk) =>
Proxy blk -> Decoder s (Point SomeHashableBlock)
decodeLedgerPeerSnapshotPoint Proxy blk
proxy
                                       Decoder
  s
  (NetworkMagic
   -> [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
   -> LedgerPeerSnapshot 'BigLedgerPeers)
-> Decoder s NetworkMagic
-> Decoder
     s
     ([(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
      -> LedgerPeerSnapshot 'BigLedgerPeers)
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
<*> (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic)
-> Decoder s Word32 -> Decoder s NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
Codec.decodeWord32)
                                       Decoder
  s
  ([(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
   -> LedgerPeerSnapshot 'BigLedgerPeers)
-> Decoder
     s [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
-> Decoder s (LedgerPeerSnapshot 'BigLedgerPeers)
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 [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
forall s.
Decoder
  s [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
decodeBigStakePools)
      Word8
3 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
Codec.decodeListLenOf Int
3 Decoder s ()
-> Decoder s SomeLedgerPeerSnapshot
-> Decoder s SomeLedgerPeerSnapshot
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Proxy 'AllLedgerPeers
-> LedgerPeerSnapshot 'AllLedgerPeers -> SomeLedgerPeerSnapshot
forall (k :: LedgerPeersKind).
Typeable k =>
Proxy k -> LedgerPeerSnapshot k -> SomeLedgerPeerSnapshot
SomeLedgerPeerSnapshot Proxy 'AllLedgerPeers
forall {k} (t :: k). Proxy t
Proxy (LedgerPeerSnapshot 'AllLedgerPeers -> SomeLedgerPeerSnapshot)
-> Decoder s (LedgerPeerSnapshot 'AllLedgerPeers)
-> Decoder s SomeLedgerPeerSnapshot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             (Point SomeHashableBlock
-> NetworkMagic
-> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> LedgerPeerSnapshot 'AllLedgerPeers
LedgerAllPeerSnapshotV23 (Point SomeHashableBlock
 -> NetworkMagic
 -> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
 -> LedgerPeerSnapshot 'AllLedgerPeers)
-> Decoder s (Point SomeHashableBlock)
-> Decoder
     s
     (NetworkMagic
      -> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
      -> LedgerPeerSnapshot 'AllLedgerPeers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy blk -> Decoder s (Point SomeHashableBlock)
forall blk s.
(FromCBOR (HeaderHash blk), ToCBOR (HeaderHash blk),
 ToJSON (HeaderHash blk), Typeable blk, StandardHash blk) =>
Proxy blk -> Decoder s (Point SomeHashableBlock)
decodeLedgerPeerSnapshotPoint Proxy blk
proxy
                                       Decoder
  s
  (NetworkMagic
   -> [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
   -> LedgerPeerSnapshot 'AllLedgerPeers)
-> Decoder s NetworkMagic
-> Decoder
     s
     ([(PoolStake, NonEmpty LedgerRelayAccessPoint)]
      -> LedgerPeerSnapshot 'AllLedgerPeers)
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
<*> (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic)
-> Decoder s Word32 -> Decoder s NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
Codec.decodeWord32)
                                       Decoder
  s
  ([(PoolStake, NonEmpty LedgerRelayAccessPoint)]
   -> LedgerPeerSnapshot 'AllLedgerPeers)
-> Decoder s [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> Decoder s (LedgerPeerSnapshot 'AllLedgerPeers)
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 [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
forall s. Decoder s [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
decodeAllStakePools)
      Word8
_ -> String -> Decoder s SomeLedgerPeerSnapshot
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s SomeLedgerPeerSnapshot)
-> String -> Decoder s SomeLedgerPeerSnapshot
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 SomeHashableBlock
                              -> Codec.Encoding
encodeLedgerPeerSnapshotPoint :: Point SomeHashableBlock -> Encoding
encodeLedgerPeerSnapshotPoint = \case
  Point SomeHashableBlock
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 = SomeHashableBlock (Proxy blk
Proxy :: Proxy blk) HeaderHash blk
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
<> HeaderHash blk -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR HeaderHash blk
hash


decodeLedgerPeerSnapshotPoint :: forall blk s.
                                 ( FromCBOR (HeaderHash blk)
                                 , ToCBOR (HeaderHash blk)
                                 , ToJSON (HeaderHash blk)
                                 , Typeable blk
                                 , StandardHash blk)
                              => Proxy blk -> Codec.Decoder s (Point SomeHashableBlock)
decodeLedgerPeerSnapshotPoint :: forall blk s.
(FromCBOR (HeaderHash blk), ToCBOR (HeaderHash blk),
 ToJSON (HeaderHash blk), Typeable blk, StandardHash blk) =>
Proxy blk -> Decoder s (Point SomeHashableBlock)
decodeLedgerPeerSnapshotPoint Proxy blk
_proxy = do
  listLen <- Decoder s Int
forall s. Decoder s Int
Codec.decodeListLen
  tag     <- Codec.decodeWord8
  case (tag, listLen) of
    (Word8
0, Int
1) -> Point SomeHashableBlock -> Decoder s (Point SomeHashableBlock)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point SomeHashableBlock -> Decoder s (Point SomeHashableBlock))
-> Point SomeHashableBlock -> Decoder s (Point SomeHashableBlock)
forall a b. (a -> b) -> a -> b
$ WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
-> Point SomeHashableBlock
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
Point WithOrigin (Block SlotNo (HeaderHash SomeHashableBlock))
WithOrigin (Block SlotNo SomeHashableBlock)
forall t. WithOrigin t
Origin
    (Word8
0, Int
n) -> String -> Decoder s (Point SomeHashableBlock)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Point SomeHashableBlock))
-> String -> Decoder s (Point SomeHashableBlock)
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 SomeHashableBlock))
-> Point SomeHashableBlock
WithOrigin (Block SlotNo SomeHashableBlock)
-> Point SomeHashableBlock
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
Point (WithOrigin (Block SlotNo SomeHashableBlock)
 -> Point SomeHashableBlock)
-> (Block SlotNo SomeHashableBlock
    -> WithOrigin (Block SlotNo SomeHashableBlock))
-> Block SlotNo SomeHashableBlock
-> Point SomeHashableBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block SlotNo SomeHashableBlock
-> WithOrigin (Block SlotNo SomeHashableBlock)
forall t. t -> WithOrigin t
At (Block SlotNo SomeHashableBlock -> Point SomeHashableBlock)
-> Decoder s (Block SlotNo SomeHashableBlock)
-> Decoder s (Point SomeHashableBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SlotNo -> SomeHashableBlock -> Block SlotNo SomeHashableBlock
forall slot hash. slot -> hash -> Block slot hash
Block (SlotNo -> SomeHashableBlock -> Block SlotNo SomeHashableBlock)
-> Decoder s SlotNo
-> Decoder s (SomeHashableBlock -> Block SlotNo SomeHashableBlock)
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 (SomeHashableBlock -> Block SlotNo SomeHashableBlock)
-> Decoder s SomeHashableBlock
-> Decoder s (Block SlotNo SomeHashableBlock)
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
<*> (Proxy blk -> HeaderHash blk -> SomeHashableBlock
forall blk.
(StandardHash blk, ToCBOR (HeaderHash blk),
 FromCBOR (HeaderHash blk), ToJSON (HeaderHash blk),
 Typeable blk) =>
Proxy blk -> HeaderHash blk -> SomeHashableBlock
SomeHashableBlock (Proxy blk
forall {k} (t :: k). Proxy t
Proxy :: Proxy blk) (HeaderHash blk -> SomeHashableBlock)
-> Decoder s (HeaderHash blk) -> Decoder s SomeHashableBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (HeaderHash blk)
forall s. Decoder s (HeaderHash blk)
forall a s. FromCBOR a => Decoder s a
fromCBOR))
    (Word8
1, Int
n) -> String -> Decoder s (Point SomeHashableBlock)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Point SomeHashableBlock))
-> String -> Decoder s (Point SomeHashableBlock)
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 SomeHashableBlock)
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)


-- | Used by functions to indicate what kind of ledger peer to process
--
data LedgerPeersKind = AllLedgerPeers | BigLedgerPeers
  deriving (LedgerPeersKind -> LedgerPeersKind -> Bool
(LedgerPeersKind -> LedgerPeersKind -> Bool)
-> (LedgerPeersKind -> LedgerPeersKind -> Bool)
-> Eq LedgerPeersKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LedgerPeersKind -> LedgerPeersKind -> Bool
== :: LedgerPeersKind -> LedgerPeersKind -> Bool
$c/= :: LedgerPeersKind -> LedgerPeersKind -> Bool
/= :: LedgerPeersKind -> LedgerPeersKind -> Bool
Eq, 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, 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 =>
SRVPrefix
-> LedgerPeersConsensusInterface extraAPI m
-> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
getRelayAccessPointsFromLedger
  SRVPrefix
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 (SRVPrefix -> LedgerRelayAccessPoint -> RelayAccessPoint
prefixLedgerRelayAccessPoint SRVPrefix
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 }