{-# 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(
ScriptLookups(..)
, typedValidatorLookups
, generalise
, unspentOutputs
, mintingPolicy
, plutusV1MintingPolicy
, plutusV2MintingPolicy
, otherScript
, plutusV1OtherScript
, plutusV2OtherScript
, otherData
, paymentPubKey
, paymentPubKeyHash
, 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
, 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
, ScriptLookups a -> Map ScriptHash (Versioned Script)
slOtherScripts :: Map ScriptHash (Versioned Script)
, ScriptLookups a -> Map DatumHash Datum
slOtherData :: Map DatumHash Datum
, ScriptLookups a -> Set PaymentPubKeyHash
slPaymentPubKeyHashes :: Set PaymentPubKeyHash
, ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator :: Maybe (TypedValidator a)
, ScriptLookups a -> Maybe PaymentPubKeyHash
slOwnPaymentPubKeyHash :: Maybe PaymentPubKeyHash
, ScriptLookups a -> Maybe StakingCredential
slOwnStakingCredential :: Maybe StakingCredential
} 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
, 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
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
}
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 }
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 }
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)
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)
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 }
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)
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)
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 }
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))
= (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
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)
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 }
data UnbalancedTx
= UnbalancedCardanoTx
{ UnbalancedTx -> CardanoBuildTx
unBalancedCardanoBuildTx :: C.CardanoBuildTx
, UnbalancedTx -> UtxoIndex
unBalancedTxUtxoIndex :: UtxoIndex
}
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)
]
data ValueSpentBalances =
ValueSpentBalances
{ ValueSpentBalances -> Value
vbsRequired :: Value
, ValueSpentBalances -> Value
vbsProvided :: Value
} 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
}
data ConstraintProcessingState =
ConstraintProcessingState
{ ConstraintProcessingState -> UnbalancedTx
cpsUnbalancedTx :: UnbalancedTx
, ConstraintProcessingState -> ValueSpentBalances
cpsValueSpentBalancesInputs :: ValueSpentBalances
, ConstraintProcessingState -> ValueSpentBalances
cpsValueSpentBalancesOutputs :: ValueSpentBalances
, 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 }
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
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)
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 []
[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)
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
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
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
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
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 ()
MustIncludeDatumInTx Datum
_ -> ()
-> ReaderT
(ScriptLookups a)
(StateT ConstraintProcessingState (Except MkTxError))
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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 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
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
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
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
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
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]
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