{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE DeriveAnyClass            #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE DerivingVia               #-}
{-# LANGUAGE EmptyCase                 #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE PolyKinds                 #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TupleSections             #-}
{-# LANGUAGE TypeApplications          #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeOperators             #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE ViewPatterns              #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}
module Ledger.Tx.Constraints.OffChain(
    -- * Lookups
    ScriptLookups(..)
    , typedValidatorLookups
    , generalise
    , unspentOutputs
    , mintingPolicy
    , plutusV1MintingPolicy
    , plutusV2MintingPolicy
    , otherScript
    , plutusV1OtherScript
    , plutusV2OtherScript
    , otherData
    , paymentPubKey
    , paymentPubKeyHash
    -- * Constraints resolution
    , SomeLookupsAndConstraints(..)
    , UnbalancedTx(..)
    , tx
    , txInsCollateral
    , txValidityRange
    , txOuts
    , utxoIndex
    , emptyUnbalancedTx
    , adjustUnbalancedTx
    , mkTx
    , mkTxWithParams
    , mkSomeTx
    , MkTxError(..)
    , _TypeCheckFailed
    , _ToCardanoError
    , _TxOutRefNotFound
    , _TxOutRefWrongType
    , _TxOutRefNoReferenceScript
    , _DatumNotFound
    , _DeclaredInputMismatch
    , _MintingPolicyNotFound
    , _ScriptHashNotFound
    , _TypedValidatorMissing
    , _DatumWrongHash
    , _CannotSatisfyAny
    , _NoMatchingOutputFound
    , _MultipleMatchingOutputsFound
    -- * Internals exposed for testing
    , ValueSpentBalances(..)
    , provided
    , required
    , missingValueSpent
    , ConstraintProcessingState(..)
    , unbalancedTx
    , valueSpentInputs
    , valueSpentOutputs
    , paramsL
    , processConstraintFun
    , addOwnInput
    , addOwnOutput
    , updateUtxoIndex
    , lookupTxOutRef
    , lookupMintingPolicy
    , lookupScript
    , lookupScriptAsReferenceScript
    , prepareConstraints
    , resolveScriptTxOut
    , resolveScriptTxOutValidator
    , resolveScriptTxOutDatumAndValue
    , DatumWithOrigin(..)
    , datumWitness
    , checkValueSpent
    , SortedConstraints(..)
    , initialState
    ) where

import Cardano.Api qualified as C
import Cardano.Api.Shelley qualified as C
import Cardano.Node.Emulator.Internal.Node.Params (PParams, Params (..), networkIdL, pProtocolParams)
import Cardano.Node.Emulator.Internal.Node.TimeSlot (posixTimeRangeToContainedSlotRange, slotRangeToPOSIXTimeRange)
import Control.Lens
import Control.Lens.Extras (is)
import Control.Monad.Except (Except, MonadError (catchError), guard, lift, runExcept, throwError, unless)
import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT), asks)
import Control.Monad.State (MonadState (get, put), StateT, execStateT, gets)
import Data.Aeson (FromJSON, ToJSON)
import Data.Either (partitionEithers)
import Data.Foldable (traverse_)
import Data.List qualified as List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Semigroup (First (First, getFirst))
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Generics (Generic)
import Ledger (Datum, Language (PlutusV1, PlutusV2), MintingPolicy, MintingPolicyHash, POSIXTimeRange,
               Redeemer (Redeemer), UtxoIndex, Versioned, adjustTxOut, decoratedTxOutReferenceScript)
import Ledger.Address (PaymentPubKey (PaymentPubKey), PaymentPubKeyHash (PaymentPubKeyHash))
import Ledger.Crypto (pubKeyHash)
import Ledger.Interval ()
import Ledger.Orphans ()
import Ledger.Scripts (ScriptHash, getRedeemer, getValidator)
import Ledger.Tx (DecoratedTxOut, TxOut, TxOutRef)
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), toCardanoMintWitness, toCardanoPolicyId)
import Ledger.Tx.CardanoAPI qualified as C
import Ledger.Tx.Constraints.TxConstraints
import Ledger.Tx.Constraints.ValidityInterval (toPlutusInterval)
import Ledger.Typed.Scripts (Any, ConnectionError (UnknownRef), TypedValidator (tvValidator, tvValidatorHash),
                             ValidatorTypes (DatumType, RedeemerType), validatorAddress)
import Plutus.Script.Utils.Scripts (datumHash, scriptHash)
import Plutus.Script.Utils.V2.Typed.Scripts qualified as Typed
import Plutus.Script.Utils.Value qualified as Value
import Plutus.V1.Ledger.Api (Datum (Datum), DatumHash, StakingCredential, Validator, Value, getMintingPolicy)
import Plutus.V1.Ledger.Scripts (MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash), Script,
                                 ScriptHash (ScriptHash), Validator (Validator), ValidatorHash (ValidatorHash))
import PlutusTx (FromData, ToData (toBuiltinData))
import PlutusTx.Lattice (BoundedMeetSemiLattice (top), JoinSemiLattice ((\/)), MeetSemiLattice ((/\)))
import PlutusTx.Numeric qualified as N
import Prettyprinter (Pretty (pretty), colon, hang, viaShow, vsep, (<+>))


data ScriptLookups a =
    ScriptLookups
        { ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs            :: Map TxOutRef DecoratedTxOut
        -- ^ Unspent outputs that the script may want to spend
        , ScriptLookups a -> Map ScriptHash (Versioned Script)
slOtherScripts         :: Map ScriptHash (Versioned Script)
        -- ^ Scripts other than "our script"
        , ScriptLookups a -> Map DatumHash Datum
slOtherData            :: Map DatumHash Datum
        -- ^ Datums that we might need
        , ScriptLookups a -> Set PaymentPubKeyHash
slPaymentPubKeyHashes  :: Set PaymentPubKeyHash
        -- ^ Public keys that we might need
        , ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator       :: Maybe (TypedValidator a)
        -- ^ The script instance with the typed validator hash & actual compiled program
        , ScriptLookups a -> Maybe PaymentPubKeyHash
slOwnPaymentPubKeyHash :: Maybe PaymentPubKeyHash
        -- ^ The contract's payment public key hash, used for depositing tokens etc.
        , ScriptLookups a -> Maybe StakingCredential
slOwnStakingCredential :: Maybe StakingCredential
        -- ^ The contract's staking credentials (optional)
        } deriving stock (Int -> ScriptLookups a -> ShowS
[ScriptLookups a] -> ShowS
ScriptLookups a -> String
(Int -> ScriptLookups a -> ShowS)
-> (ScriptLookups a -> String)
-> ([ScriptLookups a] -> ShowS)
-> Show (ScriptLookups a)
forall a. Int -> ScriptLookups a -> ShowS
forall a. [ScriptLookups a] -> ShowS
forall a. ScriptLookups a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptLookups a] -> ShowS
$cshowList :: forall a. [ScriptLookups a] -> ShowS
show :: ScriptLookups a -> String
$cshow :: forall a. ScriptLookups a -> String
showsPrec :: Int -> ScriptLookups a -> ShowS
$cshowsPrec :: forall a. Int -> ScriptLookups a -> ShowS
Show, (forall x. ScriptLookups a -> Rep (ScriptLookups a) x)
-> (forall x. Rep (ScriptLookups a) x -> ScriptLookups a)
-> Generic (ScriptLookups a)
forall x. Rep (ScriptLookups a) x -> ScriptLookups a
forall x. ScriptLookups a -> Rep (ScriptLookups a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ScriptLookups a) x -> ScriptLookups a
forall a x. ScriptLookups a -> Rep (ScriptLookups a) x
$cto :: forall a x. Rep (ScriptLookups a) x -> ScriptLookups a
$cfrom :: forall a x. ScriptLookups a -> Rep (ScriptLookups a) x
Generic)
          deriving anyclass ([ScriptLookups a] -> Encoding
[ScriptLookups a] -> Value
ScriptLookups a -> Encoding
ScriptLookups a -> Value
(ScriptLookups a -> Value)
-> (ScriptLookups a -> Encoding)
-> ([ScriptLookups a] -> Value)
-> ([ScriptLookups a] -> Encoding)
-> ToJSON (ScriptLookups a)
forall a. [ScriptLookups a] -> Encoding
forall a. [ScriptLookups a] -> Value
forall a. ScriptLookups a -> Encoding
forall a. ScriptLookups a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ScriptLookups a] -> Encoding
$ctoEncodingList :: forall a. [ScriptLookups a] -> Encoding
toJSONList :: [ScriptLookups a] -> Value
$ctoJSONList :: forall a. [ScriptLookups a] -> Value
toEncoding :: ScriptLookups a -> Encoding
$ctoEncoding :: forall a. ScriptLookups a -> Encoding
toJSON :: ScriptLookups a -> Value
$ctoJSON :: forall a. ScriptLookups a -> Value
ToJSON, Value -> Parser [ScriptLookups a]
Value -> Parser (ScriptLookups a)
(Value -> Parser (ScriptLookups a))
-> (Value -> Parser [ScriptLookups a])
-> FromJSON (ScriptLookups a)
forall a. Value -> Parser [ScriptLookups a]
forall a. Value -> Parser (ScriptLookups a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ScriptLookups a]
$cparseJSONList :: forall a. Value -> Parser [ScriptLookups a]
parseJSON :: Value -> Parser (ScriptLookups a)
$cparseJSON :: forall a. Value -> Parser (ScriptLookups a)
FromJSON)

generalise :: ScriptLookups a -> ScriptLookups Any
generalise :: ScriptLookups a -> ScriptLookups Any
generalise ScriptLookups a
sl =
    let validator :: Maybe (TypedValidator Any)
validator = (TypedValidator a -> TypedValidator Any)
-> Maybe (TypedValidator a) -> Maybe (TypedValidator Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypedValidator a -> TypedValidator Any
forall a. TypedValidator a -> TypedValidator Any
Typed.generalise (ScriptLookups a -> Maybe (TypedValidator a)
forall a. ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator ScriptLookups a
sl)
    in ScriptLookups a
sl{slTypedValidator :: Maybe (TypedValidator Any)
slTypedValidator = Maybe (TypedValidator Any)
validator}

instance Semigroup (ScriptLookups a) where
    ScriptLookups a
l <> :: ScriptLookups a -> ScriptLookups a -> ScriptLookups a
<> ScriptLookups a
r =
        ScriptLookups :: forall a.
Map TxOutRef DecoratedTxOut
-> Map ScriptHash (Versioned Script)
-> Map DatumHash Datum
-> Set PaymentPubKeyHash
-> Maybe (TypedValidator a)
-> Maybe PaymentPubKeyHash
-> Maybe StakingCredential
-> ScriptLookups a
ScriptLookups
            { slTxOutputs :: Map TxOutRef DecoratedTxOut
slTxOutputs = ScriptLookups a -> Map TxOutRef DecoratedTxOut
forall a. ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs ScriptLookups a
l Map TxOutRef DecoratedTxOut
-> Map TxOutRef DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall a. Semigroup a => a -> a -> a
<> ScriptLookups a -> Map TxOutRef DecoratedTxOut
forall a. ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs ScriptLookups a
r
            , slOtherScripts :: Map ScriptHash (Versioned Script)
slOtherScripts = ScriptLookups a -> Map ScriptHash (Versioned Script)
forall a. ScriptLookups a -> Map ScriptHash (Versioned Script)
slOtherScripts ScriptLookups a
l Map ScriptHash (Versioned Script)
-> Map ScriptHash (Versioned Script)
-> Map ScriptHash (Versioned Script)
forall a. Semigroup a => a -> a -> a
<> ScriptLookups a -> Map ScriptHash (Versioned Script)
forall a. ScriptLookups a -> Map ScriptHash (Versioned Script)
slOtherScripts ScriptLookups a
r
            , slOtherData :: Map DatumHash Datum
slOtherData = ScriptLookups a -> Map DatumHash Datum
forall a. ScriptLookups a -> Map DatumHash Datum
slOtherData ScriptLookups a
l Map DatumHash Datum -> Map DatumHash Datum -> Map DatumHash Datum
forall a. Semigroup a => a -> a -> a
<> ScriptLookups a -> Map DatumHash Datum
forall a. ScriptLookups a -> Map DatumHash Datum
slOtherData ScriptLookups a
r
            , slPaymentPubKeyHashes :: Set PaymentPubKeyHash
slPaymentPubKeyHashes = ScriptLookups a -> Set PaymentPubKeyHash
forall a. ScriptLookups a -> Set PaymentPubKeyHash
slPaymentPubKeyHashes ScriptLookups a
l Set PaymentPubKeyHash
-> Set PaymentPubKeyHash -> Set PaymentPubKeyHash
forall a. Semigroup a => a -> a -> a
<> ScriptLookups a -> Set PaymentPubKeyHash
forall a. ScriptLookups a -> Set PaymentPubKeyHash
slPaymentPubKeyHashes ScriptLookups a
r
            -- 'First' to match the semigroup instance of Map (left-biased)
            , slTypedValidator :: Maybe (TypedValidator a)
slTypedValidator = (First (TypedValidator a) -> TypedValidator a)
-> Maybe (First (TypedValidator a)) -> Maybe (TypedValidator a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap First (TypedValidator a) -> TypedValidator a
forall a. First a -> a
getFirst (Maybe (First (TypedValidator a)) -> Maybe (TypedValidator a))
-> Maybe (First (TypedValidator a)) -> Maybe (TypedValidator a)
forall a b. (a -> b) -> a -> b
$ (TypedValidator a -> First (TypedValidator a)
forall a. a -> First a
First (TypedValidator a -> First (TypedValidator a))
-> Maybe (TypedValidator a) -> Maybe (First (TypedValidator a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptLookups a -> Maybe (TypedValidator a)
forall a. ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator ScriptLookups a
l) Maybe (First (TypedValidator a))
-> Maybe (First (TypedValidator a))
-> Maybe (First (TypedValidator a))
forall a. Semigroup a => a -> a -> a
<> (TypedValidator a -> First (TypedValidator a)
forall a. a -> First a
First (TypedValidator a -> First (TypedValidator a))
-> Maybe (TypedValidator a) -> Maybe (First (TypedValidator a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptLookups a -> Maybe (TypedValidator a)
forall a. ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator ScriptLookups a
r)
            , slOwnPaymentPubKeyHash :: Maybe PaymentPubKeyHash
slOwnPaymentPubKeyHash =
                (First PaymentPubKeyHash -> PaymentPubKeyHash)
-> Maybe (First PaymentPubKeyHash) -> Maybe PaymentPubKeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap First PaymentPubKeyHash -> PaymentPubKeyHash
forall a. First a -> a
getFirst (Maybe (First PaymentPubKeyHash) -> Maybe PaymentPubKeyHash)
-> Maybe (First PaymentPubKeyHash) -> Maybe PaymentPubKeyHash
forall a b. (a -> b) -> a -> b
$ (PaymentPubKeyHash -> First PaymentPubKeyHash
forall a. a -> First a
First (PaymentPubKeyHash -> First PaymentPubKeyHash)
-> Maybe PaymentPubKeyHash -> Maybe (First PaymentPubKeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptLookups a -> Maybe PaymentPubKeyHash
forall a. ScriptLookups a -> Maybe PaymentPubKeyHash
slOwnPaymentPubKeyHash ScriptLookups a
l)
                             Maybe (First PaymentPubKeyHash)
-> Maybe (First PaymentPubKeyHash)
-> Maybe (First PaymentPubKeyHash)
forall a. Semigroup a => a -> a -> a
<> (PaymentPubKeyHash -> First PaymentPubKeyHash
forall a. a -> First a
First (PaymentPubKeyHash -> First PaymentPubKeyHash)
-> Maybe PaymentPubKeyHash -> Maybe (First PaymentPubKeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptLookups a -> Maybe PaymentPubKeyHash
forall a. ScriptLookups a -> Maybe PaymentPubKeyHash
slOwnPaymentPubKeyHash ScriptLookups a
r)
            , slOwnStakingCredential :: Maybe StakingCredential
slOwnStakingCredential =
                (First StakingCredential -> StakingCredential)
-> Maybe (First StakingCredential) -> Maybe StakingCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap First StakingCredential -> StakingCredential
forall a. First a -> a
getFirst (Maybe (First StakingCredential) -> Maybe StakingCredential)
-> Maybe (First StakingCredential) -> Maybe StakingCredential
forall a b. (a -> b) -> a -> b
$ (StakingCredential -> First StakingCredential
forall a. a -> First a
First (StakingCredential -> First StakingCredential)
-> Maybe StakingCredential -> Maybe (First StakingCredential)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptLookups a -> Maybe StakingCredential
forall a. ScriptLookups a -> Maybe StakingCredential
slOwnStakingCredential ScriptLookups a
l)
                             Maybe (First StakingCredential)
-> Maybe (First StakingCredential)
-> Maybe (First StakingCredential)
forall a. Semigroup a => a -> a -> a
<> (StakingCredential -> First StakingCredential
forall a. a -> First a
First (StakingCredential -> First StakingCredential)
-> Maybe StakingCredential -> Maybe (First StakingCredential)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptLookups a -> Maybe StakingCredential
forall a. ScriptLookups a -> Maybe StakingCredential
slOwnStakingCredential ScriptLookups a
r)
            }

instance Monoid (ScriptLookups a) where
    mappend :: ScriptLookups a -> ScriptLookups a -> ScriptLookups a
mappend = ScriptLookups a -> ScriptLookups a -> ScriptLookups a
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: ScriptLookups a
mempty  = Map TxOutRef DecoratedTxOut
-> Map ScriptHash (Versioned Script)
-> Map DatumHash Datum
-> Set PaymentPubKeyHash
-> Maybe (TypedValidator a)
-> Maybe PaymentPubKeyHash
-> Maybe StakingCredential
-> ScriptLookups a
forall a.
Map TxOutRef DecoratedTxOut
-> Map ScriptHash (Versioned Script)
-> Map DatumHash Datum
-> Set PaymentPubKeyHash
-> Maybe (TypedValidator a)
-> Maybe PaymentPubKeyHash
-> Maybe StakingCredential
-> ScriptLookups a
ScriptLookups Map TxOutRef DecoratedTxOut
forall a. Monoid a => a
mempty Map ScriptHash (Versioned Script)
forall a. Monoid a => a
mempty Map DatumHash Datum
forall a. Monoid a => a
mempty Set PaymentPubKeyHash
forall a. Monoid a => a
mempty Maybe (TypedValidator a)
forall a. Maybe a
Nothing Maybe PaymentPubKeyHash
forall a. Maybe a
Nothing Maybe StakingCredential
forall a. Maybe a
Nothing

-- | A script lookups value with a script instance. For convenience this also
--   includes the minting policy script that forwards all checks to the
--   instance's validator.
--
-- If called multiple times, only the first typed validator is kept:
--
-- @
-- typedValidatorLookups tv1 <> typedValidatorLookups tv2 <> ...
--     == typedValidatorLookups tv1
-- @
typedValidatorLookups :: TypedValidator a -> ScriptLookups a
typedValidatorLookups :: TypedValidator a -> ScriptLookups a
typedValidatorLookups TypedValidator a
inst =
    let (ValidatorHash BuiltinByteString
vh, Versioned Validator
v) = (TypedValidator a -> ValidatorHash
forall a. TypedValidator a -> ValidatorHash
tvValidatorHash TypedValidator a
inst, TypedValidator a -> Versioned Validator
forall a. TypedValidator a -> Versioned Validator
tvValidator TypedValidator a
inst)
        (MintingPolicyHash BuiltinByteString
mph, Versioned MintingPolicy
mp) = (TypedValidator a -> MintingPolicyHash
forall a. TypedValidator a -> MintingPolicyHash
Typed.forwardingMintingPolicyHash TypedValidator a
inst, TypedValidator a -> Versioned MintingPolicy
forall a. TypedValidator a -> Versioned MintingPolicy
Typed.vForwardingMintingPolicy TypedValidator a
inst)
    in ScriptLookups Any
forall a. Monoid a => a
mempty
        { slOtherScripts :: Map ScriptHash (Versioned Script)
slOtherScripts =
            [(ScriptHash, Versioned Script)]
-> Map ScriptHash (Versioned Script)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
vh, (Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validator -> Script
getValidator Versioned Validator
v)
                         , (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
mph, (MintingPolicy -> Script)
-> Versioned MintingPolicy -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MintingPolicy -> Script
getMintingPolicy Versioned MintingPolicy
mp)
                         ]
        , slTypedValidator :: Maybe (TypedValidator a)
slTypedValidator = TypedValidator a -> Maybe (TypedValidator a)
forall a. a -> Maybe a
Just TypedValidator a
inst
        }


-- | A script lookups value that uses the map of unspent outputs to resolve
--   input constraints.
unspentOutputs :: Map TxOutRef DecoratedTxOut -> ScriptLookups a
unspentOutputs :: Map TxOutRef DecoratedTxOut -> ScriptLookups a
unspentOutputs Map TxOutRef DecoratedTxOut
mp = ScriptLookups a
forall a. Monoid a => a
mempty { slTxOutputs :: Map TxOutRef DecoratedTxOut
slTxOutputs = Map TxOutRef DecoratedTxOut
mp }

-- | A script lookups value with a versioned minting policy script.
mintingPolicy :: Versioned MintingPolicy -> ScriptLookups a
mintingPolicy :: Versioned MintingPolicy -> ScriptLookups a
mintingPolicy ((MintingPolicy -> Script)
-> Versioned MintingPolicy -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MintingPolicy -> Script
getMintingPolicy -> Versioned Script
script) = ScriptLookups a
forall a. Monoid a => a
mempty { slOtherScripts :: Map ScriptHash (Versioned Script)
slOtherScripts = ScriptHash -> Versioned Script -> Map ScriptHash (Versioned Script)
forall k a. k -> a -> Map k a
Map.singleton (Versioned Script -> ScriptHash
scriptHash Versioned Script
script) Versioned Script
script }

-- | A script lookups value with a PlutusV1 minting policy script.
plutusV1MintingPolicy :: MintingPolicy -> ScriptLookups a
plutusV1MintingPolicy :: MintingPolicy -> ScriptLookups a
plutusV1MintingPolicy MintingPolicy
pl = Versioned MintingPolicy -> ScriptLookups a
forall a. Versioned MintingPolicy -> ScriptLookups a
mintingPolicy (MintingPolicy -> Language -> Versioned MintingPolicy
forall script. script -> Language -> Versioned script
Tx.Versioned MintingPolicy
pl Language
PlutusV1)

-- | A script lookups value with a PlutusV2 minting policy script.
plutusV2MintingPolicy :: MintingPolicy -> ScriptLookups a
plutusV2MintingPolicy :: MintingPolicy -> ScriptLookups a
plutusV2MintingPolicy MintingPolicy
pl = Versioned MintingPolicy -> ScriptLookups a
forall a. Versioned MintingPolicy -> ScriptLookups a
mintingPolicy (MintingPolicy -> Language -> Versioned MintingPolicy
forall script. script -> Language -> Versioned script
Tx.Versioned MintingPolicy
pl Language
PlutusV2)

-- | A script lookups value with a versioned validator script.
otherScript :: Versioned Validator -> ScriptLookups a
otherScript :: Versioned Validator -> ScriptLookups a
otherScript ((Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validator -> Script
getValidator -> Versioned Script
script) = ScriptLookups a
forall a. Monoid a => a
mempty { slOtherScripts :: Map ScriptHash (Versioned Script)
slOtherScripts = ScriptHash -> Versioned Script -> Map ScriptHash (Versioned Script)
forall k a. k -> a -> Map k a
Map.singleton (Versioned Script -> ScriptHash
scriptHash Versioned Script
script) Versioned Script
script }

-- | A script lookups value with a PlutusV1 validator script.
plutusV1OtherScript :: Validator -> ScriptLookups a
plutusV1OtherScript :: Validator -> ScriptLookups a
plutusV1OtherScript Validator
vl = Versioned Validator -> ScriptLookups a
forall a. Versioned Validator -> ScriptLookups a
otherScript (Validator -> Language -> Versioned Validator
forall script. script -> Language -> Versioned script
Tx.Versioned Validator
vl Language
PlutusV1)

-- | A script lookups value with a PlutusV2 validator script.
plutusV2OtherScript :: Validator -> ScriptLookups a
plutusV2OtherScript :: Validator -> ScriptLookups a
plutusV2OtherScript Validator
vl = Versioned Validator -> ScriptLookups a
forall a. Versioned Validator -> ScriptLookups a
otherScript (Validator -> Language -> Versioned Validator
forall script. script -> Language -> Versioned script
Tx.Versioned Validator
vl Language
PlutusV2)

-- | A script lookups value with a datum.
otherData :: Datum -> ScriptLookups a
otherData :: Datum -> ScriptLookups a
otherData Datum
dt =
    let dh :: DatumHash
dh = Datum -> DatumHash
datumHash Datum
dt in
    ScriptLookups a
forall a. Monoid a => a
mempty { slOtherData :: Map DatumHash Datum
slOtherData = DatumHash -> Datum -> Map DatumHash Datum
forall k a. k -> a -> Map k a
Map.singleton DatumHash
dh Datum
dt }

makeLensesFor
    [ ("txIns", "txIns'")
    , ("txInsCollateral", "txInsCollateral'")
    , ("txInsReference", "txInsReference'")
    , ("txExtraKeyWits", "txExtraKeyWits'")
    , ("txOuts", "txOuts'")
    , ("txValidityRange", "txValidityRange'")
    , ("txMintValue", "txMintValue'")
    ] ''C.TxBodyContent

txIns :: Lens' C.CardanoBuildTx [(C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn C.BabbageEra))]
txIns :: ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
 -> f [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> CardanoBuildTx -> f CardanoBuildTx
txIns = (TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced ((TxBodyContent BuildTx BabbageEra
  -> f (TxBodyContent BuildTx BabbageEra))
 -> CardanoBuildTx -> f CardanoBuildTx)
-> (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
     -> f [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> f [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> CardanoBuildTx
-> f CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
 -> f [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall build era. Lens' (TxBodyContent build era) (TxIns build era)
txIns'

txInsCollateral :: Lens' C.CardanoBuildTx [C.TxIn]
txInsCollateral :: ([TxIn] -> f [TxIn]) -> CardanoBuildTx -> f CardanoBuildTx
txInsCollateral = (TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced ((TxBodyContent BuildTx BabbageEra
  -> f (TxBodyContent BuildTx BabbageEra))
 -> CardanoBuildTx -> f CardanoBuildTx)
-> (([TxIn] -> f [TxIn])
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> ([TxIn] -> f [TxIn])
-> CardanoBuildTx
-> f CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxInsCollateral BabbageEra -> f (TxInsCollateral BabbageEra))
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall build era.
Lens' (TxBodyContent build era) (TxInsCollateral era)
txInsCollateral' ((TxInsCollateral BabbageEra -> f (TxInsCollateral BabbageEra))
 -> TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> (([TxIn] -> f [TxIn])
    -> TxInsCollateral BabbageEra -> f (TxInsCollateral BabbageEra))
-> ([TxIn] -> f [TxIn])
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxInsCollateral BabbageEra -> [TxIn])
-> ([TxIn] -> TxInsCollateral BabbageEra)
-> Iso
     (TxInsCollateral BabbageEra)
     (TxInsCollateral BabbageEra)
     [TxIn]
     [TxIn]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso TxInsCollateral BabbageEra -> [TxIn]
forall era. TxInsCollateral era -> [TxIn]
toList [TxIn] -> TxInsCollateral BabbageEra
fromList
    where
        toList :: TxInsCollateral era -> [TxIn]
toList TxInsCollateral era
C.TxInsCollateralNone       = []
        toList (C.TxInsCollateral CollateralSupportedInEra era
_ [TxIn]
txins) = [TxIn]
txins
        fromList :: [TxIn] -> TxInsCollateral BabbageEra
fromList []    = TxInsCollateral BabbageEra
forall era. TxInsCollateral era
C.TxInsCollateralNone
        fromList [TxIn]
txins = CollateralSupportedInEra BabbageEra
-> [TxIn] -> TxInsCollateral BabbageEra
forall era.
CollateralSupportedInEra era -> [TxIn] -> TxInsCollateral era
C.TxInsCollateral CollateralSupportedInEra BabbageEra
C.CollateralInBabbageEra [TxIn]
txins

txExtraKeyWits :: Lens' C.CardanoBuildTx (Set.Set (C.Hash C.PaymentKey))
txExtraKeyWits :: (Set (Hash PaymentKey) -> f (Set (Hash PaymentKey)))
-> CardanoBuildTx -> f CardanoBuildTx
txExtraKeyWits = (TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced ((TxBodyContent BuildTx BabbageEra
  -> f (TxBodyContent BuildTx BabbageEra))
 -> CardanoBuildTx -> f CardanoBuildTx)
-> ((Set (Hash PaymentKey) -> f (Set (Hash PaymentKey)))
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> (Set (Hash PaymentKey) -> f (Set (Hash PaymentKey)))
-> CardanoBuildTx
-> f CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxExtraKeyWitnesses BabbageEra
 -> f (TxExtraKeyWitnesses BabbageEra))
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall build era.
Lens' (TxBodyContent build era) (TxExtraKeyWitnesses era)
txExtraKeyWits' ((TxExtraKeyWitnesses BabbageEra
  -> f (TxExtraKeyWitnesses BabbageEra))
 -> TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> ((Set (Hash PaymentKey) -> f (Set (Hash PaymentKey)))
    -> TxExtraKeyWitnesses BabbageEra
    -> f (TxExtraKeyWitnesses BabbageEra))
-> (Set (Hash PaymentKey) -> f (Set (Hash PaymentKey)))
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxExtraKeyWitnesses BabbageEra -> Set (Hash PaymentKey))
-> (Set (Hash PaymentKey) -> TxExtraKeyWitnesses BabbageEra)
-> Iso
     (TxExtraKeyWitnesses BabbageEra)
     (TxExtraKeyWitnesses BabbageEra)
     (Set (Hash PaymentKey))
     (Set (Hash PaymentKey))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso TxExtraKeyWitnesses BabbageEra -> Set (Hash PaymentKey)
forall era. TxExtraKeyWitnesses era -> Set (Hash PaymentKey)
toSet Set (Hash PaymentKey) -> TxExtraKeyWitnesses BabbageEra
fromSet
    where
        toSet :: TxExtraKeyWitnesses era -> Set (Hash PaymentKey)
toSet TxExtraKeyWitnesses era
C.TxExtraKeyWitnessesNone        = Set (Hash PaymentKey)
forall a. Monoid a => a
mempty
        toSet (C.TxExtraKeyWitnesses TxExtraKeyWitnessesSupportedInEra era
_ [Hash PaymentKey]
txwits) = [Hash PaymentKey] -> Set (Hash PaymentKey)
forall a. Ord a => [a] -> Set a
Set.fromList [Hash PaymentKey]
txwits
        fromSet :: Set (Hash PaymentKey) -> TxExtraKeyWitnesses BabbageEra
fromSet Set (Hash PaymentKey)
s | Set (Hash PaymentKey) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (Hash PaymentKey)
s    = TxExtraKeyWitnesses BabbageEra
forall era. TxExtraKeyWitnesses era
C.TxExtraKeyWitnessesNone
                  | Bool
otherwise = TxExtraKeyWitnessesSupportedInEra BabbageEra
-> [Hash PaymentKey] -> TxExtraKeyWitnesses BabbageEra
forall era.
TxExtraKeyWitnessesSupportedInEra era
-> [Hash PaymentKey] -> TxExtraKeyWitnesses era
C.TxExtraKeyWitnesses TxExtraKeyWitnessesSupportedInEra BabbageEra
C.ExtraKeyWitnessesInBabbageEra ([Hash PaymentKey] -> TxExtraKeyWitnesses BabbageEra)
-> [Hash PaymentKey] -> TxExtraKeyWitnesses BabbageEra
forall a b. (a -> b) -> a -> b
$ Set (Hash PaymentKey) -> [Hash PaymentKey]
forall a. Set a -> [a]
Set.toList Set (Hash PaymentKey)
s

txInsReference :: Lens' C.CardanoBuildTx [C.TxIn]
txInsReference :: ([TxIn] -> f [TxIn]) -> CardanoBuildTx -> f CardanoBuildTx
txInsReference = (TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced ((TxBodyContent BuildTx BabbageEra
  -> f (TxBodyContent BuildTx BabbageEra))
 -> CardanoBuildTx -> f CardanoBuildTx)
-> (([TxIn] -> f [TxIn])
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> ([TxIn] -> f [TxIn])
-> CardanoBuildTx
-> f CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxInsReference BuildTx BabbageEra
 -> f (TxInsReference BuildTx BabbageEra))
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall build era.
Lens' (TxBodyContent build era) (TxInsReference build era)
txInsReference' ((TxInsReference BuildTx BabbageEra
  -> f (TxInsReference BuildTx BabbageEra))
 -> TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> (([TxIn] -> f [TxIn])
    -> TxInsReference BuildTx BabbageEra
    -> f (TxInsReference BuildTx BabbageEra))
-> ([TxIn] -> f [TxIn])
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxInsReference BuildTx BabbageEra -> [TxIn])
-> ([TxIn] -> TxInsReference BuildTx BabbageEra)
-> Iso
     (TxInsReference BuildTx BabbageEra)
     (TxInsReference BuildTx BabbageEra)
     [TxIn]
     [TxIn]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso TxInsReference BuildTx BabbageEra -> [TxIn]
forall build era. TxInsReference build era -> [TxIn]
toList [TxIn] -> TxInsReference BuildTx BabbageEra
forall build. [TxIn] -> TxInsReference build BabbageEra
fromList
    where
        toList :: TxInsReference build era -> [TxIn]
toList TxInsReference build era
C.TxInsReferenceNone       = []
        toList (C.TxInsReference ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ [TxIn]
txins) = [TxIn]
txins
        fromList :: [TxIn] -> TxInsReference build BabbageEra
fromList []    = TxInsReference build BabbageEra
forall build era. TxInsReference build era
C.TxInsReferenceNone
        fromList [TxIn]
txins = ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
-> [TxIn] -> TxInsReference build BabbageEra
forall era build.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> [TxIn] -> TxInsReference build era
C.TxInsReference ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
C.ReferenceTxInsScriptsInlineDatumsInBabbageEra [TxIn]
txins

txMintValue :: Lens' C.CardanoBuildTx
                 (C.Value, Map.Map C.PolicyId (C.ScriptWitness C.WitCtxMint C.BabbageEra))
txMintValue :: ((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
 -> f (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
-> CardanoBuildTx -> f CardanoBuildTx
txMintValue = (TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced ((TxBodyContent BuildTx BabbageEra
  -> f (TxBodyContent BuildTx BabbageEra))
 -> CardanoBuildTx -> f CardanoBuildTx)
-> (((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
     -> f (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> ((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
    -> f (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
-> CardanoBuildTx
-> f CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMintValue BuildTx BabbageEra
 -> f (TxMintValue BuildTx BabbageEra))
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall build era.
Lens' (TxBodyContent build era) (TxMintValue build era)
txMintValue' ((TxMintValue BuildTx BabbageEra
  -> f (TxMintValue BuildTx BabbageEra))
 -> TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> (((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
     -> f (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
    -> TxMintValue BuildTx BabbageEra
    -> f (TxMintValue BuildTx BabbageEra))
-> ((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
    -> f (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMintValue BuildTx BabbageEra
 -> (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
-> ((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
    -> TxMintValue BuildTx BabbageEra)
-> Iso
     (TxMintValue BuildTx BabbageEra)
     (TxMintValue BuildTx BabbageEra)
     (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
     (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso TxMintValue BuildTx BabbageEra
-> (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
toMaybe (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
-> TxMintValue BuildTx BabbageEra
fromMaybe
    where
        toMaybe :: C.TxMintValue C.BuildTx C.BabbageEra -> (C.Value, Map.Map C.PolicyId (C.ScriptWitness C.WitCtxMint C.BabbageEra))
        toMaybe :: TxMintValue BuildTx BabbageEra
-> (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
toMaybe (C.TxMintValue MultiAssetSupportedInEra BabbageEra
_ Value
v (C.BuildTxWith Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
msc)) = (Value
v, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
msc)
        toMaybe TxMintValue BuildTx BabbageEra
_                                       = (Value
forall a. Monoid a => a
mempty, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
forall a. Monoid a => a
mempty)
        fromMaybe ::  (C.Value, Map.Map C.PolicyId (C.ScriptWitness C.WitCtxMint C.BabbageEra)) -> C.TxMintValue C.BuildTx C.BabbageEra
        fromMaybe :: (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
-> TxMintValue BuildTx BabbageEra
fromMaybe (Value
c, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
msc) = MultiAssetSupportedInEra BabbageEra
-> Value
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
-> TxMintValue BuildTx BabbageEra
forall era build.
MultiAssetSupportedInEra era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
C.TxMintValue MultiAssetSupportedInEra BabbageEra
C.MultiAssetInBabbageEra Value
c (Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
msc)

txOuts :: Lens' C.CardanoBuildTx [TxOut]
txOuts :: ([TxOut] -> f [TxOut]) -> CardanoBuildTx -> f CardanoBuildTx
txOuts = (TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced ((TxBodyContent BuildTx BabbageEra
  -> f (TxBodyContent BuildTx BabbageEra))
 -> CardanoBuildTx -> f CardanoBuildTx)
-> (([TxOut] -> f [TxOut])
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> ([TxOut] -> f [TxOut])
-> CardanoBuildTx
-> f CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut CtxTx BabbageEra] -> f [TxOut CtxTx BabbageEra])
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall build era. Lens' (TxBodyContent build era) [TxOut CtxTx era]
txOuts' (([TxOut CtxTx BabbageEra] -> f [TxOut CtxTx BabbageEra])
 -> TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> (([TxOut] -> f [TxOut])
    -> [TxOut CtxTx BabbageEra] -> f [TxOut CtxTx BabbageEra])
-> ([TxOut] -> f [TxOut])
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut] -> f [TxOut])
-> [TxOut CtxTx BabbageEra] -> f [TxOut CtxTx BabbageEra]
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

txValidityRange :: Lens' C.CardanoBuildTx (C.TxValidityLowerBound C.BabbageEra, C.TxValidityUpperBound C.BabbageEra)
txValidityRange :: ((TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
 -> f (TxValidityLowerBound BabbageEra,
       TxValidityUpperBound BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
txValidityRange = (TxBodyContent BuildTx BabbageEra
 -> f (TxBodyContent BuildTx BabbageEra))
-> CardanoBuildTx -> f CardanoBuildTx
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced ((TxBodyContent BuildTx BabbageEra
  -> f (TxBodyContent BuildTx BabbageEra))
 -> CardanoBuildTx -> f CardanoBuildTx)
-> (((TxValidityLowerBound BabbageEra,
      TxValidityUpperBound BabbageEra)
     -> f (TxValidityLowerBound BabbageEra,
           TxValidityUpperBound BabbageEra))
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> ((TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra)
    -> f (TxValidityLowerBound BabbageEra,
          TxValidityUpperBound BabbageEra))
-> CardanoBuildTx
-> f CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
 -> f (TxValidityLowerBound BabbageEra,
       TxValidityUpperBound BabbageEra))
-> TxBodyContent BuildTx BabbageEra
-> f (TxBodyContent BuildTx BabbageEra)
forall build era.
Lens'
  (TxBodyContent build era)
  (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange'

emptyCardanoBuildTx :: Params -> C.CardanoBuildTx
emptyCardanoBuildTx :: Params -> CardanoBuildTx
emptyCardanoBuildTx Params
p = TxBodyContent BuildTx BabbageEra -> CardanoBuildTx
C.CardanoBuildTx (TxBodyContent BuildTx BabbageEra -> CardanoBuildTx)
-> TxBodyContent BuildTx BabbageEra -> CardanoBuildTx
forall a b. (a -> b) -> a -> b
$ TxBodyContent :: forall build era.
TxIns build era
-> TxInsCollateral era
-> TxInsReference build era
-> [TxOut CtxTx era]
-> TxTotalCollateral era
-> TxReturnCollateral CtxTx era
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> TxScriptValidity era
-> TxBodyContent build era
C.TxBodyContent
    { txIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
C.txIns = [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
forall a. Monoid a => a
mempty
    , txInsCollateral :: TxInsCollateral BabbageEra
C.txInsCollateral = CollateralSupportedInEra BabbageEra
-> [TxIn] -> TxInsCollateral BabbageEra
forall era.
CollateralSupportedInEra era -> [TxIn] -> TxInsCollateral era
C.TxInsCollateral CollateralSupportedInEra BabbageEra
C.CollateralInBabbageEra [TxIn]
forall a. Monoid a => a
mempty
    , txInsReference :: TxInsReference BuildTx BabbageEra
C.txInsReference = TxInsReference BuildTx BabbageEra
forall build era. TxInsReference build era
C.TxInsReferenceNone
    , txOuts :: [TxOut CtxTx BabbageEra]
C.txOuts = [TxOut CtxTx BabbageEra]
forall a. Monoid a => a
mempty
    , txTotalCollateral :: TxTotalCollateral BabbageEra
C.txTotalCollateral = TxTotalCollateral BabbageEra
forall era. TxTotalCollateral era
C.TxTotalCollateralNone
    , txReturnCollateral :: TxReturnCollateral CtxTx BabbageEra
C.txReturnCollateral = TxReturnCollateral CtxTx BabbageEra
forall ctx era. TxReturnCollateral ctx era
C.TxReturnCollateralNone
    , txFee :: TxFee BabbageEra
C.txFee = TxFeesExplicitInEra BabbageEra -> Lovelace -> TxFee BabbageEra
forall era. TxFeesExplicitInEra era -> Lovelace -> TxFee era
C.TxFeeExplicit TxFeesExplicitInEra BabbageEra
C.TxFeesExplicitInBabbageEra Lovelace
forall a. Monoid a => a
mempty
    , txValidityRange :: (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
C.txValidityRange = (TxValidityLowerBound BabbageEra
forall era. TxValidityLowerBound era
C.TxValidityNoLowerBound, ValidityNoUpperBoundSupportedInEra BabbageEra
-> TxValidityUpperBound BabbageEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
C.TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra BabbageEra
C.ValidityNoUpperBoundInBabbageEra)
    , txMintValue :: TxMintValue BuildTx BabbageEra
C.txMintValue = TxMintValue BuildTx BabbageEra
forall build era. TxMintValue build era
C.TxMintNone
    , txProtocolParams :: BuildTxWith BuildTx (Maybe ProtocolParameters)
C.txProtocolParams = Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith (Maybe ProtocolParameters
 -> BuildTxWith BuildTx (Maybe ProtocolParameters))
-> Maybe ProtocolParameters
-> BuildTxWith BuildTx (Maybe ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Maybe ProtocolParameters
forall a. a -> Maybe a
Just (ProtocolParameters -> Maybe ProtocolParameters)
-> ProtocolParameters -> Maybe ProtocolParameters
forall a b. (a -> b) -> a -> b
$ Params -> ProtocolParameters
pProtocolParams Params
p
    , txScriptValidity :: TxScriptValidity BabbageEra
C.txScriptValidity = TxScriptValidity BabbageEra
forall era. TxScriptValidity era
C.TxScriptValidityNone
    , txExtraKeyWits :: TxExtraKeyWitnesses BabbageEra
C.txExtraKeyWits = TxExtraKeyWitnesses BabbageEra
forall era. TxExtraKeyWitnesses era
C.TxExtraKeyWitnessesNone
    , txMetadata :: TxMetadataInEra BabbageEra
C.txMetadata = TxMetadataInEra BabbageEra
forall era. TxMetadataInEra era
C.TxMetadataNone
    , txAuxScripts :: TxAuxScripts BabbageEra
C.txAuxScripts = TxAuxScripts BabbageEra
forall era. TxAuxScripts era
C.TxAuxScriptsNone
    , txWithdrawals :: TxWithdrawals BuildTx BabbageEra
C.txWithdrawals = TxWithdrawals BuildTx BabbageEra
forall build era. TxWithdrawals build era
C.TxWithdrawalsNone
    , txCertificates :: TxCertificates BuildTx BabbageEra
C.txCertificates = TxCertificates BuildTx BabbageEra
forall build era. TxCertificates build era
C.TxCertificatesNone
    , txUpdateProposal :: TxUpdateProposal BabbageEra
C.txUpdateProposal = TxUpdateProposal BabbageEra
forall era. TxUpdateProposal era
C.TxUpdateProposalNone
    }

emptyUnbalancedTx :: Params -> UnbalancedTx
emptyUnbalancedTx :: Params -> UnbalancedTx
emptyUnbalancedTx Params
params = CardanoBuildTx -> UtxoIndex -> UnbalancedTx
UnbalancedCardanoTx (Params -> CardanoBuildTx
emptyCardanoBuildTx Params
params) UtxoIndex
forall a. Monoid a => a
mempty

-- | A script lookups value with a payment public key
paymentPubKey :: PaymentPubKey -> ScriptLookups a
paymentPubKey :: PaymentPubKey -> ScriptLookups a
paymentPubKey (PaymentPubKey PubKey
pk) =
   PaymentPubKeyHash -> ScriptLookups a
forall a. PaymentPubKeyHash -> ScriptLookups a
paymentPubKeyHash (PubKeyHash -> PaymentPubKeyHash
PaymentPubKeyHash (PubKeyHash -> PaymentPubKeyHash)
-> PubKeyHash -> PaymentPubKeyHash
forall a b. (a -> b) -> a -> b
$ PubKey -> PubKeyHash
pubKeyHash PubKey
pk)

-- | A script lookups value with a payment public key
paymentPubKeyHash :: PaymentPubKeyHash -> ScriptLookups a
paymentPubKeyHash :: PaymentPubKeyHash -> ScriptLookups a
paymentPubKeyHash PaymentPubKeyHash
pkh =
    ScriptLookups a
forall a. Monoid a => a
mempty { slPaymentPubKeyHashes :: Set PaymentPubKeyHash
slPaymentPubKeyHashes = PaymentPubKeyHash -> Set PaymentPubKeyHash
forall a. a -> Set a
Set.singleton PaymentPubKeyHash
pkh }


-- | An unbalanced transaction. It needs to be balanced and signed before it
--   can be submitted to the ledger. See note [Submitting transactions from
--   Plutus contracts] in 'Plutus.Contract.Wallet'.
data UnbalancedTx
    = UnbalancedCardanoTx
        { UnbalancedTx -> CardanoBuildTx
unBalancedCardanoBuildTx :: C.CardanoBuildTx
        , UnbalancedTx -> UtxoIndex
unBalancedTxUtxoIndex    :: UtxoIndex
        -- ^ Utxo lookups that are used for adding inputs to the 'UnbalancedTx'.
        -- Simply refers to  'slTxOutputs' of 'ScriptLookups'.
        }
    deriving stock (UnbalancedTx -> UnbalancedTx -> Bool
(UnbalancedTx -> UnbalancedTx -> Bool)
-> (UnbalancedTx -> UnbalancedTx -> Bool) -> Eq UnbalancedTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnbalancedTx -> UnbalancedTx -> Bool
$c/= :: UnbalancedTx -> UnbalancedTx -> Bool
== :: UnbalancedTx -> UnbalancedTx -> Bool
$c== :: UnbalancedTx -> UnbalancedTx -> Bool
Eq, (forall x. UnbalancedTx -> Rep UnbalancedTx x)
-> (forall x. Rep UnbalancedTx x -> UnbalancedTx)
-> Generic UnbalancedTx
forall x. Rep UnbalancedTx x -> UnbalancedTx
forall x. UnbalancedTx -> Rep UnbalancedTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnbalancedTx x -> UnbalancedTx
$cfrom :: forall x. UnbalancedTx -> Rep UnbalancedTx x
Generic, Int -> UnbalancedTx -> ShowS
[UnbalancedTx] -> ShowS
UnbalancedTx -> String
(Int -> UnbalancedTx -> ShowS)
-> (UnbalancedTx -> String)
-> ([UnbalancedTx] -> ShowS)
-> Show UnbalancedTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnbalancedTx] -> ShowS
$cshowList :: [UnbalancedTx] -> ShowS
show :: UnbalancedTx -> String
$cshow :: UnbalancedTx -> String
showsPrec :: Int -> UnbalancedTx -> ShowS
$cshowsPrec :: Int -> UnbalancedTx -> ShowS
Show)
    deriving anyclass (Value -> Parser [UnbalancedTx]
Value -> Parser UnbalancedTx
(Value -> Parser UnbalancedTx)
-> (Value -> Parser [UnbalancedTx]) -> FromJSON UnbalancedTx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UnbalancedTx]
$cparseJSONList :: Value -> Parser [UnbalancedTx]
parseJSON :: Value -> Parser UnbalancedTx
$cparseJSON :: Value -> Parser UnbalancedTx
FromJSON, [UnbalancedTx] -> Encoding
[UnbalancedTx] -> Value
UnbalancedTx -> Encoding
UnbalancedTx -> Value
(UnbalancedTx -> Value)
-> (UnbalancedTx -> Encoding)
-> ([UnbalancedTx] -> Value)
-> ([UnbalancedTx] -> Encoding)
-> ToJSON UnbalancedTx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UnbalancedTx] -> Encoding
$ctoEncodingList :: [UnbalancedTx] -> Encoding
toJSONList :: [UnbalancedTx] -> Value
$ctoJSONList :: [UnbalancedTx] -> Value
toEncoding :: UnbalancedTx -> Encoding
$ctoEncoding :: UnbalancedTx -> Encoding
toJSON :: UnbalancedTx -> Value
$ctoJSON :: UnbalancedTx -> Value
ToJSON)

makeLensesFor
    [ ("unBalancedCardanoBuildTx", "cardanoTx")
    , ("unBalancedTxUtxoIndex", "utxoIndex")
    ] ''UnbalancedTx

tx :: Traversal' UnbalancedTx C.CardanoBuildTx
tx :: (CardanoBuildTx -> f CardanoBuildTx)
-> UnbalancedTx -> f UnbalancedTx
tx = (CardanoBuildTx -> f CardanoBuildTx)
-> UnbalancedTx -> f UnbalancedTx
Lens' UnbalancedTx CardanoBuildTx
cardanoTx

instance Pretty UnbalancedTx where
    pretty :: UnbalancedTx -> Doc ann
pretty (UnbalancedCardanoTx CardanoBuildTx
utx (C.UTxO Map TxIn (TxOut CtxUTxO BabbageEra)
utxo)) =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"Tx:", CardanoBuildTx -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty CardanoBuildTx
utx]
        , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"Requires signatures:" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Hash PaymentKey -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (Hash PaymentKey -> Doc ann) -> [Hash PaymentKey] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Hash PaymentKey) -> [Hash PaymentKey]
forall a. Set a -> [a]
Set.toList (CardanoBuildTx
utx CardanoBuildTx
-> Getting
     (Set (Hash PaymentKey)) CardanoBuildTx (Set (Hash PaymentKey))
-> Set (Hash PaymentKey)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (Hash PaymentKey)) CardanoBuildTx (Set (Hash PaymentKey))
Lens' CardanoBuildTx (Set (Hash PaymentKey))
txExtraKeyWits))
        , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"Utxo index:" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((TxIn, TxOut CtxUTxO BabbageEra) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((TxIn, TxOut CtxUTxO BabbageEra) -> Doc ann)
-> [(TxIn, TxOut CtxUTxO BabbageEra)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn (TxOut CtxUTxO BabbageEra)
-> [(TxIn, TxOut CtxUTxO BabbageEra)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn (TxOut CtxUTxO BabbageEra)
utxo)
        ]

{- Note [Balance of value spent]

To build a transaction that satisfies the 'MustSpendAtLeast' and
'MustProduceAtLeast' constraints, we keep a tally of the required and
actual values we encounter on either side of the transaction. Then we
compute the missing value on both sides, and add an input with the
join of the positive parts [1] of the missing values.

[1] See 'Plutus.V1.Ledger.Value.split'

-}

-- | The balances we track for computing the missing 'Value' (if any)
--   that needs to be added to the transaction.
--   See note [Balance of value spent].
data ValueSpentBalances =
    ValueSpentBalances
        { ValueSpentBalances -> Value
vbsRequired :: Value
        -- ^ Required value spent by the transaction.
        , ValueSpentBalances -> Value
vbsProvided :: Value
        -- ^ Value provided by an input or output of the transaction.
        } deriving (Int -> ValueSpentBalances -> ShowS
[ValueSpentBalances] -> ShowS
ValueSpentBalances -> String
(Int -> ValueSpentBalances -> ShowS)
-> (ValueSpentBalances -> String)
-> ([ValueSpentBalances] -> ShowS)
-> Show ValueSpentBalances
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueSpentBalances] -> ShowS
$cshowList :: [ValueSpentBalances] -> ShowS
show :: ValueSpentBalances -> String
$cshow :: ValueSpentBalances -> String
showsPrec :: Int -> ValueSpentBalances -> ShowS
$cshowsPrec :: Int -> ValueSpentBalances -> ShowS
Show, (forall x. ValueSpentBalances -> Rep ValueSpentBalances x)
-> (forall x. Rep ValueSpentBalances x -> ValueSpentBalances)
-> Generic ValueSpentBalances
forall x. Rep ValueSpentBalances x -> ValueSpentBalances
forall x. ValueSpentBalances -> Rep ValueSpentBalances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValueSpentBalances x -> ValueSpentBalances
$cfrom :: forall x. ValueSpentBalances -> Rep ValueSpentBalances x
Generic)

instance Semigroup ValueSpentBalances where
    ValueSpentBalances
l <> :: ValueSpentBalances -> ValueSpentBalances -> ValueSpentBalances
<> ValueSpentBalances
r =
        ValueSpentBalances :: Value -> Value -> ValueSpentBalances
ValueSpentBalances
            { vbsRequired :: Value
vbsRequired = ValueSpentBalances -> Value
vbsRequired ValueSpentBalances
l Value -> Value -> Value
forall a. JoinSemiLattice a => a -> a -> a
\/ ValueSpentBalances -> Value
vbsRequired ValueSpentBalances
r
            , vbsProvided :: Value
vbsProvided = ValueSpentBalances -> Value
vbsProvided ValueSpentBalances
l Value -> Value -> Value
forall a. JoinSemiLattice a => a -> a -> a
\/ ValueSpentBalances -> Value
vbsProvided ValueSpentBalances
r
            }

-- No @Monoid ValueSpentBalances@ because @max@ (used by 'convexUnion') is only
-- a semigroup. In this module we only use @Value@s with non-negative amounts,
-- so @mempty :: Value@ technically is the identity, but I'd rather not
-- define the instance. Maybe we need a type for non-negative @Value@s.

data ConstraintProcessingState =
    ConstraintProcessingState
        { ConstraintProcessingState -> UnbalancedTx
cpsUnbalancedTx              :: UnbalancedTx
        -- ^ The unbalanced transaction that we're building
        , ConstraintProcessingState -> ValueSpentBalances
cpsValueSpentBalancesInputs  :: ValueSpentBalances
        -- ^ Balance of the values given and required for the transaction's
        --   inputs
        , ConstraintProcessingState -> ValueSpentBalances
cpsValueSpentBalancesOutputs :: ValueSpentBalances
        -- ^ Balance of the values produced and required for the transaction's
        --   outputs
        , ConstraintProcessingState -> Params
cpsParams                    :: Params
        }

missingValueSpent :: ValueSpentBalances -> Value
missingValueSpent :: ValueSpentBalances -> Value
missingValueSpent ValueSpentBalances{Value
vbsRequired :: Value
vbsRequired :: ValueSpentBalances -> Value
vbsRequired, Value
vbsProvided :: Value
vbsProvided :: ValueSpentBalances -> Value
vbsProvided} =
    let
        difference :: Value
difference = Value
vbsRequired Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
N.negate Value
vbsProvided
        (Value
_, Value
missing) = Value -> (Value, Value)
Value.split Value
difference
    in Value
missing

makeLensesFor
    [ ("cpsUnbalancedTx", "unbalancedTx")
    , ("cpsMintRedeemers", "mintRedeemers")
    , ("cpsValueSpentBalancesInputs", "valueSpentInputs")
    , ("cpsValueSpentBalancesOutputs", "valueSpentOutputs")
    , ("cpsParams", "paramsL")
    ] ''ConstraintProcessingState

initialState :: Params -> ConstraintProcessingState
initialState :: Params -> ConstraintProcessingState
initialState Params
params = ConstraintProcessingState :: UnbalancedTx
-> ValueSpentBalances
-> ValueSpentBalances
-> Params
-> ConstraintProcessingState
ConstraintProcessingState
    { cpsUnbalancedTx :: UnbalancedTx
cpsUnbalancedTx = Params -> UnbalancedTx
emptyUnbalancedTx Params
params
    , cpsValueSpentBalancesInputs :: ValueSpentBalances
cpsValueSpentBalancesInputs = Value -> Value -> ValueSpentBalances
ValueSpentBalances Value
forall a. Monoid a => a
mempty Value
forall a. Monoid a => a
mempty
    , cpsValueSpentBalancesOutputs :: ValueSpentBalances
cpsValueSpentBalancesOutputs = Value -> Value -> ValueSpentBalances
ValueSpentBalances Value
forall a. Monoid a => a
mempty Value
forall a. Monoid a => a
mempty
    , cpsParams :: Params
cpsParams = Params
params
    }

provided :: Value -> ValueSpentBalances
provided :: Value -> ValueSpentBalances
provided Value
v = ValueSpentBalances :: Value -> Value -> ValueSpentBalances
ValueSpentBalances { vbsProvided :: Value
vbsProvided = Value
v, vbsRequired :: Value
vbsRequired = Value
forall a. Monoid a => a
mempty }

required :: Value -> ValueSpentBalances
required :: Value -> ValueSpentBalances
required Value
v = ValueSpentBalances :: Value -> Value -> ValueSpentBalances
ValueSpentBalances { vbsRequired :: Value
vbsRequired = Value
v, vbsProvided :: Value
vbsProvided = Value
forall a. Monoid a => a
mempty }

-- | Some typed 'TxConstraints' and the 'ScriptLookups' needed to turn them
--   into an 'UnbalancedTx'.
data SomeLookupsAndConstraints where
    SomeLookupsAndConstraints
        :: forall a. (FromData (DatumType a), ToData (DatumType a), ToData (RedeemerType a))
        => ScriptLookups a
        -> TxConstraints (RedeemerType a) (DatumType a)
        -> SomeLookupsAndConstraints

data MkTxError =
      TypeCheckFailed Typed.ConnectionError
    | ToCardanoError C.ToCardanoError
    | TxOutRefNotFound TxOutRef
    | TxOutRefWrongType TxOutRef
    | TxOutRefNoReferenceScript TxOutRef
    | DatumNotFound DatumHash
    | DeclaredInputMismatch Value
    | DeclaredOutputMismatch Value
    | MintingPolicyNotFound MintingPolicyHash
    | ScriptHashNotFound ScriptHash
    | TypedValidatorMissing
    | DatumWrongHash DatumHash Datum
    | CannotSatisfyAny
    | NoMatchingOutputFound ValidatorHash
    | MultipleMatchingOutputsFound ValidatorHash
    | AmbiguousRedeemer TxOutRef [Redeemer]
    | AmbiguousReferenceScript TxOutRef [TxOutRef]
    deriving stock (MkTxError -> MkTxError -> Bool
(MkTxError -> MkTxError -> Bool)
-> (MkTxError -> MkTxError -> Bool) -> Eq MkTxError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MkTxError -> MkTxError -> Bool
$c/= :: MkTxError -> MkTxError -> Bool
== :: MkTxError -> MkTxError -> Bool
$c== :: MkTxError -> MkTxError -> Bool
Eq, Int -> MkTxError -> ShowS
[MkTxError] -> ShowS
MkTxError -> String
(Int -> MkTxError -> ShowS)
-> (MkTxError -> String)
-> ([MkTxError] -> ShowS)
-> Show MkTxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MkTxError] -> ShowS
$cshowList :: [MkTxError] -> ShowS
show :: MkTxError -> String
$cshow :: MkTxError -> String
showsPrec :: Int -> MkTxError -> ShowS
$cshowsPrec :: Int -> MkTxError -> ShowS
Show, (forall x. MkTxError -> Rep MkTxError x)
-> (forall x. Rep MkTxError x -> MkTxError) -> Generic MkTxError
forall x. Rep MkTxError x -> MkTxError
forall x. MkTxError -> Rep MkTxError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MkTxError x -> MkTxError
$cfrom :: forall x. MkTxError -> Rep MkTxError x
Generic)
    deriving anyclass ([MkTxError] -> Encoding
[MkTxError] -> Value
MkTxError -> Encoding
MkTxError -> Value
(MkTxError -> Value)
-> (MkTxError -> Encoding)
-> ([MkTxError] -> Value)
-> ([MkTxError] -> Encoding)
-> ToJSON MkTxError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MkTxError] -> Encoding
$ctoEncodingList :: [MkTxError] -> Encoding
toJSONList :: [MkTxError] -> Value
$ctoJSONList :: [MkTxError] -> Value
toEncoding :: MkTxError -> Encoding
$ctoEncoding :: MkTxError -> Encoding
toJSON :: MkTxError -> Value
$ctoJSON :: MkTxError -> Value
ToJSON, Value -> Parser [MkTxError]
Value -> Parser MkTxError
(Value -> Parser MkTxError)
-> (Value -> Parser [MkTxError]) -> FromJSON MkTxError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MkTxError]
$cparseJSONList :: Value -> Parser [MkTxError]
parseJSON :: Value -> Parser MkTxError
$cparseJSON :: Value -> Parser MkTxError
FromJSON)
makeClassyPrisms ''MkTxError

instance Pretty MkTxError where
    pretty :: MkTxError -> Doc ann
pretty = \case
        TypeCheckFailed ConnectionError
e              -> Doc ann
"Type check failed:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ConnectionError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ConnectionError
e
        ToCardanoError ToCardanoError
e               -> Doc ann
"Cardano conversion error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ToCardanoError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ToCardanoError
e
        TxOutRefNotFound TxOutRef
t             -> Doc ann
"Tx out reference not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxOutRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOutRef
t
        TxOutRefWrongType TxOutRef
t            -> Doc ann
"Tx out reference wrong type:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxOutRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOutRef
t
        TxOutRefNoReferenceScript TxOutRef
t    -> Doc ann
"Tx out reference does not contain a reference script:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxOutRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOutRef
t
        DatumNotFound DatumHash
h                -> Doc ann
"No datum with hash" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DatumHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty DatumHash
h Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"was found in lookups value"
        DeclaredInputMismatch Value
v        -> Doc ann
"Discrepancy of" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
v Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"inputs"
        DeclaredOutputMismatch Value
v       -> Doc ann
"Discrepancy of" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
v Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"outputs"
        MintingPolicyNotFound MintingPolicyHash
h        -> Doc ann
"No minting policy with hash" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MintingPolicyHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty MintingPolicyHash
h Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"was found"
        ScriptHashNotFound ScriptHash
h           -> Doc ann
"No script with hash" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ScriptHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ScriptHash
h Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"was found"
        MkTxError
TypedValidatorMissing          -> Doc ann
"Script instance is missing"
        DatumWrongHash DatumHash
h Datum
d             -> Doc ann
"Wrong hash for datum" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Datum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Datum
d Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DatumHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty DatumHash
h
        MkTxError
CannotSatisfyAny               -> Doc ann
"Cannot satisfy any of the required constraints"
        NoMatchingOutputFound ValidatorHash
h        -> Doc ann
"No matching output found for validator hash" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ValidatorHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ValidatorHash
h
        MultipleMatchingOutputsFound ValidatorHash
h -> Doc ann
"Multiple matching outputs found for validator hash" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ValidatorHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ValidatorHash
h
        AmbiguousRedeemer TxOutRef
t [Redeemer]
rs         -> Doc ann
"Try to spend a script output" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxOutRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOutRef
t
                                       Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"with different redeemers:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Redeemer] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Redeemer]
rs
        AmbiguousReferenceScript TxOutRef
t [TxOutRef]
rss -> Doc ann
"Try to spend a script output" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxOutRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOutRef
t
                                       Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"with different referenceScript:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [TxOutRef] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [TxOutRef]
rss

-- | Given a list of 'SomeLookupsAndConstraints' describing the constraints
--   for several scripts, build a single transaction that runs all the scripts.
mkSomeTx
    :: Params
    -> [SomeLookupsAndConstraints]
    -> Either MkTxError UnbalancedTx
mkSomeTx :: Params
-> [SomeLookupsAndConstraints] -> Either MkTxError UnbalancedTx
mkSomeTx Params
params [SomeLookupsAndConstraints]
xs =
    let process :: SomeLookupsAndConstraints
-> StateT ConstraintProcessingState (Except MkTxError) ()
process = \case
            SomeLookupsAndConstraints ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
constraints ->
                ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> StateT ConstraintProcessingState (Except MkTxError) ()
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> StateT ConstraintProcessingState (Except MkTxError) ()
processLookupsAndConstraints ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
constraints
    in  (ConstraintProcessingState -> UnbalancedTx)
-> Either MkTxError ConstraintProcessingState
-> Either MkTxError UnbalancedTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstraintProcessingState -> UnbalancedTx
cpsUnbalancedTx
        (Either MkTxError ConstraintProcessingState
 -> Either MkTxError UnbalancedTx)
-> Either MkTxError ConstraintProcessingState
-> Either MkTxError UnbalancedTx
forall a b. (a -> b) -> a -> b
$ Except MkTxError ConstraintProcessingState
-> Either MkTxError ConstraintProcessingState
forall e a. Except e a -> Either e a
runExcept
        (Except MkTxError ConstraintProcessingState
 -> Either MkTxError ConstraintProcessingState)
-> Except MkTxError ConstraintProcessingState
-> Either MkTxError ConstraintProcessingState
forall a b. (a -> b) -> a -> b
$ StateT ConstraintProcessingState (Except MkTxError) [()]
-> ConstraintProcessingState
-> Except MkTxError ConstraintProcessingState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((SomeLookupsAndConstraints
 -> StateT ConstraintProcessingState (Except MkTxError) ())
-> [SomeLookupsAndConstraints]
-> StateT ConstraintProcessingState (Except MkTxError) [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SomeLookupsAndConstraints
-> StateT ConstraintProcessingState (Except MkTxError) ()
process [SomeLookupsAndConstraints]
xs) (Params -> ConstraintProcessingState
initialState Params
params)

data SortedConstraints
   = MkSortedConstraints
   { SortedConstraints -> [POSIXTimeRange]
rangeConstraints :: [POSIXTimeRange]
   , SortedConstraints -> [TxConstraint]
otherConstraints :: [TxConstraint]
   } deriving (SortedConstraints -> SortedConstraints -> Bool
(SortedConstraints -> SortedConstraints -> Bool)
-> (SortedConstraints -> SortedConstraints -> Bool)
-> Eq SortedConstraints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortedConstraints -> SortedConstraints -> Bool
$c/= :: SortedConstraints -> SortedConstraints -> Bool
== :: SortedConstraints -> SortedConstraints -> Bool
$c== :: SortedConstraints -> SortedConstraints -> Bool
Eq, Int -> SortedConstraints -> ShowS
[SortedConstraints] -> ShowS
SortedConstraints -> String
(Int -> SortedConstraints -> ShowS)
-> (SortedConstraints -> String)
-> ([SortedConstraints] -> ShowS)
-> Show SortedConstraints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortedConstraints] -> ShowS
$cshowList :: [SortedConstraints] -> ShowS
show :: SortedConstraints -> String
$cshow :: SortedConstraints -> String
showsPrec :: Int -> SortedConstraints -> ShowS
$cshowsPrec :: Int -> SortedConstraints -> ShowS
Show)

-- | Filtering MustSpend constraints to ensure their consistency and check that we do not try to spend them
-- with different redeemer or reference scripts.
--
-- When:
--     - 2 or more MustSpendPubkeyOutput are defined for the same output, we only keep the first one
--     - 2 or more MustSpendScriptOutpt are defined for the same output:
--          - if they have different redeemer, we throw an 'AmbiguousRedeemer' error;
--          - if they provide more than one reference script we throw an 'AmbiguousReferenceScript' error;
--          - if only one define a reference script, we use that reference script.
cleaningMustSpendConstraints :: MonadError MkTxError m => [TxConstraint] -> m [TxConstraint]
cleaningMustSpendConstraints :: [TxConstraint] -> m [TxConstraint]
cleaningMustSpendConstraints (x :: TxConstraint
x@(MustSpendScriptOutput TxOutRef
t Redeemer
_ Maybe TxOutRef
_):[TxConstraint]
xs) = do
    let
        spendSame :: TxConstraint -> Bool
spendSame (MustSpendScriptOutput TxOutRef
t' Redeemer
_ Maybe TxOutRef
_) = TxOutRef
t TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TxOutRef
t'
        spendSame TxConstraint
_                              = Bool
False
        getRedeemer :: TxConstraint -> Maybe Redeemer
getRedeemer (MustSpendScriptOutput TxOutRef
_ Redeemer
r Maybe TxOutRef
_) = Redeemer -> Maybe Redeemer
forall a. a -> Maybe a
Just Redeemer
r
        getRedeemer TxConstraint
_                             = Maybe Redeemer
forall a. Maybe a
Nothing
        getReferenceScript :: TxConstraint -> Maybe TxOutRef
getReferenceScript (MustSpendScriptOutput TxOutRef
_ Redeemer
_ Maybe TxOutRef
rs) = Maybe TxOutRef
rs
        getReferenceScript TxConstraint
_                              = Maybe TxOutRef
forall a. Maybe a
Nothing
        ([TxConstraint]
mustSpendSame, [TxConstraint]
otherConstraints) = (TxConstraint -> Bool)
-> [TxConstraint] -> ([TxConstraint], [TxConstraint])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition TxConstraint -> Bool
spendSame [TxConstraint]
xs
        redeemers :: Set Redeemer
redeemers = [Redeemer] -> Set Redeemer
forall a. Ord a => [a] -> Set a
Set.fromList ([Redeemer] -> Set Redeemer) -> [Redeemer] -> Set Redeemer
forall a b. (a -> b) -> a -> b
$ (TxConstraint -> Maybe Redeemer) -> [TxConstraint] -> [Redeemer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxConstraint -> Maybe Redeemer
getRedeemer (TxConstraint
xTxConstraint -> [TxConstraint] -> [TxConstraint]
forall a. a -> [a] -> [a]
:[TxConstraint]
mustSpendSame)
        referenceScripts :: Set TxOutRef
referenceScripts = [TxOutRef] -> Set TxOutRef
forall a. Ord a => [a] -> Set a
Set.fromList ([TxOutRef] -> Set TxOutRef) -> [TxOutRef] -> Set TxOutRef
forall a b. (a -> b) -> a -> b
$ (TxConstraint -> Maybe TxOutRef) -> [TxConstraint] -> [TxOutRef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxConstraint -> Maybe TxOutRef
getReferenceScript (TxConstraint
xTxConstraint -> [TxConstraint] -> [TxConstraint]
forall a. a -> [a] -> [a]
:[TxConstraint]
mustSpendSame)
    Redeemer
red <- case Set Redeemer -> [Redeemer]
forall a. Set a -> [a]
Set.toList Set Redeemer
redeemers of
                []    -> MkTxError -> m Redeemer
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m Redeemer) -> MkTxError -> m Redeemer
forall a b. (a -> b) -> a -> b
$ TxOutRef -> [Redeemer] -> MkTxError
AmbiguousRedeemer TxOutRef
t [] -- Can't happen as x must have a redeemer
                [Redeemer
red] -> Redeemer -> m Redeemer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redeemer
red
                [Redeemer]
rs    -> MkTxError -> m Redeemer
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m Redeemer) -> MkTxError -> m Redeemer
forall a b. (a -> b) -> a -> b
$ TxOutRef -> [Redeemer] -> MkTxError
AmbiguousRedeemer TxOutRef
t [Redeemer]
rs
    Maybe TxOutRef
rs  <- case Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
referenceScripts of
                []  -> Maybe TxOutRef -> m (Maybe TxOutRef)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TxOutRef
forall a. Maybe a
Nothing
                [TxOutRef
r] -> Maybe TxOutRef -> m (Maybe TxOutRef)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TxOutRef -> m (Maybe TxOutRef))
-> Maybe TxOutRef -> m (Maybe TxOutRef)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Maybe TxOutRef
forall a. a -> Maybe a
Just TxOutRef
r
                [TxOutRef]
rs  -> MkTxError -> m (Maybe TxOutRef)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m (Maybe TxOutRef))
-> MkTxError -> m (Maybe TxOutRef)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> [TxOutRef] -> MkTxError
AmbiguousReferenceScript TxOutRef
t [TxOutRef]
rs
    (TxOutRef -> Redeemer -> Maybe TxOutRef -> TxConstraint
MustSpendScriptOutput TxOutRef
t Redeemer
red Maybe TxOutRef
rsTxConstraint -> [TxConstraint] -> [TxConstraint]
forall a. a -> [a] -> [a]
:) ([TxConstraint] -> [TxConstraint])
-> m [TxConstraint] -> m [TxConstraint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxConstraint] -> m [TxConstraint]
forall (m :: * -> *).
MonadError MkTxError m =>
[TxConstraint] -> m [TxConstraint]
cleaningMustSpendConstraints [TxConstraint]
otherConstraints
cleaningMustSpendConstraints (x :: TxConstraint
x@(MustSpendPubKeyOutput TxOutRef
_):[TxConstraint]
xs) =
    (TxConstraint
x TxConstraint -> [TxConstraint] -> [TxConstraint]
forall a. a -> [a] -> [a]
:) ([TxConstraint] -> [TxConstraint])
-> m [TxConstraint] -> m [TxConstraint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxConstraint] -> m [TxConstraint]
forall (m :: * -> *).
MonadError MkTxError m =>
[TxConstraint] -> m [TxConstraint]
cleaningMustSpendConstraints ((TxConstraint -> Bool) -> [TxConstraint] -> [TxConstraint]
forall a. (a -> Bool) -> [a] -> [a]
filter (TxConstraint
x TxConstraint -> TxConstraint -> Bool
forall a. Eq a => a -> a -> Bool
/=) [TxConstraint]
xs)
cleaningMustSpendConstraints [] = [TxConstraint] -> m [TxConstraint]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
cleaningMustSpendConstraints (TxConstraint
x:[TxConstraint]
xs) = (TxConstraint
x TxConstraint -> [TxConstraint] -> [TxConstraint]
forall a. a -> [a] -> [a]
:) ([TxConstraint] -> [TxConstraint])
-> m [TxConstraint] -> m [TxConstraint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxConstraint] -> m [TxConstraint]
forall (m :: * -> *).
MonadError MkTxError m =>
[TxConstraint] -> m [TxConstraint]
cleaningMustSpendConstraints [TxConstraint]
xs

prepareConstraints
    ::
    ( FromData (DatumType a)
    , ToData (DatumType a)
    , ToData (RedeemerType a)
    )
    => [ScriptInputConstraint (RedeemerType a)]
    -> [ScriptOutputConstraint (DatumType a)]
    -> [TxConstraint]
    -> ReaderT (ScriptLookups a) (StateT ConstraintProcessingState (Except MkTxError)) SortedConstraints
prepareConstraints :: [ScriptInputConstraint (RedeemerType a)]
-> [ScriptOutputConstraint (DatumType a)]
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
prepareConstraints [ScriptInputConstraint (RedeemerType a)]
ownInputs [ScriptOutputConstraint (DatumType a)]
ownOutputs [TxConstraint]
constraints = do
    let
      extractPosixTimeRange :: TxConstraint -> Either POSIXTimeRange TxConstraint
extractPosixTimeRange = \case
        MustValidateInTimeRange ValidityInterval POSIXTime
range -> POSIXTimeRange -> Either POSIXTimeRange TxConstraint
forall a b. a -> Either a b
Left (POSIXTimeRange -> Either POSIXTimeRange TxConstraint)
-> POSIXTimeRange -> Either POSIXTimeRange TxConstraint
forall a b. (a -> b) -> a -> b
$ ValidityInterval POSIXTime -> POSIXTimeRange
forall a. ValidityInterval a -> Interval a
toPlutusInterval ValidityInterval POSIXTime
range
        TxConstraint
other                         -> TxConstraint -> Either POSIXTimeRange TxConstraint
forall a b. b -> Either a b
Right TxConstraint
other
      ([POSIXTimeRange]
ranges, [TxConstraint]
_nonRangeConstraints) = [Either POSIXTimeRange TxConstraint]
-> ([POSIXTimeRange], [TxConstraint])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either POSIXTimeRange TxConstraint]
 -> ([POSIXTimeRange], [TxConstraint]))
-> [Either POSIXTimeRange TxConstraint]
-> ([POSIXTimeRange], [TxConstraint])
forall a b. (a -> b) -> a -> b
$ TxConstraint -> Either POSIXTimeRange TxConstraint
extractPosixTimeRange (TxConstraint -> Either POSIXTimeRange TxConstraint)
-> [TxConstraint] -> [Either POSIXTimeRange TxConstraint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxConstraint]
constraints
    [TxConstraint]
ownInputConstraints <- (ScriptInputConstraint (RedeemerType a)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxConstraint)
-> [ScriptInputConstraint (RedeemerType a)]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [TxConstraint]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ScriptInputConstraint (RedeemerType a)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxConstraint
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m,
 FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptInputConstraint (RedeemerType a) -> m TxConstraint
addOwnInput [ScriptInputConstraint (RedeemerType a)]
ownInputs
    [TxConstraint]
ownOutputConstraints <- (ScriptOutputConstraint (DatumType a)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxConstraint)
-> [ScriptOutputConstraint (DatumType a)]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [TxConstraint]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ScriptOutputConstraint (DatumType a)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxConstraint
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m,
 ToData (DatumType a)) =>
ScriptOutputConstraint (DatumType a) -> m TxConstraint
addOwnOutput [ScriptOutputConstraint (DatumType a)]
ownOutputs
    [TxConstraint]
cleanedConstraints <- [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [TxConstraint]
forall (m :: * -> *).
MonadError MkTxError m =>
[TxConstraint] -> m [TxConstraint]
cleaningMustSpendConstraints [TxConstraint]
constraints
    SortedConstraints
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SortedConstraints
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      SortedConstraints)
-> SortedConstraints
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
forall a b. (a -> b) -> a -> b
$ [POSIXTimeRange] -> [TxConstraint] -> SortedConstraints
MkSortedConstraints [POSIXTimeRange]
ranges ([TxConstraint]
cleanedConstraints [TxConstraint] -> [TxConstraint] -> [TxConstraint]
forall a. Semigroup a => a -> a -> a
<> [TxConstraint]
ownOutputConstraints [TxConstraint] -> [TxConstraint] -> [TxConstraint]
forall a. Semigroup a => a -> a -> a
<> [TxConstraint]
ownInputConstraints)


-- | Resolve some 'TxConstraints' by modifying the 'UnbalancedTx' in the
--   'ConstraintProcessingState'
processLookupsAndConstraints
    ::
    ( FromData (DatumType a)
    , ToData (DatumType a)
    , ToData (RedeemerType a)
    )
    => ScriptLookups a
    -> TxConstraints (RedeemerType a) (DatumType a)
    -> StateT ConstraintProcessingState (Except MkTxError) ()
processLookupsAndConstraints :: ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> StateT ConstraintProcessingState (Except MkTxError) ()
processLookupsAndConstraints ScriptLookups a
lookups TxConstraints{[TxConstraint]
txConstraints :: forall i o. TxConstraints i o -> [TxConstraint]
txConstraints :: [TxConstraint]
txConstraints, [ScriptInputConstraint (RedeemerType a)]
txOwnInputs :: forall i o. TxConstraints i o -> [ScriptInputConstraint i]
txOwnInputs :: [ScriptInputConstraint (RedeemerType a)]
txOwnInputs, txConstraintFuns :: forall i o. TxConstraints i o -> TxConstraintFuns
txConstraintFuns = TxConstraintFuns [TxConstraintFun]
txCnsFuns, [ScriptOutputConstraint (DatumType a)]
txOwnOutputs :: forall i o. TxConstraints i o -> [ScriptOutputConstraint o]
txOwnOutputs :: [ScriptOutputConstraint (DatumType a)]
txOwnOutputs} = do
        (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   ()
 -> ScriptLookups a
 -> StateT ConstraintProcessingState (Except MkTxError) ())
-> ScriptLookups a
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
-> StateT ConstraintProcessingState (Except MkTxError) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
-> ScriptLookups a
-> StateT ConstraintProcessingState (Except MkTxError) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ScriptLookups a
lookups (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   ()
 -> StateT ConstraintProcessingState (Except MkTxError) ())
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
-> StateT ConstraintProcessingState (Except MkTxError) ()
forall a b. (a -> b) -> a -> b
$ do
            SortedConstraints
sortedConstraints <- [ScriptInputConstraint (RedeemerType a)]
-> [ScriptOutputConstraint (DatumType a)]
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
[ScriptInputConstraint (RedeemerType a)]
-> [ScriptOutputConstraint (DatumType a)]
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
prepareConstraints [ScriptInputConstraint (RedeemerType a)]
txOwnInputs [ScriptOutputConstraint (DatumType a)]
txOwnOutputs [TxConstraint]
txConstraints
            (TxConstraint
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ TxConstraint
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a.
TxConstraint
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
processConstraint (SortedConstraints -> [TxConstraint]
otherConstraints SortedConstraints
sortedConstraints)
            (TxConstraintFun
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> [TxConstraintFun]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ TxConstraintFun
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a.
TxConstraintFun
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
processConstraintFun [TxConstraintFun]
txCnsFuns
            ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m,
 MonadState ConstraintProcessingState m, MonadError MkTxError m) =>
m ()
checkValueSpent
            ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m,
 MonadState ConstraintProcessingState m, MonadError MkTxError m) =>
m ()
updateUtxoIndex
            StateT ConstraintProcessingState (Except MkTxError) ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ConstraintProcessingState (Except MkTxError) ()
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> StateT ConstraintProcessingState (Except MkTxError) ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a b. (a -> b) -> a -> b
$ [POSIXTimeRange]
-> StateT ConstraintProcessingState (Except MkTxError) ()
setValidityRange (SortedConstraints -> [POSIXTimeRange]
rangeConstraints SortedConstraints
sortedConstraints)

processConstraintFun
    :: TxConstraintFun
    -> ReaderT (ScriptLookups a) (StateT ConstraintProcessingState (Except MkTxError)) ()
processConstraintFun :: TxConstraintFun
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
processConstraintFun = \case
    MustSpendScriptOutputWithMatchingDatumAndValue ValidatorHash
vh Datum -> Bool
datumPred Value -> Bool
valuePred Redeemer
red -> do
        ScriptLookups{Map TxOutRef DecoratedTxOut
slTxOutputs :: Map TxOutRef DecoratedTxOut
slTxOutputs :: forall a. ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs} <- ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  (ScriptLookups a)
forall r (m :: * -> *). MonadReader r m => m r
ask
        -- TODO: Need to precalculate the validator hash or else this won't work
        -- with PlutusV2 validator. This means changing `DecoratedTxOut` to
        -- include the hash.
        let matches :: Maybe (Versioned Validator, DatumWithOrigin, Value) -> Bool
matches (Just (Versioned Validator
_, DatumWithOrigin
d, Value
value)) = Datum -> Bool
datumPred (DatumWithOrigin -> Datum
getDatum DatumWithOrigin
d) Bool -> Bool -> Bool
&& Value -> Bool
valuePred Value
value
            matches Maybe (Versioned Validator, DatumWithOrigin, Value)
Nothing              = Bool
False

        [(TxOutRef, Maybe (Versioned Validator, DatumWithOrigin, Value))]
opts <- (Map TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))
 -> [(TxOutRef,
      Maybe (Versioned Validator, DatumWithOrigin, Value))])
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Map
        TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value)))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [(TxOutRef, Maybe (Versioned Validator, DatumWithOrigin, Value))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))
-> [(TxOutRef,
     Maybe (Versioned Validator, DatumWithOrigin, Value))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))
 -> [(TxOutRef,
      Maybe (Versioned Validator, DatumWithOrigin, Value))])
-> (Map
      TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))
    -> Map
         TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value)))
-> Map
     TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))
-> [(TxOutRef,
     Maybe (Versioned Validator, DatumWithOrigin, Value))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Versioned Validator, DatumWithOrigin, Value) -> Bool)
-> Map
     TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))
-> Map
     TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Maybe (Versioned Validator, DatumWithOrigin, Value) -> Bool
matches)
                (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   (Map
      TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value)))
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      [(TxOutRef, Maybe (Versioned Validator, DatumWithOrigin, Value))])
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Map
        TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value)))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [(TxOutRef, Maybe (Versioned Validator, DatumWithOrigin, Value))]
forall a b. (a -> b) -> a -> b
$ (DecoratedTxOut
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Maybe (Versioned Validator, DatumWithOrigin, Value)))
-> Map TxOutRef DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Map
        TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (Versioned Validator, DatumWithOrigin, Value))
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
DecoratedTxOut
-> m (Maybe (Versioned Validator, DatumWithOrigin, Value))
resolveScriptTxOut
                (Map TxOutRef DecoratedTxOut
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Map
         TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value))))
-> Map TxOutRef DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Map
        TxOutRef (Maybe (Versioned Validator, DatumWithOrigin, Value)))
forall a b. (a -> b) -> a -> b
$ (DecoratedTxOut -> Bool)
-> Map TxOutRef DecoratedTxOut -> Map TxOutRef DecoratedTxOut
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((Maybe ValidatorHash -> Maybe ValidatorHash -> Bool
forall a. Eq a => a -> a -> Bool
== ValidatorHash -> Maybe ValidatorHash
forall a. a -> Maybe a
Just ValidatorHash
vh) (Maybe ValidatorHash -> Bool)
-> (DecoratedTxOut -> Maybe ValidatorHash)
-> DecoratedTxOut
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First ValidatorHash) DecoratedTxOut ValidatorHash
-> DecoratedTxOut -> Maybe ValidatorHash
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ValidatorHash) DecoratedTxOut ValidatorHash
Traversal' DecoratedTxOut ValidatorHash
Tx.decoratedTxOutValidatorHash) Map TxOutRef DecoratedTxOut
slTxOutputs
        case [(TxOutRef, Maybe (Versioned Validator, DatumWithOrigin, Value))]
opts of
            [] -> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a b. (a -> b) -> a -> b
$ ValidatorHash -> MkTxError
NoMatchingOutputFound ValidatorHash
vh
            [(TxOutRef
ref, Just (Versioned Validator
validator, DatumWithOrigin
datum, Value
value))] -> do
                WitnessHeader
mkWitness <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError WitnessHeader
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError WitnessHeader
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      WitnessHeader)
-> Either ToCardanoError WitnessHeader
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall a b. (a -> b) -> a -> b
$ Versioned Script -> Either ToCardanoError WitnessHeader
C.toCardanoTxInScriptWitnessHeader (Validator -> Script
getValidator (Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned Validator
validator)
                TxIn
txIn <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError TxIn
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxIn)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
ref
                let witness :: Witness WitCtxTxIn BabbageEra
witness
                        = ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn BabbageEra
-> Witness WitCtxTxIn BabbageEra
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
C.ScriptWitness ScriptWitnessInCtx WitCtxTxIn
C.ScriptWitnessForSpending (ScriptWitness WitCtxTxIn BabbageEra
 -> Witness WitCtxTxIn BabbageEra)
-> ScriptWitness WitCtxTxIn BabbageEra
-> Witness WitCtxTxIn BabbageEra
forall a b. (a -> b) -> a -> b
$
                            WitnessHeader
mkWitness
                            (Maybe Datum -> ScriptDatum WitCtxTxIn
C.toCardanoDatumWitness (Maybe Datum -> ScriptDatum WitCtxTxIn)
-> Maybe Datum -> ScriptDatum WitCtxTxIn
forall a b. (a -> b) -> a -> b
$ DatumWithOrigin -> Maybe Datum
datumWitness DatumWithOrigin
datum)
                            (BuiltinData -> ScriptData
C.toCardanoScriptData (Redeemer -> BuiltinData
getRedeemer Redeemer
red))
                            ExecutionUnits
C.zeroExecutionUnits

                (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
     -> Identity
          [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> Identity
         [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
     -> Identity
          [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> Identity
         [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
 -> Identity
      [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens'
  CardanoBuildTx
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
txIns (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
  -> Identity
       [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [(TxIn
txIn, Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith Witness WitCtxTxIn BabbageEra
witness)]

                (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentInputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
provided Value
value
            [(TxOutRef, Maybe (Versioned Validator, DatumWithOrigin, Value))]
_ -> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a b. (a -> b) -> a -> b
$ ValidatorHash -> MkTxError
MultipleMatchingOutputsFound ValidatorHash
vh

data DatumWithOrigin
    = DatumInTx { DatumWithOrigin -> Datum
getDatum :: Datum }
    | DatumInline { getDatum :: Datum }

datumWitness :: DatumWithOrigin -> Maybe Datum
datumWitness :: DatumWithOrigin -> Maybe Datum
datumWitness (DatumInTx Datum
d)   = Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
d
datumWitness (DatumInline Datum
_) = Maybe Datum
forall a. Maybe a
Nothing

checkValueSpent
    :: ( MonadReader (ScriptLookups a) m
       , MonadState ConstraintProcessingState m
       , MonadError MkTxError m
       )
    => m ()
checkValueSpent :: m ()
checkValueSpent = do
    Value
missingInputs <- LensLike'
  (Const Value) ConstraintProcessingState ValueSpentBalances
-> (ValueSpentBalances -> Value) -> m Value
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike'
  (Const Value) ConstraintProcessingState ValueSpentBalances
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentInputs ValueSpentBalances -> Value
missingValueSpent
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value -> Bool
Value.isZero Value
missingInputs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MkTxError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m ()) -> MkTxError -> m ()
forall a b. (a -> b) -> a -> b
$ Value -> MkTxError
DeclaredInputMismatch Value
missingInputs
    Value
missingOutputs <- LensLike'
  (Const Value) ConstraintProcessingState ValueSpentBalances
-> (ValueSpentBalances -> Value) -> m Value
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike'
  (Const Value) ConstraintProcessingState ValueSpentBalances
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentOutputs ValueSpentBalances -> Value
missingValueSpent
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Value -> Bool
Value.isZero Value
missingOutputs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MkTxError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m ()) -> MkTxError -> m ()
forall a b. (a -> b) -> a -> b
$ Value -> MkTxError
DeclaredOutputMismatch Value
missingOutputs

-- | Reinject the validityRange inside the unbalanced Tx.
--   As the Tx is a Caradano transaction, and as we have access to the SlotConfig,
--   we can already internalize the constraints for the test
setValidityRange
    :: [POSIXTimeRange] -> StateT ConstraintProcessingState (Except MkTxError) ()
setValidityRange :: [POSIXTimeRange]
-> StateT ConstraintProcessingState (Except MkTxError) ()
setValidityRange [POSIXTimeRange]
ranges = do
  SlotConfig
slotConfig <- (ConstraintProcessingState -> SlotConfig)
-> StateT ConstraintProcessingState (Except MkTxError) SlotConfig
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Params -> SlotConfig
pSlotConfig (Params -> SlotConfig)
-> (ConstraintProcessingState -> Params)
-> ConstraintProcessingState
-> SlotConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintProcessingState -> Params
cpsParams)
  let slotRange :: SlotRange
slotRange = (SlotRange -> SlotRange -> SlotRange)
-> SlotRange -> [SlotRange] -> SlotRange
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SlotRange -> SlotRange -> SlotRange
forall a. MeetSemiLattice a => a -> a -> a
(/\) SlotRange
forall a. BoundedMeetSemiLattice a => a
top ([SlotRange] -> SlotRange) -> [SlotRange] -> SlotRange
forall a b. (a -> b) -> a -> b
$ SlotConfig -> POSIXTimeRange -> SlotRange
posixTimeRangeToContainedSlotRange SlotConfig
slotConfig (POSIXTimeRange -> SlotRange) -> [POSIXTimeRange] -> [SlotRange]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [POSIXTimeRange]
ranges
  (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
cTxTR <- (ToCardanoError -> MkTxError)
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> StateT
     ConstraintProcessingState
     (Except MkTxError)
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either
   ToCardanoError
   (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
 -> StateT
      ConstraintProcessingState
      (Except MkTxError)
      (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> StateT
     ConstraintProcessingState
     (Except MkTxError)
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
forall a b. (a -> b) -> a -> b
$ SlotRange
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
C.toCardanoValidityRange SlotRange
slotRange
  (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (((TxValidityLowerBound BabbageEra,
      TxValidityUpperBound BabbageEra)
     -> Identity
          (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ((TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra)
    -> Identity
         (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (((TxValidityLowerBound BabbageEra,
      TxValidityUpperBound BabbageEra)
     -> Identity
          (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ((TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra)
    -> Identity
         (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
 -> Identity
      (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens'
  CardanoBuildTx
  (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
txValidityRange (((TxValidityLowerBound BabbageEra,
   TxValidityUpperBound BabbageEra)
  -> Identity
       (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (TxValidityLowerBound BabbageEra,
    TxValidityUpperBound BabbageEra)
-> StateT ConstraintProcessingState (Except MkTxError) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
cTxTR

-- | Turn a 'TxConstraints' value into an unbalanced transaction that satisfies
--   the constraints. To use this in a contract, see
--   'Plutus.Contract.submitTxConstraints'
--   and related functions.
mkTx
    :: ( FromData (DatumType a)
       , ToData (DatumType a)
       , ToData (RedeemerType a)
       )
    => Params
    -> ScriptLookups a
    -> TxConstraints (RedeemerType a) (DatumType a)
    -> Either MkTxError UnbalancedTx
mkTx :: Params
-> ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Either MkTxError UnbalancedTx
mkTx Params
params ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
txc = Params
-> [SomeLookupsAndConstraints] -> Either MkTxError UnbalancedTx
mkSomeTx Params
params [ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> SomeLookupsAndConstraints
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> SomeLookupsAndConstraints
SomeLookupsAndConstraints ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
txc]

throwLeft :: (MonadState s m, MonadError err m) => (b -> err) -> Either b r -> m r
throwLeft :: (b -> err) -> Either b r -> m r
throwLeft b -> err
f = (b -> m r) -> (r -> m r) -> Either b r -> m r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (err -> m r
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (err -> m r) -> (b -> err) -> b -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> err
f) r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Modify the 'UnbalancedTx' so that it satisfies the constraints, if
--   possible. Fails if a hash is missing from the lookups, or if an output
--   of the wrong type is spent.
processConstraint
    :: TxConstraint
    -> ReaderT (ScriptLookups a) (StateT ConstraintProcessingState (Except MkTxError)) ()
processConstraint :: TxConstraint
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
processConstraint = \case
    MustIncludeDatumInTxWithHash DatumHash
_ Datum
_ -> ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- always succeeds
    MustIncludeDatumInTx Datum
_ -> ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- always succeeds
    MustSpendPubKeyOutput TxOutRef
txo -> do
        DecoratedTxOut
txout <- TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall a.
TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
lookupTxOutRef TxOutRef
txo
        Value
value <- ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  Value
-> (Value
    -> ReaderT
         (ScriptLookups a)
         (StateT ConstraintProcessingState (Except MkTxError))
         Value)
-> Maybe Value
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxOutRef -> MkTxError
TxOutRefWrongType TxOutRef
txo)) Value
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      Value)
-> Maybe Value
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall a b. (a -> b) -> a -> b
$ do
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ APrism
  DecoratedTxOut
  DecoratedTxOut
  (PubKeyHash, Maybe StakingCredential, Value,
   Maybe (DatumHash, DatumFromQuery), Maybe (Versioned Script))
  (PubKeyHash, Maybe StakingCredential, Value,
   Maybe (DatumHash, DatumFromQuery), Maybe (Versioned Script))
-> DecoratedTxOut -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism
  DecoratedTxOut
  DecoratedTxOut
  (PubKeyHash, Maybe StakingCredential, Value,
   Maybe (DatumHash, DatumFromQuery), Maybe (Versioned Script))
  (PubKeyHash, Maybe StakingCredential, Value,
   Maybe (DatumHash, DatumFromQuery), Maybe (Versioned Script))
Prism'
  DecoratedTxOut
  (PubKeyHash, Maybe StakingCredential, Value,
   Maybe (DatumHash, DatumFromQuery), Maybe (Versioned Script))
Tx._PublicKeyDecoratedTxOut DecoratedTxOut
txout
            Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ DecoratedTxOut
txout DecoratedTxOut -> Getting Value DecoratedTxOut Value -> Value
forall s a. s -> Getting a s a -> a
^. Getting Value DecoratedTxOut Value
Lens' DecoratedTxOut Value
Tx.decoratedTxOutValue
        TxIn
txIn <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError TxIn
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxIn)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
txo
        (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
     -> Identity
          [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> Identity
         [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
     -> Identity
          [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> Identity
         [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
 -> Identity
      [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens'
  CardanoBuildTx
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
txIns (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
  -> Identity
       [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [(TxIn
txIn, Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith (KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn BabbageEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
C.KeyWitness KeyWitnessInCtx WitCtxTxIn
C.KeyWitnessForSpending))]
        (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentInputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
provided (Value -> Value
C.fromCardanoValue Value
value)

    MustBeSignedBy PaymentPubKeyHash
pk -> do
        Hash PaymentKey
ekw <-  (ToCardanoError
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Hash PaymentKey))
-> (Hash PaymentKey
    -> ReaderT
         (ScriptLookups a)
         (StateT ConstraintProcessingState (Except MkTxError))
         (Hash PaymentKey))
-> Either ToCardanoError (Hash PaymentKey)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Hash PaymentKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Hash PaymentKey)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Hash PaymentKey))
-> (ToCardanoError -> MkTxError)
-> ToCardanoError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> MkTxError
ToCardanoError) Hash PaymentKey
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Hash PaymentKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError (Hash PaymentKey)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Hash PaymentKey))
-> Either ToCardanoError (Hash PaymentKey)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$ PaymentPubKeyHash -> Either ToCardanoError (Hash PaymentKey)
C.toCardanoPaymentKeyHash PaymentPubKeyHash
pk
        (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ((Set (Hash PaymentKey) -> Identity (Set (Hash PaymentKey)))
    -> UnbalancedTx -> Identity UnbalancedTx)
-> (Set (Hash PaymentKey) -> Identity (Set (Hash PaymentKey)))
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> ((Set (Hash PaymentKey) -> Identity (Set (Hash PaymentKey)))
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> (Set (Hash PaymentKey) -> Identity (Set (Hash PaymentKey)))
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Hash PaymentKey) -> Identity (Set (Hash PaymentKey)))
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens' CardanoBuildTx (Set (Hash PaymentKey))
txExtraKeyWits ((Set (Hash PaymentKey) -> Identity (Set (Hash PaymentKey)))
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> Set (Hash PaymentKey)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Hash PaymentKey -> Set (Hash PaymentKey)
forall a. a -> Set a
Set.singleton Hash PaymentKey
ekw
    MustSpendScriptOutput TxOutRef
txo Redeemer
redeemer Maybe TxOutRef
mref -> do
        DecoratedTxOut
txout <- TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall a.
TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
lookupTxOutRef TxOutRef
txo
        WitnessHeader
mkWitness <- case Maybe TxOutRef
mref of
          Just TxOutRef
ref -> do
            DecoratedTxOut
refTxOut <- TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall a.
TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
lookupTxOutRef TxOutRef
ref
            case DecoratedTxOut
refTxOut DecoratedTxOut
-> Getting
     (Maybe (Versioned Script))
     DecoratedTxOut
     (Maybe (Versioned Script))
-> Maybe (Versioned Script)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Versioned Script))
  DecoratedTxOut
  (Maybe (Versioned Script))
Lens' DecoratedTxOut (Maybe (Versioned Script))
Tx.decoratedTxOutReferenceScript of
                Just (Tx.Versioned Script
_ Language
lang) -> do
                    TxIn
txIn <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError TxIn
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxIn)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
ref
                    (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([TxIn] -> Identity [TxIn])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([TxIn] -> Identity [TxIn])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([TxIn] -> Identity [TxIn])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([TxIn] -> Identity [TxIn])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Identity [TxIn])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens' CardanoBuildTx [TxIn]
txInsReference (([TxIn] -> Identity [TxIn])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [TxIn]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [ TxIn
txIn ]
                    (ToCardanoError -> MkTxError)
-> Either ToCardanoError WitnessHeader
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError WitnessHeader
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      WitnessHeader)
-> Either ToCardanoError WitnessHeader
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall a b. (a -> b) -> a -> b
$ Versioned TxOutRef -> Either ToCardanoError WitnessHeader
C.toCardanoTxInReferenceWitnessHeader (TxOutRef -> Language -> Versioned TxOutRef
forall script. script -> Language -> Versioned script
Tx.Versioned TxOutRef
ref Language
lang)
                Maybe (Versioned Script)
_ -> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxOutRef -> MkTxError
TxOutRefNoReferenceScript TxOutRef
ref)
          Maybe TxOutRef
Nothing -> do
            Maybe (Versioned Validator)
mscriptTXO <- DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (Versioned Validator))
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
DecoratedTxOut -> m (Maybe (Versioned Validator))
resolveScriptTxOutValidator DecoratedTxOut
txout
            case Maybe (Versioned Validator)
mscriptTXO of
                Just Versioned Validator
validator ->
                    (ToCardanoError -> MkTxError)
-> Either ToCardanoError WitnessHeader
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError WitnessHeader
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      WitnessHeader)
-> Either ToCardanoError WitnessHeader
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall a b. (a -> b) -> a -> b
$ Versioned Script -> Either ToCardanoError WitnessHeader
C.toCardanoTxInScriptWitnessHeader (Validator -> Script
getValidator (Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned Validator
validator)
                Maybe (Versioned Validator)
_ -> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     WitnessHeader
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxOutRef -> MkTxError
TxOutRefWrongType TxOutRef
txo)
        Maybe (DatumWithOrigin, Value)
mscriptTXO <- DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (DatumWithOrigin, Value))
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
DecoratedTxOut -> m (Maybe (DatumWithOrigin, Value))
resolveScriptTxOutDatumAndValue DecoratedTxOut
txout
        case Maybe (DatumWithOrigin, Value)
mscriptTXO of
            Just (DatumWithOrigin
datum, Value
value) -> do
                TxIn
txIn <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError TxIn
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxIn)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
txo
                let witness :: Witness WitCtxTxIn BabbageEra
witness
                        = ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn BabbageEra
-> Witness WitCtxTxIn BabbageEra
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
C.ScriptWitness ScriptWitnessInCtx WitCtxTxIn
C.ScriptWitnessForSpending (ScriptWitness WitCtxTxIn BabbageEra
 -> Witness WitCtxTxIn BabbageEra)
-> ScriptWitness WitCtxTxIn BabbageEra
-> Witness WitCtxTxIn BabbageEra
forall a b. (a -> b) -> a -> b
$
                            WitnessHeader
mkWitness
                            (Maybe Datum -> ScriptDatum WitCtxTxIn
C.toCardanoDatumWitness (Maybe Datum -> ScriptDatum WitCtxTxIn)
-> Maybe Datum -> ScriptDatum WitCtxTxIn
forall a b. (a -> b) -> a -> b
$ DatumWithOrigin -> Maybe Datum
datumWitness DatumWithOrigin
datum)
                            (BuiltinData -> ScriptData
C.toCardanoScriptData (Redeemer -> BuiltinData
getRedeemer Redeemer
redeemer))
                            ExecutionUnits
C.zeroExecutionUnits

                (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
     -> Identity
          [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> Identity
         [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
     -> Identity
          [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
    -> Identity
         [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
 -> Identity
      [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens'
  CardanoBuildTx
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
txIns (([(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
  -> Identity
       [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra))]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [(TxIn
txIn, Witness WitCtxTxIn BabbageEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn BabbageEra)
forall a. a -> BuildTxWith BuildTx a
C.BuildTxWith Witness WitCtxTxIn BabbageEra
witness)]

                (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentInputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
provided Value
value

            Maybe (DatumWithOrigin, Value)
_ -> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxOutRef -> MkTxError
TxOutRefWrongType TxOutRef
txo)

    MustUseOutputAsCollateral TxOutRef
txo -> do
        TxIn
txIn <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError TxIn
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxIn)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
txo
        (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([TxIn] -> Identity [TxIn])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([TxIn] -> Identity [TxIn])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([TxIn] -> Identity [TxIn])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([TxIn] -> Identity [TxIn])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Identity [TxIn])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens' CardanoBuildTx [TxIn]
txInsCollateral (([TxIn] -> Identity [TxIn])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [TxIn]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [ TxIn
txIn ]

    MustReferenceOutput TxOutRef
txo -> do
        TxIn
txIn <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError TxIn
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxIn)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
txo
        (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([TxIn] -> Identity [TxIn])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([TxIn] -> Identity [TxIn])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([TxIn] -> Identity [TxIn])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([TxIn] -> Identity [TxIn])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Identity [TxIn])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens' CardanoBuildTx [TxIn]
txInsReference (([TxIn] -> Identity [TxIn])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [TxIn]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [ TxIn
txIn ]

    MustMintValue MintingPolicyHash
mpsHash Redeemer
red TokenName
tn Integer
i Maybe TxOutRef
mref -> do
        let value :: Integer -> Value
value = CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton (MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol MintingPolicyHash
mpsHash) TokenName
tn

        -- If i is negative we are burning tokens. The tokens burned must
        -- be provided as an input. So we add the value burnt to
        -- 'valueSpentInputs'. If i is positive then new tokens are created
        -- which must be added to 'valueSpentOutputs'.
        if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
            then (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentInputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
provided (Integer -> Value
value (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i))
            else (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentOutputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
provided (Integer -> Value
value Integer
i)

        Value
v <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError Value
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError Value
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      Value)
-> Either ToCardanoError Value
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall a b. (a -> b) -> a -> b
$ Value -> Either ToCardanoError Value
C.toCardanoValue (Value -> Either ToCardanoError Value)
-> Value -> Either ToCardanoError Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
value Integer
i
        PolicyId
pId <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError PolicyId
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     PolicyId
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError PolicyId
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      PolicyId)
-> Either ToCardanoError PolicyId
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     PolicyId
forall a b. (a -> b) -> a -> b
$ MintingPolicyHash -> Either ToCardanoError PolicyId
toCardanoPolicyId MintingPolicyHash
mpsHash
        ScriptWitness WitCtxMint BabbageEra
witness <- case Maybe TxOutRef
mref of
            Just TxOutRef
ref -> do
                DecoratedTxOut
refTxOut <- TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall a.
TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
lookupTxOutRef TxOutRef
ref
                case DecoratedTxOut
refTxOut DecoratedTxOut
-> Getting
     (First (Maybe (Versioned Script)))
     DecoratedTxOut
     (Maybe (Versioned Script))
-> Maybe (Maybe (Versioned Script))
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (Maybe (Versioned Script)))
  DecoratedTxOut
  (Maybe (Versioned Script))
Lens' DecoratedTxOut (Maybe (Versioned Script))
decoratedTxOutReferenceScript of
                    Just Maybe (Versioned Script)
_ -> do
                      TxIn
txIn <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError TxIn
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      TxIn)
-> Either ToCardanoError TxIn
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
ref
                      (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([TxIn] -> Identity [TxIn])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([TxIn] -> Identity [TxIn])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([TxIn] -> Identity [TxIn])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([TxIn] -> Identity [TxIn])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Identity [TxIn])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens' CardanoBuildTx [TxIn]
txInsReference (([TxIn] -> Identity [TxIn])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [TxIn]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [TxIn
txIn]
                      (ToCardanoError -> MkTxError)
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ScriptWitness WitCtxMint BabbageEra)
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError
                        (Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (ScriptWitness WitCtxMint BabbageEra))
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ScriptWitness WitCtxMint BabbageEra)
forall a b. (a -> b) -> a -> b
$ Redeemer
-> Maybe (Versioned TxOutRef)
-> Maybe (Versioned MintingPolicy)
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
toCardanoMintWitness Redeemer
red ((TxOutRef -> Language -> Versioned TxOutRef)
-> Language -> TxOutRef -> Versioned TxOutRef
forall a b c. (a -> b -> c) -> b -> a -> c
flip TxOutRef -> Language -> Versioned TxOutRef
forall script. script -> Language -> Versioned script
Tx.Versioned Language
PlutusV2 (TxOutRef -> Versioned TxOutRef)
-> Maybe TxOutRef -> Maybe (Versioned TxOutRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxOutRef
mref) Maybe (Versioned MintingPolicy)
forall a. Maybe a
Nothing
                    Maybe (Maybe (Versioned Script))
_      -> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ScriptWitness WitCtxMint BabbageEra)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxOutRef -> MkTxError
TxOutRefNoReferenceScript TxOutRef
ref)
            Maybe TxOutRef
Nothing -> do
                Versioned MintingPolicy
mintingPolicyScript <- MintingPolicyHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
forall a.
MintingPolicyHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
lookupMintingPolicy MintingPolicyHash
mpsHash
                (ToCardanoError -> MkTxError)
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ScriptWitness WitCtxMint BabbageEra)
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError
                  (Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (ScriptWitness WitCtxMint BabbageEra))
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ScriptWitness WitCtxMint BabbageEra)
forall a b. (a -> b) -> a -> b
$ Redeemer
-> Maybe (Versioned TxOutRef)
-> Maybe (Versioned MintingPolicy)
-> Either ToCardanoError (ScriptWitness WitCtxMint BabbageEra)
toCardanoMintWitness Redeemer
red Maybe (Versioned TxOutRef)
forall a. Maybe a
Nothing (Versioned MintingPolicy -> Maybe (Versioned MintingPolicy)
forall a. a -> Maybe a
Just Versioned MintingPolicy
mintingPolicyScript)
        (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
     -> Identity
          (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
    -> Identity
         (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
     -> Identity
          (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
    -> Identity
         (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
 -> Identity
      (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens'
  CardanoBuildTx
  (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
txMintValue (((Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
  -> Identity
       (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra)))
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (Value, Map PolicyId (ScriptWitness WitCtxMint BabbageEra))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= (Value
v, PolicyId
-> ScriptWitness WitCtxMint BabbageEra
-> Map PolicyId (ScriptWitness WitCtxMint BabbageEra)
forall k a. k -> a -> Map k a
Map.singleton PolicyId
pId ScriptWitness WitCtxMint BabbageEra
witness)

    MustPayToAddress Address
addr Maybe (TxOutDatum Datum)
md Maybe ScriptHash
refScriptHashM Value
vl -> do
        NetworkId
networkId <- Getting NetworkId ConstraintProcessingState NetworkId
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     NetworkId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Params -> Const NetworkId Params)
-> ConstraintProcessingState
-> Const NetworkId ConstraintProcessingState
Lens' ConstraintProcessingState Params
paramsL ((Params -> Const NetworkId Params)
 -> ConstraintProcessingState
 -> Const NetworkId ConstraintProcessingState)
-> ((NetworkId -> Const NetworkId NetworkId)
    -> Params -> Const NetworkId Params)
-> Getting NetworkId ConstraintProcessingState NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NetworkId -> Const NetworkId NetworkId)
-> Params -> Const NetworkId Params
Lens' Params NetworkId
networkIdL)
        ReferenceScript BabbageEra
refScript <- Maybe ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
forall a.
Maybe ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
lookupScriptAsReferenceScript Maybe ScriptHash
refScriptHashM
        TxOut CtxTx BabbageEra
out <- (ToCardanoError -> MkTxError)
-> Either ToCardanoError (TxOut CtxTx BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (TxOut CtxTx BabbageEra)
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either ToCardanoError (TxOut CtxTx BabbageEra)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (TxOut CtxTx BabbageEra))
-> Either ToCardanoError (TxOut CtxTx BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (TxOut CtxTx BabbageEra)
forall a b. (a -> b) -> a -> b
$ AddressInEra BabbageEra
-> TxOutValue BabbageEra
-> TxOutDatum CtxTx BabbageEra
-> ReferenceScript BabbageEra
-> TxOut CtxTx BabbageEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
C.TxOut
            (AddressInEra BabbageEra
 -> TxOutValue BabbageEra
 -> TxOutDatum CtxTx BabbageEra
 -> ReferenceScript BabbageEra
 -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (AddressInEra BabbageEra)
-> Either
     ToCardanoError
     (TxOutValue BabbageEra
      -> TxOutDatum CtxTx BabbageEra
      -> ReferenceScript BabbageEra
      -> TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkId
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
C.toCardanoAddressInEra NetworkId
networkId Address
addr
            Either
  ToCardanoError
  (TxOutValue BabbageEra
   -> TxOutDatum CtxTx BabbageEra
   -> ReferenceScript BabbageEra
   -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (TxOutValue BabbageEra)
-> Either
     ToCardanoError
     (TxOutDatum CtxTx BabbageEra
      -> ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> TxOutValue BabbageEra)
-> Either ToCardanoError Value
-> Either ToCardanoError (TxOutValue BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> TxOutValue BabbageEra
C.toCardanoTxOutValue (Value -> Either ToCardanoError Value
C.toCardanoValue Value
vl)
            Either
  ToCardanoError
  (TxOutDatum CtxTx BabbageEra
   -> ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
-> Either
     ToCardanoError
     (ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxOutDatum CtxTx BabbageEra
-> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TxOutDatum Datum) -> TxOutDatum CtxTx BabbageEra
toTxOutDatum Maybe (TxOutDatum Datum)
md)
            Either
  ToCardanoError
  (ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (ReferenceScript BabbageEra)
-> Either ToCardanoError (TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReferenceScript BabbageEra
-> Either ToCardanoError (ReferenceScript BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript BabbageEra
refScript
        (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (([TxOut] -> Identity [TxOut])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([TxOut] -> Identity [TxOut])
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (([TxOut] -> Identity [TxOut])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([TxOut] -> Identity [TxOut])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut] -> Identity [TxOut])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens' CardanoBuildTx [TxOut]
txOuts (([TxOut] -> Identity [TxOut])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [TxOut]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [ TxOut CtxTx BabbageEra -> TxOut
Tx.TxOut TxOut CtxTx BabbageEra
out ]

        (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentOutputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
provided Value
vl

    MustSpendAtLeast Value
vl -> (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentInputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
required Value
vl
    MustProduceAtLeast Value
vl -> (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
valueSpentOutputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
required Value
vl

    MustSatisfyAnyOf [[TxConstraint]]
xs -> do
        ConstraintProcessingState
s <- ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ConstraintProcessingState
forall s (m :: * -> *). MonadState s m => m s
get
        let tryNext :: [[TxConstraint]]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
tryNext [] =
                MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MkTxError
CannotSatisfyAny
            tryNext ([TxConstraint]
hs:[[TxConstraint]]
qs) = do
                (TxConstraint
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ TxConstraint
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a.
TxConstraint
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
processConstraint [TxConstraint]
hs ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
-> (MkTxError
    -> ReaderT
         (ScriptLookups a)
         (StateT ConstraintProcessingState (Except MkTxError))
         ())
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
-> MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a b. a -> b -> a
const (ConstraintProcessingState
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ConstraintProcessingState
s ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [[TxConstraint]]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
tryNext [[TxConstraint]]
qs)
        [[TxConstraint]]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
tryNext [[TxConstraint]]
xs

    MustValidateInTimeRange ValidityInterval POSIXTime
timeRange -> do
        SlotConfig
slotConfig <- (ConstraintProcessingState -> SlotConfig)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SlotConfig
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Params -> SlotConfig
pSlotConfig (Params -> SlotConfig)
-> (ConstraintProcessingState -> Params)
-> ConstraintProcessingState
-> SlotConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintProcessingState -> Params
cpsParams)
        UnbalancedTx
unbTx <- Getting UnbalancedTx ConstraintProcessingState UnbalancedTx
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     UnbalancedTx
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting UnbalancedTx ConstraintProcessingState UnbalancedTx
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx
        let currentValRange :: Maybe
  (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
currentValRange = UnbalancedTx
unbTx UnbalancedTx
-> Getting
     (First
        (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
     UnbalancedTx
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> Maybe
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (CardanoBuildTx
 -> Const
      (First
         (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
      CardanoBuildTx)
-> UnbalancedTx
-> Const
     (First
        (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
     UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx
  -> Const
       (First
          (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
       CardanoBuildTx)
 -> UnbalancedTx
 -> Const
      (First
         (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
      UnbalancedTx)
-> (((TxValidityLowerBound BabbageEra,
      TxValidityUpperBound BabbageEra)
     -> Const
          (First
             (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
          (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
    -> CardanoBuildTx
    -> Const
         (First
            (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
         CardanoBuildTx)
-> Getting
     (First
        (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
     UnbalancedTx
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
 -> Const
      (First
         (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
      (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> CardanoBuildTx
-> Const
     (First
        (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
     CardanoBuildTx
Lens'
  CardanoBuildTx
  (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
txValidityRange
        let currentTimeRange :: POSIXTimeRange
currentTimeRange = POSIXTimeRange
-> ((TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra)
    -> POSIXTimeRange)
-> Maybe
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> POSIXTimeRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe POSIXTimeRange
forall a. BoundedMeetSemiLattice a => a
top (SlotConfig -> SlotRange -> POSIXTimeRange
slotRangeToPOSIXTimeRange SlotConfig
slotConfig (SlotRange -> POSIXTimeRange)
-> ((TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra)
    -> SlotRange)
-> (TxValidityLowerBound BabbageEra,
    TxValidityUpperBound BabbageEra)
-> POSIXTimeRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> SlotRange
forall era.
(TxValidityLowerBound era, TxValidityUpperBound era) -> SlotRange
C.fromCardanoValidityRange) Maybe
  (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
currentValRange
        let newRange :: SlotRange
newRange = SlotConfig -> POSIXTimeRange -> SlotRange
posixTimeRangeToContainedSlotRange SlotConfig
slotConfig (POSIXTimeRange -> SlotRange) -> POSIXTimeRange -> SlotRange
forall a b. (a -> b) -> a -> b
$ POSIXTimeRange
currentTimeRange POSIXTimeRange -> POSIXTimeRange -> POSIXTimeRange
forall a. MeetSemiLattice a => a -> a -> a
/\ ValidityInterval POSIXTime -> POSIXTimeRange
forall a. ValidityInterval a -> Interval a
toPlutusInterval ValidityInterval POSIXTime
timeRange
        (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
cTxTR <- (ToCardanoError -> MkTxError)
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
forall s (m :: * -> *) err b r.
(MonadState s m, MonadError err m) =>
(b -> err) -> Either b r -> m r
throwLeft ToCardanoError -> MkTxError
ToCardanoError (Either
   ToCardanoError
   (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
forall a b. (a -> b) -> a -> b
$ SlotRange
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
C.toCardanoValidityRange SlotRange
newRange
        (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (((TxValidityLowerBound BabbageEra,
      TxValidityUpperBound BabbageEra)
     -> Identity
          (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ((TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra)
    -> Identity
         (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoBuildTx -> Identity CardanoBuildTx)
-> UnbalancedTx -> Identity UnbalancedTx
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> Identity CardanoBuildTx)
 -> UnbalancedTx -> Identity UnbalancedTx)
-> (((TxValidityLowerBound BabbageEra,
      TxValidityUpperBound BabbageEra)
     -> Identity
          (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ((TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra)
    -> Identity
         (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
 -> Identity
      (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens'
  CardanoBuildTx
  (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
txValidityRange (((TxValidityLowerBound BabbageEra,
   TxValidityUpperBound BabbageEra)
  -> Identity
       (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra))
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> (TxValidityLowerBound BabbageEra,
    TxValidityUpperBound BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
cTxTR

-- | Add a typed input, checking the type of the output it spends. Return the value
--   of the spent output.
addOwnInput
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       , FromData (DatumType a)
       , ToData (DatumType a)
       , ToData (RedeemerType a)
       )
    => ScriptInputConstraint (RedeemerType a)
    -> m TxConstraint
addOwnInput :: ScriptInputConstraint (RedeemerType a) -> m TxConstraint
addOwnInput ScriptInputConstraint{RedeemerType a
icRedeemer :: forall a. ScriptInputConstraint a -> a
icRedeemer :: RedeemerType a
icRedeemer, TxOutRef
icTxOutRef :: forall a. ScriptInputConstraint a -> TxOutRef
icTxOutRef :: TxOutRef
icTxOutRef, Maybe TxOutRef
icReferenceTxOutRef :: forall a. ScriptInputConstraint a -> Maybe TxOutRef
icReferenceTxOutRef :: Maybe TxOutRef
icReferenceTxOutRef} = do
    ScriptLookups{Map TxOutRef DecoratedTxOut
slTxOutputs :: Map TxOutRef DecoratedTxOut
slTxOutputs :: forall a. ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs, Maybe (TypedValidator a)
slTypedValidator :: Maybe (TypedValidator a)
slTypedValidator :: forall a. ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator} <- m (ScriptLookups a)
forall r (m :: * -> *). MonadReader r m => m r
ask
    TypedValidator a
inst <- m (TypedValidator a)
-> (TypedValidator a -> m (TypedValidator a))
-> Maybe (TypedValidator a)
-> m (TypedValidator a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MkTxError -> m (TypedValidator a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MkTxError
TypedValidatorMissing) TypedValidator a -> m (TypedValidator a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypedValidator a)
slTypedValidator
    TypedScriptTxOutRef a
typedOutRef <-
      (ConnectionError -> m (TypedScriptTxOutRef a))
-> (TypedScriptTxOutRef a -> m (TypedScriptTxOutRef a))
-> Either ConnectionError (TypedScriptTxOutRef a)
-> m (TypedScriptTxOutRef a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MkTxError -> m (TypedScriptTxOutRef a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m (TypedScriptTxOutRef a))
-> (ConnectionError -> MkTxError)
-> ConnectionError
-> m (TypedScriptTxOutRef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionError -> MkTxError
TypeCheckFailed) TypedScriptTxOutRef a -> m (TypedScriptTxOutRef a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Either ConnectionError (TypedScriptTxOutRef a)
 -> m (TypedScriptTxOutRef a))
-> Either ConnectionError (TypedScriptTxOutRef a)
-> m (TypedScriptTxOutRef a)
forall a b. (a -> b) -> a -> b
$ forall a. Except ConnectionError a -> Either ConnectionError a
forall e a. Except e a -> Either e a
runExcept @Typed.ConnectionError
      (Except ConnectionError (TypedScriptTxOutRef a)
 -> Either ConnectionError (TypedScriptTxOutRef a))
-> Except ConnectionError (TypedScriptTxOutRef a)
-> Either ConnectionError (TypedScriptTxOutRef a)
forall a b. (a -> b) -> a -> b
$ do
          (TxOut
txOut, Datum
datum) <- ExceptT ConnectionError Identity (TxOut, Datum)
-> ((TxOut, Datum)
    -> ExceptT ConnectionError Identity (TxOut, Datum))
-> Maybe (TxOut, Datum)
-> ExceptT ConnectionError Identity (TxOut, Datum)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConnectionError -> ExceptT ConnectionError Identity (TxOut, Datum)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConnectionError
 -> ExceptT ConnectionError Identity (TxOut, Datum))
-> ConnectionError
-> ExceptT ConnectionError Identity (TxOut, Datum)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> ConnectionError
UnknownRef TxOutRef
icTxOutRef) (TxOut, Datum) -> ExceptT ConnectionError Identity (TxOut, Datum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TxOut, Datum)
 -> ExceptT ConnectionError Identity (TxOut, Datum))
-> Maybe (TxOut, Datum)
-> ExceptT ConnectionError Identity (TxOut, Datum)
forall a b. (a -> b) -> a -> b
$ do
                                DecoratedTxOut
ciTxOut <- TxOutRef -> Map TxOutRef DecoratedTxOut -> Maybe DecoratedTxOut
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
icTxOutRef Map TxOutRef DecoratedTxOut
slTxOutputs
                                Datum
datum <- DecoratedTxOut
ciTxOut DecoratedTxOut
-> Getting (First Datum) DecoratedTxOut Datum -> Maybe Datum
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((DatumHash, DatumFromQuery)
 -> Const (First Datum) (DatumHash, DatumFromQuery))
-> DecoratedTxOut -> Const (First Datum) DecoratedTxOut
Traversal' DecoratedTxOut (DatumHash, DatumFromQuery)
Tx.decoratedTxOutDatum (((DatumHash, DatumFromQuery)
  -> Const (First Datum) (DatumHash, DatumFromQuery))
 -> DecoratedTxOut -> Const (First Datum) DecoratedTxOut)
-> ((Datum -> Const (First Datum) Datum)
    -> (DatumHash, DatumFromQuery)
    -> Const (First Datum) (DatumHash, DatumFromQuery))
-> Getting (First Datum) DecoratedTxOut Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatumFromQuery -> Const (First Datum) DatumFromQuery)
-> (DatumHash, DatumFromQuery)
-> Const (First Datum) (DatumHash, DatumFromQuery)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((DatumFromQuery -> Const (First Datum) DatumFromQuery)
 -> (DatumHash, DatumFromQuery)
 -> Const (First Datum) (DatumHash, DatumFromQuery))
-> ((Datum -> Const (First Datum) Datum)
    -> DatumFromQuery -> Const (First Datum) DatumFromQuery)
-> (Datum -> Const (First Datum) Datum)
-> (DatumHash, DatumFromQuery)
-> Const (First Datum) (DatumHash, DatumFromQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Datum -> Const (First Datum) Datum)
-> DatumFromQuery -> Const (First Datum) DatumFromQuery
Traversal' DatumFromQuery Datum
Tx.datumInDatumFromQuery
                                (TxOut, Datum) -> Maybe (TxOut, Datum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DecoratedTxOut -> TxOut
Tx.toTxInfoTxOut DecoratedTxOut
ciTxOut, Datum
datum)
          TypedValidator a
-> TxOutRef
-> TxOut
-> Datum
-> Except ConnectionError (TypedScriptTxOutRef a)
forall out (m :: * -> *).
(FromData (DatumType out), ToData (DatumType out),
 MonadError ConnectionError m) =>
TypedValidator out
-> TxOutRef -> TxOut -> Datum -> m (TypedScriptTxOutRef out)
Typed.typeScriptTxOutRef TypedValidator a
inst TxOutRef
icTxOutRef TxOut
txOut Datum
datum
    let red :: Redeemer
red = BuiltinData -> Redeemer
Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ RedeemerType a -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData RedeemerType a
icRedeemer
    TxConstraint -> m TxConstraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxConstraint -> m TxConstraint) -> TxConstraint -> m TxConstraint
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Redeemer -> Maybe TxOutRef -> TxConstraint
MustSpendScriptOutput (TypedScriptTxOutRef a -> TxOutRef
forall a. TypedScriptTxOutRef a -> TxOutRef
Typed.tyTxOutRefRef TypedScriptTxOutRef a
typedOutRef) Redeemer
red Maybe TxOutRef
icReferenceTxOutRef

-- | Convert a @ScriptOutputConstraint@ into a @TxConstraint@.
addOwnOutput
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       , ToData (DatumType a)
       )
    => ScriptOutputConstraint (DatumType a)
    -> m TxConstraint
addOwnOutput :: ScriptOutputConstraint (DatumType a) -> m TxConstraint
addOwnOutput ScriptOutputConstraint{TxOutDatum (DatumType a)
ocDatum :: forall a. ScriptOutputConstraint a -> TxOutDatum a
ocDatum :: TxOutDatum (DatumType a)
ocDatum, Value
ocValue :: forall a. ScriptOutputConstraint a -> Value
ocValue :: Value
ocValue, Maybe ScriptHash
ocReferenceScriptHash :: forall a. ScriptOutputConstraint a -> Maybe ScriptHash
ocReferenceScriptHash :: Maybe ScriptHash
ocReferenceScriptHash} = do
    ScriptLookups{Maybe (TypedValidator a)
slTypedValidator :: Maybe (TypedValidator a)
slTypedValidator :: forall a. ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator} <- m (ScriptLookups a)
forall r (m :: * -> *). MonadReader r m => m r
ask
    TypedValidator a
inst <- m (TypedValidator a)
-> (TypedValidator a -> m (TypedValidator a))
-> Maybe (TypedValidator a)
-> m (TypedValidator a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MkTxError -> m (TypedValidator a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MkTxError
TypedValidatorMissing) TypedValidator a -> m (TypedValidator a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypedValidator a)
slTypedValidator
    let dsV :: TxOutDatum Datum
dsV = (DatumType a -> Datum)
-> TxOutDatum (DatumType a) -> TxOutDatum Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinData -> Datum
Datum (BuiltinData -> Datum)
-> (DatumType a -> BuiltinData) -> DatumType a -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumType a -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData) TxOutDatum (DatumType a)
ocDatum
    TxConstraint -> m TxConstraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxConstraint -> m TxConstraint) -> TxConstraint -> m TxConstraint
forall a b. (a -> b) -> a -> b
$ Address
-> Maybe (TxOutDatum Datum)
-> Maybe ScriptHash
-> Value
-> TxConstraint
MustPayToAddress (TypedValidator a -> Address
forall a. TypedValidator a -> Address
validatorAddress TypedValidator a
inst) (TxOutDatum Datum -> Maybe (TxOutDatum Datum)
forall a. a -> Maybe a
Just TxOutDatum Datum
dsV) Maybe ScriptHash
ocReferenceScriptHash Value
ocValue

lookupDatum
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       )
    => DatumHash
    -> m Datum
lookupDatum :: DatumHash -> m Datum
lookupDatum DatumHash
dvh =
    let err :: m Datum
err = MkTxError -> m Datum
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DatumHash -> MkTxError
DatumNotFound DatumHash
dvh) in
    (ScriptLookups a -> Map DatumHash Datum) -> m (Map DatumHash Datum)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ScriptLookups a -> Map DatumHash Datum
forall a. ScriptLookups a -> Map DatumHash Datum
slOtherData m (Map DatumHash Datum)
-> (Map DatumHash Datum -> m Datum) -> m Datum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Datum -> (Datum -> m Datum) -> Maybe Datum -> m Datum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Datum
err Datum -> m Datum
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Datum -> m Datum)
-> (Map DatumHash Datum -> Maybe Datum)
-> Map DatumHash Datum
-> m Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe Datum) (Map DatumHash Datum) (Maybe Datum)
-> Map DatumHash Datum -> Maybe Datum
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Index (Map DatumHash Datum)
-> Lens'
     (Map DatumHash Datum) (Maybe (IxValue (Map DatumHash Datum)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map DatumHash Datum)
DatumHash
dvh)

lookupValidator
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       )
    => ValidatorHash
    -> m (Versioned Validator)
lookupValidator :: ValidatorHash -> m (Versioned Validator)
lookupValidator (ValidatorHash BuiltinByteString
vh) = (Script -> Validator) -> Versioned Script -> Versioned Validator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script -> Validator
Validator (Versioned Script -> Versioned Validator)
-> m (Versioned Script) -> m (Versioned Validator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> m (Versioned Script)
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
ScriptHash -> m (Versioned Script)
lookupScript (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
vh)

lookupScript
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       )
    => ScriptHash
    -> m (Versioned Script)
lookupScript :: ScriptHash -> m (Versioned Script)
lookupScript ScriptHash
sh =
    let err :: m (Versioned Script)
err = MkTxError -> m (Versioned Script)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScriptHash -> MkTxError
ScriptHashNotFound ScriptHash
sh) in
    (ScriptLookups a -> Map ScriptHash (Versioned Script))
-> m (Map ScriptHash (Versioned Script))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ScriptLookups a -> Map ScriptHash (Versioned Script)
forall a. ScriptLookups a -> Map ScriptHash (Versioned Script)
slOtherScripts m (Map ScriptHash (Versioned Script))
-> (Map ScriptHash (Versioned Script) -> m (Versioned Script))
-> m (Versioned Script)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Versioned Script)
-> (Versioned Script -> m (Versioned Script))
-> Maybe (Versioned Script)
-> m (Versioned Script)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Versioned Script)
err Versioned Script -> m (Versioned Script)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Versioned Script) -> m (Versioned Script))
-> (Map ScriptHash (Versioned Script) -> Maybe (Versioned Script))
-> Map ScriptHash (Versioned Script)
-> m (Versioned Script)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Maybe (Versioned Script))
  (Map ScriptHash (Versioned Script))
  (Maybe (Versioned Script))
-> Map ScriptHash (Versioned Script) -> Maybe (Versioned Script)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Index (Map ScriptHash (Versioned Script))
-> Lens'
     (Map ScriptHash (Versioned Script))
     (Maybe (IxValue (Map ScriptHash (Versioned Script))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ScriptHash (Versioned Script))
ScriptHash
sh)

lookupTxOutRef
    :: Tx.TxOutRef
    -> ReaderT (ScriptLookups a) (StateT ConstraintProcessingState (Except MkTxError)) Tx.DecoratedTxOut
lookupTxOutRef :: TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
lookupTxOutRef TxOutRef
outRef =
    let err :: ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  DecoratedTxOut
err = MkTxError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxOutRef -> MkTxError
TxOutRefNotFound TxOutRef
outRef) in
    (ScriptLookups a -> Map TxOutRef DecoratedTxOut)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Map TxOutRef DecoratedTxOut)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ScriptLookups a -> Map TxOutRef DecoratedTxOut
forall a. ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  (Map TxOutRef DecoratedTxOut)
-> (Map TxOutRef DecoratedTxOut
    -> ReaderT
         (ScriptLookups a)
         (StateT ConstraintProcessingState (Except MkTxError))
         DecoratedTxOut)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  DecoratedTxOut
-> (DecoratedTxOut
    -> ReaderT
         (ScriptLookups a)
         (StateT ConstraintProcessingState (Except MkTxError))
         DecoratedTxOut)
-> Maybe DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  DecoratedTxOut
err DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DecoratedTxOut
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      DecoratedTxOut)
-> (Map TxOutRef DecoratedTxOut -> Maybe DecoratedTxOut)
-> Map TxOutRef DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Maybe DecoratedTxOut)
  (Map TxOutRef DecoratedTxOut)
  (Maybe DecoratedTxOut)
-> Map TxOutRef DecoratedTxOut -> Maybe DecoratedTxOut
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Index (Map TxOutRef DecoratedTxOut)
-> Lens'
     (Map TxOutRef DecoratedTxOut)
     (Maybe (IxValue (Map TxOutRef DecoratedTxOut)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map TxOutRef DecoratedTxOut)
TxOutRef
outRef)

lookupMintingPolicy
    :: MintingPolicyHash
    -> ReaderT (ScriptLookups a) (StateT ConstraintProcessingState (Except MkTxError)) (Versioned MintingPolicy)
lookupMintingPolicy :: MintingPolicyHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
lookupMintingPolicy (MintingPolicyHash BuiltinByteString
mph) = (Script -> MintingPolicy)
-> Versioned Script -> Versioned MintingPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script -> MintingPolicy
MintingPolicy (Versioned Script -> Versioned MintingPolicy)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned Script)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned Script)
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
ScriptHash -> m (Versioned Script)
lookupScript (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
mph)

lookupScriptAsReferenceScript
    :: Maybe ScriptHash
    -> ReaderT (ScriptLookups a) (StateT ConstraintProcessingState (Except MkTxError)) (C.ReferenceScript C.BabbageEra)
lookupScriptAsReferenceScript :: Maybe ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
lookupScriptAsReferenceScript Maybe ScriptHash
msh = do
    Maybe (Versioned Script)
mscript <- (ScriptHash
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Versioned Script))
-> Maybe ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (Versioned Script))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned Script)
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
ScriptHash -> m (Versioned Script)
lookupScript Maybe ScriptHash
msh
    Either ToCardanoError (ReferenceScript BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
forall (m :: * -> *) a.
MonadError MkTxError m =>
Either ToCardanoError a -> m a
throwToCardanoError (Either ToCardanoError (ReferenceScript BabbageEra)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (ReferenceScript BabbageEra))
-> Either ToCardanoError (ReferenceScript BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
forall a b. (a -> b) -> a -> b
$ Maybe (Versioned Script)
-> Either ToCardanoError (ReferenceScript BabbageEra)
C.toCardanoReferenceScript Maybe (Versioned Script)
mscript

resolveScriptTxOut
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       )
    => DecoratedTxOut -> m (Maybe (Versioned Validator, DatumWithOrigin, Value))
resolveScriptTxOut :: DecoratedTxOut
-> m (Maybe (Versioned Validator, DatumWithOrigin, Value))
resolveScriptTxOut DecoratedTxOut
txo = do
    Maybe (Versioned Validator)
mv <- DecoratedTxOut -> m (Maybe (Versioned Validator))
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
DecoratedTxOut -> m (Maybe (Versioned Validator))
resolveScriptTxOutValidator DecoratedTxOut
txo
    Maybe (DatumWithOrigin, Value)
mdv <- DecoratedTxOut -> m (Maybe (DatumWithOrigin, Value))
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
DecoratedTxOut -> m (Maybe (DatumWithOrigin, Value))
resolveScriptTxOutDatumAndValue DecoratedTxOut
txo
    Maybe (Versioned Validator, DatumWithOrigin, Value)
-> m (Maybe (Versioned Validator, DatumWithOrigin, Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Versioned Validator, DatumWithOrigin, Value)
 -> m (Maybe (Versioned Validator, DatumWithOrigin, Value)))
-> Maybe (Versioned Validator, DatumWithOrigin, Value)
-> m (Maybe (Versioned Validator, DatumWithOrigin, Value))
forall a b. (a -> b) -> a -> b
$ (\Versioned Validator
v (DatumWithOrigin
d, Value
value) -> (Versioned Validator
v, DatumWithOrigin
d, Value
value)) (Versioned Validator
 -> (DatumWithOrigin, Value)
 -> (Versioned Validator, DatumWithOrigin, Value))
-> Maybe (Versioned Validator)
-> Maybe
     ((DatumWithOrigin, Value)
      -> (Versioned Validator, DatumWithOrigin, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Versioned Validator)
mv Maybe
  ((DatumWithOrigin, Value)
   -> (Versioned Validator, DatumWithOrigin, Value))
-> Maybe (DatumWithOrigin, Value)
-> Maybe (Versioned Validator, DatumWithOrigin, Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (DatumWithOrigin, Value)
mdv

resolveScriptTxOutValidator
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       )
    => DecoratedTxOut -> m (Maybe (Versioned Validator))
resolveScriptTxOutValidator :: DecoratedTxOut -> m (Maybe (Versioned Validator))
resolveScriptTxOutValidator
        Tx.ScriptDecoratedTxOut
            { _decoratedTxOutValidator :: DecoratedTxOut -> Maybe (Versioned Validator)
Tx._decoratedTxOutValidator = Maybe (Versioned Validator)
v
            , _decoratedTxOutValidatorHash :: DecoratedTxOut -> ValidatorHash
Tx._decoratedTxOutValidatorHash = ValidatorHash
vh
            } = do
    -- first check in the 'DecoratedTxOut' for the validator, then
    -- look for it in the 'slOtherScripts' map.
    Versioned Validator
validator <- m (Versioned Validator)
-> (Versioned Validator -> m (Versioned Validator))
-> Maybe (Versioned Validator)
-> m (Versioned Validator)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ValidatorHash -> m (Versioned Validator)
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
ValidatorHash -> m (Versioned Validator)
lookupValidator ValidatorHash
vh) Versioned Validator -> m (Versioned Validator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Versioned Validator)
v
    Maybe (Versioned Validator) -> m (Maybe (Versioned Validator))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Versioned Validator) -> m (Maybe (Versioned Validator)))
-> Maybe (Versioned Validator) -> m (Maybe (Versioned Validator))
forall a b. (a -> b) -> a -> b
$ Versioned Validator -> Maybe (Versioned Validator)
forall a. a -> Maybe a
Just Versioned Validator
validator
resolveScriptTxOutValidator DecoratedTxOut
_ = Maybe (Versioned Validator) -> m (Maybe (Versioned Validator))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Versioned Validator)
forall a. Maybe a
Nothing

resolveScriptTxOutDatumAndValue
    :: ( MonadReader (ScriptLookups a) m
       , MonadError MkTxError m
       )
    => DecoratedTxOut -> m (Maybe (DatumWithOrigin, Value))
resolveScriptTxOutDatumAndValue :: DecoratedTxOut -> m (Maybe (DatumWithOrigin, Value))
resolveScriptTxOutDatumAndValue
        Tx.ScriptDecoratedTxOut
            { _decoratedTxOutScriptDatum :: DecoratedTxOut -> (DatumHash, DatumFromQuery)
Tx._decoratedTxOutScriptDatum = (DatumHash
dh, DatumFromQuery
d)
            , Value
_decoratedTxOutValue :: DecoratedTxOut -> Value
_decoratedTxOutValue :: Value
Tx._decoratedTxOutValue
            } = do

    -- first check in the 'DecoratedTxOut' for the datum, then
    -- look for it in the 'slOtherData' map.
    DatumWithOrigin
datum <- case DatumFromQuery
d of
        DatumFromQuery
Tx.DatumUnknown      -> Datum -> DatumWithOrigin
DatumInTx (Datum -> DatumWithOrigin) -> m Datum -> m DatumWithOrigin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatumHash -> m Datum
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
DatumHash -> m Datum
lookupDatum DatumHash
dh
        Tx.DatumInBody Datum
datum -> DatumWithOrigin -> m DatumWithOrigin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Datum -> DatumWithOrigin
DatumInTx Datum
datum)
        Tx.DatumInline Datum
datum -> DatumWithOrigin -> m DatumWithOrigin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Datum -> DatumWithOrigin
DatumInline Datum
datum)
    Maybe (DatumWithOrigin, Value)
-> m (Maybe (DatumWithOrigin, Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DatumWithOrigin, Value)
 -> m (Maybe (DatumWithOrigin, Value)))
-> Maybe (DatumWithOrigin, Value)
-> m (Maybe (DatumWithOrigin, Value))
forall a b. (a -> b) -> a -> b
$ (DatumWithOrigin, Value) -> Maybe (DatumWithOrigin, Value)
forall a. a -> Maybe a
Just (DatumWithOrigin
datum, Value -> Value
C.fromCardanoValue Value
_decoratedTxOutValue)
resolveScriptTxOutDatumAndValue DecoratedTxOut
_ = Maybe (DatumWithOrigin, Value)
-> m (Maybe (DatumWithOrigin, Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DatumWithOrigin, Value)
forall a. Maybe a
Nothing

throwToCardanoError :: MonadError MkTxError m => Either C.ToCardanoError a -> m a
throwToCardanoError :: Either ToCardanoError a -> m a
throwToCardanoError (Left ToCardanoError
err) = MkTxError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m a) -> MkTxError -> m a
forall a b. (a -> b) -> a -> b
$ ToCardanoError -> MkTxError
ToCardanoError ToCardanoError
err
throwToCardanoError (Right a
a)  = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

toTxOutDatum :: Maybe (TxOutDatum Datum) -> C.TxOutDatum C.CtxTx C.BabbageEra
toTxOutDatum :: Maybe (TxOutDatum Datum) -> TxOutDatum CtxTx BabbageEra
toTxOutDatum = \case
    Maybe (TxOutDatum Datum)
Nothing                   -> TxOutDatum CtxTx BabbageEra
C.toCardanoTxOutNoDatum
    Just (TxOutDatumHash Datum
d)   -> Datum -> TxOutDatum CtxTx BabbageEra
forall ctx. Datum -> TxOutDatum ctx BabbageEra
C.toCardanoTxOutDatumHashFromDatum Datum
d
    Just (TxOutDatumInTx Datum
d)   -> Datum -> TxOutDatum CtxTx BabbageEra
C.toCardanoTxOutDatumInTx Datum
d
    Just (TxOutDatumInline Datum
d) -> Datum -> TxOutDatum CtxTx BabbageEra
C.toCardanoTxOutDatumInline Datum
d

-- | Turn a 'TxConstraints' value into an unbalanced transaction that satisfies
--   the constraints. To use this in a contract, see
--   'Plutus.Contract.submitTxConstraints'
--   and related functions.
mkTxWithParams
    :: ( FromData (DatumType a)
       , ToData (DatumType a)
       , ToData (RedeemerType a)
       )
    => Params
    -> ScriptLookups a
    -> TxConstraints (RedeemerType a) (DatumType a)
    -> Either MkTxError UnbalancedTx
mkTxWithParams :: Params
-> ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Either MkTxError UnbalancedTx
mkTxWithParams Params
params ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
txc = Params
-> [SomeLookupsAndConstraints] -> Either MkTxError UnbalancedTx
mkSomeTx Params
params [ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> SomeLookupsAndConstraints
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> SomeLookupsAndConstraints
SomeLookupsAndConstraints ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
txc]

-- | Each transaction output should contain a minimum amount of Ada (this is a
-- restriction on the real Cardano network).
adjustUnbalancedTx :: PParams -> UnbalancedTx -> ([C.Lovelace], UnbalancedTx)
adjustUnbalancedTx :: PParams -> UnbalancedTx -> ([Lovelace], UnbalancedTx)
adjustUnbalancedTx PParams
params = (CardanoBuildTx -> ([Lovelace], CardanoBuildTx))
-> UnbalancedTx -> ([Lovelace], UnbalancedTx)
Traversal' UnbalancedTx CardanoBuildTx
tx ((CardanoBuildTx -> ([Lovelace], CardanoBuildTx))
 -> UnbalancedTx -> ([Lovelace], UnbalancedTx))
-> ((TxOut -> ([Lovelace], TxOut))
    -> CardanoBuildTx -> ([Lovelace], CardanoBuildTx))
-> (TxOut -> ([Lovelace], TxOut))
-> UnbalancedTx
-> ([Lovelace], UnbalancedTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut] -> ([Lovelace], [TxOut]))
-> CardanoBuildTx -> ([Lovelace], CardanoBuildTx)
Lens' CardanoBuildTx [TxOut]
txOuts (([TxOut] -> ([Lovelace], [TxOut]))
 -> CardanoBuildTx -> ([Lovelace], CardanoBuildTx))
-> ((TxOut -> ([Lovelace], TxOut))
    -> [TxOut] -> ([Lovelace], [TxOut]))
-> (TxOut -> ([Lovelace], TxOut))
-> CardanoBuildTx
-> ([Lovelace], CardanoBuildTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut -> ([Lovelace], TxOut)) -> [TxOut] -> ([Lovelace], [TxOut])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TxOut -> ([Lovelace], TxOut))
 -> UnbalancedTx -> ([Lovelace], UnbalancedTx))
-> (TxOut -> ([Lovelace], TxOut))
-> UnbalancedTx
-> ([Lovelace], UnbalancedTx)
forall a b. (a -> b) -> a -> b
$ PParams -> TxOut -> ([Lovelace], TxOut)
adjustTxOut PParams
params

updateUtxoIndex
    :: ( MonadReader (ScriptLookups a) m
       , MonadState ConstraintProcessingState m
       , MonadError MkTxError m
       )
    => m ()
updateUtxoIndex :: m ()
updateUtxoIndex = do
    ScriptLookups{Map TxOutRef DecoratedTxOut
slTxOutputs :: Map TxOutRef DecoratedTxOut
slTxOutputs :: forall a. ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs} <- m (ScriptLookups a)
forall r (m :: * -> *). MonadReader r m => m r
ask
    NetworkId
networkId <- (ConstraintProcessingState -> NetworkId) -> m NetworkId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((ConstraintProcessingState -> NetworkId) -> m NetworkId)
-> (ConstraintProcessingState -> NetworkId) -> m NetworkId
forall a b. (a -> b) -> a -> b
$ Params -> NetworkId
pNetworkId (Params -> NetworkId)
-> (ConstraintProcessingState -> Params)
-> ConstraintProcessingState
-> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintProcessingState -> Params
cpsParams
    UtxoIndex
slUtxos <- Either ToCardanoError UtxoIndex -> m UtxoIndex
forall (m :: * -> *) a.
MonadError MkTxError m =>
Either ToCardanoError a -> m a
throwToCardanoError (Either ToCardanoError UtxoIndex -> m UtxoIndex)
-> Either ToCardanoError UtxoIndex -> m UtxoIndex
forall a b. (a -> b) -> a -> b
$ NetworkId
-> Map TxOutRef DecoratedTxOut -> Either ToCardanoError UtxoIndex
Tx.fromDecoratedIndex NetworkId
networkId Map TxOutRef DecoratedTxOut
slTxOutputs
    (UnbalancedTx -> Identity UnbalancedTx)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState UnbalancedTx
unbalancedTx ((UnbalancedTx -> Identity UnbalancedTx)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ((UtxoIndex -> Identity UtxoIndex)
    -> UnbalancedTx -> Identity UnbalancedTx)
-> (UtxoIndex -> Identity UtxoIndex)
-> ConstraintProcessingState
-> Identity ConstraintProcessingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoIndex -> Identity UtxoIndex)
-> UnbalancedTx -> Identity UnbalancedTx
Lens' UnbalancedTx UtxoIndex
utxoIndex ((UtxoIndex -> Identity UtxoIndex)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> UtxoIndex -> m ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= UtxoIndex
slUtxos