{-# 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 (CertState (..), UTxOState)
import Cardano.Ledger.Shelley.Rules (
  DelegsEnv,
  DelplEnv,
  LedgerEnv (..),
  ShelleyDelplPredFailure,
  UtxoEnv,
 )
import Cardano.Ledger.UTxO (EraUTxO)
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.ConcreteCryptoTypes (Mock)
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
  , Mock (EraCrypto 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
  ) =>
  TQC.HasTrace (AlonzoLEDGER era) (GenEnv era)
  where
  envGen :: HasCallStack => GenEnv era -> Gen (Environment (AlonzoLEDGER era))
envGen GenEnv {Constants
geConstants :: forall era. GenEnv era -> Constants
geConstants :: Constants
geConstants} =
    forall era.
SlotNo
-> TxIx -> PParams era -> AccountState -> Bool -> LedgerEnv era
LedgerEnv (Word64 -> SlotNo
SlotNo Word64
0) forall a. Bounded a => a
minBound
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. EraGen era => Constants -> Gen (PParams era)
genEraPParams @era Constants
geConstants
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Constants -> Gen AccountState
genAccountState Constants
geConstants
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

  sigGen :: HasCallStack =>
GenEnv era
-> Environment (AlonzoLEDGER era)
-> State (AlonzoLEDGER era)
-> Gen (Signal (AlonzoLEDGER era))
sigGen GenEnv era
genenv Environment (AlonzoLEDGER era)
env State (AlonzoLEDGER era)
state = forall era.
(EraGen era, EraUTxO era, Mock (EraCrypto 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) =>
GenEnv era -> LedgerEnv era -> LedgerState era -> Gen (Tx era)
genTx GenEnv era
genenv Environment (AlonzoLEDGER era)
env State (AlonzoLEDGER era)
state

  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 = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT BaseM (AlonzoLEDGER era) a
act BaseEnv (AlonzoLEDGER era)
globals