{-# 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 :: forall c era. GenEnv c era -> Constants
geConstants :: Constants
geConstants} =
    forall era.
SlotNo
-> Maybe EpochNo
-> TxIx
-> PParams era
-> AccountState
-> LedgerEnv era
LedgerEnv (Word64 -> SlotNo
SlotNo Word64
0) forall a. Maybe a
Nothing 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

  sigGen :: HasCallStack =>
GenEnv c era
-> Environment (AlonzoLEDGER era)
-> State (AlonzoLEDGER era)
-> Gen (Signal (AlonzoLEDGER era))
sigGen GenEnv c era
genenv Environment (AlonzoLEDGER era)
env State (AlonzoLEDGER era)
state = 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 GenEnv c 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