{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Alonzo.Imp (
  spec,
  Shelley.shelleyToBabbageSpec,
  alonzoToConwaySpec,
  alonzoOnlySpec,
) where

import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusTxInfo (..),
  LedgerLevelTxInfo (..),
  PlutusTxInfoResult (..),
 )
import Cardano.Ledger.BaseTypes (Globals (..), Inject (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus (SLanguage (..))
import Cardano.Ledger.Shelley.Core (ShelleyEraTxCert)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Control.State.Transition (Event)
import Data.Proxy (Proxy (..))
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Lens.Micro
import Lens.Micro.Mtl (use)
import Test.Cardano.Ledger.Alonzo.Era (mkTestLedgerTxInfo)
import qualified Test.Cardano.Ledger.Alonzo.Imp.BbodySpec as BBODY
import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxoSpec as UTXO
import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxosSpec as UTXOS
import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec as UTXOW
import Test.Cardano.Ledger.Alonzo.ImpTest
import Test.Cardano.Ledger.Imp.Common
import qualified Test.Cardano.Ledger.Mary.Imp as Mary
import qualified Test.Cardano.Ledger.Shelley.Imp as Shelley

spec ::
  ( AlonzoEraImp era
  , Event (EraRule "RUPD" era) ~ Shelley.RupdEvent
  ) =>
  proxy era ->
  Spec
spec :: forall era (proxy :: * -> *).
(AlonzoEraImp era, Event (EraRule "RUPD" era) ~ RupdEvent) =>
proxy era -> Spec
spec proxy era
era = do
  proxy era -> Spec
forall era (proxy :: * -> *).
(MaryEraImp era, Event (EraRule "RUPD" era) ~ RupdEvent) =>
proxy era -> Spec
Mary.spec proxy era
era
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"AlonzoEra Onwards" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ proxy era -> SpecWith (ImpInit (LedgerSpec era)) -> Spec
forall (proxy :: * -> *) era.
ShelleyEraImp era =>
proxy era -> SpecWith (ImpInit (LedgerSpec era)) -> Spec
withImpInitEachEraVersion proxy era
era (SpecWith (ImpInit (LedgerSpec era)) -> Spec)
-> SpecWith (ImpInit (LedgerSpec era)) -> Spec
forall a b. (a -> b) -> a -> b
$ do
    SpecWith (ImpInit (LedgerSpec era))
forall era. AlonzoEraImp era => SpecWith (ImpInit (LedgerSpec era))
BBODY.spec
    SpecWith (ImpInit (LedgerSpec era))
forall era. AlonzoEraImp era => SpecWith (ImpInit (LedgerSpec era))
UTXO.spec
    SpecWith (ImpInit (LedgerSpec era))
forall era. AlonzoEraImp era => SpecWith (ImpInit (LedgerSpec era))
UTXOS.spec
    SpecWith (ImpInit (LedgerSpec era))
forall era. AlonzoEraImp era => SpecWith (ImpInit (LedgerSpec era))
UTXOW.spec

alonzoToConwaySpec ::
  (AlonzoEraImp era, ShelleyEraTxCert era) =>
  proxy era ->
  Spec
alonzoToConwaySpec :: forall era (proxy :: * -> *).
(AlonzoEraImp era, ShelleyEraTxCert era) =>
proxy era -> Spec
alonzoToConwaySpec proxy era
era = proxy era -> SpecWith (ImpInit (LedgerSpec era)) -> Spec
forall (proxy :: * -> *) era.
ShelleyEraImp era =>
proxy era -> SpecWith (ImpInit (LedgerSpec era)) -> Spec
withImpInitEachEraVersion proxy era
era (SpecWith (ImpInit (LedgerSpec era)) -> Spec)
-> SpecWith (ImpInit (LedgerSpec era)) -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"AlonzoEra Specific" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    UTXOW.alonzoToConwaySpec

alonzoOnlySpec :: Spec
alonzoOnlySpec :: Spec
alonzoOnlySpec =
  Proxy AlonzoEra
-> SpecWith (ImpInit (LedgerSpec AlonzoEra)) -> Spec
forall (proxy :: * -> *) era.
ShelleyEraImp era =>
proxy era -> SpecWith (ImpInit (LedgerSpec era)) -> Spec
withImpInitEachEraVersion (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AlonzoEra) (SpecWith (ImpInit (LedgerSpec AlonzoEra)) -> Spec)
-> SpecWith (ImpInit (LedgerSpec AlonzoEra)) -> Spec
forall a b. (a -> b) -> a -> b
$
    String
-> SpecWith (ImpInit (LedgerSpec AlonzoEra))
-> SpecWith (ImpInit (LedgerSpec AlonzoEra))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PlutusV1" (SpecWith (ImpInit (LedgerSpec AlonzoEra))
 -> SpecWith (ImpInit (LedgerSpec AlonzoEra)))
-> SpecWith (ImpInit (LedgerSpec AlonzoEra))
-> SpecWith (ImpInit (LedgerSpec AlonzoEra))
forall a b. (a -> b) -> a -> b
$ do
      String
-> ImpM (LedgerSpec AlonzoEra) ()
-> SpecWith (Arg (ImpM (LedgerSpec AlonzoEra) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"toPlutusTxInfo does not fail when Byron scripts are present in TxOuts" (ImpM (LedgerSpec AlonzoEra) ()
 -> SpecWith (Arg (ImpM (LedgerSpec AlonzoEra) ())))
-> ImpM (LedgerSpec AlonzoEra) ()
-> SpecWith (Arg (ImpM (LedgerSpec AlonzoEra) ()))
forall a b. (a -> b) -> a -> b
$ do
        pv <- ImpTestM AlonzoEra ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
        Globals {epochInfo, systemStart} <- use impGlobalsL
        (_, shelleyAddr) <- freshKeyAddr
        byronAddr <- AddrBootstrap <$> freshBootstrapAddress
        shelleyTxIn <- sendCoinTo shelleyAddr mempty
        utxo <- getUTxO
        let
          byronTxOut = Addr -> Value AlonzoEra -> TxOut AlonzoEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
byronAddr (Value AlonzoEra -> TxOut AlonzoEra)
-> (Coin -> Value AlonzoEra) -> Coin -> TxOut AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Value AlonzoEra
forall t s. Inject t s => t -> s
inject (Coin -> TxOut AlonzoEra) -> Coin -> TxOut AlonzoEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1
          tx :: Tx TopTx AlonzoEra
          tx =
            forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @AlonzoEra TxBody TopTx AlonzoEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l AlonzoEra
mkBasicTxBody
              Tx TopTx AlonzoEra
-> (Tx TopTx AlonzoEra -> Tx TopTx AlonzoEra) -> Tx TopTx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxBody l AlonzoEra)
bodyTxL ((TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx TopTx AlonzoEra
-> Identity (Tx TopTx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l AlonzoEra) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> Set TxIn -> Tx TopTx AlonzoEra -> Tx TopTx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
shelleyTxIn
              Tx TopTx AlonzoEra
-> (Tx TopTx AlonzoEra -> Tx TopTx AlonzoEra) -> Tx TopTx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxBody l AlonzoEra)
bodyTxL ((TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> ((StrictSeq (AlonzoTxOut AlonzoEra)
     -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
    -> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> (StrictSeq (AlonzoTxOut AlonzoEra)
    -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> Tx TopTx AlonzoEra
-> Identity (Tx TopTx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut AlonzoEra)
 -> Identity (StrictSeq (TxOut AlonzoEra)))
-> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra)
(StrictSeq (AlonzoTxOut AlonzoEra)
 -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l AlonzoEra) (StrictSeq (TxOut AlonzoEra))
outputsTxBodyL ((StrictSeq (AlonzoTxOut AlonzoEra)
  -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> StrictSeq (AlonzoTxOut AlonzoEra)
-> Tx TopTx AlonzoEra
-> Tx TopTx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxOut AlonzoEra -> StrictSeq (AlonzoTxOut AlonzoEra)
forall a. a -> StrictSeq a
SSeq.singleton TxOut AlonzoEra
AlonzoTxOut AlonzoEra
byronTxOut
          lti = ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO AlonzoEra
-> Tx TopTx AlonzoEra
-> LedgerLevelTxInfo TopTx AlonzoEra
-> LedgerTxInfo TopTx AlonzoEra
forall era (level :: TxLevel).
(EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx level era
-> LedgerLevelTxInfo level era
-> LedgerTxInfo level era
mkTestLedgerTxInfo ProtVer
pv EpochInfo (Either Text)
epochInfo SystemStart
systemStart UTxO AlonzoEra
utxo Tx TopTx AlonzoEra
tx (LedgerLevelTxInfo TopTx AlonzoEra -> LedgerTxInfo TopTx AlonzoEra)
-> LedgerLevelTxInfo TopTx AlonzoEra
-> LedgerTxInfo TopTx AlonzoEra
forall a b. (a -> b) -> a -> b
$ Map TxId (TxInfoResult AlonzoEra)
-> LedgerLevelTxInfo TopTx AlonzoEra
forall era.
Map TxId (TxInfoResult era) -> LedgerLevelTxInfo TopTx era
LedgerTopTxInfo Map TxId (TxInfoResult AlonzoEra)
forall a. Monoid a => a
mempty
        void $ expectRight $ unPlutusTxInfoResult $ toPlutusTxInfo SPlutusV1 lti
      String
-> ImpM (LedgerSpec AlonzoEra) ()
-> SpecWith (Arg (ImpM (LedgerSpec AlonzoEra) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"toPlutusTxInfo does not fail when Byron scripts are present in TxIns" (ImpM (LedgerSpec AlonzoEra) ()
 -> SpecWith (Arg (ImpM (LedgerSpec AlonzoEra) ())))
-> ImpM (LedgerSpec AlonzoEra) ()
-> SpecWith (Arg (ImpM (LedgerSpec AlonzoEra) ()))
forall a b. (a -> b) -> a -> b
$ do
        pv <- ImpTestM AlonzoEra ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
        Globals {epochInfo, systemStart} <- use impGlobalsL
        (_, shelleyAddr) <- freshKeyAddr
        byronAddr <- AddrBootstrap <$> freshBootstrapAddress
        byronTxIn <- sendCoinTo byronAddr mempty
        utxo <- getUTxO
        let
          shelleyTxOut = Addr -> Value AlonzoEra -> TxOut AlonzoEra
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
shelleyAddr (Value AlonzoEra -> TxOut AlonzoEra)
-> (Coin -> Value AlonzoEra) -> Coin -> TxOut AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Value AlonzoEra
forall t s. Inject t s => t -> s
inject (Coin -> TxOut AlonzoEra) -> Coin -> TxOut AlonzoEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1
          tx :: Tx TopTx AlonzoEra
          tx =
            forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
mkBasicTx @AlonzoEra TxBody TopTx AlonzoEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l AlonzoEra
mkBasicTxBody
              Tx TopTx AlonzoEra
-> (Tx TopTx AlonzoEra -> Tx TopTx AlonzoEra) -> Tx TopTx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxBody l AlonzoEra)
bodyTxL ((TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx TopTx AlonzoEra
-> Identity (Tx TopTx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l AlonzoEra) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> Set TxIn -> Tx TopTx AlonzoEra -> Tx TopTx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton TxIn
byronTxIn
              Tx TopTx AlonzoEra
-> (Tx TopTx AlonzoEra -> Tx TopTx AlonzoEra) -> Tx TopTx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxBody l AlonzoEra)
bodyTxL ((TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> ((StrictSeq (AlonzoTxOut AlonzoEra)
     -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
    -> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra))
-> (StrictSeq (AlonzoTxOut AlonzoEra)
    -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> Tx TopTx AlonzoEra
-> Identity (Tx TopTx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut AlonzoEra)
 -> Identity (StrictSeq (TxOut AlonzoEra)))
-> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra)
(StrictSeq (AlonzoTxOut AlonzoEra)
 -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> TxBody TopTx AlonzoEra -> Identity (TxBody TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l AlonzoEra) (StrictSeq (TxOut AlonzoEra))
outputsTxBodyL ((StrictSeq (AlonzoTxOut AlonzoEra)
  -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
 -> Tx TopTx AlonzoEra -> Identity (Tx TopTx AlonzoEra))
-> StrictSeq (AlonzoTxOut AlonzoEra)
-> Tx TopTx AlonzoEra
-> Tx TopTx AlonzoEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AlonzoTxOut AlonzoEra -> StrictSeq (AlonzoTxOut AlonzoEra)
forall a. a -> StrictSeq a
SSeq.singleton TxOut AlonzoEra
AlonzoTxOut AlonzoEra
shelleyTxOut
          lti = ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO AlonzoEra
-> Tx TopTx AlonzoEra
-> LedgerLevelTxInfo TopTx AlonzoEra
-> LedgerTxInfo TopTx AlonzoEra
forall era (level :: TxLevel).
(EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx level era
-> LedgerLevelTxInfo level era
-> LedgerTxInfo level era
mkTestLedgerTxInfo ProtVer
pv EpochInfo (Either Text)
epochInfo SystemStart
systemStart UTxO AlonzoEra
utxo Tx TopTx AlonzoEra
tx (LedgerLevelTxInfo TopTx AlonzoEra -> LedgerTxInfo TopTx AlonzoEra)
-> LedgerLevelTxInfo TopTx AlonzoEra
-> LedgerTxInfo TopTx AlonzoEra
forall a b. (a -> b) -> a -> b
$ Map TxId (TxInfoResult AlonzoEra)
-> LedgerLevelTxInfo TopTx AlonzoEra
forall era.
Map TxId (TxInfoResult era) -> LedgerLevelTxInfo TopTx era
LedgerTopTxInfo Map TxId (TxInfoResult AlonzoEra)
forall a. Monoid a => a
mempty
        void $ expectRight $ unPlutusTxInfoResult $ toPlutusTxInfo SPlutusV1 lti