{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | 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 (..)
  , ConwayMeasure (..)
  , fromExUnits
  ) where

import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Ledger.Allegra.Rules as AllegraEra
import           Cardano.Ledger.Alonzo.Core (Tx, TxSeq, bodyTxL, eraProtVerLow,
                     fromTxSeq, ppMaxBBSizeL, ppMaxBlockExUnitsL, sizeTxF)
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 qualified Cardano.Ledger.Babbage.Rules as BabbageEra
import qualified Cardano.Ledger.BaseTypes as L
import           Cardano.Ledger.Binary (Annotator (..), DecCBOR (..),
                     EncCBOR (..), FromCBOR (..), FullByteString (..),
                     ToCBOR (..), toPlainDecoder)
import qualified Cardano.Ledger.Conway.Rules as ConwayEra
import qualified Cardano.Ledger.Conway.Rules as SL
import qualified Cardano.Ledger.Conway.UTxO as SL
import qualified Cardano.Ledger.Core as SL (txIdTxBody)
import           Cardano.Ledger.Crypto (Crypto)
import qualified Cardano.Ledger.SafeHash as SL
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Rules as ShelleyEra
import           Control.Arrow ((+++))
import           Control.Monad (guard)
import           Control.Monad.Except (Except, liftEither)
import           Control.Monad.Identity (Identity (..))
import           Data.DerivingVia (InstantiatedAt (..))
import           Data.Foldable (toList)
import           Data.Measure (Measure)
import           Data.Typeable (Typeable)
import qualified Data.Validation as V
import           GHC.Generics (Generic)
import           GHC.Natural (Natural)
import           Lens.Micro ((^.))
import           NoThunks.Class (NoThunks (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Shelley.Eras
import           Ouroboros.Consensus.Shelley.Ledger.Block
import           Ouroboros.Consensus.Shelley.Ledger.Ledger
                     (ShelleyLedgerConfig (shelleyLedgerGlobals),
                     Ticked (TickedShelleyLedgerState, tickedShelleyLedgerState),
                     getPParams)
import           Ouroboros.Consensus.Util (ShowProxy (..))
import           Ouroboros.Consensus.Util.Condense
import           Ouroboros.Network.Block (unwrapCBORinCBOR, wrapCBORinCBOR)

data instance GenTx (ShelleyBlock proto era) = ShelleyTx !(SL.TxId (EraCrypto era)) !(Tx 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)) where

data instance Validated (GenTx (ShelleyBlock proto era)) =
    ShelleyValidatedTx
      !(SL.TxId (EraCrypto era))
      !(SL.Validated (Tx 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))) where

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

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


-- |'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 ('TxSeq') 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)
-> Ticked (LedgerState (ShelleyBlock proto era))
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (Ticked (LedgerState (ShelleyBlock proto era)),
      Validated (GenTx (ShelleyBlock proto era)))
applyTx = LedgerConfig (ShelleyBlock proto era)
-> WhetherToIntervene
-> SlotNo
-> GenTx (ShelleyBlock proto era)
-> Ticked (LedgerState (ShelleyBlock proto era))
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (Ticked (LedgerState (ShelleyBlock proto era)),
      Validated (GenTx (ShelleyBlock proto era)))
forall era proto.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock proto era)
-> WhetherToIntervene
-> SlotNo
-> GenTx (ShelleyBlock proto era)
-> TickedLedgerState (ShelleyBlock proto era)
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era),
      Validated (GenTx (ShelleyBlock proto era)))
applyShelleyTx

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

  txForgetValidated :: Validated (GenTx (ShelleyBlock proto era))
-> GenTx (ShelleyBlock proto era)
txForgetValidated (ShelleyValidatedTx TxId (EraCrypto era)
txid Validated (Tx era)
vtx) = TxId (EraCrypto era) -> Tx era -> GenTx (ShelleyBlock proto era)
forall proto era.
TxId (EraCrypto era) -> Tx era -> GenTx (ShelleyBlock proto era)
ShelleyTx TxId (EraCrypto era)
txid (Validated (Tx era) -> Tx era
forall tx. Validated tx -> tx
SL.extractTx Validated (Tx era)
vtx)

mkShelleyTx :: forall era proto. ShelleyBasedEra era => Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx :: forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx Tx era
tx = TxId (EraCrypto era) -> Tx era -> GenTx (ShelleyBlock proto era)
forall proto era.
TxId (EraCrypto era) -> Tx era -> GenTx (ShelleyBlock proto era)
ShelleyTx (forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
SL.txIdTxBody @era (Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL)) Tx era
tx

mkShelleyValidatedTx :: forall era proto.
     ShelleyBasedEra era
  => SL.Validated (Tx era)
  -> Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx :: forall era proto.
ShelleyBasedEra era =>
Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx Validated (Tx era)
vtx = TxId (EraCrypto era)
-> Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era))
forall proto era.
TxId (EraCrypto era)
-> Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era))
ShelleyValidatedTx TxId (EraCrypto era)
txid Validated (Tx era)
vtx
  where
    txid :: TxId (EraCrypto era)
txid = forall era. EraTxBody era => TxBody era -> TxId (EraCrypto era)
SL.txIdTxBody @era (Validated (Tx era) -> Tx era
forall tx. Validated tx -> tx
SL.extractTx Validated (Tx era)
vtx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL)

newtype instance TxId (GenTx (ShelleyBlock proto era)) = ShelleyTxId (SL.TxId (EraCrypto era))
  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 (EraCrypto era), Typeable era, Typeable proto)
                       => EncCBOR (TxId (GenTx (ShelleyBlock proto era)))
deriving newtype instance (Crypto (EraCrypto era), Typeable era, Typeable proto)
                       => DecCBOR (TxId (GenTx (ShelleyBlock proto era)))

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

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

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

instance ShelleyBasedEra era => HasTxs (ShelleyBlock proto era) where
  extractTxs :: ShelleyBlock proto era -> [GenTx (ShelleyBlock proto era)]
extractTxs =
        (Tx era -> GenTx (ShelleyBlock proto era))
-> [Tx era] -> [GenTx (ShelleyBlock proto era)]
forall a b. (a -> b) -> [a] -> [b]
map Tx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx
      ([Tx era] -> [GenTx (ShelleyBlock proto era)])
-> (ShelleyBlock proto era -> [Tx era])
-> ShelleyBlock proto era
-> [GenTx (ShelleyBlock proto era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSeq era -> [Tx era]
txSeqToList
      (TxSeq era -> [Tx era])
-> (ShelleyBlock proto era -> TxSeq era)
-> ShelleyBlock proto era
-> [Tx era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (ShelleyProtocolHeader proto) era -> TxSeq era
forall h era. Block h era -> TxSeq era
SL.bbody
      (Block (ShelleyProtocolHeader proto) era -> TxSeq era)
-> (ShelleyBlock proto era
    -> Block (ShelleyProtocolHeader proto) era)
-> ShelleyBlock proto era
-> TxSeq 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
      txSeqToList :: TxSeq era -> [Tx era]
      txSeqToList :: TxSeq era -> [Tx era]
txSeqToList = StrictSeq (Tx era) -> [Tx era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (Tx era) -> [Tx era])
-> (TxSeq era -> StrictSeq (Tx era)) -> TxSeq era -> [Tx era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraSegWits era => TxSeq era -> StrictSeq (Tx era)
fromTxSeq @era

{-------------------------------------------------------------------------------
  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 (EraCrypto era)
_txid Tx era
tx) = (Tx era -> Encoding) -> Tx era -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR Tx era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Tx era
tx

instance ShelleyCompatible proto era => FromCBOR (GenTx (ShelleyBlock proto era)) where
  fromCBOR :: forall s. Decoder s (GenTx (ShelleyBlock proto era))
fromCBOR = (Tx era -> GenTx (ShelleyBlock proto era))
-> Decoder s (Tx 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 era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Decoder s (Tx era) -> Decoder s (GenTx (ShelleyBlock proto era)))
-> Decoder s (Tx era) -> Decoder s (GenTx (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ (forall s. Decoder s (ByteString -> Tx era))
-> forall s. Decoder s (Tx era)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR
    ((forall s. Decoder s (ByteString -> Tx era))
 -> forall s. Decoder s (Tx era))
-> (forall s. Decoder s (ByteString -> Tx era))
-> forall s. Decoder s (Tx era)
forall a b. (a -> b) -> a -> b
$ Version
-> Decoder s (ByteString -> Tx era)
-> Decoder s (ByteString -> Tx era)
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder (forall era. Era era => Version
eraProtVerLow @era) (Decoder s (ByteString -> Tx era)
 -> Decoder s (ByteString -> Tx era))
-> Decoder s (ByteString -> Tx era)
-> Decoder s (ByteString -> Tx era)
forall a b. (a -> b) -> a -> b
$ ((FullByteString -> Tx era)
-> (ByteString -> FullByteString) -> ByteString -> Tx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FullByteString
Full) ((FullByteString -> Tx era) -> ByteString -> Tx era)
-> (Annotator (Tx era) -> FullByteString -> Tx era)
-> Annotator (Tx era)
-> ByteString
-> Tx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotator (Tx era) -> FullByteString -> Tx era
forall a. Annotator a -> FullByteString -> a
runAnnotator (Annotator (Tx era) -> ByteString -> Tx era)
-> Decoder s (Annotator (Tx era))
-> Decoder s (ByteString -> Tx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Tx era))
forall s. Decoder s (Annotator (Tx 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 (EraCrypto era)
_ Tx era
tx ) = Tx era -> String
forall a. Show a => a -> String
show Tx era
tx

instance Condense (GenTxId (ShelleyBlock proto era)) where
  condense :: GenTxId (ShelleyBlock proto era) -> String
condense (ShelleyTxId TxId (EraCrypto era)
i) = String
"txid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TxId (EraCrypto era) -> String
forall a. Show a => a -> String
show TxId (EraCrypto era)
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)
  -> Except (ApplyTxErr (ShelleyBlock proto era))
       ( TickedLedgerState (ShelleyBlock proto era)
       , 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)
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era),
      Validated (GenTx (ShelleyBlock proto era)))
applyShelleyTx LedgerConfig (ShelleyBlock proto era)
cfg WhetherToIntervene
wti SlotNo
slot (ShelleyTx TxId (EraCrypto era)
_ Tx era
tx) TickedLedgerState (ShelleyBlock proto era)
st = do
    (LedgerState era
mempoolState', Validated (Tx era)
vtx) <-
       Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> ExceptT
     (ApplyTxError era) Identity (LedgerState era, Validated (Tx era))
forall era.
ShelleyBasedEra era =>
Globals
-> LedgerEnv era
-> LedgerState era
-> WhetherToIntervene
-> Tx era
-> Except (ApplyTxError era) (LedgerState era, Validated (Tx 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 era
tx

    let st' :: TickedLedgerState (ShelleyBlock proto era)
st' = (forall (f :: * -> *).
 Applicative f =>
 (LedgerState era -> f (LedgerState era))
 -> TickedLedgerState (ShelleyBlock proto era)
 -> f (TickedLedgerState (ShelleyBlock proto era)))
-> LedgerState era
-> TickedLedgerState (ShelleyBlock proto era)
-> TickedLedgerState (ShelleyBlock proto era)
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)
-> f (TickedLedgerState (ShelleyBlock proto era))
forall (f :: * -> *).
Applicative f =>
(LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era)
-> f (TickedLedgerState (ShelleyBlock proto era))
forall (f :: * -> *) era proto.
Functor f =>
(LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era)
-> f (TickedLedgerState (ShelleyBlock proto era))
theLedgerLens LedgerState era
mempoolState' TickedLedgerState (ShelleyBlock proto era)
st

    (TickedLedgerState (ShelleyBlock proto era),
 Validated (GenTx (ShelleyBlock proto era)))
-> ExceptT
     (ApplyTxError era)
     Identity
     (TickedLedgerState (ShelleyBlock proto era),
      Validated (GenTx (ShelleyBlock proto era)))
forall a. a -> ExceptT (ApplyTxError era) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TickedLedgerState (ShelleyBlock proto era)
st', Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era))
forall era proto.
ShelleyBasedEra era =>
Validated (Tx era) -> Validated (GenTx (ShelleyBlock proto era))
mkShelleyValidatedTx Validated (Tx era)
vtx)
  where
    innerSt :: NewEpochState era
innerSt = TickedLedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era)
st

reapplyShelleyTx ::
     ShelleyBasedEra era
  => LedgerConfig (ShelleyBlock proto era)
  -> SlotNo
  -> Validated (GenTx (ShelleyBlock proto era))
  -> TickedLedgerState (ShelleyBlock proto era)
  -> Except (ApplyTxErr (ShelleyBlock proto era)) (TickedLedgerState (ShelleyBlock proto era))
reapplyShelleyTx :: forall era proto.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock proto era)
-> SlotNo
-> Validated (GenTx (ShelleyBlock proto era))
-> TickedLedgerState (ShelleyBlock proto era)
-> Except
     (ApplyTxErr (ShelleyBlock proto era))
     (TickedLedgerState (ShelleyBlock proto era))
reapplyShelleyTx LedgerConfig (ShelleyBlock proto era)
cfg SlotNo
slot Validated (GenTx (ShelleyBlock proto era))
vgtx TickedLedgerState (ShelleyBlock proto era)
st = do
    MempoolState era
mempoolState' <-
        Globals
-> MempoolEnv era
-> MempoolState era
-> Validated (Tx era)
-> ExceptT (ApplyTxError era) Identity (MempoolState era)
forall era (m :: * -> *).
(ApplyTx era, MonadError (ApplyTxError era) m) =>
Globals
-> MempoolEnv era
-> MempoolState era
-> Validated (Tx era)
-> m (MempoolState era)
forall (m :: * -> *).
MonadError (ApplyTxError era) m =>
Globals
-> MempoolEnv era
-> MempoolState era
-> Validated (Tx era)
-> m (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 era)
vtx

    TickedLedgerState (ShelleyBlock proto era)
-> ExceptT
     (ApplyTxError era)
     Identity
     (TickedLedgerState (ShelleyBlock proto era))
forall a. a -> ExceptT (ApplyTxError era) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TickedLedgerState (ShelleyBlock proto era)
 -> ExceptT
      (ApplyTxError era)
      Identity
      (TickedLedgerState (ShelleyBlock proto era)))
-> TickedLedgerState (ShelleyBlock proto era)
-> ExceptT
     (ApplyTxError era)
     Identity
     (TickedLedgerState (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 (MempoolState era -> f (MempoolState era))
 -> TickedLedgerState (ShelleyBlock proto era)
 -> f (TickedLedgerState (ShelleyBlock proto era)))
-> MempoolState era
-> TickedLedgerState (ShelleyBlock proto era)
-> TickedLedgerState (ShelleyBlock proto era)
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> b -> s -> t
set (MempoolState era -> f (MempoolState era))
-> TickedLedgerState (ShelleyBlock proto era)
-> f (TickedLedgerState (ShelleyBlock proto era))
forall (f :: * -> *).
Applicative f =>
(MempoolState era -> f (MempoolState era))
-> TickedLedgerState (ShelleyBlock proto era)
-> f (TickedLedgerState (ShelleyBlock proto era))
forall (f :: * -> *) era proto.
Functor f =>
(LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era)
-> f (TickedLedgerState (ShelleyBlock proto era))
theLedgerLens MempoolState era
mempoolState' TickedLedgerState (ShelleyBlock proto era)
st
  where
    ShelleyValidatedTx TxId (EraCrypto era)
_txid Validated (Tx era)
vtx = Validated (GenTx (ShelleyBlock proto era))
vgtx

    innerSt :: NewEpochState era
innerSt = TickedLedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era)
st

-- | 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)
  -> f (TickedLedgerState (ShelleyBlock proto era))
theLedgerLens :: forall (f :: * -> *) era proto.
Functor f =>
(LedgerState era -> f (LedgerState era))
-> TickedLedgerState (ShelleyBlock proto era)
-> f (TickedLedgerState (ShelleyBlock proto era))
theLedgerLens LedgerState era -> f (LedgerState era)
f TickedLedgerState (ShelleyBlock proto era)
x =
        (\NewEpochState era
y -> TickedLedgerState (ShelleyBlock proto era)
x{tickedShelleyLedgerState = y})
    (NewEpochState era -> TickedLedgerState (ShelleyBlock proto era))
-> f (NewEpochState era)
-> f (TickedLedgerState (ShelleyBlock proto era))
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) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era)
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 }

instance Semigroup (TxErrorSG era) where
  TxErrorSG (SL.ApplyTxError NonEmpty (PredicateFailure (EraRule "LEDGER" era))
x) <> :: TxErrorSG era -> TxErrorSG era -> TxErrorSG era
<> TxErrorSG (SL.ApplyTxError NonEmpty (PredicateFailure (EraRule "LEDGER" era))
y) =
    ApplyTxError era -> TxErrorSG era
forall era. ApplyTxError era -> TxErrorSG era
TxErrorSG (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (PredicateFailure (EraRule "LEDGER" era))
x NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall a. Semigroup a => a -> a -> a
<> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
y))

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 = TxErrorSG era
-> (Maybe a -> Maybe a) -> Maybe a -> Validation (TxErrorSG era) a
forall (v :: * -> * -> *) e a b.
Validate v =>
e -> (a -> Maybe b) -> a -> v e b
V.validate (ApplyTxError era -> TxErrorSG era
forall era. ApplyTxError era -> TxErrorSG era
TxErrorSG ApplyTxError era
err) Maybe a -> Maybe a
forall a. a -> a
id 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
. Validation (TxErrorSG era) a -> Either (TxErrorSG era) a
forall e a. Validation e a -> Either e a
V.toEither

-----

txsMaxBytes ::
     ShelleyCompatible proto era
  => TickedLedgerState (ShelleyBlock proto era)
  -> IgnoringOverflow ByteSize32
txsMaxBytes :: forall proto era.
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era)
-> IgnoringOverflow ByteSize32
txsMaxBytes TickedShelleyLedgerState { NewEpochState era
tickedShelleyLedgerState :: forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> 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)
  -> GenTx (ShelleyBlock proto era)
  -> V.Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize :: forall proto era.
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock proto era)
st (ShelleyTx TxId (EraCrypto era)
_txid Tx era
tx') =
    ApplyTxError era
-> Maybe (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
forall era a.
ApplyTxError era -> Maybe a -> Validation (TxErrorSG era) a
validateMaybe (Integer -> Integer -> ApplyTxError era
forall era.
MaxTxSizeUTxO era =>
Integer -> Integer -> ApplyTxError era
maxTxSizeUTxO Integer
txsz Integer
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
$ Integer
txsz Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
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
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
txsz
  where
    txsz :: Integer
txsz = Integer
forall a. Num a => a
perTxOverhead Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Tx era
tx' Tx era -> Getting Integer (Tx era) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer (Tx era) Integer
forall era. EraTx era => SimpleGetter (Tx era) Integer
SimpleGetter (Tx era) Integer
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) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era)
st
    limit :: Integer
limit   = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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) :: Integer

class MaxTxSizeUTxO era where
  maxTxSizeUTxO ::
       Integer
       -- ^ Actual transaction size
    -> Integer
       -- ^ Maximum transaction size
    -> SL.ApplyTxError era

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

instance MaxTxSizeUTxO (AllegraEra c) where
  maxTxSizeUTxO :: Integer -> Integer -> ApplyTxError (AllegraEra c)
maxTxSizeUTxO Integer
x Integer
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (AllegraEra c)))
-> ApplyTxError (AllegraEra c)
NonEmpty (ShelleyLedgerPredFailure (AllegraEra c))
-> ApplyTxError (AllegraEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ShelleyLedgerPredFailure (AllegraEra c))
 -> ApplyTxError (AllegraEra c))
-> (ShelleyLedgerPredFailure (AllegraEra c)
    -> NonEmpty (ShelleyLedgerPredFailure (AllegraEra c)))
-> ShelleyLedgerPredFailure (AllegraEra c)
-> ApplyTxError (AllegraEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure (AllegraEra c)
-> NonEmpty (ShelleyLedgerPredFailure (AllegraEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ShelleyLedgerPredFailure (AllegraEra c)
 -> ApplyTxError (AllegraEra c))
-> ShelleyLedgerPredFailure (AllegraEra c)
-> ApplyTxError (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (AllegraEra c))
-> ShelleyLedgerPredFailure (AllegraEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure
    (PredicateFailure (EraRule "UTXOW" (AllegraEra c))
 -> ShelleyLedgerPredFailure (AllegraEra c))
-> PredicateFailure (EraRule "UTXOW" (AllegraEra c))
-> ShelleyLedgerPredFailure (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (AllegraEra c))
-> ShelleyUtxowPredFailure (AllegraEra c)
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (AllegraEra c))
 -> ShelleyUtxowPredFailure (AllegraEra c))
-> PredicateFailure (EraRule "UTXO" (AllegraEra c))
-> ShelleyUtxowPredFailure (AllegraEra c)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> AllegraUtxoPredFailure (AllegraEra c)
forall era. Integer -> Integer -> AllegraUtxoPredFailure era
AllegraEra.MaxTxSizeUTxO Integer
x Integer
y

instance MaxTxSizeUTxO (MaryEra c) where
  maxTxSizeUTxO :: Integer -> Integer -> ApplyTxError (MaryEra c)
maxTxSizeUTxO Integer
x Integer
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (MaryEra c)))
-> ApplyTxError (MaryEra c)
NonEmpty (ShelleyLedgerPredFailure (MaryEra c))
-> ApplyTxError (MaryEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ShelleyLedgerPredFailure (MaryEra c))
 -> ApplyTxError (MaryEra c))
-> (ShelleyLedgerPredFailure (MaryEra c)
    -> NonEmpty (ShelleyLedgerPredFailure (MaryEra c)))
-> ShelleyLedgerPredFailure (MaryEra c)
-> ApplyTxError (MaryEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure (MaryEra c)
-> NonEmpty (ShelleyLedgerPredFailure (MaryEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ShelleyLedgerPredFailure (MaryEra c) -> ApplyTxError (MaryEra c))
-> ShelleyLedgerPredFailure (MaryEra c) -> ApplyTxError (MaryEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (MaryEra c))
-> ShelleyLedgerPredFailure (MaryEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure
    (PredicateFailure (EraRule "UTXOW" (MaryEra c))
 -> ShelleyLedgerPredFailure (MaryEra c))
-> PredicateFailure (EraRule "UTXOW" (MaryEra c))
-> ShelleyLedgerPredFailure (MaryEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (MaryEra c))
-> ShelleyUtxowPredFailure (MaryEra c)
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (MaryEra c))
 -> ShelleyUtxowPredFailure (MaryEra c))
-> PredicateFailure (EraRule "UTXO" (MaryEra c))
-> ShelleyUtxowPredFailure (MaryEra c)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> AllegraUtxoPredFailure (MaryEra c)
forall era. Integer -> Integer -> AllegraUtxoPredFailure era
AllegraEra.MaxTxSizeUTxO Integer
x Integer
y

instance MaxTxSizeUTxO (AlonzoEra c) where
  maxTxSizeUTxO :: Integer -> Integer -> ApplyTxError (AlonzoEra c)
maxTxSizeUTxO Integer
x Integer
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (AlonzoEra c)))
-> ApplyTxError (AlonzoEra c)
NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c))
-> ApplyTxError (AlonzoEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c))
 -> ApplyTxError (AlonzoEra c))
-> (ShelleyLedgerPredFailure (AlonzoEra c)
    -> NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c)))
-> ShelleyLedgerPredFailure (AlonzoEra c)
-> ApplyTxError (AlonzoEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure (AlonzoEra c)
-> NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ShelleyLedgerPredFailure (AlonzoEra c)
 -> ApplyTxError (AlonzoEra c))
-> ShelleyLedgerPredFailure (AlonzoEra c)
-> ApplyTxError (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (AlonzoEra c))
-> ShelleyLedgerPredFailure (AlonzoEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure
    (PredicateFailure (EraRule "UTXOW" (AlonzoEra c))
 -> ShelleyLedgerPredFailure (AlonzoEra c))
-> PredicateFailure (EraRule "UTXOW" (AlonzoEra c))
-> ShelleyLedgerPredFailure (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ ShelleyUtxowPredFailure (AlonzoEra c)
-> AlonzoUtxowPredFailure (AlonzoEra c)
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
AlonzoEra.ShelleyInAlonzoUtxowPredFailure
    (ShelleyUtxowPredFailure (AlonzoEra c)
 -> AlonzoUtxowPredFailure (AlonzoEra c))
-> ShelleyUtxowPredFailure (AlonzoEra c)
-> AlonzoUtxowPredFailure (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (AlonzoEra c))
-> ShelleyUtxowPredFailure (AlonzoEra c)
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (AlonzoEra c))
 -> ShelleyUtxowPredFailure (AlonzoEra c))
-> PredicateFailure (EraRule "UTXO" (AlonzoEra c))
-> ShelleyUtxowPredFailure (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> AlonzoUtxoPredFailure (AlonzoEra c)
forall era. Integer -> Integer -> AlonzoUtxoPredFailure era
AlonzoEra.MaxTxSizeUTxO Integer
x Integer
y

instance MaxTxSizeUTxO (BabbageEra c) where
  maxTxSizeUTxO :: Integer -> Integer -> ApplyTxError (BabbageEra c)
maxTxSizeUTxO Integer
x Integer
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (BabbageEra c)))
-> ApplyTxError (BabbageEra c)
NonEmpty (ShelleyLedgerPredFailure (BabbageEra c))
-> ApplyTxError (BabbageEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ShelleyLedgerPredFailure (BabbageEra c))
 -> ApplyTxError (BabbageEra c))
-> (ShelleyLedgerPredFailure (BabbageEra c)
    -> NonEmpty (ShelleyLedgerPredFailure (BabbageEra c)))
-> ShelleyLedgerPredFailure (BabbageEra c)
-> ApplyTxError (BabbageEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure (BabbageEra c)
-> NonEmpty (ShelleyLedgerPredFailure (BabbageEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ShelleyLedgerPredFailure (BabbageEra c)
 -> ApplyTxError (BabbageEra c))
-> ShelleyLedgerPredFailure (BabbageEra c)
-> ApplyTxError (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (BabbageEra c))
-> ShelleyLedgerPredFailure (BabbageEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure
    (PredicateFailure (EraRule "UTXOW" (BabbageEra c))
 -> ShelleyLedgerPredFailure (BabbageEra c))
-> PredicateFailure (EraRule "UTXOW" (BabbageEra c))
-> ShelleyLedgerPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (BabbageEra c))
-> BabbageUtxowPredFailure (BabbageEra c)
forall era.
PredicateFailure (EraRule "UTXO" era)
-> BabbageUtxowPredFailure era
BabbageEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (BabbageEra c))
 -> BabbageUtxowPredFailure (BabbageEra c))
-> PredicateFailure (EraRule "UTXO" (BabbageEra c))
-> BabbageUtxowPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ AlonzoUtxoPredFailure (BabbageEra c)
-> BabbageUtxoPredFailure (BabbageEra c)
forall era. AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era
BabbageEra.AlonzoInBabbageUtxoPredFailure
    (AlonzoUtxoPredFailure (BabbageEra c)
 -> BabbageUtxoPredFailure (BabbageEra c))
-> AlonzoUtxoPredFailure (BabbageEra c)
-> BabbageUtxoPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> AlonzoUtxoPredFailure (BabbageEra c)
forall era. Integer -> Integer -> AlonzoUtxoPredFailure era
AlonzoEra.MaxTxSizeUTxO Integer
x Integer
y

instance MaxTxSizeUTxO (ConwayEra c) where
  maxTxSizeUTxO :: Integer -> Integer -> ApplyTxError (ConwayEra c)
maxTxSizeUTxO Integer
x Integer
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (ConwayEra c)))
-> ApplyTxError (ConwayEra c)
NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
-> ApplyTxError (ConwayEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
 -> ApplyTxError (ConwayEra c))
-> (ConwayLedgerPredFailure (ConwayEra c)
    -> NonEmpty (ConwayLedgerPredFailure (ConwayEra c)))
-> ConwayLedgerPredFailure (ConwayEra c)
-> ApplyTxError (ConwayEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayLedgerPredFailure (ConwayEra c)
-> NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ConwayLedgerPredFailure (ConwayEra c)
 -> ApplyTxError (ConwayEra c))
-> ConwayLedgerPredFailure (ConwayEra c)
-> ApplyTxError (ConwayEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (ConwayEra c))
-> ConwayLedgerPredFailure (ConwayEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayEra.ConwayUtxowFailure
    (PredicateFailure (EraRule "UTXOW" (ConwayEra c))
 -> ConwayLedgerPredFailure (ConwayEra c))
-> PredicateFailure (EraRule "UTXOW" (ConwayEra c))
-> ConwayLedgerPredFailure (ConwayEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (ConwayEra c))
-> ConwayUtxowPredFailure (ConwayEra c)
forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
ConwayEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (ConwayEra c))
 -> ConwayUtxowPredFailure (ConwayEra c))
-> PredicateFailure (EraRule "UTXO" (ConwayEra c))
-> ConwayUtxowPredFailure (ConwayEra c)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> ConwayUtxoPredFailure (ConwayEra c)
forall era. Integer -> Integer -> ConwayUtxoPredFailure era
ConwayEra.MaxTxSizeUTxO Integer
x Integer
y

-----

instance ShelleyCompatible p (ShelleyEra c) => TxLimits (ShelleyBlock p (ShelleyEra c)) where
  type TxMeasure (ShelleyBlock p (ShelleyEra c)) = IgnoringOverflow ByteSize32
  txMeasure :: LedgerConfig (ShelleyBlock p (ShelleyEra c))
-> TickedLedgerState (ShelleyBlock p (ShelleyEra c))
-> GenTx (ShelleyBlock p (ShelleyEra c))
-> Except
     (ApplyTxErr (ShelleyBlock p (ShelleyEra c)))
     (TxMeasure (ShelleyBlock p (ShelleyEra c)))
txMeasure              LedgerConfig (ShelleyBlock p (ShelleyEra c))
_cfg TickedLedgerState (ShelleyBlock p (ShelleyEra c))
st GenTx (ShelleyBlock p (ShelleyEra c))
tx = Validation
  (TxErrorSG (ShelleyEra c))
  (TxMeasure (ShelleyBlock p (ShelleyEra c)))
-> Except
     (ApplyTxError (ShelleyEra c))
     (TxMeasure (ShelleyBlock p (ShelleyEra c)))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG (ShelleyEra c))
   (TxMeasure (ShelleyBlock p (ShelleyEra c)))
 -> Except
      (ApplyTxError (ShelleyEra c))
      (TxMeasure (ShelleyBlock p (ShelleyEra c))))
-> Validation
     (TxErrorSG (ShelleyEra c))
     (TxMeasure (ShelleyBlock p (ShelleyEra c)))
-> Except
     (ApplyTxError (ShelleyEra c))
     (TxMeasure (ShelleyBlock p (ShelleyEra c)))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p (ShelleyEra c))
-> GenTx (ShelleyBlock p (ShelleyEra c))
-> Validation
     (TxErrorSG (ShelleyEra c)) (IgnoringOverflow ByteSize32)
forall proto era.
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock p (ShelleyEra c))
st GenTx (ShelleyBlock p (ShelleyEra c))
tx
  blockCapacityTxMeasure :: LedgerConfig (ShelleyBlock p (ShelleyEra c))
-> TickedLedgerState (ShelleyBlock p (ShelleyEra c))
-> TxMeasure (ShelleyBlock p (ShelleyEra c))
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p (ShelleyEra c))
_cfg       = TickedLedgerState (ShelleyBlock p (ShelleyEra c))
-> IgnoringOverflow ByteSize32
TickedLedgerState (ShelleyBlock p (ShelleyEra c))
-> TxMeasure (ShelleyBlock p (ShelleyEra c))
forall proto era.
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era)
-> IgnoringOverflow ByteSize32
txsMaxBytes

instance ShelleyCompatible p (AllegraEra c) => TxLimits (ShelleyBlock p (AllegraEra c)) where
  type TxMeasure (ShelleyBlock p (AllegraEra c)) = IgnoringOverflow ByteSize32
  txMeasure :: LedgerConfig (ShelleyBlock p (AllegraEra c))
-> TickedLedgerState (ShelleyBlock p (AllegraEra c))
-> GenTx (ShelleyBlock p (AllegraEra c))
-> Except
     (ApplyTxErr (ShelleyBlock p (AllegraEra c)))
     (TxMeasure (ShelleyBlock p (AllegraEra c)))
txMeasure              LedgerConfig (ShelleyBlock p (AllegraEra c))
_cfg TickedLedgerState (ShelleyBlock p (AllegraEra c))
st GenTx (ShelleyBlock p (AllegraEra c))
tx = Validation
  (TxErrorSG (AllegraEra c))
  (TxMeasure (ShelleyBlock p (AllegraEra c)))
-> Except
     (ApplyTxError (AllegraEra c))
     (TxMeasure (ShelleyBlock p (AllegraEra c)))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG (AllegraEra c))
   (TxMeasure (ShelleyBlock p (AllegraEra c)))
 -> Except
      (ApplyTxError (AllegraEra c))
      (TxMeasure (ShelleyBlock p (AllegraEra c))))
-> Validation
     (TxErrorSG (AllegraEra c))
     (TxMeasure (ShelleyBlock p (AllegraEra c)))
-> Except
     (ApplyTxError (AllegraEra c))
     (TxMeasure (ShelleyBlock p (AllegraEra c)))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p (AllegraEra c))
-> GenTx (ShelleyBlock p (AllegraEra c))
-> Validation
     (TxErrorSG (AllegraEra c)) (IgnoringOverflow ByteSize32)
forall proto era.
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock p (AllegraEra c))
st GenTx (ShelleyBlock p (AllegraEra c))
tx
  blockCapacityTxMeasure :: LedgerConfig (ShelleyBlock p (AllegraEra c))
-> TickedLedgerState (ShelleyBlock p (AllegraEra c))
-> TxMeasure (ShelleyBlock p (AllegraEra c))
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p (AllegraEra c))
_cfg       = TickedLedgerState (ShelleyBlock p (AllegraEra c))
-> IgnoringOverflow ByteSize32
TickedLedgerState (ShelleyBlock p (AllegraEra c))
-> TxMeasure (ShelleyBlock p (AllegraEra c))
forall proto era.
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era)
-> IgnoringOverflow ByteSize32
txsMaxBytes

instance ShelleyCompatible p (MaryEra c) => TxLimits (ShelleyBlock p (MaryEra c)) where
  type TxMeasure (ShelleyBlock p (MaryEra c)) = IgnoringOverflow ByteSize32
  txMeasure :: LedgerConfig (ShelleyBlock p (MaryEra c))
-> TickedLedgerState (ShelleyBlock p (MaryEra c))
-> GenTx (ShelleyBlock p (MaryEra c))
-> Except
     (ApplyTxErr (ShelleyBlock p (MaryEra c)))
     (TxMeasure (ShelleyBlock p (MaryEra c)))
txMeasure              LedgerConfig (ShelleyBlock p (MaryEra c))
_cfg TickedLedgerState (ShelleyBlock p (MaryEra c))
st GenTx (ShelleyBlock p (MaryEra c))
tx = Validation
  (TxErrorSG (MaryEra c)) (TxMeasure (ShelleyBlock p (MaryEra c)))
-> Except
     (ApplyTxError (MaryEra c)) (TxMeasure (ShelleyBlock p (MaryEra c)))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG (MaryEra c)) (TxMeasure (ShelleyBlock p (MaryEra c)))
 -> Except
      (ApplyTxError (MaryEra c))
      (TxMeasure (ShelleyBlock p (MaryEra c))))
-> Validation
     (TxErrorSG (MaryEra c)) (TxMeasure (ShelleyBlock p (MaryEra c)))
-> Except
     (ApplyTxError (MaryEra c)) (TxMeasure (ShelleyBlock p (MaryEra c)))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p (MaryEra c))
-> GenTx (ShelleyBlock p (MaryEra c))
-> Validation (TxErrorSG (MaryEra c)) (IgnoringOverflow ByteSize32)
forall proto era.
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock p (MaryEra c))
st GenTx (ShelleyBlock p (MaryEra c))
tx
  blockCapacityTxMeasure :: LedgerConfig (ShelleyBlock p (MaryEra c))
-> TickedLedgerState (ShelleyBlock p (MaryEra c))
-> TxMeasure (ShelleyBlock p (MaryEra c))
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p (MaryEra c))
_cfg       = TickedLedgerState (ShelleyBlock p (MaryEra c))
-> IgnoringOverflow ByteSize32
TickedLedgerState (ShelleyBlock p (MaryEra c))
-> TxMeasure (ShelleyBlock p (MaryEra c))
forall proto era.
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era)
-> 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

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

blockCapacityAlonzoMeasure ::
     forall proto era.
     (ShelleyCompatible proto era, L.AlonzoEraPParams era)
  => TickedLedgerState (ShelleyBlock proto era)
  -> AlonzoMeasure
blockCapacityAlonzoMeasure :: forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) -> AlonzoMeasure
blockCapacityAlonzoMeasure TickedLedgerState (ShelleyBlock proto era)
ledgerState =
    AlonzoMeasure {
        byteSize :: IgnoringOverflow ByteSize32
byteSize = TickedLedgerState (ShelleyBlock proto era)
-> IgnoringOverflow ByteSize32
forall proto era.
ShelleyCompatible proto era =>
TickedLedgerState (ShelleyBlock proto era)
-> IgnoringOverflow ByteSize32
txsMaxBytes TickedLedgerState (ShelleyBlock proto era)
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) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era)
ledgerState

txMeasureAlonzo ::
     forall proto era.
     ( ShelleyCompatible proto era
     , L.AlonzoEraPParams era
     , L.AlonzoEraTxWits era
     , ExUnitsTooBigUTxO era
     , MaxTxSizeUTxO era
     )
  => TickedLedgerState (ShelleyBlock proto era)
  -> 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)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock proto era)
st tx :: GenTx (ShelleyBlock proto era)
tx@(ShelleyTx TxId (EraCrypto era)
_txid Tx 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)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
forall proto era.
(ShelleyCompatible proto era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
txInBlockSize TickedLedgerState (ShelleyBlock proto era)
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 era -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
totExUnits Tx 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) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era)
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
limit ExUnits
txsz) (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 Crypto c => ExUnitsTooBigUTxO (AlonzoEra c) where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> ApplyTxError (AlonzoEra c)
exUnitsTooBigUTxO ExUnits
x ExUnits
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (AlonzoEra c)))
-> ApplyTxError (AlonzoEra c)
NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c))
-> ApplyTxError (AlonzoEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c))
 -> ApplyTxError (AlonzoEra c))
-> (ShelleyLedgerPredFailure (AlonzoEra c)
    -> NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c)))
-> ShelleyLedgerPredFailure (AlonzoEra c)
-> ApplyTxError (AlonzoEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure (AlonzoEra c)
-> NonEmpty (ShelleyLedgerPredFailure (AlonzoEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ShelleyLedgerPredFailure (AlonzoEra c)
 -> ApplyTxError (AlonzoEra c))
-> ShelleyLedgerPredFailure (AlonzoEra c)
-> ApplyTxError (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (AlonzoEra c))
-> ShelleyLedgerPredFailure (AlonzoEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure
    (PredicateFailure (EraRule "UTXOW" (AlonzoEra c))
 -> ShelleyLedgerPredFailure (AlonzoEra c))
-> PredicateFailure (EraRule "UTXOW" (AlonzoEra c))
-> ShelleyLedgerPredFailure (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ ShelleyUtxowPredFailure (AlonzoEra c)
-> AlonzoUtxowPredFailure (AlonzoEra c)
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
AlonzoEra.ShelleyInAlonzoUtxowPredFailure
    (ShelleyUtxowPredFailure (AlonzoEra c)
 -> AlonzoUtxowPredFailure (AlonzoEra c))
-> ShelleyUtxowPredFailure (AlonzoEra c)
-> AlonzoUtxowPredFailure (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (AlonzoEra c))
-> ShelleyUtxowPredFailure (AlonzoEra c)
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (AlonzoEra c))
 -> ShelleyUtxowPredFailure (AlonzoEra c))
-> PredicateFailure (EraRule "UTXO" (AlonzoEra c))
-> ShelleyUtxowPredFailure (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$ ExUnits -> ExUnits -> AlonzoUtxoPredFailure (AlonzoEra c)
forall era. ExUnits -> ExUnits -> AlonzoUtxoPredFailure era
AlonzoEra.ExUnitsTooBigUTxO ExUnits
x ExUnits
y

instance Crypto c => ExUnitsTooBigUTxO (BabbageEra c) where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> ApplyTxError (BabbageEra c)
exUnitsTooBigUTxO ExUnits
x ExUnits
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (BabbageEra c)))
-> ApplyTxError (BabbageEra c)
NonEmpty (ShelleyLedgerPredFailure (BabbageEra c))
-> ApplyTxError (BabbageEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ShelleyLedgerPredFailure (BabbageEra c))
 -> ApplyTxError (BabbageEra c))
-> (ShelleyLedgerPredFailure (BabbageEra c)
    -> NonEmpty (ShelleyLedgerPredFailure (BabbageEra c)))
-> ShelleyLedgerPredFailure (BabbageEra c)
-> ApplyTxError (BabbageEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure (BabbageEra c)
-> NonEmpty (ShelleyLedgerPredFailure (BabbageEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ShelleyLedgerPredFailure (BabbageEra c)
 -> ApplyTxError (BabbageEra c))
-> ShelleyLedgerPredFailure (BabbageEra c)
-> ApplyTxError (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (BabbageEra c))
-> ShelleyLedgerPredFailure (BabbageEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ShelleyLedgerPredFailure era
ShelleyEra.UtxowFailure
    (PredicateFailure (EraRule "UTXOW" (BabbageEra c))
 -> ShelleyLedgerPredFailure (BabbageEra c))
-> PredicateFailure (EraRule "UTXOW" (BabbageEra c))
-> ShelleyLedgerPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ AlonzoUtxowPredFailure (BabbageEra c)
-> BabbageUtxowPredFailure (BabbageEra c)
forall era.
AlonzoUtxowPredFailure era -> BabbageUtxowPredFailure era
BabbageEra.AlonzoInBabbageUtxowPredFailure
    (AlonzoUtxowPredFailure (BabbageEra c)
 -> BabbageUtxowPredFailure (BabbageEra c))
-> AlonzoUtxowPredFailure (BabbageEra c)
-> BabbageUtxowPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ ShelleyUtxowPredFailure (BabbageEra c)
-> AlonzoUtxowPredFailure (BabbageEra c)
forall era.
ShelleyUtxowPredFailure era -> AlonzoUtxowPredFailure era
AlonzoEra.ShelleyInAlonzoUtxowPredFailure
    (ShelleyUtxowPredFailure (BabbageEra c)
 -> AlonzoUtxowPredFailure (BabbageEra c))
-> ShelleyUtxowPredFailure (BabbageEra c)
-> AlonzoUtxowPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (BabbageEra c))
-> ShelleyUtxowPredFailure (BabbageEra c)
forall era.
PredicateFailure (EraRule "UTXO" era)
-> ShelleyUtxowPredFailure era
ShelleyEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (BabbageEra c))
 -> ShelleyUtxowPredFailure (BabbageEra c))
-> PredicateFailure (EraRule "UTXO" (BabbageEra c))
-> ShelleyUtxowPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ AlonzoUtxoPredFailure (BabbageEra c)
-> BabbageUtxoPredFailure (BabbageEra c)
forall era. AlonzoUtxoPredFailure era -> BabbageUtxoPredFailure era
BabbageEra.AlonzoInBabbageUtxoPredFailure
    (AlonzoUtxoPredFailure (BabbageEra c)
 -> BabbageUtxoPredFailure (BabbageEra c))
-> AlonzoUtxoPredFailure (BabbageEra c)
-> BabbageUtxoPredFailure (BabbageEra c)
forall a b. (a -> b) -> a -> b
$ ExUnits -> ExUnits -> AlonzoUtxoPredFailure (BabbageEra c)
forall era. ExUnits -> ExUnits -> AlonzoUtxoPredFailure era
AlonzoEra.ExUnitsTooBigUTxO ExUnits
x ExUnits
y

instance Crypto c => ExUnitsTooBigUTxO (ConwayEra c) where
  exUnitsTooBigUTxO :: ExUnits -> ExUnits -> ApplyTxError (ConwayEra c)
exUnitsTooBigUTxO ExUnits
x ExUnits
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (ConwayEra c)))
-> ApplyTxError (ConwayEra c)
NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
-> ApplyTxError (ConwayEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
 -> ApplyTxError (ConwayEra c))
-> (ConwayLedgerPredFailure (ConwayEra c)
    -> NonEmpty (ConwayLedgerPredFailure (ConwayEra c)))
-> ConwayLedgerPredFailure (ConwayEra c)
-> ApplyTxError (ConwayEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayLedgerPredFailure (ConwayEra c)
-> NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ConwayLedgerPredFailure (ConwayEra c)
 -> ApplyTxError (ConwayEra c))
-> ConwayLedgerPredFailure (ConwayEra c)
-> ApplyTxError (ConwayEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXOW" (ConwayEra c))
-> ConwayLedgerPredFailure (ConwayEra c)
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> ConwayLedgerPredFailure era
ConwayEra.ConwayUtxowFailure
    (PredicateFailure (EraRule "UTXOW" (ConwayEra c))
 -> ConwayLedgerPredFailure (ConwayEra c))
-> PredicateFailure (EraRule "UTXOW" (ConwayEra c))
-> ConwayLedgerPredFailure (ConwayEra c)
forall a b. (a -> b) -> a -> b
$ PredicateFailure (EraRule "UTXO" (ConwayEra c))
-> ConwayUtxowPredFailure (ConwayEra c)
forall era.
PredicateFailure (EraRule "UTXO" era) -> ConwayUtxowPredFailure era
ConwayEra.UtxoFailure
    (PredicateFailure (EraRule "UTXO" (ConwayEra c))
 -> ConwayUtxowPredFailure (ConwayEra c))
-> PredicateFailure (EraRule "UTXO" (ConwayEra c))
-> ConwayUtxowPredFailure (ConwayEra c)
forall a b. (a -> b) -> a -> b
$ ExUnits -> ExUnits -> ConwayUtxoPredFailure (ConwayEra c)
forall era. ExUnits -> ExUnits -> ConwayUtxoPredFailure era
ConwayEra.ExUnitsTooBigUTxO ExUnits
x ExUnits
y

-----

instance ( ShelleyCompatible p (AlonzoEra c)
         ) => TxLimits (ShelleyBlock p (AlonzoEra c)) where

  type TxMeasure (ShelleyBlock p (AlonzoEra c)) = AlonzoMeasure
  txMeasure :: LedgerConfig (ShelleyBlock p (AlonzoEra c))
-> TickedLedgerState (ShelleyBlock p (AlonzoEra c))
-> GenTx (ShelleyBlock p (AlonzoEra c))
-> Except
     (ApplyTxErr (ShelleyBlock p (AlonzoEra c)))
     (TxMeasure (ShelleyBlock p (AlonzoEra c)))
txMeasure              LedgerConfig (ShelleyBlock p (AlonzoEra c))
_cfg TickedLedgerState (ShelleyBlock p (AlonzoEra c))
st GenTx (ShelleyBlock p (AlonzoEra c))
tx = Validation
  (TxErrorSG (AlonzoEra c))
  (TxMeasure (ShelleyBlock p (AlonzoEra c)))
-> Except
     (ApplyTxError (AlonzoEra c))
     (TxMeasure (ShelleyBlock p (AlonzoEra c)))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG (AlonzoEra c))
   (TxMeasure (ShelleyBlock p (AlonzoEra c)))
 -> Except
      (ApplyTxError (AlonzoEra c))
      (TxMeasure (ShelleyBlock p (AlonzoEra c))))
-> Validation
     (TxErrorSG (AlonzoEra c))
     (TxMeasure (ShelleyBlock p (AlonzoEra c)))
-> Except
     (ApplyTxError (AlonzoEra c))
     (TxMeasure (ShelleyBlock p (AlonzoEra c)))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p (AlonzoEra c))
-> GenTx (ShelleyBlock p (AlonzoEra c))
-> Validation (TxErrorSG (AlonzoEra c)) AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era,
 AlonzoEraTxWits era, ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock p (AlonzoEra c))
st GenTx (ShelleyBlock p (AlonzoEra c))
tx
  blockCapacityTxMeasure :: LedgerConfig (ShelleyBlock p (AlonzoEra c))
-> TickedLedgerState (ShelleyBlock p (AlonzoEra c))
-> TxMeasure (ShelleyBlock p (AlonzoEra c))
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p (AlonzoEra c))
_cfg       = TickedLedgerState (ShelleyBlock p (AlonzoEra c))
-> TxMeasure (ShelleyBlock p (AlonzoEra c))
TickedLedgerState (ShelleyBlock p (AlonzoEra c)) -> AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) -> AlonzoMeasure
blockCapacityAlonzoMeasure

-----

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

instance HasByteSize ConwayMeasure where
  txMeasureByteSize :: ConwayMeasure -> ByteSize32
txMeasureByteSize = AlonzoMeasure -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize (AlonzoMeasure -> ByteSize32)
-> (ConwayMeasure -> AlonzoMeasure) -> ConwayMeasure -> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayMeasure -> AlonzoMeasure
alonzoMeasure

blockCapacityConwayMeasure ::
     forall proto era.
     ( ShelleyCompatible proto era
     , L.AlonzoEraPParams era
     )
  => TickedLedgerState (ShelleyBlock proto era)
  -> ConwayMeasure
blockCapacityConwayMeasure :: forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) -> ConwayMeasure
blockCapacityConwayMeasure TickedLedgerState (ShelleyBlock proto era)
st =
    ConwayMeasure {
        alonzoMeasure :: AlonzoMeasure
alonzoMeasure  = TickedLedgerState (ShelleyBlock proto era) -> AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) -> AlonzoMeasure
blockCapacityAlonzoMeasure TickedLedgerState (ShelleyBlock proto era)
st
      , refScriptsSize :: IgnoringOverflow ByteSize32
refScriptsSize = 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 -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$
          -- For post-Conway eras, this will become a protocol parameter.
          Int
SL.maxRefScriptSizePerBlock
      }

txMeasureConway ::
     forall proto era.
     ( ShelleyCompatible proto era
     , L.AlonzoEraTxWits era
     , L.BabbageEraTxBody era
     , ExUnitsTooBigUTxO era
     , MaxTxSizeUTxO era
     , TxRefScriptsSizeTooBig era
     )
  => TickedLedgerState (ShelleyBlock proto era)
  -> GenTx (ShelleyBlock proto era)
  -> V.Validation (TxErrorSG era) ConwayMeasure
txMeasureConway :: forall proto era.
(ShelleyCompatible proto era, AlonzoEraTxWits era,
 BabbageEraTxBody era, ExUnitsTooBigUTxO era, MaxTxSizeUTxO era,
 TxRefScriptsSizeTooBig era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) ConwayMeasure
txMeasureConway TickedLedgerState (ShelleyBlock proto era)
st tx :: GenTx (ShelleyBlock proto era)
tx@(ShelleyTx TxId (EraCrypto era)
_txid Tx era
tx') =
    AlonzoMeasure -> IgnoringOverflow ByteSize32 -> ConwayMeasure
ConwayMeasure (AlonzoMeasure -> IgnoringOverflow ByteSize32 -> ConwayMeasure)
-> Validation (TxErrorSG era) AlonzoMeasure
-> Validation
     (TxErrorSG era) (IgnoringOverflow ByteSize32 -> ConwayMeasure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era,
 AlonzoEraTxWits era, ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock proto era)
st GenTx (ShelleyBlock proto era)
tx Validation
  (TxErrorSG era) (IgnoringOverflow ByteSize32 -> ConwayMeasure)
-> Validation (TxErrorSG era) (IgnoringOverflow ByteSize32)
-> Validation (TxErrorSG era) ConwayMeasure
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) (IgnoringOverflow ByteSize32)
refScriptBytes
  where
    utxo :: UTxO era
utxo = NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
SL.getUTxO (NewEpochState era -> UTxO era)
-> (TickedLedgerState (ShelleyBlock proto era)
    -> NewEpochState era)
-> TickedLedgerState (ShelleyBlock proto era)
-> UTxO era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickedLedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState (TickedLedgerState (ShelleyBlock proto era) -> UTxO era)
-> TickedLedgerState (ShelleyBlock proto era) -> UTxO era
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era)
st
    txsz :: Int
txsz = UTxO era -> Tx era -> Int
forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> Int
SL.txNonDistinctRefScriptsSize UTxO era
utxo Tx era
tx' :: Int

    -- For post-Conway eras, this will become a protocol parameter.
    limit :: Int
limit = Int
SL.maxRefScriptSizePerTx

    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
limit Int
txsz) (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 Crypto c => TxRefScriptsSizeTooBig (ConwayEra c) where
  txRefScriptsSizeTooBig :: Int -> Int -> ApplyTxError (ConwayEra c)
txRefScriptsSizeTooBig Int
x Int
y =
      NonEmpty (PredicateFailure (EraRule "LEDGER" (ConwayEra c)))
-> ApplyTxError (ConwayEra c)
NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
-> ApplyTxError (ConwayEra c)
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
SL.ApplyTxError (NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
 -> ApplyTxError (ConwayEra c))
-> (ConwayLedgerPredFailure (ConwayEra c)
    -> NonEmpty (ConwayLedgerPredFailure (ConwayEra c)))
-> ConwayLedgerPredFailure (ConwayEra c)
-> ApplyTxError (ConwayEra c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayLedgerPredFailure (ConwayEra c)
-> NonEmpty (ConwayLedgerPredFailure (ConwayEra c))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ConwayLedgerPredFailure (ConwayEra c)
 -> ApplyTxError (ConwayEra c))
-> ConwayLedgerPredFailure (ConwayEra c)
-> ApplyTxError (ConwayEra c)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ConwayLedgerPredFailure (ConwayEra c)
forall era. Int -> Int -> ConwayLedgerPredFailure era
ConwayEra.ConwayTxRefScriptsSizeTooBig Int
x Int
y

-----

txMeasureBabbage ::
     forall proto era.
     ( ShelleyCompatible proto era
     , L.AlonzoEraTxWits era
     , L.BabbageEraTxBody era
     , ExUnitsTooBigUTxO era
     , MaxTxSizeUTxO era
     )
  => TickedLedgerState (ShelleyBlock proto era)
  -> GenTx (ShelleyBlock proto era)
  -> V.Validation (TxErrorSG era) ConwayMeasure
txMeasureBabbage :: forall proto era.
(ShelleyCompatible proto era, AlonzoEraTxWits era,
 BabbageEraTxBody era, ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) ConwayMeasure
txMeasureBabbage TickedLedgerState (ShelleyBlock proto era)
st tx :: GenTx (ShelleyBlock proto era)
tx@(ShelleyTx TxId (EraCrypto era)
_txid Tx era
tx') =
    (\AlonzoMeasure
x -> AlonzoMeasure -> IgnoringOverflow ByteSize32 -> ConwayMeasure
ConwayMeasure AlonzoMeasure
x IgnoringOverflow ByteSize32
refScriptBytes) (AlonzoMeasure -> ConwayMeasure)
-> Validation (TxErrorSG era) AlonzoMeasure
-> Validation (TxErrorSG era) ConwayMeasure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era,
 AlonzoEraTxWits era, ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) AlonzoMeasure
txMeasureAlonzo TickedLedgerState (ShelleyBlock proto era)
st GenTx (ShelleyBlock proto era)
tx
  where
    utxo :: UTxO era
utxo = NewEpochState era -> UTxO era
forall era. NewEpochState era -> UTxO era
SL.getUTxO (NewEpochState era -> UTxO era) -> NewEpochState era -> UTxO era
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era)
st

    -- The Babbage rules should have checked this ref script size against a
    -- limit, but they did not. Now that Cardano @mainnet@ is in Conway, that
    -- omission is no longer an attack vector. Any other chain intending to
    -- ever use Babbage as its current era ought to patch this.
    refScriptBytes :: IgnoringOverflow ByteSize32
refScriptBytes =
        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 (UTxO era -> Tx era -> Int
forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> Int
SL.txNonDistinctRefScriptsSize UTxO era
utxo Tx era
tx' :: Int)

-- | We anachronistically use 'ConwayMeasure' in Babbage.
instance ( ShelleyCompatible p (BabbageEra c)
         ) => TxLimits (ShelleyBlock p (BabbageEra c)) where

  type TxMeasure (ShelleyBlock p (BabbageEra c)) = ConwayMeasure
  txMeasure :: LedgerConfig (ShelleyBlock p (BabbageEra c))
-> TickedLedgerState (ShelleyBlock p (BabbageEra c))
-> GenTx (ShelleyBlock p (BabbageEra c))
-> Except
     (ApplyTxErr (ShelleyBlock p (BabbageEra c)))
     (TxMeasure (ShelleyBlock p (BabbageEra c)))
txMeasure              LedgerConfig (ShelleyBlock p (BabbageEra c))
_cfg TickedLedgerState (ShelleyBlock p (BabbageEra c))
st GenTx (ShelleyBlock p (BabbageEra c))
tx = Validation
  (TxErrorSG (BabbageEra c))
  (TxMeasure (ShelleyBlock p (BabbageEra c)))
-> Except
     (ApplyTxError (BabbageEra c))
     (TxMeasure (ShelleyBlock p (BabbageEra c)))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG (BabbageEra c))
   (TxMeasure (ShelleyBlock p (BabbageEra c)))
 -> Except
      (ApplyTxError (BabbageEra c))
      (TxMeasure (ShelleyBlock p (BabbageEra c))))
-> Validation
     (TxErrorSG (BabbageEra c))
     (TxMeasure (ShelleyBlock p (BabbageEra c)))
-> Except
     (ApplyTxError (BabbageEra c))
     (TxMeasure (ShelleyBlock p (BabbageEra c)))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p (BabbageEra c))
-> GenTx (ShelleyBlock p (BabbageEra c))
-> Validation (TxErrorSG (BabbageEra c)) ConwayMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraTxWits era,
 BabbageEraTxBody era, ExUnitsTooBigUTxO era, MaxTxSizeUTxO era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) ConwayMeasure
txMeasureBabbage TickedLedgerState (ShelleyBlock p (BabbageEra c))
st GenTx (ShelleyBlock p (BabbageEra c))
tx
  blockCapacityTxMeasure :: LedgerConfig (ShelleyBlock p (BabbageEra c))
-> TickedLedgerState (ShelleyBlock p (BabbageEra c))
-> TxMeasure (ShelleyBlock p (BabbageEra c))
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p (BabbageEra c))
_cfg       = TickedLedgerState (ShelleyBlock p (BabbageEra c))
-> TxMeasure (ShelleyBlock p (BabbageEra c))
TickedLedgerState (ShelleyBlock p (BabbageEra c)) -> ConwayMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) -> ConwayMeasure
blockCapacityConwayMeasure

instance ( ShelleyCompatible p (ConwayEra c)
         ) => TxLimits (ShelleyBlock p (ConwayEra c)) where

  type TxMeasure (ShelleyBlock p (ConwayEra c)) = ConwayMeasure
  txMeasure :: LedgerConfig (ShelleyBlock p (ConwayEra c))
-> TickedLedgerState (ShelleyBlock p (ConwayEra c))
-> GenTx (ShelleyBlock p (ConwayEra c))
-> Except
     (ApplyTxErr (ShelleyBlock p (ConwayEra c)))
     (TxMeasure (ShelleyBlock p (ConwayEra c)))
txMeasure              LedgerConfig (ShelleyBlock p (ConwayEra c))
_cfg TickedLedgerState (ShelleyBlock p (ConwayEra c))
st GenTx (ShelleyBlock p (ConwayEra c))
tx = Validation
  (TxErrorSG (ConwayEra c))
  (TxMeasure (ShelleyBlock p (ConwayEra c)))
-> Except
     (ApplyTxError (ConwayEra c))
     (TxMeasure (ShelleyBlock p (ConwayEra c)))
forall era a.
Validation (TxErrorSG era) a -> Except (ApplyTxError era) a
runValidation (Validation
   (TxErrorSG (ConwayEra c))
   (TxMeasure (ShelleyBlock p (ConwayEra c)))
 -> Except
      (ApplyTxError (ConwayEra c))
      (TxMeasure (ShelleyBlock p (ConwayEra c))))
-> Validation
     (TxErrorSG (ConwayEra c))
     (TxMeasure (ShelleyBlock p (ConwayEra c)))
-> Except
     (ApplyTxError (ConwayEra c))
     (TxMeasure (ShelleyBlock p (ConwayEra c)))
forall a b. (a -> b) -> a -> b
$ TickedLedgerState (ShelleyBlock p (ConwayEra c))
-> GenTx (ShelleyBlock p (ConwayEra c))
-> Validation (TxErrorSG (ConwayEra c)) ConwayMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraTxWits era,
 BabbageEraTxBody era, ExUnitsTooBigUTxO era, MaxTxSizeUTxO era,
 TxRefScriptsSizeTooBig era) =>
TickedLedgerState (ShelleyBlock proto era)
-> GenTx (ShelleyBlock proto era)
-> Validation (TxErrorSG era) ConwayMeasure
txMeasureConway TickedLedgerState (ShelleyBlock p (ConwayEra c))
st GenTx (ShelleyBlock p (ConwayEra c))
tx
  blockCapacityTxMeasure :: LedgerConfig (ShelleyBlock p (ConwayEra c))
-> TickedLedgerState (ShelleyBlock p (ConwayEra c))
-> TxMeasure (ShelleyBlock p (ConwayEra c))
blockCapacityTxMeasure LedgerConfig (ShelleyBlock p (ConwayEra c))
_cfg       = TickedLedgerState (ShelleyBlock p (ConwayEra c))
-> TxMeasure (ShelleyBlock p (ConwayEra c))
TickedLedgerState (ShelleyBlock p (ConwayEra c)) -> ConwayMeasure
forall proto era.
(ShelleyCompatible proto era, AlonzoEraPParams era) =>
TickedLedgerState (ShelleyBlock proto era) -> ConwayMeasure
blockCapacityConwayMeasure