-- | This module provides the description of a transaction skeleton. We have our
-- own representation of a transaction for three main reasons:
--
-- - our transaction skeletons are typed (datums, validators, outputs...)
--
-- - with our own wrapper, we are less affected by plutus updates
--
-- - we can have default or automated behavior for the parts of the transactions
-- that are less relevant to testing, such as collaterals or fees
module Cooked.Skeleton
  ( LabelConstrs,
    TxLabel (..),
    BalanceOutputPolicy (..),
    FeePolicy (..),
    BalancingPolicy (..),
    BalancingUtxos (..),
    RawModTx (..),
    EmulatorParamsModification (..),
    CollateralUtxos (..),
    AnchorResolution (..),
    applyEmulatorParamsModification,
    applyRawModOnBalancedTx,
    TxOpts (..),
    txOptEnsureMinAdaL,
    txOptUnsafeModTxL,
    txOptAutoSlotIncreaseL,
    txOptBalancingPolicyL,
    txOptBalanceOutputPolicyL,
    txOptFeePolicyL,
    txOptBalancingUtxosL,
    txOptEmulatorParamsModificationL,
    txOptCollateralUtxosL,
    txOptAnchorResolutionL,
    txOptAutoReferenceScriptsL,
    TxSkelMints,
    addToTxSkelMints,
    txSkelMintsToList,
    txSkelMintsFromList,
    txSkelMintsFromList',
    txSkelMintsValue,
    txSkelOutValueL,
    txSkelOutDatumL,
    txSkelOutValue,
    txSkelOutValidator,
    TxSkelOutDatumConstrs,
    TxSkelOutDatum (..),
    TxSkelOut (..),
    txSkelOutTypedDatum,
    txSkelOutUntypedDatum,
    paysPK,
    paysScript,
    paysScriptInlineDatum,
    paysScriptUnresolvedDatumHash,
    paysScriptNoDatum,
    withDatum,
    withInlineDatum,
    withUnresolvedDatumHash,
    withReferenceScript,
    withStakingCredential,
    TxSkelRedeemer (..),
    Redeemer (..),
    withReferenceInput,
    TxParameterChange (..),
    TxGovAction (..),
    TxSkelProposal (..),
    txSkelProposalsL,
    txSkelProposalAddressL,
    txSkelProposalActionL,
    txSkelProposalWitnessL,
    txSkelProposalAnchorL,
    TxSkelWithdrawals,
    txSkelWithdrawnValue,
    txSkelWithdrawalsScripts,
    pkWithdrawal,
    scriptWithdrawal,
    TxSkel (..),
    txSkelLabelL,
    txSkelOptsL,
    txSkelMintsL,
    txSkelValidityRangeL,
    txSkelSignersL,
    txSkelInsL,
    txSkelInsReferenceL,
    txSkelOutsL,
    txSkelWithdrawalsL,
    txSkelTemplate,
    txSkelDataInOutputs,
    txSkelValidatorsInOutputs,
    txSkelOutOwnerTypeP,
    txSkelOutputDatumTypeAT,
    SkelContext (..),
    txSkelKnownTxOutRefs,
    simpleTxSkelProposal,
    withWitness,
    withAnchor,
    txSkelValueInOutputs,
    txSkelReferenceScripts,
    txSkelReferenceTxOutRefs,
    someTxSkelRedeemer,
    emptyTxSkelRedeemer,
  )
where

import Cardano.Api qualified as Cardano
import Cardano.Node.Emulator qualified as Emulator
import Control.Monad
import Cooked.Conversion
import Cooked.Output
import Cooked.Pretty.Class
import Cooked.Wallet
import Data.ByteString (ByteString)
import Data.Default
import Data.Either
import Data.Either.Combinators
import Data.Function
import Data.List (foldl')
import Data.List.NonEmpty qualified as NEList
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Map.NonEmpty (NEMap)
import Data.Map.NonEmpty qualified as NEMap
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Ledger.Slot qualified as Ledger
import Optics.Core
import Optics.TH
import Plutus.Script.Utils.Ada qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import Plutus.Script.Utils.Typed qualified as Script hiding (validatorHash)
import Plutus.Script.Utils.Value qualified as Script hiding (adaSymbol, adaToken)
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Prelude qualified as PlutusTx
import Test.QuickCheck (NonZero (..))
import Type.Reflection

-- * Transaction labels

type LabelConstrs x = (PrettyCooked x, Show x, Typeable x, Eq x, Ord x)

data TxLabel where
  TxLabel :: (LabelConstrs x) => x -> TxLabel

instance Eq TxLabel where
  TxLabel
a == :: TxLabel -> TxLabel -> Bool
== TxLabel
x = TxLabel -> TxLabel -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TxLabel
a TxLabel
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Show TxLabel where
  show :: TxLabel -> String
show (TxLabel x
x) = x -> String
forall a. Show a => a -> String
show x
x

instance PrettyCooked TxLabel where
  prettyCookedOpt :: PrettyCookedOpts -> TxLabel -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (TxLabel x
x) = PrettyCookedOpts -> x -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts x
x

instance Ord TxLabel where
  compare :: TxLabel -> TxLabel -> Ordering
compare (TxLabel x
a) (TxLabel x
x) =
    case SomeTypeRep -> SomeTypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeRep x -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
a)) (TypeRep x -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
x)) of
      Ordering
LT -> Ordering
LT
      Ordering
GT -> Ordering
GT
      Ordering
EQ -> case x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
a TypeRep x -> TypeRep x -> Maybe (x :~~: x)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
x of
        Just x :~~: x
HRefl -> x -> x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare x
a x
x
x
        -- This can never happen, since 'eqTypeRep' is implemented in terms of
        -- '==' on the type representation:
        Maybe (x :~~: x)
Nothing -> String -> Ordering
forall a. HasCallStack => String -> a
error String
"Type representations compare as EQ, but are not eqTypeRep"

-- * Transaction options

-- | What fee policy to use in the transaction.
data FeePolicy
  = -- | Use automatic fee computation. If balancing is activated, an optimal
    -- fee will be computed based on the transaction and existing utxos in the
    -- balancing wallet. Otherwise, the maximum transaction fee will be applied.
    AutoFeeComputation
  | -- | Provide a fee to the transaction. If the autobalancing is activated, it
    -- will be attempted around this fee, which might lead to failure if it is
    -- too low, otherwise, this fee will be given to transaction generation.
    ManualFee Integer
  deriving (FeePolicy -> FeePolicy -> Bool
(FeePolicy -> FeePolicy -> Bool)
-> (FeePolicy -> FeePolicy -> Bool) -> Eq FeePolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeePolicy -> FeePolicy -> Bool
== :: FeePolicy -> FeePolicy -> Bool
$c/= :: FeePolicy -> FeePolicy -> Bool
/= :: FeePolicy -> FeePolicy -> Bool
Eq, Eq FeePolicy
Eq FeePolicy =>
(FeePolicy -> FeePolicy -> Ordering)
-> (FeePolicy -> FeePolicy -> Bool)
-> (FeePolicy -> FeePolicy -> Bool)
-> (FeePolicy -> FeePolicy -> Bool)
-> (FeePolicy -> FeePolicy -> Bool)
-> (FeePolicy -> FeePolicy -> FeePolicy)
-> (FeePolicy -> FeePolicy -> FeePolicy)
-> Ord FeePolicy
FeePolicy -> FeePolicy -> Bool
FeePolicy -> FeePolicy -> Ordering
FeePolicy -> FeePolicy -> FeePolicy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FeePolicy -> FeePolicy -> Ordering
compare :: FeePolicy -> FeePolicy -> Ordering
$c< :: FeePolicy -> FeePolicy -> Bool
< :: FeePolicy -> FeePolicy -> Bool
$c<= :: FeePolicy -> FeePolicy -> Bool
<= :: FeePolicy -> FeePolicy -> Bool
$c> :: FeePolicy -> FeePolicy -> Bool
> :: FeePolicy -> FeePolicy -> Bool
$c>= :: FeePolicy -> FeePolicy -> Bool
>= :: FeePolicy -> FeePolicy -> Bool
$cmax :: FeePolicy -> FeePolicy -> FeePolicy
max :: FeePolicy -> FeePolicy -> FeePolicy
$cmin :: FeePolicy -> FeePolicy -> FeePolicy
min :: FeePolicy -> FeePolicy -> FeePolicy
Ord, Int -> FeePolicy -> ShowS
[FeePolicy] -> ShowS
FeePolicy -> String
(Int -> FeePolicy -> ShowS)
-> (FeePolicy -> String)
-> ([FeePolicy] -> ShowS)
-> Show FeePolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeePolicy -> ShowS
showsPrec :: Int -> FeePolicy -> ShowS
$cshow :: FeePolicy -> String
show :: FeePolicy -> String
$cshowList :: [FeePolicy] -> ShowS
showList :: [FeePolicy] -> ShowS
Show)

instance Default FeePolicy where
  def :: FeePolicy
def = FeePolicy
AutoFeeComputation

-- | Whether to adjust a potentially existing output to the balancing wallet
-- with the change during transaction balancing.
data BalanceOutputPolicy
  = -- | Try to adjust an existing public key output with the change. If no
    -- suitable output can be found, create a new change output.
    AdjustExistingOutput
  | -- | Do not change the existing outputs, always create a new change output.
    DontAdjustExistingOutput
  deriving (BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
(BalanceOutputPolicy -> BalanceOutputPolicy -> Bool)
-> (BalanceOutputPolicy -> BalanceOutputPolicy -> Bool)
-> Eq BalanceOutputPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
== :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
$c/= :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
/= :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
Eq, Eq BalanceOutputPolicy
Eq BalanceOutputPolicy =>
(BalanceOutputPolicy -> BalanceOutputPolicy -> Ordering)
-> (BalanceOutputPolicy -> BalanceOutputPolicy -> Bool)
-> (BalanceOutputPolicy -> BalanceOutputPolicy -> Bool)
-> (BalanceOutputPolicy -> BalanceOutputPolicy -> Bool)
-> (BalanceOutputPolicy -> BalanceOutputPolicy -> Bool)
-> (BalanceOutputPolicy
    -> BalanceOutputPolicy -> BalanceOutputPolicy)
-> (BalanceOutputPolicy
    -> BalanceOutputPolicy -> BalanceOutputPolicy)
-> Ord BalanceOutputPolicy
BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
BalanceOutputPolicy -> BalanceOutputPolicy -> Ordering
BalanceOutputPolicy -> BalanceOutputPolicy -> BalanceOutputPolicy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BalanceOutputPolicy -> BalanceOutputPolicy -> Ordering
compare :: BalanceOutputPolicy -> BalanceOutputPolicy -> Ordering
$c< :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
< :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
$c<= :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
<= :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
$c> :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
> :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
$c>= :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
>= :: BalanceOutputPolicy -> BalanceOutputPolicy -> Bool
$cmax :: BalanceOutputPolicy -> BalanceOutputPolicy -> BalanceOutputPolicy
max :: BalanceOutputPolicy -> BalanceOutputPolicy -> BalanceOutputPolicy
$cmin :: BalanceOutputPolicy -> BalanceOutputPolicy -> BalanceOutputPolicy
min :: BalanceOutputPolicy -> BalanceOutputPolicy -> BalanceOutputPolicy
Ord, Int -> BalanceOutputPolicy -> ShowS
[BalanceOutputPolicy] -> ShowS
BalanceOutputPolicy -> String
(Int -> BalanceOutputPolicy -> ShowS)
-> (BalanceOutputPolicy -> String)
-> ([BalanceOutputPolicy] -> ShowS)
-> Show BalanceOutputPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalanceOutputPolicy -> ShowS
showsPrec :: Int -> BalanceOutputPolicy -> ShowS
$cshow :: BalanceOutputPolicy -> String
show :: BalanceOutputPolicy -> String
$cshowList :: [BalanceOutputPolicy] -> ShowS
showList :: [BalanceOutputPolicy] -> ShowS
Show)

instance Default BalanceOutputPolicy where
  def :: BalanceOutputPolicy
def = BalanceOutputPolicy
AdjustExistingOutput

-- | Which UTxOs to use when balancing. Note that utxos that are already known
-- by the skeleton being balanced (in the sense of `txSkelKnownTxOutRefs`,
-- i.e. inputs and reference inputs) will be filtered out during balancing.
data BalancingUtxos
  = -- | Use all UTxOs containing only a Value (no datum, no staking credential,
    -- and no reference script) belonging to the balancing wallet.
    BalancingUtxosFromBalancingWallet
  | -- | Use the provided UTxOs. UTxOs belonging to scripts will be filtered out
    BalancingUtxosFromSet (Set Api.TxOutRef)
  deriving (BalancingUtxos -> BalancingUtxos -> Bool
(BalancingUtxos -> BalancingUtxos -> Bool)
-> (BalancingUtxos -> BalancingUtxos -> Bool) -> Eq BalancingUtxos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalancingUtxos -> BalancingUtxos -> Bool
== :: BalancingUtxos -> BalancingUtxos -> Bool
$c/= :: BalancingUtxos -> BalancingUtxos -> Bool
/= :: BalancingUtxos -> BalancingUtxos -> Bool
Eq, Eq BalancingUtxos
Eq BalancingUtxos =>
(BalancingUtxos -> BalancingUtxos -> Ordering)
-> (BalancingUtxos -> BalancingUtxos -> Bool)
-> (BalancingUtxos -> BalancingUtxos -> Bool)
-> (BalancingUtxos -> BalancingUtxos -> Bool)
-> (BalancingUtxos -> BalancingUtxos -> Bool)
-> (BalancingUtxos -> BalancingUtxos -> BalancingUtxos)
-> (BalancingUtxos -> BalancingUtxos -> BalancingUtxos)
-> Ord BalancingUtxos
BalancingUtxos -> BalancingUtxos -> Bool
BalancingUtxos -> BalancingUtxos -> Ordering
BalancingUtxos -> BalancingUtxos -> BalancingUtxos
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BalancingUtxos -> BalancingUtxos -> Ordering
compare :: BalancingUtxos -> BalancingUtxos -> Ordering
$c< :: BalancingUtxos -> BalancingUtxos -> Bool
< :: BalancingUtxos -> BalancingUtxos -> Bool
$c<= :: BalancingUtxos -> BalancingUtxos -> Bool
<= :: BalancingUtxos -> BalancingUtxos -> Bool
$c> :: BalancingUtxos -> BalancingUtxos -> Bool
> :: BalancingUtxos -> BalancingUtxos -> Bool
$c>= :: BalancingUtxos -> BalancingUtxos -> Bool
>= :: BalancingUtxos -> BalancingUtxos -> Bool
$cmax :: BalancingUtxos -> BalancingUtxos -> BalancingUtxos
max :: BalancingUtxos -> BalancingUtxos -> BalancingUtxos
$cmin :: BalancingUtxos -> BalancingUtxos -> BalancingUtxos
min :: BalancingUtxos -> BalancingUtxos -> BalancingUtxos
Ord, Int -> BalancingUtxos -> ShowS
[BalancingUtxos] -> ShowS
BalancingUtxos -> String
(Int -> BalancingUtxos -> ShowS)
-> (BalancingUtxos -> String)
-> ([BalancingUtxos] -> ShowS)
-> Show BalancingUtxos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalancingUtxos -> ShowS
showsPrec :: Int -> BalancingUtxos -> ShowS
$cshow :: BalancingUtxos -> String
show :: BalancingUtxos -> String
$cshowList :: [BalancingUtxos] -> ShowS
showList :: [BalancingUtxos] -> ShowS
Show)

instance Default BalancingUtxos where
  def :: BalancingUtxos
def = BalancingUtxos
BalancingUtxosFromBalancingWallet

-- | Whether to balance the transaction or not, and which wallet to use to
-- provide outputs for balancing. Either the first signer or an explicit
-- wallet. In the second case, this wallet must be a signer of the transaction.
data BalancingPolicy
  = BalanceWithFirstSigner
  | BalanceWith Wallet
  | DoNotBalance
  deriving (BalancingPolicy -> BalancingPolicy -> Bool
(BalancingPolicy -> BalancingPolicy -> Bool)
-> (BalancingPolicy -> BalancingPolicy -> Bool)
-> Eq BalancingPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalancingPolicy -> BalancingPolicy -> Bool
== :: BalancingPolicy -> BalancingPolicy -> Bool
$c/= :: BalancingPolicy -> BalancingPolicy -> Bool
/= :: BalancingPolicy -> BalancingPolicy -> Bool
Eq, Eq BalancingPolicy
Eq BalancingPolicy =>
(BalancingPolicy -> BalancingPolicy -> Ordering)
-> (BalancingPolicy -> BalancingPolicy -> Bool)
-> (BalancingPolicy -> BalancingPolicy -> Bool)
-> (BalancingPolicy -> BalancingPolicy -> Bool)
-> (BalancingPolicy -> BalancingPolicy -> Bool)
-> (BalancingPolicy -> BalancingPolicy -> BalancingPolicy)
-> (BalancingPolicy -> BalancingPolicy -> BalancingPolicy)
-> Ord BalancingPolicy
BalancingPolicy -> BalancingPolicy -> Bool
BalancingPolicy -> BalancingPolicy -> Ordering
BalancingPolicy -> BalancingPolicy -> BalancingPolicy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BalancingPolicy -> BalancingPolicy -> Ordering
compare :: BalancingPolicy -> BalancingPolicy -> Ordering
$c< :: BalancingPolicy -> BalancingPolicy -> Bool
< :: BalancingPolicy -> BalancingPolicy -> Bool
$c<= :: BalancingPolicy -> BalancingPolicy -> Bool
<= :: BalancingPolicy -> BalancingPolicy -> Bool
$c> :: BalancingPolicy -> BalancingPolicy -> Bool
> :: BalancingPolicy -> BalancingPolicy -> Bool
$c>= :: BalancingPolicy -> BalancingPolicy -> Bool
>= :: BalancingPolicy -> BalancingPolicy -> Bool
$cmax :: BalancingPolicy -> BalancingPolicy -> BalancingPolicy
max :: BalancingPolicy -> BalancingPolicy -> BalancingPolicy
$cmin :: BalancingPolicy -> BalancingPolicy -> BalancingPolicy
min :: BalancingPolicy -> BalancingPolicy -> BalancingPolicy
Ord, Int -> BalancingPolicy -> ShowS
[BalancingPolicy] -> ShowS
BalancingPolicy -> String
(Int -> BalancingPolicy -> ShowS)
-> (BalancingPolicy -> String)
-> ([BalancingPolicy] -> ShowS)
-> Show BalancingPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalancingPolicy -> ShowS
showsPrec :: Int -> BalancingPolicy -> ShowS
$cshow :: BalancingPolicy -> String
show :: BalancingPolicy -> String
$cshowList :: [BalancingPolicy] -> ShowS
showList :: [BalancingPolicy] -> ShowS
Show)

instance Default BalancingPolicy where
  def :: BalancingPolicy
def = BalancingPolicy
BalanceWithFirstSigner

-- | Wraps a function that will be applied to a transaction right before
-- submission, and after balancing.
newtype RawModTx
  = RawModTxAfterBalancing (Cardano.Tx Cardano.ConwayEra -> Cardano.Tx Cardano.ConwayEra)

-- This instance always returns @False@, which is no problem, because 'Eq
-- TxSkel' is only used for tests that never depend on this comparison
instance Eq RawModTx where
  RawModTx
_ == :: RawModTx -> RawModTx -> Bool
== RawModTx
_ = Bool
False

instance Show RawModTx where
  show :: RawModTx -> String
show (RawModTxAfterBalancing Tx ConwayEra -> Tx ConwayEra
_) = String
"RawModTxAfterBalancing"

-- | Applies a list of modifications right before the transaction is
-- submitted. The leftmost function in the argument list is applied first.
applyRawModOnBalancedTx :: [RawModTx] -> Cardano.Tx Cardano.ConwayEra -> Cardano.Tx Cardano.ConwayEra
applyRawModOnBalancedTx :: [RawModTx] -> Tx ConwayEra -> Tx ConwayEra
applyRawModOnBalancedTx = ((Tx ConwayEra -> Tx ConwayEra)
 -> RawModTx -> Tx ConwayEra -> Tx ConwayEra)
-> (Tx ConwayEra -> Tx ConwayEra)
-> [RawModTx]
-> Tx ConwayEra
-> Tx ConwayEra
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Tx ConwayEra -> Tx ConwayEra
acc (RawModTxAfterBalancing Tx ConwayEra -> Tx ConwayEra
f) -> Tx ConwayEra -> Tx ConwayEra
acc (Tx ConwayEra -> Tx ConwayEra)
-> (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra -> Tx ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx ConwayEra -> Tx ConwayEra
f) Tx ConwayEra -> Tx ConwayEra
forall a. a -> a
id

-- | Wraps a function that will temporarily change the emulator parameters for
-- the transaction's balancing and submission.
newtype EmulatorParamsModification = EmulatorParamsModification (Emulator.Params -> Emulator.Params)

-- This instance always returns @False@, which is no problem, because 'Eq
-- TxSkel' is only used for tests that never depend on this comparison
instance Eq EmulatorParamsModification where
  EmulatorParamsModification
_ == :: EmulatorParamsModification -> EmulatorParamsModification -> Bool
== EmulatorParamsModification
_ = Bool
False

instance Show EmulatorParamsModification where
  show :: EmulatorParamsModification -> String
show EmulatorParamsModification {} = String
"EmulatorParamsModification <function>"

applyEmulatorParamsModification :: Maybe EmulatorParamsModification -> Emulator.Params -> Emulator.Params
applyEmulatorParamsModification :: Maybe EmulatorParamsModification -> Params -> Params
applyEmulatorParamsModification (Just (EmulatorParamsModification Params -> Params
f)) = Params -> Params
f
applyEmulatorParamsModification Maybe EmulatorParamsModification
Nothing = Params -> Params
forall a. a -> a
id

-- | Describe which UTxOs to use as collaterals
data CollateralUtxos
  = -- | Rely on automated computation with only-value UTxOs from the balancing
    -- wallet. Return collaterals will be sent to this wallet.
    CollateralUtxosFromBalancingWallet
  | -- | Rely on automated computation with only-value UTxOs from a given
    -- wallet. Return collaterals will be sent to this wallet.
    CollateralUtxosFromWallet Wallet
  | -- | Manually provide a set of candidate UTxOs to be used as collaterals
    -- alongside a wallet to send return collaterals back to.
    CollateralUtxosFromSet (Set Api.TxOutRef) Wallet
  deriving (CollateralUtxos -> CollateralUtxos -> Bool
(CollateralUtxos -> CollateralUtxos -> Bool)
-> (CollateralUtxos -> CollateralUtxos -> Bool)
-> Eq CollateralUtxos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollateralUtxos -> CollateralUtxos -> Bool
== :: CollateralUtxos -> CollateralUtxos -> Bool
$c/= :: CollateralUtxos -> CollateralUtxos -> Bool
/= :: CollateralUtxos -> CollateralUtxos -> Bool
Eq, Int -> CollateralUtxos -> ShowS
[CollateralUtxos] -> ShowS
CollateralUtxos -> String
(Int -> CollateralUtxos -> ShowS)
-> (CollateralUtxos -> String)
-> ([CollateralUtxos] -> ShowS)
-> Show CollateralUtxos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollateralUtxos -> ShowS
showsPrec :: Int -> CollateralUtxos -> ShowS
$cshow :: CollateralUtxos -> String
show :: CollateralUtxos -> String
$cshowList :: [CollateralUtxos] -> ShowS
showList :: [CollateralUtxos] -> ShowS
Show)

instance Default CollateralUtxos where
  def :: CollateralUtxos
def = CollateralUtxos
CollateralUtxosFromBalancingWallet

-- | Describes how to resolve anchors in proposal procedures
data AnchorResolution
  = -- | Provide a map between urls and page content as Bytestring
    AnchorResolutionLocal (Map String ByteString)
  | -- | Allow online fetch of pages from a given URL. Important note: using
    -- this option is unsafe, as it requires a web connection and inherently
    -- prevents guarantees of reproducibily. Use at your own discretion.
    AnchorResolutionHttp
  deriving (AnchorResolution -> AnchorResolution -> Bool
(AnchorResolution -> AnchorResolution -> Bool)
-> (AnchorResolution -> AnchorResolution -> Bool)
-> Eq AnchorResolution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnchorResolution -> AnchorResolution -> Bool
== :: AnchorResolution -> AnchorResolution -> Bool
$c/= :: AnchorResolution -> AnchorResolution -> Bool
/= :: AnchorResolution -> AnchorResolution -> Bool
Eq, Int -> AnchorResolution -> ShowS
[AnchorResolution] -> ShowS
AnchorResolution -> String
(Int -> AnchorResolution -> ShowS)
-> (AnchorResolution -> String)
-> ([AnchorResolution] -> ShowS)
-> Show AnchorResolution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnchorResolution -> ShowS
showsPrec :: Int -> AnchorResolution -> ShowS
$cshow :: AnchorResolution -> String
show :: AnchorResolution -> String
$cshowList :: [AnchorResolution] -> ShowS
showList :: [AnchorResolution] -> ShowS
Show)

instance Default AnchorResolution where
  def :: AnchorResolution
def = Map String ByteString -> AnchorResolution
AnchorResolutionLocal Map String ByteString
forall k a. Map k a
Map.empty

-- | Set of options to modify the behavior of generating and validating some
-- transaction.
data TxOpts = TxOpts
  { -- | Performs an adjustment to unbalanced transactions, making sure every
    -- UTxO that is produced has the necessary minimum amount of Ada.
    --
    -- Default is @False@.
    TxOpts -> Bool
txOptEnsureMinAda :: Bool,
    -- | Whether to increase the slot counter automatically on transaction
    -- submission.  This is useful for modelling transactions that could be
    -- submitted in parallel in reality, so there should be no explicit ordering
    -- of what comes first.
    --
    -- Default is @True@.
    TxOpts -> Bool
txOptAutoSlotIncrease :: Bool,
    -- | Applies an arbitrary modification to a transaction after it has been
    -- potentially adjusted ('txOptEnsureMinAda') and balanced. The name of this
    -- option contains /unsafe/ to draw attention to the fact that modifying a
    -- transaction at that stage might make it invalid. Still, this offers a
    -- hook for being able to alter a transaction in unforeseen ways. It is
    -- mostly used to test contracts that have been written for custom PABs.
    --
    -- One interesting use of this function is to observe a transaction just
    -- before it is being sent for validation, with
    --
    -- > txOptUnsafeModTx = [RawModTxAfterBalancing Debug.Trace.traceShowId]
    --
    -- The leftmost function in the list is applied first.
    --
    -- Default is @[]@.
    TxOpts -> [RawModTx]
txOptUnsafeModTx :: [RawModTx],
    -- | Whether to balance the transaction or not, and which wallet should
    -- provide/reclaim the missing and surplus value. Balancing ensures that
    --
    -- > input + mints == output + fees + burns
    --
    -- If you decide to set @txOptBalance = DoNotBalance@ you will have trouble
    -- satisfying that equation by hand unless you use @ManualFee@. You will
    -- likely see a error about value preservation.
    --
    -- Default is 'BalanceWithFirstSigner'
    TxOpts -> BalancingPolicy
txOptBalancingPolicy :: BalancingPolicy,
    -- | The fee to use when balancing the transaction
    --
    -- Default is 'AutomaticFeeComputation'
    TxOpts -> FeePolicy
txOptFeePolicy :: FeePolicy,
    -- | The 'BalanceOutputPolicy' to apply when balancing the transaction.
    --
    -- Default is 'AdjustExistingOutput'.
    TxOpts -> BalanceOutputPolicy
txOptBalanceOutputPolicy :: BalanceOutputPolicy,
    -- | Which UTxOs to use during balancing. This can either be a precise list,
    -- or rely on automatic searches for utxos with values only belonging to the
    -- balancing wallet.
    --
    -- Default is 'BalancingUtxosFromBalancingWallet'.
    TxOpts -> BalancingUtxos
txOptBalancingUtxos :: BalancingUtxos,
    -- | Apply an arbitrary modification to the protocol parameters that are
    -- used to balance and submit the transaction. This is obviously a very
    -- unsafe thing to do if you want to preserve compatibility with the actual
    -- chain. It is useful mainly for testing purposes, when you might want to
    -- use extremely big transactions or transactions that exhaust the maximum
    -- execution budget. Such a thing could be accomplished with
    --
    -- > txOptEmulatorParamsModification = Just $ EmulatorParamsModification increaseTransactionLimits
    --
    -- for example.
    --
    -- Default is 'Nothing'.
    TxOpts -> Maybe EmulatorParamsModification
txOptEmulatorParamsModification :: Maybe EmulatorParamsModification,
    -- | Which utxos to use as collaterals. They can be given manually, or
    -- computed automatically from a given, or the balancing, wallet.
    --
    -- Default is 'CollateralUtxosFromBalancingWallet'
    TxOpts -> CollateralUtxos
txOptCollateralUtxos :: CollateralUtxos,
    -- | How to resolve anchor in proposal procedures
    --
    -- Default is 'AnchorResolutionLocal Map.Empty'
    TxOpts -> AnchorResolution
txOptAnchorResolution :: AnchorResolution,
    -- | Whether to automatically fill up reference inputs in redeemers when
    -- they contain the right reference script. This will imply going through
    -- all the known utxos with reference scripts and compare their hashes, thus
    -- will slightly reduce performance.
    --
    -- Defaut is 'False'.
    TxOpts -> Bool
txOptAutoReferenceScripts :: Bool
  }
  deriving (TxOpts -> TxOpts -> Bool
(TxOpts -> TxOpts -> Bool)
-> (TxOpts -> TxOpts -> Bool) -> Eq TxOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxOpts -> TxOpts -> Bool
== :: TxOpts -> TxOpts -> Bool
$c/= :: TxOpts -> TxOpts -> Bool
/= :: TxOpts -> TxOpts -> Bool
Eq, Int -> TxOpts -> ShowS
[TxOpts] -> ShowS
TxOpts -> String
(Int -> TxOpts -> ShowS)
-> (TxOpts -> String) -> ([TxOpts] -> ShowS) -> Show TxOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxOpts -> ShowS
showsPrec :: Int -> TxOpts -> ShowS
$cshow :: TxOpts -> String
show :: TxOpts -> String
$cshowList :: [TxOpts] -> ShowS
showList :: [TxOpts] -> ShowS
Show)

makeLensesFor
  [ ("txOptEnsureMinAda", "txOptEnsureMinAdaL"),
    ("txOptAutoSlotIncrease", "txOptAutoSlotIncreaseL"),
    ("txOptUnsafeModTx", "txOptUnsafeModTxL"),
    ("txOptBalancingPolicy", "txOptBalancingPolicyL"),
    ("txOptFeePolicy", "txOptFeePolicyL"),
    ("txOptBalanceOutputPolicy", "txOptBalanceOutputPolicyL"),
    ("txOptBalancingUtxos", "txOptBalancingUtxosL"),
    ("txOptEmulatorParamsModification", "txOptEmulatorParamsModificationL"),
    ("txOptCollateralUtxos", "txOptCollateralUtxosL"),
    ("txOptAnchorResolution", "txOptAnchorResolutionL"),
    ("txOptAutoReferenceScripts", "txOptAutoReferenceScriptsL")
  ]
  ''TxOpts

instance Default TxOpts where
  def :: TxOpts
def =
    TxOpts
      { txOptEnsureMinAda :: Bool
txOptEnsureMinAda = Bool
False,
        txOptAutoSlotIncrease :: Bool
txOptAutoSlotIncrease = Bool
True,
        txOptUnsafeModTx :: [RawModTx]
txOptUnsafeModTx = [],
        txOptBalancingPolicy :: BalancingPolicy
txOptBalancingPolicy = BalancingPolicy
forall a. Default a => a
def,
        txOptBalanceOutputPolicy :: BalanceOutputPolicy
txOptBalanceOutputPolicy = BalanceOutputPolicy
forall a. Default a => a
def,
        txOptFeePolicy :: FeePolicy
txOptFeePolicy = FeePolicy
forall a. Default a => a
def,
        txOptBalancingUtxos :: BalancingUtxos
txOptBalancingUtxos = BalancingUtxos
forall a. Default a => a
def,
        txOptEmulatorParamsModification :: Maybe EmulatorParamsModification
txOptEmulatorParamsModification = Maybe EmulatorParamsModification
forall a. Maybe a
Nothing,
        txOptCollateralUtxos :: CollateralUtxos
txOptCollateralUtxos = CollateralUtxos
forall a. Default a => a
def,
        txOptAnchorResolution :: AnchorResolution
txOptAnchorResolution = AnchorResolution
forall a. Default a => a
def,
        txOptAutoReferenceScripts :: Bool
txOptAutoReferenceScripts = Bool
False
      }

-- * Redeemers for transaction inputs

type RedeemerConstrs redeemer =
  ( Api.ToData redeemer,
    Show redeemer,
    PrettyCooked redeemer,
    PlutusTx.Eq redeemer,
    Typeable redeemer
  )

data Redeemer where
  EmptyRedeemer :: Redeemer
  SomeRedeemer :: (RedeemerConstrs redeemer) => redeemer -> Redeemer

deriving instance (Show Redeemer)

instance Eq Redeemer where
  Redeemer
EmptyRedeemer == :: Redeemer -> Redeemer -> Bool
== Redeemer
EmptyRedeemer = Bool
True
  (SomeRedeemer redeemer
r1) == (SomeRedeemer redeemer
r2) =
    case redeemer -> TypeRep redeemer
forall a. Typeable a => a -> TypeRep a
typeOf redeemer
r1 TypeRep redeemer
-> TypeRep redeemer -> Maybe (redeemer :~~: redeemer)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` redeemer -> TypeRep redeemer
forall a. Typeable a => a -> TypeRep a
typeOf redeemer
r2 of
      Just redeemer :~~: redeemer
HRefl -> redeemer
r1 redeemer -> redeemer -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== redeemer
redeemer
r2
      Maybe (redeemer :~~: redeemer)
Nothing -> Bool
False
  Redeemer
_ == Redeemer
_ = Bool
False

data TxSkelRedeemer = TxSkelRedeemer
  { TxSkelRedeemer -> Redeemer
txSkelRedeemer :: Redeemer,
    -- An optional input containing a reference script
    TxSkelRedeemer -> Maybe TxOutRef
txSkelReferenceInput :: Maybe Api.TxOutRef
  }
  deriving (Int -> TxSkelRedeemer -> ShowS
[TxSkelRedeemer] -> ShowS
TxSkelRedeemer -> String
(Int -> TxSkelRedeemer -> ShowS)
-> (TxSkelRedeemer -> String)
-> ([TxSkelRedeemer] -> ShowS)
-> Show TxSkelRedeemer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSkelRedeemer -> ShowS
showsPrec :: Int -> TxSkelRedeemer -> ShowS
$cshow :: TxSkelRedeemer -> String
show :: TxSkelRedeemer -> String
$cshowList :: [TxSkelRedeemer] -> ShowS
showList :: [TxSkelRedeemer] -> ShowS
Show, TxSkelRedeemer -> TxSkelRedeemer -> Bool
(TxSkelRedeemer -> TxSkelRedeemer -> Bool)
-> (TxSkelRedeemer -> TxSkelRedeemer -> Bool) -> Eq TxSkelRedeemer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
== :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
$c/= :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
/= :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
Eq)

-- Two helpers to create skeleton redeemers
someTxSkelRedeemer :: (RedeemerConstrs redeemer) => redeemer -> TxSkelRedeemer
someTxSkelRedeemer :: forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> TxSkelRedeemer
someTxSkelRedeemer redeemer
a = Redeemer -> Maybe TxOutRef -> TxSkelRedeemer
TxSkelRedeemer (redeemer -> Redeemer
forall a. RedeemerConstrs a => a -> Redeemer
SomeRedeemer redeemer
a) Maybe TxOutRef
forall a. Maybe a
Nothing

emptyTxSkelRedeemer :: TxSkelRedeemer
emptyTxSkelRedeemer :: TxSkelRedeemer
emptyTxSkelRedeemer = Redeemer -> Maybe TxOutRef -> TxSkelRedeemer
TxSkelRedeemer Redeemer
EmptyRedeemer Maybe TxOutRef
forall a. Maybe a
Nothing

-- Additional helper to specify a given reference input. As reference inputs are
-- automatically attached during transaction generation when they contain the
-- right scripts by default, there are only 3 cases where this can be useful:
-- - The reliance on a reference script needs to be made explicit
-- - A wrong reference script somehow needs to be attached
-- - The automated attachement of reference inputs has been disabled using the
-- `txOptAutoReferenceScripts` option

withReferenceInput :: TxSkelRedeemer -> Api.TxOutRef -> TxSkelRedeemer
withReferenceInput :: TxSkelRedeemer -> TxOutRef -> TxSkelRedeemer
withReferenceInput TxSkelRedeemer
red TxOutRef
ref = TxSkelRedeemer
red {txSkelReferenceInput = Just ref}

-- * Description of the Governance actions (or proposal procedures)

-- These are all the protocol parameters. They are taken from
-- https://github.com/IntersectMBO/cardano-ledger/blob/c4fbc05999866fea7c0cb1b211fd5288f286b95d/eras/conway/impl/cddl-files/conway.cddl#L381-L412
-- and will most likely change in future eras.
data TxParameterChange where
  -- | The linear factor for the minimum fee calculation
  FeePerByte :: Integer -> TxParameterChange
  -- | The constant factor for the minimum fee calculation
  FeeFixed :: Integer -> TxParameterChange
  -- | Maximal block body size
  MaxBlockBodySize :: Integer -> TxParameterChange
  -- | Maximal transaction size
  MaxTxSize :: Integer -> TxParameterChange
  -- | Maximal block header size
  MaxBlockHeaderSize :: Integer -> TxParameterChange
  -- | The amount of a key registration deposit
  KeyDeposit :: Integer -> TxParameterChange
  -- | The amount of a pool registration deposit
  PoolDeposit :: Integer -> TxParameterChange
  -- | Maximum number of epochs in the future a pool retirement is allowed to
  -- be scheduled future for.
  PoolRetirementMaxEpoch :: Integer -> TxParameterChange
  -- | Desired number of pools
  PoolNumber :: Integer -> TxParameterChange
  -- | Pool influence
  PoolInfluence :: Rational -> TxParameterChange
  -- | Monetary expansion
  MonetaryExpansion :: Rational -> TxParameterChange
  -- | Treasury expansion
  TreasuryCut :: Rational -> TxParameterChange
  -- | Minimum Stake Pool Cost
  MinPoolCost :: Integer -> TxParameterChange
  -- | Cost in lovelace per byte of UTxO storage
  CoinsPerUTxOByte :: Integer -> TxParameterChange
  -- | Cost models for non-native script languages
  CostModels ::
    { TxParameterChange -> [Integer]
cmPlutusV1Costs :: [Integer],
      TxParameterChange -> [Integer]
cmPlutusV2Costs :: [Integer],
      TxParameterChange -> [Integer]
cmPlutusV3Costs :: [Integer]
    } ->
    TxParameterChange
  -- | Prices of execution units
  Prices ::
    { TxParameterChange -> Rational
pMemoryCost :: Rational,
      TxParameterChange -> Rational
pStepCost :: Rational
    } ->
    TxParameterChange
  -- | Max total script execution resources units allowed per tx
  MaxTxExUnits ::
    { TxParameterChange -> Integer
mteuMemory :: Integer,
      TxParameterChange -> Integer
mteuSteps :: Integer
    } ->
    TxParameterChange
  -- | Max total script execution resources units allowed per block
  MaxBlockExUnits ::
    { TxParameterChange -> Integer
mbeuMemory :: Integer,
      TxParameterChange -> Integer
mbeuSteps :: Integer
    } ->
    TxParameterChange
  -- | Max size of a Value in an output
  MaxValSize :: Integer -> TxParameterChange
  -- | Percentage of the txfee which must be provided as collateral when
  -- including non-native scripts.
  CollateralPercentage :: Integer -> TxParameterChange
  -- | Maximum number of collateral inputs allowed in a transaction
  MaxCollateralInputs :: Integer -> TxParameterChange
  -- | Thresholds for pool votes
  PoolVotingThresholds ::
    { TxParameterChange -> Rational
pvtMotionNoConfidence :: Rational,
      TxParameterChange -> Rational
pvtCommitteeNormal :: Rational,
      TxParameterChange -> Rational
pvtCommitteeNoConfidence :: Rational,
      TxParameterChange -> Rational
pvtHardFork :: Rational,
      TxParameterChange -> Rational
pvtSecurityGroup :: Rational
    } ->
    TxParameterChange
  -- | Thresholds for DRep votes
  DRepVotingThresholds ::
    { TxParameterChange -> Rational
drvtMotionNoConfidence :: Rational,
      TxParameterChange -> Rational
drvtCommitteeNormal :: Rational,
      TxParameterChange -> Rational
drvtCommitteeNoConfidence :: Rational,
      TxParameterChange -> Rational
drvtUpdateConstitution :: Rational,
      TxParameterChange -> Rational
drvtHardForkInitialization :: Rational,
      TxParameterChange -> Rational
drvtNetworkGroup :: Rational,
      TxParameterChange -> Rational
drvtEconomicGroup :: Rational,
      TxParameterChange -> Rational
drvtTechnicalGroup :: Rational,
      TxParameterChange -> Rational
drvtGovernanceGroup :: Rational,
      TxParameterChange -> Rational
drvtTreasuryWithdrawal :: Rational
    } ->
    TxParameterChange
  -- | Minimum size of the Constitutional Committee
  CommitteeMinSize :: Integer -> TxParameterChange
  -- | The Constitutional Committee Term limit in number of Slots
  CommitteeMaxTermLength :: Integer -> TxParameterChange
  -- | Gov action lifetime in number of Epochs
  GovActionLifetime :: Integer -> TxParameterChange
  -- | The amount of the Gov Action deposit
  GovActionDeposit :: Integer -> TxParameterChange
  -- | The amount of a DRep registration deposit
  DRepRegistrationDeposit :: Integer -> TxParameterChange
  -- | The number of Epochs that a DRep can perform no activity without losing
  -- their @Active@ status.
  DRepActivity :: Integer -> TxParameterChange
  -- Reference scripts fee for the minimum fee calculation
  -- will exist later on MinFeeRefScriptCostPerByte :: Integer -> TxParameterChange
  deriving (Int -> TxParameterChange -> ShowS
[TxParameterChange] -> ShowS
TxParameterChange -> String
(Int -> TxParameterChange -> ShowS)
-> (TxParameterChange -> String)
-> ([TxParameterChange] -> ShowS)
-> Show TxParameterChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxParameterChange -> ShowS
showsPrec :: Int -> TxParameterChange -> ShowS
$cshow :: TxParameterChange -> String
show :: TxParameterChange -> String
$cshowList :: [TxParameterChange] -> ShowS
showList :: [TxParameterChange] -> ShowS
Show, TxParameterChange -> TxParameterChange -> Bool
(TxParameterChange -> TxParameterChange -> Bool)
-> (TxParameterChange -> TxParameterChange -> Bool)
-> Eq TxParameterChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxParameterChange -> TxParameterChange -> Bool
== :: TxParameterChange -> TxParameterChange -> Bool
$c/= :: TxParameterChange -> TxParameterChange -> Bool
/= :: TxParameterChange -> TxParameterChange -> Bool
Eq)

data TxGovAction where
  -- If several parameter changes are of the same kind, only the last
  -- one will take effect
  TxGovActionParameterChange :: [TxParameterChange] -> TxGovAction
  TxGovActionHardForkInitiation :: Api.ProtocolVersion -> TxGovAction
  TxGovActionTreasuryWithdrawals :: Map Api.Credential Api.Lovelace -> TxGovAction
  TxGovActionNoConfidence :: TxGovAction
  TxGovActionUpdateCommittee :: [Api.ColdCommitteeCredential] -> Map Api.ColdCommitteeCredential Integer -> PlutusTx.Rational -> TxGovAction
  TxGovActionNewConstitution :: Api.Constitution -> TxGovAction
  deriving (Int -> TxGovAction -> ShowS
[TxGovAction] -> ShowS
TxGovAction -> String
(Int -> TxGovAction -> ShowS)
-> (TxGovAction -> String)
-> ([TxGovAction] -> ShowS)
-> Show TxGovAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxGovAction -> ShowS
showsPrec :: Int -> TxGovAction -> ShowS
$cshow :: TxGovAction -> String
show :: TxGovAction -> String
$cshowList :: [TxGovAction] -> ShowS
showList :: [TxGovAction] -> ShowS
Show, TxGovAction -> TxGovAction -> Bool
(TxGovAction -> TxGovAction -> Bool)
-> (TxGovAction -> TxGovAction -> Bool) -> Eq TxGovAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxGovAction -> TxGovAction -> Bool
== :: TxGovAction -> TxGovAction -> Bool
$c/= :: TxGovAction -> TxGovAction -> Bool
/= :: TxGovAction -> TxGovAction -> Bool
Eq)

data TxSkelProposal where
  TxSkelProposal ::
    { -- | Whatever credential will get back the deposit
      TxSkelProposal -> Address
txSkelProposalAddress :: Api.Address,
      -- | The proposed action
      TxSkelProposal -> TxGovAction
txSkelProposalAction :: TxGovAction,
      -- | An optional script (typically the constitution script) to witness the
      -- proposal and validate it. Only parameter changes and treasury
      -- withdrawals can be subject to such a validation and transactions will
      -- not pass validation phase 1 if other actions are given a witness.
      TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalWitness :: Maybe (Script.Versioned Script.Script, TxSkelRedeemer),
      -- | An optional anchor to be given as additional data. It should
      -- correspond to the URL of a web page
      TxSkelProposal -> Maybe String
txSkelProposalAnchor :: Maybe String
    } ->
    TxSkelProposal
  deriving (Int -> TxSkelProposal -> ShowS
[TxSkelProposal] -> ShowS
TxSkelProposal -> String
(Int -> TxSkelProposal -> ShowS)
-> (TxSkelProposal -> String)
-> ([TxSkelProposal] -> ShowS)
-> Show TxSkelProposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSkelProposal -> ShowS
showsPrec :: Int -> TxSkelProposal -> ShowS
$cshow :: TxSkelProposal -> String
show :: TxSkelProposal -> String
$cshowList :: [TxSkelProposal] -> ShowS
showList :: [TxSkelProposal] -> ShowS
Show, TxSkelProposal -> TxSkelProposal -> Bool
(TxSkelProposal -> TxSkelProposal -> Bool)
-> (TxSkelProposal -> TxSkelProposal -> Bool) -> Eq TxSkelProposal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSkelProposal -> TxSkelProposal -> Bool
== :: TxSkelProposal -> TxSkelProposal -> Bool
$c/= :: TxSkelProposal -> TxSkelProposal -> Bool
/= :: TxSkelProposal -> TxSkelProposal -> Bool
Eq)

makeLensesFor
  [ ("txSkelProposalAddress", "txSkelProposalAddressL"),
    ("txSkelProposalAction", "txSkelProposalActionL"),
    ("txSkelProposalWitness", "txSkelProposalWitnessL"),
    ("txSkelProposalAnchor", "txSkelProposalAnchorL")
  ]
  ''TxSkelProposal

simpleTxSkelProposal :: (ToAddress a) => a -> TxGovAction -> TxSkelProposal
simpleTxSkelProposal :: forall a. ToAddress a => a -> TxGovAction -> TxSkelProposal
simpleTxSkelProposal a
a TxGovAction
govAction = Address
-> TxGovAction
-> Maybe (Versioned Script, TxSkelRedeemer)
-> Maybe String
-> TxSkelProposal
TxSkelProposal (a -> Address
forall a. ToAddress a => a -> Address
toAddress a
a) TxGovAction
govAction Maybe (Versioned Script, TxSkelRedeemer)
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

withWitness :: (ToVersionedScript a) => TxSkelProposal -> (a, TxSkelRedeemer) -> TxSkelProposal
withWitness :: forall a.
ToVersionedScript a =>
TxSkelProposal -> (a, TxSkelRedeemer) -> TxSkelProposal
withWitness TxSkelProposal
prop (a
s, TxSkelRedeemer
red) = TxSkelProposal
prop {txSkelProposalWitness = Just (toVersionedScript s, red)}

withAnchor :: TxSkelProposal -> String -> TxSkelProposal
withAnchor :: TxSkelProposal -> String -> TxSkelProposal
withAnchor TxSkelProposal
prop String
url = TxSkelProposal
prop {txSkelProposalAnchor = Just url}

-- * Description of the Withdrawals

-- | Withdrawals associate either a script or a private key with a redeemer and
-- a certain amount of ada. Note that the redeemer will be ignored in the case
-- of a private key.
type TxSkelWithdrawals =
  Map
    (Either (Script.Versioned Script.Script) Api.PubKeyHash)
    (TxSkelRedeemer, Script.Ada)

txSkelWithdrawnValue :: TxSkel -> Api.Value
txSkelWithdrawnValue :: TxSkel -> Value
txSkelWithdrawnValue = [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat ([Value] -> Value) -> (TxSkel -> [Value]) -> TxSkel -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ada -> Value
forall a. ToValue a => a -> Value
toValue (Ada -> Value)
-> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
    -> Ada)
-> (Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSkelRedeemer, Ada) -> Ada
forall a b. (a, b) -> b
snd ((TxSkelRedeemer, Ada) -> Ada)
-> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
    -> (TxSkelRedeemer, Ada))
-> (Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
-> Ada
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
-> (TxSkelRedeemer, Ada)
forall a b. (a, b) -> b
snd ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
 -> Value)
-> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
-> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
 -> [Value])
-> (TxSkel
    -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))])
-> TxSkel
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
-> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
 -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))])
-> (TxSkel
    -> Map
         (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada))
-> TxSkel
-> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
txSkelWithdrawals

txSkelWithdrawalsScripts :: TxSkel -> [Script.Versioned Script.Script]
txSkelWithdrawalsScripts :: TxSkel -> [Versioned Script]
txSkelWithdrawalsScripts = ([Versioned Script], [PubKeyHash]) -> [Versioned Script]
forall a b. (a, b) -> a
fst (([Versioned Script], [PubKeyHash]) -> [Versioned Script])
-> (TxSkel -> ([Versioned Script], [PubKeyHash]))
-> TxSkel
-> [Versioned Script]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (Versioned Script) PubKeyHash]
-> ([Versioned Script], [PubKeyHash])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (Versioned Script) PubKeyHash]
 -> ([Versioned Script], [PubKeyHash]))
-> (TxSkel -> [Either (Versioned Script) PubKeyHash])
-> TxSkel
-> ([Versioned Script], [PubKeyHash])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
-> Either (Versioned Script) PubKeyHash
forall a b. (a, b) -> a
fst ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
 -> Either (Versioned Script) PubKeyHash)
-> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
-> [Either (Versioned Script) PubKeyHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
 -> [Either (Versioned Script) PubKeyHash])
-> (TxSkel
    -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))])
-> TxSkel
-> [Either (Versioned Script) PubKeyHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
-> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
 -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))])
-> (TxSkel
    -> Map
         (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada))
-> TxSkel
-> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
txSkelWithdrawals

pkWithdrawal :: (ToPubKeyHash pkh) => pkh -> Script.Ada -> TxSkelWithdrawals
pkWithdrawal :: forall pkh.
ToPubKeyHash pkh =>
pkh
-> Ada
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
pkWithdrawal pkh
pkh Ada
amount = Either (Versioned Script) PubKeyHash
-> (TxSkelRedeemer, Ada)
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
forall k a. k -> a -> Map k a
Map.singleton (PubKeyHash -> Either (Versioned Script) PubKeyHash
forall a b. b -> Either a b
Right (PubKeyHash -> Either (Versioned Script) PubKeyHash)
-> PubKeyHash -> Either (Versioned Script) PubKeyHash
forall a b. (a -> b) -> a -> b
$ pkh -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
toPubKeyHash pkh
pkh) (TxSkelRedeemer
emptyTxSkelRedeemer, Ada
amount)

scriptWithdrawal :: (ToVersionedScript script) => script -> TxSkelRedeemer -> Script.Ada -> TxSkelWithdrawals
scriptWithdrawal :: forall script.
ToVersionedScript script =>
script
-> TxSkelRedeemer
-> Ada
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
scriptWithdrawal script
script TxSkelRedeemer
red Ada
amount = Either (Versioned Script) PubKeyHash
-> (TxSkelRedeemer, Ada)
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
forall k a. k -> a -> Map k a
Map.singleton (Versioned Script -> Either (Versioned Script) PubKeyHash
forall a b. a -> Either a b
Left (Versioned Script -> Either (Versioned Script) PubKeyHash)
-> Versioned Script -> Either (Versioned Script) PubKeyHash
forall a b. (a -> b) -> a -> b
$ script -> Versioned Script
forall a. ToVersionedScript a => a -> Versioned Script
toVersionedScript script
script) (TxSkelRedeemer
red, Ada
amount)

-- * Description of the Minting

-- | A description of what a transaction mints. For every policy, there can only
-- be one 'TxSkelRedeemer', and if there is, there must be some token names, each
-- with a non-zero amount of tokens.
--
-- You'll probably not construct this by hand, but use 'txSkelMintsFromList'.
type TxSkelMints =
  Map
    (Script.Versioned Script.MintingPolicy)
    (TxSkelRedeemer, NEMap Api.TokenName (NonZero Integer))

-- | Combining 'TxSkelMints' in a sensible way. In particular, this means that
--
-- > Map.fromList [(pol, (red, NEMap.fromList [(tName, 1)]))]
--
-- and
--
-- > Map.fromList [(pol, (red', NEMap.fromList [(tName, -1)]))]
--
-- will combine to become the empty 'TxSkelMints' (and similar examples, where
-- the values add up to zero, see the comment at the definition of
-- 'addToTxSkelMints').
--
-- In every case, if you add mints with a different redeemer for the same
-- policy, the redeemer used in the right argument takes precedence.
instance {-# OVERLAPPING #-} Semigroup TxSkelMints where
  TxSkelMints
a <> :: TxSkelMints -> TxSkelMints -> TxSkelMints
<> TxSkelMints
b = (TxSkelMints
 -> (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
 -> TxSkelMints)
-> TxSkelMints
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
-> TxSkelMints
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
 -> TxSkelMints -> TxSkelMints)
-> TxSkelMints
-> (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
-> TxSkelMints
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
-> TxSkelMints -> TxSkelMints
addToTxSkelMints) TxSkelMints
a (TxSkelMints
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
txSkelMintsToList TxSkelMints
b)

instance {-# OVERLAPPING #-} Monoid TxSkelMints where
  mempty :: TxSkelMints
mempty = TxSkelMints
forall k a. Map k a
Map.empty

-- | Add a new entry to a 'TxSkelMints'. There are a few wrinkles:
--
-- (1) If for a given policy, redeemer, and token name, there are @n@ tokens in
-- the argument 'TxSkelMints', and you add @-n@ tokens, the corresponding entry
-- in the "inner map" of the policy will disappear (obviously, because all of
-- its values have to be non-zero). If that also means that the inner map
-- becomes empty, the policy will disappear from the 'TxSkelMints' altogether.
--
-- (2) If a policy is already present on the argument 'TxSkelMints' with a
-- redeemer @a@, and you add a mint with a different redeemer @b@, the old
-- redeemer is thrown away. The values associated with the token names of that
-- policy are added as described above, though. This means that any pre-existing
-- values will be minted with a new redeemer.
--
-- If, for some reason, you really want to generate a 'TxSkelMints' that has
-- both a negative and a positive entry of the same asset class and redeemer,
-- you'll have to do so manually. Note, however, that even if you do so, NO
-- VALIDATOR OR MINTING POLICY WILL EVER GET TO SEE A TRANSACTION WITH SUCH
-- CONFLICTING INFORMATION. This is not a design decision/limitation of
-- cooked-validators: The Cardano API 'TxBodyContent' type, that we're
-- translating everything into eventually, stores minting information as a
-- minted value together with a map from policy IDs to witnesses (which
-- represent the used redeemers). That means that we can only store _one_
-- redeemer per minting policy, and no conflicting mints of the same asset
-- class, since they'll just cancel.
addToTxSkelMints ::
  (Script.Versioned Script.MintingPolicy, TxSkelRedeemer, Api.TokenName, Integer) ->
  TxSkelMints ->
  TxSkelMints
addToTxSkelMints :: (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
-> TxSkelMints -> TxSkelMints
addToTxSkelMints (Versioned MintingPolicy
pol, TxSkelRedeemer
red, TokenName
tName, Integer
amount) TxSkelMints
mints
  | Integer
0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
amount = TxSkelMints
mints
  | Bool
otherwise = case TxSkelMints
mints TxSkelMints
-> Versioned MintingPolicy
-> Maybe (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Versioned MintingPolicy
pol of
      Maybe (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
Nothing ->
        -- The policy isn't yet in the given 'TxSkelMints', so we can just add a
        -- new entry:
        Versioned MintingPolicy
-> (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
-> TxSkelMints
-> TxSkelMints
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Versioned MintingPolicy
pol (TxSkelRedeemer
red, TokenName -> NonZero Integer -> NEMap TokenName (NonZero Integer)
forall k a. k -> a -> NEMap k a
NEMap.singleton TokenName
tName (Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero Integer
amount)) TxSkelMints
mints
      Just (TxSkelRedeemer
_oldRed, NEMap TokenName (NonZero Integer)
innerMap) ->
        -- Ignore the old redeemer: If it's the same as the new one, nothing
        -- will change, if not, the new redeemer will be kept.
        case NEMap TokenName (NonZero Integer)
innerMap NEMap TokenName (NonZero Integer)
-> TokenName -> Maybe (NonZero Integer)
forall k a. Ord k => NEMap k a -> k -> Maybe a
NEMap.!? TokenName
tName of
          Maybe (NonZero Integer)
Nothing ->
            -- The given token name has not yet occurred for the given
            -- policy. This means that we can just add the new tokens to the
            -- inner map:
            Versioned MintingPolicy
-> (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
-> TxSkelMints
-> TxSkelMints
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Versioned MintingPolicy
pol (TxSkelRedeemer
red, TokenName
-> NonZero Integer
-> NEMap TokenName (NonZero Integer)
-> NEMap TokenName (NonZero Integer)
forall k a. Ord k => k -> a -> NEMap k a -> NEMap k a
NEMap.insert TokenName
tName (Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero Integer
amount) NEMap TokenName (NonZero Integer)
innerMap) TxSkelMints
mints
          Just (NonZero Integer
oldAmount) ->
            let newAmount :: Integer
newAmount = Integer
oldAmount Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
amount
             in if Integer
newAmount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
                  then -- If the sum of the old amount of tokens and the
                  -- additional tokens is non-zero, we can just update the
                  -- amount in the inner map:
                    Versioned MintingPolicy
-> (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
-> TxSkelMints
-> TxSkelMints
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Versioned MintingPolicy
pol (TxSkelRedeemer
red, TokenName
-> NonZero Integer
-> NEMap TokenName (NonZero Integer)
-> NEMap TokenName (NonZero Integer)
forall k a. Ord k => k -> a -> NEMap k a -> NEMap k a
NEMap.insert TokenName
tName (Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero Integer
newAmount) NEMap TokenName (NonZero Integer)
innerMap) TxSkelMints
mints
                  else -- If the sum is zero, we'll have to delete the token
                  -- name from the inner map. If that yields a completely empty
                  -- inner map, we'll have to remove the entry altogether:
                  case Map TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall k a. Map k a -> Maybe (NEMap k a)
NEMap.nonEmptyMap (Map TokenName (NonZero Integer)
 -> Maybe (NEMap TokenName (NonZero Integer)))
-> Map TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a b. (a -> b) -> a -> b
$ TokenName
-> NEMap TokenName (NonZero Integer)
-> Map TokenName (NonZero Integer)
forall k a. Ord k => k -> NEMap k a -> Map k a
NEMap.delete TokenName
tName NEMap TokenName (NonZero Integer)
innerMap of
                    Maybe (NEMap TokenName (NonZero Integer))
Nothing -> Versioned MintingPolicy -> TxSkelMints -> TxSkelMints
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Versioned MintingPolicy
pol TxSkelMints
mints
                    Just NEMap TokenName (NonZero Integer)
newInnerMap -> Versioned MintingPolicy
-> (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
-> TxSkelMints
-> TxSkelMints
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Versioned MintingPolicy
pol (TxSkelRedeemer
red, NEMap TokenName (NonZero Integer)
newInnerMap) TxSkelMints
mints

-- | Convert from 'TxSkelMints' to a list of tuples describing eveything that's
-- being minted.
txSkelMintsToList :: TxSkelMints -> [(Script.Versioned Script.MintingPolicy, TxSkelRedeemer, Api.TokenName, Integer)]
txSkelMintsToList :: TxSkelMints
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
txSkelMintsToList =
  ((Versioned MintingPolicy,
  (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
 -> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)])
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    ( \(Versioned MintingPolicy
p, (TxSkelRedeemer
r, NEMap TokenName (NonZero Integer)
m)) ->
        (\(TokenName
t, NonZero Integer
n) -> (Versioned MintingPolicy
p, TxSkelRedeemer
r, TokenName
t, Integer
n))
          ((TokenName, NonZero Integer)
 -> (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer))
-> [(TokenName, NonZero Integer)]
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TokenName, NonZero Integer)
-> [(TokenName, NonZero Integer)]
forall a. NonEmpty a -> [a]
NEList.toList (NEMap TokenName (NonZero Integer)
-> NonEmpty (TokenName, NonZero Integer)
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toList NEMap TokenName (NonZero Integer)
m)
    )
    ([(Versioned MintingPolicy,
   (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
 -> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)])
-> (TxSkelMints
    -> [(Versioned MintingPolicy,
         (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))])
-> TxSkelMints
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelMints
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
forall k a. Map k a -> [(k, a)]
Map.toList

-- | Smart constructor for 'TxSkelMints'. This function relies on
-- 'addToTxSkelMints'. So, some non-empty lists (where all amounts for a given
-- asset class an redeemer add up to zero) might be translated into the empty
-- 'TxSkelMints'.
txSkelMintsFromList :: [(Script.Versioned Script.MintingPolicy, TxSkelRedeemer, Api.TokenName, Integer)] -> TxSkelMints
txSkelMintsFromList :: [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
-> TxSkelMints
txSkelMintsFromList = ((Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
 -> TxSkelMints -> TxSkelMints)
-> TxSkelMints
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
-> TxSkelMints
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
-> TxSkelMints -> TxSkelMints
addToTxSkelMints TxSkelMints
forall a. Monoid a => a
mempty

-- | Another smart constructor for 'TxSkelMints', where the redeemer and minting
-- policies are not duplicated.
txSkelMintsFromList' :: [(Script.Versioned Script.MintingPolicy, TxSkelRedeemer, [(Api.TokenName, Integer)])] -> TxSkelMints
txSkelMintsFromList' :: [(Versioned MintingPolicy, TxSkelRedeemer, [(TokenName, Integer)])]
-> TxSkelMints
txSkelMintsFromList' = [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
-> TxSkelMints
txSkelMintsFromList ([(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
 -> TxSkelMints)
-> ([(Versioned MintingPolicy, TxSkelRedeemer,
      [(TokenName, Integer)])]
    -> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)])
-> [(Versioned MintingPolicy, TxSkelRedeemer,
     [(TokenName, Integer)])]
-> TxSkelMints
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Versioned MintingPolicy, TxSkelRedeemer, [(TokenName, Integer)])
 -> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)])
-> [(Versioned MintingPolicy, TxSkelRedeemer,
     [(TokenName, Integer)])]
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Versioned MintingPolicy
mp, TxSkelRedeemer
r, [(TokenName, Integer)]
m) -> (\(TokenName
tn, Integer
i) -> (Versioned MintingPolicy
mp, TxSkelRedeemer
r, TokenName
tn, Integer
i)) ((TokenName, Integer)
 -> (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer))
-> [(TokenName, Integer)]
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TokenName, Integer)]
m)

-- | The value described by a 'TxSkelMints'
txSkelMintsValue :: TxSkelMints -> Api.Value
txSkelMintsValue :: TxSkelMints -> Value
txSkelMintsValue =
  Optic'
  A_Fold
  NoIx
  TxSkelMints
  (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
-> ((Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
    -> Value)
-> TxSkelMints
-> Value
forall k m (is :: IxList) s a.
(Is k A_Fold, Monoid m) =>
Optic' k is s a -> (a -> m) -> s -> m
foldMapOf
    ((TxSkelMints
 -> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)])
-> Getter
     TxSkelMints
     [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
forall s a. (s -> a) -> Getter s a
to TxSkelMints
-> [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
txSkelMintsToList Getter
  TxSkelMints
  [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
-> Optic
     A_Fold
     NoIx
     [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
     [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
     (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
     (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
-> Optic'
     A_Fold
     NoIx
     TxSkelMints
     (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Fold
  NoIx
  [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
  [(Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)]
  (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
  (Versioned MintingPolicy, TxSkelRedeemer, TokenName, Integer)
forall (f :: * -> *) a. Foldable f => Fold (f a) a
folded)
    ( \(Versioned MintingPolicy
policy, TxSkelRedeemer
_, TokenName
tName, Integer
amount) ->
        AssetClass -> Integer -> Value
Script.assetClassValue
          ( CurrencySymbol -> TokenName -> AssetClass
Script.assetClass
              (Versioned MintingPolicy -> CurrencySymbol
Script.scriptCurrencySymbol Versioned MintingPolicy
policy)
              TokenName
tName
          )
          Integer
amount
    )

-- * Transaction outputs

class IsTxSkelOutAllowedOwner a where
  toPKHOrValidator :: a -> Either Api.PubKeyHash (Script.Versioned Script.Validator)

instance IsTxSkelOutAllowedOwner Api.PubKeyHash where
  toPKHOrValidator :: PubKeyHash -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = PubKeyHash -> Either PubKeyHash (Versioned Validator)
forall a b. a -> Either a b
Left

instance IsTxSkelOutAllowedOwner (Script.TypedValidator a) where
  toPKHOrValidator :: TypedValidator a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator = Versioned Validator -> Either PubKeyHash (Versioned Validator)
forall a b. b -> Either a b
Right (Versioned Validator -> Either PubKeyHash (Versioned Validator))
-> (TypedValidator a -> Versioned Validator)
-> TypedValidator a
-> Either PubKeyHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypedValidator a -> Versioned Validator
forall a. TypedValidator a -> Versioned Validator
Script.tvValidator

-- | Transaction outputs. The 'Pays' constructor is really general, and you'll
-- probably want to use one of the smart constructors like 'paysScript' or
-- 'paysPK' in most cases.
data TxSkelOut where
  Pays ::
    ( Show o, -- This is needed only for the 'Show' instance of 'TxSkel', which
    -- in turn is only needed in tests.
      Typeable o,
      IsTxInfoOutput o,
      IsTxSkelOutAllowedOwner (OwnerType o),
      Typeable (OwnerType o),
      ToCredential (OwnerType o),
      DatumType o ~ TxSkelOutDatum,
      ValueType o ~ Api.Value, -- needed for the 'txSkelOutValueL'
      ToVersionedScript (ReferenceScriptType o),
      Show (OwnerType o),
      Show (ReferenceScriptType o),
      Typeable (ReferenceScriptType o)
    ) =>
    {()
producedOutput :: o} ->
    TxSkelOut

instance Eq TxSkelOut where
  Pays o
a == :: TxSkelOut -> TxSkelOut -> Bool
== Pays o
b = case o -> TypeRep o
forall a. Typeable a => a -> TypeRep a
typeOf o
a TypeRep o -> TypeRep o -> Maybe (o :~~: o)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` o -> TypeRep o
forall a. Typeable a => a -> TypeRep a
typeOf o
b of
    Just o :~~: o
HRefl -> o -> TxOut
forall o. IsTxInfoOutput o => o -> TxOut
outputTxOut o
a TxOut -> TxOut -> Bool
forall a. Eq a => a -> a -> Bool
== o -> TxOut
forall o. IsTxInfoOutput o => o -> TxOut
outputTxOut o
b
    Maybe (o :~~: o)
Nothing -> Bool
False

deriving instance Show TxSkelOut

txSkelOutDatumL :: Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL :: Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL =
  (TxSkelOut -> TxSkelOutDatum)
-> (TxSkelOut -> TxSkelOutDatum -> TxSkelOut)
-> Lens' TxSkelOut TxSkelOutDatum
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(Pays o
output) -> o
output o -> Optic' A_Lens NoIx o TxSkelOutDatum -> TxSkelOutDatum
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' o (DatumType o)
Optic' A_Lens NoIx o TxSkelOutDatum
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL)
    (\(Pays o
output) TxSkelOutDatum
newDatum -> o -> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (o -> TxSkelOut) -> o -> TxSkelOut
forall a b. (a -> b) -> a -> b
$ o
output o -> (o -> o) -> o
forall a b. a -> (a -> b) -> b
& Lens' o (DatumType o)
Optic A_Lens NoIx o o TxSkelOutDatum TxSkelOutDatum
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL Optic A_Lens NoIx o o TxSkelOutDatum TxSkelOutDatum
-> TxSkelOutDatum -> o -> o
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ TxSkelOutDatum
newDatum)

txSkelOutValueL :: Lens' TxSkelOut Api.Value
txSkelOutValueL :: Lens' TxSkelOut Value
txSkelOutValueL =
  (TxSkelOut -> Value)
-> (TxSkelOut -> Value -> TxSkelOut) -> Lens' TxSkelOut Value
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(Pays o
output) -> o -> Value
forall o. (IsAbstractOutput o, ToValue (ValueType o)) => o -> Value
outputValue o
output)
    (\(Pays o
output) Value
newValue -> o -> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (o -> TxSkelOut) -> o -> TxSkelOut
forall a b. (a -> b) -> a -> b
$ o
output o -> (o -> o) -> o
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx o o Value Value
Lens' o (ValueType o)
forall o. IsAbstractOutput o => Lens' o (ValueType o)
outputValueL Optic A_Lens NoIx o o Value Value -> Value -> o -> o
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Value
newValue)

txSkelOutValue :: TxSkelOut -> Api.Value
txSkelOutValue :: TxSkelOut -> Value
txSkelOutValue = (TxSkelOut -> Lens' TxSkelOut Value -> Value
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' TxSkelOut Value
txSkelOutValueL)

txSkelOutValidator :: TxSkelOut -> Maybe (Script.Versioned Script.Validator)
txSkelOutValidator :: TxSkelOut -> Maybe (Versioned Validator)
txSkelOutValidator (Pays o
output) = Either PubKeyHash (Versioned Validator)
-> Maybe (Versioned Validator)
forall a b. Either a b -> Maybe b
rightToMaybe (OwnerType o -> Either PubKeyHash (Versioned Validator)
forall a.
IsTxSkelOutAllowedOwner a =>
a -> Either PubKeyHash (Versioned Validator)
toPKHOrValidator (OwnerType o -> Either PubKeyHash (Versioned Validator))
-> OwnerType o -> Either PubKeyHash (Versioned Validator)
forall a b. (a -> b) -> a -> b
$ o
output o -> Optic' A_Lens NoIx o (OwnerType o) -> OwnerType o
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx o (OwnerType o)
forall o. IsAbstractOutput o => Lens' o (OwnerType o)
outputOwnerL)

type TxSkelOutDatumConstrs a = (Show a, PrettyCooked a, Api.ToData a, PlutusTx.Eq a, Typeable a)

-- | On transaction outputs, we have the options to use
--
-- 1. no datum
-- 2. only a datum hash
-- 3. a "normal" datum
-- 4. an inline datum
--
-- These four options are also what the type 'TxSkelOutDatum' records. The
-- following table explains their differences.
--
-- +------------------------+------------------+---------------------+-----------------------+
-- |                        | datum stored in  |                     | 'Api.OutputDatum'     |
-- |                        | in the simulated | datum resolved      | constructor           |
-- |                        | chain state      | on the 'txInfoData' | seen by the validator |
-- +========================+==================+=====================+=======================+
-- | 'TxSkelOutNoDatum'     | no               | no                  | 'Api.NoOutputDatum'   |
-- +------------------------+------------------+---------------------+-----------------------+
-- | 'TxSkelOutDatumHash'   | yes              | no                  | 'Api.OutputDatumHash' |
-- +------------------------+------------------+---------------------+-----------------------+
-- | 'TxSkelOutDatum'       | yes              | yes                 | 'Api.OutputDatumHash' |
-- +------------------------+------------------+---------------------+-----------------------+
-- | 'TxSkelOutInlineDatum' | yes              | no                  | 'Api.OutputDatum'     |
-- +------------------------+------------------+---------------------+-----------------------+
--
-- That is:
--
-- - Whenever there is a datum, we'll store it in the state of our simulated
--   chain. This will make it possible to retrieve it later, using functions
--   such as 'datumFromHash'.
--
-- - Both of the 'TxSkelOutDatumHash' and 'TxSkelOutDatum' constructors will
--   create an output that scripts see on the 'txInfo' as having a datum
--   hash. The difference is whether that hash will be resolvable using
--   validator functions like 'findDatum'.
data TxSkelOutDatum where
  -- | use no datum
  TxSkelOutNoDatum :: TxSkelOutDatum
  -- | only include the hash on the transaction
  TxSkelOutDatumHash :: (TxSkelOutDatumConstrs a) => a -> TxSkelOutDatum
  -- | use a 'Api.OutputDatumHash' on the transaction output, but generate the
  -- transaction in such a way that the complete datum is included in the
  -- 'txInfoData' seen by validators
  TxSkelOutDatum :: (TxSkelOutDatumConstrs a) => a -> TxSkelOutDatum
  -- | use an inline datum
  TxSkelOutInlineDatum :: (TxSkelOutDatumConstrs a) => a -> TxSkelOutDatum

deriving instance Show TxSkelOutDatum

instance Eq TxSkelOutDatum where
  TxSkelOutDatum
x == :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
== TxSkelOutDatum
y = TxSkelOutDatum -> TxSkelOutDatum -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TxSkelOutDatum
x TxSkelOutDatum
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord TxSkelOutDatum where
  compare :: TxSkelOutDatum -> TxSkelOutDatum -> Ordering
compare TxSkelOutDatum
TxSkelOutNoDatum TxSkelOutDatum
TxSkelOutNoDatum = Ordering
EQ
  compare (TxSkelOutDatumHash a
d1) (TxSkelOutDatumHash a
d2) =
    case SomeTypeRep -> SomeTypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
d1)) (TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
d2)) of
      Ordering
LT -> Ordering
LT
      Ordering
GT -> Ordering
GT
      Ordering
EQ -> case a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
d1 TypeRep a -> TypeRep a -> Maybe (a :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
d2 of
        Just a :~~: a
HRefl -> BuiltinData -> BuiltinData -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
d1) (a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
d2)
        Maybe (a :~~: a)
Nothing -> String -> Ordering
forall a. HasCallStack => String -> a
error String
"This branch cannot happen: un-equal type representations that compare to EQ"
  compare (TxSkelOutDatum a
d1) (TxSkelOutDatum a
d2) =
    TxSkelOutDatum -> TxSkelOutDatum -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash a
d1) (a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash a
d2)
  compare (TxSkelOutInlineDatum a
d1) (TxSkelOutInlineDatum a
d2) =
    TxSkelOutDatum -> TxSkelOutDatum -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash a
d1) (a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash a
d2)
  compare TxSkelOutDatumHash {} TxSkelOutDatum
TxSkelOutNoDatum = Ordering
GT
  compare TxSkelOutDatum {} TxSkelOutDatum
TxSkelOutNoDatum = Ordering
GT
  compare TxSkelOutDatum {} TxSkelOutDatumHash {} = Ordering
GT
  compare TxSkelOutInlineDatum {} TxSkelOutDatum
_ = Ordering
GT
  compare TxSkelOutDatum
_ TxSkelOutDatum
_ = Ordering
LT

instance ToOutputDatum TxSkelOutDatum where
  toOutputDatum :: TxSkelOutDatum -> OutputDatum
toOutputDatum TxSkelOutDatum
TxSkelOutNoDatum = OutputDatum
Api.NoOutputDatum
  toOutputDatum (TxSkelOutDatumHash a
datum) = DatumHash -> OutputDatum
Api.OutputDatumHash (DatumHash -> OutputDatum) -> (a -> DatumHash) -> a -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> DatumHash
Script.datumHash (Datum -> DatumHash) -> (a -> Datum) -> a -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> (a -> BuiltinData) -> a -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData (a -> OutputDatum) -> a -> OutputDatum
forall a b. (a -> b) -> a -> b
$ a
datum
  toOutputDatum (TxSkelOutDatum a
datum) = DatumHash -> OutputDatum
Api.OutputDatumHash (DatumHash -> OutputDatum) -> (a -> DatumHash) -> a -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> DatumHash
Script.datumHash (Datum -> DatumHash) -> (a -> Datum) -> a -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> (a -> BuiltinData) -> a -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData (a -> OutputDatum) -> a -> OutputDatum
forall a b. (a -> b) -> a -> b
$ a
datum
  toOutputDatum (TxSkelOutInlineDatum a
datum) = Datum -> OutputDatum
Api.OutputDatum (Datum -> OutputDatum) -> (a -> Datum) -> a -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> (a -> BuiltinData) -> a -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData (a -> OutputDatum) -> a -> OutputDatum
forall a b. (a -> b) -> a -> b
$ a
datum

txSkelOutUntypedDatum :: TxSkelOutDatum -> Maybe Api.Datum
txSkelOutUntypedDatum :: TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum = \case
  TxSkelOutDatum
TxSkelOutNoDatum -> Maybe Datum
forall a. Maybe a
Nothing
  TxSkelOutDatumHash a
x -> Datum -> Maybe Datum
forall a. a -> Maybe a
Just (BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
x)
  TxSkelOutDatum a
x -> Datum -> Maybe Datum
forall a. a -> Maybe a
Just (BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
x)
  TxSkelOutInlineDatum a
x -> Datum -> Maybe Datum
forall a. a -> Maybe a
Just (BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
x)

txSkelOutTypedDatum :: (Api.FromData a) => TxSkelOutDatum -> Maybe a
txSkelOutTypedDatum :: forall a. FromData a => TxSkelOutDatum -> Maybe a
txSkelOutTypedDatum = BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
Api.fromBuiltinData (BuiltinData -> Maybe a)
-> (Datum -> BuiltinData) -> Datum -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> BuiltinData
Api.getDatum (Datum -> Maybe a)
-> (TxSkelOutDatum -> Maybe Datum) -> TxSkelOutDatum -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum

-- ** Smart constructors for transaction outputs

-- | Pay a certain value to a public key.
paysPK :: (ToPubKeyHash a) => a -> Api.Value -> TxSkelOut
paysPK :: forall a. ToPubKeyHash a => a -> Value -> TxSkelOut
paysPK a
pkh Value
value =
  ConcreteOutput PubKeyHash TxSkelOutDatum Value (Versioned Script)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays
    ( PubKeyHash
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Maybe (Versioned Script)
-> ConcreteOutput
     PubKeyHash TxSkelOutDatum Value (Versioned Script)
forall ownerType datumType valueType referenceScriptType.
ownerType
-> Maybe StakingCredential
-> datumType
-> valueType
-> Maybe referenceScriptType
-> ConcreteOutput ownerType datumType valueType referenceScriptType
ConcreteOutput
        (a -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
toPubKeyHash a
pkh)
        Maybe StakingCredential
forall a. Maybe a
Nothing
        TxSkelOutDatum
TxSkelOutNoDatum
        Value
value
        (forall a. Maybe a
Nothing @(Script.Versioned Script.Script))
    )

-- | Pays a script a certain value with a certain datum hash, using the
-- 'TxSkelOutDatum' constructor. The resolved datum is provided in the body of
-- the transaction that issues the payment.
paysScript ::
  ( Api.ToData (Script.DatumType a),
    Show (Script.DatumType a),
    Typeable (Script.DatumType a),
    PlutusTx.Eq (Script.DatumType a),
    PrettyCooked (Script.DatumType a),
    Typeable a
  ) =>
  Script.TypedValidator a ->
  Script.DatumType a ->
  Api.Value ->
  TxSkelOut
paysScript :: forall a.
(ToData (DatumType a), Show (DatumType a), Typeable (DatumType a),
 Eq (DatumType a), PrettyCooked (DatumType a), Typeable a) =>
TypedValidator a -> DatumType a -> Value -> TxSkelOut
paysScript TypedValidator a
validator DatumType a
datum Value
value =
  ConcreteOutput
  (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays
    ( TypedValidator a
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Maybe (Versioned Script)
-> ConcreteOutput
     (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
forall ownerType datumType valueType referenceScriptType.
ownerType
-> Maybe StakingCredential
-> datumType
-> valueType
-> Maybe referenceScriptType
-> ConcreteOutput ownerType datumType valueType referenceScriptType
ConcreteOutput
        TypedValidator a
validator
        Maybe StakingCredential
forall a. Maybe a
Nothing
        (DatumType a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatum DatumType a
datum)
        Value
value
        (forall a. Maybe a
Nothing @(Script.Versioned Script.Script))
    )

-- | Pays a script a certain value with a certain inlined datum.
paysScriptInlineDatum ::
  ( Api.ToData (Script.DatumType a),
    Show (Script.DatumType a),
    Typeable (Script.DatumType a),
    PlutusTx.Eq (Script.DatumType a),
    PrettyCooked (Script.DatumType a),
    Typeable a
  ) =>
  Script.TypedValidator a ->
  Script.DatumType a ->
  Api.Value ->
  TxSkelOut
paysScriptInlineDatum :: forall a.
(ToData (DatumType a), Show (DatumType a), Typeable (DatumType a),
 Eq (DatumType a), PrettyCooked (DatumType a), Typeable a) =>
TypedValidator a -> DatumType a -> Value -> TxSkelOut
paysScriptInlineDatum TypedValidator a
validator DatumType a
datum Value
value =
  ConcreteOutput
  (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays
    ( TypedValidator a
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Maybe (Versioned Script)
-> ConcreteOutput
     (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
forall ownerType datumType valueType referenceScriptType.
ownerType
-> Maybe StakingCredential
-> datumType
-> valueType
-> Maybe referenceScriptType
-> ConcreteOutput ownerType datumType valueType referenceScriptType
ConcreteOutput
        TypedValidator a
validator
        Maybe StakingCredential
forall a. Maybe a
Nothing
        (DatumType a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutInlineDatum DatumType a
datum)
        Value
value
        (forall a. Maybe a
Nothing @(Script.Versioned Script.Script))
    )

-- | Pays a script a certain value with a certain hashed datum, whose resolved
-- datum is not provided in the transaction body that issues the payment (as
-- opposed to "paysScript").
paysScriptUnresolvedDatumHash ::
  ( Api.ToData (Script.DatumType a),
    Show (Script.DatumType a),
    Typeable (Script.DatumType a),
    PlutusTx.Eq (Script.DatumType a),
    PrettyCooked (Script.DatumType a),
    Typeable a
  ) =>
  Script.TypedValidator a ->
  Script.DatumType a ->
  Api.Value ->
  TxSkelOut
paysScriptUnresolvedDatumHash :: forall a.
(ToData (DatumType a), Show (DatumType a), Typeable (DatumType a),
 Eq (DatumType a), PrettyCooked (DatumType a), Typeable a) =>
TypedValidator a -> DatumType a -> Value -> TxSkelOut
paysScriptUnresolvedDatumHash TypedValidator a
validator DatumType a
datum Value
value =
  ConcreteOutput
  (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays
    ( TypedValidator a
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Maybe (Versioned Script)
-> ConcreteOutput
     (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
forall ownerType datumType valueType referenceScriptType.
ownerType
-> Maybe StakingCredential
-> datumType
-> valueType
-> Maybe referenceScriptType
-> ConcreteOutput ownerType datumType valueType referenceScriptType
ConcreteOutput
        TypedValidator a
validator
        Maybe StakingCredential
forall a. Maybe a
Nothing
        (DatumType a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash DatumType a
datum)
        Value
value
        (forall a. Maybe a
Nothing @(Script.Versioned Script.Script))
    )

-- | Pays a script a certain value without any datum. Intended to be used with
-- 'withDatum', 'withUnresolvedDatumHash', or 'withInlineDatum' to try a datum whose type
-- does not match the validator's.
paysScriptNoDatum :: (Typeable a) => Script.TypedValidator a -> Api.Value -> TxSkelOut
paysScriptNoDatum :: forall a. Typeable a => TypedValidator a -> Value -> TxSkelOut
paysScriptNoDatum TypedValidator a
validator Value
value =
  ConcreteOutput
  (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays
    ( TypedValidator a
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Maybe (Versioned Script)
-> ConcreteOutput
     (TypedValidator a) TxSkelOutDatum Value (Versioned Script)
forall ownerType datumType valueType referenceScriptType.
ownerType
-> Maybe StakingCredential
-> datumType
-> valueType
-> Maybe referenceScriptType
-> ConcreteOutput ownerType datumType valueType referenceScriptType
ConcreteOutput
        TypedValidator a
validator
        Maybe StakingCredential
forall a. Maybe a
Nothing
        TxSkelOutDatum
TxSkelOutNoDatum
        Value
value
        (forall a. Maybe a
Nothing @(Script.Versioned Script.Script))
    )

-- | Set the datum in a payment to the given datum (whose type may not fit the
-- typed validator in case of a script).
withDatum :: (Api.ToData a, Show a, Typeable a, PlutusTx.Eq a, PrettyCooked a) => TxSkelOut -> a -> TxSkelOut
withDatum :: forall a.
(ToData a, Show a, Typeable a, Eq a, PrettyCooked a) =>
TxSkelOut -> a -> TxSkelOut
withDatum (Pays o
output) a
datum = ConcreteOutput
  (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (ConcreteOutput
   (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
 -> TxSkelOut)
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$ (o
-> ConcreteOutput
     (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput o
output) {concreteOutputDatum = TxSkelOutDatum datum}

-- | Set the datum in a payment to the given inlined datum (whose type may not
-- fit the typed validator in case of a script).
withInlineDatum :: (Api.ToData a, Show a, Typeable a, PlutusTx.Eq a, PrettyCooked a) => TxSkelOut -> a -> TxSkelOut
withInlineDatum :: forall a.
(ToData a, Show a, Typeable a, Eq a, PrettyCooked a) =>
TxSkelOut -> a -> TxSkelOut
withInlineDatum (Pays o
output) a
datum = ConcreteOutput
  (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (ConcreteOutput
   (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
 -> TxSkelOut)
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$ (o
-> ConcreteOutput
     (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput o
output) {concreteOutputDatum = TxSkelOutInlineDatum datum}

-- | Set the datum in a payment to the given hashed (not resolved in the
-- transaction) datum (whose type may not fit the typed validator in case of a
-- script).
withUnresolvedDatumHash :: (Api.ToData a, Show a, Typeable a, PlutusTx.Eq a, PrettyCooked a) => TxSkelOut -> a -> TxSkelOut
withUnresolvedDatumHash :: forall a.
(ToData a, Show a, Typeable a, Eq a, PrettyCooked a) =>
TxSkelOut -> a -> TxSkelOut
withUnresolvedDatumHash (Pays o
output) a
datum = ConcreteOutput
  (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (ConcreteOutput
   (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
 -> TxSkelOut)
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$ (o
-> ConcreteOutput
     (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput o
output) {concreteOutputDatum = TxSkelOutDatumHash datum}

-- | Add a reference script to a transaction output (or replace it if there is
-- already one)
withReferenceScript :: (Show script, ToVersionedScript script, Typeable script, ToScriptHash script) => TxSkelOut -> script -> TxSkelOut
withReferenceScript :: forall script.
(Show script, ToVersionedScript script, Typeable script,
 ToScriptHash script) =>
TxSkelOut -> script -> TxSkelOut
withReferenceScript (Pays o
output) script
script = ConcreteOutput (OwnerType o) TxSkelOutDatum Value script
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (ConcreteOutput (OwnerType o) TxSkelOutDatum Value script
 -> TxSkelOut)
-> ConcreteOutput (OwnerType o) TxSkelOutDatum Value script
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$ (o
-> ConcreteOutput
     (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput o
output) {concreteOutputReferenceScript = Just script}

-- | Add a staking credential to a transaction output (or replace it if there is
-- already one)
withStakingCredential :: TxSkelOut -> Api.StakingCredential -> TxSkelOut
withStakingCredential :: TxSkelOut -> StakingCredential -> TxSkelOut
withStakingCredential (Pays o
output) StakingCredential
stakingCredential = ConcreteOutput
  (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (ConcreteOutput
   (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
 -> TxSkelOut)
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$ (o
-> ConcreteOutput
     (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput o
output) {concreteOutputStakingCredential = Just stakingCredential}

-- * Transaction skeletons

data TxSkel where
  TxSkel ::
    { -- | Labels do not influence the transaction generation at all; they are
      -- pretty-printed whenever cooked-validators prints a transaction, and can
      -- therefore make the output more informative (and greppable).
      TxSkel -> Set TxLabel
txSkelLabel :: Set TxLabel,
      -- | Some options that control transaction generation.
      TxSkel -> TxOpts
txSkelOpts :: TxOpts,
      -- | Any value minted or burned by the transaction. You'll probably want
      -- to use 'txSkelMintsFromList' to construct this.
      TxSkel -> TxSkelMints
txSkelMints :: TxSkelMints,
      -- | The wallets signing the transaction. This list must contain at least
      -- one element. By default, the first signer will pay for fees and
      -- balancing. You can change that with 'txOptBalanceWallet'.
      TxSkel -> [Wallet]
txSkelSigners :: [Wallet],
      TxSkel -> SlotRange
txSkelValidityRange :: Ledger.SlotRange,
      -- | To each 'TxOutRef' the transaction should consume, add a redeemer
      -- specifying how to spend it. You must make sure that
      --
      -- - On 'TxOutRef's referencing UTxOs belonging to public keys, you use
      --   the 'emptyTxSkelRedeemer' smart constructor.
      --
      -- - On 'TxOutRef's referencing UTxOs belonging to scripts, you must make
      --   sure that the type of the redeemer is appropriate for the script.
      TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelIns :: Map Api.TxOutRef TxSkelRedeemer,
      -- | All outputs referenced by the transaction.
      TxSkel -> Set TxOutRef
txSkelInsReference :: Set Api.TxOutRef,
      -- | The outputs of the transaction. These will occur in exactly this
      -- order on the transaction.
      TxSkel -> [TxSkelOut]
txSkelOuts :: [TxSkelOut],
      -- | Possible proposals issued in this transaction to be voted on and
      -- possible enacted later on.
      TxSkel -> [TxSkelProposal]
txSkelProposals :: [TxSkelProposal],
      -- | Withdrawals performed by the transaction
      TxSkel
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
txSkelWithdrawals :: TxSkelWithdrawals
    } ->
    TxSkel
  deriving (Int -> TxSkel -> ShowS
[TxSkel] -> ShowS
TxSkel -> String
(Int -> TxSkel -> ShowS)
-> (TxSkel -> String) -> ([TxSkel] -> ShowS) -> Show TxSkel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSkel -> ShowS
showsPrec :: Int -> TxSkel -> ShowS
$cshow :: TxSkel -> String
show :: TxSkel -> String
$cshowList :: [TxSkel] -> ShowS
showList :: [TxSkel] -> ShowS
Show, TxSkel -> TxSkel -> Bool
(TxSkel -> TxSkel -> Bool)
-> (TxSkel -> TxSkel -> Bool) -> Eq TxSkel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSkel -> TxSkel -> Bool
== :: TxSkel -> TxSkel -> Bool
$c/= :: TxSkel -> TxSkel -> Bool
/= :: TxSkel -> TxSkel -> Bool
Eq)

makeLensesFor
  [ ("txSkelLabel", "txSkelLabelL"),
    ("txSkelOpts", "txSkelOptsL"),
    ("txSkelMints", "txSkelMintsL"),
    ("txSkelValidityRange", "txSkelValidityRangeL"),
    ("txSkelSigners", "txSkelSignersL"),
    ("txSkelIns", "txSkelInsL"),
    ("txSkelInsReference", "txSkelInsReferenceL"),
    ("txSkelOuts", "txSkelOutsL"),
    ("txSkelProposals", "txSkelProposalsL"),
    ("txSkelWithdrawals", "txSkelWithdrawalsL")
  ]
  ''TxSkel

-- | A convenience template of an empty transaction skeleton.
txSkelTemplate :: TxSkel
txSkelTemplate :: TxSkel
txSkelTemplate =
  TxSkel
    { txSkelLabel :: Set TxLabel
txSkelLabel = Set TxLabel
forall a. Set a
Set.empty,
      txSkelOpts :: TxOpts
txSkelOpts = TxOpts
forall a. Default a => a
def,
      txSkelMints :: TxSkelMints
txSkelMints = TxSkelMints
forall k a. Map k a
Map.empty,
      txSkelValidityRange :: SlotRange
txSkelValidityRange = SlotRange
forall a. Interval a
Api.always,
      txSkelSigners :: [Wallet]
txSkelSigners = [],
      txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelIns = Map TxOutRef TxSkelRedeemer
forall k a. Map k a
Map.empty,
      txSkelInsReference :: Set TxOutRef
txSkelInsReference = Set TxOutRef
forall a. Set a
Set.empty,
      txSkelOuts :: [TxSkelOut]
txSkelOuts = [],
      txSkelProposals :: [TxSkelProposal]
txSkelProposals = [],
      txSkelWithdrawals :: Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
txSkelWithdrawals = Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
forall k a. Map k a
Map.empty
    }

-- | The missing information on a 'TxSkel' that can only be resolved by querying
-- the state of the blockchain.
data SkelContext = SkelContext
  { SkelContext -> Map TxOutRef TxOut
skelContextTxOuts :: Map Api.TxOutRef Api.TxOut,
    SkelContext -> Map DatumHash TxSkelOutDatum
skelContextTxSkelOutDatums :: Map Api.DatumHash TxSkelOutDatum
  }

-- | Returns the full value contained in the skeleton outputs
txSkelValueInOutputs :: TxSkel -> Api.Value
txSkelValueInOutputs :: TxSkel -> Value
txSkelValueInOutputs = Optic' A_Fold NoIx TxSkel Value -> TxSkel -> Value
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Lens' TxSkel [TxSkelOut]
txSkelOutsL Lens' TxSkel [TxSkelOut]
-> Optic A_Fold NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Fold NoIx TxSkel TxSkel TxSkelOut TxSkelOut
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Fold NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
forall (f :: * -> *) a. Foldable f => Fold (f a) a
folded Optic A_Fold NoIx TxSkel TxSkel TxSkelOut TxSkelOut
-> Lens' TxSkelOut Value -> Optic' A_Fold NoIx TxSkel Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Lens' TxSkelOut Value
txSkelOutValueL)

-- | Return all data on transaction outputs. This can contain duplicates, which
-- is intended.
txSkelDataInOutputs :: TxSkel -> [(Api.DatumHash, TxSkelOutDatum)]
txSkelDataInOutputs :: TxSkel -> [(DatumHash, TxSkelOutDatum)]
txSkelDataInOutputs =
  Optic' A_Fold NoIx TxSkel TxSkelOutDatum
-> (TxSkelOutDatum -> [(DatumHash, TxSkelOutDatum)])
-> TxSkel
-> [(DatumHash, TxSkelOutDatum)]
forall k m (is :: IxList) s a.
(Is k A_Fold, Monoid m) =>
Optic' k is s a -> (a -> m) -> s -> m
foldMapOf
    ( Lens' TxSkel [TxSkelOut]
txSkelOutsL
        Lens' TxSkel [TxSkelOut]
-> Optic A_Fold NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Fold NoIx TxSkel TxSkel TxSkelOut TxSkelOut
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Fold NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
forall (f :: * -> *) a. Foldable f => Fold (f a) a
folded
        Optic A_Fold NoIx TxSkel TxSkel TxSkelOut TxSkelOut
-> Lens' TxSkelOut TxSkelOutDatum
-> Optic' A_Fold NoIx TxSkel TxSkelOutDatum
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Lens' TxSkelOut TxSkelOutDatum
txSkelOutDatumL
    )
    ( \TxSkelOutDatum
txSkelOutDatum ->
        [(DatumHash, TxSkelOutDatum)]
-> (Datum -> [(DatumHash, TxSkelOutDatum)])
-> Maybe Datum
-> [(DatumHash, TxSkelOutDatum)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          []
          (\Datum
datum -> [(Datum -> DatumHash
Script.datumHash Datum
datum, TxSkelOutDatum
txSkelOutDatum)])
          (TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum TxSkelOutDatum
txSkelOutDatum)
    )

-- | All validators which will receive transaction outputs
txSkelValidatorsInOutputs :: TxSkel -> Map Script.ValidatorHash (Script.Versioned Script.Validator)
txSkelValidatorsInOutputs :: TxSkel -> Map ValidatorHash (Versioned Validator)
txSkelValidatorsInOutputs =
  [(ValidatorHash, Versioned Validator)]
-> Map ValidatorHash (Versioned Validator)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(ValidatorHash, Versioned Validator)]
 -> Map ValidatorHash (Versioned Validator))
-> (TxSkel -> [(ValidatorHash, Versioned Validator)])
-> TxSkel
-> Map ValidatorHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSkelOut -> Maybe (ValidatorHash, Versioned Validator))
-> [TxSkelOut] -> [(ValidatorHash, Versioned Validator)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Versioned Validator -> (ValidatorHash, Versioned Validator))
-> Maybe (Versioned Validator)
-> Maybe (ValidatorHash, Versioned Validator)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Versioned Validator
val -> (Versioned Validator -> ValidatorHash
Script.validatorHash Versioned Validator
val, Versioned Validator
val)) (Maybe (Versioned Validator)
 -> Maybe (ValidatorHash, Versioned Validator))
-> (TxSkelOut -> Maybe (Versioned Validator))
-> TxSkelOut
-> Maybe (ValidatorHash, Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> Maybe (Versioned Validator)
txSkelOutValidator)
    ([TxSkelOut] -> [(ValidatorHash, Versioned Validator)])
-> (TxSkel -> [TxSkelOut])
-> TxSkel
-> [(ValidatorHash, Versioned Validator)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> [TxSkelOut]
txSkelOuts

-- | All validators in the reference script field of transaction outputs
txSkelReferenceScripts :: TxSkel -> Map Script.ValidatorHash (Script.Versioned Script.Validator)
txSkelReferenceScripts :: TxSkel -> Map ValidatorHash (Versioned Validator)
txSkelReferenceScripts =
  [Map ValidatorHash (Versioned Validator)]
-> Map ValidatorHash (Versioned Validator)
forall a. Monoid a => [a] -> a
mconcat
    ([Map ValidatorHash (Versioned Validator)]
 -> Map ValidatorHash (Versioned Validator))
-> (TxSkel -> [Map ValidatorHash (Versioned Validator)])
-> TxSkel
-> Map ValidatorHash (Versioned Validator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSkelOut -> Map ValidatorHash (Versioned Validator))
-> [TxSkelOut] -> [Map ValidatorHash (Versioned Validator)]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \(Pays o
output) ->
          case o
output o
-> Optic' A_Lens NoIx o (Maybe (ReferenceScriptType o))
-> Maybe (ReferenceScriptType o)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx o (Maybe (ReferenceScriptType o))
forall o.
IsAbstractOutput o =>
Lens' o (Maybe (ReferenceScriptType o))
outputReferenceScriptL of
            Maybe (ReferenceScriptType o)
Nothing -> Map ValidatorHash (Versioned Validator)
forall k a. Map k a
Map.empty
            Just ReferenceScriptType o
x ->
              let vScript :: Versioned Script
vScript@(Script.Versioned Script
script Language
version) = ReferenceScriptType o -> Versioned Script
forall a. ToVersionedScript a => a -> Versioned Script
toVersionedScript ReferenceScriptType o
x
                  Script.ScriptHash BuiltinByteString
hash = Versioned Script -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
toScriptHash Versioned Script
vScript
               in ValidatorHash
-> Versioned Validator -> Map ValidatorHash (Versioned Validator)
forall k a. k -> a -> Map k a
Map.singleton (BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
hash) (Versioned Validator -> Map ValidatorHash (Versioned Validator))
-> Versioned Validator -> Map ValidatorHash (Versioned Validator)
forall a b. (a -> b) -> a -> b
$ Validator -> Language -> Versioned Validator
forall script. script -> Language -> Versioned script
Script.Versioned (Script -> Validator
Script.Validator Script
script) Language
version
      )
    ([TxSkelOut] -> [Map ValidatorHash (Versioned Validator)])
-> (TxSkel -> [TxSkelOut])
-> TxSkel
-> [Map ValidatorHash (Versioned Validator)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> [TxSkelOut]
txSkelOuts

-- | All `TxOutRefs` in reference inputs
txSkelReferenceTxOutRefs :: TxSkel -> [Api.TxOutRef]
txSkelReferenceTxOutRefs :: TxSkel -> [TxOutRef]
txSkelReferenceTxOutRefs TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Set TxOutRef
Set TxLabel
Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
Map TxOutRef TxSkelRedeemer
TxSkelMints
SlotRange
TxOpts
txSkelWithdrawals :: TxSkel
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
txSkelLabel :: TxSkel -> Set TxLabel
txSkelOpts :: TxSkel -> TxOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSigners :: TxSkel -> [Wallet]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelLabel :: Set TxLabel
txSkelOpts :: TxOpts
txSkelMints :: TxSkelMints
txSkelSigners :: [Wallet]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
..} =
  -- direct reference inputs
  Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
txSkelInsReference
    -- reference inputs in inputs redeemers
    [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. Semigroup a => a -> a -> a
<> (TxSkelRedeemer -> Maybe TxOutRef)
-> [TxSkelRedeemer] -> [TxOutRef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxSkelRedeemer -> Maybe TxOutRef
txSkelReferenceInput (Map TxOutRef TxSkelRedeemer -> [TxSkelRedeemer]
forall k a. Map k a -> [a]
Map.elems Map TxOutRef TxSkelRedeemer
txSkelIns)
    -- reference inputs in proposals redeemers
    [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. Semigroup a => a -> a -> a
<> ((Versioned Script, TxSkelRedeemer) -> Maybe TxOutRef)
-> [(Versioned Script, TxSkelRedeemer)] -> [TxOutRef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxSkelRedeemer -> Maybe TxOutRef
txSkelReferenceInput (TxSkelRedeemer -> Maybe TxOutRef)
-> ((Versioned Script, TxSkelRedeemer) -> TxSkelRedeemer)
-> (Versioned Script, TxSkelRedeemer)
-> Maybe TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Versioned Script, TxSkelRedeemer) -> TxSkelRedeemer
forall a b. (a, b) -> b
snd) ((TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer))
-> [TxSkelProposal] -> [(Versioned Script, TxSkelRedeemer)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalWitness [TxSkelProposal]
txSkelProposals)
    -- reference inputs in mints redeemers
    [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. Semigroup a => a -> a -> a
<> ((Versioned MintingPolicy,
  (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
 -> Maybe TxOutRef)
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
-> [TxOutRef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxSkelRedeemer -> Maybe TxOutRef
txSkelReferenceInput (TxSkelRedeemer -> Maybe TxOutRef)
-> ((Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
    -> TxSkelRedeemer)
-> (Versioned MintingPolicy,
    (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
-> Maybe TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
-> TxSkelRedeemer
forall a b. (a, b) -> a
fst ((TxSkelRedeemer, NEMap TokenName (NonZero Integer))
 -> TxSkelRedeemer)
-> ((Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
    -> (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
-> (Versioned MintingPolicy,
    (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
-> TxSkelRedeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Versioned MintingPolicy,
 (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
-> (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
forall a b. (a, b) -> b
snd) (TxSkelMints
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
forall k a. Map k a -> [(k, a)]
Map.toList TxSkelMints
txSkelMints)

-- | All `TxOutRefs` known by a given transaction skeleton. This includes
-- TxOutRef`s used as inputs of the skeleton and `TxOutRef`s used as reference
-- inputs of the skeleton.  This does not include additional possible
-- `TxOutRef`s used for balancing and additional `TxOutRef`s used as collateral
-- inputs, as they are not part of the skeleton.
txSkelKnownTxOutRefs :: TxSkel -> [Api.TxOutRef]
txSkelKnownTxOutRefs :: TxSkel -> [TxOutRef]
txSkelKnownTxOutRefs skel :: TxSkel
skel@TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Set TxOutRef
Set TxLabel
Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
Map TxOutRef TxSkelRedeemer
TxSkelMints
SlotRange
TxOpts
txSkelWithdrawals :: TxSkel
-> Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
txSkelLabel :: TxSkel -> Set TxLabel
txSkelOpts :: TxSkel -> TxOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSigners :: TxSkel -> [Wallet]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelLabel :: Set TxLabel
txSkelOpts :: TxOpts
txSkelMints :: TxSkelMints
txSkelSigners :: [Wallet]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: Map (Either (Versioned Script) PubKeyHash) (TxSkelRedeemer, Ada)
..} = TxSkel -> [TxOutRef]
txSkelReferenceTxOutRefs TxSkel
skel [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. Semigroup a => a -> a -> a
<> Map TxOutRef TxSkelRedeemer -> [TxOutRef]
forall k a. Map k a -> [k]
Map.keys Map TxOutRef TxSkelRedeemer
txSkelIns

-- * Various Optics on 'TxSkels' and all the other types defined here

-- | Decide if a transaction output has a certain owner and datum type.
txSkelOutOwnerTypeP ::
  forall ownerType.
  ( ToCredential ownerType,
    Show ownerType,
    IsTxSkelOutAllowedOwner ownerType,
    Typeable ownerType
  ) =>
  Prism' TxSkelOut (ConcreteOutput ownerType TxSkelOutDatum Api.Value (Script.Versioned Script.Script))
txSkelOutOwnerTypeP :: forall ownerType.
(ToCredential ownerType, Show ownerType,
 IsTxSkelOutAllowedOwner ownerType, Typeable ownerType) =>
Prism'
  TxSkelOut
  (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script))
txSkelOutOwnerTypeP =
  (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script)
 -> TxSkelOut)
-> (TxSkelOut
    -> Maybe
         (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script)))
-> Prism
     TxSkelOut
     TxSkelOut
     (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script))
     (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
    ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script)
-> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays
    ( \(Pays o
output) ->
        case OwnerType o -> TypeRep (OwnerType o)
forall a. Typeable a => a -> TypeRep a
typeOf (o
output o -> Optic' A_Lens NoIx o (OwnerType o) -> OwnerType o
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx o (OwnerType o)
forall o. IsAbstractOutput o => Lens' o (OwnerType o)
outputOwnerL) TypeRep (OwnerType o)
-> TypeRep ownerType -> Maybe (OwnerType o :~~: ownerType)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @ownerType of
          Just OwnerType o :~~: ownerType
HRefl ->
            let cOut :: ConcreteOutput
  (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
cOut = o
-> ConcreteOutput
     (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
forall out.
IsAbstractOutput out =>
out
-> ConcreteOutput
     (OwnerType out)
     (DatumType out)
     (ValueType out)
     (ReferenceScriptType out)
fromAbstractOutput o
output
             in ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script)
-> Maybe
     (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script))
forall a. a -> Maybe a
Just (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script)
 -> Maybe
      (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script)))
-> ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script)
-> Maybe
     (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script))
forall a b. (a -> b) -> a -> b
$ ConcreteOutput
  (OwnerType o) (DatumType o) (ValueType o) (ReferenceScriptType o)
cOut {concreteOutputReferenceScript = toVersionedScript <$> concreteOutputReferenceScript cOut}
          Maybe (OwnerType o :~~: ownerType)
Nothing -> Maybe
  (ConcreteOutput ownerType TxSkelOutDatum Value (Versioned Script))
forall a. Maybe a
Nothing
    )

txSkelOutputDatumTypeAT ::
  (Api.FromData a, Typeable a) =>
  AffineTraversal' TxSkelOut a
txSkelOutputDatumTypeAT :: forall a. (FromData a, Typeable a) => AffineTraversal' TxSkelOut a
txSkelOutputDatumTypeAT =
  (TxSkelOut -> Either TxSkelOut a)
-> (TxSkelOut -> a -> TxSkelOut)
-> AffineTraversal TxSkelOut TxSkelOut a a
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    ( \TxSkelOut
txSkelOut -> case TxSkelOut -> Maybe Datum
txSkelOutDatumComplete TxSkelOut
txSkelOut of
        Maybe Datum
Nothing -> TxSkelOut -> Either TxSkelOut a
forall a b. a -> Either a b
Left TxSkelOut
txSkelOut
        Just (Api.Datum BuiltinData
datum) -> case BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
Api.fromBuiltinData BuiltinData
datum of
          Just a
tyDatum -> a -> Either TxSkelOut a
forall a b. b -> Either a b
Right a
tyDatum
          Maybe a
Nothing -> TxSkelOut -> Either TxSkelOut a
forall a b. a -> Either a b
Left TxSkelOut
txSkelOut
    )
    ( \(Pays o
output) a
newTyDatum ->
        o -> TxSkelOut
forall a.
(Show a, Typeable a, IsTxInfoOutput a,
 IsTxSkelOutAllowedOwner (OwnerType a), Typeable (OwnerType a),
 ToCredential (OwnerType a), DatumType a ~ TxSkelOutDatum,
 ValueType a ~ Value, ToVersionedScript (ReferenceScriptType a),
 Show (OwnerType a), Show (ReferenceScriptType a),
 Typeable (ReferenceScriptType a)) =>
a -> TxSkelOut
Pays (o -> TxSkelOut) -> o -> TxSkelOut
forall a b. (a -> b) -> a -> b
$
          Optic A_Lens NoIx o o TxSkelOutDatum TxSkelOutDatum
-> (TxSkelOutDatum -> TxSkelOutDatum) -> o -> o
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
            Lens' o (DatumType o)
Optic A_Lens NoIx o o TxSkelOutDatum TxSkelOutDatum
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL
            ( \case
                TxSkelOutDatum
TxSkelOutNoDatum -> TxSkelOutDatum
TxSkelOutNoDatum
                TxSkelOutDatum a
tyDatum -> a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatum (a -> TxSkelOutDatum) -> a -> TxSkelOutDatum
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b a. (Typeable b, Typeable a) => b -> a -> b
replaceDatumOnCorrectType a
tyDatum a
newTyDatum
                TxSkelOutDatumHash a
tyDatum -> a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash (a -> TxSkelOutDatum) -> a -> TxSkelOutDatum
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b a. (Typeable b, Typeable a) => b -> a -> b
replaceDatumOnCorrectType a
tyDatum a
newTyDatum
                TxSkelOutInlineDatum a
tyDatum -> a -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutInlineDatum (a -> TxSkelOutDatum) -> a -> TxSkelOutDatum
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall b a. (Typeable b, Typeable a) => b -> a -> b
replaceDatumOnCorrectType a
tyDatum a
newTyDatum
            )
            o
output
    )
  where
    replaceDatumOnCorrectType :: (Typeable b, Typeable a) => b -> a -> b
    replaceDatumOnCorrectType :: forall b a. (Typeable b, Typeable a) => b -> a -> b
replaceDatumOnCorrectType b
old a
new = case b -> TypeRep b
forall a. Typeable a => a -> TypeRep a
typeOf b
old TypeRep b -> TypeRep a -> Maybe (b :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
new of
      Just b :~~: a
HRefl -> b
a
new
      Maybe (b :~~: a)
Nothing -> b
old

    txSkelOutDatumComplete :: TxSkelOut -> Maybe Api.Datum
    txSkelOutDatumComplete :: TxSkelOut -> Maybe Datum
txSkelOutDatumComplete (Pays o
output) = TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum (TxSkelOutDatum -> Maybe Datum) -> TxSkelOutDatum -> Maybe Datum
forall a b. (a -> b) -> a -> b
$ o
output o -> Optic' A_Lens NoIx o TxSkelOutDatum -> TxSkelOutDatum
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' o (DatumType o)
Optic' A_Lens NoIx o TxSkelOutDatum
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL