{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Babbage.TxInfo where

import Cardano.Ledger.Address (Addr (..), BootstrapAddress (..))
import Cardano.Ledger.Alonzo.Plutus.Context (
  ContextError,
  EraPlutusTxInfo (toPlutusTxInfo),
  LedgerTxInfo (..),
  PlutusTxInfo,
 )
import Cardano.Ledger.Alonzo.Plutus.TxInfo (AlonzoContextError (..), TxOutSource (..))
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.TxInfo (BabbageContextError (..), transTxInInfoV2, transTxOutV2)
import Cardano.Ledger.BaseTypes (
  Inject (..),
  Network (..),
  ProtVer (..),
  StrictMaybe (..),
  natVersion,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (StakeReference (..))
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Mary.Value (MaryValue)
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..), dataToBinaryData)
import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..))
import Cardano.Ledger.TxIn (TxIn (..), mkTxInPartial)
import Cardano.Ledger.UTxO (UTxO (..))
import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
import Cardano.Slotting.Slot (EpochSize (..))
import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import GHC.Stack
import Lens.Micro
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceeds)
import Test.Cardano.Ledger.Shelley.Address.Bootstrap (aliceByronAddr)
import Test.Cardano.Ledger.Shelley.Examples.Cast (alicePHK)
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))

byronAddr :: Addr c
byronAddr :: forall c. Addr c
byronAddr = forall c. BootstrapAddress c -> Addr c
AddrBootstrap (forall c. Address -> BootstrapAddress c
BootstrapAddress Address
aliceByronAddr)

shelleyAddr :: Crypto c => Addr c
shelleyAddr :: forall c. Crypto c => Addr c
shelleyAddr = forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall c. Crypto c => Credential 'Payment c
alicePHK forall c. StakeReference c
StakeRefNull

ei :: EpochInfo (Either a)
ei :: forall a. EpochInfo (Either a)
ei = forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
100) (POSIXTime -> SlotLength
mkSlotLength POSIXTime
1)

ss :: SystemStart
ss :: SystemStart
ss = UTCTime -> SystemStart
SystemStart forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0

-- This input is only a "Byron input" in the sense
-- that we attach it to a Byron output in the UTxO created below.
byronInput :: Crypto c => TxIn c
byronInput :: forall c. Crypto c => TxIn c
byronInput = forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial forall c. HashAlgorithm (HASH c) => TxId c
genesisId Integer
0

-- This input is only unknown in the sense
-- that it is not present in the UTxO created below.
unknownInput :: Crypto c => TxIn c
unknownInput :: forall c. Crypto c => TxIn c
unknownInput = forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial forall c. HashAlgorithm (HASH c) => TxId c
genesisId Integer
1

byronOutput :: forall era. EraTxOut era => TxOut era
byronOutput :: forall era. EraTxOut era => TxOut era
byronOutput = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut forall c. Addr c
byronAddr (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1)

shelleyOutput :: forall era. EraTxOut era => TxOut era
shelleyOutput :: forall era. EraTxOut era => TxOut era
shelleyOutput = forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall c. Crypto c => Addr c
shelleyAddr) (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
2)

datumEx :: forall era. Era era => Datum era
datumEx :: forall era. Era era => Datum era
datumEx = forall era. BinaryData era -> Datum era
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data era -> BinaryData era
dataToBinaryData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => Data -> Data era
Data forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Data
PV1.I forall a b. (a -> b) -> a -> b
$ Integer
123

inlineDatumOutput ::
  forall era.
  ( BabbageEraTxOut era
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  TxOut era
inlineDatumOutput :: forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
TxOut era
inlineDatumOutput =
  forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall c. Crypto c => Addr c
shelleyAddr) (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3)
    forall a b. a -> (a -> b) -> b
& forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
datumTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era. Era era => Datum era
datumEx

refScriptOutput :: BabbageEraTxOut era => TxOut era
refScriptOutput :: forall era. BabbageEraTxOut era => TxOut era
refScriptOutput =
  forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall c. Crypto c => Addr c
shelleyAddr) (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3)
    forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, PlutusLanguage l, AlonzoEraScript era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
3)

-- This input is only a "Shelley input" in the sense
-- that we attach it to a Shelley output in the UTxO created below.
shelleyInput :: Crypto c => TxIn c
shelleyInput :: forall c. Crypto c => TxIn c
shelleyInput = forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial forall c. HashAlgorithm (HASH c) => TxId c
genesisId Integer
2

inputWithInlineDatum :: Crypto c => TxIn c
inputWithInlineDatum :: forall c. Crypto c => TxIn c
inputWithInlineDatum = forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial forall c. HashAlgorithm (HASH c) => TxId c
genesisId Integer
3

inputWithRefScript :: Crypto c => TxIn c
inputWithRefScript :: forall c. Crypto c => TxIn c
inputWithRefScript = forall c. HasCallStack => TxId c -> Integer -> TxIn c
mkTxInPartial forall c. HashAlgorithm (HASH c) => TxId c
genesisId Integer
4

utxo ::
  ( BabbageEraTxOut era
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  UTxO era
utxo :: forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
UTxO era
utxo =
  forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (forall c. Crypto c => TxIn c
byronInput, forall era. EraTxOut era => TxOut era
byronOutput)
      , (forall c. Crypto c => TxIn c
shelleyInput, forall era. EraTxOut era => TxOut era
shelleyOutput)
      , (forall c. Crypto c => TxIn c
inputWithInlineDatum, forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
TxOut era
inlineDatumOutput)
      , (forall c. Crypto c => TxIn c
inputWithRefScript, forall era. BabbageEraTxOut era => TxOut era
refScriptOutput)
      ]

txb ::
  forall era.
  BabbageEraTxBody era =>
  TxIn (EraCrypto era) ->
  Maybe (TxIn (EraCrypto era)) ->
  TxOut era ->
  TxBody era
txb :: forall era.
BabbageEraTxBody era =>
TxIn (EraCrypto era)
-> Maybe (TxIn (EraCrypto era)) -> TxOut era -> TxBody era
txb TxIn (EraCrypto era)
i Maybe (TxIn (EraCrypto era))
mRefInp TxOut era
o =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Set a
Set.singleton TxIn (EraCrypto era)
i
    forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. a -> Set a
Set.singleton Maybe (TxIn (EraCrypto era))
mRefInp
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
StrictSeq.singleton TxOut era
o
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
2

txBare ::
  forall era.
  (EraTx era, BabbageEraTxBody era) =>
  TxIn (EraCrypto era) ->
  TxOut era ->
  Tx era
txBare :: forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare TxIn (EraCrypto era)
i TxOut era
o = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era.
BabbageEraTxBody era =>
TxIn (EraCrypto era)
-> Maybe (TxIn (EraCrypto era)) -> TxOut era -> TxBody era
txb TxIn (EraCrypto era)
i forall a. Maybe a
Nothing TxOut era
o)

txRefInput :: forall era. (EraTx era, BabbageEraTxBody era) => TxIn (EraCrypto era) -> Tx era
txRefInput :: forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> Tx era
txRefInput TxIn (EraCrypto era)
refInput = forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (forall era.
BabbageEraTxBody era =>
TxIn (EraCrypto era)
-> Maybe (TxIn (EraCrypto era)) -> TxOut era -> TxBody era
txb forall c. Crypto c => TxIn c
shelleyInput (forall a. a -> Maybe a
Just TxIn (EraCrypto era)
refInput) forall era. EraTxOut era => TxOut era
shelleyOutput)

hasReferenceInput :: SLanguage l -> PlutusTxInfo l -> Bool
hasReferenceInput :: forall (l :: Language). SLanguage l -> PlutusTxInfo l -> Bool
hasReferenceInput SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> Bool
False
    SLanguage l
SPlutusV2 -> TxInfo -> [TxInInfo]
PV2.txInfoReferenceInputs PlutusTxInfo l
txInfo forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty
    SLanguage l
SPlutusV3 -> TxInfo -> [TxInInfo]
PV3.txInfoReferenceInputs PlutusTxInfo l
txInfo forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty

expectOneInput :: PV2.TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput :: forall (l :: Language).
TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput TxInInfo
i SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> Bool
False
    SLanguage l
SPlutusV2 -> TxInfo -> [TxInInfo]
PV2.txInfoInputs PlutusTxInfo l
txInfo forall a. Eq a => a -> a -> Bool
== [TxInInfo
i]
    SLanguage l
SPlutusV3 -> Bool
False

expectOneOutput :: PV2.TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput :: forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput TxOut
o SLanguage l
slang PlutusTxInfo l
txInfo =
  case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> Bool
False
    SLanguage l
SPlutusV2 -> TxInfo -> [TxOut]
PV2.txInfoOutputs PlutusTxInfo l
txInfo forall a. Eq a => a -> a -> Bool
== [TxOut
o]
    SLanguage l
SPlutusV3 -> TxInfo -> [TxOut]
PV3.txInfoOutputs PlutusTxInfo l
txInfo forall a. Eq a => a -> a -> Bool
== [TxOut
o]

successfulTranslation ::
  forall era l.
  ( BabbageEraTxOut era
  , EraPlutusTxInfo l era
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  SLanguage l ->
  Tx era ->
  (SLanguage l -> PlutusTxInfo l -> Bool) ->
  Assertion
successfulTranslation :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation SLanguage l
slang Tx era
tx SLanguage l -> PlutusTxInfo l -> Bool
f =
  let lti :: LedgerTxInfo era
lti =
        LedgerTxInfo
          { ltiProtVer :: ProtVer
ltiProtVer = Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Natural
0
          , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = forall a. EpochInfo (Either a)
ei
          , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
ss
          , ltiUTxO :: UTxO era
ltiUTxO = forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
UTxO era
utxo
          , ltiTx :: Tx era
ltiTx = Tx era
tx
          }
   in case forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
lti of
        Right PlutusTxInfo l
txInfo -> HasCallStack => String -> Bool -> Assertion
assertBool String
"unexpected transaction info" (SLanguage l -> PlutusTxInfo l -> Bool
f SLanguage l
slang PlutusTxInfo l
txInfo)
        Left ContextError era
e -> forall a. HasCallStack => String -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"no translation error was expected, but got: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ContextError era
e

expectTranslationError ::
  forall era l.
  ( BabbageEraTxOut era
  , EraPlutusTxInfo l era
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  SLanguage l ->
  Tx era ->
  ContextError era ->
  Assertion
expectTranslationError :: forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError SLanguage l
slang Tx era
tx ContextError era
expected =
  let lti :: LedgerTxInfo era
lti =
        LedgerTxInfo
          { ltiProtVer :: ProtVer
ltiProtVer = Version -> Natural -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Natural
0
          , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = forall a. EpochInfo (Either a)
ei
          , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
ss
          , ltiUTxO :: UTxO era
ltiUTxO = forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
UTxO era
utxo
          , ltiTx :: Tx era
ltiTx = Tx era
tx
          }
   in case forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfo SLanguage l
slang LedgerTxInfo era
lti of
        Right PlutusTxInfo l
_ -> forall a. HasCallStack => String -> IO a
assertFailure String
"This translation was expected to fail, but it succeeded."
        Left ContextError era
e -> ContextError era
e forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ContextError era
expected

expectV1TranslationError ::
  ( BabbageEraTxOut era
  , EraPlutusTxInfo 'PlutusV1 era
  , Value era ~ MaryValue (EraCrypto era)
  ) =>
  Tx era ->
  ContextError era ->
  Assertion
expectV1TranslationError :: forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError = forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError SLanguage 'PlutusV1
SPlutusV1

errorTranslate ::
  forall era b.
  (HasCallStack, Show (ContextError era)) =>
  String ->
  Either (ContextError era) b ->
  b
errorTranslate :: forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate String
exampleName =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ContextError era
err -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
exampleName forall a. [a] -> [a] -> [a]
++ String
" failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ContextError era
err) forall a. a -> a
id

translatedInputEx1 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxInInfo
translatedInputEx1 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx1 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedInputEx1" forall a b. (a -> b) -> a -> b
$ forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV2 @era forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
UTxO era
utxo forall c. Crypto c => TxIn c
inputWithInlineDatum

translatedInputEx2 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxInInfo
translatedInputEx2 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx2 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedInputEx2" forall a b. (a -> b) -> a -> b
$ forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV2 @era forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
UTxO era
utxo forall c. Crypto c => TxIn c
inputWithRefScript

translatedOutputEx1 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxOut
translatedOutputEx1 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx1 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedOutputEx1" forall a b. (a -> b) -> a -> b
$
    forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 @era (forall c. TxIx -> TxOutSource c
TxOutFromOutput forall a. Bounded a => a
minBound) forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
TxOut era
inlineDatumOutput

translatedOutputEx2 ::
  forall era.
  ( BabbageEraTxOut era
  , Show (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  PV2.TxOut
translatedOutputEx2 :: forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx2 Proxy era
_ =
  forall era b.
(HasCallStack, Show (ContextError era)) =>
String -> Either (ContextError era) b -> b
errorTranslate @era String
"translatedOutputEx2" forall a b. (a -> b) -> a -> b
$
    forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 @era (forall c. TxIx -> TxOutSource c
TxOutFromOutput forall a. Bounded a => a
minBound) forall era. BabbageEraTxOut era => TxOut era
refScriptOutput

txInfoTestsV1 ::
  forall era.
  ( EraTx era
  , BabbageEraTxBody era
  , Value era ~ MaryValue (EraCrypto era)
  , EraPlutusTxInfo 'PlutusV1 era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  TestTree
txInfoTestsV1 :: forall era.
(EraTx era, BabbageEraTxBody era,
 Value era ~ MaryValue (EraCrypto era),
 EraPlutusTxInfo 'PlutusV1 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TestTree
txInfoTestsV1 Proxy era
_ =
  String -> [TestTree] -> TestTree
testGroup
    String
"Plutus V1"
    forall a b. (a -> b) -> a -> b
$ [ String -> Assertion -> TestTree
testCase String
"translation error on byron txout" forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
shelleyInput forall era. EraTxOut era => TxOut era
byronOutput)
            (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era (forall c. TxIx -> TxOutSource c
TxOutFromOutput forall a. Bounded a => a
minBound))
      , String -> Assertion -> TestTree
testCase String
"translation error on byron txin" forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
byronInput forall era. EraTxOut era => TxOut era
shelleyOutput)
            (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era (forall c. TxIn c -> TxOutSource c
TxOutFromInput forall c. Crypto c => TxIn c
byronInput))
      , String -> Assertion -> TestTree
testCase String
"translation error on unknown txin (logic error)" forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
unknownInput forall era. EraTxOut era => TxOut era
shelleyOutput)
            (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError forall a b. (a -> b) -> a -> b
$ forall era. TxIn (EraCrypto era) -> AlonzoContextError era
TranslationLogicMissingInput @era forall c. Crypto c => TxIn c
unknownInput)
      , String -> Assertion -> TestTree
testCase String
"translation error on inline datum in input" forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
inputWithInlineDatum forall era. EraTxOut era => TxOut era
shelleyOutput)
            (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
InlineDatumsNotSupported @era (forall c. TxIn c -> TxOutSource c
TxOutFromInput forall c. Crypto c => TxIn c
inputWithInlineDatum))
      , String -> Assertion -> TestTree
testCase String
"translation error on inline datum in output" forall a b. (a -> b) -> a -> b
$
          forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
            (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
shelleyInput forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
TxOut era
inlineDatumOutput)
            (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
InlineDatumsNotSupported @era (forall c. TxIx -> TxOutSource c
TxOutFromOutput forall a. Bounded a => a
minBound))
      ]
      forall a. [a] -> [a] -> [a]
++ if forall era. Era era => Version
eraProtVerLow @era forall a. Ord a => a -> a -> Bool
< forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9
        then
          [ String -> Assertion -> TestTree
testCase String
"translation error on reference script in input" forall a b. (a -> b) -> a -> b
$
              forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
                (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
inputWithRefScript forall era. EraTxOut era => TxOut era
shelleyOutput)
                (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ReferenceScriptsNotSupported @era (forall c. TxIn c -> TxOutSource c
TxOutFromInput forall c. Crypto c => TxIn c
inputWithRefScript))
          , String -> Assertion -> TestTree
testCase String
"translation error on reference script in output" forall a b. (a -> b) -> a -> b
$
              forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
                (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
shelleyInput forall era. BabbageEraTxOut era => TxOut era
refScriptOutput)
                (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ReferenceScriptsNotSupported @era (forall c. TxIx -> TxOutSource c
TxOutFromOutput forall a. Bounded a => a
minBound))
          , String -> Assertion -> TestTree
testCase String
"translation error on reference input" forall a b. (a -> b) -> a -> b
$
              forall era.
(BabbageEraTxOut era, EraPlutusTxInfo 'PlutusV1 era,
 Value era ~ MaryValue (EraCrypto era)) =>
Tx era -> ContextError era -> Assertion
expectV1TranslationError @era
                (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> Tx era
txRefInput forall c. Crypto c => TxIn c
shelleyInput)
                (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. Set (TxIn (EraCrypto era)) -> BabbageContextError era
ReferenceInputsNotSupported @era (forall a. a -> Set a
Set.singleton forall c. Crypto c => TxIn c
shelleyInput))
          ]
        else []

txInfoTestsV2 ::
  forall era l.
  ( EraTx era
  , EraPlutusTxInfo l era
  , BabbageEraTxBody era
  , Value era ~ MaryValue (EraCrypto era)
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  Proxy era ->
  SLanguage l ->
  TestTree
txInfoTestsV2 :: forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, BabbageEraTxBody era,
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> SLanguage l -> TestTree
txInfoTestsV2 Proxy era
p SLanguage l
lang =
  String -> [TestTree] -> TestTree
testGroup
    (forall a. Show a => a -> String
show SLanguage l
lang)
    [ String -> Assertion -> TestTree
testCase String
"translation error on byron txout" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
shelleyInput forall era. EraTxOut era => TxOut era
byronOutput)
          (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era (forall c. TxIx -> TxOutSource c
TxOutFromOutput forall a. Bounded a => a
minBound))
    , String -> Assertion -> TestTree
testCase String
"translation error on byron txin" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
byronInput forall era. EraTxOut era => TxOut era
shelleyOutput)
          (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era (forall c. TxIn c -> TxOutSource c
TxOutFromInput forall c. Crypto c => TxIn c
byronInput))
    , String -> Assertion -> TestTree
testCase String
"translation error on unknown txin (logic error)" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l -> Tx era -> ContextError era -> Assertion
expectTranslationError @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
unknownInput forall era. EraTxOut era => TxOut era
shelleyOutput)
          (forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError forall a b. (a -> b) -> a -> b
$ forall era. TxIn (EraCrypto era) -> AlonzoContextError era
TranslationLogicMissingInput @era forall c. Crypto c => TxIn c
unknownInput)
    , String -> Assertion -> TestTree
testCase String
"use reference input starting in Babbage" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> Tx era
txRefInput forall c. Crypto c => TxIn c
shelleyInput)
          forall (l :: Language). SLanguage l -> PlutusTxInfo l -> Bool
hasReferenceInput
    , String -> Assertion -> TestTree
testCase String
"use inline datum in input" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
inputWithInlineDatum forall era. EraTxOut era => TxOut era
shelleyOutput)
          (forall (l :: Language).
TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput (forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx1 Proxy era
p))
    , String -> Assertion -> TestTree
testCase String
"use inline datum in output" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
shelleyInput forall era.
(BabbageEraTxOut era, Value era ~ MaryValue (EraCrypto era)) =>
TxOut era
inlineDatumOutput)
          (forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput (forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx1 Proxy era
p))
    , String -> Assertion -> TestTree
testCase String
"use reference script in input" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
inputWithRefScript forall era. EraTxOut era => TxOut era
shelleyOutput)
          (forall (l :: Language).
TxInInfo -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneInput (forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxInInfo
translatedInputEx2 Proxy era
p))
    , String -> Assertion -> TestTree
testCase String
"use reference script in output" forall a b. (a -> b) -> a -> b
$
        forall era (l :: Language).
(BabbageEraTxOut era, EraPlutusTxInfo l era,
 Value era ~ MaryValue (EraCrypto era)) =>
SLanguage l
-> Tx era -> (SLanguage l -> PlutusTxInfo l -> Bool) -> Assertion
successfulTranslation @era
          SLanguage l
lang
          (forall era.
(EraTx era, BabbageEraTxBody era) =>
TxIn (EraCrypto era) -> TxOut era -> Tx era
txBare forall c. Crypto c => TxIn c
shelleyInput forall era. BabbageEraTxOut era => TxOut era
refScriptOutput)
          (forall (l :: Language).
TxOut -> SLanguage l -> PlutusTxInfo l -> Bool
expectOneOutput (forall era.
(BabbageEraTxOut era, Show (ContextError era),
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TxOut
translatedOutputEx2 Proxy era
p))
    ]

txInfoTests ::
  forall era.
  ( EraTx era
  , BabbageEraTxBody era
  , Value era ~ MaryValue (EraCrypto era)
  , Inject (BabbageContextError era) (ContextError era)
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  ) =>
  Proxy era ->
  TestTree
txInfoTests :: forall era.
(EraTx era, BabbageEraTxBody era,
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era),
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
Proxy era -> TestTree
txInfoTests Proxy era
p = String -> [TestTree] -> TestTree
testGroup String
"txInfo translation" [forall era.
(EraTx era, BabbageEraTxBody era,
 Value era ~ MaryValue (EraCrypto era),
 EraPlutusTxInfo 'PlutusV1 era,
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> TestTree
txInfoTestsV1 Proxy era
p, forall era (l :: Language).
(EraTx era, EraPlutusTxInfo l era, BabbageEraTxBody era,
 Value era ~ MaryValue (EraCrypto era),
 Inject (BabbageContextError era) (ContextError era)) =>
Proxy era -> SLanguage l -> TestTree
txInfoTestsV2 Proxy era
p SLanguage 'PlutusV2
SPlutusV2]