{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Alonzo.Imp.TxInfoSpec (spec) where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Core (
  EraTx (..),
  EraTxBody (..),
  EraTxOut (..),
 )
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo (..), LedgerTxInfo (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Plutus (SLanguage (..))
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.ImpTest
import Test.Cardano.Ledger.Imp.Common

spec :: Spec
spec :: Spec
spec = forall t. ImpSpec t => SpecWith (ImpInit t) -> Spec
withImpInit @(LedgerSpec 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
"TxInfo" (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
-> 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 <$> freshBootstapAddress
      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 =
          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 =
          LedgerTxInfo
            { ltiProtVer :: ProtVer
ltiProtVer = ProtVer
pv
            , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
epochInfo
            , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
systemStart
            , ltiUTxO :: UTxO AlonzoEra
ltiUTxO = UTxO AlonzoEra
utxo
            , ltiTx :: Tx TopTx AlonzoEra
ltiTx = Tx TopTx AlonzoEra
tx
            }
      void $ expectRight $ 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 <$> freshBootstapAddress
      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 =
          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 =
          LedgerTxInfo
            { ltiProtVer :: ProtVer
ltiProtVer = ProtVer
pv
            , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
epochInfo
            , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
systemStart
            , ltiUTxO :: UTxO AlonzoEra
ltiUTxO = UTxO AlonzoEra
utxo
            , ltiTx :: Tx TopTx AlonzoEra
ltiTx = Tx TopTx AlonzoEra
tx
            }
      void $ expectRight $ toPlutusTxInfo SPlutusV1 lti