{-# 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 #-}
-- TODO: Ledger has a few deprecations that we are ignoring for now
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# 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 (..)
  , 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 (totExUnits)
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 qualified Cardano.Ledger.Dijkstra.Rules as DijkstraEra
import qualified Cardano.Ledger.Hashes as SL
import Cardano.Ledger.Mary (ApplyTxError (MaryApplyTxError))
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)
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 (..))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.Tables.Utils
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.Validated (Tx TopTx era))
  deriving stock (forall x.
 Validated (GenTx (ShelleyBlock proto era))
 -> Rep (Validated (GenTx (ShelleyBlock proto era))) x)
-> (forall x.
    Rep (Validated (GenTx (ShelleyBlock proto era))) x
    -> Validated (GenTx (ShelleyBlock proto era)))
-> Generic (Validated (GenTx (ShelleyBlock proto era)))
forall x.
Rep (Validated (GenTx (ShelleyBlock proto era))) x
-> Validated (GenTx (ShelleyBlock proto era))
forall x.
Validated (GenTx (ShelleyBlock proto era))
-> Rep (Validated (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 (Validated (GenTx (ShelleyBlock proto era))) x
-> Validated (GenTx (ShelleyBlock proto era))
forall proto era x.
Validated (GenTx (ShelleyBlock proto era))
-> Rep (Validated (GenTx (ShelleyBlock proto era))) x
$cfrom :: forall proto era x.
Validated (GenTx (ShelleyBlock proto era))
-> Rep (Validated (GenTx (ShelleyBlock proto era))) x
from :: forall x.
Validated (GenTx (ShelleyBlock proto era))
-> Rep (Validated (GenTx (ShelleyBlock proto era))) x
$cto :: forall proto era x.
Rep (Validated (GenTx (ShelleyBlock proto era))) x
-> Validated (GenTx (ShelleyBlock proto era))
to :: forall x.
Rep (Validated (GenTx (ShelleyBlock proto era))) x
-> Validated (GenTx (ShelleyBlock proto era))
Generic

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

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

deriving instance ShelleyBasedEra era => Show (Validated (GenTx (ShelleyBlock proto era)))

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 Validated (Tx TopTx era)
vtx) = TxId -> Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall proto era.
TxId -> Tx TopTx era -> GenTx (ShelleyBlock proto era)
ShelleyTx TxId
txid (Validated (Tx TopTx era) -> Tx TopTx era
forall tx. Validated tx -> tx
SL.extractTx Validated (Tx TopTx 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.
EraTxBody 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.Validated (Tx TopTx era) ->
  Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx :: forall era proto.
ShelleyBasedEra era =>
Validated (Tx TopTx era)
-> Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx Validated (Tx TopTx era)
vtx = TxId
-> Validated (Tx TopTx era)
-> Validated (GenTx (ShelleyBlock proto era))
forall proto era.
TxId
-> Validated (Tx TopTx era)
-> Validated (GenTx (ShelleyBlock proto era))
ShelleyValidatedTx TxId
txid Validated (Tx TopTx era)
vtx
 where
  txid :: TxId
txid = Tx TopTx era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx (Validated (Tx TopTx era) -> Tx TopTx era
forall tx. Validated tx -> tx
SL.extractTx Validated (Tx TopTx 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, Validated (Tx TopTx era))
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx TopTx era
-> Except
     (ApplyTxError era) (LedgerState era, Validated (Tx TopTx 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
-> Validated (Tx TopTx era)
-> Either (ApplyTxError era) (MempoolState era)
forall era.
ApplyTx era =>
Globals
-> MempoolEnv era
-> MempoolState era
-> Validated (Tx TopTx era)
-> Either (ApplyTxError era) (MempoolState era)
SL.reapplyTx
        (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)
        Validated (Tx TopTx era)
vtx

  pure $
    unstowLedgerTables $
      set theLedgerLens mempoolState' st1
 where
  ShelleyValidatedTx TxId
_txid Validated (Tx TopTx 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

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

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

-----

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.AlonzoEraPParams era
  , L.AlonzoEraTxWits 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, AlonzoEraPParams era,
 AlonzoEraTxWits 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).
(EraTx era, AlonzoEraTxWits era) =>
Tx l era -> ExUnits
totExUnits 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 ExUnits -> AlonzoUtxoPredFailure AlonzoEra
forall era. Mismatch RelLTEQ ExUnits -> AlonzoUtxoPredFailure era
AlonzoEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ ExUnits -> AlonzoUtxoPredFailure AlonzoEra)
-> Mismatch RelLTEQ ExUnits -> AlonzoUtxoPredFailure AlonzoEra
forall a b. (a -> b) -> a -> b
$
              L.Mismatch
                { mismatchSupplied :: ExUnits
mismatchSupplied = ExUnits
txsz
                , mismatchExpected :: ExUnits
mismatchExpected = 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 ExUnits -> AlonzoUtxoPredFailure BabbageEra
forall era. Mismatch RelLTEQ ExUnits -> AlonzoUtxoPredFailure era
AlonzoEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ ExUnits -> AlonzoUtxoPredFailure BabbageEra)
-> Mismatch RelLTEQ ExUnits -> AlonzoUtxoPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
                  L.Mismatch
                    { mismatchSupplied :: ExUnits
mismatchSupplied = ExUnits
txsz
                    , mismatchExpected :: ExUnits
mismatchExpected = 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 ExUnits -> ConwayUtxoPredFailure ConwayEra
forall era. Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure era
ConwayEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure ConwayEra)
-> Mismatch RelLTEQ ExUnits -> ConwayUtxoPredFailure ConwayEra
forall a b. (a -> b) -> a -> b
$
            L.Mismatch
              { mismatchSupplied :: ExUnits
mismatchSupplied = ExUnits
txsz
              , mismatchExpected :: ExUnits
mismatchExpected = 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 ExUnits -> DijkstraUtxoPredFailure DijkstraEra
forall era. Mismatch RelLTEQ ExUnits -> DijkstraUtxoPredFailure era
DijkstraEra.ExUnitsTooBigUTxO (Mismatch RelLTEQ ExUnits -> DijkstraUtxoPredFailure DijkstraEra)
-> Mismatch RelLTEQ ExUnits -> DijkstraUtxoPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
              L.Mismatch
                { mismatchSupplied :: ExUnits
mismatchSupplied = ExUnits
txsz
                , mismatchExpected :: ExUnits
mismatchExpected = 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, AlonzoEraPParams era,
 AlonzoEraTxWits 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

-----

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
            }

-- | 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, AlonzoEraPParams era,
 AlonzoEraTxWits 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

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, AlonzoEraPParams era,
 AlonzoEraTxWits 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

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, AlonzoEraPParams era,
 AlonzoEraTxWits 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)