{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Babbage.Translation.TranslatableGen (
  genTx,
  genTxOut,
  utxoWithTx,
) where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Plutus.Context (SupportedLanguage (..))
import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose (..), ExUnits (..))
import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..))
import Cardano.Ledger.Alonzo.TxWits
import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..), TxBody (BabbageTxBody))
import Cardano.Ledger.Binary (mkSized)
import Cardano.Ledger.Credential (StakeReference (..))
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..))
import Cardano.Ledger.Plutus.Language (SLanguage (..))
import Cardano.Ledger.State (UTxO (..))
import Cardano.Ledger.TxIn (TxIn (..))
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict
import Data.Sequence.Strict (fromList)
import qualified Data.Set as Set
import Lens.Micro ((^.))
import Test.Cardano.Ledger.Alonzo.Arbitrary (genScripts)
import Test.Cardano.Ledger.Alonzo.Translation.TranslatableGen (TranslatableGen (..))
import Test.Cardano.Ledger.Babbage.Arbitrary ()
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.QuickCheck (
  Arbitrary,
  Gen,
  arbitrary,
  elements,
  frequency,
  listOf1,
  oneof,
  scale,
  vectorOf,
 )

instance TranslatableGen BabbageEra where
  tgRedeemers :: Gen (Redeemers BabbageEra)
tgRedeemers = Gen (Redeemers BabbageEra)
forall era.
(AlonzoEraScript era,
 PlutusPurpose AsIx era ~ AlonzoPlutusPurpose AsIx era) =>
Gen (Redeemers era)
genRedeemers
  tgTx :: SupportedLanguage BabbageEra -> Gen (Tx BabbageEra)
tgTx SupportedLanguage BabbageEra
l = forall era.
(TranslatableGen era, Arbitrary (TxAuxData era),
 AlonzoTxWits era ~ TxWits era) =>
Gen (TxBody era) -> Gen (AlonzoTx era)
genTx @BabbageEra (SupportedLanguage BabbageEra -> Gen (TxBody BabbageEra)
genTxBody SupportedLanguage BabbageEra
l)
  tgUtxo :: SupportedLanguage BabbageEra
-> Tx BabbageEra -> Gen (UTxO BabbageEra)
tgUtxo = forall era.
(EraTx era, Arbitrary (Value era), Arbitrary (Script era),
 TxOut era ~ BabbageTxOut era) =>
SupportedLanguage era -> Tx era -> Gen (UTxO era)
utxoWithTx @BabbageEra

utxoWithTx ::
  forall era.
  ( EraTx era
  , Arbitrary (Value era)
  , Arbitrary (Script era)
  , TxOut era ~ BabbageTxOut era
  ) =>
  SupportedLanguage era ->
  Tx era ->
  Gen (UTxO era)
utxoWithTx :: forall era.
(EraTx era, Arbitrary (Value era), Arbitrary (Script era),
 TxOut era ~ BabbageTxOut era) =>
SupportedLanguage era -> Tx era -> Gen (UTxO era)
utxoWithTx SupportedLanguage era
l Tx era
tx = do
  let allIns :: Set TxIn
allIns = Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => SimpleGetter (TxBody era) (Set TxIn)
SimpleGetter (TxBody era) (Set TxIn)
allInputsTxBodyF
  [BabbageTxOut era]
outs <- Int -> Gen (BabbageTxOut era) -> Gen [BabbageTxOut era]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Set TxIn -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set TxIn
allIns) (forall era.
(EraTxOut era, Arbitrary (Value era), Arbitrary (Script era)) =>
SupportedLanguage era -> Gen (BabbageTxOut era)
genTxOut @era SupportedLanguage era
l)
  UTxO era -> Gen (UTxO era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO era -> Gen (UTxO era)) -> UTxO era -> Gen (UTxO era)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO ([(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut era)] -> Map TxIn (TxOut era))
-> [(TxIn, TxOut era)] -> Map TxIn (TxOut era)
forall a b. (a -> b) -> a -> b
$ Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
allIns [TxIn] -> [BabbageTxOut era] -> [(TxIn, BabbageTxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [BabbageTxOut era]
outs)

genTx ::
  forall era.
  ( TranslatableGen era
  , Arbitrary (TxAuxData era)
  , AlonzoTxWits era ~ TxWits era
  ) =>
  Gen (TxBody era) ->
  Gen (AlonzoTx era)
genTx :: forall era.
(TranslatableGen era, Arbitrary (TxAuxData era),
 AlonzoTxWits era ~ TxWits era) =>
Gen (TxBody era) -> Gen (AlonzoTx era)
genTx Gen (TxBody era)
txbGen =
  TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
TxBody era
-> AlonzoTxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
    (TxBody era
 -> AlonzoTxWits era
 -> IsValid
 -> StrictMaybe (TxAuxData era)
 -> AlonzoTx era)
-> Gen (TxBody era)
-> Gen
     (AlonzoTxWits era
      -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxBody era)
txbGen
    Gen
  (AlonzoTxWits era
   -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Gen (AlonzoTxWits era)
-> Gen (IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era. TranslatableGen era => Gen (AlonzoTxWits era)
genTxWits @era
    Gen (IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Gen IsValid -> Gen (StrictMaybe (TxAuxData era) -> AlonzoTx era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen IsValid
forall a. Arbitrary a => Gen a
arbitrary
    Gen (StrictMaybe (TxAuxData era) -> AlonzoTx era)
-> Gen (StrictMaybe (TxAuxData era)) -> Gen (AlonzoTx era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe (TxAuxData era))
forall a. Arbitrary a => Gen a
arbitrary

genTxOut ::
  forall era.
  ( EraTxOut era
  , Arbitrary (Value era)
  , Arbitrary (Script era)
  ) =>
  SupportedLanguage era ->
  Gen (BabbageTxOut era)
genTxOut :: forall era.
(EraTxOut era, Arbitrary (Value era), Arbitrary (Script era)) =>
SupportedLanguage era -> Gen (BabbageTxOut era)
genTxOut (SupportedLanguage SLanguage l
slang) = do
  Addr
addr <- Gen Addr
genNonByronAddr
  Value era
value <- (Int -> Int) -> Gen (Value era) -> Gen (Value era)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen (Value era)
forall a. Arbitrary a => Gen a
arbitrary
  StrictMaybe (Script era)
script <- case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> StrictMaybe (Script era) -> Gen (StrictMaybe (Script era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (Script era)
forall a. StrictMaybe a
SNothing
    SLanguage l
_ -> Gen (StrictMaybe (Script era))
forall a. Arbitrary a => Gen a
arbitrary
  Datum era
datum <- case SLanguage l
slang of
    SLanguage l
SPlutusV1 -> [Gen (Datum era)] -> Gen (Datum era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Datum era -> Gen (Datum era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum era
forall era. Datum era
NoDatum, DataHash -> Datum era
forall era. DataHash -> Datum era
DatumHash (DataHash -> Datum era) -> Gen DataHash -> Gen (Datum era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen DataHash
forall a. Arbitrary a => Gen a
arbitrary :: Gen DataHash)]
    SLanguage l
_ -> Gen (Datum era)
forall a. Arbitrary a => Gen a
arbitrary
  BabbageTxOut era -> Gen (BabbageTxOut era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BabbageTxOut era -> Gen (BabbageTxOut era))
-> BabbageTxOut era -> Gen (BabbageTxOut era)
forall a b. (a -> b) -> a -> b
$ Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut Addr
addr Value era
value Datum era
datum StrictMaybe (Script era)
script

genTxBody :: SupportedLanguage BabbageEra -> Gen (TxBody BabbageEra)
genTxBody :: SupportedLanguage BabbageEra -> Gen (TxBody BabbageEra)
genTxBody l :: SupportedLanguage BabbageEra
l@(SupportedLanguage SLanguage l
slang) = do
  let genTxOuts :: Gen (StrictSeq (Sized (BabbageTxOut BabbageEra)))
genTxOuts = [Sized (BabbageTxOut BabbageEra)]
-> StrictSeq (Sized (BabbageTxOut BabbageEra))
forall a. [a] -> StrictSeq a
fromList ([Sized (BabbageTxOut BabbageEra)]
 -> StrictSeq (Sized (BabbageTxOut BabbageEra)))
-> Gen [Sized (BabbageTxOut BabbageEra)]
-> Gen (StrictSeq (Sized (BabbageTxOut BabbageEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Sized (BabbageTxOut BabbageEra))
-> Gen [Sized (BabbageTxOut BabbageEra)]
forall a. Gen a -> Gen [a]
listOf1 (Version
-> BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerLow @BabbageEra) (BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra))
-> Gen (BabbageTxOut BabbageEra)
-> Gen (Sized (BabbageTxOut BabbageEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
(EraTxOut era, Arbitrary (Value era), Arbitrary (Script era)) =>
SupportedLanguage era -> Gen (BabbageTxOut era)
genTxOut @BabbageEra SupportedLanguage BabbageEra
l)
  let genTxIns :: Gen (Set TxIn)
genTxIns = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList ([TxIn] -> Set TxIn) -> Gen [TxIn] -> Gen (Set TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxIn -> Gen [TxIn]
forall a. Gen a -> Gen [a]
listOf1 (Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary :: Gen TxIn)
  Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut BabbageEra))
-> StrictMaybe (Sized (TxOut BabbageEra))
-> StrictMaybe Coin
-> StrictSeq (TxCert BabbageEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update BabbageEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody BabbageEra
Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (BabbageTxOut BabbageEra))
-> StrictMaybe (Sized (BabbageTxOut BabbageEra))
-> StrictMaybe Coin
-> StrictSeq (ShelleyTxCert BabbageEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update BabbageEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody BabbageEra
BabbageTxBody
    (Set TxIn
 -> Set TxIn
 -> Set TxIn
 -> StrictSeq (Sized (BabbageTxOut BabbageEra))
 -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
 -> StrictMaybe Coin
 -> StrictSeq (ShelleyTxCert BabbageEra)
 -> Withdrawals
 -> Coin
 -> ValidityInterval
 -> StrictMaybe (Update BabbageEra)
 -> Set (KeyHash 'Witness)
 -> MultiAsset
 -> StrictMaybe ScriptIntegrityHash
 -> StrictMaybe TxAuxDataHash
 -> StrictMaybe Network
 -> TxBody BabbageEra)
-> Gen (Set TxIn)
-> Gen
     (Set TxIn
      -> Set TxIn
      -> StrictSeq (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set TxIn)
genTxIns
    Gen
  (Set TxIn
   -> Set TxIn
   -> StrictSeq (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (Set TxIn)
-> Gen
     (Set TxIn
      -> StrictSeq (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Set TxIn
   -> StrictSeq (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (Set TxIn)
-> Gen
     (StrictSeq (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( case SLanguage l
slang of -- refinputs
            SLanguage l
SPlutusV1 -> Set TxIn -> Gen (Set TxIn)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set TxIn
forall a. Set a
Set.empty
            SLanguage l
_ -> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
        )
    Gen
  (StrictSeq (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictSeq (Sized (BabbageTxOut BabbageEra)))
-> Gen
     (StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictSeq (Sized (BabbageTxOut BabbageEra)))
genTxOuts
    Gen
  (StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe (Sized (BabbageTxOut BabbageEra)))
-> Gen
     (StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe (Sized (BabbageTxOut BabbageEra)))
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe Coin)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictSeq (ShelleyTxCert BabbageEra))
-> Gen
     (Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictSeq (ShelleyTxCert BabbageEra))
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen Withdrawals
-> Gen
     (Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Withdrawals
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen Coin
-> Gen
     (ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen ValidityInterval
-> Gen
     (StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ValidityInterval
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe (Update BabbageEra))
-> Gen
     (Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int)
-> Gen (StrictMaybe (Update BabbageEra))
-> Gen (StrictMaybe (Update BabbageEra))
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen (StrictMaybe (Update BabbageEra))
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (Set (KeyHash 'Witness))
-> Gen
     (MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set (KeyHash 'Witness))
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen MultiAsset
-> Gen
     (StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen MultiAsset -> Gen MultiAsset
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen MultiAsset
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe ScriptIntegrityHash)
-> Gen
     (StrictMaybe TxAuxDataHash
      -> StrictMaybe Network -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe ScriptIntegrityHash)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (StrictMaybe TxAuxDataHash
   -> StrictMaybe Network -> TxBody BabbageEra)
-> Gen (StrictMaybe TxAuxDataHash)
-> Gen (StrictMaybe Network -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe TxAuxDataHash)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (StrictMaybe Network -> TxBody BabbageEra)
-> Gen (StrictMaybe Network) -> Gen (TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe Network)
forall a. Arbitrary a => Gen a
arbitrary

genNonByronAddr :: Gen Addr
genNonByronAddr :: Gen Addr
genNonByronAddr =
  Network -> PaymentCredential -> StakeReference -> Addr
Addr
    (Network -> PaymentCredential -> StakeReference -> Addr)
-> Gen Network -> Gen (PaymentCredential -> StakeReference -> Addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Network
forall a. Arbitrary a => Gen a
arbitrary
    Gen (PaymentCredential -> StakeReference -> Addr)
-> Gen PaymentCredential -> Gen (StakeReference -> Addr)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PaymentCredential
forall a. Arbitrary a => Gen a
arbitrary
    Gen (StakeReference -> Addr) -> Gen StakeReference -> Gen Addr
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Int, Gen StakeReference)] -> Gen StakeReference
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
85, StakeCredential -> StakeReference
StakeRefBase (StakeCredential -> StakeReference)
-> Gen StakeCredential -> Gen StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen StakeCredential
forall a. Arbitrary a => Gen a
arbitrary)
      , (Int
15, StakeReference -> Gen StakeReference
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull)
      ]

genTxWits ::
  TranslatableGen era =>
  Gen (AlonzoTxWits era)
genTxWits :: forall era. TranslatableGen era => Gen (AlonzoTxWits era)
genTxWits =
  Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
AlonzoTxWits
    (Set (WitVKey 'Witness)
 -> Set BootstrapWitness
 -> Map ScriptHash (Script era)
 -> TxDats era
 -> Redeemers era
 -> AlonzoTxWits era)
-> Gen (Set (WitVKey 'Witness))
-> Gen
     (Set BootstrapWitness
      -> Map ScriptHash (Script era)
      -> TxDats era
      -> Redeemers era
      -> AlonzoTxWits era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (WitVKey 'Witness))
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Set BootstrapWitness
   -> Map ScriptHash (Script era)
   -> TxDats era
   -> Redeemers era
   -> AlonzoTxWits era)
-> Gen (Set BootstrapWitness)
-> Gen
     (Map ScriptHash (Script era)
      -> TxDats era -> Redeemers era -> AlonzoTxWits era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set BootstrapWitness)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Map ScriptHash (Script era)
   -> TxDats era -> Redeemers era -> AlonzoTxWits era)
-> Gen (Map ScriptHash (Script era))
-> Gen (TxDats era -> Redeemers era -> AlonzoTxWits era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Map ScriptHash (Script era))
forall era.
(EraScript era, Arbitrary (Script era)) =>
Gen (Map ScriptHash (Script era))
genScripts
    Gen (TxDats era -> Redeemers era -> AlonzoTxWits era)
-> Gen (TxDats era) -> Gen (Redeemers era -> AlonzoTxWits era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (TxDats era)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Redeemers era -> AlonzoTxWits era)
-> Gen (Redeemers era) -> Gen (AlonzoTxWits era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Redeemers era)
forall era. TranslatableGen era => Gen (Redeemers era)
tgRedeemers

genRedeemers ::
  forall era.
  (AlonzoEraScript era, PlutusPurpose AsIx era ~ AlonzoPlutusPurpose AsIx era) =>
  Gen (Redeemers era)
genRedeemers :: forall era.
(AlonzoEraScript era,
 PlutusPurpose AsIx era ~ AlonzoPlutusPurpose AsIx era) =>
Gen (Redeemers era)
genRedeemers = do
  Data era
d <- Gen (Data era)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (Data era)
  ExUnits
eu <- Gen ExUnits
forall a. Arbitrary a => Gen a
arbitrary :: Gen ExUnits
  -- We provide `RdrmPtr Spend 0` as the only valid reedemer, because
  -- for any other redeemer type, we would have to modify the body of the transaction
  -- in order for the translation to succeed
  Map (AlonzoPlutusPurpose AsIx era) (Data era, ExUnits)
-> Redeemers era
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (AlonzoPlutusPurpose AsIx era) (Data era, ExUnits)
 -> Redeemers era)
-> Gen (Map (AlonzoPlutusPurpose AsIx era) (Data era, ExUnits))
-> Gen (Redeemers era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Map (AlonzoPlutusPurpose AsIx era) (Data era, ExUnits)]
-> Gen (Map (AlonzoPlutusPurpose AsIx era) (Data era, ExUnits))
forall a. HasCallStack => [a] -> Gen a
elements [AlonzoPlutusPurpose AsIx era
-> (Data era, ExUnits)
-> Map (AlonzoPlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. k -> a -> Map k a
Map.singleton (AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx era)
-> AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0) (Data era
d, ExUnits
eu), Map (AlonzoPlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. Map k a
Map.empty]