{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Ledger.PeerSelection () where

import           Data.SOP.BasicFunctors
import           Data.SOP.Functors
import           Data.SOP.Strict
import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.Ledger ()
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import           Ouroboros.Consensus.Ledger.SupportsPeerSelection

instance CanHardFork xs => LedgerSupportsPeerSelection (HardForkBlock xs) where
  getPeers :: forall (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers =
        NS (K [(PoolStake, NonEmpty StakePoolRelay)]) xs
-> [(PoolStake, NonEmpty StakePoolRelay)]
NS (K [(PoolStake, NonEmpty StakePoolRelay)]) xs
-> CollapseTo NS [(PoolStake, NonEmpty StakePoolRelay)]
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K [(PoolStake, NonEmpty StakePoolRelay)]) xs
 -> [(PoolStake, NonEmpty StakePoolRelay)])
-> (LedgerState (HardForkBlock xs) mk
    -> NS (K [(PoolStake, NonEmpty StakePoolRelay)]) xs)
-> LedgerState (HardForkBlock xs) mk
-> [(PoolStake, NonEmpty StakePoolRelay)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Flip LedgerState mk a
    -> K [(PoolStake, NonEmpty StakePoolRelay)] a)
-> NS (Flip LedgerState mk) xs
-> NS (K [(PoolStake, NonEmpty StakePoolRelay)]) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle ([(PoolStake, NonEmpty StakePoolRelay)]
-> K [(PoolStake, NonEmpty StakePoolRelay)] a
forall k a (b :: k). a -> K a b
K ([(PoolStake, NonEmpty StakePoolRelay)]
 -> K [(PoolStake, NonEmpty StakePoolRelay)] a)
-> (Flip LedgerState mk a
    -> [(PoolStake, NonEmpty StakePoolRelay)])
-> Flip LedgerState mk a
-> K [(PoolStake, NonEmpty StakePoolRelay)] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState a mk -> [(PoolStake, NonEmpty StakePoolRelay)]
forall blk (mk :: MapKind).
LedgerSupportsPeerSelection blk =>
LedgerState blk mk -> [(PoolStake, NonEmpty StakePoolRelay)]
forall (mk :: MapKind).
LedgerState a mk -> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers (LedgerState a mk -> [(PoolStake, NonEmpty StakePoolRelay)])
-> (Flip LedgerState mk a -> LedgerState a mk)
-> Flip LedgerState mk a
-> [(PoolStake, NonEmpty StakePoolRelay)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState mk a -> LedgerState a mk
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip)
      (NS (Flip LedgerState mk) xs
 -> NS (K [(PoolStake, NonEmpty StakePoolRelay)]) xs)
-> (LedgerState (HardForkBlock xs) mk
    -> NS (Flip LedgerState mk) xs)
-> LedgerState (HardForkBlock xs) mk
-> NS (K [(PoolStake, NonEmpty StakePoolRelay)]) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState (Flip LedgerState mk) xs
-> NS (Flip LedgerState mk) xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip
      (HardForkState (Flip LedgerState mk) xs
 -> NS (Flip LedgerState mk) xs)
-> (LedgerState (HardForkBlock xs) mk
    -> HardForkState (Flip LedgerState mk) xs)
-> LedgerState (HardForkBlock xs) mk
-> NS (Flip LedgerState mk) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra