{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Ledger.CommonProtocolParams () 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
  ( HasCanonicalTxIn
  , HasHardForkTxOut (..)
  )
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import Ouroboros.Consensus.Ledger.CommonProtocolParams

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

askCurrentLedger ::
  CanHardFork xs =>
  (forall blk. CommonProtocolParams blk => LedgerState blk mk -> a) ->
  LedgerState (HardForkBlock xs) mk ->
  a
askCurrentLedger :: forall (xs :: [*]) (mk :: MapKind) a.
CanHardFork xs =>
(forall blk. CommonProtocolParams blk => LedgerState blk mk -> a)
-> LedgerState (HardForkBlock xs) mk -> a
askCurrentLedger forall blk. CommonProtocolParams blk => LedgerState blk mk -> a
f =
  NS (K a) xs -> a
NS (K a) xs -> CollapseTo NS a
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 a) xs -> a)
-> (LedgerState (HardForkBlock xs) mk -> NS (K a) xs)
-> LedgerState (HardForkBlock xs) mk
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => Flip LedgerState mk a -> K a a)
-> NS (Flip LedgerState mk) 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)
-> (Flip LedgerState mk a -> a) -> Flip LedgerState mk a -> K a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState a mk -> a
forall blk. CommonProtocolParams blk => LedgerState blk mk -> a
f (LedgerState a mk -> a)
-> (Flip LedgerState mk a -> LedgerState a mk)
-> Flip LedgerState mk a
-> a
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 a) xs)
-> (LedgerState (HardForkBlock xs) mk
    -> NS (Flip LedgerState mk) xs)
-> LedgerState (HardForkBlock xs) mk
-> NS (K a) 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