{-# 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.Conway (
  ConwayEra,
  hardforkConwayBootstrapPhase,
  hardforkConwayDisallowUnelectedCommitteeFromVoting,
  hardforkConwayDELEGIncorrectDepositsAndRefunds,
  hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule,
  Tx (..),
  ApplyTxError (..),
) where

import Cardano.Ledger.Alonzo (mkAlonzoStAnnTx)
import Cardano.Ledger.Babbage.TxBody ()
import Cardano.Ledger.BaseTypes (Inject (..))
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Block (EraBlockHeader)
import Cardano.Ledger.Conway.BlockBody ()
import Cardano.Ledger.Conway.Era (
  ConwayEra,
  hardforkConwayBootstrapPhase,
  hardforkConwayDELEGIncorrectDepositsAndRefunds,
  hardforkConwayDisallowUnelectedCommitteeFromVoting,
  hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule,
 )
import Cardano.Ledger.Conway.Forecast ()
import Cardano.Ledger.Conway.Governance (RunConwayRatify (..))
import Cardano.Ledger.Conway.Rules (ConwayLedgerPredFailure)
import Cardano.Ledger.Conway.State ()
import Cardano.Ledger.Conway.Transition ()
import Cardano.Ledger.Conway.Translation ()
import Cardano.Ledger.Conway.Tx (Tx (..))
import Cardano.Ledger.Conway.TxInfo ()
import Cardano.Ledger.Conway.TxOut ()
import Cardano.Ledger.Conway.UTxO ()
import Cardano.Ledger.Shelley.API
import Data.Bifunctor (Bifunctor (first))
import Data.List.NonEmpty (NonEmpty)
import GHC.Generics (Generic)

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

  mkStAnnTx :: EpochInfo (Either Text)
-> SystemStart
-> PParams ConwayEra
-> UTxO ConwayEra
-> Tx TopTx ConwayEra
-> StAnnTx TopTx ConwayEra
mkStAnnTx = EpochInfo (Either Text)
-> SystemStart
-> PParams ConwayEra
-> UTxO ConwayEra
-> Tx TopTx ConwayEra
-> StAnnTx TopTx ConwayEra
EpochInfo (Either Text)
-> SystemStart
-> PParams ConwayEra
-> UTxO ConwayEra
-> Tx TopTx ConwayEra
-> AlonzoStAnnTx TopTx ConwayEra
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

  applyTxValidation :: ValidationPolicy
-> Globals
-> MempoolEnv ConwayEra
-> MempoolState ConwayEra
-> StAnnTx TopTx ConwayEra
-> Either
     (ApplyTxError ConwayEra)
     (MempoolState ConwayEra, Validated (Tx TopTx ConwayEra))
applyTxValidation ValidationPolicy
validationPolicy Globals
globals MempoolEnv ConwayEra
env MempoolState ConwayEra
state StAnnTx TopTx ConwayEra
stAnnTx =
    (NonEmpty (ConwayLedgerPredFailure ConwayEra)
 -> ApplyTxError ConwayEra)
-> Either
     (NonEmpty (ConwayLedgerPredFailure ConwayEra))
     (MempoolState ConwayEra, Validated (Tx TopTx ConwayEra))
-> Either
     (ApplyTxError ConwayEra)
     (MempoolState ConwayEra, Validated (Tx TopTx ConwayEra))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first NonEmpty (ConwayLedgerPredFailure ConwayEra)
-> ApplyTxError ConwayEra
ConwayApplyTxError (Either
   (NonEmpty (ConwayLedgerPredFailure ConwayEra))
   (MempoolState ConwayEra, Validated (Tx TopTx ConwayEra))
 -> Either
      (ApplyTxError ConwayEra)
      (MempoolState ConwayEra, Validated (Tx TopTx ConwayEra)))
-> Either
     (NonEmpty (ConwayLedgerPredFailure ConwayEra))
     (MempoolState ConwayEra, Validated (Tx TopTx ConwayEra))
-> Either
     (ApplyTxError ConwayEra)
     (MempoolState ConwayEra, Validated (Tx TopTx ConwayEra))
forall a b. (a -> b) -> a -> b
$
      forall (rule :: Symbol) era.
(EraTx 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) =>
ValidationPolicy
-> Globals
-> LedgerEnv era
-> MempoolState era
-> StAnnTx TopTx era
-> Either
     (NonEmpty (PredicateFailure (EraRule rule era)))
     (MempoolState era, Validated (Tx TopTx era))
ruleApplyTxValidation @"MEMPOOL" ValidationPolicy
validationPolicy Globals
globals MempoolEnv ConwayEra
env MempoolState ConwayEra
state StAnnTx TopTx ConwayEra
stAnnTx

instance ApplyTick ConwayEra

instance EraBlockHeader h ConwayEra => ApplyBlock h ConwayEra

instance RunConwayRatify ConwayEra

instance Inject (NonEmpty (ConwayLedgerPredFailure ConwayEra)) (ApplyTxError ConwayEra) where
  inject :: NonEmpty (ConwayLedgerPredFailure ConwayEra)
-> ApplyTxError ConwayEra
inject = NonEmpty (ConwayLedgerPredFailure ConwayEra)
-> ApplyTxError ConwayEra
ConwayApplyTxError