{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Conway.Rules.Bbody (
ConwayBBODY,
ConwayBbodyPredFailure (..),
maxRefScriptSizePerBlock,
) where
import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
import Cardano.Ledger.Alonzo.PParams (AlonzoEraPParams)
import Cardano.Ledger.Alonzo.Rules (
AlonzoBbodyEvent (..),
AlonzoBbodyPredFailure (ShelleyInAlonzoBbodyPredFailure),
AlonzoUtxoPredFailure,
AlonzoUtxosPredFailure,
AlonzoUtxowPredFailure,
alonzoBbodyTransition,
)
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo (AlonzoBbodyPredFailure (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.Tx (AlonzoTx)
import Cardano.Ledger.Alonzo.TxSeq (AlonzoTxSeq, txSeqTxns)
import Cardano.Ledger.Alonzo.TxWits (AlonzoEraTxWits (..))
import Cardano.Ledger.BHeaderView (BHeaderView (..))
import Cardano.Ledger.Babbage.Core (BabbageEraTxBody)
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure)
import Cardano.Ledger.BaseTypes (Mismatch (..), ShelleyBase)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (
Decode (..),
Encode (..),
decode,
encode,
(!>),
(<!),
)
import Cardano.Ledger.Block (Block (..))
import Cardano.Ledger.Conway.Era (ConwayBBODY, ConwayEra)
import Cardano.Ledger.Conway.Rules.Cert (ConwayCertPredFailure)
import Cardano.Ledger.Conway.Rules.Certs (ConwayCertsPredFailure)
import Cardano.Ledger.Conway.Rules.Deleg (ConwayDelegPredFailure)
import Cardano.Ledger.Conway.Rules.Gov (ConwayGovPredFailure)
import Cardano.Ledger.Conway.Rules.GovCert (ConwayGovCertPredFailure)
import Cardano.Ledger.Conway.Rules.Ledger (ConwayLedgerPredFailure)
import Cardano.Ledger.Conway.Rules.Ledgers ()
import Cardano.Ledger.Conway.Rules.Utxo (ConwayUtxoPredFailure)
import Cardano.Ledger.Conway.Rules.Utxos (ConwayUtxosPredFailure)
import Cardano.Ledger.Conway.Rules.Utxow (ConwayUtxowPredFailure)
import Cardano.Ledger.Conway.UTxO (txNonDistinctRefScriptsSize)
import Cardano.Ledger.Core
import qualified Cardano.Ledger.Era as Era
import Cardano.Ledger.Keys (DSignable, Hash)
import Cardano.Ledger.Shelley.LedgerState (LedgerState (..), lsUTxOState, utxosUtxo)
import Cardano.Ledger.Shelley.Rules (
BbodyEnv (..),
ShelleyBbodyEvent (..),
ShelleyBbodyPredFailure,
ShelleyBbodyState (..),
ShelleyLedgersEnv (..),
ShelleyLedgersPredFailure,
ShelleyPoolPredFailure,
ShelleyUtxoPredFailure,
ShelleyUtxowPredFailure,
)
import qualified Cardano.Ledger.Shelley.Rules as Shelley (ShelleyBbodyPredFailure (..))
import Control.State.Transition (
Embed (..),
STS (..),
TRC (..),
TransitionRule,
judgmentContext,
(?!),
)
import Data.Foldable (Foldable (foldMap'))
import Data.Monoid (Sum (getSum))
import qualified Data.Monoid as Monoid (Sum (..))
import Data.Sequence (Seq)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
maxRefScriptSizePerBlock :: Int
maxRefScriptSizePerBlock :: Int
maxRefScriptSizePerBlock = Int
1024 forall a. Num a => a -> a -> a
* Int
1024
data ConwayBbodyPredFailure era
= WrongBlockBodySizeBBODY
!Int
!Int
| InvalidBodyHashBBODY
!(Hash (EraCrypto era) EraIndependentBlockBody)
!(Hash (EraCrypto era) EraIndependentBlockBody)
|
LedgersFailure !(PredicateFailure (EraRule "LEDGERS" era))
| TooManyExUnits
!ExUnits
!ExUnits
| BodyRefScriptsSizeTooBig
Int
Int
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayBbodyPredFailure era) x -> ConwayBbodyPredFailure era
forall era x.
ConwayBbodyPredFailure era -> Rep (ConwayBbodyPredFailure era) x
$cto :: forall era x.
Rep (ConwayBbodyPredFailure era) x -> ConwayBbodyPredFailure era
$cfrom :: forall era x.
ConwayBbodyPredFailure era -> Rep (ConwayBbodyPredFailure era) x
Generic)
deriving instance
(Era era, Show (PredicateFailure (EraRule "LEDGERS" era))) =>
Show (ConwayBbodyPredFailure era)
deriving instance
(Era era, Eq (PredicateFailure (EraRule "LEDGERS" era))) =>
Eq (ConwayBbodyPredFailure era)
deriving anyclass instance
(Era era, NoThunks (PredicateFailure (EraRule "LEDGERS" era))) =>
NoThunks (ConwayBbodyPredFailure era)
instance
( Era era
, EncCBOR (PredicateFailure (EraRule "LEDGERS" era))
) =>
EncCBOR (ConwayBbodyPredFailure era)
where
encCBOR :: ConwayBbodyPredFailure era -> Encoding
encCBOR =
forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
WrongBlockBodySizeBBODY Int
x Int
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Int -> Int -> ConwayBbodyPredFailure era
WrongBlockBodySizeBBODY Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
x forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
y
InvalidBodyHashBBODY Hash (HASH (EraCrypto era)) EraIndependentBlockBody
x Hash (HASH (EraCrypto era)) EraIndependentBlockBody
y -> forall t. t -> Word -> Encode 'Open t
Sum (forall era.
Hash (EraCrypto era) EraIndependentBlockBody
-> Hash (EraCrypto era) EraIndependentBlockBody
-> ConwayBbodyPredFailure era
InvalidBodyHashBBODY @era) Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Hash (HASH (EraCrypto era)) EraIndependentBlockBody
x forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Hash (HASH (EraCrypto era)) EraIndependentBlockBody
y
LedgersFailure PredicateFailure (EraRule "LEDGERS" era)
x -> forall t. t -> Word -> Encode 'Open t
Sum (forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ConwayBbodyPredFailure era
LedgersFailure @era) Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PredicateFailure (EraRule "LEDGERS" era)
x
TooManyExUnits ExUnits
x ExUnits
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era. ExUnits -> ExUnits -> ConwayBbodyPredFailure era
TooManyExUnits Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
x forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
y
BodyRefScriptsSizeTooBig Int
x Int
y -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Int -> Int -> ConwayBbodyPredFailure era
BodyRefScriptsSizeTooBig Word
4 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
x forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
y
instance
( Era era
, DecCBOR (PredicateFailure (EraRule "LEDGERS" era))
) =>
DecCBOR (ConwayBbodyPredFailure era)
where
decCBOR :: forall s. Decoder s (ConwayBbodyPredFailure era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayBbodyPred" forall a b. (a -> b) -> a -> b
$ \case
Word
0 -> forall t. t -> Decode 'Open t
SumD forall era. Int -> Int -> ConwayBbodyPredFailure era
WrongBlockBodySizeBBODY forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
1 -> forall t. t -> Decode 'Open t
SumD forall era.
Hash (EraCrypto era) EraIndependentBlockBody
-> Hash (EraCrypto era) EraIndependentBlockBody
-> ConwayBbodyPredFailure era
InvalidBodyHashBBODY forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
2 -> forall t. t -> Decode 'Open t
SumD forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ConwayBbodyPredFailure era
LedgersFailure forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
3 -> forall t. t -> Decode 'Open t
SumD forall era. ExUnits -> ExUnits -> ConwayBbodyPredFailure era
TooManyExUnits forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
4 -> forall t. t -> Decode 'Open t
SumD forall era. Int -> Int -> ConwayBbodyPredFailure era
BodyRefScriptsSizeTooBig forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n
type instance EraRuleFailure "BBODY" (ConwayEra c) = ConwayBbodyPredFailure (ConwayEra c)
type instance EraRuleEvent "BBODY" (ConwayEra c) = AlonzoBbodyEvent (ConwayEra c)
instance InjectRuleFailure "BBODY" ConwayBbodyPredFailure (ConwayEra c)
instance InjectRuleFailure "BBODY" AlonzoBbodyPredFailure (ConwayEra c) where
injectFailure :: AlonzoBbodyPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
AlonzoBbodyPredFailure era -> ConwayBbodyPredFailure era
alonzoToConwayBbodyPredFailure
instance InjectRuleFailure "BBODY" ShelleyBbodyPredFailure (ConwayEra c) where
injectFailure :: ShelleyBbodyPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure
instance InjectRuleFailure "BBODY" ShelleyLedgersPredFailure (ConwayEra c) where
injectFailure :: ShelleyLedgersPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure
instance InjectRuleFailure "BBODY" ConwayLedgerPredFailure (ConwayEra c) where
injectFailure :: ConwayLedgerPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayUtxowPredFailure (ConwayEra c) where
injectFailure :: ConwayUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" BabbageUtxowPredFailure (ConwayEra c) where
injectFailure :: BabbageUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" AlonzoUtxowPredFailure (ConwayEra c) where
injectFailure :: AlonzoUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ShelleyUtxowPredFailure (ConwayEra c) where
injectFailure :: ShelleyUtxowPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayUtxoPredFailure (ConwayEra c) where
injectFailure :: ConwayUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" BabbageUtxoPredFailure (ConwayEra c) where
injectFailure :: BabbageUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" AlonzoUtxoPredFailure (ConwayEra c) where
injectFailure :: AlonzoUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" AlonzoUtxosPredFailure (ConwayEra c) where
injectFailure :: AlonzoUtxosPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayUtxosPredFailure (ConwayEra c) where
injectFailure :: ConwayUtxosPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ShelleyUtxoPredFailure (ConwayEra c) where
injectFailure :: ShelleyUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" AllegraUtxoPredFailure (ConwayEra c) where
injectFailure :: AllegraUtxoPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayCertsPredFailure (ConwayEra c) where
injectFailure :: ConwayCertsPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayCertPredFailure (ConwayEra c) where
injectFailure :: ConwayCertPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayDelegPredFailure (ConwayEra c) where
injectFailure :: ConwayDelegPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ShelleyPoolPredFailure (ConwayEra c) where
injectFailure :: ShelleyPoolPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayGovCertPredFailure (ConwayEra c) where
injectFailure :: ConwayGovCertPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
instance InjectRuleFailure "BBODY" ConwayGovPredFailure (ConwayEra c) where
injectFailure :: ConwayGovPredFailure (ConwayEra c)
-> EraRuleFailure "BBODY" (ConwayEra c)
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ShelleyBbodyPredFailure era
Shelley.LedgersFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
shelleyToConwayBbodyPredFailure ::
forall era.
ShelleyBbodyPredFailure era ->
ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure :: forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure
(Shelley.WrongBlockBodySizeBBODY (Mismatch Int
supplied Int
expected)) =
forall era. Int -> Int -> ConwayBbodyPredFailure era
WrongBlockBodySizeBBODY Int
supplied Int
expected
shelleyToConwayBbodyPredFailure
(Shelley.InvalidBodyHashBBODY (Mismatch Hash (EraCrypto era) EraIndependentBlockBody
supplied Hash (EraCrypto era) EraIndependentBlockBody
expected)) =
forall era.
Hash (EraCrypto era) EraIndependentBlockBody
-> Hash (EraCrypto era) EraIndependentBlockBody
-> ConwayBbodyPredFailure era
InvalidBodyHashBBODY Hash (EraCrypto era) EraIndependentBlockBody
supplied Hash (EraCrypto era) EraIndependentBlockBody
expected
shelleyToConwayBbodyPredFailure (Shelley.LedgersFailure PredicateFailure (EraRule "LEDGERS" era)
x) = forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ConwayBbodyPredFailure era
LedgersFailure PredicateFailure (EraRule "LEDGERS" era)
x
alonzoToConwayBbodyPredFailure ::
forall era.
AlonzoBbodyPredFailure era ->
ConwayBbodyPredFailure era
alonzoToConwayBbodyPredFailure :: forall era.
AlonzoBbodyPredFailure era -> ConwayBbodyPredFailure era
alonzoToConwayBbodyPredFailure (ShelleyInAlonzoBbodyPredFailure ShelleyBbodyPredFailure era
x) = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure ShelleyBbodyPredFailure era
x
alonzoToConwayBbodyPredFailure (Alonzo.TooManyExUnits ExUnits
x ExUnits
y) = forall era. ExUnits -> ExUnits -> ConwayBbodyPredFailure era
TooManyExUnits ExUnits
x ExUnits
y
instance
( DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody)
, Embed (EraRule "LEDGERS" era) (EraRule "BBODY" era)
, Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era
, State (EraRule "LEDGERS" era) ~ LedgerState era
, Signal (EraRule "LEDGERS" era) ~ Seq (AlonzoTx era)
, AlonzoEraTxWits era
, Tx era ~ AlonzoTx era
, Era.TxSeq era ~ AlonzoTxSeq era
, Tx era ~ AlonzoTx era
, EraSegWits era
, AlonzoEraPParams era
, InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era
, InjectRuleFailure "BBODY" ConwayBbodyPredFailure era
, EraRule "BBODY" era ~ ConwayBBODY era
, EraTx era
, BabbageEraTxBody era
) =>
STS (ConwayBBODY era)
where
type
State (ConwayBBODY era) =
ShelleyBbodyState era
type
Signal (ConwayBBODY era) =
Block (BHeaderView (EraCrypto era)) era
type Environment (ConwayBBODY era) = BbodyEnv era
type BaseM (ConwayBBODY era) = ShelleyBase
type PredicateFailure (ConwayBBODY era) = ConwayBbodyPredFailure era
type Event (ConwayBBODY era) = AlonzoBbodyEvent era
initialRules :: [InitialRule (ConwayBBODY era)]
initialRules = []
transitionRules :: [TransitionRule (ConwayBBODY era)]
transitionRules = [forall era.
(Signal (EraRule "BBODY" era)
~ Block (BHeaderView (EraCrypto era)) era,
State (EraRule "BBODY" era) ~ ShelleyBbodyState era,
State (EraRule "LEDGERS" era) ~ LedgerState era,
TxSeq era ~ AlonzoTxSeq era, Tx era ~ AlonzoTx era,
InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era,
InjectRuleFailure "BBODY" ConwayBbodyPredFailure era, EraTx era,
BabbageEraTxBody era) =>
TransitionRule (EraRule "BBODY" era)
conwayBbodyTransition @era forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall era.
(STS (EraRule "BBODY" era),
Signal (EraRule "BBODY" era)
~ Block (BHeaderView (EraCrypto era)) era,
InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era,
BaseM (EraRule "BBODY" era) ~ ShelleyBase,
State (EraRule "BBODY" era) ~ ShelleyBbodyState era,
Environment (EraRule "BBODY" era) ~ BbodyEnv era,
Embed (EraRule "LEDGERS" era) (EraRule "BBODY" era),
Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era,
State (EraRule "LEDGERS" era) ~ LedgerState era,
Signal (EraRule "LEDGERS" era) ~ Seq (Tx era), EraSegWits era,
AlonzoEraTxWits era, TxSeq era ~ AlonzoTxSeq era,
Tx era ~ AlonzoTx era, AlonzoEraPParams era) =>
TransitionRule (EraRule "BBODY" era)
alonzoBbodyTransition @era]
conwayBbodyTransition ::
forall era.
( Signal (EraRule "BBODY" era) ~ Block (BHeaderView (EraCrypto era)) era
, State (EraRule "BBODY" era) ~ ShelleyBbodyState era
, State (EraRule "LEDGERS" era) ~ LedgerState era
, Era.TxSeq era ~ AlonzoTxSeq era
, Tx era ~ AlonzoTx era
, InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era
, InjectRuleFailure "BBODY" ConwayBbodyPredFailure era
, EraTx era
, BabbageEraTxBody era
) =>
TransitionRule (EraRule "BBODY" era)
conwayBbodyTransition :: forall era.
(Signal (EraRule "BBODY" era)
~ Block (BHeaderView (EraCrypto era)) era,
State (EraRule "BBODY" era) ~ ShelleyBbodyState era,
State (EraRule "LEDGERS" era) ~ LedgerState era,
TxSeq era ~ AlonzoTxSeq era, Tx era ~ AlonzoTx era,
InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era,
InjectRuleFailure "BBODY" ConwayBbodyPredFailure era, EraTx era,
BabbageEraTxBody era) =>
TransitionRule (EraRule "BBODY" era)
conwayBbodyTransition = do
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \( TRC
( Environment (EraRule "BBODY" era)
_
, state :: State (EraRule "BBODY" era)
state@(BbodyState State (EraRule "LEDGERS" era)
ls BlocksMade (EraCrypto era)
_)
, UnserialisedBlock BHeaderView (EraCrypto era)
_ TxSeq era
txsSeq
)
) -> do
let utxo :: UTxO era
utxo = forall era. UTxOState era -> UTxO era
utxosUtxo (forall era. LedgerState era -> UTxOState era
lsUTxOState State (EraRule "LEDGERS" era)
ls)
txs :: StrictSeq (Tx era)
txs = forall era. AlonzoTxSeq era -> StrictSeq (Tx era)
txSeqTxns TxSeq era
txsSeq
totalRefScriptSize :: Int
totalRefScriptSize =
forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (forall a. a -> Sum a
Monoid.Sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo) StrictSeq (Tx era)
txs
Int
totalRefScriptSize
forall a. Ord a => a -> a -> Bool
<= Int
maxRefScriptSizePerBlock
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
(forall era. Int -> Int -> ConwayBbodyPredFailure era
BodyRefScriptsSizeTooBig Int
totalRefScriptSize Int
maxRefScriptSizePerBlock)
forall (f :: * -> *) a. Applicative f => a -> f a
pure State (EraRule "BBODY" era)
state
instance
( Era era
, BaseM ledgers ~ ShelleyBase
, ledgers ~ EraRule "LEDGERS" era
, STS ledgers
, DSignable (EraCrypto era) (Hash (EraCrypto era) EraIndependentTxBody)
, Era era
) =>
Embed ledgers (ConwayBBODY era)
where
wrapFailed :: PredicateFailure ledgers -> PredicateFailure (ConwayBBODY era)
wrapFailed = forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> ConwayBbodyPredFailure era
LedgersFailure
wrapEvent :: Event ledgers -> Event (ConwayBBODY era)
wrapEvent = forall era. ShelleyBbodyEvent era -> AlonzoBbodyEvent era
ShelleyInAlonzoEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Event (EraRule "LEDGERS" era) -> ShelleyBbodyEvent era
LedgersEvent