{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# 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.Dijkstra.Examples (
  ledgerExamples,
  exampleDijkstraBasedTopTx,
  exampleDijkstraBasedSubTx,
) where

import Cardano.Ledger.Address (DirectDeposits (..))
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
import Cardano.Ledger.BaseTypes (
  Exclusive (..),
  Inclusive (..),
  Network (..),
  StrictMaybe (..),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Rules (ConwayDelegPredFailure (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra (ApplyTxError (..), DijkstraEra)
import qualified Cardano.Ledger.Dijkstra.Rules as Dijkstra
import Cardano.Ledger.Dijkstra.Scripts (
  AccountBalanceInterval (..),
  AccountBalanceIntervals (..),
  DijkstraEraScript,
  pattern GuardingPurpose,
 )
import Cardano.Ledger.Dijkstra.TxBody (
  DijkstraEraTxBody,
  accountBalanceIntervalsTxBodyL,
  directDepositsTxBodyL,
  guardsTxBodyL,
  requiredTopLevelGuardsL,
  subTransactionsTxBodyL,
 )
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Cardano.Ledger.Plutus.Data (
  Data (..),
  Datum (..),
  dataToBinaryData,
 )
import Cardano.Ledger.Plutus.Language (Language (..), plutusBinary)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.MapExtras as Map
import qualified Data.OMap.Strict as OMap
import qualified Data.OSet.Strict as OSet
import qualified Data.Sequence.Strict as StrictSeq
import Lens.Micro ((%~), (&), (.~), (<>~))
import qualified PlutusLedgerApi.Common as P
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceeds)
import Test.Cardano.Ledger.Alonzo.Examples (
  exampleDatum,
  mkAlonzoBasedLedgerExamples,
 )
import Test.Cardano.Ledger.Babbage.Examples (exampleBabbageNewEpochState)
import Test.Cardano.Ledger.Conway.Examples (exampleConwayBasedTopTx, exampleConwayBasedTx)
import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
import Test.Cardano.Ledger.Dijkstra.ImpTest (exampleDijkstraGenesis)
import Test.Cardano.Ledger.Mary.Examples (exampleMultiAssetValue)
import Test.Cardano.Ledger.Plutus (alwaysSucceedsPlutus)
import Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples (..),
  addShelleyBasedTopTxExampleFee,
  examplePayKey,
  exampleStakeKey,
  mkKeyHash,
  mkScriptHash,
 )

ledgerExamples :: LedgerExamples DijkstraEra
ledgerExamples :: LedgerExamples DijkstraEra
ledgerExamples =
  ApplyTxError DijkstraEra
-> NewEpochState DijkstraEra
-> Tx TopTx DijkstraEra
-> TranslationContext DijkstraEra
-> LedgerExamples DijkstraEra
forall era.
AlonzoEraPParams era =>
ApplyTxError era
-> NewEpochState era
-> Tx TopTx era
-> TranslationContext era
-> LedgerExamples era
mkAlonzoBasedLedgerExamples
    ( NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
 -> ApplyTxError DijkstraEra)
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
forall a b. (a -> b) -> a -> b
$
        DijkstraMempoolPredFailure DijkstraEra
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DijkstraMempoolPredFailure DijkstraEra
 -> NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
-> DijkstraMempoolPredFailure DijkstraEra
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> DijkstraMempoolPredFailure era
Dijkstra.LedgerFailure (PredicateFailure (EraRule "LEDGER" DijkstraEra)
 -> DijkstraMempoolPredFailure DijkstraEra)
-> PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> DijkstraMempoolPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
            ConwayDelegPredFailure DijkstraEra
-> EraRuleFailure "LEDGER" DijkstraEra
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure DijkstraEra
 -> EraRuleFailure "LEDGER" DijkstraEra)
-> ConwayDelegPredFailure DijkstraEra
-> EraRuleFailure "LEDGER" DijkstraEra
forall a b. (a -> b) -> a -> b
$
              KeyHash StakePool -> ConwayDelegPredFailure DijkstraEra
forall era. KeyHash StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
    )
    NewEpochState DijkstraEra
forall era.
(BabbageEraTest era, Value era ~ MaryValue) =>
NewEpochState era
exampleBabbageNewEpochState
    Tx TopTx DijkstraEra
exampleDijkstraTx
    TranslationContext DijkstraEra
DijkstraGenesis
exampleDijkstraGenesis
  where
    exampleDijkstraTx :: Tx TopTx DijkstraEra
    exampleDijkstraTx :: Tx TopTx DijkstraEra
exampleDijkstraTx =
      Tx TopTx DijkstraEra
forall era.
(AlonzoEraTx era, DijkstraEraTxBody era, Value era ~ MaryValue,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era,
 EraPlutusTxInfo 'PlutusV4 era, AlonzoEraTxAuxData era) =>
Tx TopTx era
exampleDijkstraBasedTopTx
        Tx TopTx DijkstraEra
-> (Tx TopTx DijkstraEra -> Tx TopTx DijkstraEra)
-> Tx TopTx DijkstraEra
forall a b. a -> (a -> b) -> b
& Tx TopTx DijkstraEra -> Tx TopTx DijkstraEra
forall era. EraTx era => Tx TopTx era -> Tx TopTx era
addShelleyBasedTopTxExampleFee

exampleDijkstraBasedTopTx ::
  forall era.
  ( AlonzoEraTx era
  , DijkstraEraTxBody era
  , Value era ~ MaryValue
  , DijkstraEraScript era
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  , EraPlutusTxInfo PlutusV3 era
  , EraPlutusTxInfo PlutusV4 era
  , AlonzoEraTxAuxData era
  ) =>
  Tx TopTx era
exampleDijkstraBasedTopTx :: forall era.
(AlonzoEraTx era, DijkstraEraTxBody era, Value era ~ MaryValue,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era,
 EraPlutusTxInfo 'PlutusV4 era, AlonzoEraTxAuxData era) =>
Tx TopTx era
exampleDijkstraBasedTopTx =
  Tx TopTx era
forall era.
(AlonzoEraTx era, ConwayEraTxBody era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era, Value era ~ MaryValue) =>
Tx TopTx era
exampleConwayBasedTopTx
    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, DijkstraEraTxBody era, AlonzoEraTxAuxData era,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV4 era, Value era ~ MaryValue) =>
Tx l era -> Tx l era
addDijkstraBasedTxFeatures
    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, DijkstraEraTxBody era, AlonzoEraTxAuxData era,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era,
 EraPlutusTxInfo 'PlutusV4 era, Value era ~ MaryValue) =>
Tx TopTx era -> Tx TopTx era
addDijkstraBasedTopTxFeatures

exampleDijkstraBasedSubTx ::
  forall era.
  ( AlonzoEraTx era
  , DijkstraEraTxBody era
  , Value era ~ MaryValue
  , DijkstraEraScript era
  , EraPlutusTxInfo PlutusV1 era
  , EraPlutusTxInfo PlutusV2 era
  , EraPlutusTxInfo PlutusV3 era
  , EraPlutusTxInfo PlutusV4 era
  , AlonzoEraTxAuxData era
  ) =>
  Tx SubTx era
exampleDijkstraBasedSubTx :: forall era.
(AlonzoEraTx era, DijkstraEraTxBody era, Value era ~ MaryValue,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era,
 EraPlutusTxInfo 'PlutusV4 era, AlonzoEraTxAuxData era) =>
Tx SubTx era
exampleDijkstraBasedSubTx =
  Tx SubTx era
forall era (l :: TxLevel).
(AlonzoEraTx era, ConwayEraTxBody era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era, Value era ~ MaryValue,
 Typeable l) =>
Tx l era
exampleConwayBasedTx
    Tx SubTx era -> (Tx SubTx era -> Tx SubTx era) -> Tx SubTx era
forall a b. a -> (a -> b) -> b
& Tx SubTx era -> Tx SubTx era
forall era (l :: TxLevel).
(AlonzoEraTx era, DijkstraEraTxBody era, AlonzoEraTxAuxData era,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV4 era, Value era ~ MaryValue) =>
Tx l era -> Tx l era
addDijkstraBasedTxFeatures
    Tx SubTx era -> (Tx SubTx era -> Tx SubTx era) -> Tx SubTx era
forall a b. a -> (a -> b) -> b
& Tx SubTx era -> Tx SubTx era
forall era.
(AlonzoEraTx era, DijkstraEraTxBody era) =>
Tx SubTx era -> Tx SubTx era
addDijkstraBasedSubTxFeatures

addDijkstraBasedTopTxFeatures ::
  forall era.
  ( AlonzoEraTx era
  , DijkstraEraTxBody era
  , AlonzoEraTxAuxData era
  , DijkstraEraScript era
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  , EraPlutusTxInfo 'PlutusV3 era
  , EraPlutusTxInfo 'PlutusV4 era
  , Value era ~ MaryValue
  ) =>
  Tx TopTx era ->
  Tx TopTx era
addDijkstraBasedTopTxFeatures :: forall era.
(AlonzoEraTx era, DijkstraEraTxBody era, AlonzoEraTxAuxData era,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era,
 EraPlutusTxInfo 'PlutusV4 era, Value era ~ MaryValue) =>
Tx TopTx era -> Tx TopTx era
addDijkstraBasedTopTxFeatures 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))
-> ((OMap TxId (Tx SubTx era)
     -> Identity (OMap TxId (Tx SubTx era)))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (OMap TxId (Tx SubTx era)
    -> Identity (OMap TxId (Tx SubTx era)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> OMap TxId (Tx SubTx era) -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tx SubTx era] -> OMap TxId (Tx SubTx era)
forall (f :: * -> *) k v.
(Foldable f, HasOKey k v) =>
f v -> OMap k v
OMap.fromFoldable [Tx SubTx era
forall era.
(AlonzoEraTx era, DijkstraEraTxBody era, Value era ~ MaryValue,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era,
 EraPlutusTxInfo 'PlutusV4 era, AlonzoEraTxAuxData era) =>
Tx SubTx era
exampleDijkstraBasedSubTx]

addDijkstraBasedSubTxFeatures ::
  forall era.
  ( AlonzoEraTx era
  , DijkstraEraTxBody era
  ) =>
  Tx SubTx era ->
  Tx SubTx era
addDijkstraBasedSubTxFeatures :: forall era.
(AlonzoEraTx era, DijkstraEraTxBody era) =>
Tx SubTx era -> Tx SubTx era
addDijkstraBasedSubTxFeatures Tx SubTx era
tx =
  Tx SubTx era
tx
    Tx SubTx era -> (Tx SubTx era -> Tx SubTx era) -> Tx SubTx era
forall a b. a -> (a -> b) -> b
& (TxBody SubTx era -> Identity (TxBody SubTx era))
-> Tx SubTx era -> Identity (Tx SubTx 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 SubTx era -> Identity (TxBody SubTx era))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> ((Map (Credential Guard) (StrictMaybe (Data era))
     -> Identity (Map (Credential Guard) (StrictMaybe (Data era))))
    -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> (Map (Credential Guard) (StrictMaybe (Data era))
    -> Identity (Map (Credential Guard) (StrictMaybe (Data era))))
-> Tx SubTx era
-> Identity (Tx SubTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential Guard) (StrictMaybe (Data era))
 -> Identity (Map (Credential Guard) (StrictMaybe (Data era))))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era.
DijkstraEraTxBody era =>
Lens'
  (TxBody SubTx era)
  (Map (Credential Guard) (StrictMaybe (Data era)))
Lens'
  (TxBody SubTx era)
  (Map (Credential Guard) (StrictMaybe (Data era)))
requiredTopLevelGuardsL
      ((Map (Credential Guard) (StrictMaybe (Data era))
  -> Identity (Map (Credential Guard) (StrictMaybe (Data era))))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> Map (Credential Guard) (StrictMaybe (Data era))
-> Tx SubTx era
-> Tx SubTx era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [(Credential Guard, StrictMaybe (Data era))]
-> Map (Credential Guard) (StrictMaybe (Data era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (KeyHash Guard -> Credential Guard
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Guard -> Credential Guard)
-> KeyHash Guard -> Credential Guard
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Guard
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
212, StrictMaybe (Data era)
forall a. StrictMaybe a
SNothing)
        , (ScriptHash -> Credential Guard
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential Guard) -> ScriptHash -> Credential Guard
forall a b. (a -> b) -> a -> b
$ Int -> ScriptHash
mkScriptHash Int
213, Data era -> StrictMaybe (Data era)
forall a. a -> StrictMaybe a
SJust (Data era -> StrictMaybe (Data era))
-> Data era -> StrictMaybe (Data era)
forall a b. (a -> b) -> a -> b
$ forall era. Era era => Data era
exampleDatum @era)
        ]

addDijkstraBasedTxFeatures ::
  forall era l.
  ( AlonzoEraTx era
  , DijkstraEraTxBody era
  , AlonzoEraTxAuxData era
  , DijkstraEraScript era
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV4 era
  , Value era ~ MaryValue
  ) =>
  Tx l era ->
  Tx l era
addDijkstraBasedTxFeatures :: forall era (l :: TxLevel).
(AlonzoEraTx era, DijkstraEraTxBody era, AlonzoEraTxAuxData era,
 DijkstraEraScript era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV4 era, Value era ~ MaryValue) =>
Tx l era -> Tx l era
addDijkstraBasedTxFeatures 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 @'PlutusV4 Natural
3]
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Redeemers era -> Identity (Redeemers era))
-> TxWits era -> Identity (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era -> Identity (Redeemers era))
 -> TxWits era -> Identity (TxWits era))
-> Redeemers era -> TxWits era -> TxWits era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Redeemers era
redeemers
          )
    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
PlutusV4
            (PlutusBinary -> NonEmpty PlutusBinary
forall a. a -> NonEmpty a
NE.singleton (Plutus 'PlutusV4 -> PlutusBinary
forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary (forall (l :: Language). Natural -> Plutus l
alwaysSucceedsPlutus @'PlutusV4 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))
-> ((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
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 @'PlutusV4 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))
-> ((OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
    -> TxBody l era -> Identity (TxBody l era))
-> (OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (OSet (Credential Guard))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (Credential Guard))
guardsTxBodyL
      ((OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
 -> Tx l era -> Identity (Tx l era))
-> OSet (Credential Guard) -> Tx l era -> Tx l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential Guard] -> OSet (Credential Guard)
forall a. Ord a => [a] -> OSet a
OSet.fromList
        [ KeyHash Guard -> Credential Guard
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Guard -> Credential Guard)
-> KeyHash Guard -> Credential Guard
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Guard
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
211
        , KeyHash Guard -> Credential Guard
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Guard -> Credential Guard)
-> KeyHash Guard -> Credential Guard
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Guard
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
212
        , ScriptHash -> Credential Guard
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential Guard) -> ScriptHash -> Credential Guard
forall a b. (a -> b) -> a -> b
$ Int -> ScriptHash
mkScriptHash Int
213
        ]
    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))
-> ((DirectDeposits -> Identity DirectDeposits)
    -> TxBody l era -> Identity (TxBody l era))
-> (DirectDeposits -> Identity DirectDeposits)
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirectDeposits -> Identity DirectDeposits)
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> Tx l era -> Identity (Tx l era))
-> DirectDeposits -> Tx l era -> Tx l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DirectDeposits
exampleDirectDeposits
    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))
-> ((AccountBalanceIntervals era
     -> Identity (AccountBalanceIntervals era))
    -> TxBody l era -> Identity (TxBody l era))
-> (AccountBalanceIntervals era
    -> Identity (AccountBalanceIntervals era))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> Tx l era -> Identity (Tx l era))
-> AccountBalanceIntervals era -> Tx l era -> Tx l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AccountBalanceIntervals era
forall era. AccountBalanceIntervals era
exampleAccountBalanceIntervals
  where
    redeemers :: Redeemers era
redeemers =
      Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Redeemers era
forall a b. (a -> b) -> a -> b
$
        [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (AsIx Word32 ScriptHash -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
DijkstraEraScript era =>
f Word32 ScriptHash -> PlutusPurpose f era
GuardingPurpose (AsIx Word32 ScriptHash -> PlutusPurpose AsIx era)
-> AsIx Word32 ScriptHash -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 ScriptHash
forall ix it. ix -> AsIx ix it
AsIx Word32
3, (Data era
redeemerData, Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000))
          ]
    redeemerData :: Data era
redeemerData = forall era. Era era => Data -> Data era
Data @era (Integer -> [Data] -> Data
P.Constr Integer
1 [[Data] -> Data
P.List [Integer -> Data
P.I Integer
1], [(Data, Data)] -> Data
P.Map [(Integer -> Data
P.I Integer
2, ByteString -> Data
P.B ByteString
"2")]])

exampleDirectDeposits :: DirectDeposits
exampleDirectDeposits :: DirectDeposits
exampleDirectDeposits =
  Map AccountAddress Coin -> DirectDeposits
DirectDeposits (Map AccountAddress Coin -> DirectDeposits)
-> Map AccountAddress Coin -> DirectDeposits
forall a b. (a -> b) -> a -> b
$
    AccountAddress -> Coin -> Map AccountAddress Coin
forall k a. k -> a -> Map k a
Map.singleton
      (Network -> AccountId -> AccountAddress
AccountAddress Network
Mainnet (Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> KeyHash Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
300))
      (Integer -> Coin
Coin Integer
1000000)

exampleAccountBalanceIntervals :: AccountBalanceIntervals era
exampleAccountBalanceIntervals :: forall era. AccountBalanceIntervals era
exampleAccountBalanceIntervals =
  Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals (Map AccountId (AccountBalanceInterval era)
 -> AccountBalanceIntervals era)
-> Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall a b. (a -> b) -> a -> b
$
    [(AccountId, AccountBalanceInterval era)]
-> Map AccountId (AccountBalanceInterval era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> KeyHash Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
400, Inclusive Coin -> AccountBalanceInterval era
forall era. Inclusive Coin -> AccountBalanceInterval era
AccountBalanceLowerBound (Coin -> Inclusive Coin
forall a. a -> Inclusive a
Inclusive (Coin -> Inclusive Coin) -> Coin -> Inclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
500))
      , (Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> KeyHash Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
401, Exclusive Coin -> AccountBalanceInterval era
forall era. Exclusive Coin -> AccountBalanceInterval era
AccountBalanceUpperBound (Coin -> Exclusive Coin
forall a. a -> Exclusive a
Exclusive (Coin -> Exclusive Coin) -> Coin -> Exclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10000))
      ,
        ( Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential Staking)
-> ScriptHash -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> ScriptHash
mkScriptHash Int
402
        , Inclusive Coin -> Exclusive Coin -> AccountBalanceInterval era
forall era.
Inclusive Coin -> Exclusive Coin -> AccountBalanceInterval era
AccountBalanceBothBounds (Coin -> Inclusive Coin
forall a. a -> Inclusive a
Inclusive (Coin -> Inclusive Coin) -> Coin -> Inclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100) (Coin -> Exclusive Coin
forall a. a -> Exclusive a
Exclusive (Coin -> Exclusive Coin) -> Coin -> Exclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
        )
      ]