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

module Test.Cardano.Ledger.Babbage.Examples (
  ledgerExamples,
  mkBabbageBasedExampleTx,
  exampleBabbageBasedTxBody,
  exampleBabbageNewEpochState,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose (..))
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.Sequence.Strict as StrictSeq
import Lens.Micro
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceeds)
import Test.Cardano.Ledger.Alonzo.Examples (
  exampleAlonzoBasedShelleyTxBody,
  exampleAlonzoBasedTxBody,
  exampleDatum,
  mkAlonzoBasedExampleTx,
  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 (..),
  exampleNewEpochState,
  examplePayKey,
  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
    ( TxBody TopTx BabbageEra
-> PlutusPurpose AsIx BabbageEra -> Tx TopTx BabbageEra
forall era.
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
mkBabbageBasedExampleTx
        TxBody TopTx BabbageEra
forall era.
(BabbageEraTxBody era, ShelleyEraTxBody era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
TxBody TopTx era
exampleBabbageBasedShelleyTxBody
        (AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx BabbageEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx BabbageEra)
-> AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx BabbageEra
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0)
    )
    TranslationContext BabbageEra
NoGenesis BabbageEra
forall era. NoGenesis era
NoGenesis

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))

mkBabbageBasedExampleTx ::
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraTxAuxData era
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  ) =>
  TxBody TopTx era ->
  PlutusPurpose AsIx era ->
  Tx TopTx era
mkBabbageBasedExampleTx :: forall era.
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
mkBabbageBasedExampleTx TxBody TopTx era
txBody PlutusPurpose AsIx era
scriptPurpose =
  TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
forall era.
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era) =>
TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
mkAlonzoBasedExampleTx TxBody TopTx era
txBody PlutusPurpose AsIx era
scriptPurpose
    Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx 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 TopTx era -> Identity (Tx TopTx era))
-> TxWits era -> Tx TopTx era -> Tx TopTx 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 s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptHash -> Script era -> Map ScriptHash (Script era)
forall k a. k -> a -> Map k a
Map.singleton
                  (forall era. EraScript era => Script era -> ScriptHash
hashScript @era (Script era -> ScriptHash) -> Script era -> ScriptHash
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
3)
                  (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
3)
          )
    Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData era)
 -> Identity (StrictMaybe (TxAuxData era)))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
auxDataTxL
      ((StrictMaybe (TxAuxData era)
  -> Identity (StrictMaybe (TxAuxData era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> (StrictMaybe (TxAuxData era) -> StrictMaybe (TxAuxData era))
-> Tx TopTx era
-> Tx TopTx era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TxAuxData era -> TxAuxData era)
-> StrictMaybe (TxAuxData era) -> StrictMaybe (TxAuxData era)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \TxAuxData era
auxData ->
            TxAuxData era
auxData
              TxAuxData era -> (TxAuxData era -> TxAuxData era) -> TxAuxData era
forall a b. a -> (a -> b) -> b
& (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)
-> TxAuxData era
-> TxAuxData era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Language
-> NonEmpty PlutusBinary -> Map Language (NonEmpty PlutusBinary)
forall k a. k -> a -> Map k a
Map.singleton 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)))
        )

exampleBabbageBasedShelleyTxBody ::
  forall era.
  ( BabbageEraTxBody era
  , ShelleyEraTxBody era
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  TxBody TopTx era
exampleBabbageBasedShelleyTxBody :: forall era.
(BabbageEraTxBody era, ShelleyEraTxBody era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 Value era ~ MaryValue) =>
TxBody TopTx era
exampleBabbageBasedShelleyTxBody =
  TxBody TopTx era -> TxBody TopTx era
forall era.
(BabbageEraTxBody era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
TxBody TopTx era -> TxBody TopTx era
mkBabbageBasedExampleTxBody TxBody TopTx era
forall era.
(AlonzoEraTxBody era, ShelleyEraTxBody era,
 Value era ~ MaryValue) =>
TxBody TopTx era
exampleAlonzoBasedShelleyTxBody

exampleBabbageBasedTxBody ::
  forall era.
  ( BabbageEraTxBody era
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  , Value era ~ MaryValue
  ) =>
  TxBody TopTx era
exampleBabbageBasedTxBody :: forall era.
(BabbageEraTxBody era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, Value era ~ MaryValue) =>
TxBody TopTx era
exampleBabbageBasedTxBody =
  TxBody TopTx era -> TxBody TopTx era
forall era.
(BabbageEraTxBody era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
TxBody TopTx era -> TxBody TopTx era
mkBabbageBasedExampleTxBody TxBody TopTx era
forall era.
(AlonzoEraTxBody era, Value era ~ MaryValue) =>
TxBody TopTx era
exampleAlonzoBasedTxBody

mkBabbageBasedExampleTxBody ::
  forall era.
  ( BabbageEraTxBody era
  , Value era ~ MaryValue
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  ) =>
  TxBody TopTx era ->
  TxBody TopTx era
mkBabbageBasedExampleTxBody :: forall era.
(BabbageEraTxBody era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era) =>
TxBody TopTx era -> TxBody TopTx era
mkBabbageBasedExampleTxBody TxBody TopTx era
txBody =
  TxBody TopTx era
txBody
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx era -> Identity (TxBody TopTx 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))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Set TxIn -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
exampleTxIns
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx 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)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictSeq (TxOut era) -> TxBody TopTx era -> TxBody TopTx 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
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) -- inline datum
            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) -- inline datum
            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)
        ]
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (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)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictMaybe (TxOut era) -> TxBody TopTx era -> TxBody 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
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (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))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictMaybe Coin -> TxBody TopTx era -> TxBody 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)

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)