{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-x-ord-preserving-coercions #-}
#if __GLASGOW_HASKELL__ < 908
{-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-}
#endif

-- | Shelley mempool integration
--
-- TODO nearly all of the logic in this module belongs in cardano-ledger, not
-- ouroboros-consensus; ouroboros-consensus-cardano should just be "glue code".
module Ouroboros.Consensus.Shelley.Ledger.Mempool
  ( GenTx (..)
  , SL.ApplyTxError (..)
  , TxId (..)
  , DijkstraEbMeasure (..)
  , Validated (..)
  , fixedBlockBodyOverhead
  , mkShelleyTx
  , mkShelleyValidatedTx
  , perTxOverhead

    -- * Exported for tests
  , AlonzoMeasure (..)
  , RefScriptSize (..)
  , fromExUnits
  ) where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Allegra (ApplyTxError (AllegraApplyTxError))
import qualified Cardano.Ledger.Allegra.Rules as AllegraEra
import Cardano.Ledger.Alonzo (ApplyTxError (AlonzoApplyTxError))
import Cardano.Ledger.Alonzo.Core
  ( BlockBody
  , TopTx
  , Tx
  , allInputsTxBodyF
  , bodyTxL
  , eraDecoder
  , ppMaxBBSizeL
  , ppMaxBlockExUnitsL
  , sizeTxF
  , txIdTx
  , txSeqBlockBodyL
  , wireSizeTxF
  )
import qualified Cardano.Ledger.Alonzo.Rules as AlonzoEra
import Cardano.Ledger.Alonzo.Scripts
  ( ExUnits
  , ExUnits' (..)
  , pointWiseExUnits
  , unWrapExUnits
  )
import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (getTotalExUnits))
import qualified Cardano.Ledger.Api as L
import Cardano.Ledger.Babbage (ApplyTxError (BabbageApplyTxError))
import qualified Cardano.Ledger.Babbage.Rules as BabbageEra
import qualified Cardano.Ledger.BaseTypes as L
import Cardano.Ledger.Binary
  ( Annotator (..)
  , DecCBOR (..)
  , EncCBOR (..)
  , FromCBOR (..)
  , FullByteString (..)
  , ToCBOR (..)
  )
import Cardano.Ledger.Conway (ApplyTxError (ConwayApplyTxError))
import qualified Cardano.Ledger.Conway.PParams as SL
import qualified Cardano.Ledger.Conway.Rules as ConwayEra
import qualified Cardano.Ledger.Conway.UTxO as SL
import Cardano.Ledger.Dijkstra (ApplyTxError (DijkstraApplyTxError))
import Cardano.Ledger.Dijkstra.PParams
  ( ppMaxEndorserBlockExUnitsL
  , ppMaxEndorserBlockReferencesSizeL
  , ppMaxEndorserBlockTxsSizeL
  , ppMaxRefScriptSizePerEndorserBlockL
  )
import qualified Cardano.Ledger.Dijkstra.Rules as DijkstraEra
import qualified Cardano.Ledger.Hashes as SL
import Cardano.Ledger.Mary (ApplyTxError (MaryApplyTxError))
import Cardano.Ledger.Plutus.ExUnits (OrdExUnits (..))
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Rules as ShelleyEra
import Cardano.Protocol.Crypto (Crypto)
import Control.Arrow ((+++))
import Control.Monad (guard)
import Control.Monad.Except (Except, liftEither)
import Control.Monad.Identity (Identity (..))
import Data.ByteString.Short (ShortByteString)
import Data.DerivingVia (InstantiatedAt (..))
import Data.Foldable (toList)
import Data.Measure (Measure, zero)
import Data.Typeable (Typeable)
import qualified Data.Validation as V
import Data.Word (Word32)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)
import NoThunks.Class (NoThunks (..), allNoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.Tables.Utils
import qualified Ouroboros.Consensus.Leios.Types as Leios
import Ouroboros.Consensus.Protocol.Praos2 (Praos2)
import Ouroboros.Consensus.Shelley.Eras
import Ouroboros.Consensus.Shelley.Ledger.Block
import Ouroboros.Consensus.Shelley.Ledger.Ledger
  ( BigEndianTxIn (..)
  , ShelleyLedgerConfig (shelleyLedgerGlobals)
  , Ticked (TickedShelleyLedgerState, tickedShelleyLedgerState)
  , getPParams
  )
import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
import Ouroboros.Consensus.Util (ShowProxy (..), coerceMapKeys, coerceSet)
import Ouroboros.Consensus.Util.Condense
import Ouroboros.Network.Block (unwrapCBORinCBOR, wrapCBORinCBOR)
import Ouroboros.Network.SizeInBytes
import Ouroboros.Network.Tx (HasRawTxId (..))

data instance GenTx (ShelleyBlock proto era) = ShelleyTx !SL.TxId !(Tx TopTx era)
  deriving stock (forall x.
 GenTx (ShelleyBlock proto era)
 -> Rep (GenTx (ShelleyBlock proto era)) x)
-> (forall x.
    Rep (GenTx (ShelleyBlock proto era)) x
    -> GenTx (ShelleyBlock proto era))
-> Generic (GenTx (ShelleyBlock proto era))
forall x.
Rep (GenTx (ShelleyBlock proto era)) x
-> GenTx (ShelleyBlock proto era)
forall x.
GenTx (ShelleyBlock proto era)
-> Rep (GenTx (ShelleyBlock proto era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall proto era x.
Rep (GenTx (ShelleyBlock proto era)) x
-> GenTx (ShelleyBlock proto era)
forall proto era x.
GenTx (ShelleyBlock proto era)
-> Rep (GenTx (ShelleyBlock proto era)) x
$cfrom :: forall proto era x.
GenTx (ShelleyBlock proto era)
-> Rep (GenTx (ShelleyBlock proto era)) x
from :: forall x.
GenTx (ShelleyBlock proto era)
-> Rep (GenTx (ShelleyBlock proto era)) x
$cto :: forall proto era x.
Rep (GenTx (ShelleyBlock proto era)) x
-> GenTx (ShelleyBlock proto era)
to :: forall x.
Rep (GenTx (ShelleyBlock proto era)) x
-> GenTx (ShelleyBlock proto era)
Generic

deriving instance ShelleyBasedEra era => NoThunks (GenTx (ShelleyBlock proto era))

deriving instance ShelleyBasedEra era => Eq (GenTx (ShelleyBlock proto era))

instance
  (Typeable era, Typeable proto) =>
  ShowProxy (GenTx (ShelleyBlock proto era))

data instance Validated (GenTx (ShelleyBlock proto era))
  = ShelleyValidatedTx
      !SL.TxId
      !(SL.ValidatedTx era)

-- We cannot use @deriving stock@ or @deriving instance@ for these instances
-- because 'SL.ValidatedTx' wraps 'SL.StAnnTx', a type family whose Dijkstra
-- instance ('DijkstraStAnnTx') contains 'TxInfoResult', which holds function
-- values. Function types admit no 'Show', 'Eq', or 'NoThunks' instances.
-- Instead we write manual instances that either delegate to the underlying
-- transaction (extracted via 'SL.extractValidatedTx') or ignore the
-- validated-tx payload entirely when it is not needed.

instance ShelleyBasedEra era => NoThunks (Validated (GenTx (ShelleyBlock proto era))) where
  showTypeOf :: Proxy (Validated (GenTx (ShelleyBlock proto era))) -> String
showTypeOf Proxy (Validated (GenTx (ShelleyBlock proto era)))
_ = String
"Validated (GenTx (ShelleyBlock proto era))"
  wNoThunks :: Context
-> Validated (GenTx (ShelleyBlock proto era))
-> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (ShelleyValidatedTx TxId
txid ValidatedTx era
vtx) =
    [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
      [ Context -> TxId -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt TxId
txid
      , Context -> Tx TopTx era -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (ValidatedTx era -> Tx TopTx era
forall era. EraTx era => ValidatedTx era -> Tx TopTx era
SL.extractValidatedTx ValidatedTx era
vtx)
      ]

instance ShelleyBasedEra era => Eq (Validated (GenTx (ShelleyBlock proto era))) where
  ShelleyValidatedTx TxId
txid1 ValidatedTx era
_ == :: Validated (GenTx (ShelleyBlock proto era))
-> Validated (GenTx (ShelleyBlock proto era)) -> Bool
== ShelleyValidatedTx TxId
txid2 ValidatedTx era
_ = TxId
txid1 TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxId
txid2

instance ShelleyBasedEra era => Show (Validated (GenTx (ShelleyBlock proto era))) where
  show :: Validated (GenTx (ShelleyBlock proto era)) -> String
show (ShelleyValidatedTx TxId
txid ValidatedTx era
vtx) =
    String
"(ShelleyValidatedTx " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxId -> String
forall a. Show a => a -> String
show TxId
txid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tx TopTx era -> String
forall a. Show a => a -> String
show (ValidatedTx era -> Tx TopTx era
forall era. EraTx era => ValidatedTx era -> Tx TopTx era
SL.extractValidatedTx ValidatedTx era
vtx) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance
  (Typeable era, Typeable proto) =>
  ShowProxy (Validated (GenTx (ShelleyBlock proto era)))

type instance ApplyTxErr (ShelleyBlock proto era) = SL.ApplyTxError era

-- orphaned instance
instance Typeable era => ShowProxy (SL.ApplyTxError era)

-- | 'txInBlockSize' is used to estimate how many transactions we can grab from
--  the Mempool to put into the block we are going to forge without exceeding
--  the maximum block body size according to the ledger. If we exceed that
--  limit, we will have forged a block that is invalid according to the ledger.
--  We ourselves won't even adopt it, causing us to lose our slot, something we
--  must try to avoid.
--
--  For this reason it is better to overestimate the size of a transaction than
--  to underestimate. The only downside is that we maybe could have put one (or
--  more?) transactions extra in that block.
--
--  As the sum of the serialised transaction sizes is not equal to the size of
--  the serialised block body ('BlockBody') consisting of those transactions
--  (see cardano-node#1545 for an example), we account for some extra overhead
--  per transaction as a safety margin.
--
--  Also see 'perTxOverhead'.
fixedBlockBodyOverhead :: Num a => a
fixedBlockBodyOverhead :: forall a. Num a => a
fixedBlockBodyOverhead = a
1024

-- | See 'fixedBlockBodyOverhead'.
perTxOverhead :: Num a => a
perTxOverhead :: forall a. Num a => a
perTxOverhead = a
4

instance
  (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era)) =>
  LedgerSupportsMempool (ShelleyBlock proto era)
  where
  txInvariant :: GenTx (ShelleyBlock proto era) -> Bool
txInvariant = Bool -> GenTx (ShelleyBlock proto era) -> Bool
forall a b. a -> b -> a
const Bool
True

  applyTx :: LedgerConfig (ShelleyBlock proto era)
-> WhetherToIntervene
-> SlotNo
-> GenTx (ShelleyBlock proto era)
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) DiffMK,
      Validated (GenTx (ShelleyBlock proto era)))
applyTx = LedgerConfig (ShelleyBlock proto era)
-> WhetherToIntervene
-> SlotNo
-> GenTx (ShelleyBlock proto era)
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) DiffMK,
      Validated (GenTx (ShelleyBlock proto era)))
forall era proto.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock proto era)
-> WhetherToIntervene
-> SlotNo
-> GenTx (ShelleyBlock proto era)
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) DiffMK,
      Validated (GenTx (ShelleyBlock proto era)))
applyShelleyTx

  reapplyTx :: HasCallStack =>
LedgerConfig (ShelleyBlock proto era)
-> SlotNo
-> Validated (GenTx (ShelleyBlock proto era))
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) ValuesMK)
reapplyTx = LedgerConfig (ShelleyBlock proto era)
-> SlotNo
-> Validated (GenTx (ShelleyBlock proto era))
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) ValuesMK)
forall era proto.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock proto era)
-> SlotNo
-> Validated (GenTx (ShelleyBlock proto era))
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) ValuesMK)
reapplyShelleyTx

  txForgetValidated :: Validated (GenTx (ShelleyBlock proto era))
-> GenTx (ShelleyBlock proto era)
txForgetValidated (ShelleyValidatedTx TxId
txid ValidatedTx era
vtx) = TxId -> Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall proto era.
TxId -> Tx TopTx era -> GenTx (ShelleyBlock proto era)
ShelleyTx TxId
txid (ValidatedTx era -> Tx TopTx era
forall era. EraTx era => ValidatedTx era -> Tx TopTx era
SL.extractValidatedTx ValidatedTx era
vtx)

  getTransactionKeySets :: GenTx (ShelleyBlock proto era)
-> LedgerTables (ShelleyBlock proto era) KeysMK
getTransactionKeySets (ShelleyTx TxId
_ Tx TopTx era
tx) =
    KeysMK
  (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
-> LedgerTables (ShelleyBlock proto era) KeysMK
forall blk (mk :: * -> * -> *).
mk (TxIn blk) (TxOut blk) -> LedgerTables blk mk
LedgerTables (KeysMK
   (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
 -> LedgerTables (ShelleyBlock proto era) KeysMK)
-> KeysMK
     (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
-> LedgerTables (ShelleyBlock proto era) KeysMK
forall a b. (a -> b) -> a -> b
$
      Set (TxIn (ShelleyBlock proto era))
-> KeysMK
     (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
forall k v. Set k -> KeysMK k v
KeysMK (Set (TxIn (ShelleyBlock proto era))
 -> KeysMK
      (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era)))
-> Set (TxIn (ShelleyBlock proto era))
-> KeysMK
     (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$
        Set TxIn -> Set (TxIn (ShelleyBlock proto era))
forall k1 k2. Coercible k1 k2 => Set k1 -> Set k2
coerceSet
          (Tx TopTx era
tx Tx TopTx era
-> Getting (Set TxIn) (Tx TopTx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era))
-> Tx TopTx era -> Const (Set TxIn) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era))
 -> Tx TopTx era -> Const (Set TxIn) (Tx TopTx era))
-> ((Set TxIn -> Const (Set TxIn) (Set TxIn))
    -> TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era))
-> Getting (Set TxIn) (Tx TopTx era) (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Const (Set TxIn) (Set TxIn))
-> TxBody TopTx era -> Const (Set TxIn) (TxBody TopTx era)
forall era. EraTx era => SimpleGetter (TxBody TopTx era) (Set TxIn)
SimpleGetter (TxBody TopTx era) (Set TxIn)
allInputsTxBodyF)

  mkMempoolApplyTxError :: forall (mk :: * -> * -> *).
TickedLedgerState (ShelleyBlock proto era) mk
-> Text -> Maybe (ApplyTxErr (ShelleyBlock proto era))
mkMempoolApplyTxError TickedLedgerState (ShelleyBlock proto era) mk
_tlst Text
txt =
    ((Text -> ApplyTxError era) -> Text -> ApplyTxError era
forall a b. (a -> b) -> a -> b
$ Text
txt) ((Text -> ApplyTxError era) -> ApplyTxError era)
-> Maybe (Text -> ApplyTxError era) -> Maybe (ApplyTxError era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy era -> Maybe (Text -> ApplyTxError era)
forall era (proxy :: * -> *).
ShelleyBasedEra era =>
proxy era -> Maybe (Text -> ApplyTxError era)
forall (proxy :: * -> *).
proxy era -> Maybe (Text -> ApplyTxError era)
mkEraMkMempoolApplyTxError (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @era)

mkShelleyTx ::
  forall era proto. ShelleyBasedEra era => Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx :: forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx Tx TopTx era
tx = TxId -> Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall proto era.
TxId -> Tx TopTx era -> GenTx (ShelleyBlock proto era)
ShelleyTx (Tx TopTx era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx Tx TopTx era
tx) Tx TopTx era
tx

mkShelleyValidatedTx ::
  forall era proto.
  ShelleyBasedEra era =>
  SL.ValidatedTx era ->
  Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx :: forall era proto.
ShelleyBasedEra era =>
ValidatedTx era -> Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx ValidatedTx era
vtx = TxId
-> ValidatedTx era -> Validated (GenTx (ShelleyBlock proto era))
forall proto era.
TxId
-> ValidatedTx era -> Validated (GenTx (ShelleyBlock proto era))
ShelleyValidatedTx TxId
txid ValidatedTx era
vtx
 where
  txid :: TxId
txid = Tx TopTx era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx (ValidatedTx era -> Tx TopTx era
forall era. EraTx era => ValidatedTx era -> Tx TopTx era
SL.extractValidatedTx ValidatedTx era
vtx)

newtype instance TxId (GenTx (ShelleyBlock proto era)) = ShelleyTxId SL.TxId
  deriving newtype (TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
(TxId (GenTx (ShelleyBlock proto era))
 -> TxId (GenTx (ShelleyBlock proto era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era)) -> Bool)
-> Eq (TxId (GenTx (ShelleyBlock proto era)))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
$c== :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
== :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
$c/= :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
/= :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
Eq, Eq (TxId (GenTx (ShelleyBlock proto era)))
Eq (TxId (GenTx (ShelleyBlock proto era))) =>
(TxId (GenTx (ShelleyBlock proto era))
 -> TxId (GenTx (ShelleyBlock proto era)) -> Ordering)
-> (TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era)))
-> (TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era))
    -> TxId (GenTx (ShelleyBlock proto era)))
-> Ord (TxId (GenTx (ShelleyBlock proto era)))
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Ordering
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall proto era. Eq (TxId (GenTx (ShelleyBlock proto era)))
forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Ordering
forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
$ccompare :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Ordering
compare :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Ordering
$c< :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
< :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
$c<= :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
<= :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
$c> :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
> :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
$c>= :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
>= :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era)) -> Bool
$cmax :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
max :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
$cmin :: forall proto era.
TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
min :: TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
-> TxId (GenTx (ShelleyBlock proto era))
Ord, Context
-> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx (ShelleyBlock proto era))) -> String
(Context
 -> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo))
-> (Context
    -> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx (ShelleyBlock proto era))) -> String)
-> NoThunks (TxId (GenTx (ShelleyBlock proto era)))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall proto era.
Context
-> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo)
forall proto era.
Proxy (TxId (GenTx (ShelleyBlock proto era))) -> String
$cnoThunks :: forall proto era.
Context
-> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall proto era.
Context
-> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> TxId (GenTx (ShelleyBlock proto era)) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall proto era.
Proxy (TxId (GenTx (ShelleyBlock proto era))) -> String
showTypeOf :: Proxy (TxId (GenTx (ShelleyBlock proto era))) -> String
NoThunks)

deriving newtype instance
  Crypto (ProtoCrypto proto) =>
  EncCBOR (TxId (GenTx (ShelleyBlock proto era)))
deriving newtype instance
  (Typeable era, Typeable proto, Crypto (ProtoCrypto proto)) =>
  DecCBOR (TxId (GenTx (ShelleyBlock proto era)))

instance
  (Typeable era, Typeable proto) =>
  ShowProxy (TxId (GenTx (ShelleyBlock proto era)))

instance ShelleyBasedEra era => HasTxId (GenTx (ShelleyBlock proto era)) where
  txId :: GenTx (ShelleyBlock proto era)
-> TxId (GenTx (ShelleyBlock proto era))
txId (ShelleyTx TxId
i Tx TopTx era
_) = TxId -> TxId (GenTx (ShelleyBlock proto era))
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
ShelleyTxId TxId
i

instance ShelleyBasedEra era => ConvertRawTxId (GenTx (ShelleyBlock proto era)) where
  toRawTxIdHash :: TxId (GenTx (ShelleyBlock proto era)) -> ShortByteString
toRawTxIdHash (ShelleyTxId TxId
i) =
    Hash HASH EraIndependentTxBody -> ShortByteString
forall h a. Hash h a -> ShortByteString
Hash.hashToBytesShort (Hash HASH EraIndependentTxBody -> ShortByteString)
-> (TxId -> Hash HASH EraIndependentTxBody)
-> TxId
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
SL.extractHash (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody)
-> (TxId -> SafeHash EraIndependentTxBody)
-> TxId
-> Hash HASH EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> SafeHash EraIndependentTxBody
SL.unTxId (TxId -> ShortByteString) -> TxId -> ShortByteString
forall a b. (a -> b) -> a -> b
$ TxId
i

instance ShelleyBasedEra era => HasRawTxId (TxId (GenTx (ShelleyBlock proto era))) where
  type RawTxId (TxId (GenTx (ShelleyBlock proto era))) = ShortByteString
  getRawTxId :: TxId (GenTx (ShelleyBlock proto era))
-> RawTxId (TxId (GenTx (ShelleyBlock proto era)))
getRawTxId = TxId (GenTx (ShelleyBlock proto era)) -> ShortByteString
TxId (GenTx (ShelleyBlock proto era))
-> RawTxId (TxId (GenTx (ShelleyBlock proto era)))
forall tx. ConvertRawTxId tx => TxId tx -> ShortByteString
toRawTxIdHash

instance ShelleyBasedEra era => HasTxs (ShelleyBlock proto era) where
  extractTxs :: ShelleyBlock proto era -> [GenTx (ShelleyBlock proto era)]
extractTxs =
    (Tx TopTx era -> GenTx (ShelleyBlock proto era))
-> [Tx TopTx era] -> [GenTx (ShelleyBlock proto era)]
forall a b. (a -> b) -> [a] -> [b]
map Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx
      ([Tx TopTx era] -> [GenTx (ShelleyBlock proto era)])
-> (ShelleyBlock proto era -> [Tx TopTx era])
-> ShelleyBlock proto era
-> [GenTx (ShelleyBlock proto era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockBody era -> [Tx TopTx era]
blockBodyToTxList
      (BlockBody era -> [Tx TopTx era])
-> (ShelleyBlock proto era -> BlockBody era)
-> ShelleyBlock proto era
-> [Tx TopTx era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (ShelleyProtocolHeader proto) era -> BlockBody era
forall h era. Block h era -> BlockBody era
SL.blockBody
      (Block (ShelleyProtocolHeader proto) era -> BlockBody era)
-> (ShelleyBlock proto era
    -> Block (ShelleyProtocolHeader proto) era)
-> ShelleyBlock proto era
-> BlockBody era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw
   where
    blockBodyToTxList :: BlockBody era -> [Tx TopTx era]
    blockBodyToTxList :: BlockBody era -> [Tx TopTx era]
blockBodyToTxList BlockBody era
blockBody = StrictSeq (Tx TopTx era) -> [Tx TopTx era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (Tx TopTx era) -> [Tx TopTx era])
-> StrictSeq (Tx TopTx era) -> [Tx TopTx era]
forall a b. (a -> b) -> a -> b
$ BlockBody era
blockBody BlockBody era
-> Getting
     (StrictSeq (Tx TopTx era))
     (BlockBody era)
     (StrictSeq (Tx TopTx era))
-> StrictSeq (Tx TopTx era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (Tx TopTx era))
  (BlockBody era)
  (StrictSeq (Tx TopTx era))
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
txSeqBlockBodyL

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

instance ShelleyCompatible proto era => ToCBOR (GenTx (ShelleyBlock proto era)) where
  -- No need to encode the 'TxId', it's just a hash of the 'SL.TxBody' inside
  -- 'SL.Tx', so it can be recomputed.
  toCBOR :: GenTx (ShelleyBlock proto era) -> Encoding
toCBOR (ShelleyTx TxId
_txid Tx TopTx era
tx) = (Tx TopTx era -> Encoding) -> Tx TopTx era -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR Tx TopTx era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Tx TopTx era
tx

instance ShelleyCompatible proto era => FromCBOR (GenTx (ShelleyBlock proto era)) where
  fromCBOR :: forall s. Decoder s (GenTx (ShelleyBlock proto era))
fromCBOR =
    (Tx TopTx era -> GenTx (ShelleyBlock proto era))
-> Decoder s (Tx TopTx era)
-> Decoder s (GenTx (ShelleyBlock proto era))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Decoder s (Tx TopTx era)
 -> Decoder s (GenTx (ShelleyBlock proto era)))
-> Decoder s (Tx TopTx era)
-> Decoder s (GenTx (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$
      (forall s.
 Decoder s (ByteString -> Either DecoderError (Tx TopTx era)))
-> Decoder s (Tx TopTx era)
(forall s.
 Decoder s (ByteString -> Either DecoderError (Tx TopTx era)))
-> forall s. Decoder s (Tx TopTx era)
forall a.
(forall s. Decoder s (ByteString -> Either DecoderError a))
-> forall s. Decoder s a
unwrapCBORinCBOR ((forall s.
  Decoder s (ByteString -> Either DecoderError (Tx TopTx era)))
 -> forall s. Decoder s (Tx TopTx era))
-> (forall s.
    Decoder s (ByteString -> Either DecoderError (Tx TopTx era)))
-> forall s. Decoder s (Tx TopTx era)
forall a b. (a -> b) -> a -> b
$
        forall era t s. Era era => Decoder s t -> Decoder s t
eraDecoder @era (Decoder s (ByteString -> Either DecoderError (Tx TopTx era))
 -> Decoder s (ByteString -> Either DecoderError (Tx TopTx era)))
-> Decoder s (ByteString -> Either DecoderError (Tx TopTx era))
-> Decoder s (ByteString -> Either DecoderError (Tx TopTx era))
forall a b. (a -> b) -> a -> b
$
          ((FullByteString -> Either DecoderError (Tx TopTx era))
-> (ByteString -> FullByteString)
-> ByteString
-> Either DecoderError (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FullByteString
Full) ((FullByteString -> Either DecoderError (Tx TopTx era))
 -> ByteString -> Either DecoderError (Tx TopTx era))
-> (Annotator (Tx TopTx era)
    -> FullByteString -> Either DecoderError (Tx TopTx era))
-> Annotator (Tx TopTx era)
-> ByteString
-> Either DecoderError (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotator (Tx TopTx era)
-> FullByteString -> Either DecoderError (Tx TopTx era)
forall a. Annotator a -> FullByteString -> Either DecoderError a
runAnnotator (Annotator (Tx TopTx era)
 -> ByteString -> Either DecoderError (Tx TopTx era))
-> Decoder s (Annotator (Tx TopTx era))
-> Decoder s (ByteString -> Either DecoderError (Tx TopTx era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Tx TopTx era))
forall s. Decoder s (Annotator (Tx TopTx era))
forall a s. DecCBOR a => Decoder s a
decCBOR

{-------------------------------------------------------------------------------
  Pretty-printing
-------------------------------------------------------------------------------}

instance ShelleyBasedEra era => Condense (GenTx (ShelleyBlock proto era)) where
  condense :: GenTx (ShelleyBlock proto era) -> String
condense (ShelleyTx TxId
_ Tx TopTx era
tx) = Tx TopTx era -> String
forall a. Show a => a -> String
show Tx TopTx era
tx

instance Condense (GenTxId (ShelleyBlock proto era)) where
  condense :: GenTxId (ShelleyBlock proto era) -> String
condense (ShelleyTxId TxId
i) = String
"txid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TxId -> String
forall a. Show a => a -> String
show TxId
i

instance ShelleyBasedEra era => Show (GenTx (ShelleyBlock proto era)) where
  show :: GenTx (ShelleyBlock proto era) -> String
show = GenTx (ShelleyBlock proto era) -> String
forall a. Condense a => a -> String
condense

instance Show (GenTxId (ShelleyBlock proto era)) where
  show :: GenTxId (ShelleyBlock proto era) -> String
show = GenTxId (ShelleyBlock proto era) -> String
forall a. Condense a => a -> String
condense

{-------------------------------------------------------------------------------
  Applying transactions
-------------------------------------------------------------------------------}

applyShelleyTx ::
  forall era proto.
  ShelleyBasedEra era =>
  LedgerConfig (ShelleyBlock proto era) ->
  WhetherToIntervene ->
  SlotNo ->
  GenTx (ShelleyBlock proto era) ->
  TickedLedgerState (ShelleyBlock proto era) ValuesMK ->
  Except
    (ApplyTxErr (ShelleyBlock proto era))
    ( TickedLedgerState (ShelleyBlock proto era) DiffMK
    , Validated (GenTx (ShelleyBlock proto era))
    )
applyShelleyTx :: forall era proto.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock proto era)
-> WhetherToIntervene
-> SlotNo
-> GenTx (ShelleyBlock proto era)
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) DiffMK,
      Validated (GenTx (ShelleyBlock proto era)))
applyShelleyTx LedgerConfig (ShelleyBlock proto era)
cfg WhetherToIntervene
wti SlotNo
slot (ShelleyTx TxId
_ Tx TopTx era
tx) TickedLedgerState (ShelleyBlock proto era) ValuesMK
st0 = do
  let st1 :: TickedLedgerState (ShelleyBlock proto era) EmptyMK
      st1 :: TickedLedgerState (ShelleyBlock proto era) EmptyMK
st1 = TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
forall (l :: (* -> * -> *) -> *).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables TickedLedgerState (ShelleyBlock proto era) ValuesMK
st0

      innerSt :: SL.NewEpochState era
      innerSt :: NewEpochState era
innerSt = TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) EmptyMK
st1

  (mempoolState', vtx) <-
    Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx TopTx era
-> Except (ApplyTxError era) (LedgerState era, ValidatedTx era)
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx TopTx era
-> Except (ApplyTxError era) (LedgerState era, ValidatedTx era)
applyShelleyBasedTx
      (ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
cfg)
      (NewEpochState era -> SlotNo -> LedgerEnv era
forall era.
EraGov era =>
NewEpochState era -> SlotNo -> MempoolEnv era
SL.mkMempoolEnv NewEpochState era
innerSt SlotNo
slot)
      (NewEpochState era -> LedgerState era
forall era. NewEpochState era -> MempoolState era
SL.mkMempoolState NewEpochState era
innerSt)
      WhetherToIntervene
wti
      Tx TopTx era
tx

  let st' :: TickedLedgerState (ShelleyBlock proto era) DiffMK
      st' =
        Ticked LedgerState (ShelleyBlock proto era) TrackingMK
-> TickedLedgerState (ShelleyBlock proto era) DiffMK
forall (l :: * -> (* -> * -> *) -> *) blk.
HasLedgerTables l blk =>
l blk TrackingMK -> l blk DiffMK
trackingToDiffs (Ticked LedgerState (ShelleyBlock proto era) TrackingMK
 -> TickedLedgerState (ShelleyBlock proto era) DiffMK)
-> Ticked LedgerState (ShelleyBlock proto era) TrackingMK
-> TickedLedgerState (ShelleyBlock proto era) DiffMK
forall a b. (a -> b) -> a -> b
$
          TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Ticked LedgerState (ShelleyBlock proto era) TrackingMK
forall (l :: * -> (* -> * -> *) -> *) blk
       (l' :: * -> (* -> * -> *) -> *).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk ValuesMK -> l' blk TrackingMK
calculateDifference TickedLedgerState (ShelleyBlock proto era) ValuesMK
st0 (TickedLedgerState (ShelleyBlock proto era) ValuesMK
 -> Ticked LedgerState (ShelleyBlock proto era) TrackingMK)
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Ticked LedgerState (ShelleyBlock proto era) TrackingMK
forall a b. (a -> b) -> a -> b
$
            TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
forall (l :: (* -> * -> *) -> *).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables (TickedLedgerState (ShelleyBlock proto era) EmptyMK
 -> TickedLedgerState (ShelleyBlock proto era) ValuesMK)
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
forall a b. (a -> b) -> a -> b
$
              (forall (f :: * -> *).
 Applicative f =>
 (LedgerState era -> f (LedgerState era))
 -> TickedLedgerState (ShelleyBlock proto era) EmptyMK
 -> f (TickedLedgerState (ShelleyBlock proto era) EmptyMK))
-> LedgerState era
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> b -> s -> t
set (LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> f (TickedLedgerState (ShelleyBlock proto era) EmptyMK)
forall (f :: * -> *).
Applicative f =>
(LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> f (TickedLedgerState (ShelleyBlock proto era) EmptyMK)
forall (f :: * -> *) era proto (mk :: * -> * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era) mk
-> f (TickedLedgerState (ShelleyBlock proto era) mk)
theLedgerLens LedgerState era
mempoolState' TickedLedgerState (ShelleyBlock proto era) EmptyMK
st1

  pure (st', mkShelleyValidatedTx vtx)

reapplyShelleyTx ::
  ShelleyBasedEra era =>
  LedgerConfig (ShelleyBlock proto era) ->
  SlotNo ->
  Validated (GenTx (ShelleyBlock proto era)) ->
  TickedLedgerState (ShelleyBlock proto era) ValuesMK ->
  Except (ApplyTxErr (ShelleyBlock proto era)) (TickedLedgerState (ShelleyBlock proto era) ValuesMK)
reapplyShelleyTx :: forall era proto.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock proto era)
-> SlotNo
-> Validated (GenTx (ShelleyBlock proto era))
-> TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era) ValuesMK)
reapplyShelleyTx LedgerConfig (ShelleyBlock proto era)
cfg SlotNo
slot Validated (GenTx (ShelleyBlock proto era))
vgtx TickedLedgerState (ShelleyBlock proto era) ValuesMK
st0 = do
  let st1 :: Ticked LedgerState (ShelleyBlock proto era) EmptyMK
st1 = TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> Ticked LedgerState (ShelleyBlock proto era) EmptyMK
forall (l :: (* -> * -> *) -> *).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables TickedLedgerState (ShelleyBlock proto era) ValuesMK
st0
      innerSt :: NewEpochState era
innerSt = Ticked LedgerState (ShelleyBlock proto era) EmptyMK
-> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState Ticked LedgerState (ShelleyBlock proto era) EmptyMK
st1

  mempoolState' <-
    Either (ApplyTxError era) (MempoolState era)
-> ExceptT (ApplyTxError era) Identity (MempoolState era)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either (ApplyTxError era) (MempoolState era)
 -> ExceptT (ApplyTxError era) Identity (MempoolState era))
-> Either (ApplyTxError era) (MempoolState era)
-> ExceptT (ApplyTxError era) Identity (MempoolState era)
forall a b. (a -> b) -> a -> b
$
      Globals
-> MempoolEnv era
-> MempoolState era
-> ValidatedTx era
-> Either (ApplyTxError era) (MempoolState era)
forall era.
(ApplyTx era, EraGov era) =>
Globals
-> MempoolEnv era
-> MempoolState era
-> ValidatedTx era
-> Either (ApplyTxError era) (MempoolState era)
SL.reapplyValidatedTx
        (ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
cfg)
        (NewEpochState era -> SlotNo -> MempoolEnv era
forall era.
EraGov era =>
NewEpochState era -> SlotNo -> MempoolEnv era
SL.mkMempoolEnv NewEpochState era
innerSt SlotNo
slot)
        (NewEpochState era -> MempoolState era
forall era. NewEpochState era -> MempoolState era
SL.mkMempoolState NewEpochState era
innerSt)
        ValidatedTx era
vtx

  pure $
    unstowLedgerTables $
      set theLedgerLens mempoolState' st1
 where
  ShelleyValidatedTx TxId
_txid ValidatedTx era
vtx = Validated (GenTx (ShelleyBlock proto era))
vgtx

-- | The lens combinator
set ::
  (forall f. Applicative f => (a -> f b) -> s -> f t) ->
  b ->
  s ->
  t
set :: forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> b -> s -> t
set forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
lens b
inner s
outer =
  Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> Identity t -> t
forall a b. (a -> b) -> a -> b
$ (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
lens (\a
_ -> b -> Identity b
forall a. a -> Identity a
Identity b
inner) s
outer

theLedgerLens ::
  Functor f =>
  (SL.LedgerState era -> f (SL.LedgerState era)) ->
  TickedLedgerState (ShelleyBlock proto era) mk ->
  f (TickedLedgerState (ShelleyBlock proto era) mk)
theLedgerLens :: forall (f :: * -> *) era proto (mk :: * -> * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era) mk
-> f (TickedLedgerState (ShelleyBlock proto era) mk)
theLedgerLens LedgerState era -> f (LedgerState era)
f TickedLedgerState (ShelleyBlock proto era) mk
x =
  (\NewEpochState era
y -> TickedLedgerState (ShelleyBlock proto era) mk
x{tickedShelleyLedgerState = y})
    (NewEpochState era
 -> TickedLedgerState (ShelleyBlock proto era) mk)
-> f (NewEpochState era)
-> f (TickedLedgerState (ShelleyBlock proto era) mk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LedgerState era -> f (LedgerState era))
-> NewEpochState era -> f (NewEpochState era)
forall (f :: * -> *) era.
Functor f =>
(MempoolState era -> f (MempoolState era))
-> NewEpochState era -> f (NewEpochState era)
SL.overNewEpochState LedgerState era -> f (LedgerState era)
f (TickedLedgerState (ShelleyBlock proto era) mk -> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) mk
x)

{-------------------------------------------------------------------------------
  Tx Limits
-------------------------------------------------------------------------------}

-- | A non-exported newtype wrapper just to give a 'Semigroup' instance
newtype TxErrorSG era = TxErrorSG {forall era. TxErrorSG era -> ApplyTxError era
unTxErrorSG :: SL.ApplyTxError era}

deriving newtype instance Semigroup (SL.ApplyTxError era) => Semigroup (TxErrorSG era)

validateMaybe ::
  SL.ApplyTxError era ->
  Maybe a ->
  V.Validation (TxErrorSG era) a
validateMaybe :: forall era a.
ApplyTxError era -> Maybe a -> Validation (TxErrorSG era) a
validateMaybe ApplyTxError era
err Maybe a
mb = Validation (TxErrorSG era) a
-> (a -> Validation (TxErrorSG era) a)
-> Maybe a
-> Validation (TxErrorSG era) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TxErrorSG era -> Validation (TxErrorSG era) a
forall err a. err -> Validation err a
V.Failure (ApplyTxError era -> TxErrorSG era
forall era. ApplyTxError era -> TxErrorSG era
TxErrorSG ApplyTxError era
err)) a -> Validation (TxErrorSG era) a
forall err a. a -> Validation err a
V.Success Maybe a
mb

runValidation ::
  V.Validation (TxErrorSG era) a ->
  Except (SL.ApplyTxError era) a
runValidation :: forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation = Either (ApplyTxError era) a
-> ExceptT (ApplyTxError era) Identity a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either (ApplyTxError era) a
 -> ExceptT (ApplyTxError era) Identity a)
-> (Validation (TxErrorSG era) a -> Either (ApplyTxError era) a)
-> Validation (TxErrorSG era) a
-> ExceptT (ApplyTxError era) Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxErrorSG era -> ApplyTxError era
forall era. TxErrorSG era -> ApplyTxError era
unTxErrorSG (TxErrorSG era -> ApplyTxError era)
-> (a -> a)
-> Either (TxErrorSG era) a
-> Either (ApplyTxError era) a
forall b c b' c'.
(b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ a -> a
forall a. a -> a
id) (Either (TxErrorSG era) a -> Either (ApplyTxError era) a)
-> (Validation (TxErrorSG era) a -> Either (TxErrorSG era) a)
-> Validation (TxErrorSG era) a
-> Either (ApplyTxError era) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Either (TxErrorSG era) a)
  (Validation (TxErrorSG era) a)
  (Either (TxErrorSG era) a)
-> Validation (TxErrorSG era) a -> Either (TxErrorSG era) a
forall a s. Getting a s a -> s -> a
view Getting
  (Either (TxErrorSG era) a)
  (Validation (TxErrorSG era) a)
  (Either (TxErrorSG era) a)
forall a b a' b' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Either a b) (f (Either a' b'))
-> p (Validation a b) (f (Validation a' b'))
V.either

-----

txsMaxBytes ::
  ShelleyCompatible proto era =>
  TickedLedgerState (ShelleyBlock proto era) mk ->
  IgnoringOverflow ByteSize32
txsMaxBytes :: forall proto era (mk :: * -> * -> *).
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era) mk
-> IgnoringOverflow ByteSize32
txsMaxBytes TickedShelleyLedgerState{NewEpochState era
tickedShelleyLedgerState :: forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState} =
  -- `maxBlockBodySize` is expected to be bigger than `fixedBlockBodyOverhead`
  ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$
    Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$
      Word32
maxBlockBodySize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
forall a. Num a => a
fixedBlockBodyOverhead
 where
  maxBlockBodySize :: Word32
maxBlockBodySize = NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams NewEpochState era
tickedShelleyLedgerState PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxBBSizeL

txInBlockSize ::
  (ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
  TickedLedgerState (ShelleyBlock proto era) mk ->
  GenTx (ShelleyBlock proto era) ->
  V.Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize :: forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock proto era) mk
st (ShelleyTx TxId
_txid Tx TopTx era
tx') =
  ApplyTxError era
-> Maybe (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
forall era a.
ApplyTxError era -> Maybe a -> Validation (TxErrorSG era) a
validateMaybe (Word32 -> Word32 -> ApplyTxError era
forall era.
MaxTxSizeUTxO era =>
Word32 -> Word32 -> ApplyTxError era
maxTxSizeUTxO Word32
txsz Word32
limit) (Maybe (IgnoringOverflow ByteSize32)
 -> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32))
-> Maybe (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
forall a b. (a -> b) -> a -> b
$ do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word32
txsz Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
limit
    IgnoringOverflow ByteSize32 -> Maybe (IgnoringOverflow ByteSize32)
forall a. a -> Maybe a
Just (IgnoringOverflow ByteSize32
 -> Maybe (IgnoringOverflow ByteSize32))
-> IgnoringOverflow ByteSize32
-> Maybe (IgnoringOverflow ByteSize32)
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32
txsz Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
forall a. Num a => a
perTxOverhead
 where
  txsz :: Word32
txsz = Tx TopTx era
tx' Tx TopTx era -> Getting Word32 (Tx TopTx era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx era) Word32
forall era (l :: TxLevel).
(EraTx era, HasCallStack) =>
SimpleGetter (Tx l era) Word32
SimpleGetter (Tx TopTx era) Word32
forall (l :: TxLevel).
HasCallStack =>
SimpleGetter (Tx l era) Word32
sizeTxF

  pparams :: PParams era
pparams = NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams era)
-> NewEpochState era -> PParams era
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era) mk -> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) mk
st
  limit :: Word32
limit = PParams era
pparams PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
L.ppMaxTxSizeL

class MaxTxSizeUTxO era where
  maxTxSizeUTxO ::
    -- | Actual transaction size
    Word32 ->
    -- | Maximum transaction size
    Word32 ->
    SL.ApplyTxError era

instance MaxTxSizeUTxO ShelleyEra where
  maxTxSizeUTxO :: Word32 -> Word32 -> ApplyTxError ShelleyEra
maxTxSizeUTxO Word32
txSize Word32
txSizeLimit =
    NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
-> ApplyTxError ShelleyEra
SL.ShelleyApplyTxError (NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
 -> ApplyTxError ShelleyEra)
-> (ShelleyLedgerPredFailure ShelleyEra
    -> NonEmpty (ShelleyLedgerPredFailure ShelleyEra))
-> ShelleyLedgerPredFailure ShelleyEra
-> ApplyTxError ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure ShelleyEra
-> NonEmpty (ShelleyLedgerPredFailure ShelleyEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure ShelleyEra -> ApplyTxError ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra -> ApplyTxError ShelleyEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure (PredicateFailure (EraRule "UTXOW" ShelleyEra)
 -> ShelleyLedgerPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXOW" ShelleyEra)
-> ShelleyLedgerPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure (PredicateFailure (EraRule "UTXO" ShelleyEra)
 -> ShelleyUtxowPredFailure ShelleyEra)
-> PredicateFailure (EraRule "UTXO" ShelleyEra)
-> ShelleyUtxowPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
          Mismatch RelLTEQ Word32 -> ShelleyUtxoPredFailure ShelleyEra
forall era. Mismatch RelLTEQ Word32 -> ShelleyUtxoPredFailure era
ShelleyEra.MaxTxSizeUTxO (Mismatch RelLTEQ Word32 -> ShelleyUtxoPredFailure ShelleyEra)
-> Mismatch RelLTEQ Word32 -> ShelleyUtxoPredFailure ShelleyEra
forall a b. (a -> b) -> a -> b
$
            L.Mismatch
              { mismatchSupplied :: Word32
mismatchSupplied = Word32
txSize
              , mismatchExpected :: Word32
mismatchExpected = Word32
txSizeLimit
              }

instance MaxTxSizeUTxO AllegraEra where
  maxTxSizeUTxO :: Word32 -> Word32 -> ApplyTxError AllegraEra
maxTxSizeUTxO Word32
txSize Word32
txSizeLimit =
    NonEmpty (ShelleyLedgerPredFailure AllegraEra)
-> ApplyTxError AllegraEra
AllegraApplyTxError (NonEmpty (ShelleyLedgerPredFailure AllegraEra)
 -> ApplyTxError AllegraEra)
-> (ShelleyLedgerPredFailure AllegraEra
    -> NonEmpty (ShelleyLedgerPredFailure AllegraEra))
-> ShelleyLedgerPredFailure AllegraEra
-> ApplyTxError AllegraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure AllegraEra
-> NonEmpty (ShelleyLedgerPredFailure AllegraEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure AllegraEra -> ApplyTxError AllegraEra)
-> ShelleyLedgerPredFailure AllegraEra -> ApplyTxError AllegraEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" AllegraEra)
-> ShelleyLedgerPredFailure AllegraEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure (PredicateFailure (EraRule "UTXOW" AllegraEra)
 -> ShelleyLedgerPredFailure AllegraEra)
-> PredicateFailure (EraRule "UTXOW" AllegraEra)
-> ShelleyLedgerPredFailure AllegraEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXO" AllegraEra)
-> ShelleyUtxowPredFailure AllegraEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure (PredicateFailure (EraRule "UTXO" AllegraEra)
 -> ShelleyUtxowPredFailure AllegraEra)
-> PredicateFailure (EraRule "UTXO" AllegraEra)
-> ShelleyUtxowPredFailure AllegraEra
forall a b. (a -> b) -> a -> b
$
          Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure AllegraEra
forall era. Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure era
AllegraEra.MaxTxSizeUTxO (Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure AllegraEra)
-> Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure AllegraEra
forall a b. (a -> b) -> a -> b
$
            L.Mismatch
              { mismatchSupplied :: Word32
mismatchSupplied = Word32
txSize
              , mismatchExpected :: Word32
mismatchExpected = Word32
txSizeLimit
              }

instance MaxTxSizeUTxO MaryEra where
  maxTxSizeUTxO :: Word32 -> Word32 -> ApplyTxError MaryEra
maxTxSizeUTxO Word32
txSize Word32
txSizeLimit =
    NonEmpty (ShelleyLedgerPredFailure MaryEra) -> ApplyTxError MaryEra
MaryApplyTxError (NonEmpty (ShelleyLedgerPredFailure MaryEra)
 -> ApplyTxError MaryEra)
-> (ShelleyLedgerPredFailure MaryEra
    -> NonEmpty (ShelleyLedgerPredFailure MaryEra))
-> ShelleyLedgerPredFailure MaryEra
-> ApplyTxError MaryEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure MaryEra
-> NonEmpty (ShelleyLedgerPredFailure MaryEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure MaryEra -> ApplyTxError MaryEra)
-> ShelleyLedgerPredFailure MaryEra -> ApplyTxError MaryEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" MaryEra)
-> ShelleyLedgerPredFailure MaryEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure (PredicateFailure (EraRule "UTXOW" MaryEra)
 -> ShelleyLedgerPredFailure MaryEra)
-> PredicateFailure (EraRule "UTXOW" MaryEra)
-> ShelleyLedgerPredFailure MaryEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXO" MaryEra)
-> ShelleyUtxowPredFailure MaryEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure (PredicateFailure (EraRule "UTXO" MaryEra)
 -> ShelleyUtxowPredFailure MaryEra)
-> PredicateFailure (EraRule "UTXO" MaryEra)
-> ShelleyUtxowPredFailure MaryEra
forall a b. (a -> b) -> a -> b
$
          Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure MaryEra
forall era. Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure era
AllegraEra.MaxTxSizeUTxO (Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure MaryEra)
-> Mismatch RelLTEQ Word32 -> AllegraUtxoPredFailure MaryEra
forall a b. (a -> b) -> a -> b
$
            L.Mismatch
              { mismatchSupplied :: Word32
mismatchSupplied = Word32
txSize
              , mismatchExpected :: Word32
mismatchExpected = Word32
txSizeLimit
              }

instance MaxTxSizeUTxO AlonzoEra where
  maxTxSizeUTxO :: Word32 -> Word32 -> ApplyTxError AlonzoEra
maxTxSizeUTxO Word32
txSize Word32
txSizeLimit =
    NonEmpty (ShelleyLedgerPredFailure AlonzoEra)
-> ApplyTxError AlonzoEra
AlonzoApplyTxError (NonEmpty (ShelleyLedgerPredFailure AlonzoEra)
 -> ApplyTxError AlonzoEra)
-> (ShelleyLedgerPredFailure AlonzoEra
    -> NonEmpty (ShelleyLedgerPredFailure AlonzoEra))
-> ShelleyLedgerPredFailure AlonzoEra
-> ApplyTxError AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure AlonzoEra
-> NonEmpty (ShelleyLedgerPredFailure AlonzoEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure AlonzoEra -> ApplyTxError AlonzoEra)
-> ShelleyLedgerPredFailure AlonzoEra -> ApplyTxError AlonzoEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" AlonzoEra)
-> ShelleyLedgerPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure (PredicateFailure (EraRule "UTXOW" AlonzoEra)
 -> ShelleyLedgerPredFailure AlonzoEra)
-> PredicateFailure (EraRule "UTXOW" AlonzoEra)
-> ShelleyLedgerPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
        ShelleyUtxowPredFailure AlonzoEra
-> AlonzoUtxowPredFailure AlonzoEra
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
AlonzoEra.ShelleyInAlonzoUtxowPredFailure (ShelleyUtxowPredFailure AlonzoEra
 -> AlonzoUtxowPredFailure AlonzoEra)
-> ShelleyUtxowPredFailure AlonzoEra
-> AlonzoUtxowPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "UTXO" AlonzoEra)
-> ShelleyUtxowPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure (PredicateFailure (EraRule "UTXO" AlonzoEra)
 -> ShelleyUtxowPredFailure AlonzoEra)
-> PredicateFailure (EraRule "UTXO" AlonzoEra)
-> ShelleyUtxowPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
            Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure AlonzoEra
forall era. Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure era
AlonzoEra.MaxTxSizeUTxO (Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure AlonzoEra)
-> Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
              L.Mismatch
                { mismatchSupplied :: Word32
mismatchSupplied = Word32
txSize
                , mismatchExpected :: Word32
mismatchExpected = Word32
txSizeLimit
                }

instance MaxTxSizeUTxO BabbageEra where
  maxTxSizeUTxO :: Word32 -> Word32 -> ApplyTxError BabbageEra
maxTxSizeUTxO Word32
txSize Word32
txSizeLimit =
    NonEmpty (ShelleyLedgerPredFailure BabbageEra)
-> ApplyTxError BabbageEra
BabbageApplyTxError (NonEmpty (ShelleyLedgerPredFailure BabbageEra)
 -> ApplyTxError BabbageEra)
-> (ShelleyLedgerPredFailure BabbageEra
    -> NonEmpty (ShelleyLedgerPredFailure BabbageEra))
-> ShelleyLedgerPredFailure BabbageEra
-> ApplyTxError BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure BabbageEra
-> NonEmpty (ShelleyLedgerPredFailure BabbageEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure BabbageEra -> ApplyTxError BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra -> ApplyTxError BabbageEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure (PredicateFailure (EraRule "UTXOW" BabbageEra)
 -> ShelleyLedgerPredFailure BabbageEra)
-> PredicateFailure (EraRule "UTXOW" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXO" BabbageEra)
-> BabbageUtxowPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> BabbageUtxowPredFailure era
BabbageEra.UtxoFailure (PredicateFailure (EraRule "UTXO" BabbageEra)
 -> BabbageUtxowPredFailure BabbageEra)
-> PredicateFailure (EraRule "UTXO" BabbageEra)
-> BabbageUtxowPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
          AlonzoUtxoPredFailure BabbageEra
-> BabbageUtxoPredFailure BabbageEra
forall era. AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era
BabbageEra.AlonzoInBabbageUtxoPredFailure (AlonzoUtxoPredFailure BabbageEra
 -> BabbageUtxoPredFailure BabbageEra)
-> AlonzoUtxoPredFailure BabbageEra
-> BabbageUtxoPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
            Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure BabbageEra
forall era. Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure era
AlonzoEra.MaxTxSizeUTxO (Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure BabbageEra)
-> Mismatch RelLTEQ Word32 -> AlonzoUtxoPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
              L.Mismatch
                { mismatchSupplied :: Word32
mismatchSupplied = Word32
txSize
                , mismatchExpected :: Word32
mismatchExpected = Word32
txSizeLimit
                }

instance MaxTxSizeUTxO ConwayEra where
  maxTxSizeUTxO :: Word32 -> Word32 -> ApplyTxError ConwayEra
maxTxSizeUTxO Word32
txSize Word32
txSizeLimit =
    NonEmpty (ConwayLedgerPredFailure ConwayEra)
-> ApplyTxError ConwayEra
ConwayApplyTxError (NonEmpty (ConwayLedgerPredFailure ConwayEra)
 -> ApplyTxError ConwayEra)
-> (ConwayLedgerPredFailure ConwayEra
    -> NonEmpty (ConwayLedgerPredFailure ConwayEra))
-> ConwayLedgerPredFailure ConwayEra
-> ApplyTxError ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayLedgerPredFailure ConwayEra
-> NonEmpty (ConwayLedgerPredFailure ConwayEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConwayLedgerPredFailure ConwayEra -> ApplyTxError ConwayEra)
-> ConwayLedgerPredFailure ConwayEra -> ApplyTxError ConwayEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" ConwayEra)
-> ConwayLedgerPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayEra.ConwayUtxowFailure (PredicateFailure (EraRule "UTXOW" ConwayEra)
 -> ConwayLedgerPredFailure ConwayEra)
-> PredicateFailure (EraRule "UTXOW" ConwayEra)
-> ConwayLedgerPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXO" ConwayEra)
-> ConwayUtxowPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
ConwayEra.UtxoFailure (PredicateFailure (EraRule "UTXO" ConwayEra)
 -> ConwayUtxowPredFailure ConwayEra)
-> PredicateFailure (EraRule "UTXO" ConwayEra)
-> ConwayUtxowPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
          Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure ConwayEra
forall era. Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure era
ConwayEra.MaxTxSizeUTxO (Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure ConwayEra)
-> Mismatch RelLTEQ Word32 -> ConwayUtxoPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
            L.Mismatch
              { mismatchSupplied :: Word32
mismatchSupplied = Word32
txSize
              , mismatchExpected :: Word32
mismatchExpected = Word32
txSizeLimit
              }

instance MaxTxSizeUTxO DijkstraEra where
  maxTxSizeUTxO :: Word32 -> Word32 -> ApplyTxError DijkstraEra
maxTxSizeUTxO Word32
txSize Word32
txSizeLimit =
    NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
 -> ApplyTxError DijkstraEra)
-> (DijkstraMempoolPredFailure DijkstraEra
    -> NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
-> DijkstraMempoolPredFailure DijkstraEra
-> ApplyTxError DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DijkstraMempoolPredFailure DijkstraEra
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DijkstraMempoolPredFailure DijkstraEra
 -> ApplyTxError DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
-> ApplyTxError DijkstraEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> DijkstraMempoolPredFailure era
DijkstraEra.LedgerFailure (PredicateFailure (EraRule "LEDGER" DijkstraEra)
 -> DijkstraMempoolPredFailure DijkstraEra)
-> PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXOW" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> DijkstraLedgerPredFailure era
DijkstraEra.DijkstraUtxowFailure (PredicateFailure (EraRule "UTXOW" DijkstraEra)
 -> DijkstraLedgerPredFailure DijkstraEra)
-> PredicateFailure (EraRule "UTXOW" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "UTXO" DijkstraEra)
-> DijkstraUtxowPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> DijkstraUtxowPredFailure era
DijkstraEra.UtxoFailure (PredicateFailure (EraRule "UTXO" DijkstraEra)
 -> DijkstraUtxowPredFailure DijkstraEra)
-> PredicateFailure (EraRule "UTXO" DijkstraEra)
-> DijkstraUtxowPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
            Mismatch RelLTEQ Word32 -> DijkstraUtxoPredFailure DijkstraEra
forall era. Mismatch RelLTEQ Word32 -> DijkstraUtxoPredFailure era
DijkstraEra.MaxTxSizeUTxO (Mismatch RelLTEQ Word32 -> DijkstraUtxoPredFailure DijkstraEra)
-> Mismatch RelLTEQ Word32 -> DijkstraUtxoPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
              L.Mismatch
                { mismatchSupplied :: Word32
mismatchSupplied = Word32
txSize
                , mismatchExpected :: Word32
mismatchExpected = Word32
txSizeLimit
                }

-----

wrapCBORinCBOROverhead ::
  -- | payload size
  Word32 ->
  SizeInBytes
wrapCBORinCBOROverhead :: Word32 -> SizeInBytes
wrapCBORinCBOROverhead Word32
size =
  SizeInBytes
2 -- wrapCBORinCBOR's encodeTag 24
    SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ case Word32
size of -- upper bound for wrapCBORinCBOR's encodeBytes overhead;
    -- it is bounded by maximum tx size
      Word32
_
        | Word32
size Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0x17 -> SizeInBytes
1
        | Word32
size Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0xff -> SizeInBytes
2
        | Word32
size Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0xffff -> SizeInBytes
3
        | Bool
otherwise -> SizeInBytes
5
    SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ Word32 -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size

instance ShelleyCompatible p ShelleyEra => TxLimits (ShelleyBlock p ShelleyEra) where
  type TxMeasurePhase1 (ShelleyBlock p ShelleyEra) = IgnoringOverflow ByteSize32
  type TxMeasurePhase2 (ShelleyBlock p ShelleyEra) = TrivialTxMeasurePhase2
  txWireSize :: GenTx (ShelleyBlock p ShelleyEra) -> SizeInBytes
txWireSize (ShelleyTx TxId
_ Tx TopTx ShelleyEra
tx) = Word32 -> SizeInBytes
wrapCBORinCBOROverhead (Tx TopTx ShelleyEra
tx Tx TopTx ShelleyEra
-> Getting Word32 (Tx TopTx ShelleyEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx ShelleyEra) Word32
SimpleGetter (Tx TopTx ShelleyEra) Word32
forall era (l :: TxLevel).
EraTx era =>
SimpleGetter (Tx l era) Word32
wireSizeTxF)
  txMeasurePhase1 :: LedgerConfig (ShelleyBlock p ShelleyEra)
-> TickedLedgerState (ShelleyBlock p ShelleyEra) EmptyMK
-> GenTx (ShelleyBlock p ShelleyEra)
-> Except
     (ApplyTxErr (ShelleyBlock p ShelleyEra))
     (TxMeasurePhase1 (ShelleyBlock p ShelleyEra))
txMeasurePhase1 LedgerConfig (ShelleyBlock p ShelleyEra)
_cfg TickedLedgerState (ShelleyBlock p ShelleyEra) EmptyMK
st GenTx (ShelleyBlock p ShelleyEra)
tx = Validation
  (TxErrorSG ShelleyEra)
  (TxMeasurePhase1 (ShelleyBlock p ShelleyEra))
-> Except
     (ApplyTxError ShelleyEra)
     (TxMeasurePhase1 (ShelleyBlock p ShelleyEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG ShelleyEra)
   (TxMeasurePhase1 (ShelleyBlock p ShelleyEra))
 -> Except
      (ApplyTxError ShelleyEra)
      (TxMeasurePhase1 (ShelleyBlock p ShelleyEra)))
-> Validation
     (TxErrorSG ShelleyEra)
     (TxMeasurePhase1 (ShelleyBlock p ShelleyEra))
-> Except
     (ApplyTxError ShelleyEra)
     (TxMeasurePhase1 (ShelleyBlock p ShelleyEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p ShelleyEra) EmptyMK
-> GenTx (ShelleyBlock p ShelleyEra)
-> Validation (TxErrorSG ShelleyEra) (IgnoringOverflow ByteSize32)
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock p ShelleyEra) EmptyMK
st GenTx (ShelleyBlock p ShelleyEra)
tx
  txMeasurePhase2 :: LedgerConfig (ShelleyBlock p ShelleyEra)
-> TickedLedgerState (ShelleyBlock p ShelleyEra) ValuesMK
-> GenTx (ShelleyBlock p ShelleyEra)
-> Except
     (ApplyTxErr (ShelleyBlock p ShelleyEra))
     (TxMeasurePhase2 (ShelleyBlock p ShelleyEra))
txMeasurePhase2 LedgerConfig (ShelleyBlock p ShelleyEra)
_cfg TickedLedgerState (ShelleyBlock p ShelleyEra) ValuesMK
_st GenTx (ShelleyBlock p ShelleyEra)
_tx = TrivialTxMeasurePhase2
-> ExceptT
     (ApplyTxError ShelleyEra) Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT (ApplyTxError ShelleyEra) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p ShelleyEra)
-> TickedLedgerState (ShelleyBlock p ShelleyEra) mk
-> TxMeasure (ShelleyBlock p ShelleyEra)
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p ShelleyEra)
_cfg = (IgnoringOverflow ByteSize32
 -> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p ShelleyEra))
-> TrivialTxMeasurePhase2
-> IgnoringOverflow ByteSize32
-> TxMeasure (ShelleyBlock p ShelleyEra)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IgnoringOverflow ByteSize32
-> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p ShelleyEra)
TxMeasurePhase1 (ShelleyBlock p ShelleyEra)
-> TxMeasurePhase2 (ShelleyBlock p ShelleyEra)
-> TxMeasure (ShelleyBlock p ShelleyEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2 (IgnoringOverflow ByteSize32
 -> TxMeasure (ShelleyBlock p ShelleyEra))
-> (Ticked LedgerState (ShelleyBlock p ShelleyEra) mk
    -> IgnoringOverflow ByteSize32)
-> Ticked LedgerState (ShelleyBlock p ShelleyEra) mk
-> TxMeasure (ShelleyBlock p ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState (ShelleyBlock p ShelleyEra) mk
-> IgnoringOverflow ByteSize32
forall proto era (mk :: * -> * -> *).
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era) mk
-> IgnoringOverflow ByteSize32
txsMaxBytes

  type TxEbMeasure (ShelleyBlock p ShelleyEra) = TxMeasure (ShelleyBlock p ShelleyEra)

  txEbMeasure :: forall (proxy :: * -> *).
proxy (ShelleyBlock p ShelleyEra)
-> TxMeasure (ShelleyBlock p ShelleyEra)
-> TxEbMeasure (ShelleyBlock p ShelleyEra)
txEbMeasure proxy (ShelleyBlock p ShelleyEra)
_ = TxMeasure (ShelleyBlock p ShelleyEra)
-> TxEbMeasure (ShelleyBlock p ShelleyEra)
TxMeasure (ShelleyBlock p ShelleyEra)
-> TxMeasure (ShelleyBlock p ShelleyEra)
forall a. a -> a
id

  ebCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p ShelleyEra)
-> TickedLedgerState (ShelleyBlock p ShelleyEra) mk
-> TxEbMeasure (ShelleyBlock p ShelleyEra)
ebCapacityTxMeasure LedgerConfig (ShelleyBlock p ShelleyEra)
_cfg TickedLedgerState (ShelleyBlock p ShelleyEra) mk
_st = TxEbMeasure (ShelleyBlock p ShelleyEra)
TxMeasure (ShelleyBlock p ShelleyEra)
forall a. Measure a => a
zero
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy (ShelleyBlock p ShelleyEra)
-> TxEbMeasure (ShelleyBlock p ShelleyEra)
-> TxMeasure (ShelleyBlock p ShelleyEra)
mempoolEbReservation proxy (ShelleyBlock p ShelleyEra)
_ = TxEbMeasure (ShelleyBlock p ShelleyEra)
-> TxMeasure (ShelleyBlock p ShelleyEra)
TxMeasure (ShelleyBlock p ShelleyEra)
-> TxMeasure (ShelleyBlock p ShelleyEra)
forall a. a -> a
id

instance ShelleyCompatible p AllegraEra => TxLimits (ShelleyBlock p AllegraEra) where
  type TxMeasurePhase1 (ShelleyBlock p AllegraEra) = IgnoringOverflow ByteSize32
  type TxMeasurePhase2 (ShelleyBlock p AllegraEra) = TrivialTxMeasurePhase2
  txWireSize :: GenTx (ShelleyBlock p AllegraEra) -> SizeInBytes
txWireSize (ShelleyTx TxId
_ Tx TopTx AllegraEra
tx) = Word32 -> SizeInBytes
wrapCBORinCBOROverhead (Tx TopTx AllegraEra
tx Tx TopTx AllegraEra
-> Getting Word32 (Tx TopTx AllegraEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx AllegraEra) Word32
SimpleGetter (Tx TopTx AllegraEra) Word32
forall era (l :: TxLevel).
EraTx era =>
SimpleGetter (Tx l era) Word32
wireSizeTxF)
  txMeasurePhase1 :: LedgerConfig (ShelleyBlock p AllegraEra)
-> TickedLedgerState (ShelleyBlock p AllegraEra) EmptyMK
-> GenTx (ShelleyBlock p AllegraEra)
-> Except
     (ApplyTxErr (ShelleyBlock p AllegraEra))
     (TxMeasurePhase1 (ShelleyBlock p AllegraEra))
txMeasurePhase1 LedgerConfig (ShelleyBlock p AllegraEra)
_cfg TickedLedgerState (ShelleyBlock p AllegraEra) EmptyMK
st GenTx (ShelleyBlock p AllegraEra)
tx = Validation
  (TxErrorSG AllegraEra)
  (TxMeasurePhase1 (ShelleyBlock p AllegraEra))
-> Except
     (ApplyTxError AllegraEra)
     (TxMeasurePhase1 (ShelleyBlock p AllegraEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG AllegraEra)
   (TxMeasurePhase1 (ShelleyBlock p AllegraEra))
 -> Except
      (ApplyTxError AllegraEra)
      (TxMeasurePhase1 (ShelleyBlock p AllegraEra)))
-> Validation
     (TxErrorSG AllegraEra)
     (TxMeasurePhase1 (ShelleyBlock p AllegraEra))
-> Except
     (ApplyTxError AllegraEra)
     (TxMeasurePhase1 (ShelleyBlock p AllegraEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p AllegraEra) EmptyMK
-> GenTx (ShelleyBlock p AllegraEra)
-> Validation (TxErrorSG AllegraEra) (IgnoringOverflow ByteSize32)
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock p AllegraEra) EmptyMK
st GenTx (ShelleyBlock p AllegraEra)
tx
  txMeasurePhase2 :: LedgerConfig (ShelleyBlock p AllegraEra)
-> TickedLedgerState (ShelleyBlock p AllegraEra) ValuesMK
-> GenTx (ShelleyBlock p AllegraEra)
-> Except
     (ApplyTxErr (ShelleyBlock p AllegraEra))
     (TxMeasurePhase2 (ShelleyBlock p AllegraEra))
txMeasurePhase2 LedgerConfig (ShelleyBlock p AllegraEra)
_cfg TickedLedgerState (ShelleyBlock p AllegraEra) ValuesMK
_st GenTx (ShelleyBlock p AllegraEra)
_tx = TrivialTxMeasurePhase2
-> ExceptT
     (ApplyTxError AllegraEra) Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT (ApplyTxError AllegraEra) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p AllegraEra)
-> TickedLedgerState (ShelleyBlock p AllegraEra) mk
-> TxMeasure (ShelleyBlock p AllegraEra)
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p AllegraEra)
_cfg = (IgnoringOverflow ByteSize32
 -> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p AllegraEra))
-> TrivialTxMeasurePhase2
-> IgnoringOverflow ByteSize32
-> TxMeasure (ShelleyBlock p AllegraEra)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IgnoringOverflow ByteSize32
-> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p AllegraEra)
TxMeasurePhase1 (ShelleyBlock p AllegraEra)
-> TxMeasurePhase2 (ShelleyBlock p AllegraEra)
-> TxMeasure (ShelleyBlock p AllegraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2 (IgnoringOverflow ByteSize32
 -> TxMeasure (ShelleyBlock p AllegraEra))
-> (Ticked LedgerState (ShelleyBlock p AllegraEra) mk
    -> IgnoringOverflow ByteSize32)
-> Ticked LedgerState (ShelleyBlock p AllegraEra) mk
-> TxMeasure (ShelleyBlock p AllegraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState (ShelleyBlock p AllegraEra) mk
-> IgnoringOverflow ByteSize32
forall proto era (mk :: * -> * -> *).
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era) mk
-> IgnoringOverflow ByteSize32
txsMaxBytes

  type TxEbMeasure (ShelleyBlock p AllegraEra) = TxMeasure (ShelleyBlock p AllegraEra)

  txEbMeasure :: forall (proxy :: * -> *).
proxy (ShelleyBlock p AllegraEra)
-> TxMeasure (ShelleyBlock p AllegraEra)
-> TxEbMeasure (ShelleyBlock p AllegraEra)
txEbMeasure proxy (ShelleyBlock p AllegraEra)
_ = TxMeasure (ShelleyBlock p AllegraEra)
-> TxEbMeasure (ShelleyBlock p AllegraEra)
TxMeasure (ShelleyBlock p AllegraEra)
-> TxMeasure (ShelleyBlock p AllegraEra)
forall a. a -> a
id

  ebCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p AllegraEra)
-> TickedLedgerState (ShelleyBlock p AllegraEra) mk
-> TxEbMeasure (ShelleyBlock p AllegraEra)
ebCapacityTxMeasure LedgerConfig (ShelleyBlock p AllegraEra)
_cfg TickedLedgerState (ShelleyBlock p AllegraEra) mk
_st = TxEbMeasure (ShelleyBlock p AllegraEra)
TxMeasure (ShelleyBlock p AllegraEra)
forall a. Measure a => a
zero
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy (ShelleyBlock p AllegraEra)
-> TxEbMeasure (ShelleyBlock p AllegraEra)
-> TxMeasure (ShelleyBlock p AllegraEra)
mempoolEbReservation proxy (ShelleyBlock p AllegraEra)
_ = TxEbMeasure (ShelleyBlock p AllegraEra)
-> TxMeasure (ShelleyBlock p AllegraEra)
TxMeasure (ShelleyBlock p AllegraEra)
-> TxMeasure (ShelleyBlock p AllegraEra)
forall a. a -> a
id

instance ShelleyCompatible p MaryEra => TxLimits (ShelleyBlock p MaryEra) where
  type TxMeasurePhase1 (ShelleyBlock p MaryEra) = IgnoringOverflow ByteSize32
  type TxMeasurePhase2 (ShelleyBlock p MaryEra) = TrivialTxMeasurePhase2
  txWireSize :: GenTx (ShelleyBlock p MaryEra) -> SizeInBytes
txWireSize (ShelleyTx TxId
_ Tx TopTx MaryEra
tx) = Word32 -> SizeInBytes
wrapCBORinCBOROverhead (Tx TopTx MaryEra
tx Tx TopTx MaryEra
-> Getting Word32 (Tx TopTx MaryEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx MaryEra) Word32
SimpleGetter (Tx TopTx MaryEra) Word32
forall era (l :: TxLevel).
EraTx era =>
SimpleGetter (Tx l era) Word32
wireSizeTxF)
  txMeasurePhase1 :: LedgerConfig (ShelleyBlock p MaryEra)
-> TickedLedgerState (ShelleyBlock p MaryEra) EmptyMK
-> GenTx (ShelleyBlock p MaryEra)
-> Except
     (ApplyTxErr (ShelleyBlock p MaryEra))
     (TxMeasurePhase1 (ShelleyBlock p MaryEra))
txMeasurePhase1 LedgerConfig (ShelleyBlock p MaryEra)
_cfg TickedLedgerState (ShelleyBlock p MaryEra) EmptyMK
st GenTx (ShelleyBlock p MaryEra)
tx = Validation
  (TxErrorSG MaryEra) (TxMeasurePhase1 (ShelleyBlock p MaryEra))
-> Except
     (ApplyTxError MaryEra) (TxMeasurePhase1 (ShelleyBlock p MaryEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG MaryEra) (TxMeasurePhase1 (ShelleyBlock p MaryEra))
 -> Except
      (ApplyTxError MaryEra) (TxMeasurePhase1 (ShelleyBlock p MaryEra)))
-> Validation
     (TxErrorSG MaryEra) (TxMeasurePhase1 (ShelleyBlock p MaryEra))
-> Except
     (ApplyTxError MaryEra) (TxMeasurePhase1 (ShelleyBlock p MaryEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p MaryEra) EmptyMK
-> GenTx (ShelleyBlock p MaryEra)
-> Validation (TxErrorSG MaryEra) (IgnoringOverflow ByteSize32)
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock p MaryEra) EmptyMK
st GenTx (ShelleyBlock p MaryEra)
tx
  txMeasurePhase2 :: LedgerConfig (ShelleyBlock p MaryEra)
-> TickedLedgerState (ShelleyBlock p MaryEra) ValuesMK
-> GenTx (ShelleyBlock p MaryEra)
-> Except
     (ApplyTxErr (ShelleyBlock p MaryEra))
     (TxMeasurePhase2 (ShelleyBlock p MaryEra))
txMeasurePhase2 LedgerConfig (ShelleyBlock p MaryEra)
_cfg TickedLedgerState (ShelleyBlock p MaryEra) ValuesMK
_st GenTx (ShelleyBlock p MaryEra)
_tx = TrivialTxMeasurePhase2
-> ExceptT (ApplyTxError MaryEra) Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT (ApplyTxError MaryEra) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p MaryEra)
-> TickedLedgerState (ShelleyBlock p MaryEra) mk
-> TxMeasure (ShelleyBlock p MaryEra)
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p MaryEra)
_cfg = (IgnoringOverflow ByteSize32
 -> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p MaryEra))
-> TrivialTxMeasurePhase2
-> IgnoringOverflow ByteSize32
-> TxMeasure (ShelleyBlock p MaryEra)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IgnoringOverflow ByteSize32
-> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p MaryEra)
TxMeasurePhase1 (ShelleyBlock p MaryEra)
-> TxMeasurePhase2 (ShelleyBlock p MaryEra)
-> TxMeasure (ShelleyBlock p MaryEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2 (IgnoringOverflow ByteSize32 -> TxMeasure (ShelleyBlock p MaryEra))
-> (Ticked LedgerState (ShelleyBlock p MaryEra) mk
    -> IgnoringOverflow ByteSize32)
-> Ticked LedgerState (ShelleyBlock p MaryEra) mk
-> TxMeasure (ShelleyBlock p MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState (ShelleyBlock p MaryEra) mk
-> IgnoringOverflow ByteSize32
forall proto era (mk :: * -> * -> *).
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era) mk
-> IgnoringOverflow ByteSize32
txsMaxBytes

  type TxEbMeasure (ShelleyBlock p MaryEra) = TxMeasure (ShelleyBlock p MaryEra)

  txEbMeasure :: forall (proxy :: * -> *).
proxy (ShelleyBlock p MaryEra)
-> TxMeasure (ShelleyBlock p MaryEra)
-> TxEbMeasure (ShelleyBlock p MaryEra)
txEbMeasure proxy (ShelleyBlock p MaryEra)
_ = TxMeasure (ShelleyBlock p MaryEra)
-> TxEbMeasure (ShelleyBlock p MaryEra)
TxMeasure (ShelleyBlock p MaryEra)
-> TxMeasure (ShelleyBlock p MaryEra)
forall a. a -> a
id

  ebCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p MaryEra)
-> TickedLedgerState (ShelleyBlock p MaryEra) mk
-> TxEbMeasure (ShelleyBlock p MaryEra)
ebCapacityTxMeasure LedgerConfig (ShelleyBlock p MaryEra)
_cfg TickedLedgerState (ShelleyBlock p MaryEra) mk
_st = TxEbMeasure (ShelleyBlock p MaryEra)
TxMeasure (ShelleyBlock p MaryEra)
forall a. Measure a => a
zero
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy (ShelleyBlock p MaryEra)
-> TxEbMeasure (ShelleyBlock p MaryEra)
-> TxMeasure (ShelleyBlock p MaryEra)
mempoolEbReservation proxy (ShelleyBlock p MaryEra)
_ = TxEbMeasure (ShelleyBlock p MaryEra)
-> TxMeasure (ShelleyBlock p MaryEra)
TxMeasure (ShelleyBlock p MaryEra)
-> TxMeasure (ShelleyBlock p MaryEra)
forall a. a -> a
id

-----

data AlonzoMeasure = AlonzoMeasure
  { AlonzoMeasure -> IgnoringOverflow ByteSize32
byteSize :: !(IgnoringOverflow ByteSize32)
  , AlonzoMeasure -> ExUnits' Natural
exUnits :: !(ExUnits' Natural)
  }
  deriving stock (AlonzoMeasure -> AlonzoMeasure -> Bool
(AlonzoMeasure -> AlonzoMeasure -> Bool)
-> (AlonzoMeasure -> AlonzoMeasure -> Bool) -> Eq AlonzoMeasure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlonzoMeasure -> AlonzoMeasure -> Bool
== :: AlonzoMeasure -> AlonzoMeasure -> Bool
$c/= :: AlonzoMeasure -> AlonzoMeasure -> Bool
/= :: AlonzoMeasure -> AlonzoMeasure -> Bool
Eq, (forall x. AlonzoMeasure -> Rep AlonzoMeasure x)
-> (forall x. Rep AlonzoMeasure x -> AlonzoMeasure)
-> Generic AlonzoMeasure
forall x. Rep AlonzoMeasure x -> AlonzoMeasure
forall x. AlonzoMeasure -> Rep AlonzoMeasure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AlonzoMeasure -> Rep AlonzoMeasure x
from :: forall x. AlonzoMeasure -> Rep AlonzoMeasure x
$cto :: forall x. Rep AlonzoMeasure x -> AlonzoMeasure
to :: forall x. Rep AlonzoMeasure x -> AlonzoMeasure
Generic, Int -> AlonzoMeasure -> ShowS
[AlonzoMeasure] -> ShowS
AlonzoMeasure -> String
(Int -> AlonzoMeasure -> ShowS)
-> (AlonzoMeasure -> String)
-> ([AlonzoMeasure] -> ShowS)
-> Show AlonzoMeasure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlonzoMeasure -> ShowS
showsPrec :: Int -> AlonzoMeasure -> ShowS
$cshow :: AlonzoMeasure -> String
show :: AlonzoMeasure -> String
$cshowList :: [AlonzoMeasure] -> ShowS
showList :: [AlonzoMeasure] -> ShowS
Show)
  deriving anyclass Context -> AlonzoMeasure -> IO (Maybe ThunkInfo)
Proxy AlonzoMeasure -> String
(Context -> AlonzoMeasure -> IO (Maybe ThunkInfo))
-> (Context -> AlonzoMeasure -> IO (Maybe ThunkInfo))
-> (Proxy AlonzoMeasure -> String)
-> NoThunks AlonzoMeasure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> AlonzoMeasure -> IO (Maybe ThunkInfo)
noThunks :: Context -> AlonzoMeasure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AlonzoMeasure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> AlonzoMeasure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy AlonzoMeasure -> String
showTypeOf :: Proxy AlonzoMeasure -> String
NoThunks
  deriving
    Eq AlonzoMeasure
AlonzoMeasure
Eq AlonzoMeasure =>
AlonzoMeasure
-> (AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure)
-> (AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure)
-> (AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure)
-> Measure AlonzoMeasure
AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
forall a.
Eq a =>
a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> Measure a
$czero :: AlonzoMeasure
zero :: AlonzoMeasure
$cplus :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
plus :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
$cmin :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
min :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
$cmax :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
max :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
Measure
    via (InstantiatedAt Generic AlonzoMeasure)

instance HasByteSize AlonzoMeasure where
  txMeasureByteSize :: AlonzoMeasure -> ByteSize32
txMeasureByteSize = IgnoringOverflow ByteSize32 -> ByteSize32
forall a. IgnoringOverflow a -> a
unIgnoringOverflow (IgnoringOverflow ByteSize32 -> ByteSize32)
-> (AlonzoMeasure -> IgnoringOverflow ByteSize32)
-> AlonzoMeasure
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoMeasure -> IgnoringOverflow ByteSize32
byteSize

instance Semigroup AlonzoMeasure where
  AlonzoMeasure IgnoringOverflow ByteSize32
b1 ExUnits' Natural
e1 <> :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
<> AlonzoMeasure IgnoringOverflow ByteSize32
b2 ExUnits' Natural
e2 =
    IgnoringOverflow ByteSize32 -> ExUnits' Natural -> AlonzoMeasure
AlonzoMeasure (IgnoringOverflow ByteSize32
b1 IgnoringOverflow ByteSize32
-> IgnoringOverflow ByteSize32 -> IgnoringOverflow ByteSize32
forall a. Semigroup a => a -> a -> a
<> IgnoringOverflow ByteSize32
b2) (ExUnits' Natural
e1 ExUnits' Natural -> ExUnits' Natural -> ExUnits' Natural
forall a. Semigroup a => a -> a -> a
<> ExUnits' Natural
e2)

instance Monoid AlonzoMeasure where
  mappend :: AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
mappend = AlonzoMeasure -> AlonzoMeasure -> AlonzoMeasure
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: AlonzoMeasure
mempty = IgnoringOverflow ByteSize32 -> ExUnits' Natural -> AlonzoMeasure
AlonzoMeasure IgnoringOverflow ByteSize32
forall a. Monoid a => a
mempty ExUnits' Natural
forall a. Monoid a => a
mempty

instance TxMeasurePhase1Metrics AlonzoMeasure where
  txMeasureMetricTxSizeBytes :: AlonzoMeasure -> ByteSize32
txMeasureMetricTxSizeBytes = IgnoringOverflow ByteSize32 -> ByteSize32
forall msr. TxMeasurePhase1Metrics msr => msr -> ByteSize32
txMeasureMetricTxSizeBytes (IgnoringOverflow ByteSize32 -> ByteSize32)
-> (AlonzoMeasure -> IgnoringOverflow ByteSize32)
-> AlonzoMeasure
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoMeasure -> IgnoringOverflow ByteSize32
byteSize
  txMeasureMetricExUnitsMemory :: AlonzoMeasure -> Natural
txMeasureMetricExUnitsMemory = ExUnits' Natural -> Natural
forall a. ExUnits' a -> a
exUnitsMem' (ExUnits' Natural -> Natural)
-> (AlonzoMeasure -> ExUnits' Natural) -> AlonzoMeasure -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoMeasure -> ExUnits' Natural
exUnits
  txMeasureMetricExUnitsSteps :: AlonzoMeasure -> Natural
txMeasureMetricExUnitsSteps = ExUnits' Natural -> Natural
forall a. ExUnits' a -> a
exUnitsSteps' (ExUnits' Natural -> Natural)
-> (AlonzoMeasure -> ExUnits' Natural) -> AlonzoMeasure -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoMeasure -> ExUnits' Natural
exUnits

fromExUnits :: ExUnits -> ExUnits' Natural
fromExUnits :: ExUnits -> ExUnits' Natural
fromExUnits = ExUnits -> ExUnits' Natural
unWrapExUnits

blockCapacityAlonzoMeasure ::
  forall proto era mk.
  (ShelleyCompatible proto era, L.AlonzoEraPParams era) =>
  TickedLedgerState (ShelleyBlock proto era) mk ->
  AlonzoMeasure
blockCapacityAlonzoMeasure :: forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) mk -> AlonzoMeasure
blockCapacityAlonzoMeasure TickedLedgerState (ShelleyBlock proto era) mk
ledgerState =
  AlonzoMeasure
    { byteSize :: IgnoringOverflow ByteSize32
byteSize = TickedLedgerState (ShelleyBlock proto era) mk
-> IgnoringOverflow ByteSize32
forall proto era (mk :: * -> * -> *).
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era) mk
-> IgnoringOverflow ByteSize32
txsMaxBytes TickedLedgerState (ShelleyBlock proto era) mk
ledgerState
    , exUnits :: ExUnits' Natural
exUnits = ExUnits -> ExUnits' Natural
fromExUnits (ExUnits -> ExUnits' Natural) -> ExUnits -> ExUnits' Natural
forall a b. (a -> b) -> a -> b
$ PParams era
pparams PParams era -> Getting ExUnits (PParams era) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams era) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL
    }
 where
  pparams :: PParams era
pparams = NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams era)
-> NewEpochState era -> PParams era
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era) mk -> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) mk
ledgerState

txMeasureAlonzo ::
  forall proto era.
  ( ShelleyCompatible proto era
  , L.AlonzoEraTx era
  , ExUnitsTooBigUTxO era
  , MaxTxSizeUTxO era
  ) =>
  TickedLedgerState (ShelleyBlock proto era) EmptyMK ->
  GenTx (ShelleyBlock proto era) ->
  V.Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo :: forall proto era.
(ShelleyCompatible proto era, AlonzoEraTx era,
 ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock proto era) EmptyMK
st tx :: GenTx (ShelleyBlock proto era)
tx@(ShelleyTx TxId
_txid Tx TopTx era
tx') =
  IgnoringOverflow ByteSize32 -> ExUnits' Natural -> AlonzoMeasure
AlonzoMeasure (IgnoringOverflow ByteSize32 -> ExUnits' Natural -> AlonzoMeasure)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) (ExUnits' Natural -> AlonzoMeasure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock proto era) EmptyMK
st GenTx (ShelleyBlock proto era)
tx Validation (TxErrorSG era) (ExUnits' Natural -> AlonzoMeasure)
-> Validation (TxErrorSG era) (ExUnits' Natural)
-> Validation (TxErrorSG era) AlonzoMeasure
forall a b.
Validation (TxErrorSG era) (a -> b)
-> Validation (TxErrorSG era) a -> Validation (TxErrorSG era) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation (TxErrorSG era) (ExUnits' Natural)
exunits
 where
  txsz :: ExUnits
txsz = Tx TopTx era -> ExUnits
forall era (l :: TxLevel). AlonzoEraTx era => Tx l era -> ExUnits
forall (l :: TxLevel). Tx l era -> ExUnits
getTotalExUnits Tx TopTx era
tx'

  pparams :: PParams era
pparams = NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams era)
-> NewEpochState era -> PParams era
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) EmptyMK
st
  limit :: ExUnits
limit = PParams era
pparams PParams era -> Getting ExUnits (PParams era) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams era) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
L.ppMaxTxExUnitsL

  exunits :: Validation (TxErrorSG era) (ExUnits' Natural)
exunits =
    ApplyTxError era
-> Maybe (ExUnits' Natural)
-> Validation (TxErrorSG era) (ExUnits' Natural)
forall era a.
ApplyTxError era -> Maybe a -> Validation (TxErrorSG era) a
validateMaybe (ExUnits -> ExUnits -> ApplyTxError era
forall era.
ExUnitsTooBigUTxO era =>
ExUnits -> ExUnits -> ApplyTxError era
exUnitsTooBigUTxO ExUnits
txsz ExUnits
limit) (Maybe (ExUnits' Natural)
 -> Validation (TxErrorSG era) (ExUnits' Natural))
-> Maybe (ExUnits' Natural)
-> Validation (TxErrorSG era) (ExUnits' Natural)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural -> Bool) -> ExUnits -> ExUnits -> Bool
pointWiseExUnits Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ExUnits
txsz ExUnits
limit
      ExUnits' Natural -> Maybe (ExUnits' Natural)
forall a. a -> Maybe a
Just (ExUnits' Natural -> Maybe (ExUnits' Natural))
-> ExUnits' Natural -> Maybe (ExUnits' Natural)
forall a b. (a -> b) -> a -> b
$ ExUnits -> ExUnits' Natural
fromExUnits ExUnits
txsz

class ExUnitsTooBigUTxO era where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> SL.ApplyTxError era

instance ExUnitsTooBigUTxO AlonzoEra where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> ApplyTxError AlonzoEra
exUnitsTooBigUTxO ExUnits
txsz ExUnits
limit =
    NonEmpty (ShelleyLedgerPredFailure AlonzoEra)
-> ApplyTxError AlonzoEra
AlonzoApplyTxError (NonEmpty (ShelleyLedgerPredFailure AlonzoEra)
 -> ApplyTxError AlonzoEra)
-> (ShelleyLedgerPredFailure AlonzoEra
    -> NonEmpty (ShelleyLedgerPredFailure AlonzoEra))
-> ShelleyLedgerPredFailure AlonzoEra
-> ApplyTxError AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure AlonzoEra
-> NonEmpty (ShelleyLedgerPredFailure AlonzoEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure AlonzoEra -> ApplyTxError AlonzoEra)
-> ShelleyLedgerPredFailure AlonzoEra -> ApplyTxError AlonzoEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" AlonzoEra)
-> ShelleyLedgerPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure (PredicateFailure (EraRule "UTXOW" AlonzoEra)
 -> ShelleyLedgerPredFailure AlonzoEra)
-> PredicateFailure (EraRule "UTXOW" AlonzoEra)
-> ShelleyLedgerPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
        ShelleyUtxowPredFailure AlonzoEra
-> AlonzoUtxowPredFailure AlonzoEra
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
AlonzoEra.ShelleyInAlonzoUtxowPredFailure (ShelleyUtxowPredFailure AlonzoEra
 -> AlonzoUtxowPredFailure AlonzoEra)
-> ShelleyUtxowPredFailure AlonzoEra
-> AlonzoUtxowPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "UTXO" AlonzoEra)
-> ShelleyUtxowPredFailure AlonzoEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure (PredicateFailure (EraRule "UTXO" AlonzoEra)
 -> ShelleyUtxowPredFailure AlonzoEra)
-> PredicateFailure (EraRule "UTXO" AlonzoEra)
-> ShelleyUtxowPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
            Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure AlonzoEra
forall era.
Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure era
AlonzoEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure AlonzoEra)
-> Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
              L.Mismatch
                { mismatchSupplied :: OrdExUnits
mismatchSupplied = ExUnits -> OrdExUnits
OrdExUnits ExUnits
txsz
                , mismatchExpected :: OrdExUnits
mismatchExpected = ExUnits -> OrdExUnits
OrdExUnits ExUnits
limit
                }

instance ExUnitsTooBigUTxO BabbageEra where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> ApplyTxError BabbageEra
exUnitsTooBigUTxO ExUnits
txsz ExUnits
limit =
    NonEmpty (ShelleyLedgerPredFailure BabbageEra)
-> ApplyTxError BabbageEra
BabbageApplyTxError (NonEmpty (ShelleyLedgerPredFailure BabbageEra)
 -> ApplyTxError BabbageEra)
-> (ShelleyLedgerPredFailure BabbageEra
    -> NonEmpty (ShelleyLedgerPredFailure BabbageEra))
-> ShelleyLedgerPredFailure BabbageEra
-> ApplyTxError BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure BabbageEra
-> NonEmpty (ShelleyLedgerPredFailure BabbageEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure BabbageEra -> ApplyTxError BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra -> ApplyTxError BabbageEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure (PredicateFailure (EraRule "UTXOW" BabbageEra)
 -> ShelleyLedgerPredFailure BabbageEra)
-> PredicateFailure (EraRule "UTXOW" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
        AlonzoUtxowPredFailure BabbageEra
-> BabbageUtxowPredFailure BabbageEra
forall era.
AlonzoUtxowPredFailure era -> BabbageUtxowPredFailure era
BabbageEra.AlonzoInBabbageUtxowPredFailure (AlonzoUtxowPredFailure BabbageEra
 -> BabbageUtxowPredFailure BabbageEra)
-> AlonzoUtxowPredFailure BabbageEra
-> BabbageUtxowPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
          ShelleyUtxowPredFailure BabbageEra
-> AlonzoUtxowPredFailure BabbageEra
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
AlonzoEra.ShelleyInAlonzoUtxowPredFailure (ShelleyUtxowPredFailure BabbageEra
 -> AlonzoUtxowPredFailure BabbageEra)
-> ShelleyUtxowPredFailure BabbageEra
-> AlonzoUtxowPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
            PredicateFailure (EraRule "UTXO" BabbageEra)
-> ShelleyUtxowPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure (PredicateFailure (EraRule "UTXO" BabbageEra)
 -> ShelleyUtxowPredFailure BabbageEra)
-> PredicateFailure (EraRule "UTXO" BabbageEra)
-> ShelleyUtxowPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
              AlonzoUtxoPredFailure BabbageEra
-> BabbageUtxoPredFailure BabbageEra
forall era. AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era
BabbageEra.AlonzoInBabbageUtxoPredFailure (AlonzoUtxoPredFailure BabbageEra
 -> BabbageUtxoPredFailure BabbageEra)
-> AlonzoUtxoPredFailure BabbageEra
-> BabbageUtxoPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
                Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure BabbageEra
forall era.
Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure era
AlonzoEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure BabbageEra)
-> Mismatch RelLTEQ OrdExUnits -> AlonzoUtxoPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
                  L.Mismatch
                    { mismatchSupplied :: OrdExUnits
mismatchSupplied = ExUnits -> OrdExUnits
OrdExUnits ExUnits
txsz
                    , mismatchExpected :: OrdExUnits
mismatchExpected = ExUnits -> OrdExUnits
OrdExUnits ExUnits
limit
                    }

instance ExUnitsTooBigUTxO ConwayEra where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> ApplyTxError ConwayEra
exUnitsTooBigUTxO ExUnits
txsz ExUnits
limit =
    NonEmpty (ConwayLedgerPredFailure ConwayEra)
-> ApplyTxError ConwayEra
ConwayApplyTxError (NonEmpty (ConwayLedgerPredFailure ConwayEra)
 -> ApplyTxError ConwayEra)
-> (ConwayLedgerPredFailure ConwayEra
    -> NonEmpty (ConwayLedgerPredFailure ConwayEra))
-> ConwayLedgerPredFailure ConwayEra
-> ApplyTxError ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayLedgerPredFailure ConwayEra
-> NonEmpty (ConwayLedgerPredFailure ConwayEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConwayLedgerPredFailure ConwayEra -> ApplyTxError ConwayEra)
-> ConwayLedgerPredFailure ConwayEra -> ApplyTxError ConwayEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "UTXOW" ConwayEra)
-> ConwayLedgerPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayEra.ConwayUtxowFailure (PredicateFailure (EraRule "UTXOW" ConwayEra)
 -> ConwayLedgerPredFailure ConwayEra)
-> PredicateFailure (EraRule "UTXOW" ConwayEra)
-> ConwayLedgerPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXO" ConwayEra)
-> ConwayUtxowPredFailure ConwayEra
forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
ConwayEra.UtxoFailure (PredicateFailure (EraRule "UTXO" ConwayEra)
 -> ConwayUtxowPredFailure ConwayEra)
-> PredicateFailure (EraRule "UTXO" ConwayEra)
-> ConwayUtxowPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
          Mismatch RelLTEQ OrdExUnits -> ConwayUtxoPredFailure ConwayEra
forall era.
Mismatch RelLTEQ OrdExUnits -> ConwayUtxoPredFailure era
ConwayEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ OrdExUnits -> ConwayUtxoPredFailure ConwayEra)
-> Mismatch RelLTEQ OrdExUnits -> ConwayUtxoPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
            L.Mismatch
              { mismatchSupplied :: OrdExUnits
mismatchSupplied = ExUnits -> OrdExUnits
OrdExUnits ExUnits
txsz
              , mismatchExpected :: OrdExUnits
mismatchExpected = ExUnits -> OrdExUnits
OrdExUnits ExUnits
limit
              }

instance ExUnitsTooBigUTxO DijkstraEra where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> ApplyTxError DijkstraEra
exUnitsTooBigUTxO ExUnits
txsz ExUnits
limit =
    NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
 -> ApplyTxError DijkstraEra)
-> (DijkstraMempoolPredFailure DijkstraEra
    -> NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
-> DijkstraMempoolPredFailure DijkstraEra
-> ApplyTxError DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DijkstraMempoolPredFailure DijkstraEra
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DijkstraMempoolPredFailure DijkstraEra
 -> ApplyTxError DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
-> ApplyTxError DijkstraEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> DijkstraMempoolPredFailure era
DijkstraEra.LedgerFailure (PredicateFailure (EraRule "LEDGER" DijkstraEra)
 -> DijkstraMempoolPredFailure DijkstraEra)
-> PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "UTXOW" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> DijkstraLedgerPredFailure era
DijkstraEra.DijkstraUtxowFailure (PredicateFailure (EraRule "UTXOW" DijkstraEra)
 -> DijkstraLedgerPredFailure DijkstraEra)
-> PredicateFailure (EraRule "UTXOW" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "UTXO" DijkstraEra)
-> DijkstraUtxowPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> DijkstraUtxowPredFailure era
DijkstraEra.UtxoFailure (PredicateFailure (EraRule "UTXO" DijkstraEra)
 -> DijkstraUtxowPredFailure DijkstraEra)
-> PredicateFailure (EraRule "UTXO" DijkstraEra)
-> DijkstraUtxowPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
            Mismatch RelLTEQ OrdExUnits -> DijkstraUtxoPredFailure DijkstraEra
forall era.
Mismatch RelLTEQ OrdExUnits -> DijkstraUtxoPredFailure era
DijkstraEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ OrdExUnits
 -> DijkstraUtxoPredFailure DijkstraEra)
-> Mismatch RelLTEQ OrdExUnits
-> DijkstraUtxoPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
              L.Mismatch
                { mismatchSupplied :: OrdExUnits
mismatchSupplied = ExUnits -> OrdExUnits
OrdExUnits ExUnits
txsz
                , mismatchExpected :: OrdExUnits
mismatchExpected = ExUnits -> OrdExUnits
OrdExUnits ExUnits
limit
                }

-----

instance
  ShelleyCompatible p AlonzoEra =>
  TxLimits (ShelleyBlock p AlonzoEra)
  where
  type TxMeasurePhase1 (ShelleyBlock p AlonzoEra) = AlonzoMeasure
  type TxMeasurePhase2 (ShelleyBlock p AlonzoEra) = TrivialTxMeasurePhase2
  txWireSize :: GenTx (ShelleyBlock p AlonzoEra) -> SizeInBytes
txWireSize (ShelleyTx TxId
_ Tx TopTx AlonzoEra
tx) = Word32 -> SizeInBytes
wrapCBORinCBOROverhead (Tx TopTx AlonzoEra
tx Tx TopTx AlonzoEra
-> Getting Word32 (Tx TopTx AlonzoEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx AlonzoEra) Word32
SimpleGetter (Tx TopTx AlonzoEra) Word32
forall era (l :: TxLevel).
EraTx era =>
SimpleGetter (Tx l era) Word32
wireSizeTxF)
  txMeasurePhase1 :: LedgerConfig (ShelleyBlock p AlonzoEra)
-> TickedLedgerState (ShelleyBlock p AlonzoEra) EmptyMK
-> GenTx (ShelleyBlock p AlonzoEra)
-> Except
     (ApplyTxErr (ShelleyBlock p AlonzoEra))
     (TxMeasurePhase1 (ShelleyBlock p AlonzoEra))
txMeasurePhase1 LedgerConfig (ShelleyBlock p AlonzoEra)
_cfg TickedLedgerState (ShelleyBlock p AlonzoEra) EmptyMK
st GenTx (ShelleyBlock p AlonzoEra)
tx = Validation
  (TxErrorSG AlonzoEra) (TxMeasurePhase1 (ShelleyBlock p AlonzoEra))
-> Except
     (ApplyTxError AlonzoEra)
     (TxMeasurePhase1 (ShelleyBlock p AlonzoEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG AlonzoEra) (TxMeasurePhase1 (ShelleyBlock p AlonzoEra))
 -> Except
      (ApplyTxError AlonzoEra)
      (TxMeasurePhase1 (ShelleyBlock p AlonzoEra)))
-> Validation
     (TxErrorSG AlonzoEra) (TxMeasurePhase1 (ShelleyBlock p AlonzoEra))
-> Except
     (ApplyTxError AlonzoEra)
     (TxMeasurePhase1 (ShelleyBlock p AlonzoEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p AlonzoEra) EmptyMK
-> GenTx (ShelleyBlock p AlonzoEra)
-> Validation (TxErrorSG AlonzoEra) AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraTx era,
 ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock p AlonzoEra) EmptyMK
st GenTx (ShelleyBlock p AlonzoEra)
tx
  txMeasurePhase2 :: LedgerConfig (ShelleyBlock p AlonzoEra)
-> TickedLedgerState (ShelleyBlock p AlonzoEra) ValuesMK
-> GenTx (ShelleyBlock p AlonzoEra)
-> Except
     (ApplyTxErr (ShelleyBlock p AlonzoEra))
     (TxMeasurePhase2 (ShelleyBlock p AlonzoEra))
txMeasurePhase2 LedgerConfig (ShelleyBlock p AlonzoEra)
_cfg TickedLedgerState (ShelleyBlock p AlonzoEra) ValuesMK
_st GenTx (ShelleyBlock p AlonzoEra)
_tx = TrivialTxMeasurePhase2
-> ExceptT (ApplyTxError AlonzoEra) Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT (ApplyTxError AlonzoEra) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p AlonzoEra)
-> TickedLedgerState (ShelleyBlock p AlonzoEra) mk
-> TxMeasure (ShelleyBlock p AlonzoEra)
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p AlonzoEra)
_cfg = (AlonzoMeasure
 -> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p AlonzoEra))
-> TrivialTxMeasurePhase2
-> AlonzoMeasure
-> TxMeasure (ShelleyBlock p AlonzoEra)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TxMeasurePhase1 (ShelleyBlock p AlonzoEra)
-> TxMeasurePhase2 (ShelleyBlock p AlonzoEra)
-> TxMeasure (ShelleyBlock p AlonzoEra)
AlonzoMeasure
-> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p AlonzoEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2 (AlonzoMeasure -> TxMeasure (ShelleyBlock p AlonzoEra))
-> (Ticked LedgerState (ShelleyBlock p AlonzoEra) mk
    -> AlonzoMeasure)
-> Ticked LedgerState (ShelleyBlock p AlonzoEra) mk
-> TxMeasure (ShelleyBlock p AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState (ShelleyBlock p AlonzoEra) mk -> AlonzoMeasure
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) mk -> AlonzoMeasure
blockCapacityAlonzoMeasure

  type TxEbMeasure (ShelleyBlock p AlonzoEra) = TxMeasure (ShelleyBlock p AlonzoEra)

  txEbMeasure :: forall (proxy :: * -> *).
proxy (ShelleyBlock p AlonzoEra)
-> TxMeasure (ShelleyBlock p AlonzoEra)
-> TxEbMeasure (ShelleyBlock p AlonzoEra)
txEbMeasure proxy (ShelleyBlock p AlonzoEra)
_ = TxMeasure (ShelleyBlock p AlonzoEra)
-> TxEbMeasure (ShelleyBlock p AlonzoEra)
TxMeasure (ShelleyBlock p AlonzoEra)
-> TxMeasure (ShelleyBlock p AlonzoEra)
forall a. a -> a
id

  ebCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p AlonzoEra)
-> TickedLedgerState (ShelleyBlock p AlonzoEra) mk
-> TxEbMeasure (ShelleyBlock p AlonzoEra)
ebCapacityTxMeasure LedgerConfig (ShelleyBlock p AlonzoEra)
_cfg TickedLedgerState (ShelleyBlock p AlonzoEra) mk
_st = TxEbMeasure (ShelleyBlock p AlonzoEra)
TxMeasure (ShelleyBlock p AlonzoEra)
forall a. Measure a => a
zero
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy (ShelleyBlock p AlonzoEra)
-> TxEbMeasure (ShelleyBlock p AlonzoEra)
-> TxMeasure (ShelleyBlock p AlonzoEra)
mempoolEbReservation proxy (ShelleyBlock p AlonzoEra)
_ = TxEbMeasure (ShelleyBlock p AlonzoEra)
-> TxMeasure (ShelleyBlock p AlonzoEra)
TxMeasure (ShelleyBlock p AlonzoEra)
-> TxMeasure (ShelleyBlock p AlonzoEra)
forall a. a -> a
id

-----

newtype RefScriptSize = RefScriptSize {RefScriptSize -> IgnoringOverflow ByteSize32
refScriptsSize :: IgnoringOverflow ByteSize32}
  deriving (RefScriptSize -> RefScriptSize -> Bool
(RefScriptSize -> RefScriptSize -> Bool)
-> (RefScriptSize -> RefScriptSize -> Bool) -> Eq RefScriptSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RefScriptSize -> RefScriptSize -> Bool
== :: RefScriptSize -> RefScriptSize -> Bool
$c/= :: RefScriptSize -> RefScriptSize -> Bool
/= :: RefScriptSize -> RefScriptSize -> Bool
Eq, (forall x. RefScriptSize -> Rep RefScriptSize x)
-> (forall x. Rep RefScriptSize x -> RefScriptSize)
-> Generic RefScriptSize
forall x. Rep RefScriptSize x -> RefScriptSize
forall x. RefScriptSize -> Rep RefScriptSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RefScriptSize -> Rep RefScriptSize x
from :: forall x. RefScriptSize -> Rep RefScriptSize x
$cto :: forall x. Rep RefScriptSize x -> RefScriptSize
to :: forall x. Rep RefScriptSize x -> RefScriptSize
Generic, Int -> RefScriptSize -> ShowS
[RefScriptSize] -> ShowS
RefScriptSize -> String
(Int -> RefScriptSize -> ShowS)
-> (RefScriptSize -> String)
-> ([RefScriptSize] -> ShowS)
-> Show RefScriptSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RefScriptSize -> ShowS
showsPrec :: Int -> RefScriptSize -> ShowS
$cshow :: RefScriptSize -> String
show :: RefScriptSize -> String
$cshowList :: [RefScriptSize] -> ShowS
showList :: [RefScriptSize] -> ShowS
Show)
  deriving newtype (Context -> RefScriptSize -> IO (Maybe ThunkInfo)
Proxy RefScriptSize -> String
(Context -> RefScriptSize -> IO (Maybe ThunkInfo))
-> (Context -> RefScriptSize -> IO (Maybe ThunkInfo))
-> (Proxy RefScriptSize -> String)
-> NoThunks RefScriptSize
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> RefScriptSize -> IO (Maybe ThunkInfo)
noThunks :: Context -> RefScriptSize -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RefScriptSize -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RefScriptSize -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy RefScriptSize -> String
showTypeOf :: Proxy RefScriptSize -> String
NoThunks, Eq RefScriptSize
RefScriptSize
Eq RefScriptSize =>
RefScriptSize
-> (RefScriptSize -> RefScriptSize -> RefScriptSize)
-> (RefScriptSize -> RefScriptSize -> RefScriptSize)
-> (RefScriptSize -> RefScriptSize -> RefScriptSize)
-> Measure RefScriptSize
RefScriptSize -> RefScriptSize -> RefScriptSize
forall a.
Eq a =>
a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> Measure a
$czero :: RefScriptSize
zero :: RefScriptSize
$cplus :: RefScriptSize -> RefScriptSize -> RefScriptSize
plus :: RefScriptSize -> RefScriptSize -> RefScriptSize
$cmin :: RefScriptSize -> RefScriptSize -> RefScriptSize
min :: RefScriptSize -> RefScriptSize -> RefScriptSize
$cmax :: RefScriptSize -> RefScriptSize -> RefScriptSize
max :: RefScriptSize -> RefScriptSize -> RefScriptSize
Measure, NonEmpty RefScriptSize -> RefScriptSize
RefScriptSize -> RefScriptSize -> RefScriptSize
(RefScriptSize -> RefScriptSize -> RefScriptSize)
-> (NonEmpty RefScriptSize -> RefScriptSize)
-> (forall b. Integral b => b -> RefScriptSize -> RefScriptSize)
-> Semigroup RefScriptSize
forall b. Integral b => b -> RefScriptSize -> RefScriptSize
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RefScriptSize -> RefScriptSize -> RefScriptSize
<> :: RefScriptSize -> RefScriptSize -> RefScriptSize
$csconcat :: NonEmpty RefScriptSize -> RefScriptSize
sconcat :: NonEmpty RefScriptSize -> RefScriptSize
$cstimes :: forall b. Integral b => b -> RefScriptSize -> RefScriptSize
stimes :: forall b. Integral b => b -> RefScriptSize -> RefScriptSize
Semigroup, Semigroup RefScriptSize
RefScriptSize
Semigroup RefScriptSize =>
RefScriptSize
-> (RefScriptSize -> RefScriptSize -> RefScriptSize)
-> ([RefScriptSize] -> RefScriptSize)
-> Monoid RefScriptSize
[RefScriptSize] -> RefScriptSize
RefScriptSize -> RefScriptSize -> RefScriptSize
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: RefScriptSize
mempty :: RefScriptSize
$cmappend :: RefScriptSize -> RefScriptSize -> RefScriptSize
mappend :: RefScriptSize -> RefScriptSize -> RefScriptSize
$cmconcat :: [RefScriptSize] -> RefScriptSize
mconcat :: [RefScriptSize] -> RefScriptSize
Monoid)

instance TxMeasurePhase2Metrics RefScriptSize where
  txMeasureMetricRefScriptsSizeBytes :: RefScriptSize -> ByteSize32
txMeasureMetricRefScriptsSizeBytes = IgnoringOverflow ByteSize32 -> ByteSize32
forall a. IgnoringOverflow a -> a
unIgnoringOverflow (IgnoringOverflow ByteSize32 -> ByteSize32)
-> (RefScriptSize -> IgnoringOverflow ByteSize32)
-> RefScriptSize
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefScriptSize -> IgnoringOverflow ByteSize32
refScriptsSize

blockCapacityConwayMeasure ::
  forall proto era mk.
  ( ShelleyCompatible proto era
  , SL.ConwayEraPParams era
  ) =>
  TickedLedgerState (ShelleyBlock proto era) mk ->
  (AlonzoMeasure, RefScriptSize)
blockCapacityConwayMeasure :: forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, ConwayEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> (AlonzoMeasure, RefScriptSize)
blockCapacityConwayMeasure TickedLedgerState (ShelleyBlock proto era) mk
st =
  ( TickedLedgerState (ShelleyBlock proto era) mk -> AlonzoMeasure
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) mk -> AlonzoMeasure
blockCapacityAlonzoMeasure TickedLedgerState (ShelleyBlock proto era) mk
st
  , IgnoringOverflow ByteSize32 -> RefScriptSize
RefScriptSize (IgnoringOverflow ByteSize32 -> RefScriptSize)
-> IgnoringOverflow ByteSize32 -> RefScriptSize
forall a b. (a -> b) -> a -> b
$
      ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$
        Word32 -> ByteSize32
ByteSize32 (PParams era
pparams PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era.
ConwayEraPParams era =>
SimpleGetter (PParams era) Word32
SimpleGetter (PParams era) Word32
SL.ppMaxRefScriptSizePerBlockG)
  )
 where
  pparams :: PParams era
pparams = NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams era)
-> NewEpochState era -> PParams era
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era) mk -> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) mk
st

txMeasureRefScripts ::
  forall proto era.
  ( ShelleyCompatible proto era
  , L.BabbageEraTxBody era
  , TxRefScriptsSizeTooBig era
  , SL.ConwayEraPParams era
  ) =>
  TickedLedgerState (ShelleyBlock proto era) ValuesMK ->
  GenTx (ShelleyBlock proto era) ->
  V.Validation (TxErrorSG era) RefScriptSize
txMeasureRefScripts :: forall proto era.
(ShelleyCompatible proto era, BabbageEraTxBody era,
 TxRefScriptsSizeTooBig era, ConwayEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) RefScriptSize
txMeasureRefScripts TickedLedgerState (ShelleyBlock proto era) ValuesMK
st (ShelleyTx TxId
_txid Tx TopTx era
tx') =
  IgnoringOverflow ByteSize32 -> RefScriptSize
RefScriptSize (IgnoringOverflow ByteSize32 -> RefScriptSize)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) RefScriptSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
refScriptBytes
 where
  ValuesMK Map
  (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
utxo = LedgerTables (ShelleyBlock proto era) ValuesMK
-> ValuesMK
     (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
forall blk (mk :: * -> * -> *).
LedgerTables blk mk -> mk (TxIn blk) (TxOut blk)
getLedgerTables (LedgerTables (ShelleyBlock proto era) ValuesMK
 -> ValuesMK
      (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era)))
-> LedgerTables (ShelleyBlock proto era) ValuesMK
-> ValuesMK
     (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> LedgerTables (ShelleyBlock proto era) ValuesMK
forall (mk :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (ShelleyBlock proto era) mk
forall (l :: * -> (* -> * -> *) -> *) blk (mk :: * -> * -> *).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
projectLedgerTables TickedLedgerState (ShelleyBlock proto era) ValuesMK
st
  txsz :: Int
txsz = UTxO era -> Tx TopTx era -> Int
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> Int
SL.txNonDistinctRefScriptsSize (Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
SL.UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ Map BigEndianTxIn (TxOut era) -> Map TxIn (TxOut era)
forall k1 k2 v. Coercible k1 k2 => Map k1 v -> Map k2 v
coerceMapKeys Map
  (TxIn (ShelleyBlock proto era)) (TxOut (ShelleyBlock proto era))
Map BigEndianTxIn (TxOut era)
utxo) Tx TopTx era
tx' :: Int

  pparams :: PParams era
pparams = NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams era)
-> NewEpochState era -> PParams era
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> NewEpochState era
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) ValuesMK
st

  limit :: Int
limit = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int (PParams era
pparams PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era.
ConwayEraPParams era =>
SimpleGetter (PParams era) Word32
SimpleGetter (PParams era) Word32
SL.ppMaxRefScriptSizePerTxG)

  refScriptBytes :: Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
refScriptBytes =
    ApplyTxError era
-> Maybe (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
forall era a.
ApplyTxError era -> Maybe a -> Validation (TxErrorSG era) a
validateMaybe (Int -> Int -> ApplyTxError era
forall era.
TxRefScriptsSizeTooBig era =>
Int -> Int -> ApplyTxError era
txRefScriptsSizeTooBig Int
txsz Int
limit) (Maybe (IgnoringOverflow ByteSize32)
 -> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32))
-> Maybe (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
txsz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limit
      IgnoringOverflow ByteSize32 -> Maybe (IgnoringOverflow ByteSize32)
forall a. a -> Maybe a
Just (IgnoringOverflow ByteSize32
 -> Maybe (IgnoringOverflow ByteSize32))
-> IgnoringOverflow ByteSize32
-> Maybe (IgnoringOverflow ByteSize32)
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
txsz

class TxRefScriptsSizeTooBig era where
  txRefScriptsSizeTooBig :: Int -> Int -> SL.ApplyTxError era

instance TxRefScriptsSizeTooBig ConwayEra where
  txRefScriptsSizeTooBig :: Int -> Int -> ApplyTxError ConwayEra
txRefScriptsSizeTooBig Int
txsz Int
limit =
    NonEmpty (ConwayLedgerPredFailure ConwayEra)
-> ApplyTxError ConwayEra
ConwayApplyTxError (NonEmpty (ConwayLedgerPredFailure ConwayEra)
 -> ApplyTxError ConwayEra)
-> (ConwayLedgerPredFailure ConwayEra
    -> NonEmpty (ConwayLedgerPredFailure ConwayEra))
-> ConwayLedgerPredFailure ConwayEra
-> ApplyTxError ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayLedgerPredFailure ConwayEra
-> NonEmpty (ConwayLedgerPredFailure ConwayEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConwayLedgerPredFailure ConwayEra -> ApplyTxError ConwayEra)
-> ConwayLedgerPredFailure ConwayEra -> ApplyTxError ConwayEra
forall a b. (a -> b) -> a -> b
$
      Mismatch RelLTEQ Int -> ConwayLedgerPredFailure ConwayEra
forall era. Mismatch RelLTEQ Int -> ConwayLedgerPredFailure era
ConwayEra.ConwayTxRefScriptsSizeTooBig (Mismatch RelLTEQ Int -> ConwayLedgerPredFailure ConwayEra)
-> Mismatch RelLTEQ Int -> ConwayLedgerPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
        L.Mismatch
          { mismatchSupplied :: Int
mismatchSupplied = Int
txsz
          , mismatchExpected :: Int
mismatchExpected = Int
limit
          }

instance TxRefScriptsSizeTooBig DijkstraEra where
  txRefScriptsSizeTooBig :: Int -> Int -> ApplyTxError DijkstraEra
txRefScriptsSizeTooBig Int
txsz Int
limit =
    NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
 -> ApplyTxError DijkstraEra)
-> (DijkstraMempoolPredFailure DijkstraEra
    -> NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
-> DijkstraMempoolPredFailure DijkstraEra
-> ApplyTxError DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DijkstraMempoolPredFailure DijkstraEra
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DijkstraMempoolPredFailure DijkstraEra
 -> ApplyTxError DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
-> ApplyTxError DijkstraEra
forall a b. (a -> b) -> a -> b
$
      PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> DijkstraMempoolPredFailure era
DijkstraEra.LedgerFailure (PredicateFailure (EraRule "LEDGER" DijkstraEra)
 -> DijkstraMempoolPredFailure DijkstraEra)
-> PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
        Mismatch RelLTEQ Int -> DijkstraLedgerPredFailure DijkstraEra
forall era. Mismatch RelLTEQ Int -> DijkstraLedgerPredFailure era
DijkstraEra.DijkstraTxRefScriptsSizeTooBig (Mismatch RelLTEQ Int -> DijkstraLedgerPredFailure DijkstraEra)
-> Mismatch RelLTEQ Int -> DijkstraLedgerPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
          L.Mismatch
            { mismatchSupplied :: Int
mismatchSupplied = Int
txsz
            , mismatchExpected :: Int
mismatchExpected = Int
limit
            }

-- | Measure of transactions in a Dijkstra-era Leios endorser block.
--
-- An endorser block carries references to transactions, while the referenced
-- transactions, its closure, must satisfy block-like limits. So this pairs the
-- closure's 'TxMeasure' with the one dimension specific to endorser blocks:
-- the size of the references themselves.
--
-- The closure type names one protocol, 'Praos' 'StandardCrypto'. The phase
-- measures do not depend on the protocol, so 'txEbMeasureDijkstra' and
-- 'mempoolEbReservation' rebuild the 'TxMeasure' for any protocol.
data DijkstraEbMeasure = DijkstraEbMeasure
  { DijkstraEbMeasure
-> TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
ebClosureMeasure :: !(TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra))
  , DijkstraEbMeasure -> IgnoringOverflow ByteSize32
txReferencesSize :: !(IgnoringOverflow ByteSize32)
  -- ^ Size of transaction references _excluding_ any framing overhead: of one
  -- transaction's reference, or summed over whatever is measured (an endorser
  -- block, a run of mempool transactions).
  }
  deriving stock (DijkstraEbMeasure -> DijkstraEbMeasure -> Bool
(DijkstraEbMeasure -> DijkstraEbMeasure -> Bool)
-> (DijkstraEbMeasure -> DijkstraEbMeasure -> Bool)
-> Eq DijkstraEbMeasure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DijkstraEbMeasure -> DijkstraEbMeasure -> Bool
== :: DijkstraEbMeasure -> DijkstraEbMeasure -> Bool
$c/= :: DijkstraEbMeasure -> DijkstraEbMeasure -> Bool
/= :: DijkstraEbMeasure -> DijkstraEbMeasure -> Bool
Eq, (forall x. DijkstraEbMeasure -> Rep DijkstraEbMeasure x)
-> (forall x. Rep DijkstraEbMeasure x -> DijkstraEbMeasure)
-> Generic DijkstraEbMeasure
forall x. Rep DijkstraEbMeasure x -> DijkstraEbMeasure
forall x. DijkstraEbMeasure -> Rep DijkstraEbMeasure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DijkstraEbMeasure -> Rep DijkstraEbMeasure x
from :: forall x. DijkstraEbMeasure -> Rep DijkstraEbMeasure x
$cto :: forall x. Rep DijkstraEbMeasure x -> DijkstraEbMeasure
to :: forall x. Rep DijkstraEbMeasure x -> DijkstraEbMeasure
Generic, Int -> DijkstraEbMeasure -> ShowS
[DijkstraEbMeasure] -> ShowS
DijkstraEbMeasure -> String
(Int -> DijkstraEbMeasure -> ShowS)
-> (DijkstraEbMeasure -> String)
-> ([DijkstraEbMeasure] -> ShowS)
-> Show DijkstraEbMeasure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DijkstraEbMeasure -> ShowS
showsPrec :: Int -> DijkstraEbMeasure -> ShowS
$cshow :: DijkstraEbMeasure -> String
show :: DijkstraEbMeasure -> String
$cshowList :: [DijkstraEbMeasure] -> ShowS
showList :: [DijkstraEbMeasure] -> ShowS
Show)
  deriving anyclass Context -> DijkstraEbMeasure -> IO (Maybe ThunkInfo)
Proxy DijkstraEbMeasure -> String
(Context -> DijkstraEbMeasure -> IO (Maybe ThunkInfo))
-> (Context -> DijkstraEbMeasure -> IO (Maybe ThunkInfo))
-> (Proxy DijkstraEbMeasure -> String)
-> NoThunks DijkstraEbMeasure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> DijkstraEbMeasure -> IO (Maybe ThunkInfo)
noThunks :: Context -> DijkstraEbMeasure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DijkstraEbMeasure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DijkstraEbMeasure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy DijkstraEbMeasure -> String
showTypeOf :: Proxy DijkstraEbMeasure -> String
NoThunks
  deriving
    Eq DijkstraEbMeasure
DijkstraEbMeasure
Eq DijkstraEbMeasure =>
DijkstraEbMeasure
-> (DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure)
-> (DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure)
-> (DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure)
-> Measure DijkstraEbMeasure
DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure
forall a.
Eq a =>
a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> Measure a
$czero :: DijkstraEbMeasure
zero :: DijkstraEbMeasure
$cplus :: DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure
plus :: DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure
$cmin :: DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure
min :: DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure
$cmax :: DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure
max :: DijkstraEbMeasure -> DijkstraEbMeasure -> DijkstraEbMeasure
Measure
    via (InstantiatedAt Generic DijkstraEbMeasure)

-- | The cost of one transaction in an endorser block: its closure cost is the
-- transaction's 'TxMeasure', and its reference costs the bytes
-- 'Leios.encodeLeiosEb' writes for it.
txEbMeasureDijkstra :: TxMeasure (ShelleyBlock p DijkstraEra) -> DijkstraEbMeasure
txEbMeasureDijkstra :: forall p.
TxMeasure (ShelleyBlock p DijkstraEra) -> DijkstraEbMeasure
txEbMeasureDijkstra (TxMeasure TxMeasurePhase1 (ShelleyBlock p DijkstraEra)
alonzo TxMeasurePhase2 (ShelleyBlock p DijkstraEra)
refScripts) =
  DijkstraEbMeasure
    { ebClosureMeasure :: TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
ebClosureMeasure = TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasurePhase2
     (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TxMeasurePhase1 (ShelleyBlock p DijkstraEra)
TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
alonzo TxMeasurePhase2 (ShelleyBlock p DijkstraEra)
TxMeasurePhase2 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
refScripts
    , txReferencesSize :: IgnoringOverflow ByteSize32
txReferencesSize =
        ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> (ByteSize32 -> ByteSize32)
-> ByteSize32
-> IgnoringOverflow ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> ByteSize32
Leios.encodeLeiosEbItemSize (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$
          AlonzoMeasure -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize TxMeasurePhase1 (ShelleyBlock p DijkstraEra)
AlonzoMeasure
alonzo
    }

-- | What one Leios endorser block may hold, from the Dijkstra endorser-block
-- protocol parameters.
leiosEndorserBlockCapacity ::
  forall proto mk.
  TickedLedgerState (ShelleyBlock proto DijkstraEra) mk ->
  DijkstraEbMeasure
leiosEndorserBlockCapacity :: forall proto (mk :: * -> * -> *).
TickedLedgerState (ShelleyBlock proto DijkstraEra) mk
-> DijkstraEbMeasure
leiosEndorserBlockCapacity TickedLedgerState (ShelleyBlock proto DijkstraEra) mk
st =
  DijkstraEbMeasure
    { ebClosureMeasure :: TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
ebClosureMeasure =
        TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasurePhase2
     (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
-> TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure
          AlonzoMeasure
            { byteSize :: IgnoringOverflow ByteSize32
byteSize = ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$ PParams DijkstraEra
pparams PParams DijkstraEra
-> Getting Word32 (PParams DijkstraEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams DijkstraEra) Word32
forall era. DijkstraEraPParams era => Lens' (PParams era) Word32
Lens' (PParams DijkstraEra) Word32
ppMaxEndorserBlockTxsSizeL
            , exUnits :: ExUnits' Natural
exUnits = ExUnits -> ExUnits' Natural
fromExUnits (ExUnits -> ExUnits' Natural) -> ExUnits -> ExUnits' Natural
forall a b. (a -> b) -> a -> b
$ OrdExUnits -> ExUnits
unOrdExUnits (OrdExUnits -> ExUnits) -> OrdExUnits -> ExUnits
forall a b. (a -> b) -> a -> b
$ PParams DijkstraEra
pparams PParams DijkstraEra
-> Getting OrdExUnits (PParams DijkstraEra) OrdExUnits
-> OrdExUnits
forall s a. s -> Getting a s a -> a
^. Getting OrdExUnits (PParams DijkstraEra) OrdExUnits
forall era.
DijkstraEraPParams era =>
Lens' (PParams era) OrdExUnits
Lens' (PParams DijkstraEra) OrdExUnits
ppMaxEndorserBlockExUnitsL
            }
          ( IgnoringOverflow ByteSize32 -> RefScriptSize
RefScriptSize (IgnoringOverflow ByteSize32 -> RefScriptSize)
-> IgnoringOverflow ByteSize32 -> RefScriptSize
forall a b. (a -> b) -> a -> b
$
              ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$
                Word32 -> ByteSize32
ByteSize32 (PParams DijkstraEra
pparams PParams DijkstraEra
-> Getting Word32 (PParams DijkstraEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams DijkstraEra) Word32
forall era. DijkstraEraPParams era => Lens' (PParams era) Word32
Lens' (PParams DijkstraEra) Word32
ppMaxRefScriptSizePerEndorserBlockL)
          )
    , -- Transactions are charged 'Leios.encodeLeiosEbItemSize' for their
      -- reference and nothing else, so the framing 'Leios.encodeLeiosEb' writes
      -- ahead of them comes off the capacity here.
      --
      -- Nothing checks that an endorser block of this size fits one LeiosFetch
      -- message. That check must come with the LeiosFetch protocol.
      txReferencesSize :: IgnoringOverflow ByteSize32
txReferencesSize =
        ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> (Word32 -> ByteSize32) -> Word32 -> IgnoringOverflow ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32)
-> (Word32 -> Word32) -> Word32 -> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
Leios.leiosReferencesCapacity (Word32 -> IgnoringOverflow ByteSize32)
-> Word32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$
          PParams DijkstraEra
pparams PParams DijkstraEra
-> Getting Word32 (PParams DijkstraEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams DijkstraEra) Word32
forall era. DijkstraEraPParams era => Lens' (PParams era) Word32
Lens' (PParams DijkstraEra) Word32
ppMaxEndorserBlockReferencesSizeL
    }
 where
  pparams :: PParams DijkstraEra
pparams = NewEpochState DijkstraEra -> PParams DijkstraEra
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState DijkstraEra -> PParams DijkstraEra)
-> NewEpochState DijkstraEra -> PParams DijkstraEra
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto DijkstraEra) mk
-> NewEpochState DijkstraEra
forall proto era (mk :: * -> * -> *).
Ticked LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto DijkstraEra) mk
st

-- | We anachronistically use 'ConwayMeasure' in Babbage.
instance
  ShelleyCompatible p BabbageEra =>
  TxLimits (ShelleyBlock p BabbageEra)
  where
  type TxMeasurePhase1 (ShelleyBlock p BabbageEra) = AlonzoMeasure
  type TxMeasurePhase2 (ShelleyBlock p BabbageEra) = TrivialTxMeasurePhase2
  txWireSize :: GenTx (ShelleyBlock p BabbageEra) -> SizeInBytes
txWireSize (ShelleyTx TxId
_ Tx TopTx BabbageEra
tx) = Word32 -> SizeInBytes
wrapCBORinCBOROverhead (Tx TopTx BabbageEra
tx Tx TopTx BabbageEra
-> Getting Word32 (Tx TopTx BabbageEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx BabbageEra) Word32
SimpleGetter (Tx TopTx BabbageEra) Word32
forall era (l :: TxLevel).
EraTx era =>
SimpleGetter (Tx l era) Word32
wireSizeTxF)
  txMeasurePhase1 :: LedgerConfig (ShelleyBlock p BabbageEra)
-> TickedLedgerState (ShelleyBlock p BabbageEra) EmptyMK
-> GenTx (ShelleyBlock p BabbageEra)
-> Except
     (ApplyTxErr (ShelleyBlock p BabbageEra))
     (TxMeasurePhase1 (ShelleyBlock p BabbageEra))
txMeasurePhase1 LedgerConfig (ShelleyBlock p BabbageEra)
_cfg TickedLedgerState (ShelleyBlock p BabbageEra) EmptyMK
st GenTx (ShelleyBlock p BabbageEra)
tx = Validation
  (TxErrorSG BabbageEra)
  (TxMeasurePhase1 (ShelleyBlock p BabbageEra))
-> Except
     (ApplyTxError BabbageEra)
     (TxMeasurePhase1 (ShelleyBlock p BabbageEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG BabbageEra)
   (TxMeasurePhase1 (ShelleyBlock p BabbageEra))
 -> Except
      (ApplyTxError BabbageEra)
      (TxMeasurePhase1 (ShelleyBlock p BabbageEra)))
-> Validation
     (TxErrorSG BabbageEra)
     (TxMeasurePhase1 (ShelleyBlock p BabbageEra))
-> Except
     (ApplyTxError BabbageEra)
     (TxMeasurePhase1 (ShelleyBlock p BabbageEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p BabbageEra) EmptyMK
-> GenTx (ShelleyBlock p BabbageEra)
-> Validation (TxErrorSG BabbageEra) AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraTx era,
 ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock p BabbageEra) EmptyMK
st GenTx (ShelleyBlock p BabbageEra)
tx
  txMeasurePhase2 :: LedgerConfig (ShelleyBlock p BabbageEra)
-> TickedLedgerState (ShelleyBlock p BabbageEra) ValuesMK
-> GenTx (ShelleyBlock p BabbageEra)
-> Except
     (ApplyTxErr (ShelleyBlock p BabbageEra))
     (TxMeasurePhase2 (ShelleyBlock p BabbageEra))
txMeasurePhase2 LedgerConfig (ShelleyBlock p BabbageEra)
_cfg TickedLedgerState (ShelleyBlock p BabbageEra) ValuesMK
_st GenTx (ShelleyBlock p BabbageEra)
_tx = TrivialTxMeasurePhase2
-> ExceptT
     (ApplyTxError BabbageEra) Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT (ApplyTxError BabbageEra) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p BabbageEra)
-> TickedLedgerState (ShelleyBlock p BabbageEra) mk
-> TxMeasure (ShelleyBlock p BabbageEra)
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p BabbageEra)
_cfg = (AlonzoMeasure
 -> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p BabbageEra))
-> TrivialTxMeasurePhase2
-> AlonzoMeasure
-> TxMeasure (ShelleyBlock p BabbageEra)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TxMeasurePhase1 (ShelleyBlock p BabbageEra)
-> TxMeasurePhase2 (ShelleyBlock p BabbageEra)
-> TxMeasure (ShelleyBlock p BabbageEra)
AlonzoMeasure
-> TrivialTxMeasurePhase2 -> TxMeasure (ShelleyBlock p BabbageEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2 (AlonzoMeasure -> TxMeasure (ShelleyBlock p BabbageEra))
-> (Ticked LedgerState (ShelleyBlock p BabbageEra) mk
    -> AlonzoMeasure)
-> Ticked LedgerState (ShelleyBlock p BabbageEra) mk
-> TxMeasure (ShelleyBlock p BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState (ShelleyBlock p BabbageEra) mk -> AlonzoMeasure
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) mk -> AlonzoMeasure
blockCapacityAlonzoMeasure

  type TxEbMeasure (ShelleyBlock p BabbageEra) = TxMeasure (ShelleyBlock p BabbageEra)

  txEbMeasure :: forall (proxy :: * -> *).
proxy (ShelleyBlock p BabbageEra)
-> TxMeasure (ShelleyBlock p BabbageEra)
-> TxEbMeasure (ShelleyBlock p BabbageEra)
txEbMeasure proxy (ShelleyBlock p BabbageEra)
_ = TxMeasure (ShelleyBlock p BabbageEra)
-> TxEbMeasure (ShelleyBlock p BabbageEra)
TxMeasure (ShelleyBlock p BabbageEra)
-> TxMeasure (ShelleyBlock p BabbageEra)
forall a. a -> a
id

  ebCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p BabbageEra)
-> TickedLedgerState (ShelleyBlock p BabbageEra) mk
-> TxEbMeasure (ShelleyBlock p BabbageEra)
ebCapacityTxMeasure LedgerConfig (ShelleyBlock p BabbageEra)
_cfg TickedLedgerState (ShelleyBlock p BabbageEra) mk
_st = TxEbMeasure (ShelleyBlock p BabbageEra)
TxMeasure (ShelleyBlock p BabbageEra)
forall a. Measure a => a
zero
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy (ShelleyBlock p BabbageEra)
-> TxEbMeasure (ShelleyBlock p BabbageEra)
-> TxMeasure (ShelleyBlock p BabbageEra)
mempoolEbReservation proxy (ShelleyBlock p BabbageEra)
_ = TxEbMeasure (ShelleyBlock p BabbageEra)
-> TxMeasure (ShelleyBlock p BabbageEra)
TxMeasure (ShelleyBlock p BabbageEra)
-> TxMeasure (ShelleyBlock p BabbageEra)
forall a. a -> a
id

instance
  ShelleyCompatible p ConwayEra =>
  TxLimits (ShelleyBlock p ConwayEra)
  where
  type TxMeasurePhase1 (ShelleyBlock p ConwayEra) = AlonzoMeasure
  type TxMeasurePhase2 (ShelleyBlock p ConwayEra) = RefScriptSize
  txWireSize :: GenTx (ShelleyBlock p ConwayEra) -> SizeInBytes
txWireSize (ShelleyTx TxId
_ Tx TopTx ConwayEra
tx) = Word32 -> SizeInBytes
wrapCBORinCBOROverhead (Tx TopTx ConwayEra
tx Tx TopTx ConwayEra
-> Getting Word32 (Tx TopTx ConwayEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx ConwayEra) Word32
SimpleGetter (Tx TopTx ConwayEra) Word32
forall era (l :: TxLevel).
EraTx era =>
SimpleGetter (Tx l era) Word32
wireSizeTxF)
  txMeasurePhase1 :: LedgerConfig (ShelleyBlock p ConwayEra)
-> TickedLedgerState (ShelleyBlock p ConwayEra) EmptyMK
-> GenTx (ShelleyBlock p ConwayEra)
-> Except
     (ApplyTxErr (ShelleyBlock p ConwayEra))
     (TxMeasurePhase1 (ShelleyBlock p ConwayEra))
txMeasurePhase1 LedgerConfig (ShelleyBlock p ConwayEra)
_cfg TickedLedgerState (ShelleyBlock p ConwayEra) EmptyMK
st GenTx (ShelleyBlock p ConwayEra)
tx = Validation
  (TxErrorSG ConwayEra) (TxMeasurePhase1 (ShelleyBlock p ConwayEra))
-> Except
     (ApplyTxError ConwayEra)
     (TxMeasurePhase1 (ShelleyBlock p ConwayEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG ConwayEra) (TxMeasurePhase1 (ShelleyBlock p ConwayEra))
 -> Except
      (ApplyTxError ConwayEra)
      (TxMeasurePhase1 (ShelleyBlock p ConwayEra)))
-> Validation
     (TxErrorSG ConwayEra) (TxMeasurePhase1 (ShelleyBlock p ConwayEra))
-> Except
     (ApplyTxError ConwayEra)
     (TxMeasurePhase1 (ShelleyBlock p ConwayEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p ConwayEra) EmptyMK
-> GenTx (ShelleyBlock p ConwayEra)
-> Validation (TxErrorSG ConwayEra) AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraTx era,
 ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock p ConwayEra) EmptyMK
st GenTx (ShelleyBlock p ConwayEra)
tx
  txMeasurePhase2 :: LedgerConfig (ShelleyBlock p ConwayEra)
-> TickedLedgerState (ShelleyBlock p ConwayEra) ValuesMK
-> GenTx (ShelleyBlock p ConwayEra)
-> Except
     (ApplyTxErr (ShelleyBlock p ConwayEra))
     (TxMeasurePhase2 (ShelleyBlock p ConwayEra))
txMeasurePhase2 LedgerConfig (ShelleyBlock p ConwayEra)
_cfg TickedLedgerState (ShelleyBlock p ConwayEra) ValuesMK
st GenTx (ShelleyBlock p ConwayEra)
tx = Validation
  (TxErrorSG ConwayEra) (TxMeasurePhase2 (ShelleyBlock p ConwayEra))
-> Except
     (ApplyTxError ConwayEra)
     (TxMeasurePhase2 (ShelleyBlock p ConwayEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG ConwayEra) (TxMeasurePhase2 (ShelleyBlock p ConwayEra))
 -> Except
      (ApplyTxError ConwayEra)
      (TxMeasurePhase2 (ShelleyBlock p ConwayEra)))
-> Validation
     (TxErrorSG ConwayEra) (TxMeasurePhase2 (ShelleyBlock p ConwayEra))
-> Except
     (ApplyTxError ConwayEra)
     (TxMeasurePhase2 (ShelleyBlock p ConwayEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p ConwayEra) ValuesMK
-> GenTx (ShelleyBlock p ConwayEra)
-> Validation (TxErrorSG ConwayEra) RefScriptSize
forall proto era.
(ShelleyCompatible proto era, BabbageEraTxBody era,
 TxRefScriptsSizeTooBig era, ConwayEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) RefScriptSize
txMeasureRefScripts TickedLedgerState (ShelleyBlock p ConwayEra) ValuesMK
st GenTx (ShelleyBlock p ConwayEra)
tx
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p ConwayEra)
-> TickedLedgerState (ShelleyBlock p ConwayEra) mk
-> TxMeasure (ShelleyBlock p ConwayEra)
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p ConwayEra)
_cfg = (AlonzoMeasure
 -> RefScriptSize -> TxMeasure (ShelleyBlock p ConwayEra))
-> (AlonzoMeasure, RefScriptSize)
-> TxMeasure (ShelleyBlock p ConwayEra)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxMeasurePhase1 (ShelleyBlock p ConwayEra)
-> TxMeasurePhase2 (ShelleyBlock p ConwayEra)
-> TxMeasure (ShelleyBlock p ConwayEra)
AlonzoMeasure
-> RefScriptSize -> TxMeasure (ShelleyBlock p ConwayEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure ((AlonzoMeasure, RefScriptSize)
 -> TxMeasure (ShelleyBlock p ConwayEra))
-> (Ticked LedgerState (ShelleyBlock p ConwayEra) mk
    -> (AlonzoMeasure, RefScriptSize))
-> Ticked LedgerState (ShelleyBlock p ConwayEra) mk
-> TxMeasure (ShelleyBlock p ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState (ShelleyBlock p ConwayEra) mk
-> (AlonzoMeasure, RefScriptSize)
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, ConwayEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> (AlonzoMeasure, RefScriptSize)
blockCapacityConwayMeasure

  type TxEbMeasure (ShelleyBlock p ConwayEra) = TxMeasure (ShelleyBlock p ConwayEra)

  txEbMeasure :: forall (proxy :: * -> *).
proxy (ShelleyBlock p ConwayEra)
-> TxMeasure (ShelleyBlock p ConwayEra)
-> TxEbMeasure (ShelleyBlock p ConwayEra)
txEbMeasure proxy (ShelleyBlock p ConwayEra)
_ = TxMeasure (ShelleyBlock p ConwayEra)
-> TxEbMeasure (ShelleyBlock p ConwayEra)
TxMeasure (ShelleyBlock p ConwayEra)
-> TxMeasure (ShelleyBlock p ConwayEra)
forall a. a -> a
id

  ebCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p ConwayEra)
-> TickedLedgerState (ShelleyBlock p ConwayEra) mk
-> TxEbMeasure (ShelleyBlock p ConwayEra)
ebCapacityTxMeasure LedgerConfig (ShelleyBlock p ConwayEra)
_cfg TickedLedgerState (ShelleyBlock p ConwayEra) mk
_st = TxEbMeasure (ShelleyBlock p ConwayEra)
TxMeasure (ShelleyBlock p ConwayEra)
forall a. Measure a => a
zero
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy (ShelleyBlock p ConwayEra)
-> TxEbMeasure (ShelleyBlock p ConwayEra)
-> TxMeasure (ShelleyBlock p ConwayEra)
mempoolEbReservation proxy (ShelleyBlock p ConwayEra)
_ = TxEbMeasure (ShelleyBlock p ConwayEra)
-> TxMeasure (ShelleyBlock p ConwayEra)
TxMeasure (ShelleyBlock p ConwayEra)
-> TxMeasure (ShelleyBlock p ConwayEra)
forall a. a -> a
id

instance
  ShelleyCompatible p DijkstraEra =>
  TxLimits (ShelleyBlock p DijkstraEra)
  where
  type TxMeasurePhase1 (ShelleyBlock p DijkstraEra) = AlonzoMeasure
  type TxMeasurePhase2 (ShelleyBlock p DijkstraEra) = RefScriptSize
  blockCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p DijkstraEra)
-> TickedLedgerState (ShelleyBlock p DijkstraEra) mk
-> TxMeasure (ShelleyBlock p DijkstraEra)
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p DijkstraEra)
_cfg = (AlonzoMeasure
 -> RefScriptSize -> TxMeasure (ShelleyBlock p DijkstraEra))
-> (AlonzoMeasure, RefScriptSize)
-> TxMeasure (ShelleyBlock p DijkstraEra)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxMeasurePhase1 (ShelleyBlock p DijkstraEra)
-> TxMeasurePhase2 (ShelleyBlock p DijkstraEra)
-> TxMeasure (ShelleyBlock p DijkstraEra)
AlonzoMeasure
-> RefScriptSize -> TxMeasure (ShelleyBlock p DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure ((AlonzoMeasure, RefScriptSize)
 -> TxMeasure (ShelleyBlock p DijkstraEra))
-> (Ticked LedgerState (ShelleyBlock p DijkstraEra) mk
    -> (AlonzoMeasure, RefScriptSize))
-> Ticked LedgerState (ShelleyBlock p DijkstraEra) mk
-> TxMeasure (ShelleyBlock p DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked LedgerState (ShelleyBlock p DijkstraEra) mk
-> (AlonzoMeasure, RefScriptSize)
forall proto era (mk :: * -> * -> *).
(ShelleyCompatible proto era, ConwayEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) mk
-> (AlonzoMeasure, RefScriptSize)
blockCapacityConwayMeasure
  txMeasurePhase1 :: LedgerConfig (ShelleyBlock p DijkstraEra)
-> TickedLedgerState (ShelleyBlock p DijkstraEra) EmptyMK
-> GenTx (ShelleyBlock p DijkstraEra)
-> Except
     (ApplyTxErr (ShelleyBlock p DijkstraEra))
     (TxMeasurePhase1 (ShelleyBlock p DijkstraEra))
txMeasurePhase1 LedgerConfig (ShelleyBlock p DijkstraEra)
_cfg TickedLedgerState (ShelleyBlock p DijkstraEra) EmptyMK
st GenTx (ShelleyBlock p DijkstraEra)
tx = Validation
  (TxErrorSG DijkstraEra)
  (TxMeasurePhase1 (ShelleyBlock p DijkstraEra))
-> Except
     (ApplyTxError DijkstraEra)
     (TxMeasurePhase1 (ShelleyBlock p DijkstraEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG DijkstraEra)
   (TxMeasurePhase1 (ShelleyBlock p DijkstraEra))
 -> Except
      (ApplyTxError DijkstraEra)
      (TxMeasurePhase1 (ShelleyBlock p DijkstraEra)))
-> Validation
     (TxErrorSG DijkstraEra)
     (TxMeasurePhase1 (ShelleyBlock p DijkstraEra))
-> Except
     (ApplyTxError DijkstraEra)
     (TxMeasurePhase1 (ShelleyBlock p DijkstraEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p DijkstraEra) EmptyMK
-> GenTx (ShelleyBlock p DijkstraEra)
-> Validation (TxErrorSG DijkstraEra) AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraTx era,
 ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era) EmptyMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock p DijkstraEra) EmptyMK
st GenTx (ShelleyBlock p DijkstraEra)
tx
  txMeasurePhase2 :: LedgerConfig (ShelleyBlock p DijkstraEra)
-> TickedLedgerState (ShelleyBlock p DijkstraEra) ValuesMK
-> GenTx (ShelleyBlock p DijkstraEra)
-> Except
     (ApplyTxErr (ShelleyBlock p DijkstraEra))
     (TxMeasurePhase2 (ShelleyBlock p DijkstraEra))
txMeasurePhase2 LedgerConfig (ShelleyBlock p DijkstraEra)
_cfg TickedLedgerState (ShelleyBlock p DijkstraEra) ValuesMK
st GenTx (ShelleyBlock p DijkstraEra)
tx = Validation
  (TxErrorSG DijkstraEra)
  (TxMeasurePhase2 (ShelleyBlock p DijkstraEra))
-> Except
     (ApplyTxError DijkstraEra)
     (TxMeasurePhase2 (ShelleyBlock p DijkstraEra))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG DijkstraEra)
   (TxMeasurePhase2 (ShelleyBlock p DijkstraEra))
 -> Except
      (ApplyTxError DijkstraEra)
      (TxMeasurePhase2 (ShelleyBlock p DijkstraEra)))
-> Validation
     (TxErrorSG DijkstraEra)
     (TxMeasurePhase2 (ShelleyBlock p DijkstraEra))
-> Except
     (ApplyTxError DijkstraEra)
     (TxMeasurePhase2 (ShelleyBlock p DijkstraEra))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p DijkstraEra) ValuesMK
-> GenTx (ShelleyBlock p DijkstraEra)
-> Validation (TxErrorSG DijkstraEra) RefScriptSize
forall proto era.
(ShelleyCompatible proto era, BabbageEraTxBody era,
 TxRefScriptsSizeTooBig era, ConwayEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) ValuesMK
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) RefScriptSize
txMeasureRefScripts TickedLedgerState (ShelleyBlock p DijkstraEra) ValuesMK
st GenTx (ShelleyBlock p DijkstraEra)
tx
  txWireSize :: GenTx (ShelleyBlock p DijkstraEra) -> SizeInBytes
txWireSize (ShelleyTx TxId
_ Tx TopTx DijkstraEra
tx) = Word32 -> SizeInBytes
wrapCBORinCBOROverhead (Tx TopTx DijkstraEra
tx Tx TopTx DijkstraEra
-> Getting Word32 (Tx TopTx DijkstraEra) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (Tx TopTx DijkstraEra) Word32
SimpleGetter (Tx TopTx DijkstraEra) Word32
forall era (l :: TxLevel).
EraTx era =>
SimpleGetter (Tx l era) Word32
wireSizeTxF)

  type TxEbMeasure (ShelleyBlock p DijkstraEra) = DijkstraEbMeasure

  txEbMeasure :: forall (proxy :: * -> *).
proxy (ShelleyBlock p DijkstraEra)
-> TxMeasure (ShelleyBlock p DijkstraEra)
-> TxEbMeasure (ShelleyBlock p DijkstraEra)
txEbMeasure proxy (ShelleyBlock p DijkstraEra)
_ = TxMeasure (ShelleyBlock p DijkstraEra)
-> TxEbMeasure (ShelleyBlock p DijkstraEra)
TxMeasure (ShelleyBlock p DijkstraEra) -> DijkstraEbMeasure
forall p.
TxMeasure (ShelleyBlock p DijkstraEra) -> DijkstraEbMeasure
txEbMeasureDijkstra

  ebCapacityTxMeasure :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock p DijkstraEra)
-> TickedLedgerState (ShelleyBlock p DijkstraEra) mk
-> TxEbMeasure (ShelleyBlock p DijkstraEra)
ebCapacityTxMeasure LedgerConfig (ShelleyBlock p DijkstraEra)
_cfg = TickedLedgerState (ShelleyBlock p DijkstraEra) mk
-> TxEbMeasure (ShelleyBlock p DijkstraEra)
TickedLedgerState (ShelleyBlock p DijkstraEra) mk
-> DijkstraEbMeasure
forall proto (mk :: * -> * -> *).
TickedLedgerState (ShelleyBlock proto DijkstraEra) mk
-> DijkstraEbMeasure
leiosEndorserBlockCapacity
  mempoolEbReservation :: forall (proxy :: * -> *).
proxy (ShelleyBlock p DijkstraEra)
-> TxEbMeasure (ShelleyBlock p DijkstraEra)
-> TxMeasure (ShelleyBlock p DijkstraEra)
mempoolEbReservation proxy (ShelleyBlock p DijkstraEra)
_ DijkstraEbMeasure{ebClosureMeasure :: DijkstraEbMeasure
-> TxMeasure (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
ebClosureMeasure = TxMeasure TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
alonzo TxMeasurePhase2 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
refScripts} =
    TxMeasurePhase1 (ShelleyBlock p DijkstraEra)
-> TxMeasurePhase2 (ShelleyBlock p DijkstraEra)
-> TxMeasure (ShelleyBlock p DijkstraEra)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure TxMeasurePhase1 (ShelleyBlock p DijkstraEra)
TxMeasurePhase1 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
alonzo TxMeasurePhase2 (ShelleyBlock p DijkstraEra)
TxMeasurePhase2 (ShelleyBlock (Praos2 StandardCrypto) DijkstraEra)
refScripts