{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- | The example transactions in this module are not valid transactions. We
-- don't care, we are only interested in serialisation, not validation.
module Test.Cardano.Ledger.Babbage.Examples (
  ledgerExamples,
  exampleBabbageNewEpochState,
  exampleBabbageBasedTx,
  exampleBabbageBasedTopTx,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
import Cardano.Ledger.Babbage (ApplyTxError (BabbageApplyTxError), BabbageEra)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Cardano.Ledger.Plutus.Data (
  Datum (..),
  dataToBinaryData,
 )
import Cardano.Ledger.Plutus.Language (Language (..), plutusBinary)
import Cardano.Ledger.Shelley.LedgerState (NewEpochState (..))
import Cardano.Ledger.Shelley.Rules (
  ShelleyDelegPredFailure (DelegateeNotRegisteredDELEG),
  ShelleyDelegsPredFailure (DelplFailure),
  ShelleyDelplPredFailure (DelegFailure),
  ShelleyLedgerPredFailure (DelegsFailure),
 )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.MapExtras as Map
import qualified Data.Sequence.Strict as StrictSeq
import Data.Typeable (Typeable)
import Lens.Micro
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceeds)
import Test.Cardano.Ledger.Alonzo.Examples (
  addAlonzoToConwayExampleReqSigners,
  exampleAlonzoBasedTopTx,
  exampleAlonzoBasedTx,
  exampleDatum,
  mkAlonzoBasedLedgerExamples,
 )
import Test.Cardano.Ledger.Babbage.Era
import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
import Test.Cardano.Ledger.Mary.Examples (exampleMultiAssetValue)
import Test.Cardano.Ledger.Plutus (alwaysSucceedsPlutus)
import Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples (..),
  addShelleyBasedTopTxExampleFee,
  addShelleyToBabbageExampleProposedPUpdates,
  addShelleyToBabbageTxCerts,
  addShelleyToConwayTxCerts,
  exampleNewEpochState,
  examplePayKey,
  exampleShelleyScript,
  exampleStakeKey,
  exampleTxIns,
  mkKeyHash,
 )

ledgerExamples :: LedgerExamples BabbageEra
ledgerExamples :: LedgerExamples BabbageEra
ledgerExamples =
  ApplyTxError BabbageEra
-> NewEpochState BabbageEra
-> Tx TopTx BabbageEra
-> TranslationContext BabbageEra
-> LedgerExamples BabbageEra
forall era.
AlonzoEraPParams era =>
ApplyTxError era
-> NewEpochState era
-> Tx TopTx era
-> TranslationContext era
-> LedgerExamples era
mkAlonzoBasedLedgerExamples
    ( NonEmpty (ShelleyLedgerPredFailure BabbageEra)
-> ApplyTxError BabbageEra
BabbageApplyTxError (NonEmpty (ShelleyLedgerPredFailure BabbageEra)
 -> ApplyTxError BabbageEra)
-> NonEmpty (ShelleyLedgerPredFailure BabbageEra)
-> ApplyTxError BabbageEra
forall a b. (a -> b) -> a -> b
$
        ShelleyLedgerPredFailure BabbageEra
-> NonEmpty (ShelleyLedgerPredFailure BabbageEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure BabbageEra
 -> NonEmpty (ShelleyLedgerPredFailure BabbageEra))
-> ShelleyLedgerPredFailure BabbageEra
-> NonEmpty (ShelleyLedgerPredFailure BabbageEra)
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "DELEGS" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure (PredicateFailure (EraRule "DELEGS" BabbageEra)
 -> ShelleyLedgerPredFailure BabbageEra)
-> PredicateFailure (EraRule "DELEGS" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
            PredicateFailure (EraRule "DELPL" BabbageEra)
-> ShelleyDelegsPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "DELPL" era)
-> ShelleyDelegsPredFailure era
DelplFailure (PredicateFailure (EraRule "DELPL" BabbageEra)
 -> ShelleyDelegsPredFailure BabbageEra)
-> PredicateFailure (EraRule "DELPL" BabbageEra)
-> ShelleyDelegsPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
              PredicateFailure (EraRule "DELEG" BabbageEra)
-> ShelleyDelplPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "DELEG" era)
-> ShelleyDelplPredFailure era
DelegFailure (PredicateFailure (EraRule "DELEG" BabbageEra)
 -> ShelleyDelplPredFailure BabbageEra)
-> PredicateFailure (EraRule "DELEG" BabbageEra)
-> ShelleyDelplPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
                KeyHash StakePool -> ShelleyDelegPredFailure BabbageEra
forall era. KeyHash StakePool -> ShelleyDelegPredFailure era
DelegateeNotRegisteredDELEG (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
    )
    NewEpochState BabbageEra
forall era.
(BabbageEraTest era, Value era ~ MaryValue) =>
NewEpochState era
exampleBabbageNewEpochState
    Tx TopTx BabbageEra
exampleBabbageTx
    TranslationContext BabbageEra
NoGenesis BabbageEra
forall era. NoGenesis era
NoGenesis
  where
    exampleBabbageTx :: Tx TopTx BabbageEra
    exampleBabbageTx :: Tx TopTx BabbageEra
exampleBabbageTx =
      Tx TopTx BabbageEra
forall era.
(AlonzoEraTx era, BabbageEraTxBody era, AlonzoEraTxAuxData era,
 Value era ~ MaryValue, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era) =>
Tx TopTx era
exampleBabbageBasedTopTx
        Tx TopTx BabbageEra
-> (Tx TopTx BabbageEra -> Tx TopTx BabbageEra)
-> Tx TopTx BabbageEra
forall a b. a -> (a -> b) -> b
& Tx TopTx BabbageEra -> Tx TopTx BabbageEra
forall era. EraTx era => Tx TopTx era -> Tx TopTx era
addShelleyBasedTopTxExampleFee
        Tx TopTx BabbageEra
-> (Tx TopTx BabbageEra -> Tx TopTx BabbageEra)
-> Tx TopTx BabbageEra
forall a b. a -> (a -> b) -> b
& Tx TopTx BabbageEra -> Tx TopTx BabbageEra
forall era.
(EraTx era, ShelleyEraTxBody era) =>
Tx TopTx era -> Tx TopTx era
addShelleyToBabbageExampleProposedPUpdates
        Tx TopTx BabbageEra
-> (Tx TopTx BabbageEra -> Tx TopTx BabbageEra)
-> Tx TopTx BabbageEra
forall a b. a -> (a -> b) -> b
& Tx TopTx BabbageEra -> Tx TopTx BabbageEra
forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
Tx l era -> Tx l era
addShelleyToBabbageTxCerts
        Tx TopTx BabbageEra
-> (Tx TopTx BabbageEra -> Tx TopTx BabbageEra)
-> Tx TopTx BabbageEra
forall a b. a -> (a -> b) -> b
& Tx TopTx BabbageEra -> Tx TopTx BabbageEra
forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxCert era) =>
Tx l era -> Tx l era
addShelleyToConwayTxCerts
        Tx TopTx BabbageEra
-> (Tx TopTx BabbageEra -> Tx TopTx BabbageEra)
-> Tx TopTx BabbageEra
forall a b. a -> (a -> b) -> b
& Tx TopTx BabbageEra -> Tx TopTx BabbageEra
forall era (l :: TxLevel).
(AlonzoEraTxBody era, AtMostEra "Conway" era, EraTx era) =>
Tx l era -> Tx l era
addAlonzoToConwayExampleReqSigners

exampleBabbageNewEpochState ::
  ( BabbageEraTest era
  , Value era ~ MaryValue
  ) =>
  NewEpochState era
exampleBabbageNewEpochState :: forall era.
(BabbageEraTest era, Value era ~ MaryValue) =>
NewEpochState era
exampleBabbageNewEpochState =
  Value era -> PParams era -> PParams era -> NewEpochState era
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era)) =>
Value era -> PParams era -> PParams era -> NewEpochState era
exampleNewEpochState
    (Int -> MaryValue
exampleMultiAssetValue Int
1)
    PParams era
forall era. EraPParams era => PParams era
emptyPParams
    (PParams era
forall era. EraPParams era => PParams era
emptyPParams PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams era -> Identity (PParams era)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams era -> Identity (PParams era))
-> CoinPerByte -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompactForm Coin -> CoinPerByte
CoinPerByte (Word64 -> CompactForm Coin
CompactCoin Word64
1))

exampleBabbageBasedTopTx ::
  forall era.
  ( AlonzoEraTx era
  , BabbageEraTxBody era
  , AlonzoEraTxAuxData era
  , Value era ~ MaryValue
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  ) =>
  Tx TopTx era
exampleBabbageBasedTopTx :: forall era.
(AlonzoEraTx era, BabbageEraTxBody era, AlonzoEraTxAuxData era,
 Value era ~ MaryValue, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era) =>
Tx TopTx era
exampleBabbageBasedTopTx =
  Tx TopTx era
forall era.
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, Value era ~ MaryValue) =>
Tx TopTx era
exampleAlonzoBasedTopTx
    Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& Tx TopTx era -> Tx TopTx era
forall era (l :: TxLevel).
(AlonzoEraTx era, BabbageEraTxBody era, AlonzoEraTxAuxData era,
 Value era ~ MaryValue, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era) =>
Tx l era -> Tx l era
addBabbageBasedTxFeatures
    Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& Tx TopTx era -> Tx TopTx era
forall era.
(AlonzoEraTx era, BabbageEraTxBody era, Value era ~ MaryValue) =>
Tx TopTx era -> Tx TopTx era
addBabbageBasedTopTxFeatures

exampleBabbageBasedTx ::
  forall era l.
  ( AlonzoEraTx era
  , BabbageEraTxBody era
  , AlonzoEraTxAuxData era
  , Value era ~ MaryValue
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  , Typeable l
  ) =>
  Tx l era
exampleBabbageBasedTx :: forall era (l :: TxLevel).
(AlonzoEraTx era, BabbageEraTxBody era, AlonzoEraTxAuxData era,
 Value era ~ MaryValue, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Typeable l) =>
Tx l era
exampleBabbageBasedTx =
  Tx l era
forall era (l :: TxLevel).
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, Value era ~ MaryValue,
 Typeable l) =>
Tx l era
exampleAlonzoBasedTx
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& Tx l era -> Tx l era
forall era (l :: TxLevel).
(AlonzoEraTx era, BabbageEraTxBody era, AlonzoEraTxAuxData era,
 Value era ~ MaryValue, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era) =>
Tx l era -> Tx l era
addBabbageBasedTxFeatures

addBabbageBasedTopTxFeatures ::
  forall era.
  ( AlonzoEraTx era
  , BabbageEraTxBody era
  , Value era ~ MaryValue
  ) =>
  Tx TopTx era ->
  Tx TopTx era
addBabbageBasedTopTxFeatures :: forall era.
(AlonzoEraTx era, BabbageEraTxBody era, Value era ~ MaryValue) =>
Tx TopTx era -> Tx TopTx era
addBabbageBasedTopTxFeatures Tx TopTx era
tx =
  Tx TopTx era
tx
    Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx 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 -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictMaybe (TxOut era) -> Identity (StrictMaybe (TxOut era)))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictMaybe (TxOut era) -> Identity (StrictMaybe (TxOut era)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (TxOut era) -> Identity (StrictMaybe (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL ((StrictMaybe (TxOut era) -> Identity (StrictMaybe (TxOut era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictMaybe (TxOut era) -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut era -> StrictMaybe (TxOut era)
forall a. a -> StrictMaybe a
SJust TxOut era
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
exampleCollateralOutput
    Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx 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 -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe Coin)
Lens' (TxBody TopTx era) (StrictMaybe Coin)
totalCollateralTxBodyL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictMaybe Coin -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
8675309)

addBabbageBasedTxFeatures ::
  forall era l.
  ( AlonzoEraTx era
  , BabbageEraTxBody era
  , AlonzoEraTxAuxData era
  , Value era ~ MaryValue
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  ) =>
  Tx l era ->
  Tx l era
addBabbageBasedTxFeatures :: forall era (l :: TxLevel).
(AlonzoEraTx era, BabbageEraTxBody era, AlonzoEraTxAuxData era,
 Value era ~ MaryValue, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era) =>
Tx l era -> Tx l era
addBabbageBasedTxFeatures Tx l era
tx =
  Tx l era
tx
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL
      ((TxWits era -> Identity (TxWits era))
 -> Tx l era -> Identity (Tx l era))
-> TxWits era -> Tx l era -> Tx l era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ ( TxWits era
forall era. EraTxWits era => TxWits era
mkBasicTxWits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ (Script era -> ScriptHash)
-> [Script era] -> Map ScriptHash (Script era)
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
hashScript [forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
3]
          )
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxAuxData era -> TxAuxData era) -> Tx l era -> Tx l era
forall era (l :: TxLevel).
EraTx era =>
(TxAuxData era -> TxAuxData era) -> Tx l era -> Tx l era
modifyTxAuxData
      ( (Map Language (NonEmpty PlutusBinary)
 -> Identity (Map Language (NonEmpty PlutusBinary)))
-> TxAuxData era -> Identity (TxAuxData era)
forall era.
AlonzoEraTxAuxData era =>
Lens' (TxAuxData era) (Map Language (NonEmpty PlutusBinary))
Lens' (TxAuxData era) (Map Language (NonEmpty PlutusBinary))
plutusScriptsTxAuxDataL
          ((Map Language (NonEmpty PlutusBinary)
  -> Identity (Map Language (NonEmpty PlutusBinary)))
 -> TxAuxData era -> Identity (TxAuxData era))
-> (Map Language (NonEmpty PlutusBinary)
    -> Map Language (NonEmpty PlutusBinary))
-> TxAuxData era
-> TxAuxData era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (NonEmpty PlutusBinary
 -> NonEmpty PlutusBinary -> NonEmpty PlutusBinary)
-> Language
-> NonEmpty PlutusBinary
-> Map Language (NonEmpty PlutusBinary)
-> Map Language (NonEmpty PlutusBinary)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
            NonEmpty PlutusBinary
-> NonEmpty PlutusBinary -> NonEmpty PlutusBinary
forall a. Semigroup a => a -> a -> a
(<>)
            Language
PlutusV2
            (PlutusBinary -> NonEmpty PlutusBinary
forall a. a -> NonEmpty a
NE.singleton (Plutus 'PlutusV2 -> PlutusBinary
forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary (forall (l :: Language). Natural -> Plutus l
alwaysSucceedsPlutus @'PlutusV2 Natural
3)))
      )
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxBody l era -> Identity (TxBody l era))
-> Tx l era -> Identity (Tx l 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 l era -> Identity (TxBody l era))
 -> Tx l era -> Identity (Tx l era))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody l era -> Identity (TxBody l era))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
referenceInputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> Tx l era -> Identity (Tx l era))
-> Set TxIn -> Tx l era -> Tx l era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Set TxIn
exampleTxIns
    Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxBody l era -> Identity (TxBody l era))
-> Tx l era -> Identity (Tx l 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 l era -> Identity (TxBody l era))
 -> Tx l era -> Identity (Tx l era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody l era -> Identity (TxBody l era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL
      ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx l era -> Identity (Tx l era))
-> StrictSeq (TxOut era) -> Tx l era -> Tx l era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [TxOut era] -> StrictSeq (TxOut era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
            (KeyPair Payment -> KeyPair Staking -> Addr
forall p s.
(MakeCredential p Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair Payment
examplePayKey KeyPair Staking
exampleStakeKey)
            (Int -> MaryValue
exampleMultiAssetValue Int
1)
            TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Datum era -> Identity (Datum era))
-> TxOut era -> Identity (TxOut era)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut era) (Datum era)
datumTxOutL ((Datum era -> Identity (Datum era))
 -> TxOut era -> Identity (TxOut era))
-> Datum era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData Data era
forall era. Era era => Data era
exampleDatum)
            TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
3)
        , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
            (KeyPair Payment -> KeyPair Staking -> Addr
forall p s.
(MakeCredential p Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair Payment
examplePayKey KeyPair Staking
exampleStakeKey)
            (Int -> MaryValue
exampleMultiAssetValue Int
2)
            TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Datum era -> Identity (Datum era))
-> TxOut era -> Identity (TxOut era)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut era) (Datum era)
datumTxOutL ((Datum era -> Identity (Datum era))
 -> TxOut era -> Identity (TxOut era))
-> Datum era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData Data era
forall era. Era era => Data era
exampleDatum)
            TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
3)
        , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
            (KeyPair Payment -> KeyPair Staking -> Addr
forall p s.
(MakeCredential p Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair Payment
examplePayKey KeyPair Staking
exampleStakeKey)
            (Int -> MaryValue
exampleMultiAssetValue Int
3)
            TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript NativeScript era
forall era. ShelleyEraScript era => NativeScript era
exampleShelleyScript)
        ]

exampleCollateralOutput ::
  ( BabbageEraTxOut era
  , Value era ~ MaryValue
  ) =>
  TxOut era
exampleCollateralOutput :: forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
TxOut era
exampleCollateralOutput =
  Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
    (KeyPair Payment -> KeyPair Staking -> Addr
forall p s.
(MakeCredential p Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair Payment
examplePayKey KeyPair Staking
exampleStakeKey)
    (Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
8675309) MultiAsset
forall a. Monoid a => a
mempty)