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

-- | 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
      -- | Actual Body Size
      !Int
      -- | Claimed Body Size in Header
      !Int
  | InvalidBodyHashBBODY
      -- | Actual Hash
      !(Hash (EraCrypto era) EraIndependentBlockBody)
      -- | Claimed Hash
      !(Hash (EraCrypto era) EraIndependentBlockBody)
  | -- | LEDGERS rule subtransition Failures
    LedgersFailure !(PredicateFailure (EraRule "LEDGERS" era))
  | TooManyExUnits
      -- | Computed Sum of ExUnits for all plutus scripts
      !ExUnits
      -- | Maximum allowed by protocal parameters
      !ExUnits
  | BodyRefScriptsSizeTooBig
      -- | Computed sum of reference script size
      Int
      -- | Maximum allowed total reference script size
      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