{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-}

module Cardano.Api.Orphans () where

import           Cardano.Api.Pretty (Pretty (..), prettyException, (<+>))
import           Cardano.Api.Via.ShowOf

import           Cardano.Binary (DecoderError (..))
import qualified Cardano.Chain.Byron.API as L
import qualified Cardano.Chain.Common as L
import qualified Cardano.Chain.Delegation.Validation.Scheduling as L.Scheduling
import qualified Cardano.Chain.Update as L
import qualified Cardano.Chain.Update.Validation.Endorsement as L.Endorsement
import qualified Cardano.Chain.Update.Validation.Interface as L.Interface
import qualified Cardano.Chain.Update.Validation.Registration as L.Registration
import qualified Cardano.Chain.Update.Validation.Voting as L.Voting
import qualified Cardano.Chain.UTxO.UTxO as L
import qualified Cardano.Chain.UTxO.Validation as L
import qualified Cardano.Ledger.Allegra.Rules as L
import qualified Cardano.Ledger.Alonzo.PParams as Ledger
import qualified Cardano.Ledger.Alonzo.Rules as L
import qualified Cardano.Ledger.Alonzo.Tx as L
import qualified Cardano.Ledger.Api as L
import qualified Cardano.Ledger.Babbage.PParams as Ledger
import qualified Cardano.Ledger.Babbage.Rules as L
import           Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import qualified Cardano.Ledger.BaseTypes as L
import qualified Cardano.Ledger.BaseTypes as Ledger
import           Cardano.Ledger.Binary
import qualified Cardano.Ledger.Binary.Plain as Plain
import qualified Cardano.Ledger.Coin as L
import qualified Cardano.Ledger.Conway.PParams as Ledger
import qualified Cardano.Ledger.Conway.Rules as L
import qualified Cardano.Ledger.Conway.TxCert as L
import qualified Cardano.Ledger.Core as L
import           Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import qualified Cardano.Ledger.Crypto as Crypto
import qualified Cardano.Ledger.Crypto as L
import           Cardano.Ledger.HKD (NoUpdate (..))
import qualified Cardano.Ledger.Keys as L.Keys
import qualified Cardano.Ledger.SafeHash as L
import qualified Cardano.Ledger.Shelley.API.Mempool as L
import qualified Cardano.Ledger.Shelley.PParams as Ledger
import qualified Cardano.Ledger.Shelley.Rules as L
import qualified Cardano.Ledger.Shelley.TxBody as L
import qualified Cardano.Ledger.Shelley.TxCert as L
import qualified Cardano.Protocol.TPraos.API as Ledger
import           Cardano.Protocol.TPraos.BHeader (HashHeader (..))
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as L
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as Ledger
import qualified Cardano.Protocol.TPraos.Rules.Tickn as Ledger
import           Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..))
import           Ouroboros.Consensus.HardFork.Combinator (OneEraHash (..))
import           Ouroboros.Consensus.Protocol.Praos (PraosState)
import qualified Ouroboros.Consensus.Protocol.Praos as Consensus
import           Ouroboros.Consensus.Protocol.TPraos (TPraosState)
import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
import qualified Ouroboros.Consensus.Shelley.Eras as Consensus
import           Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..))
import qualified Ouroboros.Consensus.Shelley.Ledger.Query as Consensus
import           Ouroboros.Network.Block (HeaderHash, Tip (..))
import           Ouroboros.Network.Mux (MuxError)
import qualified PlutusLedgerApi.Common as P
import qualified PlutusLedgerApi.V2 as V2

import qualified Codec.Binary.Bech32 as Bech32
import qualified Codec.CBOR.Read as CBOR
import           Data.Aeson (KeyValue ((.=)), ToJSON (..), ToJSONKey (..), object, pairs)
import qualified Data.Aeson as A
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Short as SBS
import           Data.Data (Data)
import           Data.Kind (Constraint, Type)
import           Data.ListMap (ListMap)
import qualified Data.ListMap as ListMap
import           Data.Maybe.Strict (StrictMaybe (..))
import           Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as Text
import           Data.Typeable (Typeable)
import           GHC.Exts (IsList (..))
import           GHC.Generics
import           GHC.Stack (HasCallStack)
import           GHC.TypeLits
import           Lens.Micro

deriving instance Generic (L.ApplyTxError era)

deriving instance Generic (L.Registration.TooLarge a)

deriving instance Generic L.ApplicationNameError

deriving instance Generic L.ApplyMempoolPayloadErr

deriving instance Generic L.Endorsement.Error

deriving instance Generic L.Interface.Error

deriving instance Generic L.LovelaceError

deriving instance Generic L.Registration.Adopted

deriving instance Generic L.Registration.Error

deriving instance Generic L.Scheduling.Error

deriving instance Generic L.SoftwareVersionError

deriving instance Generic L.SystemTagError

deriving instance Generic L.TxValidationError

deriving instance Generic L.UTxOError

deriving instance Generic L.UTxOValidationError

deriving instance Generic L.Voting.Error

deriving anyclass instance ToJSON L.ApplicationNameError

deriving anyclass instance ToJSON L.ApplyMempoolPayloadErr

deriving anyclass instance ToJSON L.Endorsement.Error

deriving anyclass instance ToJSON L.Interface.Error

deriving anyclass instance ToJSON L.LovelaceError

deriving anyclass instance ToJSON L.Registration.Adopted

deriving anyclass instance ToJSON L.Registration.ApplicationVersion

deriving anyclass instance ToJSON L.Registration.Error

deriving anyclass instance ToJSON L.Scheduling.Error

deriving anyclass instance ToJSON L.SoftwareVersionError

deriving anyclass instance ToJSON L.SystemTagError

deriving anyclass instance ToJSON L.TxValidationError

deriving anyclass instance ToJSON L.UTxOError

deriving anyclass instance ToJSON L.UTxOValidationError

deriving anyclass instance ToJSON L.Voting.Error

deriving anyclass instance ToJSON L.VotingPeriod

deriving anyclass instance
  ( ToJSON (L.PredicateFailure (L.EraRule "UTXOW" ledgerera))
  , ToJSON (L.PredicateFailure (L.EraRule "DELEGS" ledgerera))
  )
  => ToJSON (L.ShelleyLedgerPredFailure ledgerera)

deriving anyclass instance
  ( L.Crypto (L.EraCrypto ledgerera)
  , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  )
  => ToJSON (L.ShelleyUtxowPredFailure ledgerera)

deriving anyclass instance
  ( L.Crypto (L.EraCrypto ledgerera)
  , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  )
  => ToJSON (L.ShelleyPpupPredFailure ledgerera)

deriving anyclass instance
  ( L.Crypto (L.EraCrypto ledgerera)
  , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  , ToJSON (L.PlutusPurpose L.AsItem ledgerera)
  , ToJSON (L.PlutusPurpose L.AsIx ledgerera)
  )
  => ToJSON (L.AlonzoUtxowPredFailure ledgerera)

deriving anyclass instance
  ( L.Crypto (L.EraCrypto ledgerera)
  , ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  , ToJSON (L.TxCert ledgerera)
  , ToJSON (L.PlutusPurpose L.AsItem ledgerera)
  , ToJSON (L.PlutusPurpose L.AsIx ledgerera)
  )
  => ToJSON (L.BabbageUtxowPredFailure ledgerera)

deriving anyclass instance
  ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera))
  => ToJSON (L.ApplyTxError ledgerera)

deriving via
  ShowOf (L.Keys.VKey L.Keys.Witness c)
  instance
    L.Crypto c => ToJSON (L.Keys.VKey L.Keys.Witness c)

deriving via
  ShowOf (L.AllegraUtxoPredFailure ledgerera)
  instance
    Show (L.AllegraUtxoPredFailure ledgerera) => ToJSON (L.AllegraUtxoPredFailure ledgerera)

deriving via
  ShowOf (L.AlonzoUtxoPredFailure ledgerera)
  instance
    Show (L.AlonzoUtxoPredFailure ledgerera) => ToJSON (L.AlonzoUtxoPredFailure ledgerera)

deriving via
  ShowOf (L.BabbageUtxoPredFailure ledgerera)
  instance
    Show (L.BabbageUtxoPredFailure ledgerera) => ToJSON (L.BabbageUtxoPredFailure ledgerera)

deriving via
  ShowOf (L.ConwayLedgerPredFailure ledgerera)
  instance
    Show (L.ConwayLedgerPredFailure ledgerera) => ToJSON (L.ConwayLedgerPredFailure ledgerera)

deriving via
  ShowOf (L.ShelleyDelegsPredFailure ledgerera)
  instance
    Show (L.ShelleyDelegsPredFailure ledgerera) => ToJSON (L.ShelleyDelegsPredFailure ledgerera)

deriving via
  ShowOf (L.ShelleyUtxoPredFailure ledgerera)
  instance
    Show (L.ShelleyUtxoPredFailure ledgerera) => ToJSON (L.ShelleyUtxoPredFailure ledgerera)

deriving instance ToJSON a => ToJSON (L.Registration.TooLarge a)

deriving via ShowOf L.KeyHash instance ToJSON L.KeyHash

deriving via ShowOf L.ApplicationName instance ToJSONKey L.ApplicationName

deriving instance Data DecoderError

deriving instance Data CBOR.DeserialiseFailure

deriving instance Data Bech32.DecodingError

deriving instance Data Bech32.CharPosition

-- | These instances originally existed on the Lovelace type.
-- As the Lovelace type is deleted and we use L.Coin instead,
-- these instances are added to L.Coin.  The instances are
-- purely for the convenience of writing expressions involving
-- L.Coin but be aware that not all uses of these typeclasses
-- are valid.
deriving newtype instance Real L.Coin

deriving newtype instance Integral L.Coin

deriving newtype instance Num L.Coin

instance Pretty L.Coin where
  pretty :: forall ann. Coin -> Doc ann
pretty (L.Coin Integer
n) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Lovelace"

-- Orphan instances involved in the JSON output of the API queries.
-- We will remove/replace these as we provide more API wrapper types

instance Crypto.Crypto crypto => ToJSON (Consensus.StakeSnapshots crypto) where
  toJSON :: StakeSnapshots crypto -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (StakeSnapshots crypto -> [Pair])
-> StakeSnapshots crypto
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshots crypto -> [Pair]
forall e a crypto.
(KeyValue e a, Crypto crypto) =>
StakeSnapshots crypto -> [a]
stakeSnapshotsToPair
  toEncoding :: StakeSnapshots crypto -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (StakeSnapshots crypto -> Series)
-> StakeSnapshots crypto
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (StakeSnapshots crypto -> [Series])
-> StakeSnapshots crypto
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshots crypto -> [Series]
forall e a crypto.
(KeyValue e a, Crypto crypto) =>
StakeSnapshots crypto -> [a]
stakeSnapshotsToPair

stakeSnapshotsToPair
  :: (Aeson.KeyValue e a, Crypto.Crypto crypto) => Consensus.StakeSnapshots crypto -> [a]
stakeSnapshotsToPair :: forall e a crypto.
(KeyValue e a, Crypto crypto) =>
StakeSnapshots crypto -> [a]
stakeSnapshotsToPair
  Consensus.StakeSnapshots
    { Map (KeyHash 'StakePool crypto) (StakeSnapshot crypto)
ssStakeSnapshots :: Map (KeyHash 'StakePool crypto) (StakeSnapshot crypto)
ssStakeSnapshots :: forall crypto.
StakeSnapshots crypto
-> Map (KeyHash 'StakePool crypto) (StakeSnapshot crypto)
Consensus.ssStakeSnapshots
    , Coin
ssMarkTotal :: Coin
ssMarkTotal :: forall crypto. StakeSnapshots crypto -> Coin
Consensus.ssMarkTotal
    , Coin
ssSetTotal :: Coin
ssSetTotal :: forall crypto. StakeSnapshots crypto -> Coin
Consensus.ssSetTotal
    , Coin
ssGoTotal :: Coin
ssGoTotal :: forall crypto. StakeSnapshots crypto -> Coin
Consensus.ssGoTotal
    } =
    [ Key
"pools" Key -> Map (KeyHash 'StakePool crypto) (StakeSnapshot crypto) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool crypto) (StakeSnapshot crypto)
ssStakeSnapshots
    , Key
"total"
        Key -> Value -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
          [ Key
"stakeMark" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssMarkTotal
          , Key
"stakeSet" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssSetTotal
          , Key
"stakeGo" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssGoTotal
          ]
    ]

instance ToJSON (Consensus.StakeSnapshot crypto) where
  toJSON :: StakeSnapshot crypto -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (StakeSnapshot crypto -> [Pair])
-> StakeSnapshot crypto
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshot crypto -> [Pair]
forall e a crypto. KeyValue e a => StakeSnapshot crypto -> [a]
stakeSnapshotToPair
  toEncoding :: StakeSnapshot crypto -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (StakeSnapshot crypto -> Series)
-> StakeSnapshot crypto
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (StakeSnapshot crypto -> [Series])
-> StakeSnapshot crypto
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshot crypto -> [Series]
forall e a crypto. KeyValue e a => StakeSnapshot crypto -> [a]
stakeSnapshotToPair

stakeSnapshotToPair :: Aeson.KeyValue e a => Consensus.StakeSnapshot crypto -> [a]
stakeSnapshotToPair :: forall e a crypto. KeyValue e a => StakeSnapshot crypto -> [a]
stakeSnapshotToPair
  Consensus.StakeSnapshot
    { Coin
ssMarkPool :: Coin
ssMarkPool :: forall crypto. StakeSnapshot crypto -> Coin
Consensus.ssMarkPool
    , Coin
ssSetPool :: Coin
ssSetPool :: forall crypto. StakeSnapshot crypto -> Coin
Consensus.ssSetPool
    , Coin
ssGoPool :: Coin
ssGoPool :: forall crypto. StakeSnapshot crypto -> Coin
Consensus.ssGoPool
    } =
    [ Key
"stakeMark" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssMarkPool
    , Key
"stakeSet" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssSetPool
    , Key
"stakeGo" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssGoPool
    ]

instance ToJSON (OneEraHash xs) where
  toJSON :: OneEraHash xs -> Value
toJSON =
    Text -> Value
forall a. ToJSON a => a -> Value
toJSON
      (Text -> Value)
-> (OneEraHash xs -> Text) -> OneEraHash xs -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1
      (ByteString -> Text)
-> (OneEraHash xs -> ByteString) -> OneEraHash xs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode
      (ByteString -> ByteString)
-> (OneEraHash xs -> ByteString) -> OneEraHash xs -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
      (ShortByteString -> ByteString)
-> (OneEraHash xs -> ShortByteString)
-> OneEraHash xs
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraHash xs -> ShortByteString
forall k (xs :: [k]). OneEraHash xs -> ShortByteString
getOneEraHash

deriving newtype instance ToJSON ByronHash

-- This instance is temporarily duplicated in cardano-config

instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where
  toJSON :: Tip blk -> Value
toJSON Tip blk
TipGenesis = [Pair] -> Value
Aeson.object [Key
"genesis" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True]
  toJSON (Tip SlotNo
slotNo HeaderHash blk
headerHash BlockNo
blockNo) =
    [Pair] -> Value
Aeson.object
      [ Key
"slotNo" Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slotNo
      , Key
"headerHash" Key -> HeaderHash blk -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeaderHash blk
headerHash
      , Key
"blockNo" Key -> BlockNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockNo
blockNo
      ]

--
-- Simple newtype wrappers JSON conversion
--

deriving newtype instance CC.Crypto crypto => ToJSON (ShelleyHash crypto)

deriving newtype instance CC.Crypto crypto => ToJSON (HashHeader crypto)

deriving instance ToJSON (Ledger.PrtclState StandardCrypto)

deriving instance ToJSON Ledger.TicknState

deriving instance ToJSON (Ledger.ChainDepState StandardCrypto)

instance ToJSON (TPraosState StandardCrypto) where
  toJSON :: TPraosState StandardCrypto -> Value
toJSON TPraosState StandardCrypto
s =
    [Pair] -> Value
Aeson.object
      [ Key
"lastSlot" Key -> WithOrigin SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TPraosState StandardCrypto -> WithOrigin SlotNo
forall c. TPraosState c -> WithOrigin SlotNo
Consensus.tpraosStateLastSlot TPraosState StandardCrypto
s
      , Key
"chainDepState" Key -> ChainDepState StandardCrypto -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TPraosState StandardCrypto -> ChainDepState StandardCrypto
forall c. TPraosState c -> ChainDepState c
Consensus.tpraosStateChainDepState TPraosState StandardCrypto
s
      ]

instance ToJSON (PraosState StandardCrypto) where
  toJSON :: PraosState StandardCrypto -> Value
toJSON PraosState StandardCrypto
s =
    [Pair] -> Value
Aeson.object
      [ Key
"lastSlot" Key -> WithOrigin SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> WithOrigin SlotNo
forall c. PraosState c -> WithOrigin SlotNo
Consensus.praosStateLastSlot PraosState StandardCrypto
s
      , Key
"oCertCounters" Key -> Map (KeyHash 'BlockIssuer StandardCrypto) Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64
forall c. PraosState c -> Map (KeyHash 'BlockIssuer c) Word64
Consensus.praosStateOCertCounters PraosState StandardCrypto
s
      , Key
"evolvingNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateEvolvingNonce PraosState StandardCrypto
s
      , Key
"candidateNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateCandidateNonce PraosState StandardCrypto
s
      , Key
"epochNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateEpochNonce PraosState StandardCrypto
s
      , Key
"labNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateLabNonce PraosState StandardCrypto
s
      , Key
"lastEpochBlockNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState StandardCrypto -> Nonce
forall c. PraosState c -> Nonce
Consensus.praosStateLastEpochBlockNonce PraosState StandardCrypto
s
      ]

-- We wrap the individual records with Last and use Last's Semigroup instance.
-- In this instance we take the last 'Just' value or the only 'Just' value
instance Semigroup (Ledger.ShelleyPParams StrictMaybe era) where
  <> :: ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era -> ShelleyPParams StrictMaybe era
(<>) ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2 =
    let fsppMinFeeA :: StrictMaybe Coin
fsppMinFeeA = (ShelleyPParams StrictMaybe era -> StrictMaybe Coin)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Coin
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
Ledger.sppMinFeeA ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppMinFeeB :: StrictMaybe Coin
fsppMinFeeB = (ShelleyPParams StrictMaybe era -> StrictMaybe Coin)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Coin
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
Ledger.sppMinFeeB ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppMaxBBSize :: StrictMaybe NumSoftwareVersion
fsppMaxBBSize = (ShelleyPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe NumSoftwareVersion
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion
ShelleyPParams StrictMaybe era
-> HKD StrictMaybe NumSoftwareVersion
forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f NumSoftwareVersion
Ledger.sppMaxBBSize ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppMaxTxSize :: StrictMaybe NumSoftwareVersion
fsppMaxTxSize = (ShelleyPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe NumSoftwareVersion
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion
ShelleyPParams StrictMaybe era
-> HKD StrictMaybe NumSoftwareVersion
forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f NumSoftwareVersion
Ledger.sppMaxTxSize ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppMaxBHSize :: StrictMaybe Word16
fsppMaxBHSize = (ShelleyPParams StrictMaybe era -> StrictMaybe Word16)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Word16
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Word16
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Word16
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word16
Ledger.sppMaxBHSize ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppKeyDeposit :: StrictMaybe Coin
fsppKeyDeposit = (ShelleyPParams StrictMaybe era -> StrictMaybe Coin)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Coin
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
Ledger.sppKeyDeposit ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppPoolDeposit :: StrictMaybe Coin
fsppPoolDeposit = (ShelleyPParams StrictMaybe era -> StrictMaybe Coin)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Coin
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
Ledger.sppPoolDeposit ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppEMax :: StrictMaybe EpochInterval
fsppEMax = (ShelleyPParams StrictMaybe era -> StrictMaybe EpochInterval)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe EpochInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe EpochInterval
ShelleyPParams StrictMaybe era -> HKD StrictMaybe EpochInterval
forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f EpochInterval
Ledger.sppEMax ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppNOpt :: StrictMaybe Natural
fsppNOpt = (ShelleyPParams StrictMaybe era -> StrictMaybe Natural)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Natural
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Natural
Ledger.sppNOpt ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppA0 :: StrictMaybe NonNegativeInterval
fsppA0 = (ShelleyPParams StrictMaybe era -> StrictMaybe NonNegativeInterval)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe NonNegativeInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe NonNegativeInterval
ShelleyPParams StrictMaybe era
-> HKD StrictMaybe NonNegativeInterval
forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f NonNegativeInterval
Ledger.sppA0 ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppRho :: StrictMaybe UnitInterval
fsppRho = (ShelleyPParams StrictMaybe era -> StrictMaybe UnitInterval)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe UnitInterval
ShelleyPParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
Ledger.sppRho ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppTau :: StrictMaybe UnitInterval
fsppTau = (ShelleyPParams StrictMaybe era -> StrictMaybe UnitInterval)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe UnitInterval
ShelleyPParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
Ledger.sppTau ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppD :: StrictMaybe UnitInterval
fsppD = (ShelleyPParams StrictMaybe era -> StrictMaybe UnitInterval)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe UnitInterval
ShelleyPParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
Ledger.sppD ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppExtraEntropy :: StrictMaybe Nonce
fsppExtraEntropy = (ShelleyPParams StrictMaybe era -> StrictMaybe Nonce)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Nonce
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Nonce
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Nonce
Ledger.sppExtraEntropy ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppProtocolVersion :: StrictMaybe ProtVer
fsppProtocolVersion = (ShelleyPParams StrictMaybe era -> StrictMaybe ProtVer)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe ProtVer
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe ProtVer
ShelleyPParams StrictMaybe era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f ProtVer
Ledger.sppProtocolVersion ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppMinUTxOValue :: StrictMaybe Coin
fsppMinUTxOValue = (ShelleyPParams StrictMaybe era -> StrictMaybe Coin)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Coin
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
Ledger.sppMinUTxOValue ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
        fsppMinPoolCost :: StrictMaybe Coin
fsppMinPoolCost = (ShelleyPParams StrictMaybe era -> StrictMaybe Coin)
-> ShelleyPParams StrictMaybe era
-> ShelleyPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith ShelleyPParams StrictMaybe era -> StrictMaybe Coin
ShelleyPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
Ledger.sppMinPoolCost ShelleyPParams StrictMaybe era
pp1 ShelleyPParams StrictMaybe era
pp2
     in Ledger.ShelleyPParams
          { sppMinFeeA :: HKD StrictMaybe Coin
Ledger.sppMinFeeA = StrictMaybe Coin
HKD StrictMaybe Coin
fsppMinFeeA
          , sppMinFeeB :: HKD StrictMaybe Coin
Ledger.sppMinFeeB = StrictMaybe Coin
HKD StrictMaybe Coin
fsppMinFeeB
          , sppMaxBBSize :: HKD StrictMaybe NumSoftwareVersion
Ledger.sppMaxBBSize = StrictMaybe NumSoftwareVersion
HKD StrictMaybe NumSoftwareVersion
fsppMaxBBSize
          , sppMaxTxSize :: HKD StrictMaybe NumSoftwareVersion
Ledger.sppMaxTxSize = StrictMaybe NumSoftwareVersion
HKD StrictMaybe NumSoftwareVersion
fsppMaxTxSize
          , sppMaxBHSize :: HKD StrictMaybe Word16
Ledger.sppMaxBHSize = StrictMaybe Word16
HKD StrictMaybe Word16
fsppMaxBHSize
          , sppKeyDeposit :: HKD StrictMaybe Coin
Ledger.sppKeyDeposit = StrictMaybe Coin
HKD StrictMaybe Coin
fsppKeyDeposit
          , sppPoolDeposit :: HKD StrictMaybe Coin
Ledger.sppPoolDeposit = StrictMaybe Coin
HKD StrictMaybe Coin
fsppPoolDeposit
          , sppEMax :: HKD StrictMaybe EpochInterval
Ledger.sppEMax = StrictMaybe EpochInterval
HKD StrictMaybe EpochInterval
fsppEMax
          , sppNOpt :: HKD StrictMaybe Natural
Ledger.sppNOpt = StrictMaybe Natural
HKD StrictMaybe Natural
fsppNOpt
          , sppA0 :: HKD StrictMaybe NonNegativeInterval
Ledger.sppA0 = StrictMaybe NonNegativeInterval
HKD StrictMaybe NonNegativeInterval
fsppA0
          , sppRho :: HKD StrictMaybe UnitInterval
Ledger.sppRho = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fsppRho
          , sppTau :: HKD StrictMaybe UnitInterval
Ledger.sppTau = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fsppTau
          , sppD :: HKD StrictMaybe UnitInterval
Ledger.sppD = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fsppD
          , sppExtraEntropy :: HKD StrictMaybe Nonce
Ledger.sppExtraEntropy = StrictMaybe Nonce
HKD StrictMaybe Nonce
fsppExtraEntropy
          , sppProtocolVersion :: HKD StrictMaybe ProtVer
Ledger.sppProtocolVersion = StrictMaybe ProtVer
HKD StrictMaybe ProtVer
fsppProtocolVersion
          , sppMinUTxOValue :: HKD StrictMaybe Coin
Ledger.sppMinUTxOValue = StrictMaybe Coin
HKD StrictMaybe Coin
fsppMinUTxOValue
          , sppMinPoolCost :: HKD StrictMaybe Coin
Ledger.sppMinPoolCost = StrictMaybe Coin
HKD StrictMaybe Coin
fsppMinPoolCost
          }

instance Semigroup (Ledger.AlonzoPParams StrictMaybe era) where
  <> :: AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era -> AlonzoPParams StrictMaybe era
(<>) AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2 =
    let fappMinFeeA :: StrictMaybe Coin
fappMinFeeA = (AlonzoPParams StrictMaybe era -> StrictMaybe Coin)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Coin
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
Ledger.appMinFeeA AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMinFeeB :: StrictMaybe Coin
fappMinFeeB = (AlonzoPParams StrictMaybe era -> StrictMaybe Coin)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Coin
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
Ledger.appMinFeeB AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMaxBBSize :: StrictMaybe NumSoftwareVersion
fappMaxBBSize = (AlonzoPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe NumSoftwareVersion
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion
AlonzoPParams StrictMaybe era -> HKD StrictMaybe NumSoftwareVersion
forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f NumSoftwareVersion
Ledger.appMaxBBSize AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMaxTxSize :: StrictMaybe NumSoftwareVersion
fappMaxTxSize = (AlonzoPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe NumSoftwareVersion
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe NumSoftwareVersion
AlonzoPParams StrictMaybe era -> HKD StrictMaybe NumSoftwareVersion
forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f NumSoftwareVersion
Ledger.appMaxTxSize AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMaxBHSize :: StrictMaybe Word16
fappMaxBHSize = (AlonzoPParams StrictMaybe era -> StrictMaybe Word16)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Word16
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Word16
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Word16
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Word16
Ledger.appMaxBHSize AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappKeyDeposit :: StrictMaybe Coin
fappKeyDeposit = (AlonzoPParams StrictMaybe era -> StrictMaybe Coin)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Coin
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
Ledger.appKeyDeposit AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappPoolDeposit :: StrictMaybe Coin
fappPoolDeposit = (AlonzoPParams StrictMaybe era -> StrictMaybe Coin)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Coin
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
Ledger.appPoolDeposit AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappEMax :: StrictMaybe EpochInterval
fappEMax = (AlonzoPParams StrictMaybe era -> StrictMaybe EpochInterval)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe EpochInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe EpochInterval
AlonzoPParams StrictMaybe era -> HKD StrictMaybe EpochInterval
forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f EpochInterval
Ledger.appEMax AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappNOpt :: StrictMaybe Natural
fappNOpt = (AlonzoPParams StrictMaybe era -> StrictMaybe Natural)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Natural
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
Ledger.appNOpt AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappA0 :: StrictMaybe NonNegativeInterval
fappA0 = (AlonzoPParams StrictMaybe era -> StrictMaybe NonNegativeInterval)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe NonNegativeInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe NonNegativeInterval
AlonzoPParams StrictMaybe era
-> HKD StrictMaybe NonNegativeInterval
forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f NonNegativeInterval
Ledger.appA0 AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappRho :: StrictMaybe UnitInterval
fappRho = (AlonzoPParams StrictMaybe era -> StrictMaybe UnitInterval)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe UnitInterval
AlonzoPParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
Ledger.appRho AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappTau :: StrictMaybe UnitInterval
fappTau = (AlonzoPParams StrictMaybe era -> StrictMaybe UnitInterval)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe UnitInterval
AlonzoPParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
Ledger.appTau AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappD :: StrictMaybe UnitInterval
fappD = (AlonzoPParams StrictMaybe era -> StrictMaybe UnitInterval)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe UnitInterval
AlonzoPParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
Ledger.appD AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappExtraEntropy :: StrictMaybe Nonce
fappExtraEntropy = (AlonzoPParams StrictMaybe era -> StrictMaybe Nonce)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Nonce
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Nonce
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Nonce
Ledger.appExtraEntropy AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappProtocolVersion :: StrictMaybe ProtVer
fappProtocolVersion = (AlonzoPParams StrictMaybe era -> StrictMaybe ProtVer)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe ProtVer
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe ProtVer
AlonzoPParams StrictMaybe era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f ProtVer
Ledger.appProtocolVersion AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMinPoolCost :: StrictMaybe Coin
fappMinPoolCost = (AlonzoPParams StrictMaybe era -> StrictMaybe Coin)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Coin
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
Ledger.appMinPoolCost AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappCoinsPerUTxOWord :: StrictMaybe CoinPerWord
fappCoinsPerUTxOWord = (AlonzoPParams StrictMaybe era -> StrictMaybe CoinPerWord)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe CoinPerWord
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe CoinPerWord
AlonzoPParams StrictMaybe era -> HKD StrictMaybe CoinPerWord
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f CoinPerWord
Ledger.appCoinsPerUTxOWord AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappCostModels :: StrictMaybe CostModels
fappCostModels = (AlonzoPParams StrictMaybe era -> StrictMaybe CostModels)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe CostModels
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe CostModels
AlonzoPParams StrictMaybe era -> HKD StrictMaybe CostModels
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f CostModels
Ledger.appCostModels AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappPrices :: StrictMaybe Prices
fappPrices = (AlonzoPParams StrictMaybe era -> StrictMaybe Prices)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Prices
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Prices
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Prices
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Prices
Ledger.appPrices AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMaxTxExUnits :: StrictMaybe OrdExUnits
fappMaxTxExUnits = (AlonzoPParams StrictMaybe era -> StrictMaybe OrdExUnits)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe OrdExUnits
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe OrdExUnits
AlonzoPParams StrictMaybe era -> HKD StrictMaybe OrdExUnits
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f OrdExUnits
Ledger.appMaxTxExUnits AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMaxBlockExUnits :: StrictMaybe OrdExUnits
fappMaxBlockExUnits = (AlonzoPParams StrictMaybe era -> StrictMaybe OrdExUnits)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe OrdExUnits
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe OrdExUnits
AlonzoPParams StrictMaybe era -> HKD StrictMaybe OrdExUnits
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f OrdExUnits
Ledger.appMaxBlockExUnits AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMaxValSize :: StrictMaybe Natural
fappMaxValSize = (AlonzoPParams StrictMaybe era -> StrictMaybe Natural)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Natural
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
Ledger.appMaxValSize AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappCollateralPercentage :: StrictMaybe Natural
fappCollateralPercentage = (AlonzoPParams StrictMaybe era -> StrictMaybe Natural)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Natural
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
Ledger.appCollateralPercentage AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
        fappMaxCollateralInputs :: StrictMaybe Natural
fappMaxCollateralInputs = (AlonzoPParams StrictMaybe era -> StrictMaybe Natural)
-> AlonzoPParams StrictMaybe era
-> AlonzoPParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith AlonzoPParams StrictMaybe era -> StrictMaybe Natural
AlonzoPParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
Ledger.appMaxCollateralInputs AlonzoPParams StrictMaybe era
p1 AlonzoPParams StrictMaybe era
p2
     in Ledger.AlonzoPParams
          { appMinFeeA :: HKD StrictMaybe Coin
Ledger.appMinFeeA = StrictMaybe Coin
HKD StrictMaybe Coin
fappMinFeeA
          , appMinFeeB :: HKD StrictMaybe Coin
Ledger.appMinFeeB = StrictMaybe Coin
HKD StrictMaybe Coin
fappMinFeeB
          , appMaxBBSize :: HKD StrictMaybe NumSoftwareVersion
Ledger.appMaxBBSize = StrictMaybe NumSoftwareVersion
HKD StrictMaybe NumSoftwareVersion
fappMaxBBSize
          , appMaxTxSize :: HKD StrictMaybe NumSoftwareVersion
Ledger.appMaxTxSize = StrictMaybe NumSoftwareVersion
HKD StrictMaybe NumSoftwareVersion
fappMaxTxSize
          , appMaxBHSize :: HKD StrictMaybe Word16
Ledger.appMaxBHSize = StrictMaybe Word16
HKD StrictMaybe Word16
fappMaxBHSize
          , appKeyDeposit :: HKD StrictMaybe Coin
Ledger.appKeyDeposit = StrictMaybe Coin
HKD StrictMaybe Coin
fappKeyDeposit
          , appPoolDeposit :: HKD StrictMaybe Coin
Ledger.appPoolDeposit = StrictMaybe Coin
HKD StrictMaybe Coin
fappPoolDeposit
          , appEMax :: HKD StrictMaybe EpochInterval
Ledger.appEMax = StrictMaybe EpochInterval
HKD StrictMaybe EpochInterval
fappEMax
          , appNOpt :: HKD StrictMaybe Natural
Ledger.appNOpt = StrictMaybe Natural
HKD StrictMaybe Natural
fappNOpt
          , appA0 :: HKD StrictMaybe NonNegativeInterval
Ledger.appA0 = StrictMaybe NonNegativeInterval
HKD StrictMaybe NonNegativeInterval
fappA0
          , appRho :: HKD StrictMaybe UnitInterval
Ledger.appRho = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fappRho
          , appTau :: HKD StrictMaybe UnitInterval
Ledger.appTau = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fappTau
          , appD :: HKD StrictMaybe UnitInterval
Ledger.appD = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fappD
          , appExtraEntropy :: HKD StrictMaybe Nonce
Ledger.appExtraEntropy = StrictMaybe Nonce
HKD StrictMaybe Nonce
fappExtraEntropy
          , appProtocolVersion :: HKD StrictMaybe ProtVer
Ledger.appProtocolVersion = StrictMaybe ProtVer
HKD StrictMaybe ProtVer
fappProtocolVersion
          , appMinPoolCost :: HKD StrictMaybe Coin
Ledger.appMinPoolCost = StrictMaybe Coin
HKD StrictMaybe Coin
fappMinPoolCost
          , appCoinsPerUTxOWord :: HKD StrictMaybe CoinPerWord
Ledger.appCoinsPerUTxOWord = StrictMaybe CoinPerWord
HKD StrictMaybe CoinPerWord
fappCoinsPerUTxOWord
          , appCostModels :: HKD StrictMaybe CostModels
Ledger.appCostModels = StrictMaybe CostModels
HKD StrictMaybe CostModels
fappCostModels
          , appPrices :: HKD StrictMaybe Prices
Ledger.appPrices = StrictMaybe Prices
HKD StrictMaybe Prices
fappPrices
          , appMaxTxExUnits :: HKD StrictMaybe OrdExUnits
Ledger.appMaxTxExUnits = StrictMaybe OrdExUnits
HKD StrictMaybe OrdExUnits
fappMaxTxExUnits
          , appMaxBlockExUnits :: HKD StrictMaybe OrdExUnits
Ledger.appMaxBlockExUnits = StrictMaybe OrdExUnits
HKD StrictMaybe OrdExUnits
fappMaxBlockExUnits
          , appMaxValSize :: HKD StrictMaybe Natural
Ledger.appMaxValSize = StrictMaybe Natural
HKD StrictMaybe Natural
fappMaxValSize
          , appCollateralPercentage :: HKD StrictMaybe Natural
Ledger.appCollateralPercentage = StrictMaybe Natural
HKD StrictMaybe Natural
fappCollateralPercentage
          , appMaxCollateralInputs :: HKD StrictMaybe Natural
Ledger.appMaxCollateralInputs = StrictMaybe Natural
HKD StrictMaybe Natural
fappMaxCollateralInputs
          }

-- We're not interested in trying to mappend the underlying `Maybe` types
-- we only want to select one or the other therefore we use `Last`.
lastMappend :: StrictMaybe a -> StrictMaybe a -> StrictMaybe a
lastMappend :: forall a. StrictMaybe a -> StrictMaybe a -> StrictMaybe a
lastMappend StrictMaybe a
a StrictMaybe a
b = Maybe a -> StrictMaybe a
forall a. Maybe a -> StrictMaybe a
Ledger.maybeToStrictMaybe (Maybe a -> StrictMaybe a)
-> (Last a -> Maybe a) -> Last a -> StrictMaybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last a -> Maybe a
forall a. Last a -> Maybe a
getLast (Last a -> StrictMaybe a) -> Last a -> StrictMaybe a
forall a b. (a -> b) -> a -> b
$ StrictMaybe a -> Last a
forall a. StrictMaybe a -> Last a
strictMaybeToLast StrictMaybe a
a Last a -> Last a -> Last a
forall a. Semigroup a => a -> a -> a
<> StrictMaybe a -> Last a
forall a. StrictMaybe a -> Last a
strictMaybeToLast StrictMaybe a
b
 where
  strictMaybeToLast :: StrictMaybe a -> Last a
  strictMaybeToLast :: forall a. StrictMaybe a -> Last a
strictMaybeToLast = Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a)
-> (StrictMaybe a -> Maybe a) -> StrictMaybe a -> Last a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe a -> Maybe a
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe

lastMappendWith :: (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith :: forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith a -> StrictMaybe b
l = (a -> StrictMaybe b)
-> (StrictMaybe b -> StrictMaybe b -> StrictMaybe b)
-> a
-> a
-> StrictMaybe b
forall a c. (a -> c) -> (c -> c -> c) -> a -> a -> c
under2 a -> StrictMaybe b
l StrictMaybe b -> StrictMaybe b -> StrictMaybe b
forall a. StrictMaybe a -> StrictMaybe a -> StrictMaybe a
lastMappend
 where
  under2 :: (a -> c) -> (c -> c -> c) -> a -> a -> c
  under2 :: forall a c. (a -> c) -> (c -> c -> c) -> a -> a -> c
under2 a -> c
f c -> c -> c
g a
x a
y = c -> c -> c
g (a -> c
f a
x) (a -> c
f a
y)

instance Semigroup (Ledger.BabbagePParams StrictMaybe era) where
  <> :: BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era -> BabbagePParams StrictMaybe era
(<>) BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2 =
    let fbppMinFeeA :: StrictMaybe Coin
fbppMinFeeA = (BabbagePParams StrictMaybe era -> StrictMaybe Coin)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Coin
BabbagePParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
Ledger.bppMinFeeA BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMinFeeB :: StrictMaybe Coin
fbppMinFeeB = (BabbagePParams StrictMaybe era -> StrictMaybe Coin)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Coin
BabbagePParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
Ledger.bppMinFeeB BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMaxBBSize :: StrictMaybe NumSoftwareVersion
fbppMaxBBSize = (BabbagePParams StrictMaybe era -> StrictMaybe NumSoftwareVersion)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe NumSoftwareVersion
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe NumSoftwareVersion
BabbagePParams StrictMaybe era
-> HKD StrictMaybe NumSoftwareVersion
forall (f :: * -> *) era.
BabbagePParams f era -> HKD f NumSoftwareVersion
Ledger.bppMaxBBSize BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMaxTxSize :: StrictMaybe NumSoftwareVersion
fbppMaxTxSize = (BabbagePParams StrictMaybe era -> StrictMaybe NumSoftwareVersion)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe NumSoftwareVersion
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe NumSoftwareVersion
BabbagePParams StrictMaybe era
-> HKD StrictMaybe NumSoftwareVersion
forall (f :: * -> *) era.
BabbagePParams f era -> HKD f NumSoftwareVersion
Ledger.bppMaxTxSize BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMaxBHSize :: StrictMaybe Word16
fbppMaxBHSize = (BabbagePParams StrictMaybe era -> StrictMaybe Word16)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Word16
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Word16
BabbagePParams StrictMaybe era -> HKD StrictMaybe Word16
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Word16
Ledger.bppMaxBHSize BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppKeyDeposit :: StrictMaybe Coin
fbppKeyDeposit = (BabbagePParams StrictMaybe era -> StrictMaybe Coin)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Coin
BabbagePParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
Ledger.bppKeyDeposit BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppPoolDeposit :: StrictMaybe Coin
fbppPoolDeposit = (BabbagePParams StrictMaybe era -> StrictMaybe Coin)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Coin
BabbagePParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
Ledger.bppPoolDeposit BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppEMax :: StrictMaybe EpochInterval
fbppEMax = (BabbagePParams StrictMaybe era -> StrictMaybe EpochInterval)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe EpochInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe EpochInterval
BabbagePParams StrictMaybe era -> HKD StrictMaybe EpochInterval
forall (f :: * -> *) era.
BabbagePParams f era -> HKD f EpochInterval
Ledger.bppEMax BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppNOpt :: StrictMaybe Natural
fbppNOpt = (BabbagePParams StrictMaybe era -> StrictMaybe Natural)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Natural
BabbagePParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
Ledger.bppNOpt BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppA0 :: StrictMaybe NonNegativeInterval
fbppA0 = (BabbagePParams StrictMaybe era -> StrictMaybe NonNegativeInterval)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe NonNegativeInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe NonNegativeInterval
BabbagePParams StrictMaybe era
-> HKD StrictMaybe NonNegativeInterval
forall (f :: * -> *) era.
BabbagePParams f era -> HKD f NonNegativeInterval
Ledger.bppA0 BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppRho :: StrictMaybe UnitInterval
fbppRho = (BabbagePParams StrictMaybe era -> StrictMaybe UnitInterval)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe UnitInterval
BabbagePParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era.
BabbagePParams f era -> HKD f UnitInterval
Ledger.bppRho BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppTau :: StrictMaybe UnitInterval
fbppTau = (BabbagePParams StrictMaybe era -> StrictMaybe UnitInterval)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe UnitInterval
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe UnitInterval
BabbagePParams StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era.
BabbagePParams f era -> HKD f UnitInterval
Ledger.bppTau BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppProtocolVersion :: StrictMaybe ProtVer
fbppProtocolVersion = (BabbagePParams StrictMaybe era -> StrictMaybe ProtVer)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe ProtVer
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe ProtVer
BabbagePParams StrictMaybe era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. BabbagePParams f era -> HKD f ProtVer
Ledger.bppProtocolVersion BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMinPoolCost :: StrictMaybe Coin
fbppMinPoolCost = (BabbagePParams StrictMaybe era -> StrictMaybe Coin)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Coin
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Coin
BabbagePParams StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
Ledger.bppMinPoolCost BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppCoinsPerUTxOByte :: StrictMaybe CoinPerByte
fbppCoinsPerUTxOByte = (BabbagePParams StrictMaybe era -> StrictMaybe CoinPerByte)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe CoinPerByte
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe CoinPerByte
BabbagePParams StrictMaybe era -> HKD StrictMaybe CoinPerByte
forall (f :: * -> *) era. BabbagePParams f era -> HKD f CoinPerByte
Ledger.bppCoinsPerUTxOByte BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppCostModels :: StrictMaybe CostModels
fbppCostModels = (BabbagePParams StrictMaybe era -> StrictMaybe CostModels)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe CostModels
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe CostModels
BabbagePParams StrictMaybe era -> HKD StrictMaybe CostModels
forall (f :: * -> *) era. BabbagePParams f era -> HKD f CostModels
Ledger.bppCostModels BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppPrices :: StrictMaybe Prices
fbppPrices = (BabbagePParams StrictMaybe era -> StrictMaybe Prices)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Prices
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Prices
BabbagePParams StrictMaybe era -> HKD StrictMaybe Prices
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Prices
Ledger.bppPrices BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMaxTxExUnits :: StrictMaybe OrdExUnits
fbppMaxTxExUnits = (BabbagePParams StrictMaybe era -> StrictMaybe OrdExUnits)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe OrdExUnits
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe OrdExUnits
BabbagePParams StrictMaybe era -> HKD StrictMaybe OrdExUnits
forall (f :: * -> *) era. BabbagePParams f era -> HKD f OrdExUnits
Ledger.bppMaxTxExUnits BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMaxBlockExUnits :: StrictMaybe OrdExUnits
fbppMaxBlockExUnits = (BabbagePParams StrictMaybe era -> StrictMaybe OrdExUnits)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe OrdExUnits
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe OrdExUnits
BabbagePParams StrictMaybe era -> HKD StrictMaybe OrdExUnits
forall (f :: * -> *) era. BabbagePParams f era -> HKD f OrdExUnits
Ledger.bppMaxBlockExUnits BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMaxValSize :: StrictMaybe Natural
fbppMaxValSize = (BabbagePParams StrictMaybe era -> StrictMaybe Natural)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Natural
BabbagePParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
Ledger.bppMaxValSize BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppCollateralPercentage :: StrictMaybe Natural
fbppCollateralPercentage = (BabbagePParams StrictMaybe era -> StrictMaybe Natural)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Natural
BabbagePParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
Ledger.bppCollateralPercentage BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
        fbppMaxCollateralInputs :: StrictMaybe Natural
fbppMaxCollateralInputs = (BabbagePParams StrictMaybe era -> StrictMaybe Natural)
-> BabbagePParams StrictMaybe era
-> BabbagePParams StrictMaybe era
-> StrictMaybe Natural
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith BabbagePParams StrictMaybe era -> StrictMaybe Natural
BabbagePParams StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
Ledger.bppMaxCollateralInputs BabbagePParams StrictMaybe era
p1 BabbagePParams StrictMaybe era
p2
     in Ledger.BabbagePParams
          { bppMinFeeA :: HKD StrictMaybe Coin
Ledger.bppMinFeeA = StrictMaybe Coin
HKD StrictMaybe Coin
fbppMinFeeA
          , bppMinFeeB :: HKD StrictMaybe Coin
Ledger.bppMinFeeB = StrictMaybe Coin
HKD StrictMaybe Coin
fbppMinFeeB
          , bppMaxBBSize :: HKD StrictMaybe NumSoftwareVersion
Ledger.bppMaxBBSize = StrictMaybe NumSoftwareVersion
HKD StrictMaybe NumSoftwareVersion
fbppMaxBBSize
          , bppMaxTxSize :: HKD StrictMaybe NumSoftwareVersion
Ledger.bppMaxTxSize = StrictMaybe NumSoftwareVersion
HKD StrictMaybe NumSoftwareVersion
fbppMaxTxSize
          , bppMaxBHSize :: HKD StrictMaybe Word16
Ledger.bppMaxBHSize = StrictMaybe Word16
HKD StrictMaybe Word16
fbppMaxBHSize
          , bppKeyDeposit :: HKD StrictMaybe Coin
Ledger.bppKeyDeposit = StrictMaybe Coin
HKD StrictMaybe Coin
fbppKeyDeposit
          , bppPoolDeposit :: HKD StrictMaybe Coin
Ledger.bppPoolDeposit = StrictMaybe Coin
HKD StrictMaybe Coin
fbppPoolDeposit
          , bppEMax :: HKD StrictMaybe EpochInterval
Ledger.bppEMax = StrictMaybe EpochInterval
HKD StrictMaybe EpochInterval
fbppEMax
          , bppNOpt :: HKD StrictMaybe Natural
Ledger.bppNOpt = StrictMaybe Natural
HKD StrictMaybe Natural
fbppNOpt
          , bppA0 :: HKD StrictMaybe NonNegativeInterval
Ledger.bppA0 = StrictMaybe NonNegativeInterval
HKD StrictMaybe NonNegativeInterval
fbppA0
          , bppRho :: HKD StrictMaybe UnitInterval
Ledger.bppRho = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fbppRho
          , bppTau :: HKD StrictMaybe UnitInterval
Ledger.bppTau = StrictMaybe UnitInterval
HKD StrictMaybe UnitInterval
fbppTau
          , bppProtocolVersion :: HKD StrictMaybe ProtVer
Ledger.bppProtocolVersion = StrictMaybe ProtVer
HKD StrictMaybe ProtVer
fbppProtocolVersion
          , bppMinPoolCost :: HKD StrictMaybe Coin
Ledger.bppMinPoolCost = StrictMaybe Coin
HKD StrictMaybe Coin
fbppMinPoolCost
          , bppCoinsPerUTxOByte :: HKD StrictMaybe CoinPerByte
Ledger.bppCoinsPerUTxOByte = StrictMaybe CoinPerByte
HKD StrictMaybe CoinPerByte
fbppCoinsPerUTxOByte
          , bppCostModels :: HKD StrictMaybe CostModels
Ledger.bppCostModels = StrictMaybe CostModels
HKD StrictMaybe CostModels
fbppCostModels
          , bppPrices :: HKD StrictMaybe Prices
Ledger.bppPrices = StrictMaybe Prices
HKD StrictMaybe Prices
fbppPrices
          , bppMaxTxExUnits :: HKD StrictMaybe OrdExUnits
Ledger.bppMaxTxExUnits = StrictMaybe OrdExUnits
HKD StrictMaybe OrdExUnits
fbppMaxTxExUnits
          , bppMaxBlockExUnits :: HKD StrictMaybe OrdExUnits
Ledger.bppMaxBlockExUnits = StrictMaybe OrdExUnits
HKD StrictMaybe OrdExUnits
fbppMaxBlockExUnits
          , bppMaxValSize :: HKD StrictMaybe Natural
Ledger.bppMaxValSize = StrictMaybe Natural
HKD StrictMaybe Natural
fbppMaxValSize
          , bppCollateralPercentage :: HKD StrictMaybe Natural
Ledger.bppCollateralPercentage = StrictMaybe Natural
HKD StrictMaybe Natural
fbppCollateralPercentage
          , bppMaxCollateralInputs :: HKD StrictMaybe Natural
Ledger.bppMaxCollateralInputs = StrictMaybe Natural
HKD StrictMaybe Natural
fbppMaxCollateralInputs
          }

instance Semigroup (Ledger.ConwayPParams StrictMaybe era) where
  <> :: ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era -> ConwayPParams StrictMaybe era
(<>) ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2 =
    Ledger.ConwayPParams
      { cppMinFeeA :: THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin
Ledger.cppMinFeeA = (ConwayPParams StrictMaybe era
 -> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) f Coin
Ledger.cppMinFeeA ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMinFeeB :: THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin
Ledger.cppMinFeeB = (ConwayPParams StrictMaybe era
 -> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe Coin
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) f Coin
Ledger.cppMinFeeB ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMaxBBSize :: THKD
  ('PPGroups 'NetworkGroup 'SecurityGroup)
  StrictMaybe
  NumSoftwareVersion
Ledger.cppMaxBBSize = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'NetworkGroup 'SecurityGroup)
      StrictMaybe
      NumSoftwareVersion)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup)
     StrictMaybe
     NumSoftwareVersion
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup)
     StrictMaybe
     NumSoftwareVersion
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup) f NumSoftwareVersion
Ledger.cppMaxBBSize ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMaxTxSize :: THKD
  ('PPGroups 'NetworkGroup 'SecurityGroup)
  StrictMaybe
  NumSoftwareVersion
Ledger.cppMaxTxSize = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'NetworkGroup 'SecurityGroup)
      StrictMaybe
      NumSoftwareVersion)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup)
     StrictMaybe
     NumSoftwareVersion
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup)
     StrictMaybe
     NumSoftwareVersion
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup) f NumSoftwareVersion
Ledger.cppMaxTxSize ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMaxBHSize :: THKD ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe Word16
Ledger.cppMaxBHSize = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe Word16)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe Word16
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe Word16
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'NetworkGroup 'SecurityGroup) f Word16
Ledger.cppMaxBHSize ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppKeyDeposit :: THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
Ledger.cppKeyDeposit = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f Coin
Ledger.cppKeyDeposit ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppPoolDeposit :: THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
Ledger.cppPoolDeposit = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f Coin
Ledger.cppPoolDeposit ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppEMax :: THKD
  ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
  StrictMaybe
  EpochInterval
Ledger.cppEMax = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
      StrictMaybe
      EpochInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
     StrictMaybe
     EpochInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
     StrictMaybe
     EpochInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) f EpochInterval
Ledger.cppEMax ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppNOpt :: THKD
  ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16
Ledger.cppNOpt = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) f Word16
Ledger.cppNOpt ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppA0 :: THKD
  ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
  StrictMaybe
  NonNegativeInterval
Ledger.cppA0 = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
      StrictMaybe
      NonNegativeInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
     StrictMaybe
     NonNegativeInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
     StrictMaybe
     NonNegativeInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) f NonNegativeInterval
Ledger.cppA0 ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppRho :: THKD
  ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
  StrictMaybe
  UnitInterval
Ledger.cppRho = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
      StrictMaybe
      UnitInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
     StrictMaybe
     UnitInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
     StrictMaybe
     UnitInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f UnitInterval
Ledger.cppRho ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppTau :: THKD
  ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
  StrictMaybe
  UnitInterval
Ledger.cppTau = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
      StrictMaybe
      UnitInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
     StrictMaybe
     UnitInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup)
     StrictMaybe
     UnitInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f UnitInterval
Ledger.cppTau ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppProtocolVersion :: HKDNoUpdate StrictMaybe ProtVer
Ledger.cppProtocolVersion = HKDNoUpdate StrictMaybe ProtVer
NoUpdate ProtVer
forall a. NoUpdate a
NoUpdate -- For conway, protocol version cannot be changed via `PParamsUpdate`
      , cppMinPoolCost :: THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
Ledger.cppMinPoolCost = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Coin
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f Coin
Ledger.cppMinPoolCost ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppCoinsPerUTxOByte :: THKD
  ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe CoinPerByte
Ledger.cppCoinsPerUTxOByte = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe CoinPerByte)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe CoinPerByte
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'SecurityGroup) StrictMaybe CoinPerByte
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'SecurityGroup) f CoinPerByte
Ledger.cppCoinsPerUTxOByte ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppCostModels :: THKD
  ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
  StrictMaybe
  CostModels
Ledger.cppCostModels = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
      StrictMaybe
      CostModels)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
     StrictMaybe
     CostModels
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup)
     StrictMaybe
     CostModels
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) f CostModels
Ledger.cppCostModels ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppPrices :: THKD
  ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Prices
Ledger.cppPrices = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Prices)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Prices
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'NoStakePoolGroup) StrictMaybe Prices
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'EconomicGroup 'NoStakePoolGroup) f Prices
Ledger.cppPrices ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMaxTxExUnits :: THKD
  ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe OrdExUnits
Ledger.cppMaxTxExUnits = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe OrdExUnits)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe OrdExUnits
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe OrdExUnits
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'NetworkGroup 'NoStakePoolGroup) f OrdExUnits
Ledger.cppMaxTxExUnits ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMaxBlockExUnits :: THKD
  ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe OrdExUnits
Ledger.cppMaxBlockExUnits = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe OrdExUnits)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe OrdExUnits
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup) StrictMaybe OrdExUnits
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'NetworkGroup 'SecurityGroup) f OrdExUnits
Ledger.cppMaxBlockExUnits ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMaxValSize :: THKD
  ('PPGroups 'NetworkGroup 'SecurityGroup)
  StrictMaybe
  NumSoftwareVersion
Ledger.cppMaxValSize = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'NetworkGroup 'SecurityGroup)
      StrictMaybe
      NumSoftwareVersion)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup)
     StrictMaybe
     NumSoftwareVersion
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup)
     StrictMaybe
     NumSoftwareVersion
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'NetworkGroup 'SecurityGroup) f NumSoftwareVersion
Ledger.cppMaxValSize ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppCollateralPercentage :: THKD
  ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16
Ledger.cppCollateralPercentage = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) StrictMaybe Word16
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'TechnicalGroup 'NoStakePoolGroup) f Word16
Ledger.cppCollateralPercentage ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMaxCollateralInputs :: THKD ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe Word16
Ledger.cppMaxCollateralInputs = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe Word16)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe Word16
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'NetworkGroup 'NoStakePoolGroup) StrictMaybe Word16
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'NetworkGroup 'NoStakePoolGroup) f Word16
Ledger.cppMaxCollateralInputs ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppPoolVotingThresholds :: THKD
  ('PPGroups 'GovGroup 'NoStakePoolGroup)
  StrictMaybe
  PoolVotingThresholds
Ledger.cppPoolVotingThresholds = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'GovGroup 'NoStakePoolGroup)
      StrictMaybe
      PoolVotingThresholds)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup)
     StrictMaybe
     PoolVotingThresholds
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup)
     StrictMaybe
     PoolVotingThresholds
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) f PoolVotingThresholds
Ledger.cppPoolVotingThresholds ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppDRepVotingThresholds :: THKD
  ('PPGroups 'GovGroup 'NoStakePoolGroup)
  StrictMaybe
  DRepVotingThresholds
Ledger.cppDRepVotingThresholds = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'GovGroup 'NoStakePoolGroup)
      StrictMaybe
      DRepVotingThresholds)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup)
     StrictMaybe
     DRepVotingThresholds
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup)
     StrictMaybe
     DRepVotingThresholds
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) f DRepVotingThresholds
Ledger.cppDRepVotingThresholds ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppCommitteeMinSize :: THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Word16
Ledger.cppCommitteeMinSize = (ConwayPParams StrictMaybe era
 -> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Word16)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Word16
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Word16
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f Word16
Ledger.cppCommitteeMinSize ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppCommitteeMaxTermLength :: THKD
  ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
Ledger.cppCommitteeMaxTermLength = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f EpochInterval
Ledger.cppCommitteeMaxTermLength ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppGovActionLifetime :: THKD
  ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
Ledger.cppGovActionLifetime = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f EpochInterval
Ledger.cppGovActionLifetime ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppGovActionDeposit :: THKD ('PPGroups 'GovGroup 'SecurityGroup) StrictMaybe Coin
Ledger.cppGovActionDeposit = (ConwayPParams StrictMaybe era
 -> THKD ('PPGroups 'GovGroup 'SecurityGroup) StrictMaybe Coin)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'GovGroup 'SecurityGroup) StrictMaybe Coin
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'GovGroup 'SecurityGroup) StrictMaybe Coin
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'GovGroup 'SecurityGroup) f Coin
Ledger.cppGovActionDeposit ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppDRepDeposit :: THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Coin
Ledger.cppDRepDeposit = (ConwayPParams StrictMaybe era
 -> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Coin)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Coin
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe Coin
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f Coin
Ledger.cppDRepDeposit ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppDRepActivity :: THKD
  ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
Ledger.cppDRepActivity = (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'GovGroup 'NoStakePoolGroup) StrictMaybe EpochInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD ('PPGroups 'GovGroup 'NoStakePoolGroup) f EpochInterval
Ledger.cppDRepActivity ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      , cppMinFeeRefScriptCostPerByte :: THKD
  ('PPGroups 'EconomicGroup 'SecurityGroup)
  StrictMaybe
  NonNegativeInterval
Ledger.cppMinFeeRefScriptCostPerByte =
          (ConwayPParams StrictMaybe era
 -> THKD
      ('PPGroups 'EconomicGroup 'SecurityGroup)
      StrictMaybe
      NonNegativeInterval)
-> ConwayPParams StrictMaybe era
-> ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'SecurityGroup)
     StrictMaybe
     NonNegativeInterval
forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD ConwayPParams StrictMaybe era
-> THKD
     ('PPGroups 'EconomicGroup 'SecurityGroup)
     StrictMaybe
     NonNegativeInterval
forall (f :: * -> *) era.
ConwayPParams f era
-> THKD
     ('PPGroups 'EconomicGroup 'SecurityGroup) f NonNegativeInterval
Ledger.cppMinFeeRefScriptCostPerByte ConwayPParams StrictMaybe era
p1 ConwayPParams StrictMaybe era
p2
      }

lastMappendWithTHKD :: (a -> Ledger.THKD g StrictMaybe b) -> a -> a -> Ledger.THKD g StrictMaybe b
lastMappendWithTHKD :: forall a (g :: PPGroups) b.
(a -> THKD g StrictMaybe b) -> a -> a -> THKD g StrictMaybe b
lastMappendWithTHKD a -> THKD g StrictMaybe b
f a
a a
b = HKD StrictMaybe b -> THKD g StrictMaybe b
forall (t :: PPGroups) (f :: * -> *) a. HKD f a -> THKD t f a
Ledger.THKD (HKD StrictMaybe b -> THKD g StrictMaybe b)
-> HKD StrictMaybe b -> THKD g StrictMaybe b
forall a b. (a -> b) -> a -> b
$ (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
forall a b. (a -> StrictMaybe b) -> a -> a -> StrictMaybe b
lastMappendWith (THKD g StrictMaybe b -> StrictMaybe b
THKD g StrictMaybe b -> HKD StrictMaybe b
forall (t :: PPGroups) (f :: * -> *) a. THKD t f a -> HKD f a
Ledger.unTHKD (THKD g StrictMaybe b -> StrictMaybe b)
-> (a -> THKD g StrictMaybe b) -> a -> StrictMaybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> THKD g StrictMaybe b
f) a
a a
b

instance Pretty MuxError where
  pretty :: forall ann. MuxError -> Doc ann
pretty MuxError
err = Doc ann
"Mux layer error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MuxError -> Doc ann
forall a ann. Exception a => a -> Doc ann
prettyException MuxError
err

instance A.FromJSON V2.ParamName where
  parseJSON :: Value -> Parser ParamName
parseJSON = String -> (Text -> Parser ParamName) -> Value -> Parser ParamName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"ParamName" Text -> Parser ParamName
forall a (f :: * -> *). (IsParamName a, MonadFail f) => Text -> f a
parsePlutusParamName

instance A.FromJSONKey V2.ParamName where
  fromJSONKey :: FromJSONKeyFunction ParamName
fromJSONKey = (Text -> Parser ParamName) -> FromJSONKeyFunction ParamName
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
A.FromJSONKeyTextParser Text -> Parser ParamName
forall a (f :: * -> *). (IsParamName a, MonadFail f) => Text -> f a
parsePlutusParamName

parsePlutusParamName :: (P.IsParamName a, MonadFail f) => T.Text -> f a
parsePlutusParamName :: forall a (f :: * -> *). (IsParamName a, MonadFail f) => Text -> f a
parsePlutusParamName Text
t =
  case Text -> Maybe a
forall a. IsParamName a => Text -> Maybe a
P.readParamName Text
t of
    Just a
p -> a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
p
    Maybe a
Nothing -> String -> f a
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f a) -> String -> f a
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse cost model parameter name: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

deriving instance Show V2.ParamName

-- TODO upstream to cardano-ledger
instance IsList (ListMap k a) where
  type Item (ListMap k a) = (k, a)
  fromList :: [Item (ListMap k a)] -> ListMap k a
fromList = [(k, a)] -> ListMap k a
[Item (ListMap k a)] -> ListMap k a
forall k v. [(k, v)] -> ListMap k v
ListMap.fromList
  toList :: ListMap k a -> [Item (ListMap k a)]
toList = ListMap k a -> [(k, a)]
ListMap k a -> [Item (ListMap k a)]
forall k v. ListMap k v -> [(k, v)]
ListMap.toList