{-# 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.Alonzo.Tx (AlonzoTx)
import Cardano.Ledger.BaseTypes (Globals)
import Cardano.Ledger.Shelley.LedgerState (UTxOState)
import Cardano.Ledger.Shelley.Rules (
  DelegsEnv,
  DelplEnv,
  LedgerEnv (..),
  ShelleyDelplPredFailure,
  UtxoEnv,
 )
import Cardano.Ledger.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 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
  ( EraGen era
  , EraGov era
  , EraUTxO era
  , AlonzoEraTx era
  , MinLEDGER_STS 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
  , PredicateFailure (EraRule "DELPL" era) ~ ShelleyDelplPredFailure era
  , Embed (EraRule "DELEGS" era) (AlonzoLEDGER era)
  , Embed (EraRule "UTXOW" era) (AlonzoLEDGER era)
  , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
  , State (EraRule "UTXOW" era) ~ UTxOState era
  , Signal (EraRule "UTXOW" era) ~ Tx era
  , Environment (EraRule "DELEGS" era) ~ DelegsEnv era
  , State (EraRule "DELEGS" era) ~ CertState era
  , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era)
  , Tx era ~ AlonzoTx era
  , ProtVerAtMost era 8
  , EraCertState era
  , Crypto c
  ) =>
  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
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 -> LedgerEnv era -> LedgerState era -> Gen (Tx era)
GenEnv c era
-> Environment (AlonzoLEDGER era)
-> State (AlonzoLEDGER era)
-> Gen (Signal (AlonzoLEDGER era))
forall era c.
(EraGen era, EraUTxO 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 era)
genTx

  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