{-# 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, Tx (..))
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 TopTx BabbageEra)
tgTx SupportedLanguage BabbageEra
l = AlonzoTx TopTx BabbageEra -> Tx TopTx BabbageEra
forall (l :: TxLevel). AlonzoTx l BabbageEra -> Tx l BabbageEra
MkBabbageTx (AlonzoTx TopTx BabbageEra -> Tx TopTx BabbageEra)
-> Gen (AlonzoTx TopTx BabbageEra) -> Gen (Tx TopTx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
(TranslatableGen era, Arbitrary (TxAuxData era),
 AlonzoTxWits era ~ TxWits era) =>
Gen (TxBody TopTx era) -> Gen (AlonzoTx TopTx era)
genTx @BabbageEra (TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra
forall (l :: TxLevel) (t :: TxLevel -> * -> *) era.
(Typeable l, HasEraTxLevel t era,
 STxLevel l era ~ STxTopLevel l era) =>
t TopTx era -> t l era
asSTxTopLevel (TxBody TopTx BabbageEra -> TxBody TopTx BabbageEra)
-> Gen (TxBody TopTx BabbageEra) -> Gen (TxBody TopTx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SupportedLanguage BabbageEra -> Gen (TxBody TopTx BabbageEra)
genTxBody SupportedLanguage BabbageEra
l)
  tgUtxo :: SupportedLanguage BabbageEra
-> Tx TopTx BabbageEra -> Gen (UTxO BabbageEra)
tgUtxo = forall era.
(EraTx era, Arbitrary (Value era), Arbitrary (Script era),
 TxOut era ~ BabbageTxOut era) =>
SupportedLanguage era -> Tx TopTx era -> Gen (UTxO era)
utxoWithTx @BabbageEra

utxoWithTx ::
  forall era.
  ( EraTx era
  , Arbitrary (Value era)
  , Arbitrary (Script era)
  , TxOut era ~ BabbageTxOut era
  ) =>
  SupportedLanguage era ->
  Tx TopTx era ->
  Gen (UTxO era)
utxoWithTx :: forall era.
(EraTx era, Arbitrary (Value era), Arbitrary (Script era),
 TxOut era ~ BabbageTxOut era) =>
SupportedLanguage era -> Tx TopTx era -> Gen (UTxO era)
utxoWithTx SupportedLanguage era
l Tx TopTx era
tx = do
  let allIns :: Set TxIn
allIns = Tx TopTx era
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL TxBody TopTx era
-> Getting (Set TxIn) (TxBody TopTx era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx era) (Set TxIn)
forall era.
EraTxBody era =>
SimpleGetter (TxBody TopTx era) (Set TxIn)
SimpleGetter (TxBody TopTx era) (Set TxIn)
allInputsTxBodyF
  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)
  pure $ UTxO (Map.fromList $ Set.toList allIns `zip` outs)

genTx ::
  forall era.
  ( TranslatableGen era
  , Arbitrary (TxAuxData era)
  , AlonzoTxWits era ~ TxWits era
  ) =>
  Gen (TxBody TopTx era) ->
  Gen (AlonzoTx TopTx era)
genTx :: forall era.
(TranslatableGen era, Arbitrary (TxAuxData era),
 AlonzoTxWits era ~ TxWits era) =>
Gen (TxBody TopTx era) -> Gen (AlonzoTx TopTx era)
genTx Gen (TxBody TopTx era)
txbGen =
  TxBody TopTx era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx TopTx era
TxBody TopTx era
-> AlonzoTxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx TopTx era
forall era.
TxBody TopTx era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx TopTx era
AlonzoTx
    (TxBody TopTx era
 -> AlonzoTxWits era
 -> IsValid
 -> StrictMaybe (TxAuxData era)
 -> AlonzoTx TopTx era)
-> Gen (TxBody TopTx era)
-> Gen
     (AlonzoTxWits era
      -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx TopTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxBody TopTx era)
txbGen
    Gen
  (AlonzoTxWits era
   -> IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx TopTx era)
-> Gen (AlonzoTxWits era)
-> Gen
     (IsValid -> StrictMaybe (TxAuxData era) -> AlonzoTx TopTx 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 TopTx era)
-> Gen IsValid
-> Gen (StrictMaybe (TxAuxData era) -> AlonzoTx TopTx 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 TopTx era)
-> Gen (StrictMaybe (TxAuxData era)) -> Gen (AlonzoTx TopTx 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 <- Gen Addr
genNonByronAddr
  value <- scale (`div` 15) arbitrary
  script <- case 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 <- case 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
  pure $ BabbageTxOut addr value datum script

genTxBody :: SupportedLanguage BabbageEra -> Gen (TxBody TopTx BabbageEra)
genTxBody :: SupportedLanguage BabbageEra -> Gen (TxBody TopTx 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 Guard)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody TopTx 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 Guard)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody TopTx 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 Guard)
 -> MultiAsset
 -> StrictMaybe ScriptIntegrityHash
 -> StrictMaybe TxAuxDataHash
 -> StrictMaybe Network
 -> TxBody TopTx 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 Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx 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 Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx 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 Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen (StrictSeq (Sized (BabbageTxOut BabbageEra)))
-> Gen
     (StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen (StrictMaybe (Sized (BabbageTxOut BabbageEra)))
-> Gen
     (StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen (StrictSeq (ShelleyTxCert BabbageEra))
-> Gen
     (Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen Withdrawals
-> Gen
     (Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen Coin
-> Gen
     (ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen ValidityInterval
-> Gen
     (StrictMaybe (Update BabbageEra)
      -> Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen (StrictMaybe (Update BabbageEra))
-> Gen
     (Set (KeyHash Guard)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen (Set (KeyHash Guard))
-> Gen
     (MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 Guard))
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody TopTx BabbageEra)
-> Gen MultiAsset
-> Gen
     (StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody TopTx 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 TopTx BabbageEra)
-> Gen (StrictMaybe ScriptIntegrityHash)
-> Gen
     (StrictMaybe TxAuxDataHash
      -> StrictMaybe Network -> TxBody TopTx 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 TopTx BabbageEra)
-> Gen (StrictMaybe TxAuxDataHash)
-> Gen (StrictMaybe Network -> TxBody TopTx 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 TopTx BabbageEra)
-> Gen (StrictMaybe Network) -> Gen (TxBody TopTx 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 -> Credential Payment -> StakeReference -> Addr
Addr
    (Network -> Credential Payment -> StakeReference -> Addr)
-> Gen Network
-> Gen (Credential Payment -> StakeReference -> Addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Network
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Credential Payment -> StakeReference -> Addr)
-> Gen (Credential Payment) -> 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 (Credential Payment)
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, Credential Staking -> StakeReference
StakeRefBase (Credential Staking -> StakeReference)
-> Gen (Credential Staking) -> Gen StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Credential Staking)
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
  d <- Gen (Data era)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (Data era)
  eu <- 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
  Redeemers <$> elements [Map.singleton (AlonzoSpending $ AsIx 0) (d, eu), Map.empty]