{-# 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
      ProtVer
pv <- ImpTestM AlonzoEra ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Globals {EpochInfo (Either Text)
epochInfo :: EpochInfo (Either Text)
epochInfo :: Globals -> EpochInfo (Either Text)
epochInfo, SystemStart
systemStart :: SystemStart
systemStart :: Globals -> SystemStart
systemStart} <- Getting Globals (ImpTestState AlonzoEra) Globals
-> ImpM (LedgerSpec AlonzoEra) Globals
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Globals (ImpTestState AlonzoEra) Globals
forall era (f :: * -> *).
Functor f =>
(Globals -> f Globals) -> ImpTestState era -> f (ImpTestState era)
impGlobalsL
      (KeyHash 'Payment
_, Addr
shelleyAddr) <- ImpM (LedgerSpec AlonzoEra) (KeyHash 'Payment, Addr)
forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) =>
m (KeyHash 'Payment, Addr)
freshKeyAddr
      Addr
byronAddr <- BootstrapAddress -> Addr
AddrBootstrap (BootstrapAddress -> Addr)
-> ImpM (LedgerSpec AlonzoEra) BootstrapAddress
-> ImpM (LedgerSpec AlonzoEra) Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec AlonzoEra) BootstrapAddress
forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m BootstrapAddress
freshBootstapAddress
      TxIn
shelleyTxIn <- Addr -> Coin -> ImpTestM AlonzoEra TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr -> Coin -> ImpTestM era TxIn
sendCoinTo Addr
shelleyAddr Coin
forall a. Monoid a => a
mempty
      UTxO AlonzoEra
utxo <- ImpTestM AlonzoEra (UTxO AlonzoEra)
forall era. ImpTestM era (UTxO era)
getUTxO
      let
        byronTxOut :: TxOut AlonzoEra
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 AlonzoEra
tx =
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx @AlonzoEra TxBody AlonzoEra
forall era. EraTxBody era => TxBody era
mkBasicTxBody
            Tx AlonzoEra -> (Tx AlonzoEra -> Tx AlonzoEra) -> Tx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL
              ((TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx AlonzoEra
-> Identity (Tx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody AlonzoEra -> Identity (TxBody AlonzoEra)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody AlonzoEra) (Set TxIn)
inputsTxBodyL
              ((Set TxIn -> Identity (Set TxIn))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> Set TxIn -> Tx AlonzoEra -> Tx 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 AlonzoEra -> (Tx AlonzoEra -> Tx AlonzoEra) -> Tx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL
              ((TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> ((StrictSeq (AlonzoTxOut AlonzoEra)
     -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
    -> TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> (StrictSeq (AlonzoTxOut AlonzoEra)
    -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> Tx AlonzoEra
-> Identity (Tx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut AlonzoEra)
 -> Identity (StrictSeq (TxOut AlonzoEra)))
-> TxBody AlonzoEra -> Identity (TxBody AlonzoEra)
(StrictSeq (AlonzoTxOut AlonzoEra)
 -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> TxBody AlonzoEra -> Identity (TxBody AlonzoEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody AlonzoEra) (StrictSeq (TxOut AlonzoEra))
outputsTxBodyL
              ((StrictSeq (AlonzoTxOut AlonzoEra)
  -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> StrictSeq (AlonzoTxOut AlonzoEra)
-> Tx AlonzoEra
-> Tx 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 AlonzoEra
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 AlonzoEra
ltiTx = Tx AlonzoEra
tx
            }
      ImpM (LedgerSpec AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec AlonzoEra) TxInfo
 -> ImpM (LedgerSpec AlonzoEra) ())
-> ImpM (LedgerSpec AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) ()
forall a b. (a -> b) -> a -> b
$ Either (AlonzoContextError AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) TxInfo
forall a (m :: * -> *) b.
(HasCallStack, Show a, MonadIO m) =>
Either a b -> m b
expectRight (Either (AlonzoContextError AlonzoEra) TxInfo
 -> ImpM (LedgerSpec AlonzoEra) TxInfo)
-> Either (AlonzoContextError AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) TxInfo
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo SLanguage 'PlutusV1
SPlutusV1 LedgerTxInfo AlonzoEra
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
      ProtVer
pv <- ImpTestM AlonzoEra ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      Globals {EpochInfo (Either Text)
epochInfo :: Globals -> EpochInfo (Either Text)
epochInfo :: EpochInfo (Either Text)
epochInfo, SystemStart
systemStart :: Globals -> SystemStart
systemStart :: SystemStart
systemStart} <- Getting Globals (ImpTestState AlonzoEra) Globals
-> ImpM (LedgerSpec AlonzoEra) Globals
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Globals (ImpTestState AlonzoEra) Globals
forall era (f :: * -> *).
Functor f =>
(Globals -> f Globals) -> ImpTestState era -> f (ImpTestState era)
impGlobalsL
      (KeyHash 'Payment
_, Addr
shelleyAddr) <- ImpM (LedgerSpec AlonzoEra) (KeyHash 'Payment, Addr)
forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) =>
m (KeyHash 'Payment, Addr)
freshKeyAddr
      Addr
byronAddr <- BootstrapAddress -> Addr
AddrBootstrap (BootstrapAddress -> Addr)
-> ImpM (LedgerSpec AlonzoEra) BootstrapAddress
-> ImpM (LedgerSpec AlonzoEra) Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec AlonzoEra) BootstrapAddress
forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m BootstrapAddress
freshBootstapAddress
      TxIn
byronTxIn <- Addr -> Coin -> ImpTestM AlonzoEra TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr -> Coin -> ImpTestM era TxIn
sendCoinTo Addr
byronAddr Coin
forall a. Monoid a => a
mempty
      UTxO AlonzoEra
utxo <- ImpTestM AlonzoEra (UTxO AlonzoEra)
forall era. ImpTestM era (UTxO era)
getUTxO
      let
        shelleyTxOut :: TxOut AlonzoEra
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 AlonzoEra
tx =
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx @AlonzoEra TxBody AlonzoEra
forall era. EraTxBody era => TxBody era
mkBasicTxBody
            Tx AlonzoEra -> (Tx AlonzoEra -> Tx AlonzoEra) -> Tx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL
              ((TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx AlonzoEra
-> Identity (Tx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody AlonzoEra -> Identity (TxBody AlonzoEra)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody AlonzoEra) (Set TxIn)
inputsTxBodyL
              ((Set TxIn -> Identity (Set TxIn))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> Set TxIn -> Tx AlonzoEra -> Tx 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 AlonzoEra -> (Tx AlonzoEra -> Tx AlonzoEra) -> Tx AlonzoEra
forall a b. a -> (a -> b) -> b
& (TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> Tx AlonzoEra -> Identity (Tx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL
              ((TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> ((StrictSeq (AlonzoTxOut AlonzoEra)
     -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
    -> TxBody AlonzoEra -> Identity (TxBody AlonzoEra))
-> (StrictSeq (AlonzoTxOut AlonzoEra)
    -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> Tx AlonzoEra
-> Identity (Tx AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut AlonzoEra)
 -> Identity (StrictSeq (TxOut AlonzoEra)))
-> TxBody AlonzoEra -> Identity (TxBody AlonzoEra)
(StrictSeq (AlonzoTxOut AlonzoEra)
 -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
-> TxBody AlonzoEra -> Identity (TxBody AlonzoEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody AlonzoEra) (StrictSeq (TxOut AlonzoEra))
outputsTxBodyL
              ((StrictSeq (AlonzoTxOut AlonzoEra)
  -> Identity (StrictSeq (AlonzoTxOut AlonzoEra)))
 -> Tx AlonzoEra -> Identity (Tx AlonzoEra))
-> StrictSeq (AlonzoTxOut AlonzoEra)
-> Tx AlonzoEra
-> Tx 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 AlonzoEra
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 AlonzoEra
ltiTx = Tx AlonzoEra
tx
            }
      ImpM (LedgerSpec AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec AlonzoEra) TxInfo
 -> ImpM (LedgerSpec AlonzoEra) ())
-> ImpM (LedgerSpec AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) ()
forall a b. (a -> b) -> a -> b
$ Either (AlonzoContextError AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) TxInfo
forall a (m :: * -> *) b.
(HasCallStack, Show a, MonadIO m) =>
Either a b -> m b
expectRight (Either (AlonzoContextError AlonzoEra) TxInfo
 -> ImpM (LedgerSpec AlonzoEra) TxInfo)
-> Either (AlonzoContextError AlonzoEra) TxInfo
-> ImpM (LedgerSpec AlonzoEra) TxInfo
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo SLanguage 'PlutusV1
SPlutusV1 LedgerTxInfo AlonzoEra
lti