{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Chain.Update.ProtocolParameters (
  ProtocolParameters (..),
  upAdptThd,
  isBootstrapEraPP,
)
where

import Cardano.Chain.Common (
  LovelacePortion,
  TxFeePolicy,
  lovelacePortionToRational,
 )
import Cardano.Chain.Slotting (EpochNumber, SlotNumber (..), isBootstrapEra)
import Cardano.Chain.Update.SoftforkRule
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Formatting (Format, bprint, build, bytes, shortest)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (FromJSON (..), ToJSON (..), fromJSField, mkObject)

-- | Data which is associated with 'BlockVersion'
data ProtocolParameters = ProtocolParameters
  { ProtocolParameters -> Word16
ppScriptVersion :: !Word16
  , ProtocolParameters -> Natural
ppSlotDuration :: !Natural
  -- ^ Milliseconds.
  , ProtocolParameters -> Natural
ppMaxBlockSize :: !Natural
  , ProtocolParameters -> Natural
ppMaxHeaderSize :: !Natural
  , ProtocolParameters -> Natural
ppMaxTxSize :: !Natural
  , ProtocolParameters -> Natural
ppMaxProposalSize :: !Natural
  , ProtocolParameters -> LovelacePortion
ppMpcThd :: !LovelacePortion
  , ProtocolParameters -> LovelacePortion
ppHeavyDelThd :: !LovelacePortion
  , ProtocolParameters -> LovelacePortion
ppUpdateVoteThd :: !LovelacePortion
  , ProtocolParameters -> LovelacePortion
ppUpdateProposalThd :: !LovelacePortion
  , ProtocolParameters -> SlotNumber
ppUpdateProposalTTL :: !SlotNumber
  -- ^ Time to live for a protocol update proposal. This used to be the number
  -- of slots after which the system made a decision regarding an update
  -- proposal confirmation, when a majority of votes was not reached in the
  -- given number of slots. If there were more positive than negative votes the
  -- proposal became confirmed, otherwise it was rejected. Since in the
  -- Byron-Shelley bridge we do not have negative votes, and we aim at
  -- simplifying the update mechanism, 'ppUpdateProposalTTL' is re-interpreted as
  -- the number of slots a proposal has to gather a majority of votes. If a
  -- majority of votes has not been reached before this period, then the
  -- proposal is rejected.
  --
  -- -- TODO: it seems this should be a slot count.
  , ProtocolParameters -> SoftforkRule
ppSoftforkRule :: !SoftforkRule
  , ProtocolParameters -> TxFeePolicy
ppTxFeePolicy :: !TxFeePolicy
  , ProtocolParameters -> EpochNumber
ppUnlockStakeEpoch :: !EpochNumber
  }
  deriving (Int -> ProtocolParameters -> ShowS
[ProtocolParameters] -> ShowS
ProtocolParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolParameters] -> ShowS
$cshowList :: [ProtocolParameters] -> ShowS
show :: ProtocolParameters -> String
$cshow :: ProtocolParameters -> String
showsPrec :: Int -> ProtocolParameters -> ShowS
$cshowsPrec :: Int -> ProtocolParameters -> ShowS
Show, ProtocolParameters -> ProtocolParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolParameters -> ProtocolParameters -> Bool
$c/= :: ProtocolParameters -> ProtocolParameters -> Bool
== :: ProtocolParameters -> ProtocolParameters -> Bool
$c== :: ProtocolParameters -> ProtocolParameters -> Bool
Eq, Eq ProtocolParameters
ProtocolParameters -> ProtocolParameters -> Bool
ProtocolParameters -> ProtocolParameters -> Ordering
ProtocolParameters -> ProtocolParameters -> ProtocolParameters
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 :: ProtocolParameters -> ProtocolParameters -> ProtocolParameters
$cmin :: ProtocolParameters -> ProtocolParameters -> ProtocolParameters
max :: ProtocolParameters -> ProtocolParameters -> ProtocolParameters
$cmax :: ProtocolParameters -> ProtocolParameters -> ProtocolParameters
>= :: ProtocolParameters -> ProtocolParameters -> Bool
$c>= :: ProtocolParameters -> ProtocolParameters -> Bool
> :: ProtocolParameters -> ProtocolParameters -> Bool
$c> :: ProtocolParameters -> ProtocolParameters -> Bool
<= :: ProtocolParameters -> ProtocolParameters -> Bool
$c<= :: ProtocolParameters -> ProtocolParameters -> Bool
< :: ProtocolParameters -> ProtocolParameters -> Bool
$c< :: ProtocolParameters -> ProtocolParameters -> Bool
compare :: ProtocolParameters -> ProtocolParameters -> Ordering
$ccompare :: ProtocolParameters -> ProtocolParameters -> Ordering
Ord, forall x. Rep ProtocolParameters x -> ProtocolParameters
forall x. ProtocolParameters -> Rep ProtocolParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtocolParameters x -> ProtocolParameters
$cfrom :: forall x. ProtocolParameters -> Rep ProtocolParameters x
Generic)
  deriving anyclass (ProtocolParameters -> ()
forall a. (a -> ()) -> NFData a
rnf :: ProtocolParameters -> ()
$crnf :: ProtocolParameters -> ()
NFData, Context -> ProtocolParameters -> IO (Maybe ThunkInfo)
Proxy ProtocolParameters -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ProtocolParameters -> String
$cshowTypeOf :: Proxy ProtocolParameters -> String
wNoThunks :: Context -> ProtocolParameters -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ProtocolParameters -> IO (Maybe ThunkInfo)
noThunks :: Context -> ProtocolParameters -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ProtocolParameters -> IO (Maybe ThunkInfo)
NoThunks)

instance B.Buildable ProtocolParameters where
  build :: ProtocolParameters -> Builder
build ProtocolParameters
pp =
    forall a. Format Builder a -> a
bprint
      ( Format
  (Word16
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (Word16
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
"{ script version: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", slot duration: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Natural -> r)
bytes'
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", block size limit: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Natural -> r)
bytes'
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (Natural
   -> Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", header size limit: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Natural -> r)
bytes'
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (Natural
   -> Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", tx size limit: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Natural -> r)
bytes'
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (Natural
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", proposal size limit: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Natural -> r)
bytes'
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", mpc threshold: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (LovelacePortion
   -> LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", heavyweight delegation threshold: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (LovelacePortion
   -> LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", update vote threshold: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
  (LovelacePortion
   -> SlotNumber
   -> SoftforkRule
   -> TxFeePolicy
   -> EpochNumber
   -> Builder)
", update proposal threshold: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SlotNumber
   -> SoftforkRule -> TxFeePolicy -> EpochNumber -> Builder)
  (SlotNumber
   -> SoftforkRule -> TxFeePolicy -> EpochNumber -> Builder)
", update implicit period: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SoftforkRule -> TxFeePolicy -> EpochNumber -> Builder)
  (SoftforkRule -> TxFeePolicy -> EpochNumber -> Builder)
" slots"
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (SoftforkRule -> TxFeePolicy -> EpochNumber -> Builder)
  (SoftforkRule -> TxFeePolicy -> EpochNumber -> Builder)
", softfork rule: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (TxFeePolicy -> EpochNumber -> Builder)
  (TxFeePolicy -> EpochNumber -> Builder)
", tx fee policy: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (EpochNumber -> Builder) (EpochNumber -> Builder)
", unlock stake epoch: "
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build
          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
" }"
      )
      (ProtocolParameters -> Word16
ppScriptVersion ProtocolParameters
pp)
      (ProtocolParameters -> Natural
ppSlotDuration ProtocolParameters
pp)
      (ProtocolParameters -> Natural
ppMaxBlockSize ProtocolParameters
pp)
      (ProtocolParameters -> Natural
ppMaxHeaderSize ProtocolParameters
pp)
      (ProtocolParameters -> Natural
ppMaxTxSize ProtocolParameters
pp)
      (ProtocolParameters -> Natural
ppMaxProposalSize ProtocolParameters
pp)
      (ProtocolParameters -> LovelacePortion
ppMpcThd ProtocolParameters
pp)
      (ProtocolParameters -> LovelacePortion
ppHeavyDelThd ProtocolParameters
pp)
      (ProtocolParameters -> LovelacePortion
ppUpdateVoteThd ProtocolParameters
pp)
      (ProtocolParameters -> LovelacePortion
ppUpdateProposalThd ProtocolParameters
pp)
      (ProtocolParameters -> SlotNumber
ppUpdateProposalTTL ProtocolParameters
pp)
      (ProtocolParameters -> SoftforkRule
ppSoftforkRule ProtocolParameters
pp)
      (ProtocolParameters -> TxFeePolicy
ppTxFeePolicy ProtocolParameters
pp)
      (ProtocolParameters -> EpochNumber
ppUnlockStakeEpoch ProtocolParameters
pp)
    where
      bytes' :: Format r (Natural -> r)
      bytes' :: forall r. Format r (Natural -> r)
bytes' = forall f a r.
(Ord f, Integral a, Fractional f) =>
Format Builder (f -> Builder) -> Format r (a -> r)
bytes (forall a r. Real a => Format r (a -> r)
shortest @Double)

instance Monad m => ToJSON m ProtocolParameters where
  toJSON :: ProtocolParameters -> m JSValue
toJSON ProtocolParameters
pp =
    forall (m :: * -> *).
Monad m =>
[(JSString, m JSValue)] -> m JSValue
mkObject
      [ (JSString
"scriptVersion", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Word16
ppScriptVersion ProtocolParameters
pp)
      , (JSString
"slotDuration", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Natural
ppSlotDuration ProtocolParameters
pp)
      , (JSString
"maxBlockSize", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Natural
ppMaxBlockSize ProtocolParameters
pp)
      , (JSString
"maxHeaderSize", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Natural
ppMaxHeaderSize ProtocolParameters
pp)
      , (JSString
"maxTxSize", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Natural
ppMaxTxSize ProtocolParameters
pp)
      , (JSString
"maxProposalSize", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Natural
ppMaxProposalSize ProtocolParameters
pp)
      , (JSString
"mpcThd", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> LovelacePortion
ppMpcThd ProtocolParameters
pp)
      , (JSString
"heavyDelThd", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> LovelacePortion
ppHeavyDelThd ProtocolParameters
pp)
      , (JSString
"updateVoteThd", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> LovelacePortion
ppUpdateVoteThd ProtocolParameters
pp)
      , (JSString
"updateProposalThd", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> LovelacePortion
ppUpdateProposalThd ProtocolParameters
pp)
      , (JSString
"updateImplicit", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> SlotNumber
ppUpdateProposalTTL ProtocolParameters
pp)
      , (JSString
"softforkRule", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> SoftforkRule
ppSoftforkRule ProtocolParameters
pp)
      , (JSString
"txFeePolicy", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> TxFeePolicy
ppTxFeePolicy ProtocolParameters
pp)
      , (JSString
"unlockStakeEpoch", forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> EpochNumber
ppUnlockStakeEpoch ProtocolParameters
pp)
      ]

instance MonadError SchemaError m => FromJSON m ProtocolParameters where
  fromJSON :: JSValue -> m ProtocolParameters
fromJSON JSValue
obj =
    Word16
-> Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> LovelacePortion
-> SlotNumber
-> SoftforkRule
-> TxFeePolicy
-> EpochNumber
-> ProtocolParameters
ProtocolParameters
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"scriptVersion"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"slotDuration"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"maxBlockSize"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"maxHeaderSize"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"maxTxSize"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"maxProposalSize"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"mpcThd"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"heavyDelThd"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"updateVoteThd"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"updateProposalThd"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"updateImplicit"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"softforkRule"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"txFeePolicy"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"unlockStakeEpoch"

instance ToCBOR ProtocolParameters where
  toCBOR :: ProtocolParameters -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR ProtocolParameters where
  fromCBOR :: forall s. Decoder s ProtocolParameters
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR ProtocolParameters where
  encCBOR :: ProtocolParameters -> Encoding
encCBOR ProtocolParameters
pp =
    Word -> Encoding
encodeListLen Word
14
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> Word16
ppScriptVersion ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> Natural
ppSlotDuration ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> Natural
ppMaxBlockSize ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> Natural
ppMaxHeaderSize ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> Natural
ppMaxTxSize ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> Natural
ppMaxProposalSize ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> LovelacePortion
ppMpcThd ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> LovelacePortion
ppHeavyDelThd ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> LovelacePortion
ppUpdateVoteThd ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> LovelacePortion
ppUpdateProposalThd ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> SlotNumber
ppUpdateProposalTTL ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> SoftforkRule
ppSoftforkRule ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> TxFeePolicy
ppTxFeePolicy ProtocolParameters
pp)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (ProtocolParameters -> EpochNumber
ppUnlockStakeEpoch ProtocolParameters
pp)

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

-- | Version of 'isBootstrapEra' which takes 'ProtocolParameters' instead of
--   unlock stake epoch
isBootstrapEraPP :: ProtocolParameters -> EpochNumber -> Bool
isBootstrapEraPP :: ProtocolParameters -> EpochNumber -> Bool
isBootstrapEraPP ProtocolParameters
adoptedPP = EpochNumber -> EpochNumber -> Bool
isBootstrapEra (ProtocolParameters -> EpochNumber
ppUnlockStakeEpoch ProtocolParameters
adoptedPP)

-- | In Byron we do not have a @upAdptThd@ protocol parameter, so we have to
--   use the existing ones.
--
--   @lovelacePortionToRational . srMinThd . ppSoftforkRule@ will give us the
--   ratio (in the interval @[0, 1]@) of the total stake that has to endorse a
--   protocol version to become adopted. In genesis configuration, this ratio
--   will evaluate to @0.6@, so if we have 7 genesis keys, @upAdptThd = 4@.
upAdptThd :: Word8 -> ProtocolParameters -> Int
upAdptThd :: Word8 -> ProtocolParameters -> Int
upAdptThd Word8
numGenKeys ProtocolParameters
pps =
  forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Rational
stakeRatio forall a. Num a => a -> a -> a
* forall a. Real a => a -> Rational
toRational Word8
numGenKeys
  where
    stakeRatio :: Rational
stakeRatio = LovelacePortion -> Rational
lovelacePortionToRational forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SoftforkRule -> LovelacePortion
srMinThd forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ProtocolParameters -> SoftforkRule
ppSoftforkRule forall a b. (a -> b) -> a -> b
$ ProtocolParameters
pps