{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.Update.ProtocolParametersUpdate
  ( ProtocolParametersUpdate (..),
    isEmpty,
    apply,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, enforceSize)
import Cardano.Chain.Common (LovelacePortion, TxFeePolicy)
import Cardano.Chain.Slotting (EpochNumber, SlotNumber (..))
import Cardano.Chain.Update.ProtocolParameters (ProtocolParameters (..))
import Cardano.Chain.Update.SoftforkRule (SoftforkRule)
import Cardano.Prelude hiding (empty)
import Data.Aeson (ToJSON)
import Data.Text.Lazy.Builder (Builder)
import Formatting (Format, bprint, build, bytes, later, shortest)
import qualified Formatting.Buildable as B

-- | Data which represents modifications of block (aka protocol) version
data ProtocolParametersUpdate = ProtocolParametersUpdate
  { ProtocolParametersUpdate -> Maybe Word16
ppuScriptVersion :: !(Maybe Word16),
    ProtocolParametersUpdate -> Maybe Natural
ppuSlotDuration :: !(Maybe Natural),
    ProtocolParametersUpdate -> Maybe Natural
ppuMaxBlockSize :: !(Maybe Natural),
    ProtocolParametersUpdate -> Maybe Natural
ppuMaxHeaderSize :: !(Maybe Natural),
    ProtocolParametersUpdate -> Maybe Natural
ppuMaxTxSize :: !(Maybe Natural),
    ProtocolParametersUpdate -> Maybe Natural
ppuMaxProposalSize :: !(Maybe Natural),
    ProtocolParametersUpdate -> Maybe LovelacePortion
ppuMpcThd :: !(Maybe LovelacePortion),
    ProtocolParametersUpdate -> Maybe LovelacePortion
ppuHeavyDelThd :: !(Maybe LovelacePortion),
    ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateVoteThd :: !(Maybe LovelacePortion),
    ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateProposalThd :: !(Maybe LovelacePortion),
    ProtocolParametersUpdate -> Maybe SlotNumber
ppuUpdateProposalTTL :: !(Maybe SlotNumber),
    ProtocolParametersUpdate -> Maybe SoftforkRule
ppuSoftforkRule :: !(Maybe SoftforkRule),
    ProtocolParametersUpdate -> Maybe TxFeePolicy
ppuTxFeePolicy :: !(Maybe TxFeePolicy),
    ProtocolParametersUpdate -> Maybe EpochNumber
ppuUnlockStakeEpoch :: !(Maybe EpochNumber)
  }
  deriving (Int -> ProtocolParametersUpdate -> ShowS
[ProtocolParametersUpdate] -> ShowS
ProtocolParametersUpdate -> String
(Int -> ProtocolParametersUpdate -> ShowS)
-> (ProtocolParametersUpdate -> String)
-> ([ProtocolParametersUpdate] -> ShowS)
-> Show ProtocolParametersUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolParametersUpdate] -> ShowS
$cshowList :: [ProtocolParametersUpdate] -> ShowS
show :: ProtocolParametersUpdate -> String
$cshow :: ProtocolParametersUpdate -> String
showsPrec :: Int -> ProtocolParametersUpdate -> ShowS
$cshowsPrec :: Int -> ProtocolParametersUpdate -> ShowS
Show, ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
(ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> Eq ProtocolParametersUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c/= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
== :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c== :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
Eq, Eq ProtocolParametersUpdate
Eq ProtocolParametersUpdate
-> (ProtocolParametersUpdate
    -> ProtocolParametersUpdate -> Ordering)
-> (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool)
-> (ProtocolParametersUpdate
    -> ProtocolParametersUpdate -> ProtocolParametersUpdate)
-> (ProtocolParametersUpdate
    -> ProtocolParametersUpdate -> ProtocolParametersUpdate)
-> Ord ProtocolParametersUpdate
ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
ProtocolParametersUpdate -> ProtocolParametersUpdate -> Ordering
ProtocolParametersUpdate
-> ProtocolParametersUpdate -> ProtocolParametersUpdate
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
min :: ProtocolParametersUpdate
-> ProtocolParametersUpdate -> ProtocolParametersUpdate
$cmin :: ProtocolParametersUpdate
-> ProtocolParametersUpdate -> ProtocolParametersUpdate
max :: ProtocolParametersUpdate
-> ProtocolParametersUpdate -> ProtocolParametersUpdate
$cmax :: ProtocolParametersUpdate
-> ProtocolParametersUpdate -> ProtocolParametersUpdate
>= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c>= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
> :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c> :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
<= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c<= :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
< :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
$c< :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
compare :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Ordering
$ccompare :: ProtocolParametersUpdate -> ProtocolParametersUpdate -> Ordering
$cp1Ord :: Eq ProtocolParametersUpdate
Ord, (forall x.
 ProtocolParametersUpdate -> Rep ProtocolParametersUpdate x)
-> (forall x.
    Rep ProtocolParametersUpdate x -> ProtocolParametersUpdate)
-> Generic ProtocolParametersUpdate
forall x.
Rep ProtocolParametersUpdate x -> ProtocolParametersUpdate
forall x.
ProtocolParametersUpdate -> Rep ProtocolParametersUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ProtocolParametersUpdate x -> ProtocolParametersUpdate
$cfrom :: forall x.
ProtocolParametersUpdate -> Rep ProtocolParametersUpdate x
Generic)
  deriving anyclass (ProtocolParametersUpdate -> ()
(ProtocolParametersUpdate -> ()) -> NFData ProtocolParametersUpdate
forall a. (a -> ()) -> NFData a
rnf :: ProtocolParametersUpdate -> ()
$crnf :: ProtocolParametersUpdate -> ()
NFData)

instance B.Buildable ProtocolParametersUpdate where
  build :: ProtocolParametersUpdate -> Builder
build ProtocolParametersUpdate
ppu =
    Format
  Builder
  (Maybe Word16
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (Maybe Word16
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Word16
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
"{ script version: " Format
  (Maybe Word16
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Word16
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Word16
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Word16
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Word16 -> Builder)
-> Format
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe Word16
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (Word16 -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Word16
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Word16
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", slot duration: "
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Natural -> Builder)
-> Format
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (Natural -> Builder)
forall r. Format r (Natural -> r)
bytes'
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", block size limit: "
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Natural -> Builder)
-> Format
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (Natural -> Builder)
forall r. Format r (Natural -> r)
bytes'
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", header size limit: "
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Natural -> Builder)
-> Format
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (Natural -> Builder)
forall r. Format r (Natural -> r)
bytes'
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", tx size limit: "
          Format
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Natural -> Builder)
-> Format
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (Natural -> Builder)
forall r. Format r (Natural -> r)
bytes'
          Format
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", proposal size limit: "
          Format
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Natural -> Builder)
-> Format
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (Natural -> Builder)
forall r. Format r (Natural -> r)
bytes'
          Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", mpc threshold: "
          Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (LovelacePortion -> Builder)
-> Format
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (LovelacePortion -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", heavyweight delegation threshold: "
          Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (LovelacePortion -> Builder)
-> Format
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (LovelacePortion -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", update vote threshold: "
          Format
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (LovelacePortion -> Builder)
-> Format
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (LovelacePortion -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", update proposal threshold: "
          Format
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (LovelacePortion -> Builder)
-> Format
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (LovelacePortion -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
", update implicit period (slots): "
          Format
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
-> Format
     Builder
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (SlotNumber -> Builder)
-> Format
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (SlotNumber -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> Builder)
-> Format
     Builder
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format
     Builder
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
", softfork rule: "
          Format
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format
     Builder
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format
     Builder
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (SoftforkRule -> Builder)
-> Format
     (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (SoftforkRule -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format
     Builder (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format
     Builder
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
  (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
", tx fee policy: "
          Format
  (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
  (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format
     Builder (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format
     Builder (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (TxFeePolicy -> Builder)
-> Format
     (Maybe EpochNumber -> Builder)
     (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (TxFeePolicy -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (Maybe EpochNumber -> Builder)
  (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
-> Format Builder (Maybe EpochNumber -> Builder)
-> Format
     Builder (Maybe TxFeePolicy -> Maybe EpochNumber -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Maybe EpochNumber -> Builder) (Maybe EpochNumber -> Builder)
", unlock stake epoch: "
          Format
  (Maybe EpochNumber -> Builder) (Maybe EpochNumber -> Builder)
-> Format Builder (Maybe EpochNumber -> Builder)
-> Format Builder (Maybe EpochNumber -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (EpochNumber -> Builder)
-> Format Builder (Maybe EpochNumber -> Builder)
forall a r.
Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (EpochNumber -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format Builder (Maybe EpochNumber -> Builder)
-> Format Builder Builder
-> Format Builder (Maybe EpochNumber -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
" }"
      )
      (ProtocolParametersUpdate -> Maybe Word16
ppuScriptVersion ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe Natural
ppuSlotDuration ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe Natural
ppuMaxBlockSize ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe Natural
ppuMaxHeaderSize ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe Natural
ppuMaxTxSize ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe Natural
ppuMaxProposalSize ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuMpcThd ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuHeavyDelThd ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateVoteThd ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateProposalThd ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe SlotNumber
ppuUpdateProposalTTL ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe SoftforkRule
ppuSoftforkRule ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe TxFeePolicy
ppuTxFeePolicy ProtocolParametersUpdate
ppu)
      (ProtocolParametersUpdate -> Maybe EpochNumber
ppuUnlockStakeEpoch ProtocolParametersUpdate
ppu)
    where
      bmodifier :: Format Builder (a -> Builder) -> Format r (Maybe a -> r)
      bmodifier :: Format Builder (a -> Builder) -> Format r (Maybe a -> r)
bmodifier Format Builder (a -> Builder)
b = (Maybe a -> Builder) -> Format r (Maybe a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((Maybe a -> Builder) -> Format r (Maybe a -> r))
-> (Maybe a -> Builder) -> Format r (Maybe a -> r)
forall a b. (a -> b) -> a -> b
$ Builder -> (a -> Builder) -> Maybe a -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"no change" (Format Builder (a -> Builder) -> a -> Builder
forall a. Format Builder a -> a
bprint Format Builder (a -> Builder)
b)

      bytes' :: Format r (Natural -> r)
      bytes' :: Format r (Natural -> r)
bytes' = Format Builder (Double -> Builder) -> Format r (Natural -> r)
forall f a r.
(Ord f, Integral a, Fractional f) =>
Format Builder (f -> Builder) -> Format r (a -> r)
bytes (forall r. Real Double => Format r (Double -> r)
forall a r. Real a => Format r (a -> r)
shortest @Double)

-- Used for debugging purposes only
instance ToJSON ProtocolParametersUpdate

instance ToCBOR ProtocolParametersUpdate where
  toCBOR :: ProtocolParametersUpdate -> Encoding
toCBOR ProtocolParametersUpdate
ppu =
    Word -> Encoding
encodeListLen Word
14
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe Word16
ppuScriptVersion ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe Natural
ppuSlotDuration ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe Natural
ppuMaxBlockSize ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe Natural
ppuMaxHeaderSize ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe Natural
ppuMaxTxSize ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe Natural
ppuMaxProposalSize ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe LovelacePortion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuMpcThd ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe LovelacePortion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuHeavyDelThd ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe LovelacePortion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateVoteThd ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe LovelacePortion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateProposalThd ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe SlotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe SlotNumber
ppuUpdateProposalTTL ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe SoftforkRule -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe SoftforkRule
ppuSoftforkRule ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe TxFeePolicy -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe TxFeePolicy
ppuTxFeePolicy ProtocolParametersUpdate
ppu)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe EpochNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolParametersUpdate -> Maybe EpochNumber
ppuUnlockStakeEpoch ProtocolParametersUpdate
ppu)

instance FromCBOR ProtocolParametersUpdate where
  fromCBOR :: Decoder s ProtocolParametersUpdate
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ProtocolParametersUpdate" Int
14
    Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ProtocolParametersUpdate
ProtocolParametersUpdate
      (Maybe Word16
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe Natural
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe LovelacePortion
 -> Maybe SlotNumber
 -> Maybe SoftforkRule
 -> Maybe TxFeePolicy
 -> Maybe EpochNumber
 -> ProtocolParametersUpdate)
-> Decoder s (Maybe Word16)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe Word16)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe Natural
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe Natural
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe Natural)
-> Decoder
     s
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe LovelacePortion)
-> Decoder
     s
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe LovelacePortion)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe LovelacePortion)
-> Decoder
     s
     (Maybe LovelacePortion
      -> Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe LovelacePortion)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe LovelacePortion
   -> Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe LovelacePortion)
-> Decoder
     s
     (Maybe LovelacePortion
      -> Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe LovelacePortion)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe LovelacePortion
   -> Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe LovelacePortion)
-> Decoder
     s
     (Maybe SlotNumber
      -> Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe LovelacePortion)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe SlotNumber
   -> Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe SlotNumber)
-> Decoder
     s
     (Maybe SoftforkRule
      -> Maybe TxFeePolicy
      -> Maybe EpochNumber
      -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe SlotNumber)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe SoftforkRule
   -> Maybe TxFeePolicy
   -> Maybe EpochNumber
   -> ProtocolParametersUpdate)
-> Decoder s (Maybe SoftforkRule)
-> Decoder
     s
     (Maybe TxFeePolicy
      -> Maybe EpochNumber -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe SoftforkRule)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (Maybe TxFeePolicy
   -> Maybe EpochNumber -> ProtocolParametersUpdate)
-> Decoder s (Maybe TxFeePolicy)
-> Decoder s (Maybe EpochNumber -> ProtocolParametersUpdate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe TxFeePolicy)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Maybe EpochNumber -> ProtocolParametersUpdate)
-> Decoder s (Maybe EpochNumber)
-> Decoder s ProtocolParametersUpdate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe EpochNumber)
forall a s. FromCBOR a => Decoder s a
fromCBOR

empty :: ProtocolParametersUpdate
empty :: ProtocolParametersUpdate
empty =
  ProtocolParametersUpdate :: Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ProtocolParametersUpdate
ProtocolParametersUpdate
    { ppuScriptVersion :: Maybe Word16
ppuScriptVersion = Maybe Word16
forall a. Maybe a
Nothing,
      ppuSlotDuration :: Maybe Natural
ppuSlotDuration = Maybe Natural
forall a. Maybe a
Nothing,
      ppuMaxBlockSize :: Maybe Natural
ppuMaxBlockSize = Maybe Natural
forall a. Maybe a
Nothing,
      ppuMaxHeaderSize :: Maybe Natural
ppuMaxHeaderSize = Maybe Natural
forall a. Maybe a
Nothing,
      ppuMaxTxSize :: Maybe Natural
ppuMaxTxSize = Maybe Natural
forall a. Maybe a
Nothing,
      ppuMaxProposalSize :: Maybe Natural
ppuMaxProposalSize = Maybe Natural
forall a. Maybe a
Nothing,
      ppuMpcThd :: Maybe LovelacePortion
ppuMpcThd = Maybe LovelacePortion
forall a. Maybe a
Nothing,
      ppuHeavyDelThd :: Maybe LovelacePortion
ppuHeavyDelThd = Maybe LovelacePortion
forall a. Maybe a
Nothing,
      ppuUpdateVoteThd :: Maybe LovelacePortion
ppuUpdateVoteThd = Maybe LovelacePortion
forall a. Maybe a
Nothing,
      ppuUpdateProposalThd :: Maybe LovelacePortion
ppuUpdateProposalThd = Maybe LovelacePortion
forall a. Maybe a
Nothing,
      ppuUpdateProposalTTL :: Maybe SlotNumber
ppuUpdateProposalTTL = Maybe SlotNumber
forall a. Maybe a
Nothing,
      ppuSoftforkRule :: Maybe SoftforkRule
ppuSoftforkRule = Maybe SoftforkRule
forall a. Maybe a
Nothing,
      ppuTxFeePolicy :: Maybe TxFeePolicy
ppuTxFeePolicy = Maybe TxFeePolicy
forall a. Maybe a
Nothing,
      ppuUnlockStakeEpoch :: Maybe EpochNumber
ppuUnlockStakeEpoch = Maybe EpochNumber
forall a. Maybe a
Nothing
    }

isEmpty :: ProtocolParametersUpdate -> Bool
isEmpty :: ProtocolParametersUpdate -> Bool
isEmpty = (ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolParametersUpdate
empty)

-- | Apply 'ProtocolParametersUpdate' to 'ProtocolParameters'
apply :: ProtocolParametersUpdate -> ProtocolParameters -> ProtocolParameters
apply :: ProtocolParametersUpdate
-> ProtocolParameters -> ProtocolParameters
apply ProtocolParametersUpdate
ppu ProtocolParameters
pp =
  ProtocolParameters :: Word16
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> SlotNumber
-> SoftforkRule
-> TxFeePolicy
-> EpochNumber
-> ProtocolParameters
ProtocolParameters
    { ppScriptVersion :: Word16
ppScriptVersion = Word16 -> Maybe Word16 -> Word16
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> Word16
ppScriptVersion ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe Word16
ppuScriptVersion ProtocolParametersUpdate
ppu),
      ppSlotDuration :: Natural
ppSlotDuration = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> Natural
ppSlotDuration ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe Natural
ppuSlotDuration ProtocolParametersUpdate
ppu),
      ppMaxBlockSize :: Natural
ppMaxBlockSize = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> Natural
ppMaxBlockSize ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe Natural
ppuMaxBlockSize ProtocolParametersUpdate
ppu),
      ppMaxHeaderSize :: Natural
ppMaxHeaderSize = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> Natural
ppMaxHeaderSize ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe Natural
ppuMaxHeaderSize ProtocolParametersUpdate
ppu),
      ppMaxTxSize :: Natural
ppMaxTxSize = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> Natural
ppMaxTxSize ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe Natural
ppuMaxTxSize ProtocolParametersUpdate
ppu),
      ppMaxProposalSize :: Natural
ppMaxProposalSize =
        Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe
          (ProtocolParameters -> Natural
ppMaxProposalSize ProtocolParameters
pp)
          (ProtocolParametersUpdate -> Maybe Natural
ppuMaxProposalSize ProtocolParametersUpdate
ppu),
      ppMpcThd :: LovelacePortion
ppMpcThd = LovelacePortion -> Maybe LovelacePortion -> LovelacePortion
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> LovelacePortion
ppMpcThd ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuMpcThd ProtocolParametersUpdate
ppu),
      ppHeavyDelThd :: LovelacePortion
ppHeavyDelThd = LovelacePortion -> Maybe LovelacePortion -> LovelacePortion
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> LovelacePortion
ppHeavyDelThd ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuHeavyDelThd ProtocolParametersUpdate
ppu),
      ppUpdateVoteThd :: LovelacePortion
ppUpdateVoteThd = LovelacePortion -> Maybe LovelacePortion -> LovelacePortion
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> LovelacePortion
ppUpdateVoteThd ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateVoteThd ProtocolParametersUpdate
ppu),
      ppUpdateProposalThd :: LovelacePortion
ppUpdateProposalThd =
        LovelacePortion -> Maybe LovelacePortion -> LovelacePortion
forall a. a -> Maybe a -> a
fromMaybe
          (ProtocolParameters -> LovelacePortion
ppUpdateProposalThd ProtocolParameters
pp)
          (ProtocolParametersUpdate -> Maybe LovelacePortion
ppuUpdateProposalThd ProtocolParametersUpdate
ppu),
      ppUpdateProposalTTL :: SlotNumber
ppUpdateProposalTTL = SlotNumber -> Maybe SlotNumber -> SlotNumber
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> SlotNumber
ppUpdateProposalTTL ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe SlotNumber
ppuUpdateProposalTTL ProtocolParametersUpdate
ppu),
      ppSoftforkRule :: SoftforkRule
ppSoftforkRule = SoftforkRule -> Maybe SoftforkRule -> SoftforkRule
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> SoftforkRule
ppSoftforkRule ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe SoftforkRule
ppuSoftforkRule ProtocolParametersUpdate
ppu),
      ppTxFeePolicy :: TxFeePolicy
ppTxFeePolicy = TxFeePolicy -> Maybe TxFeePolicy -> TxFeePolicy
forall a. a -> Maybe a -> a
fromMaybe (ProtocolParameters -> TxFeePolicy
ppTxFeePolicy ProtocolParameters
pp) (ProtocolParametersUpdate -> Maybe TxFeePolicy
ppuTxFeePolicy ProtocolParametersUpdate
ppu),
      ppUnlockStakeEpoch :: EpochNumber
ppUnlockStakeEpoch =
        EpochNumber -> Maybe EpochNumber -> EpochNumber
forall a. a -> Maybe a -> a
fromMaybe
          (ProtocolParameters -> EpochNumber
ppUnlockStakeEpoch ProtocolParameters
pp)
          (ProtocolParametersUpdate -> Maybe EpochNumber
ppuUnlockStakeEpoch ProtocolParametersUpdate
ppu)
    }