{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage (
  BabbageEra,
  BabbageTxOut,
  TxBody (BabbageTxBody),
  Tx (..),
  ApplyTxError (..),
  AlonzoScript,
  AlonzoTxAuxData,

  -- * Forecast
  BabbageForecast (..),
  mkBabbageForecast,
  bfPoolDistrL,
  bfMaxBlockHeaderSizeL,
  bfMaxBlockBodySizeL,
  bfProtocolVersionL,
) where

import Cardano.Ledger.Alonzo (mkAlonzoStAnnTx)
import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..))
import Cardano.Ledger.Babbage.BlockBody ()
import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.Forecast (
  BabbageForecast (..),
  bfMaxBlockBodySizeL,
  bfMaxBlockHeaderSizeL,
  bfPoolDistrL,
  bfProtocolVersionL,
  mkBabbageForecast,
 )
import Cardano.Ledger.Babbage.Rules ()
import Cardano.Ledger.Babbage.State ()
import Cardano.Ledger.Babbage.Transition ()
import Cardano.Ledger.Babbage.Translation ()
import Cardano.Ledger.Babbage.Tx (Tx (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut, TxBody (BabbageTxBody))
import Cardano.Ledger.Babbage.TxInfo ()
import Cardano.Ledger.Babbage.UTxO ()
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Block (EraBlockHeader)
import Cardano.Ledger.Shelley.API
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Data.List.NonEmpty (NonEmpty)
import GHC.Generics (Generic)

instance ApplyTx BabbageEra where
  newtype ApplyTxError BabbageEra
    = BabbageApplyTxError (NonEmpty (Shelley.ShelleyLedgerPredFailure BabbageEra))
    deriving (ApplyTxError BabbageEra -> ApplyTxError BabbageEra -> Bool
(ApplyTxError BabbageEra -> ApplyTxError BabbageEra -> Bool)
-> (ApplyTxError BabbageEra -> ApplyTxError BabbageEra -> Bool)
-> Eq (ApplyTxError BabbageEra)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplyTxError BabbageEra -> ApplyTxError BabbageEra -> Bool
== :: ApplyTxError BabbageEra -> ApplyTxError BabbageEra -> Bool
$c/= :: ApplyTxError BabbageEra -> ApplyTxError BabbageEra -> Bool
/= :: ApplyTxError BabbageEra -> ApplyTxError BabbageEra -> Bool
Eq, Int -> ApplyTxError BabbageEra -> ShowS
[ApplyTxError BabbageEra] -> ShowS
ApplyTxError BabbageEra -> String
(Int -> ApplyTxError BabbageEra -> ShowS)
-> (ApplyTxError BabbageEra -> String)
-> ([ApplyTxError BabbageEra] -> ShowS)
-> Show (ApplyTxError BabbageEra)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplyTxError BabbageEra -> ShowS
showsPrec :: Int -> ApplyTxError BabbageEra -> ShowS
$cshow :: ApplyTxError BabbageEra -> String
show :: ApplyTxError BabbageEra -> String
$cshowList :: [ApplyTxError BabbageEra] -> ShowS
showList :: [ApplyTxError BabbageEra] -> ShowS
Show)
    deriving newtype (ApplyTxError BabbageEra -> Encoding
(ApplyTxError BabbageEra -> Encoding)
-> EncCBOR (ApplyTxError BabbageEra)
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: ApplyTxError BabbageEra -> Encoding
encCBOR :: ApplyTxError BabbageEra -> Encoding
EncCBOR, Typeable (ApplyTxError BabbageEra)
Typeable (ApplyTxError BabbageEra) =>
(forall s. Decoder s (ApplyTxError BabbageEra))
-> (forall s. Proxy (ApplyTxError BabbageEra) -> Decoder s ())
-> (Proxy (ApplyTxError BabbageEra) -> Text)
-> DecCBOR (ApplyTxError BabbageEra)
Proxy (ApplyTxError BabbageEra) -> Text
forall s. Decoder s (ApplyTxError BabbageEra)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (ApplyTxError BabbageEra) -> Decoder s ()
$cdecCBOR :: forall s. Decoder s (ApplyTxError BabbageEra)
decCBOR :: forall s. Decoder s (ApplyTxError BabbageEra)
$cdropCBOR :: forall s. Proxy (ApplyTxError BabbageEra) -> Decoder s ()
dropCBOR :: forall s. Proxy (ApplyTxError BabbageEra) -> Decoder s ()
$clabel :: Proxy (ApplyTxError BabbageEra) -> Text
label :: Proxy (ApplyTxError BabbageEra) -> Text
DecCBOR, NonEmpty (ApplyTxError BabbageEra) -> ApplyTxError BabbageEra
ApplyTxError BabbageEra
-> ApplyTxError BabbageEra -> ApplyTxError BabbageEra
(ApplyTxError BabbageEra
 -> ApplyTxError BabbageEra -> ApplyTxError BabbageEra)
-> (NonEmpty (ApplyTxError BabbageEra) -> ApplyTxError BabbageEra)
-> (forall b.
    Integral b =>
    b -> ApplyTxError BabbageEra -> ApplyTxError BabbageEra)
-> Semigroup (ApplyTxError BabbageEra)
forall b.
Integral b =>
b -> ApplyTxError BabbageEra -> ApplyTxError BabbageEra
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ApplyTxError BabbageEra
-> ApplyTxError BabbageEra -> ApplyTxError BabbageEra
<> :: ApplyTxError BabbageEra
-> ApplyTxError BabbageEra -> ApplyTxError BabbageEra
$csconcat :: NonEmpty (ApplyTxError BabbageEra) -> ApplyTxError BabbageEra
sconcat :: NonEmpty (ApplyTxError BabbageEra) -> ApplyTxError BabbageEra
$cstimes :: forall b.
Integral b =>
b -> ApplyTxError BabbageEra -> ApplyTxError BabbageEra
stimes :: forall b.
Integral b =>
b -> ApplyTxError BabbageEra -> ApplyTxError BabbageEra
Semigroup, (forall x.
 ApplyTxError BabbageEra -> Rep (ApplyTxError BabbageEra) x)
-> (forall x.
    Rep (ApplyTxError BabbageEra) x -> ApplyTxError BabbageEra)
-> Generic (ApplyTxError BabbageEra)
forall x.
Rep (ApplyTxError BabbageEra) x -> ApplyTxError BabbageEra
forall x.
ApplyTxError BabbageEra -> Rep (ApplyTxError BabbageEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ApplyTxError BabbageEra -> Rep (ApplyTxError BabbageEra) x
from :: forall x.
ApplyTxError BabbageEra -> Rep (ApplyTxError BabbageEra) x
$cto :: forall x.
Rep (ApplyTxError BabbageEra) x -> ApplyTxError BabbageEra
to :: forall x.
Rep (ApplyTxError BabbageEra) x -> ApplyTxError BabbageEra
Generic)

  mkStAnnTx :: EpochInfo (Either Text)
-> SystemStart
-> PParams BabbageEra
-> UTxO BabbageEra
-> Tx TopTx BabbageEra
-> StAnnTx TopTx BabbageEra
mkStAnnTx = EpochInfo (Either Text)
-> SystemStart
-> PParams BabbageEra
-> UTxO BabbageEra
-> Tx TopTx BabbageEra
-> StAnnTx TopTx BabbageEra
EpochInfo (Either Text)
-> SystemStart
-> PParams BabbageEra
-> UTxO BabbageEra
-> Tx TopTx BabbageEra
-> AlonzoStAnnTx TopTx BabbageEra
forall era.
(AlonzoEraUTxO era, AlonzoEraTx era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> UTxO era
-> Tx TopTx era
-> AlonzoStAnnTx TopTx era
mkAlonzoStAnnTx

  internalApplyTxWithValidation :: ValidationPolicy
-> Globals
-> MempoolEnv BabbageEra
-> MempoolState BabbageEra
-> Tx TopTx BabbageEra
-> Either
     (ApplyTxError BabbageEra)
     (MempoolState BabbageEra, ValidatedTx BabbageEra)
internalApplyTxWithValidation = forall (rule :: Symbol) era.
(ApplyTx era, STS (EraRule rule era),
 BaseM (EraRule rule era) ~ ShelleyBase,
 Environment (EraRule rule era) ~ LedgerEnv era,
 State (EraRule rule era) ~ MempoolState era,
 Signal (EraRule rule era) ~ StAnnTx TopTx era) =>
(NonEmpty (PredicateFailure (EraRule rule era))
 -> ApplyTxError era)
-> ValidationPolicy
-> Globals
-> LedgerEnv era
-> MempoolState era
-> Tx TopTx era
-> Either (ApplyTxError era) (MempoolState era, ValidatedTx era)
defaultApplyTxWithValidation @"LEDGER" NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra))
-> ApplyTxError BabbageEra
NonEmpty (ShelleyLedgerPredFailure BabbageEra)
-> ApplyTxError BabbageEra
BabbageApplyTxError

  internalReapplyValidatedTx :: Globals
-> MempoolEnv BabbageEra
-> MempoolState BabbageEra
-> ValidatedTx BabbageEra
-> Either (ApplyTxError BabbageEra) (MempoolState BabbageEra)
internalReapplyValidatedTx = forall (rule :: Symbol) era.
(ApplyTx era, STS (EraRule rule era),
 BaseM (EraRule rule era) ~ ShelleyBase,
 Environment (EraRule rule era) ~ LedgerEnv era,
 State (EraRule rule era) ~ MempoolState era,
 Signal (EraRule rule era) ~ StAnnTx TopTx era) =>
(NonEmpty (PredicateFailure (EraRule rule era))
 -> ApplyTxError era)
-> Globals
-> LedgerEnv era
-> MempoolState era
-> ValidatedTx era
-> Either (ApplyTxError era) (MempoolState era)
defaultReapplyValidatedTx @"LEDGER" NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra))
-> ApplyTxError BabbageEra
NonEmpty (ShelleyLedgerPredFailure BabbageEra)
-> ApplyTxError BabbageEra
BabbageApplyTxError

instance ApplyTick BabbageEra

instance EraBlockHeader h BabbageEra => ApplyBlock h BabbageEra