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

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

-- | Various types related to ledger peers.  This module is re-exported from
-- "Ouroboros.Network.PeerSelection.LedgerPeers".
--
module Ouroboros.Network.PeerSelection.LedgerPeers.Type
  ( PoolStake (..)
  , AccPoolStake (..)
  , IsLedgerPeer (..)
  , IsBigLedgerPeer (..)
  , LedgerPeersConsensusInterface (..)
  , getRelayAccessPointsFromLedger
  , mapExtraAPI
  , UseLedgerPeers (..)
  , AfterSlot (..)
  , LedgerPeersKind (..)
  , LedgerPeerSnapshot (.., LedgerPeerSnapshot)
  , getRelayAccessPointsFromLedgerPeerSnapshot
  , isLedgerPeersEnabled
  , compareLedgerPeerSnapshotApproximate
    -- * Re-exports
  , SRVPrefix
  , RelayAccessPoint (..)
  , LedgerRelayAccessPoint (..)
  , prefixLedgerRelayAccessPoint
  ) where

import GHC.Generics (Generic)

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Binary qualified as Codec
import Cardano.Slotting.Slot (SlotNo (..), WithOrigin (..))
import Control.Concurrent.Class.MonadSTM
import Control.DeepSeq (NFData (..))
import Control.Monad (forM)
import Data.Aeson
import Data.Bifunctor (first)
import Data.List.NonEmpty (NonEmpty)
import NoThunks.Class

import Ouroboros.Network.PeerSelection.RelayAccessPoint

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


getRelayAccessPointsFromLedgerPeerSnapshot
  :: SRVPrefix
  -> LedgerPeerSnapshot
  -> (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
getRelayAccessPointsFromLedgerPeerSnapshot :: SRVPrefix
-> LedgerPeerSnapshot
-> (WithOrigin SlotNo,
    [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
getRelayAccessPointsFromLedgerPeerSnapshot SRVPrefix
srvPrefix (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


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

{-# COMPLETE LedgerPeerSnapshot #-}

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

-- | In case the format changes in the future, this function provides a migration functionality
-- when possible.
--
migrateLedgerPeerSnapshot
  :: LedgerPeerSnapshot
  -> Maybe LedgerPeerSnapshot
migrateLedgerPeerSnapshot :: LedgerPeerSnapshot -> Maybe LedgerPeerSnapshot
migrateLedgerPeerSnapshot snapshot :: LedgerPeerSnapshot
snapshot@LedgerPeerSnapshotV2{} = LedgerPeerSnapshot -> Maybe LedgerPeerSnapshot
forall a. a -> Maybe a
Just LedgerPeerSnapshot
snapshot

instance ToJSON LedgerPeerSnapshot where
  toJSON :: LedgerPeerSnapshot -> 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
                                   ]]

instance FromJSON LedgerPeerSnapshot where
  parseJSON :: Value -> Parser LedgerPeerSnapshot
parseJSON = String
-> (Object -> Parser LedgerPeerSnapshot)
-> Value
-> Parser LedgerPeerSnapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LedgerPeerSnapshot" ((Object -> Parser LedgerPeerSnapshot)
 -> Value -> Parser LedgerPeerSnapshot)
-> (Object -> Parser LedgerPeerSnapshot)
-> Value
-> Parser LedgerPeerSnapshot
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    vNum :: Int <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
    ledgerPeerSnapshot <-
      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 (AccPoolStake, (PoolStake, f LedgerRelayAccessPoint))
f Object
poolV = do
                                 AccPoolStakeCoded accStake <- Object
poolV Object -> Key -> Parser AccPoolStakeCoded
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accumulatedStake"
                                 PoolStakeCoded reStake <- poolV .: "relativeStake"
                                 -- 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 :: * -> *}.
(Functor f, FromJSON (f LedgerRelayAccessPointV1)) =>
Object
-> Parser (AccPoolStake, (PoolStake, 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 (AccPoolStake, (PoolStake, b))
f Object
poolV = do
                                 AccPoolStakeCoded accStake <- Object
poolV Object -> Key -> Parser AccPoolStakeCoded
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accumulatedStake"
                                 PoolStakeCoded reStake <- poolV .: "relativeStake"
                                 relays <- 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 {b}.
FromJSON b =>
Object -> Parser (AccPoolStake, (PoolStake, b))
f (Object -> Value
Object Object
poolO)

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

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

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

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

instance ToCBOR LedgerPeerSnapshot where
  toCBOR :: LedgerPeerSnapshot -> Encoding
toCBOR (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
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (WithOriginCoded,
 [(AccPoolStakeCoded,
   (PoolStakeCoded, NonEmpty LedgerRelayAccessPoint))])
-> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (WithOrigin SlotNo -> WithOriginCoded
WithOriginCoded WithOrigin SlotNo
wOrigin, [(AccPoolStakeCoded,
  (PoolStakeCoded, NonEmpty LedgerRelayAccessPoint))]
pools')
    where
      pools' :: [(AccPoolStakeCoded,
  (PoolStakeCoded, NonEmpty LedgerRelayAccessPoint))]
pools' =
        [(AccPoolStake -> AccPoolStakeCoded
AccPoolStakeCoded AccPoolStake
accPoolStake, (PoolStake -> PoolStakeCoded
PoolStakeCoded PoolStake
relStake, NonEmpty LedgerRelayAccessPoint
relays))
        | (AccPoolStake
accPoolStake, (PoolStake
relStake, NonEmpty LedgerRelayAccessPoint
relays)) <- [(AccPoolStake, (PoolStake, NonEmpty LedgerRelayAccessPoint))]
pools
        ]

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

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

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

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

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

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

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

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

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

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

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