{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- HasTrace instances for AlonzoLEDGE
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Export HasTrace instance for AlonzoLEDGE Alonzo Era.
module Test.Cardano.Ledger.Alonzo.Trace () where

import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Rules (AlonzoLEDGER)
import Cardano.Ledger.BaseTypes (Globals, epochInfo, systemStart)
import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..))
import Cardano.Ledger.Shelley.LedgerState (UTxOState, lsUTxOState, utxosUtxo)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.Shelley.State
import Cardano.Protocol.Crypto (Crypto)
import Cardano.Slotting.Slot (SlotNo (..))
import Control.Monad.Trans.Reader (runReaderT)
import Control.State.Transition
import Data.Functor.Identity (runIdentity)
import Data.Sequence (Seq)
import Test.Cardano.Ledger.Alonzo.AlonzoEraGen ()
import Test.Cardano.Ledger.Shelley.Generator.Core (GenEnv (..))
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen (..), MinLEDGER_STS)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Generator.Trace.Ledger (genAccountState)
import Test.Cardano.Ledger.Shelley.Generator.Trace.TxCert (CERTS)
import Test.Cardano.Ledger.Shelley.Generator.Utxo (genTx)
import Test.Cardano.Ledger.Shelley.Utils (testGlobals)
import qualified Test.Control.State.Transition.Trace.Generator.QuickCheck as TQC

-- The AlonzoLEDGER STS combines utxo and delegation rules and allows for generating transactions
-- with meaningful delegation certificates.
instance
  ( ApplyTx era
  , EraGen era
  , EraGov era
  , EraUTxO era
  , AlonzoEraTx era
  , ShelleyEraAccounts era
  , MinLEDGER_STS era
  , Embed (EraRule "DELPL" era) (CERTS era)
  , Environment (EraRule "DELPL" era) ~ Shelley.DelplEnv era
  , State (EraRule "DELPL" era) ~ CertState era
  , Signal (EraRule "DELPL" era) ~ TxCert era
  , PredicateFailure (EraRule "DELPL" era) ~ Shelley.ShelleyDelplPredFailure era
  , Embed (EraRule "DELEGS" era) (AlonzoLEDGER era)
  , Embed (EraRule "UTXOW" era) (AlonzoLEDGER era)
  , Environment (EraRule "UTXOW" era) ~ Shelley.UtxoEnv era
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era
  , Environment (EraRule "DELEGS" era) ~ Shelley.DelegsEnv era
  , State (EraRule "DELEGS" era) ~ CertState era
  , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era)
  , AtMostEra "Babbage" era
  , EraCertState era
  , Crypto c
  , EraRuleFailure "LEDGER" era ~ Shelley.ShelleyLedgerPredFailure era
  , EraRule "LEDGER" era ~ AlonzoLEDGER era
  ) =>
  TQC.HasTrace (AlonzoLEDGER era) (GenEnv c era)
  where
  envGen :: HasCallStack =>
GenEnv c era -> Gen (Environment (AlonzoLEDGER era))
envGen GenEnv {Constants
geConstants :: Constants
geConstants :: forall c era. GenEnv c era -> Constants
geConstants} =
    SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
forall era.
SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> ChainAccountState
-> LedgerEnv era
Shelley.LedgerEnv (Word64 -> SlotNo
SlotNo Word64
0) Maybe EpochNo
forall a. Maybe a
Nothing TxIx
forall a. Bounded a => a
minBound
      (PParams era -> ChainAccountState -> LedgerEnv era)
-> Gen (PParams era) -> Gen (ChainAccountState -> LedgerEnv era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. EraGen era => Constants -> Gen (PParams era)
genEraPParams @era Constants
geConstants
      Gen (ChainAccountState -> LedgerEnv era)
-> Gen ChainAccountState -> Gen (LedgerEnv era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Constants -> Gen ChainAccountState
genAccountState Constants
geConstants

  sigGen :: HasCallStack =>
GenEnv c era
-> Environment (AlonzoLEDGER era)
-> State (AlonzoLEDGER era)
-> Gen (Signal (AlonzoLEDGER era))
sigGen GenEnv c era
ge ledgerEnv :: Environment (AlonzoLEDGER era)
ledgerEnv@(Shelley.LedgerEnv SlotNo
_ Maybe EpochNo
_ TxIx
_ PParams era
pParams ChainAccountState
_) State (AlonzoLEDGER era)
ls = do
    tx <- GenEnv c era
-> LedgerEnv era -> LedgerState era -> Gen (Tx TopTx era)
forall era c.
(EraGen era, EraUTxO era, ShelleyEraAccounts era,
 Embed (EraRule "DELPL" era) (CERTS era),
 Environment (EraRule "DELPL" era) ~ DelplEnv era,
 State (EraRule "DELPL" era) ~ CertState era,
 Signal (EraRule "DELPL" era) ~ TxCert era, Crypto c) =>
GenEnv c era
-> LedgerEnv era -> LedgerState era -> Gen (Tx TopTx era)
genTx GenEnv c era
ge LedgerEnv era
Environment (AlonzoLEDGER era)
ledgerEnv State (AlonzoLEDGER era)
LedgerState era
ls
    pure $
      mkStAnnTx
        (epochInfo testGlobals)
        (systemStart testGlobals)
        pParams
        (utxosUtxo (lsUTxOState ls))
        tx

  shrinkSignal :: HasCallStack =>
Signal (AlonzoLEDGER era) -> [Signal (AlonzoLEDGER era)]
shrinkSignal Signal (AlonzoLEDGER era)
_ = [] -- TODO add some kind of Shrinker?

  type BaseEnv (AlonzoLEDGER era) = Globals
  interpretSTS :: forall a.
HasCallStack =>
BaseEnv (AlonzoLEDGER era) -> BaseM (AlonzoLEDGER era) a -> a
interpretSTS BaseEnv (AlonzoLEDGER era)
globals BaseM (AlonzoLEDGER era) a
act = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ ReaderT Globals Identity a -> Globals -> Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Globals Identity a
BaseM (AlonzoLEDGER era) a
act Globals
BaseEnv (AlonzoLEDGER era)
globals