{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage.Forecast (
  BabbageForecast (..),
  mkBabbageForecast,
  bfPoolDistrL,
  bfMaxBlockHeaderSizeL,
  bfMaxBlockBodySizeL,
  bfProtocolVersionL,
) where

import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.PParams ()
import Cardano.Ledger.Babbage.State.CertState ()
import Cardano.Ledger.BaseTypes (ProtVer)
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.API.Forecast (
  EraForecast (..),
  Timeline (..),
 )
import Cardano.Ledger.Shelley.LedgerState (
  NewEpochState (..),
  curPParamsEpochStateL,
  nesEsL,
  nesPdL,
 )
import Cardano.Ledger.Shelley.Rules ()
import Cardano.Ledger.State (EraGov, PoolDistr (..))
import Control.DeepSeq (NFData)
import Data.Word (Word16, Word32)
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens, (^.))
import NoThunks.Class (NoThunks (..))

-- | Forecast data for Praos eras.
data BabbageForecast (t :: Timeline) era = BabbageForecast
  { forall (t :: Timeline) era. BabbageForecast t era -> PoolDistr
bfPoolDistr :: !PoolDistr
  , forall (t :: Timeline) era. BabbageForecast t era -> Word16
bfMaxBlockHeaderSize :: !Word16
  , forall (t :: Timeline) era. BabbageForecast t era -> Word32
bfMaxBlockBodySize :: !Word32
  , forall (t :: Timeline) era. BabbageForecast t era -> ProtVer
bfProtocolVersion :: !ProtVer
  }
  deriving (BabbageForecast t era -> BabbageForecast t era -> Bool
(BabbageForecast t era -> BabbageForecast t era -> Bool)
-> (BabbageForecast t era -> BabbageForecast t era -> Bool)
-> Eq (BabbageForecast t era)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: Timeline) era.
BabbageForecast t era -> BabbageForecast t era -> Bool
$c== :: forall (t :: Timeline) era.
BabbageForecast t era -> BabbageForecast t era -> Bool
== :: BabbageForecast t era -> BabbageForecast t era -> Bool
$c/= :: forall (t :: Timeline) era.
BabbageForecast t era -> BabbageForecast t era -> Bool
/= :: BabbageForecast t era -> BabbageForecast t era -> Bool
Eq, Int -> BabbageForecast t era -> ShowS
[BabbageForecast t era] -> ShowS
BabbageForecast t era -> String
(Int -> BabbageForecast t era -> ShowS)
-> (BabbageForecast t era -> String)
-> ([BabbageForecast t era] -> ShowS)
-> Show (BabbageForecast t era)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: Timeline) era. Int -> BabbageForecast t era -> ShowS
forall (t :: Timeline) era. [BabbageForecast t era] -> ShowS
forall (t :: Timeline) era. BabbageForecast t era -> String
$cshowsPrec :: forall (t :: Timeline) era. Int -> BabbageForecast t era -> ShowS
showsPrec :: Int -> BabbageForecast t era -> ShowS
$cshow :: forall (t :: Timeline) era. BabbageForecast t era -> String
show :: BabbageForecast t era -> String
$cshowList :: forall (t :: Timeline) era. [BabbageForecast t era] -> ShowS
showList :: [BabbageForecast t era] -> ShowS
Show, (forall x. BabbageForecast t era -> Rep (BabbageForecast t era) x)
-> (forall x.
    Rep (BabbageForecast t era) x -> BabbageForecast t era)
-> Generic (BabbageForecast t era)
forall x. Rep (BabbageForecast t era) x -> BabbageForecast t era
forall x. BabbageForecast t era -> Rep (BabbageForecast t era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (t :: Timeline) era x.
Rep (BabbageForecast t era) x -> BabbageForecast t era
forall (t :: Timeline) era x.
BabbageForecast t era -> Rep (BabbageForecast t era) x
$cfrom :: forall (t :: Timeline) era x.
BabbageForecast t era -> Rep (BabbageForecast t era) x
from :: forall x. BabbageForecast t era -> Rep (BabbageForecast t era) x
$cto :: forall (t :: Timeline) era x.
Rep (BabbageForecast t era) x -> BabbageForecast t era
to :: forall x. Rep (BabbageForecast t era) x -> BabbageForecast t era
Generic)

type role BabbageForecast phantom phantom

instance NFData (BabbageForecast t era)

instance NoThunks (BabbageForecast t era)

-- | Helper to build a 'BabbageForecast' from any Praos-era 'NewEpochState'.
mkBabbageForecast ::
  EraGov era =>
  NewEpochState era ->
  BabbageForecast t era
mkBabbageForecast :: forall era (t :: Timeline).
EraGov era =>
NewEpochState era -> BabbageForecast t era
mkBabbageForecast NewEpochState era
nes =
  BabbageForecast
    { bfPoolDistr :: PoolDistr
bfPoolDistr = NewEpochState era
nes NewEpochState era
-> Getting PoolDistr (NewEpochState era) PoolDistr -> PoolDistr
forall s a. s -> Getting a s a -> a
^. Getting PoolDistr (NewEpochState era) PoolDistr
forall era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr)
-> NewEpochState era -> f (NewEpochState era)
nesPdL
    , bfMaxBlockHeaderSize :: Word16
bfMaxBlockHeaderSize = NewEpochState era
nes NewEpochState era
-> Getting Word16 (NewEpochState era) Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const Word16 (EpochState era))
-> NewEpochState era -> Const Word16 (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const Word16 (EpochState era))
 -> NewEpochState era -> Const Word16 (NewEpochState era))
-> ((Word16 -> Const Word16 Word16)
    -> EpochState era -> Const Word16 (EpochState era))
-> Getting Word16 (NewEpochState era) Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const Word16 (PParams era))
-> EpochState era -> Const Word16 (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const Word16 (PParams era))
 -> EpochState era -> Const Word16 (EpochState era))
-> ((Word16 -> Const Word16 Word16)
    -> PParams era -> Const Word16 (PParams era))
-> (Word16 -> Const Word16 Word16)
-> EpochState era
-> Const Word16 (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Const Word16 Word16)
-> PParams era -> Const Word16 (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppMaxBHSizeL
    , bfMaxBlockBodySize :: Word32
bfMaxBlockBodySize = NewEpochState era
nes NewEpochState era
-> Getting Word32 (NewEpochState era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const Word32 (EpochState era))
-> NewEpochState era -> Const Word32 (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const Word32 (EpochState era))
 -> NewEpochState era -> Const Word32 (NewEpochState era))
-> ((Word32 -> Const Word32 Word32)
    -> EpochState era -> Const Word32 (EpochState era))
-> Getting Word32 (NewEpochState era) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const Word32 (PParams era))
-> EpochState era -> Const Word32 (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const Word32 (PParams era))
 -> EpochState era -> Const Word32 (EpochState era))
-> ((Word32 -> Const Word32 Word32)
    -> PParams era -> Const Word32 (PParams era))
-> (Word32 -> Const Word32 Word32)
-> EpochState era
-> Const Word32 (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Const Word32 Word32)
-> PParams era -> Const Word32 (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxBBSizeL
    , bfProtocolVersion :: ProtVer
bfProtocolVersion = NewEpochState era
nes NewEpochState era
-> Getting ProtVer (NewEpochState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const ProtVer (EpochState era))
-> NewEpochState era -> Const ProtVer (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const ProtVer (EpochState era))
 -> NewEpochState era -> Const ProtVer (NewEpochState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> EpochState era -> Const ProtVer (EpochState era))
-> Getting ProtVer (NewEpochState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const ProtVer (PParams era))
-> EpochState era -> Const ProtVer (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const ProtVer (PParams era))
 -> EpochState era -> Const ProtVer (EpochState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> PParams era -> Const ProtVer (PParams era))
-> (ProtVer -> Const ProtVer ProtVer)
-> EpochState era
-> Const ProtVer (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> PParams era -> Const ProtVer (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
    }

bfPoolDistrL :: Lens' (BabbageForecast t era) PoolDistr
bfPoolDistrL :: forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfPoolDistrL = (BabbageForecast t era -> PoolDistr)
-> (BabbageForecast t era -> PoolDistr -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) PoolDistr PoolDistr
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BabbageForecast t era -> PoolDistr
forall (t :: Timeline) era. BabbageForecast t era -> PoolDistr
bfPoolDistr ((BabbageForecast t era -> PoolDistr -> BabbageForecast t era)
 -> Lens
      (BabbageForecast t era)
      (BabbageForecast t era)
      PoolDistr
      PoolDistr)
-> (BabbageForecast t era -> PoolDistr -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) PoolDistr PoolDistr
forall a b. (a -> b) -> a -> b
$ \BabbageForecast t era
s PoolDistr
x -> BabbageForecast t era
s {bfPoolDistr = x}

bfMaxBlockHeaderSizeL :: Lens' (BabbageForecast t era) Word16
bfMaxBlockHeaderSizeL :: forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(Word16 -> f Word16)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfMaxBlockHeaderSizeL = (BabbageForecast t era -> Word16)
-> (BabbageForecast t era -> Word16 -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) Word16 Word16
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BabbageForecast t era -> Word16
forall (t :: Timeline) era. BabbageForecast t era -> Word16
bfMaxBlockHeaderSize ((BabbageForecast t era -> Word16 -> BabbageForecast t era)
 -> Lens
      (BabbageForecast t era) (BabbageForecast t era) Word16 Word16)
-> (BabbageForecast t era -> Word16 -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) Word16 Word16
forall a b. (a -> b) -> a -> b
$ \BabbageForecast t era
s Word16
x -> BabbageForecast t era
s {bfMaxBlockHeaderSize = x}

bfMaxBlockBodySizeL :: Lens' (BabbageForecast t era) Word32
bfMaxBlockBodySizeL :: forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(Word32 -> f Word32)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfMaxBlockBodySizeL = (BabbageForecast t era -> Word32)
-> (BabbageForecast t era -> Word32 -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) Word32 Word32
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BabbageForecast t era -> Word32
forall (t :: Timeline) era. BabbageForecast t era -> Word32
bfMaxBlockBodySize ((BabbageForecast t era -> Word32 -> BabbageForecast t era)
 -> Lens
      (BabbageForecast t era) (BabbageForecast t era) Word32 Word32)
-> (BabbageForecast t era -> Word32 -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) Word32 Word32
forall a b. (a -> b) -> a -> b
$ \BabbageForecast t era
s Word32
x -> BabbageForecast t era
s {bfMaxBlockBodySize = x}

bfProtocolVersionL :: Lens' (BabbageForecast t era) ProtVer
bfProtocolVersionL :: forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(ProtVer -> f ProtVer)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfProtocolVersionL = (BabbageForecast t era -> ProtVer)
-> (BabbageForecast t era -> ProtVer -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) ProtVer ProtVer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BabbageForecast t era -> ProtVer
forall (t :: Timeline) era. BabbageForecast t era -> ProtVer
bfProtocolVersion ((BabbageForecast t era -> ProtVer -> BabbageForecast t era)
 -> Lens
      (BabbageForecast t era) (BabbageForecast t era) ProtVer ProtVer)
-> (BabbageForecast t era -> ProtVer -> BabbageForecast t era)
-> Lens
     (BabbageForecast t era) (BabbageForecast t era) ProtVer ProtVer
forall a b. (a -> b) -> a -> b
$ \BabbageForecast t era
s ProtVer
x -> BabbageForecast t era
s {bfProtocolVersion = x}

instance EraForecast BabbageEra where
  type Forecast t BabbageEra = BabbageForecast t BabbageEra
  mkForecast :: forall (t :: Timeline).
NewEpochState BabbageEra -> Forecast t BabbageEra
mkForecast = NewEpochState BabbageEra -> Forecast t BabbageEra
NewEpochState BabbageEra -> BabbageForecast t BabbageEra
forall era (t :: Timeline).
EraGov era =>
NewEpochState era -> BabbageForecast t era
mkBabbageForecast
  poolDistrForecastL :: forall (t :: Timeline). Lens' (Forecast t BabbageEra) PoolDistr
poolDistrForecastL = (PoolDistr -> f PoolDistr)
-> Forecast t BabbageEra -> f (Forecast t BabbageEra)
(PoolDistr -> f PoolDistr)
-> BabbageForecast t BabbageEra -> f (BabbageForecast t BabbageEra)
forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(PoolDistr -> f PoolDistr)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfPoolDistrL
  maxBlockHeaderSizeForecastL :: forall (t :: Timeline). Lens' (Forecast t BabbageEra) Word16
maxBlockHeaderSizeForecastL = (Word16 -> f Word16)
-> Forecast t BabbageEra -> f (Forecast t BabbageEra)
(Word16 -> f Word16)
-> BabbageForecast t BabbageEra -> f (BabbageForecast t BabbageEra)
forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(Word16 -> f Word16)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfMaxBlockHeaderSizeL
  maxBlockBodySizeForecastL :: forall (t :: Timeline). Lens' (Forecast t BabbageEra) Word32
maxBlockBodySizeForecastL = (Word32 -> f Word32)
-> Forecast t BabbageEra -> f (Forecast t BabbageEra)
(Word32 -> f Word32)
-> BabbageForecast t BabbageEra -> f (BabbageForecast t BabbageEra)
forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(Word32 -> f Word32)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfMaxBlockBodySizeL
  protocolVersionForecastL :: forall (t :: Timeline). Lens' (Forecast t BabbageEra) ProtVer
protocolVersionForecastL = (ProtVer -> f ProtVer)
-> Forecast t BabbageEra -> f (Forecast t BabbageEra)
(ProtVer -> f ProtVer)
-> BabbageForecast t BabbageEra -> f (BabbageForecast t BabbageEra)
forall (t :: Timeline) era (f :: * -> *).
Functor f =>
(ProtVer -> f ProtVer)
-> BabbageForecast t era -> f (BabbageForecast t era)
bfProtocolVersionL