{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE DeriveAnyClass            #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE DerivingVia               #-}
{-# LANGUAGE EmptyCase                 #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE PolyKinds                 #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TupleSections             #-}
{-# LANGUAGE TypeApplications          #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeOperators             #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE ViewPatterns              #-}
{-# OPTIONS_GHC -Wno-missing-import-lists #-}
module Ledger.Tx.Constraints.OffChain(
    -- * Lookups
    P.ScriptLookups(..)
    , P.typedValidatorLookups
    , P.generalise
    , P.unspentOutputs
    , P.mintingPolicy
    , P.plutusV1MintingPolicy
    , P.plutusV2MintingPolicy
    , P.otherScript
    , P.plutusV1OtherScript
    , P.plutusV2OtherScript
    , P.otherData
    , P.ownPaymentPubKeyHash
    , P.ownStakingCredential
    , P.paymentPubKey
    , P.paymentPubKeyHash
    -- * Constraints resolution
    , P.SomeLookupsAndConstraints(..)
    , UnbalancedTx(..)
    , unBalancedTxTx
    , tx
    , txValidityRange
    , txOuts
    , P.utxoIndex
    , emptyUnbalancedTx
    , P.adjustUnbalancedTx
    , MkTxError(..)
    , mkTx
    , mkSomeTx
    ) where

import Cardano.Api qualified as C
import Cardano.Api.Shelley qualified as C
import Cardano.Node.Emulator.Params (Params (..), networkIdL, pProtocolParams)
import Cardano.Node.Emulator.TimeSlot (posixTimeRangeToContainedSlotRange)
import Control.Lens (Lens', Traversal', _2, coerced, iso, makeLensesFor, use, uses, (.=), (<>=), (^.), (^?))
import Control.Lens.Extras (is)
import Control.Monad.Except (Except, MonadError, guard, lift, mapExcept, runExcept, throwError, unless, withExcept)
import Control.Monad.Reader (MonadReader, ReaderT (runReaderT), ask, mapReaderT)
import Control.Monad.State (MonadState, StateT, execStateT, gets, mapStateT)
import Data.Aeson (FromJSON, ToJSON)
import Data.Bifunctor (first)
import Data.Either (partitionEithers)
import Data.Foldable (traverse_)
import Data.Map qualified as Map
import Data.Set qualified as Set
import GHC.Generics (Generic)
import Ledger (Datum, Language (PlutusV2), MintingPolicy, MintingPolicyHash, POSIXTimeRange, Versioned,
               decoratedTxOutReferenceScript)
import Ledger.Constraints qualified as P
import Ledger.Constraints.OffChain (UnbalancedTx (..), cpsUnbalancedTx, unBalancedTxTx, unbalancedTx)
import Ledger.Constraints.OffChain qualified as P
import Ledger.Constraints.TxConstraints (ScriptOutputConstraint, TxConstraint,
                                         TxConstraints (TxConstraints, txConstraints, txOwnInputs, txOwnOutputs),
                                         TxOutDatum (TxOutDatumHash, TxOutDatumInTx, TxOutDatumInline))
import Ledger.Constraints.ValidityInterval (toPlutusInterval)
import Plutus.Script.Utils.V2.Typed.Scripts qualified as Typed
import Plutus.V1.Ledger.Value qualified as Value
import Plutus.V2.Ledger.Tx qualified as PV2

import Ledger.Interval ()
import Ledger.Orphans ()
import Ledger.Scripts (ScriptHash, getRedeemer, getValidator)
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (CardanoBuildTx (CardanoBuildTx), toCardanoMintWitness, toCardanoPolicyId)
import Ledger.Tx.CardanoAPI qualified as C
import Ledger.Typed.Scripts (ConnectionError (UnknownRef), ValidatorTypes (DatumType, RedeemerType))
import PlutusTx (FromData, ToData (toBuiltinData))
import PlutusTx.Lattice (BoundedMeetSemiLattice (top), MeetSemiLattice ((/\)))
import Prettyprinter (Pretty (pretty), colon, (<+>))

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

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

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

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

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

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

txOuts :: Lens' C.CardanoBuildTx [C.TxOut C.CtxTx C.BabbageEra]
txOuts :: ([TxOut CtxTx BabbageEra] -> f [TxOut CtxTx BabbageEra])
-> 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 CtxTx BabbageEra] -> f [TxOut CtxTx BabbageEra])
    -> TxBodyContent BuildTx BabbageEra
    -> f (TxBodyContent BuildTx BabbageEra))
-> ([TxOut CtxTx BabbageEra] -> f [TxOut CtxTx BabbageEra])
-> 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'

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'

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

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 -> Map TxOutRef TxOut -> UnbalancedTx
UnbalancedCardanoTx (Params -> CardanoBuildTx
emptyCardanoBuildTx Params
params) Map TxOutRef TxOut
forall a. Monoid a => a
mempty

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

data MkTxError
    = ToCardanoError C.ToCardanoError
    | LedgerMkTxError P.MkTxError
    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)

instance Pretty MkTxError where
    pretty :: MkTxError -> Doc ann
pretty = \case
        ToCardanoError ToCardanoError
err  -> Doc ann
"ToCardanoError" 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
<+> ToCardanoError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ToCardanoError
err
        LedgerMkTxError MkTxError
err -> MkTxError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty MkTxError
err


-- | Given a list of 'SomeLookupsAndConstraints' describing the constraints
--   for several scripts, build a single transaction that runs all the scripts.
mkSomeTx
    :: Params
    -> [P.SomeLookupsAndConstraints]
    -> Either MkTxError UnbalancedTx
mkSomeTx :: Params
-> [SomeLookupsAndConstraints] -> Either MkTxError UnbalancedTx
mkSomeTx Params
params [SomeLookupsAndConstraints]
xs =
    let process :: SomeLookupsAndConstraints
-> StateT ConstraintProcessingState (Except MkTxError) ()
process = \case
            P.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]
   }

prepareConstraints
    :: ToData (DatumType a)
    => [ScriptOutputConstraint (DatumType a)]
    -> [TxConstraint]
    -> ReaderT (P.ScriptLookups a) (StateT P.ConstraintProcessingState (Except MkTxError)) SortedConstraints
prepareConstraints :: [ScriptOutputConstraint (DatumType a)]
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
prepareConstraints [ScriptOutputConstraint (DatumType a)]
ownOutputs [TxConstraint]
constraints = do
    let
      extractPosixTimeRange :: TxConstraint -> Either POSIXTimeRange TxConstraint
extractPosixTimeRange = \case
        P.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]
other <- ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [TxConstraint]
forall a b.
ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
mapLedgerMkTxError (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   [TxConstraint]
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      [TxConstraint])
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [TxConstraint]
forall a b. (a -> b) -> a -> b
$ [ScriptOutputConstraint (DatumType a)]
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     [TxConstraint]
forall a (m :: * -> *).
(ToData (DatumType a), MonadReader (ScriptLookups a) m,
 MonadError MkTxError m) =>
[ScriptOutputConstraint (DatumType a)]
-> [TxConstraint] -> m [TxConstraint]
P.prepareConstraints [ScriptOutputConstraint (DatumType a)]
ownOutputs [TxConstraint]
nonRangeConstraints
    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]
other


-- | Resolve some 'TxConstraints' by modifying the 'UnbalancedTx' in the
--   'ConstraintProcessingState'
processLookupsAndConstraints
    ::
    ( FromData (DatumType a)
    , ToData (DatumType a)
    , ToData (RedeemerType a)
    )
    => P.ScriptLookups a
    -> TxConstraints (RedeemerType a) (DatumType a)
    -> StateT P.ConstraintProcessingState (Except MkTxError) ()
processLookupsAndConstraints :: ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> StateT ConstraintProcessingState (Except MkTxError) ()
processLookupsAndConstraints ScriptLookups a
lookups TxConstraints{[TxConstraint]
txConstraints :: [TxConstraint]
txConstraints :: forall i o. TxConstraints i o -> [TxConstraint]
txConstraints, [ScriptInputConstraint (RedeemerType a)]
txOwnInputs :: [ScriptInputConstraint (RedeemerType a)]
txOwnInputs :: forall i o. TxConstraints i o -> [ScriptInputConstraint i]
txOwnInputs, [ScriptOutputConstraint (DatumType a)]
txOwnOutputs :: [ScriptOutputConstraint (DatumType a)]
txOwnOutputs :: forall i o. TxConstraints i o -> [ScriptOutputConstraint o]
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 <- [ScriptOutputConstraint (DatumType a)]
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
forall a.
ToData (DatumType a) =>
[ScriptOutputConstraint (DatumType a)]
-> [TxConstraint]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     SortedConstraints
prepareConstraints [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)
            -- traverse_ P.processConstraintFun txCnsFuns
            (ScriptInputConstraint (RedeemerType a)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> [ScriptInputConstraint (RedeemerType a)]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ScriptInputConstraint (RedeemerType a)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m,
 MonadState ConstraintProcessingState m, FromData (DatumType a),
 ToData (DatumType a), ToData (RedeemerType a)) =>
ScriptInputConstraint (RedeemerType a) -> m ()
addOwnInput [ScriptInputConstraint (RedeemerType a)]
txOwnInputs
            -- P.addMintingRedeemers
            ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m,
 MonadState ConstraintProcessingState m, MonadError MkTxError m) =>
m ()
checkValueSpent
            (StateT ConstraintProcessingState (Except MkTxError) ()
 -> StateT ConstraintProcessingState (Except MkTxError) ())
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((ExceptT MkTxError Identity ((), ConstraintProcessingState)
 -> ExceptT MkTxError Identity ((), ConstraintProcessingState))
-> StateT ConstraintProcessingState (Except MkTxError) ()
-> StateT ConstraintProcessingState (Except MkTxError) ()
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((MkTxError -> MkTxError)
-> ExceptT MkTxError Identity ((), ConstraintProcessingState)
-> ExceptT MkTxError Identity ((), ConstraintProcessingState)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept MkTxError -> MkTxError
LedgerMkTxError)) ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  ()
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m,
 MonadState ConstraintProcessingState m, MonadError MkTxError m) =>
m ()
P.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)

checkValueSpent
    :: ( MonadReader (P.ScriptLookups a) m
       , MonadState P.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
P.valueSpentInputs ValueSpentBalances -> Value
P.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
$ MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError) -> MkTxError -> MkTxError
forall a b. (a -> b) -> a -> b
$ Value -> MkTxError
P.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
P.valueSpentOutputs ValueSpentBalances -> Value
P.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
$ MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError) -> MkTxError -> MkTxError
forall a b. (a -> b) -> a -> b
$ Value -> MkTxError
P.DeclaredOutputMismatch Value
missingOutputs

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

-- | Turn a 'TxConstraints' value into an unbalanced transaction that satisfies
--   the constraints. To use this in a contract, see
--   'Plutus.Contract.submitTxConstraints'
--   and related functions.
mkTx
    :: ( FromData (DatumType a)
       , ToData (DatumType a)
       , ToData (RedeemerType a)
       )
    => Params
    -> P.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
P.SomeLookupsAndConstraints ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
txc]

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

-- | Modify the 'UnbalancedTx' so that it satisfies the constraints, if
--   possible. Fails if a hash is missing from the lookups, or if an output
--   of the wrong type is spent.
processConstraint
    :: TxConstraint
    -> ReaderT (P.ScriptLookups a) (StateT P.ConstraintProcessingState (Except MkTxError)) ()
processConstraint :: TxConstraint
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
processConstraint = \case
    P.MustIncludeDatumInTxWithHash DatumHash
_ Datum
_ -> ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- always succeeds
    P.MustIncludeDatumInTx Datum
_ -> ()
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- always succeeds
    P.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 (MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError) -> MkTxError -> MkTxError
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MkTxError
P.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
P.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
P.provided Value
value

    P.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
    P.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 (MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError) -> MkTxError -> MkTxError
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MkTxError
P.TxOutRefNoReferenceScript TxOutRef
ref)
          Maybe TxOutRef
Nothing -> do
            Maybe (Versioned Validator)
mscriptTXO <- ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  (Maybe (Versioned Validator))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (Versioned Validator))
forall a b.
ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
mapLedgerMkTxError (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   (Maybe (Versioned Validator))
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Maybe (Versioned Validator)))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (Versioned Validator))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (Versioned Validator))
forall a b. (a -> b) -> a -> b
$ 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))
P.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 (MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError) -> MkTxError -> MkTxError
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MkTxError
P.TxOutRefWrongType TxOutRef
txo)
        Maybe (DatumWithOrigin, Value)
mscriptTXO <- ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  (Maybe (DatumWithOrigin, Value))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (DatumWithOrigin, Value))
forall a b.
ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
mapLedgerMkTxError (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   (Maybe (DatumWithOrigin, Value))
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Maybe (DatumWithOrigin, Value)))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (DatumWithOrigin, Value))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Maybe (DatumWithOrigin, Value))
forall a b. (a -> b) -> a -> b
$ 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))
P.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
P.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
P.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
P.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 (MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError) -> MkTxError -> MkTxError
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MkTxError
P.TxOutRefWrongType TxOutRef
txo)

    P.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 ]

    P.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 ]

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

        -- If i is negative we are burning tokens. The tokens burned must
        -- be provided as an input. So we add the value burnt to
        -- 'valueSpentInputs'. If i is positive then new tokens are created
        -- which must be added to 'valueSpentOutputs'.
        if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
            then (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
P.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
P.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
P.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
P.provided (Integer -> Value
value Integer
i)

        Value
v <- (ToCardanoError
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      Value)
-> (Value
    -> ReaderT
         (ScriptLookups a)
         (StateT ConstraintProcessingState (Except MkTxError))
         Value)
-> Either ToCardanoError Value
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ToCardanoError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall a. HasCallStack => a
undefined Value
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      PolicyId)
-> (PolicyId
    -> ReaderT
         (ScriptLookups a)
         (StateT ConstraintProcessingState (Except MkTxError))
         PolicyId)
-> Either ToCardanoError PolicyId
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     PolicyId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ToCardanoError
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     PolicyId
forall a. HasCallStack => a
undefined PolicyId
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     PolicyId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 -> Either ToCardanoError TxIn)
-> (TxOutRef -> TxOutRef) -> TxOutRef -> Either ToCardanoError TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInput -> TxOutRef
Tx.txInputRef (TxInput -> TxOutRef)
-> (TxOutRef -> TxInput) -> TxOutRef -> TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> TxInput
Tx.pubKeyTxInput (TxOutRef -> Either ToCardanoError TxIn)
-> TxOutRef -> Either ToCardanoError TxIn
forall a b. (a -> b) -> a -> b
$ 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 (MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError) -> MkTxError -> MkTxError
forall a b. (a -> b) -> a -> b
$ TxOutRef -> MkTxError
P.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)

    P.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
P.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 -> Either ToCardanoError (TxOutValue BabbageEra)
C.toCardanoTxOutValue 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 CtxTx BabbageEra] -> Identity [TxOut CtxTx BabbageEra])
    -> UnbalancedTx -> Identity UnbalancedTx)
-> ([TxOut CtxTx BabbageEra] -> Identity [TxOut CtxTx 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)
-> (([TxOut CtxTx BabbageEra] -> Identity [TxOut CtxTx BabbageEra])
    -> CardanoBuildTx -> Identity CardanoBuildTx)
-> ([TxOut CtxTx BabbageEra] -> Identity [TxOut CtxTx BabbageEra])
-> UnbalancedTx
-> Identity UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxOut CtxTx BabbageEra] -> Identity [TxOut CtxTx BabbageEra])
-> CardanoBuildTx -> Identity CardanoBuildTx
Lens' CardanoBuildTx [TxOut CtxTx BabbageEra]
txOuts (([TxOut CtxTx BabbageEra] -> Identity [TxOut CtxTx BabbageEra])
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> [TxOut CtxTx BabbageEra]
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [ TxOut CtxTx BabbageEra
out ]

        (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
P.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
P.provided Value
vl

    P.MustSpendAtLeast Value
vl -> (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
P.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
P.required Value
vl
    P.MustProduceAtLeast Value
vl -> (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
P.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
P.required Value
vl

    TxConstraint
c -> String
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a. HasCallStack => String -> a
error (String
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      ())
-> String
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     ()
forall a b. (a -> b) -> a -> b
$ String
"Ledger.Tx.Constraints.OffChain: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxConstraint -> String
forall a. Show a => a -> String
show TxConstraint
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not implemented yet"

lookupTxOutRef
    :: Tx.TxOutRef
    -> ReaderT (P.ScriptLookups a) (StateT P.ConstraintProcessingState (Except MkTxError)) Tx.DecoratedTxOut
lookupTxOutRef :: TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
lookupTxOutRef TxOutRef
txo = ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall a b.
ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
mapLedgerMkTxError (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   DecoratedTxOut
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      DecoratedTxOut)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall a b. (a -> b) -> a -> b
$ TxOutRef
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     DecoratedTxOut
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
TxOutRef -> m DecoratedTxOut
P.lookupTxOutRef TxOutRef
txo

lookupMintingPolicy
    :: MintingPolicyHash
    -> ReaderT (P.ScriptLookups a) (StateT P.ConstraintProcessingState (Except MkTxError)) (Versioned MintingPolicy)
lookupMintingPolicy :: MintingPolicyHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
lookupMintingPolicy MintingPolicyHash
mph = ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  (Versioned MintingPolicy)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
forall a b.
ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
mapLedgerMkTxError (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   (Versioned MintingPolicy)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (Versioned MintingPolicy))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
forall a b. (a -> b) -> a -> b
$ MintingPolicyHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (Versioned MintingPolicy)
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
MintingPolicyHash -> m (Versioned MintingPolicy)
P.lookupMintingPolicy MintingPolicyHash
mph

lookupScriptAsReferenceScript
    :: Maybe ScriptHash
    -> ReaderT (P.ScriptLookups a) (StateT P.ConstraintProcessingState (Except MkTxError)) (C.ReferenceScript C.BabbageEra)
lookupScriptAsReferenceScript :: Maybe ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
lookupScriptAsReferenceScript Maybe ScriptHash
msh = ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  (ReferenceScript BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
forall a b.
ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
mapLedgerMkTxError (ReaderT
   (ScriptLookups a)
   (StateT ConstraintProcessingState (Except MkTxError))
   (ReferenceScript BabbageEra)
 -> ReaderT
      (ScriptLookups a)
      (StateT ConstraintProcessingState (Except MkTxError))
      (ReferenceScript BabbageEra))
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
forall a b. (a -> b) -> a -> b
$ Maybe ScriptHash
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     (ReferenceScript BabbageEra)
forall a (m :: * -> *).
(MonadReader (ScriptLookups a) m, MonadError MkTxError m) =>
Maybe ScriptHash -> m (ReferenceScript BabbageEra)
P.lookupScriptAsReferenceScript Maybe ScriptHash
msh

mapLedgerMkTxError
    :: ReaderT (P.ScriptLookups a) (StateT P.ConstraintProcessingState (Except P.MkTxError)) b
    -> ReaderT (P.ScriptLookups a) (StateT P.ConstraintProcessingState (Except MkTxError)) b
mapLedgerMkTxError :: ReaderT
  (ScriptLookups a)
  (StateT ConstraintProcessingState (Except MkTxError))
  b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
mapLedgerMkTxError = (StateT ConstraintProcessingState (Except MkTxError) b
 -> StateT ConstraintProcessingState (Except MkTxError) b)
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
-> ReaderT
     (ScriptLookups a)
     (StateT ConstraintProcessingState (Except MkTxError))
     b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((ExceptT MkTxError Identity (b, ConstraintProcessingState)
 -> ExceptT MkTxError Identity (b, ConstraintProcessingState))
-> StateT ConstraintProcessingState (Except MkTxError) b
-> StateT ConstraintProcessingState (Except MkTxError) b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((Either MkTxError (b, ConstraintProcessingState)
 -> Either MkTxError (b, ConstraintProcessingState))
-> ExceptT MkTxError Identity (b, ConstraintProcessingState)
-> ExceptT MkTxError Identity (b, ConstraintProcessingState)
forall e a e' b.
(Either e a -> Either e' b) -> Except e a -> Except e' b
mapExcept ((MkTxError -> MkTxError)
-> Either MkTxError (b, ConstraintProcessingState)
-> Either MkTxError (b, ConstraintProcessingState)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MkTxError -> MkTxError
LedgerMkTxError)))

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

-- | Add a typed input, checking the type of the output it spends. Return the value
--   of the spent output.
addOwnInput
    :: ( MonadReader (P.ScriptLookups a) m
       , MonadError MkTxError m
       , MonadState P.ConstraintProcessingState m
       , FromData (DatumType a)
       , ToData (DatumType a)
       , ToData (RedeemerType a)
       )
    => P.ScriptInputConstraint (RedeemerType a)
    -> m ()
addOwnInput :: ScriptInputConstraint (RedeemerType a) -> m ()
addOwnInput P.ScriptInputConstraint{RedeemerType a
icRedeemer :: forall a. ScriptInputConstraint a -> a
icRedeemer :: RedeemerType a
P.icRedeemer, TxOutRef
icTxOutRef :: forall a. ScriptInputConstraint a -> TxOutRef
icTxOutRef :: TxOutRef
P.icTxOutRef} = do
    P.ScriptLookups{Map TxOutRef DecoratedTxOut
slTxOutputs :: forall a. ScriptLookups a -> Map TxOutRef DecoratedTxOut
slTxOutputs :: Map TxOutRef DecoratedTxOut
P.slTxOutputs, Maybe (TypedValidator a)
slTypedValidator :: forall a. ScriptLookups a -> Maybe (TypedValidator a)
slTypedValidator :: Maybe (TypedValidator a)
P.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 -> m (TypedValidator a))
-> MkTxError -> m (TypedValidator a)
forall a b. (a -> b) -> a -> b
$ MkTxError -> MkTxError
LedgerMkTxError MkTxError
P.TypedValidatorMissing) TypedValidator a -> m (TypedValidator a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypedValidator a)
slTypedValidator
    Typed.TypedScriptTxOutRef{TxOutRef
tyTxOutRefRef :: forall a. TypedScriptTxOutRef a -> TxOutRef
tyTxOutRefRef :: TxOutRef
Typed.tyTxOutRefRef, TypedScriptTxOut a
tyTxOutRefOut :: forall a. TypedScriptTxOutRef a -> TypedScriptTxOut a
tyTxOutRefOut :: TypedScriptTxOut a
Typed.tyTxOutRefOut} <-
      (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
. MkTxError -> MkTxError
LedgerMkTxError (MkTxError -> MkTxError)
-> (ConnectionError -> MkTxError) -> ConnectionError -> MkTxError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionError -> MkTxError
P.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 vl :: Value
vl = TxOut -> Value
PV2.txOutValue (TxOut -> Value) -> TxOut -> Value
forall a b. (a -> b) -> a -> b
$ TypedScriptTxOut a -> TxOut
forall a. TypedScriptTxOut a -> TxOut
Typed.tyTxOutTxOut TypedScriptTxOut a
tyTxOutRefOut
    (ValueSpentBalances -> Identity ValueSpentBalances)
-> ConstraintProcessingState -> Identity ConstraintProcessingState
Lens' ConstraintProcessingState ValueSpentBalances
P.valueSpentInputs ((ValueSpentBalances -> Identity ValueSpentBalances)
 -> ConstraintProcessingState -> Identity ConstraintProcessingState)
-> ValueSpentBalances -> m ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Value -> ValueSpentBalances
P.provided Value
vl
    let datum :: ScriptDatum WitCtxTxIn
datum = ScriptData -> ScriptDatum WitCtxTxIn
C.ScriptDatumForTxIn (ScriptData -> ScriptDatum WitCtxTxIn)
-> ScriptData -> ScriptDatum WitCtxTxIn
forall a b. (a -> b) -> a -> b
$ BuiltinData -> ScriptData
C.toCardanoScriptData (BuiltinData -> ScriptData) -> BuiltinData -> ScriptData
forall a b. (a -> b) -> a -> b
$ DatumType a -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData (DatumType a -> BuiltinData) -> DatumType a -> BuiltinData
forall a b. (a -> b) -> a -> b
$ TypedScriptTxOut a -> DatumType a
forall a. TypedScriptTxOut a -> DatumType a
Typed.tyTxOutData TypedScriptTxOut a
tyTxOutRefOut
    TxIn
txIn <- (ToCardanoError -> m TxIn)
-> (TxIn -> m TxIn) -> Either ToCardanoError TxIn -> m TxIn
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MkTxError -> m TxIn
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m TxIn)
-> (ToCardanoError -> MkTxError) -> ToCardanoError -> m TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> MkTxError
ToCardanoError) TxIn -> m TxIn
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError TxIn -> m TxIn)
-> Either ToCardanoError TxIn -> m TxIn
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
C.toCardanoTxIn TxOutRef
tyTxOutRefRef
    WitnessHeader
mkWitness <- (ToCardanoError -> m WitnessHeader)
-> (WitnessHeader -> m WitnessHeader)
-> Either ToCardanoError WitnessHeader
-> m WitnessHeader
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MkTxError -> m WitnessHeader
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> m WitnessHeader)
-> (ToCardanoError -> MkTxError)
-> ToCardanoError
-> m WitnessHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> MkTxError
ToCardanoError) WitnessHeader -> m WitnessHeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                     (Either ToCardanoError WitnessHeader -> m WitnessHeader)
-> Either ToCardanoError WitnessHeader -> m WitnessHeader
forall a b. (a -> b) -> a -> b
$ Versioned Script -> Either ToCardanoError WitnessHeader
C.toCardanoTxInScriptWitnessHeader (Versioned Script -> Either ToCardanoError WitnessHeader)
-> Versioned Script -> Either ToCardanoError WitnessHeader
forall a b. (a -> b) -> a -> b
$ (Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validator -> Script
getValidator (Versioned Validator -> Versioned Script)
-> Versioned Validator -> Versioned Script
forall a b. (a -> b) -> a -> b
$ TypedValidator a -> Versioned Validator
forall a. TypedValidator a -> Versioned Validator
Typed.vValidatorScript TypedValidator a
inst
    let witIn :: Witness WitCtxTxIn BabbageEra
witIn = 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 ScriptDatum WitCtxTxIn
datum (BuiltinData -> ScriptData
C.toCardanoScriptData (BuiltinData -> ScriptData) -> BuiltinData -> ScriptData
forall a b. (a -> b) -> a -> b
$ RedeemerType a -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData RedeemerType a
icRedeemer) 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))]
-> m ()
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
witIn)]
    () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()