{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.Mempool (
  ConwayMEMPOOL,
  ConwayMempoolEvent (..),
  ConwayMempoolPredFailure (..),
) where

import Cardano.Ledger.BaseTypes (ShelleyBase)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), FromCBOR, ToCBOR)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra, ConwayMEMPOOL)
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules (LedgerEnv (..))
import Control.DeepSeq (NFData)
import Control.State.Transition (
  BaseM,
  Environment,
  Event,
  PredicateFailure,
  STS (..),
  Signal,
  State,
  TRC (TRC),
  TransitionRule,
  judgmentContext,
  tellEvent,
  transitionRules,
 )
import Data.Text (Text, pack)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)

newtype ConwayMempoolPredFailure era = ConwayMempoolPredFailure Text
  deriving (ConwayMempoolPredFailure era
-> ConwayMempoolPredFailure era -> Bool
forall era.
ConwayMempoolPredFailure era
-> ConwayMempoolPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayMempoolPredFailure era
-> ConwayMempoolPredFailure era -> Bool
$c/= :: forall era.
ConwayMempoolPredFailure era
-> ConwayMempoolPredFailure era -> Bool
== :: ConwayMempoolPredFailure era
-> ConwayMempoolPredFailure era -> Bool
$c== :: forall era.
ConwayMempoolPredFailure era
-> ConwayMempoolPredFailure era -> Bool
Eq, Int -> ConwayMempoolPredFailure era -> ShowS
forall era. Int -> ConwayMempoolPredFailure era -> ShowS
forall era. [ConwayMempoolPredFailure era] -> ShowS
forall era. ConwayMempoolPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayMempoolPredFailure era] -> ShowS
$cshowList :: forall era. [ConwayMempoolPredFailure era] -> ShowS
show :: ConwayMempoolPredFailure era -> String
$cshow :: forall era. ConwayMempoolPredFailure era -> String
showsPrec :: Int -> ConwayMempoolPredFailure era -> ShowS
$cshowsPrec :: forall era. Int -> ConwayMempoolPredFailure era -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayMempoolPredFailure era) x
-> ConwayMempoolPredFailure era
forall era x.
ConwayMempoolPredFailure era
-> Rep (ConwayMempoolPredFailure era) x
$cto :: forall era x.
Rep (ConwayMempoolPredFailure era) x
-> ConwayMempoolPredFailure era
$cfrom :: forall era x.
ConwayMempoolPredFailure era
-> Rep (ConwayMempoolPredFailure era) x
Generic)
  deriving newtype (Context -> ConwayMempoolPredFailure era -> IO (Maybe ThunkInfo)
Proxy (ConwayMempoolPredFailure era) -> String
forall era.
Context -> ConwayMempoolPredFailure era -> IO (Maybe ThunkInfo)
forall era. Proxy (ConwayMempoolPredFailure era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ConwayMempoolPredFailure era) -> String
$cshowTypeOf :: forall era. Proxy (ConwayMempoolPredFailure era) -> String
wNoThunks :: Context -> ConwayMempoolPredFailure era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context -> ConwayMempoolPredFailure era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ConwayMempoolPredFailure era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context -> ConwayMempoolPredFailure era -> IO (Maybe ThunkInfo)
NoThunks, ConwayMempoolPredFailure era -> ()
forall era. ConwayMempoolPredFailure era -> ()
forall a. (a -> ()) -> NFData a
rnf :: ConwayMempoolPredFailure era -> ()
$crnf :: forall era. ConwayMempoolPredFailure era -> ()
NFData, ConwayMempoolPredFailure era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
forall {era}.
Typeable era =>
Typeable (ConwayMempoolPredFailure era)
forall era.
Typeable era =>
ConwayMempoolPredFailure era -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
toCBOR :: ConwayMempoolPredFailure era -> Encoding
$ctoCBOR :: forall era.
Typeable era =>
ConwayMempoolPredFailure era -> Encoding
ToCBOR, Proxy (ConwayMempoolPredFailure era) -> Text
forall s. Decoder s (ConwayMempoolPredFailure era)
forall {era}.
Typeable era =>
Typeable (ConwayMempoolPredFailure era)
forall era.
Typeable era =>
Proxy (ConwayMempoolPredFailure era) -> Text
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall era s.
Typeable era =>
Decoder s (ConwayMempoolPredFailure era)
label :: Proxy (ConwayMempoolPredFailure era) -> Text
$clabel :: forall era.
Typeable era =>
Proxy (ConwayMempoolPredFailure era) -> Text
fromCBOR :: forall s. Decoder s (ConwayMempoolPredFailure era)
$cfromCBOR :: forall era s.
Typeable era =>
Decoder s (ConwayMempoolPredFailure era)
FromCBOR, ConwayMempoolPredFailure era -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
forall {era}.
Typeable era =>
Typeable (ConwayMempoolPredFailure era)
forall era.
Typeable era =>
ConwayMempoolPredFailure era -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayMempoolPredFailure era] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayMempoolPredFailure era) -> Size
encCBOR :: ConwayMempoolPredFailure era -> Encoding
$cencCBOR :: forall era.
Typeable era =>
ConwayMempoolPredFailure era -> Encoding
EncCBOR, Proxy (ConwayMempoolPredFailure era) -> Text
forall s. Decoder s (ConwayMempoolPredFailure era)
forall {era}.
Typeable era =>
Typeable (ConwayMempoolPredFailure era)
forall era.
Typeable era =>
Proxy (ConwayMempoolPredFailure era) -> Text
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall era s.
Typeable era =>
Decoder s (ConwayMempoolPredFailure era)
forall era s.
Typeable era =>
Proxy (ConwayMempoolPredFailure era) -> Decoder s ()
forall s. Proxy (ConwayMempoolPredFailure era) -> Decoder s ()
label :: Proxy (ConwayMempoolPredFailure era) -> Text
$clabel :: forall era.
Typeable era =>
Proxy (ConwayMempoolPredFailure era) -> Text
dropCBOR :: forall s. Proxy (ConwayMempoolPredFailure era) -> Decoder s ()
$cdropCBOR :: forall era s.
Typeable era =>
Proxy (ConwayMempoolPredFailure era) -> Decoder s ()
decCBOR :: forall s. Decoder s (ConwayMempoolPredFailure era)
$cdecCBOR :: forall era s.
Typeable era =>
Decoder s (ConwayMempoolPredFailure era)
DecCBOR)

type instance EraRuleFailure "MEMPOOL" ConwayEra = ConwayMempoolPredFailure ConwayEra
instance InjectRuleFailure "MEMPOOL" ConwayMempoolPredFailure ConwayEra

newtype ConwayMempoolEvent era = ConwayMempoolEvent Text
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayMempoolEvent era) x -> ConwayMempoolEvent era
forall era x.
ConwayMempoolEvent era -> Rep (ConwayMempoolEvent era) x
$cto :: forall era x.
Rep (ConwayMempoolEvent era) x -> ConwayMempoolEvent era
$cfrom :: forall era x.
ConwayMempoolEvent era -> Rep (ConwayMempoolEvent era) x
Generic, ConwayMempoolEvent era -> ConwayMempoolEvent era -> Bool
forall era.
ConwayMempoolEvent era -> ConwayMempoolEvent era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayMempoolEvent era -> ConwayMempoolEvent era -> Bool
$c/= :: forall era.
ConwayMempoolEvent era -> ConwayMempoolEvent era -> Bool
== :: ConwayMempoolEvent era -> ConwayMempoolEvent era -> Bool
$c== :: forall era.
ConwayMempoolEvent era -> ConwayMempoolEvent era -> Bool
Eq)
  deriving newtype (ConwayMempoolEvent era -> ()
forall era. ConwayMempoolEvent era -> ()
forall a. (a -> ()) -> NFData a
rnf :: ConwayMempoolEvent era -> ()
$crnf :: forall era. ConwayMempoolEvent era -> ()
NFData)

type instance EraRuleEvent "MEMPOOL" ConwayEra = ConwayMempoolEvent ConwayEra

instance
  (EraTx era, EraGov era) =>
  STS (ConwayMEMPOOL era)
  where
  type State (ConwayMEMPOOL era) = LedgerState era
  type Signal (ConwayMEMPOOL era) = Tx era
  type Environment (ConwayMEMPOOL era) = LedgerEnv era
  type BaseM (ConwayMEMPOOL era) = ShelleyBase
  type PredicateFailure (ConwayMEMPOOL era) = ConwayMempoolPredFailure era
  type Event (ConwayMEMPOOL era) = ConwayMempoolEvent era

  transitionRules :: [TransitionRule (ConwayMEMPOOL era)]
transitionRules = [forall era. EraTx era => TransitionRule (ConwayMEMPOOL era)
mempoolTransition @era]

mempoolTransition :: EraTx era => TransitionRule (ConwayMEMPOOL era)
mempoolTransition :: forall era. EraTx era => TransitionRule (ConwayMEMPOOL era)
mempoolTransition = do
  TRC (Environment (ConwayMEMPOOL era)
_ledgerEnv, State (ConwayMEMPOOL era)
ledgerState, Signal (ConwayMEMPOOL era)
tx) <-
    forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  -- This rule only gets invoked on transactions within the mempool.
  -- Add checks here that sanitize undesired transactions.
  forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Text -> ConwayMempoolEvent era
ConwayMempoolEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Mempool rule for tx " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTx era => Tx era -> TxId
txIdTx forall a b. (a -> b) -> a -> b
$ Signal (ConwayMEMPOOL era)
tx
  forall (f :: * -> *) a. Applicative f => a -> f a
pure State (ConwayMEMPOOL era)
ledgerState