{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.HardFork.Combinator.Ledger.CommonProtocolParams () where

import           Data.SOP.Strict

import           Ouroboros.Consensus.Ledger.CommonProtocolParams

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

instance CanHardFork xs => CommonProtocolParams (HardForkBlock xs) where
  maxHeaderSize :: LedgerState (HardForkBlock xs) -> Word32
maxHeaderSize = (forall blk. CommonProtocolParams blk => LedgerState blk -> Word32)
-> LedgerState (HardForkBlock xs) -> Word32
forall (xs :: [*]) a.
CanHardFork xs =>
(forall blk. CommonProtocolParams blk => LedgerState blk -> a)
-> LedgerState (HardForkBlock xs) -> a
askCurrentLedger forall blk. CommonProtocolParams blk => LedgerState blk -> Word32
maxHeaderSize
  maxTxSize :: LedgerState (HardForkBlock xs) -> Word32
maxTxSize     = (forall blk. CommonProtocolParams blk => LedgerState blk -> Word32)
-> LedgerState (HardForkBlock xs) -> Word32
forall (xs :: [*]) a.
CanHardFork xs =>
(forall blk. CommonProtocolParams blk => LedgerState blk -> a)
-> LedgerState (HardForkBlock xs) -> a
askCurrentLedger forall blk. CommonProtocolParams blk => LedgerState blk -> Word32
maxTxSize

askCurrentLedger
  :: CanHardFork xs
  => (forall blk. CommonProtocolParams blk => LedgerState blk -> a)
  -> LedgerState (HardForkBlock xs) -> a
askCurrentLedger :: (forall blk. CommonProtocolParams blk => LedgerState blk -> a)
-> LedgerState (HardForkBlock xs) -> a
askCurrentLedger forall blk. CommonProtocolParams blk => LedgerState blk -> a
f =
      NS (K a) xs -> 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 a) xs -> a)
-> (LedgerState (HardForkBlock xs) -> NS (K a) xs)
-> LedgerState (HardForkBlock xs)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => LedgerState a -> K a a)
-> NS LedgerState xs
-> NS (K a) 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 (a -> K a a
forall k a (b :: k). a -> K a b
K (a -> K a a) -> (LedgerState a -> a) -> LedgerState a -> K a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState a -> a
forall blk. CommonProtocolParams blk => LedgerState blk -> a
f)
    (NS LedgerState xs -> NS (K a) xs)
-> (LedgerState (HardForkBlock xs) -> NS LedgerState xs)
-> LedgerState (HardForkBlock xs)
-> NS (K a) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState LedgerState xs -> NS LedgerState xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip
    (HardForkState LedgerState xs -> NS LedgerState xs)
-> (LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs)
-> LedgerState (HardForkBlock xs)
-> NS LedgerState xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
forall (xs :: [*]).
LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
hardForkLedgerStatePerEra