{-# 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 (..), Relation (..), 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 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 (..))

-- | In the next era this will become a proper protocol parameter.
-- For now this is a hard coded limit on the total number of bytes of all reference scripts
-- combined from all transactions within a block.
maxRefScriptSizePerBlock :: Int
maxRefScriptSizePerBlock :: Int
maxRefScriptSizePerBlock = Int
1024 forall a. Num a => a -> a -> a
* Int
1024 -- 1MiB

data ConwayBbodyPredFailure era
  = WrongBlockBodySizeBBODY !(Mismatch 'RelEQ Int)
  | InvalidBodyHashBBODY !(Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody))
  | -- | LEDGERS rule subtransition Failures
    LedgersFailure !(PredicateFailure (EraRule "LEDGERS" era))
  | TooManyExUnits !(Mismatch 'RelLTEQ ExUnits)
  | BodyRefScriptsSizeTooBig !(Mismatch 'RelLTEQ 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 Mismatch 'RelEQ Int
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Mismatch 'RelEQ 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. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ Int
mm
      InvalidBodyHashBBODY Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
mm -> forall t. t -> Word -> Encode 'Open t
Sum (forall era.
Mismatch 'RelEQ (Hash HASH 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. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
mm
      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 Mismatch 'RelLTEQ ExUnits
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Mismatch 'RelLTEQ 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. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelLTEQ ExUnits
mm
      BodyRefScriptsSizeTooBig Mismatch 'RelLTEQ Int
mm -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Mismatch 'RelLTEQ 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. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelLTEQ Int
mm

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. Mismatch 'RelEQ 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).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
1 -> forall t. t -> Decode 'Open t
SumD forall era.
Mismatch 'RelEQ (Hash HASH 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).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    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. Mismatch 'RelLTEQ 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).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
4 -> forall t. t -> Decode 'Open t
SumD forall era. Mismatch 'RelLTEQ 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).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

type instance EraRuleFailure "BBODY" ConwayEra = ConwayBbodyPredFailure ConwayEra

type instance EraRuleEvent "BBODY" ConwayEra = AlonzoBbodyEvent ConwayEra

instance InjectRuleFailure "BBODY" ConwayBbodyPredFailure ConwayEra

instance InjectRuleFailure "BBODY" AlonzoBbodyPredFailure ConwayEra where
  injectFailure :: AlonzoBbodyPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
injectFailure = forall era.
AlonzoBbodyPredFailure era -> ConwayBbodyPredFailure era
alonzoToConwayBbodyPredFailure

instance InjectRuleFailure "BBODY" ShelleyBbodyPredFailure ConwayEra where
  injectFailure :: ShelleyBbodyPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
injectFailure = forall era.
ShelleyBbodyPredFailure era -> ConwayBbodyPredFailure era
shelleyToConwayBbodyPredFailure

instance InjectRuleFailure "BBODY" ShelleyLedgersPredFailure ConwayEra where
  injectFailure :: ShelleyLedgersPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayLedgerPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayUtxowPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: BabbageUtxowPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: AlonzoUtxowPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ShelleyUtxowPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayUtxoPredFailure ConwayEra -> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: BabbageUtxoPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: AlonzoUtxoPredFailure ConwayEra -> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: AlonzoUtxosPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayUtxosPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ShelleyUtxoPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: AllegraUtxoPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayCertsPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayCertPredFailure ConwayEra -> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayDelegPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ShelleyPoolPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayGovCertPredFailure ConwayEra
-> EraRuleFailure "BBODY" ConwayEra
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 where
  injectFailure :: ConwayGovPredFailure ConwayEra -> EraRuleFailure "BBODY" ConwayEra
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 'RelEQ Int
m) =
    forall era. Mismatch 'RelEQ Int -> ConwayBbodyPredFailure era
WrongBlockBodySizeBBODY Mismatch 'RelEQ Int
m
shelleyToConwayBbodyPredFailure
  (Shelley.InvalidBodyHashBBODY Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
m) =
    forall era.
Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
-> ConwayBbodyPredFailure era
InvalidBodyHashBBODY Mismatch 'RelEQ (Hash HASH EraIndependentBlockBody)
m
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 Mismatch 'RelLTEQ ExUnits
m) = forall era. Mismatch 'RelLTEQ ExUnits -> ConwayBbodyPredFailure era
TooManyExUnits Mismatch 'RelLTEQ ExUnits
m

instance
  ( 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
  , TxSeq era ~ AlonzoTxSeq 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 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 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 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 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 :: forall era.
(Signal (EraRule "BBODY" era) ~ Block BHeaderView 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
_)
              , UnserialisedBlock BHeaderView
_ 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. Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era
BodyRefScriptsSizeTooBig forall a b. (a -> b) -> a -> b
$
                  Mismatch
                    { mismatchSupplied :: Int
mismatchSupplied = Int
totalRefScriptSize
                    , mismatchExpected :: Int
mismatchExpected = 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
  ) =>
  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