{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
module Plutus.Contract.Request(
    -- * PAB requests
    -- ** Waiting
    awaitSlot
    , isSlot
    , currentSlot
    , waitNSlots
    , awaitTime
    , isTime
    , currentTime
    , waitNMilliSeconds
    -- ** Chain index queries
    , datumFromHash
    , validatorFromHash
    , mintingPolicyFromHash
    , stakeValidatorFromHash
    , redeemerFromHash
    , unspentTxOutFromRef
    , utxoRefMembership
    , utxoRefsAt
    , utxoRefsWithCurrency
    , utxosAt
    , utxosTxOutTxFromTx
    , txoRefsAt
    , getTip
    -- ** Waiting for changes to the UTXO set
    , fundsAtAddressGt
    , fundsAtAddressGeq
    , fundsAtAddressCondition
    , watchAddressUntilSlot
    , watchAddressUntilTime
    , awaitUtxoSpent
    , utxoIsSpent
    , awaitUtxoProduced
    , utxoIsProduced
    -- ** Tx and tx output confirmation
    , RollbackState(..)
    , TxStatus
    , awaitTxStatusChange
    , awaitTxConfirmed
    , isTxConfirmed
    , TxOutStatus
    , awaitTxOutStatusChange
    -- ** Contract instances
    , ownInstanceId
    -- ** Exposing endpoints
    , HasEndpoint
    , EndpointDescription(..)
    , Endpoint
    , endpoint
    , handleEndpoint
    , endpointWithMeta
    , endpointDescription
    , endpointReq
    , endpointResp
    -- ** Public key hashes
    , ownPaymentPubKeyHash
    -- ** Submitting transactions
    , submitUnbalancedTx
    , submitBalancedTx
    , balanceTx
    , submitTx
    , submitTxConstraints
    , submitTxConstraintsSpending
    , submitTxConstraintsWith
    , submitTxConfirmed
    , mkTxConstraints
    , yieldUnbalancedTx
    -- * Etc.
    , ContractRow
    , pabReq
    , mkTxContract
    , MkTxLog(..)
    ) where

import Control.Lens (Prism', preview, review, view)
import Control.Monad.Freer.Error qualified as E
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as JSON
import Data.Aeson.Types qualified as JSON
import Data.Bifunctor (Bifunctor (..))
import Data.Default (Default (def))
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Row (AllUniqueLabels, HasType, KnownSymbol, type (.==))
import Data.Text qualified as Text
import Data.Text.Extras (tshow)
import Data.Void (Void)
import GHC.Generics (Generic)
import GHC.Natural (Natural)
import GHC.TypeLits (Symbol, symbolVal)
import Ledger (Address, AssetClass, Datum, DatumHash, DiffMilliSeconds, MintingPolicy, MintingPolicyHash, POSIXTime,
               PaymentPubKeyHash, Redeemer, RedeemerHash, Slot, StakeValidator, StakeValidatorHash, TxId, TxOutRef,
               Validator, ValidatorHash, Value, addressCredential, fromMilliSeconds)
import Ledger.Constraints (TxConstraints)
import Ledger.Constraints.OffChain (ScriptLookups, UnbalancedTx)
import Ledger.Constraints.OffChain qualified as Constraints
import Ledger.Tx (CardanoTx, ChainIndexTxOut, ciTxOutValue, getCardanoTxId)
import Ledger.Typed.Scripts (Any, TypedValidator, ValidatorTypes (DatumType, RedeemerType))
import Ledger.Value qualified as V
import Plutus.Contract.Util (loopM)
import PlutusTx qualified

import Plutus.Contract.Effects (ActiveEndpoint (ActiveEndpoint, aeDescription, aeMetadata),
                                PABReq (AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentSlotReq, CurrentTimeReq, ExposeEndpointReq, OwnContractInstanceIdReq, OwnPaymentPublicKeyHashReq, WriteBalancedTxReq, YieldUnbalancedTxReq),
                                PABResp (ExposeEndpointResp))
import Plutus.Contract.Effects qualified as E
import Plutus.Contract.Logging (logDebug)
import Plutus.Contract.Schema (Input, Output)
import Wallet.Types (ContractInstanceId, EndpointDescription (EndpointDescription),
                     EndpointValue (EndpointValue, unEndpointValue))

import Plutus.ChainIndex (ChainIndexTx, Page (nextPageQuery, pageItems), PageQuery, txOutRefs)
import Plutus.ChainIndex.Api (IsUtxoResponse, TxosResponse, UtxosResponse (page))
import Plutus.ChainIndex.Types (RollbackState (Unknown), Tip, TxOutStatus, TxStatus)
import Plutus.Contract.Error (AsContractError (_ChainIndexContractError, _ConstraintResolutionContractError, _EndpointDecodeContractError, _ResumableContractError, _WalletContractError))
import Plutus.Contract.Resumable (prompt)
import Plutus.Contract.Types (Contract (Contract), MatchingError (WrongVariantError), Promise (Promise), mapError,
                              runError, throwError)

-- | Constraints on the contract schema, ensuring that the labels of the schema
--   are unique.
type ContractRow s =
  ( AllUniqueLabels (Input s)
  , AllUniqueLabels (Output s)
  )

{- Send a 'PABReq' and return the appropriate 'PABResp'
-}
pabReq ::
  forall w s e a.
  ( AsContractError e
  )
  => PABReq -- ^ The request to send
  -> Prism' PABResp a -- ^ Prism for the response
  -> Contract w s e a
pabReq :: PABReq -> Prism' PABResp a -> Contract w s e a
pabReq PABReq
req Prism' PABResp a
prism = Eff (ContractEffs w e) a -> Contract w s e a
forall w (s :: Row *) e a.
Eff (ContractEffs w e) a -> Contract w s e a
Contract (Eff (ContractEffs w e) a -> Contract w s e a)
-> Eff (ContractEffs w e) a -> Contract w s e a
forall a b. (a -> b) -> a -> b
$ do
  PABResp
x <- PABReq -> Eff (ContractEffs w e) PABResp
forall i o (effs :: [* -> *]).
Member (Resumable i o) effs =>
o -> Eff effs i
prompt @PABResp @PABReq PABReq
req
  case Getting (First a) PABResp a -> PABResp -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First a) PABResp a
Prism' PABResp a
prism PABResp
x of
    Just a
r -> a -> Eff (ContractEffs w e) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
    Maybe a
_      ->
        forall (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
E.throwError @e
            (e -> Eff (ContractEffs w e) a) -> e -> Eff (ContractEffs w e) a
forall a b. (a -> b) -> a -> b
$ AReview e MatchingError -> MatchingError -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e MatchingError
forall r. AsContractError r => Prism' r MatchingError
_ResumableContractError
            (MatchingError -> e) -> MatchingError -> e
forall a b. (a -> b) -> a -> b
$ Text -> MatchingError
WrongVariantError
            (Text -> MatchingError) -> Text -> MatchingError
forall a b. (a -> b) -> a -> b
$ Text
"unexpected answer: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PABResp -> Text
forall a. Show a => a -> Text
tshow PABResp
x

-- | Wait until the slot
awaitSlot ::
    forall w s e.
    ( AsContractError e
    )
    => Slot
    -> Contract w s e Slot
awaitSlot :: Slot -> Contract w s e Slot
awaitSlot Slot
s = PABReq -> Prism' PABResp Slot -> Contract w s e Slot
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (Slot -> PABReq
AwaitSlotReq Slot
s) Prism' PABResp Slot
E._AwaitSlotResp

-- | Wait until the slot
isSlot ::
    forall w s e.
    ( AsContractError e
    )
    => Slot
    -> Promise w s e Slot
isSlot :: Slot -> Promise w s e Slot
isSlot = Contract w s e Slot -> Promise w s e Slot
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e Slot -> Promise w s e Slot)
-> (Slot -> Contract w s e Slot) -> Slot -> Promise w s e Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> Contract w s e Slot
forall w (s :: Row *) e.
AsContractError e =>
Slot -> Contract w s e Slot
awaitSlot

-- | Get the current slot number
currentSlot ::
    forall w s e.
    ( AsContractError e
    )
    => Contract w s e Slot
currentSlot :: Contract w s e Slot
currentSlot = PABReq -> Prism' PABResp Slot -> Contract w s e Slot
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq PABReq
CurrentSlotReq Prism' PABResp Slot
E._CurrentSlotResp

-- | Wait for a number of slots to pass
waitNSlots ::
  forall w s e.
  ( AsContractError e
  )
  => Natural
  -> Contract w s e Slot
waitNSlots :: Natural -> Contract w s e Slot
waitNSlots Natural
n = do
  Slot
c <- Contract w s e Slot
forall w (s :: Row *) e. AsContractError e => Contract w s e Slot
currentSlot
  Slot -> Contract w s e Slot
forall w (s :: Row *) e.
AsContractError e =>
Slot -> Contract w s e Slot
awaitSlot (Slot -> Contract w s e Slot) -> Slot -> Contract w s e Slot
forall a b. (a -> b) -> a -> b
$ Slot
c Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ Natural -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n

-- | Wait until the slot where the given time falls into and return latest time
-- we know has passed.
--
-- Example: if starting time is 0 and slot length is 3s, then `awaitTime 4`
-- waits until slot 2 and returns the value `POSIXTime 5`.
awaitTime ::
    forall w s e.
    ( AsContractError e
    )
    => POSIXTime
    -> Contract w s e POSIXTime
awaitTime :: POSIXTime -> Contract w s e POSIXTime
awaitTime POSIXTime
s = PABReq -> Prism' PABResp POSIXTime -> Contract w s e POSIXTime
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (POSIXTime -> PABReq
AwaitTimeReq POSIXTime
s) Prism' PABResp POSIXTime
E._AwaitTimeResp

-- | Wait until the slot where the given time falls into and return latest time
-- we know has passed.
isTime ::
    forall w s e.
    ( AsContractError e
    )
    => POSIXTime
    -> Promise w s e POSIXTime
isTime :: POSIXTime -> Promise w s e POSIXTime
isTime = Contract w s e POSIXTime -> Promise w s e POSIXTime
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e POSIXTime -> Promise w s e POSIXTime)
-> (POSIXTime -> Contract w s e POSIXTime)
-> POSIXTime
-> Promise w s e POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Contract w s e POSIXTime
forall w (s :: Row *) e.
AsContractError e =>
POSIXTime -> Contract w s e POSIXTime
awaitTime

-- | Get the latest time of the current slot.
--
-- Example: if slot length is 3s and current slot is 2, then `currentTime`
-- returns the value `POSIXTime 5`
currentTime ::
    forall w s e.
    ( AsContractError e
    )
    => Contract w s e POSIXTime
currentTime :: Contract w s e POSIXTime
currentTime = PABReq -> Prism' PABResp POSIXTime -> Contract w s e POSIXTime
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq PABReq
CurrentTimeReq Prism' PABResp POSIXTime
E._CurrentTimeResp

-- | Wait for a number of milliseconds starting at the ending time of the current
-- slot, and return the latest time we know has passed.
--
-- Example: if starting time is 0, slot length is 3000ms and current slot is 0, then
-- `waitNMilliSeconds 0` returns the value `POSIXTime 2000` and `waitNMilliSeconds 1000`
-- returns the value `POSIXTime 5`.
waitNMilliSeconds ::
  forall w s e.
  ( AsContractError e
  )
  => DiffMilliSeconds
  -> Contract w s e POSIXTime
waitNMilliSeconds :: DiffMilliSeconds -> Contract w s e POSIXTime
waitNMilliSeconds DiffMilliSeconds
n = do
  POSIXTime
t <- Contract w s e POSIXTime
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e POSIXTime
currentTime
  POSIXTime -> Contract w s e POSIXTime
forall w (s :: Row *) e.
AsContractError e =>
POSIXTime -> Contract w s e POSIXTime
awaitTime (POSIXTime -> Contract w s e POSIXTime)
-> POSIXTime -> Contract w s e POSIXTime
forall a b. (a -> b) -> a -> b
$ POSIXTime
t POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ DiffMilliSeconds -> POSIXTime
fromMilliSeconds DiffMilliSeconds
n

datumFromHash ::
    forall w s e.
    ( AsContractError e
    )
    => DatumHash
    -> Contract w s e (Maybe Datum)
datumFromHash :: DatumHash -> Contract w s e (Maybe Datum)
datumFromHash DatumHash
h = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ DatumHash -> ChainIndexQuery
E.DatumFromHash DatumHash
h) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.DatumHashResponse Maybe Datum
r -> Maybe Datum -> Contract w s e (Maybe Datum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Datum
r
    ChainIndexResponse
r                     -> e -> Contract w s e (Maybe Datum)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e (Maybe Datum))
-> e -> Contract w s e (Maybe Datum)
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"DatumHashResponse", ChainIndexResponse
r)

validatorFromHash ::
    forall w s e.
    ( AsContractError e
    )
    => ValidatorHash
    -> Contract w s e (Maybe Validator)
validatorFromHash :: ValidatorHash -> Contract w s e (Maybe Validator)
validatorFromHash ValidatorHash
h = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ ValidatorHash -> ChainIndexQuery
E.ValidatorFromHash ValidatorHash
h) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.ValidatorHashResponse Maybe Validator
r -> Maybe Validator -> Contract w s e (Maybe Validator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Validator
r
    ChainIndexResponse
r                         -> e -> Contract w s e (Maybe Validator)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e (Maybe Validator))
-> e -> Contract w s e (Maybe Validator)
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"ValidatorHashResponse", ChainIndexResponse
r)

mintingPolicyFromHash ::
    forall w s e.
    ( AsContractError e
    )
    => MintingPolicyHash
    -> Contract w s e (Maybe MintingPolicy)
mintingPolicyFromHash :: MintingPolicyHash -> Contract w s e (Maybe MintingPolicy)
mintingPolicyFromHash MintingPolicyHash
h = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ MintingPolicyHash -> ChainIndexQuery
E.MintingPolicyFromHash MintingPolicyHash
h) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.MintingPolicyHashResponse Maybe MintingPolicy
r -> Maybe MintingPolicy -> Contract w s e (Maybe MintingPolicy)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe MintingPolicy
r
    ChainIndexResponse
r                             -> e -> Contract w s e (Maybe MintingPolicy)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e (Maybe MintingPolicy))
-> e -> Contract w s e (Maybe MintingPolicy)
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"MintingPolicyHashResponse", ChainIndexResponse
r)

stakeValidatorFromHash ::
    forall w s e.
    ( AsContractError e
    )
    => StakeValidatorHash
    -> Contract w s e (Maybe StakeValidator)
stakeValidatorFromHash :: StakeValidatorHash -> Contract w s e (Maybe StakeValidator)
stakeValidatorFromHash StakeValidatorHash
h = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ StakeValidatorHash -> ChainIndexQuery
E.StakeValidatorFromHash StakeValidatorHash
h) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.StakeValidatorHashResponse Maybe StakeValidator
r -> Maybe StakeValidator -> Contract w s e (Maybe StakeValidator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StakeValidator
r
    ChainIndexResponse
r                              -> e -> Contract w s e (Maybe StakeValidator)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e (Maybe StakeValidator))
-> e -> Contract w s e (Maybe StakeValidator)
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"StakeValidatorHashResponse", ChainIndexResponse
r)

redeemerFromHash ::
    forall w s e.
    ( AsContractError e
    )
    => RedeemerHash
    -> Contract w s e (Maybe Redeemer)
redeemerFromHash :: RedeemerHash -> Contract w s e (Maybe Redeemer)
redeemerFromHash RedeemerHash
h = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ RedeemerHash -> ChainIndexQuery
E.RedeemerFromHash RedeemerHash
h) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.RedeemerHashResponse Maybe Redeemer
r -> Maybe Redeemer -> Contract w s e (Maybe Redeemer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Redeemer
r
    ChainIndexResponse
r                        -> e -> Contract w s e (Maybe Redeemer)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e (Maybe Redeemer))
-> e -> Contract w s e (Maybe Redeemer)
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"RedeemerHashResponse", ChainIndexResponse
r)

unspentTxOutFromRef ::
    forall w s e.
    ( AsContractError e
    )
    => TxOutRef
    -> Contract w s e (Maybe ChainIndexTxOut)
unspentTxOutFromRef :: TxOutRef -> Contract w s e (Maybe ChainIndexTxOut)
unspentTxOutFromRef TxOutRef
ref = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ TxOutRef -> ChainIndexQuery
E.UnspentTxOutFromRef TxOutRef
ref) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.UnspentTxOutResponse Maybe ChainIndexTxOut
r -> Maybe ChainIndexTxOut -> Contract w s e (Maybe ChainIndexTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ChainIndexTxOut
r
    ChainIndexResponse
r                        -> e -> Contract w s e (Maybe ChainIndexTxOut)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e (Maybe ChainIndexTxOut))
-> e -> Contract w s e (Maybe ChainIndexTxOut)
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"UnspentTxOutResponse", ChainIndexResponse
r)

utxoRefMembership ::
    forall w s e.
    ( AsContractError e
    )
    => TxOutRef
    -> Contract w s e IsUtxoResponse
utxoRefMembership :: TxOutRef -> Contract w s e IsUtxoResponse
utxoRefMembership TxOutRef
ref = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ TxOutRef -> ChainIndexQuery
E.UtxoSetMembership TxOutRef
ref) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.UtxoSetMembershipResponse IsUtxoResponse
r -> IsUtxoResponse -> Contract w s e IsUtxoResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsUtxoResponse
r
    ChainIndexResponse
r                             -> e -> Contract w s e IsUtxoResponse
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e IsUtxoResponse)
-> e -> Contract w s e IsUtxoResponse
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"UtxoSetMembershipResponse", ChainIndexResponse
r)

-- | Get the unspent transaction output references at an address.
utxoRefsAt ::
    forall w s e.
    ( AsContractError e
    )
    => PageQuery TxOutRef
    -> Address
    -> Contract w s e UtxosResponse
utxoRefsAt :: PageQuery TxOutRef -> Address -> Contract w s e UtxosResponse
utxoRefsAt PageQuery TxOutRef
pq Address
addr = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ PageQuery TxOutRef -> Credential -> ChainIndexQuery
E.UtxoSetAtAddress PageQuery TxOutRef
pq (Credential -> ChainIndexQuery) -> Credential -> ChainIndexQuery
forall a b. (a -> b) -> a -> b
$ Address -> Credential
addressCredential Address
addr) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.UtxoSetAtResponse UtxosResponse
r -> UtxosResponse -> Contract w s e UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure UtxosResponse
r
    ChainIndexResponse
r                     -> e -> Contract w s e UtxosResponse
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e UtxosResponse)
-> e -> Contract w s e UtxosResponse
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"UtxoSetAtResponse", ChainIndexResponse
r)

-- | Get the unspent transaction output references with a specific currrency ('AssetClass').
utxoRefsWithCurrency ::
    forall w s e.
    ( AsContractError e
    )
    => PageQuery TxOutRef
    -> AssetClass
    -> Contract w s e UtxosResponse
utxoRefsWithCurrency :: PageQuery TxOutRef -> AssetClass -> Contract w s e UtxosResponse
utxoRefsWithCurrency PageQuery TxOutRef
pq AssetClass
assetClass = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ PageQuery TxOutRef -> AssetClass -> ChainIndexQuery
E.UtxoSetWithCurrency PageQuery TxOutRef
pq AssetClass
assetClass) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.UtxoSetWithCurrencyResponse UtxosResponse
r -> UtxosResponse -> Contract w s e UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure UtxosResponse
r
    ChainIndexResponse
r                               -> e -> Contract w s e UtxosResponse
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e UtxosResponse)
-> e -> Contract w s e UtxosResponse
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"UtxoSetWithCurrencyResponse", ChainIndexResponse
r)

-- | Fold through each 'Page's of unspent 'TxOutRef's at a given 'Address', and
-- accumulate the result.
foldUtxoRefsAt ::
    forall w s e a.
    ( AsContractError e
    )
    => (a -> Page TxOutRef -> Contract w s e a) -- ^ Accumulator function
    -> a -- ^ Initial value
    -> Address -- ^ Address which contain the UTXOs
    -> Contract w s e a
foldUtxoRefsAt :: (a -> Page TxOutRef -> Contract w s e a)
-> a -> Address -> Contract w s e a
foldUtxoRefsAt a -> Page TxOutRef -> Contract w s e a
f a
ini Address
addr = a -> Maybe (PageQuery TxOutRef) -> Contract w s e a
go a
ini (PageQuery TxOutRef -> Maybe (PageQuery TxOutRef)
forall a. a -> Maybe a
Just PageQuery TxOutRef
forall a. Default a => a
def)
  where
    go :: a -> Maybe (PageQuery TxOutRef) -> Contract w s e a
go a
acc Maybe (PageQuery TxOutRef)
Nothing = a -> Contract w s e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
acc
    go a
acc (Just PageQuery TxOutRef
pq) = do
      Page TxOutRef
page <- UtxosResponse -> Page TxOutRef
page (UtxosResponse -> Page TxOutRef)
-> Contract w s e UtxosResponse -> Contract w s e (Page TxOutRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PageQuery TxOutRef -> Address -> Contract w s e UtxosResponse
forall w (s :: Row *) e.
AsContractError e =>
PageQuery TxOutRef -> Address -> Contract w s e UtxosResponse
utxoRefsAt PageQuery TxOutRef
pq Address
addr
      a
newAcc <- a -> Page TxOutRef -> Contract w s e a
f a
acc Page TxOutRef
page
      a -> Maybe (PageQuery TxOutRef) -> Contract w s e a
go a
newAcc (Page TxOutRef -> Maybe (PageQuery TxOutRef)
forall a. Page a -> Maybe (PageQuery a)
nextPageQuery Page TxOutRef
page)

-- | Get the unspent transaction outputs at an address.
utxosAt ::
    forall w s e.
    ( AsContractError e
    )
    => Address
    -> Contract w s e (Map TxOutRef ChainIndexTxOut)
utxosAt :: Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
utxosAt Address
addr = do
  (Map TxOutRef ChainIndexTxOut
 -> Page TxOutRef -> Contract w s e (Map TxOutRef ChainIndexTxOut))
-> Map TxOutRef ChainIndexTxOut
-> Address
-> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e a.
AsContractError e =>
(a -> Page TxOutRef -> Contract w s e a)
-> a -> Address -> Contract w s e a
foldUtxoRefsAt Map TxOutRef ChainIndexTxOut
-> Page TxOutRef -> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall e w (s :: Row *).
AsContractError e =>
Map TxOutRef ChainIndexTxOut
-> Page TxOutRef -> Contract w s e (Map TxOutRef ChainIndexTxOut)
f Map TxOutRef ChainIndexTxOut
forall k a. Map k a
Map.empty Address
addr
  where
    f :: Map TxOutRef ChainIndexTxOut
-> Page TxOutRef -> Contract w s e (Map TxOutRef ChainIndexTxOut)
f Map TxOutRef ChainIndexTxOut
acc Page TxOutRef
page = do
      let utxoRefs :: [TxOutRef]
utxoRefs = Page TxOutRef -> [TxOutRef]
forall a. Page a -> [a]
pageItems Page TxOutRef
page
      [Maybe ChainIndexTxOut]
txOuts <- (TxOutRef -> Contract w s e (Maybe ChainIndexTxOut))
-> [TxOutRef] -> Contract w s e [Maybe ChainIndexTxOut]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TxOutRef -> Contract w s e (Maybe ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
TxOutRef -> Contract w s e (Maybe ChainIndexTxOut)
unspentTxOutFromRef [TxOutRef]
utxoRefs
      let utxos :: Map TxOutRef ChainIndexTxOut
utxos = [(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                ([(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut)
-> [(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut
forall a b. (a -> b) -> a -> b
$ ((TxOutRef, Maybe ChainIndexTxOut)
 -> Maybe (TxOutRef, ChainIndexTxOut))
-> [(TxOutRef, Maybe ChainIndexTxOut)]
-> [(TxOutRef, ChainIndexTxOut)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(TxOutRef
ref, Maybe ChainIndexTxOut
txOut) -> (ChainIndexTxOut -> (TxOutRef, ChainIndexTxOut))
-> Maybe ChainIndexTxOut -> Maybe (TxOutRef, ChainIndexTxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOutRef
ref,) Maybe ChainIndexTxOut
txOut)
                ([(TxOutRef, Maybe ChainIndexTxOut)]
 -> [(TxOutRef, ChainIndexTxOut)])
-> [(TxOutRef, Maybe ChainIndexTxOut)]
-> [(TxOutRef, ChainIndexTxOut)]
forall a b. (a -> b) -> a -> b
$ [TxOutRef]
-> [Maybe ChainIndexTxOut] -> [(TxOutRef, Maybe ChainIndexTxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxOutRef]
utxoRefs [Maybe ChainIndexTxOut]
txOuts
      Map TxOutRef ChainIndexTxOut
-> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxOutRef ChainIndexTxOut
 -> Contract w s e (Map TxOutRef ChainIndexTxOut))
-> Map TxOutRef ChainIndexTxOut
-> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall a b. (a -> b) -> a -> b
$ Map TxOutRef ChainIndexTxOut
acc Map TxOutRef ChainIndexTxOut
-> Map TxOutRef ChainIndexTxOut -> Map TxOutRef ChainIndexTxOut
forall a. Semigroup a => a -> a -> a
<> Map TxOutRef ChainIndexTxOut
utxos

-- | Get the unspent transaction outputs from a 'ChainIndexTx'.
utxosTxOutTxFromTx ::
    AsContractError e
    => ChainIndexTx
    -> Contract w s e [(TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
utxosTxOutTxFromTx :: ChainIndexTx
-> Contract w s e [(TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
utxosTxOutTxFromTx ChainIndexTx
tx =
  [Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
-> [(TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
 -> [(TxOutRef, (ChainIndexTxOut, ChainIndexTx))])
-> Contract
     w s e [Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
-> Contract w s e [(TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxOutRef
 -> Contract
      w s e (Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))))
-> [TxOutRef]
-> Contract
     w s e [Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxOutRef
-> Contract
     w s e (Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx)))
mkOutRef (ChainIndexTx -> [TxOutRef]
txOutRefs ChainIndexTx
tx)
  where
    mkOutRef :: TxOutRef
-> Contract
     w s e (Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx)))
mkOutRef TxOutRef
txOutRef = do
      Maybe ChainIndexTxOut
ciTxOutM <- TxOutRef -> Contract w s e (Maybe ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
TxOutRef -> Contract w s e (Maybe ChainIndexTxOut)
unspentTxOutFromRef TxOutRef
txOutRef
      Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))
-> Contract
     w s e (Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))
 -> Contract
      w s e (Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))))
-> Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))
-> Contract
     w s e (Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx)))
forall a b. (a -> b) -> a -> b
$ Maybe ChainIndexTxOut
ciTxOutM Maybe ChainIndexTxOut
-> (ChainIndexTxOut
    -> Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx)))
-> Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ChainIndexTxOut
ciTxOut -> (TxOutRef, (ChainIndexTxOut, ChainIndexTx))
-> Maybe (TxOutRef, (ChainIndexTxOut, ChainIndexTx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutRef
txOutRef, (ChainIndexTxOut
ciTxOut, ChainIndexTx
tx))

-- | Get the transaction outputs at an address.
txoRefsAt ::
    forall w s e.
    ( AsContractError e
    )
    => PageQuery TxOutRef
    -> Address
    -> Contract w s e TxosResponse
txoRefsAt :: PageQuery TxOutRef -> Address -> Contract w s e TxosResponse
txoRefsAt PageQuery TxOutRef
pq Address
addr = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq (ChainIndexQuery -> PABReq) -> ChainIndexQuery -> PABReq
forall a b. (a -> b) -> a -> b
$ PageQuery TxOutRef -> Credential -> ChainIndexQuery
E.TxoSetAtAddress PageQuery TxOutRef
pq (Credential -> ChainIndexQuery) -> Credential -> ChainIndexQuery
forall a b. (a -> b) -> a -> b
$ Address -> Credential
addressCredential Address
addr) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.TxoSetAtResponse TxosResponse
r -> TxosResponse -> Contract w s e TxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxosResponse
r
    ChainIndexResponse
r                    -> e -> Contract w s e TxosResponse
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e TxosResponse)
-> e -> Contract w s e TxosResponse
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"TxoSetAtAddress", ChainIndexResponse
r)

getTip ::
    forall w s e.
    ( AsContractError e
    )
    => Contract w s e Tip
getTip :: Contract w s e Tip
getTip = do
  ChainIndexResponse
cir <- PABReq
-> Prism' PABResp ChainIndexResponse
-> Contract w s e ChainIndexResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ChainIndexQuery -> PABReq
ChainIndexQueryReq ChainIndexQuery
E.GetTip) Prism' PABResp ChainIndexResponse
E._ChainIndexQueryResp
  case ChainIndexResponse
cir of
    E.GetTipResponse Tip
r -> Tip -> Contract w s e Tip
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tip
r
    ChainIndexResponse
r                  -> e -> Contract w s e Tip
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e Tip) -> e -> Contract w s e Tip
forall a b. (a -> b) -> a -> b
$ AReview e (Text, ChainIndexResponse)
-> (Text, ChainIndexResponse) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (Text, ChainIndexResponse)
forall r. AsContractError r => Prism' r (Text, ChainIndexResponse)
_ChainIndexContractError (Text
"GetTipResponse", ChainIndexResponse
r)

-- | Wait until the target slot and get the unspent transaction outputs at an
-- address.
watchAddressUntilSlot ::
    forall w s e.
    ( AsContractError e
    )
    => Address
    -> Slot
    -> Contract w s e (Map TxOutRef ChainIndexTxOut)
watchAddressUntilSlot :: Address -> Slot -> Contract w s e (Map TxOutRef ChainIndexTxOut)
watchAddressUntilSlot Address
a Slot
slot = Slot -> Contract w s e Slot
forall w (s :: Row *) e.
AsContractError e =>
Slot -> Contract w s e Slot
awaitSlot Slot
slot Contract w s e Slot
-> Contract w s e (Map TxOutRef ChainIndexTxOut)
-> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
utxosAt Address
a

-- | Wait until the target time and get the unspent transaction outputs at an
-- address.
watchAddressUntilTime ::
    forall w s e.
    ( AsContractError e
    )
    => Address
    -> POSIXTime
    -> Contract w s e (Map TxOutRef ChainIndexTxOut)
watchAddressUntilTime :: Address
-> POSIXTime -> Contract w s e (Map TxOutRef ChainIndexTxOut)
watchAddressUntilTime Address
a POSIXTime
time = POSIXTime -> Contract w s e POSIXTime
forall w (s :: Row *) e.
AsContractError e =>
POSIXTime -> Contract w s e POSIXTime
awaitTime POSIXTime
time Contract w s e POSIXTime
-> Contract w s e (Map TxOutRef ChainIndexTxOut)
-> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
utxosAt Address
a

{-| Wait until the UTXO has been spent, returning the transaction that spends it.
-}
awaitUtxoSpent ::
  forall w s e.
  ( AsContractError e
  )
  => TxOutRef
  -> Contract w s e ChainIndexTx
awaitUtxoSpent :: TxOutRef -> Contract w s e ChainIndexTx
awaitUtxoSpent TxOutRef
utxo = PABReq
-> Prism' PABResp ChainIndexTx -> Contract w s e ChainIndexTx
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (TxOutRef -> PABReq
AwaitUtxoSpentReq TxOutRef
utxo) Prism' PABResp ChainIndexTx
E._AwaitUtxoSpentResp

{-| Wait until the UTXO has been spent, returning the transaction that spends it.
-}
utxoIsSpent ::
  forall w s e.
  ( AsContractError e
  )
  => TxOutRef
  -> Promise w s e ChainIndexTx
utxoIsSpent :: TxOutRef -> Promise w s e ChainIndexTx
utxoIsSpent = Contract w s e ChainIndexTx -> Promise w s e ChainIndexTx
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e ChainIndexTx -> Promise w s e ChainIndexTx)
-> (TxOutRef -> Contract w s e ChainIndexTx)
-> TxOutRef
-> Promise w s e ChainIndexTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> Contract w s e ChainIndexTx
forall w (s :: Row *) e.
AsContractError e =>
TxOutRef -> Contract w s e ChainIndexTx
awaitUtxoSpent

{-| Wait until one or more unspent outputs are produced at an address.
-}
awaitUtxoProduced ::
  forall w s e .
  ( AsContractError e
  )
  => Address
  -> Contract w s e (NonEmpty ChainIndexTx)
awaitUtxoProduced :: Address -> Contract w s e (NonEmpty ChainIndexTx)
awaitUtxoProduced Address
address =
  PABReq
-> Prism' PABResp (NonEmpty ChainIndexTx)
-> Contract w s e (NonEmpty ChainIndexTx)
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (Address -> PABReq
AwaitUtxoProducedReq Address
address) Prism' PABResp (NonEmpty ChainIndexTx)
E._AwaitUtxoProducedResp

{-| Wait until one or more unspent outputs are produced at an address.
-}
utxoIsProduced ::
  forall w s e .
  ( AsContractError e
  )
  => Address
  -> Promise w s e (NonEmpty ChainIndexTx)
utxoIsProduced :: Address -> Promise w s e (NonEmpty ChainIndexTx)
utxoIsProduced = Contract w s e (NonEmpty ChainIndexTx)
-> Promise w s e (NonEmpty ChainIndexTx)
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e (NonEmpty ChainIndexTx)
 -> Promise w s e (NonEmpty ChainIndexTx))
-> (Address -> Contract w s e (NonEmpty ChainIndexTx))
-> Address
-> Promise w s e (NonEmpty ChainIndexTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Contract w s e (NonEmpty ChainIndexTx)
forall w (s :: Row *) e.
AsContractError e =>
Address -> Contract w s e (NonEmpty ChainIndexTx)
awaitUtxoProduced

-- | Watch an address for changes, and return the outputs
--   at that address when the total value at the address
--   has surpassed the given value.
fundsAtAddressGt
    :: forall w s e.
       ( AsContractError e
       )
    => Address
    -> Value
    -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressGt :: Address -> Value -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressGt Address
addr Value
vl =
    (Value -> Bool)
-> Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
(Value -> Bool)
-> Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressCondition (\Value
presentVal -> Value
presentVal Value -> Value -> Bool
`V.gt` Value
vl) Address
addr

fundsAtAddressCondition
    :: forall w s e.
       ( AsContractError e
       )
    => (Value -> Bool)
    -> Address
    -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressCondition :: (Value -> Bool)
-> Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressCondition Value -> Bool
condition Address
addr = (() -> Contract w s e (Either () (Map TxOutRef ChainIndexTxOut)))
-> () -> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Either a b)) -> a -> m b
loopM () -> Contract w s e (Either () (Map TxOutRef ChainIndexTxOut))
go () where
    go :: () -> Contract w s e (Either () (Map TxOutRef ChainIndexTxOut))
go () = do
        Map TxOutRef ChainIndexTxOut
cur <- Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
utxosAt Address
addr
        let presentVal :: Value
presentVal = (ChainIndexTxOut -> Value) -> Map TxOutRef ChainIndexTxOut -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting Value ChainIndexTxOut Value -> ChainIndexTxOut -> Value
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Value ChainIndexTxOut Value
Lens' ChainIndexTxOut Value
ciTxOutValue) Map TxOutRef ChainIndexTxOut
cur
        if Value -> Bool
condition Value
presentVal
            then Either () (Map TxOutRef ChainIndexTxOut)
-> Contract w s e (Either () (Map TxOutRef ChainIndexTxOut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxOutRef ChainIndexTxOut
-> Either () (Map TxOutRef ChainIndexTxOut)
forall a b. b -> Either a b
Right Map TxOutRef ChainIndexTxOut
cur)
            else Address -> Contract w s e (NonEmpty ChainIndexTx)
forall w (s :: Row *) e.
AsContractError e =>
Address -> Contract w s e (NonEmpty ChainIndexTx)
awaitUtxoProduced Address
addr Contract w s e (NonEmpty ChainIndexTx)
-> Contract w s e (Either () (Map TxOutRef ChainIndexTxOut))
-> Contract w s e (Either () (Map TxOutRef ChainIndexTxOut))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either () (Map TxOutRef ChainIndexTxOut)
-> Contract w s e (Either () (Map TxOutRef ChainIndexTxOut))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either () (Map TxOutRef ChainIndexTxOut)
forall a b. a -> Either a b
Left ())

-- | Watch an address for changes, and return the outputs
--   at that address when the total value at the address
--   has reached or surpassed the given value.
fundsAtAddressGeq
    :: forall w s e.
       ( AsContractError e
       )
    => Address
    -> Value
    -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressGeq :: Address -> Value -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressGeq Address
addr Value
vl =
    (Value -> Bool)
-> Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
forall w (s :: Row *) e.
AsContractError e =>
(Value -> Bool)
-> Address -> Contract w s e (Map TxOutRef ChainIndexTxOut)
fundsAtAddressCondition (\Value
presentVal -> Value
presentVal Value -> Value -> Bool
`V.geq` Value
vl) Address
addr

-- | Wait for the status of a transaction to change
awaitTxStatusChange :: forall w s e. AsContractError e => TxId -> Contract w s e TxStatus
awaitTxStatusChange :: TxId -> Contract w s e TxStatus
awaitTxStatusChange TxId
i = PABReq -> Prism' PABResp TxStatus -> Contract w s e TxStatus
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (TxId -> PABReq
AwaitTxStatusChangeReq TxId
i) (TxId -> Prism' PABResp TxStatus
E._AwaitTxStatusChangeResp' TxId
i)

-- TODO: Configurable level of confirmation (for example, as soon as the tx is
--       included in a block, or only when it can't be rolled back anymore)
-- | Wait until a transaction is confirmed (added to the ledger).
--   If the transaction is never added to the ledger then 'awaitTxConfirmed' never
--   returns
awaitTxConfirmed :: forall w s e. (AsContractError e) => TxId -> Contract w s e ()
awaitTxConfirmed :: TxId -> Contract w s e ()
awaitTxConfirmed TxId
i = Contract w s e ()
go where
  go :: Contract w s e ()
go = do
    TxStatus
newStatus <- TxId -> Contract w s e TxStatus
forall w (s :: Row *) e.
AsContractError e =>
TxId -> Contract w s e TxStatus
awaitTxStatusChange TxId
i
    case TxStatus
newStatus of
      TxStatus
Unknown -> Contract w s e ()
go
      TxStatus
_       -> () -> Contract w s e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Wait until a transaction is confirmed (added to the ledger).
isTxConfirmed :: forall w s e. (AsContractError e) => TxId -> Promise w s e ()
isTxConfirmed :: TxId -> Promise w s e ()
isTxConfirmed = Contract w s e () -> Promise w s e ()
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e () -> Promise w s e ())
-> (TxId -> Contract w s e ()) -> TxId -> Promise w s e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> Contract w s e ()
forall w (s :: Row *) e.
AsContractError e =>
TxId -> Contract w s e ()
awaitTxConfirmed

-- | Wait for the status of a transaction output to change.
awaitTxOutStatusChange :: forall w s e. AsContractError e => TxOutRef -> Contract w s e TxOutStatus
awaitTxOutStatusChange :: TxOutRef -> Contract w s e TxOutStatus
awaitTxOutStatusChange TxOutRef
ref = (TxOutRef, TxOutStatus) -> TxOutStatus
forall a b. (a, b) -> b
snd ((TxOutRef, TxOutStatus) -> TxOutStatus)
-> Contract w s e (TxOutRef, TxOutStatus)
-> Contract w s e TxOutStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PABReq
-> Prism' PABResp (TxOutRef, TxOutStatus)
-> Contract w s e (TxOutRef, TxOutStatus)
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (TxOutRef -> PABReq
AwaitTxOutStatusChangeReq TxOutRef
ref) Prism' PABResp (TxOutRef, TxOutStatus)
E._AwaitTxOutStatusChangeResp

-- | Get the 'ContractInstanceId' of this instance.
ownInstanceId :: forall w s e. (AsContractError e) => Contract w s e ContractInstanceId
ownInstanceId :: Contract w s e ContractInstanceId
ownInstanceId = PABReq
-> Prism' PABResp ContractInstanceId
-> Contract w s e ContractInstanceId
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq PABReq
OwnContractInstanceIdReq Prism' PABResp ContractInstanceId
E._OwnContractInstanceIdResp

type HasEndpoint l a s =
  ( HasType l (EndpointValue a) (Input s)
  , HasType l ActiveEndpoint (Output s)
  , KnownSymbol l
  , ContractRow s
  )

type Endpoint l a = l .== (EndpointValue a, ActiveEndpoint)

endpointReq :: forall l a s.
    ( HasEndpoint l a s )
    => ActiveEndpoint
endpointReq :: ActiveEndpoint
endpointReq =
    ActiveEndpoint :: EndpointDescription -> Maybe Value -> ActiveEndpoint
ActiveEndpoint
        { aeDescription :: EndpointDescription
aeDescription = String -> EndpointDescription
EndpointDescription (String -> EndpointDescription) -> String -> EndpointDescription
forall a b. (a -> b) -> a -> b
$ Proxy l -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy l
forall k (t :: k). Proxy t
Proxy @l)
        , aeMetadata :: Maybe Value
aeMetadata    = Maybe Value
forall a. Maybe a
Nothing
        }

endpointDesc :: forall (l :: Symbol). KnownSymbol l => EndpointDescription
endpointDesc :: EndpointDescription
endpointDesc = String -> EndpointDescription
EndpointDescription (String -> EndpointDescription) -> String -> EndpointDescription
forall a b. (a -> b) -> a -> b
$ Proxy l -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy l
forall k (t :: k). Proxy t
Proxy @l)

endpointResp :: forall l a s. (HasEndpoint l a s, ToJSON a) => a -> PABResp
endpointResp :: a -> PABResp
endpointResp = EndpointDescription -> EndpointValue Value -> PABResp
ExposeEndpointResp (KnownSymbol l => EndpointDescription
forall (l :: Symbol). KnownSymbol l => EndpointDescription
endpointDesc @l) (EndpointValue Value -> PABResp)
-> (a -> EndpointValue Value) -> a -> PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> EndpointValue Value
forall a. a -> EndpointValue a
EndpointValue (Value -> EndpointValue Value)
-> (a -> Value) -> a -> EndpointValue Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON

-- | Expose an endpoint, return the data that was entered
endpoint
  :: forall l a w s e b.
     ( HasEndpoint l a s
     , AsContractError e
     , FromJSON a
     )
  => (a -> Contract w s e b) -> Promise w s e b
endpoint :: (a -> Contract w s e b) -> Promise w s e b
endpoint a -> Contract w s e b
f = Contract w s e b -> Promise w s e b
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e b -> Promise w s e b)
-> Contract w s e b -> Promise w s e b
forall a b. (a -> b) -> a -> b
$ do
    (EndpointDescription
ed, EndpointValue Value
ev) <- PABReq
-> Prism' PABResp (EndpointDescription, EndpointValue Value)
-> Contract w s e (EndpointDescription, EndpointValue Value)
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ActiveEndpoint -> PABReq
ExposeEndpointReq (ActiveEndpoint -> PABReq) -> ActiveEndpoint -> PABReq
forall a b. (a -> b) -> a -> b
$ HasEndpoint l a s => ActiveEndpoint
forall (l :: Symbol) a (s :: Row *).
HasEndpoint l a s =>
ActiveEndpoint
endpointReq @l @a @s) Prism' PABResp (EndpointDescription, EndpointValue Value)
E._ExposeEndpointResp
    a
a <- EndpointDescription -> EndpointValue Value -> Contract w s e a
forall a w (s :: Row *) e.
(FromJSON a, AsContractError e) =>
EndpointDescription -> EndpointValue Value -> Contract w s e a
decode EndpointDescription
ed EndpointValue Value
ev
    a -> Contract w s e b
f a
a

decode
    :: forall a w s e.
       ( FromJSON a
       , AsContractError e
       )
    => EndpointDescription
    -> EndpointValue JSON.Value
    -> Contract w s e a
decode :: EndpointDescription -> EndpointValue Value -> Contract w s e a
decode EndpointDescription
ed ev :: EndpointValue Value
ev@EndpointValue{Value
unEndpointValue :: Value
unEndpointValue :: forall a. EndpointValue a -> a
unEndpointValue} =
    (String -> Contract w s e a)
-> (a -> Contract w s e a) -> Either String a -> Contract w s e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (\String
e -> e -> Contract w s e a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e a) -> e -> Contract w s e a
forall a b. (a -> b) -> a -> b
$ AReview e (EndpointDescription, EndpointValue Value, Text)
-> (EndpointDescription, EndpointValue Value, Text) -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e (EndpointDescription, EndpointValue Value, Text)
forall r.
AsContractError r =>
Prism' r (EndpointDescription, EndpointValue Value, Text)
_EndpointDecodeContractError (EndpointDescription
ed, EndpointValue Value
ev, String -> Text
Text.pack String
e))
        a -> Contract w s e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either String a -> Contract w s e a)
-> Either String a -> Contract w s e a
forall a b. (a -> b) -> a -> b
$ (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON Value
unEndpointValue

handleEndpoint
  :: forall l a w s e1 e2 b.
     ( HasEndpoint l a s
     , AsContractError e1
     , FromJSON a
     )
  => (Either e1 a -> Contract w s e2 b) -> Promise w s e2 b
handleEndpoint :: (Either e1 a -> Contract w s e2 b) -> Promise w s e2 b
handleEndpoint Either e1 a -> Contract w s e2 b
f = Contract w s e2 b -> Promise w s e2 b
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e2 b -> Promise w s e2 b)
-> Contract w s e2 b -> Promise w s e2 b
forall a b. (a -> b) -> a -> b
$ do
  Either e1 a
a <- Contract w s e1 a -> Contract w s e2 (Either e1 a)
forall w (s :: Row *) e e0 a.
Contract w s e a -> Contract w s e0 (Either e a)
runError (Contract w s e1 a -> Contract w s e2 (Either e1 a))
-> Contract w s e1 a -> Contract w s e2 (Either e1 a)
forall a b. (a -> b) -> a -> b
$ do
      (EndpointDescription
ed, EndpointValue Value
ev) <- PABReq
-> Prism' PABResp (EndpointDescription, EndpointValue Value)
-> Contract w s e1 (EndpointDescription, EndpointValue Value)
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ActiveEndpoint -> PABReq
ExposeEndpointReq (ActiveEndpoint -> PABReq) -> ActiveEndpoint -> PABReq
forall a b. (a -> b) -> a -> b
$ HasEndpoint l a s => ActiveEndpoint
forall (l :: Symbol) a (s :: Row *).
HasEndpoint l a s =>
ActiveEndpoint
endpointReq @l @a @s) Prism' PABResp (EndpointDescription, EndpointValue Value)
E._ExposeEndpointResp
      EndpointDescription -> EndpointValue Value -> Contract w s e1 a
forall a w (s :: Row *) e.
(FromJSON a, AsContractError e) =>
EndpointDescription -> EndpointValue Value -> Contract w s e a
decode EndpointDescription
ed EndpointValue Value
ev
  Either e1 a -> Contract w s e2 b
f Either e1 a
a

-- | Expose an endpoint with some metadata. Return the data that was entered.
endpointWithMeta
  :: forall l a w s e meta b.
     ( HasEndpoint l a s
     , AsContractError e
     , ToJSON meta
     , FromJSON a
     )
  => meta
  -> (a -> Contract w s e b)
  -> Promise w s e b
endpointWithMeta :: meta -> (a -> Contract w s e b) -> Promise w s e b
endpointWithMeta meta
meta a -> Contract w s e b
f = Contract w s e b -> Promise w s e b
forall w (s :: Row *) e a. Contract w s e a -> Promise w s e a
Promise (Contract w s e b -> Promise w s e b)
-> Contract w s e b -> Promise w s e b
forall a b. (a -> b) -> a -> b
$ do
    (EndpointDescription
ed, EndpointValue Value
ev) <- PABReq
-> Prism' PABResp (EndpointDescription, EndpointValue Value)
-> Contract w s e (EndpointDescription, EndpointValue Value)
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (ActiveEndpoint -> PABReq
ExposeEndpointReq ActiveEndpoint
s) Prism' PABResp (EndpointDescription, EndpointValue Value)
E._ExposeEndpointResp
    a
a <- EndpointDescription -> EndpointValue Value -> Contract w s e a
forall a w (s :: Row *) e.
(FromJSON a, AsContractError e) =>
EndpointDescription -> EndpointValue Value -> Contract w s e a
decode EndpointDescription
ed EndpointValue Value
ev
    a -> Contract w s e b
f a
a
    where
        s :: ActiveEndpoint
s = ActiveEndpoint :: EndpointDescription -> Maybe Value -> ActiveEndpoint
ActiveEndpoint
                { aeDescription :: EndpointDescription
aeDescription = KnownSymbol l => EndpointDescription
forall (l :: Symbol). KnownSymbol l => EndpointDescription
endpointDesc @l
                , aeMetadata :: Maybe Value
aeMetadata    = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ meta -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON meta
meta
                }

endpointDescription :: forall l. KnownSymbol l => Proxy l -> EndpointDescription
endpointDescription :: Proxy l -> EndpointDescription
endpointDescription = String -> EndpointDescription
EndpointDescription (String -> EndpointDescription)
-> (Proxy l -> String) -> Proxy l -> EndpointDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy l -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal

-- | Get the hash of a public key belonging to the wallet that runs this contract.
--   * Any funds paid to this public key hash will be treated as the wallet's own
--     funds
--   * The wallet is able to sign transactions with the private key of this
--     public key, for example, if the public key is added to the
--     'requiredSignatures' field of 'Tx'.
--   * There is a 1-n relationship between wallets and public keys (although in
--     the mockchain n=1)
ownPaymentPubKeyHash :: forall w s e. (AsContractError e) => Contract w s e PaymentPubKeyHash
ownPaymentPubKeyHash :: Contract w s e PaymentPubKeyHash
ownPaymentPubKeyHash = PABReq
-> Prism' PABResp PaymentPubKeyHash
-> Contract w s e PaymentPubKeyHash
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq PABReq
OwnPaymentPublicKeyHashReq Prism' PABResp PaymentPubKeyHash
E._OwnPaymentPublicKeyHashResp

-- | Send an unbalanced transaction to be balanced and signed. Returns the ID
--    of the final transaction when the transaction was submitted. Throws an
--    error if balancing or signing failed.
submitUnbalancedTx :: forall w s e. (AsContractError e) => UnbalancedTx -> Contract w s e CardanoTx
-- See Note [Injecting errors into the user's error type]
submitUnbalancedTx :: UnbalancedTx -> Contract w s e CardanoTx
submitUnbalancedTx UnbalancedTx
utx = do
  CardanoTx
tx <- UnbalancedTx -> Contract w s e CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
balanceTx UnbalancedTx
utx
  CardanoTx -> Contract w s e CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
CardanoTx -> Contract w s e CardanoTx
submitBalancedTx CardanoTx
tx

-- | Send an unbalanced transaction to be balanced. Returns the balanced transaction.
--    Throws an error if balancing failed.
balanceTx :: forall w s e. (AsContractError e) => UnbalancedTx -> Contract w s e CardanoTx
-- See Note [Injecting errors into the user's error type]
balanceTx :: UnbalancedTx -> Contract w s e CardanoTx
balanceTx UnbalancedTx
t =
  let req :: Contract w s e BalanceTxResponse
req = PABReq
-> Prism' PABResp BalanceTxResponse
-> Contract w s e BalanceTxResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (UnbalancedTx -> PABReq
BalanceTxReq UnbalancedTx
t) Prism' PABResp BalanceTxResponse
E._BalanceTxResp in
  Contract w s e BalanceTxResponse
req Contract w s e BalanceTxResponse
-> (BalanceTxResponse -> Contract w s e CardanoTx)
-> Contract w s e CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WalletAPIError -> Contract w s e CardanoTx)
-> (CardanoTx -> Contract w s e CardanoTx)
-> Either WalletAPIError CardanoTx
-> Contract w s e CardanoTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Contract w s e CardanoTx
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e CardanoTx)
-> (WalletAPIError -> e)
-> WalletAPIError
-> Contract w s e CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview e WalletAPIError -> WalletAPIError -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e WalletAPIError
forall r. AsContractError r => Prism' r WalletAPIError
_WalletContractError) CardanoTx -> Contract w s e CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either WalletAPIError CardanoTx -> Contract w s e CardanoTx)
-> (BalanceTxResponse -> Either WalletAPIError CardanoTx)
-> BalanceTxResponse
-> Contract w s e CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Either WalletAPIError CardanoTx)
  BalanceTxResponse
  (Either WalletAPIError CardanoTx)
-> BalanceTxResponse -> Either WalletAPIError CardanoTx
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Either WalletAPIError CardanoTx)
  BalanceTxResponse
  (Either WalletAPIError CardanoTx)
Iso' BalanceTxResponse (Either WalletAPIError CardanoTx)
E.balanceTxResponse

-- | Send an balanced transaction to be signed. Returns the ID
--    of the final transaction when the transaction was submitted. Throws an
--    error if signing failed.
submitBalancedTx :: forall w s e. (AsContractError e) => CardanoTx -> Contract w s e CardanoTx
-- See Note [Injecting errors into the user's error type]
submitBalancedTx :: CardanoTx -> Contract w s e CardanoTx
submitBalancedTx CardanoTx
t =
  let req :: Contract w s e WriteBalancedTxResponse
req = PABReq
-> Prism' PABResp WriteBalancedTxResponse
-> Contract w s e WriteBalancedTxResponse
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (CardanoTx -> PABReq
WriteBalancedTxReq CardanoTx
t) Prism' PABResp WriteBalancedTxResponse
E._WriteBalancedTxResp in
  Contract w s e WriteBalancedTxResponse
req Contract w s e WriteBalancedTxResponse
-> (WriteBalancedTxResponse -> Contract w s e CardanoTx)
-> Contract w s e CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WalletAPIError -> Contract w s e CardanoTx)
-> (CardanoTx -> Contract w s e CardanoTx)
-> Either WalletAPIError CardanoTx
-> Contract w s e CardanoTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Contract w s e CardanoTx
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> Contract w s e CardanoTx)
-> (WalletAPIError -> e)
-> WalletAPIError
-> Contract w s e CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview e WalletAPIError -> WalletAPIError -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e WalletAPIError
forall r. AsContractError r => Prism' r WalletAPIError
_WalletContractError) CardanoTx -> Contract w s e CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either WalletAPIError CardanoTx -> Contract w s e CardanoTx)
-> (WriteBalancedTxResponse -> Either WalletAPIError CardanoTx)
-> WriteBalancedTxResponse
-> Contract w s e CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Either WalletAPIError CardanoTx)
  WriteBalancedTxResponse
  (Either WalletAPIError CardanoTx)
-> WriteBalancedTxResponse -> Either WalletAPIError CardanoTx
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Either WalletAPIError CardanoTx)
  WriteBalancedTxResponse
  (Either WalletAPIError CardanoTx)
Iso' WriteBalancedTxResponse (Either WalletAPIError CardanoTx)
E.writeBalancedTxResponse

-- | Build a transaction that satisfies the constraints, then submit it to the
--   network. The constraints do not refer to any typed script inputs or
--   outputs.
submitTx :: forall w s e.
  ( AsContractError e
  )
  => TxConstraints Void Void
  -> Contract w s e CardanoTx
submitTx :: TxConstraints Void Void -> Contract w s e CardanoTx
submitTx = ScriptLookups Void
-> TxConstraints (RedeemerType Void) (DatumType Void)
-> Contract w s e CardanoTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraintsWith @Void ScriptLookups Void
forall a. Monoid a => a
mempty

-- | Build a transaction that satisfies the constraints, then submit it to the
--   network. Using the current outputs at the contract address and the
--   contract's own public key to solve the constraints.
submitTxConstraints
  :: forall a w s e.
  ( PlutusTx.ToData (RedeemerType a)
  , PlutusTx.FromData (DatumType a)
  , PlutusTx.ToData (DatumType a)
  , AsContractError e
  )
  => TypedValidator a
  -> TxConstraints (RedeemerType a) (DatumType a)
  -> Contract w s e CardanoTx
submitTxConstraints :: TypedValidator a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraints TypedValidator a
inst = ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraintsWith (TypedValidator a -> ScriptLookups a
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator a
inst)

-- | Build a transaction that satisfies the constraints using the UTXO map
--   to resolve any input constraints (see 'Ledger.Constraints.TxConstraints.InputConstraint')
submitTxConstraintsSpending
  :: forall a w s e.
  ( PlutusTx.ToData (RedeemerType a)
  , PlutusTx.FromData (DatumType a)
  , PlutusTx.ToData (DatumType a)
  , AsContractError e
  )
  => TypedValidator a
  -> Map TxOutRef ChainIndexTxOut
  -> TxConstraints (RedeemerType a) (DatumType a)
  -> Contract w s e CardanoTx
submitTxConstraintsSpending :: TypedValidator a
-> Map TxOutRef ChainIndexTxOut
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraintsSpending TypedValidator a
inst Map TxOutRef ChainIndexTxOut
utxo =
  let lookups :: ScriptLookups a
lookups = TypedValidator a -> ScriptLookups a
forall a. TypedValidator a -> ScriptLookups a
Constraints.typedValidatorLookups TypedValidator a
inst ScriptLookups a -> ScriptLookups a -> ScriptLookups a
forall a. Semigroup a => a -> a -> a
<> Map TxOutRef ChainIndexTxOut -> ScriptLookups a
forall a. Map TxOutRef ChainIndexTxOut -> ScriptLookups a
Constraints.unspentOutputs Map TxOutRef ChainIndexTxOut
utxo
  in ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraintsWith ScriptLookups a
lookups

{-| A variant of 'mkTx' that runs in the 'Contract' monad, throwing errors and
logging its inputs and outputs.
-}
mkTxContract ::
    forall w s a.
    ( PlutusTx.FromData (DatumType a)
    , PlutusTx.ToData (DatumType a)
    , PlutusTx.ToData (RedeemerType a)
    )
    => ScriptLookups a
    -> TxConstraints (RedeemerType a) (DatumType a)
    -> Contract w s Constraints.MkTxError UnbalancedTx
mkTxContract :: ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s MkTxError UnbalancedTx
mkTxContract ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
txc = do
    let result :: Either MkTxError UnbalancedTx
result = ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Either MkTxError UnbalancedTx
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Either MkTxError UnbalancedTx
Constraints.mkTx ScriptLookups a
lookups TxConstraints (RedeemerType a) (DatumType a)
txc
        logData :: MkTxLog
logData = MkTxLog :: ScriptLookups Any
-> TxConstraints BuiltinData BuiltinData
-> Either MkTxError UnbalancedTx
-> MkTxLog
MkTxLog{mkTxLogLookups :: ScriptLookups Any
mkTxLogLookups=ScriptLookups a -> ScriptLookups Any
forall a. ScriptLookups a -> ScriptLookups Any
Constraints.generalise ScriptLookups a
lookups, mkTxLogTxConstraints :: TxConstraints BuiltinData BuiltinData
mkTxLogTxConstraints=(RedeemerType a -> BuiltinData)
-> (DatumType a -> BuiltinData)
-> TxConstraints (RedeemerType a) (DatumType a)
-> TxConstraints BuiltinData BuiltinData
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap RedeemerType a -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData DatumType a -> BuiltinData
forall a. ToData a => a -> BuiltinData
PlutusTx.toBuiltinData TxConstraints (RedeemerType a) (DatumType a)
txc, mkTxLogResult :: Either MkTxError UnbalancedTx
mkTxLogResult = Either MkTxError UnbalancedTx
result}
    MkTxLog -> Contract w s MkTxError ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logDebug MkTxLog
logData
    case Either MkTxError UnbalancedTx
result of
        Left MkTxError
err -> MkTxError -> Contract w s MkTxError UnbalancedTx
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MkTxError
err
        Right UnbalancedTx
r' -> UnbalancedTx -> Contract w s MkTxError UnbalancedTx
forall (m :: * -> *) a. Monad m => a -> m a
return UnbalancedTx
r'

{-| Arguments and result of a call to 'mkTx'
-}
data MkTxLog =
    MkTxLog
        { MkTxLog -> ScriptLookups Any
mkTxLogLookups       :: ScriptLookups Any
        , MkTxLog -> TxConstraints BuiltinData BuiltinData
mkTxLogTxConstraints :: TxConstraints PlutusTx.BuiltinData PlutusTx.BuiltinData
        , MkTxLog -> Either MkTxError UnbalancedTx
mkTxLogResult        :: Either Constraints.MkTxError UnbalancedTx
        }
        deriving stock (Int -> MkTxLog -> ShowS
[MkTxLog] -> ShowS
MkTxLog -> String
(Int -> MkTxLog -> ShowS)
-> (MkTxLog -> String) -> ([MkTxLog] -> ShowS) -> Show MkTxLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MkTxLog] -> ShowS
$cshowList :: [MkTxLog] -> ShowS
show :: MkTxLog -> String
$cshow :: MkTxLog -> String
showsPrec :: Int -> MkTxLog -> ShowS
$cshowsPrec :: Int -> MkTxLog -> ShowS
Show, (forall x. MkTxLog -> Rep MkTxLog x)
-> (forall x. Rep MkTxLog x -> MkTxLog) -> Generic MkTxLog
forall x. Rep MkTxLog x -> MkTxLog
forall x. MkTxLog -> Rep MkTxLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MkTxLog x -> MkTxLog
$cfrom :: forall x. MkTxLog -> Rep MkTxLog x
Generic)
        deriving anyclass ([MkTxLog] -> Encoding
[MkTxLog] -> Value
MkTxLog -> Encoding
MkTxLog -> Value
(MkTxLog -> Value)
-> (MkTxLog -> Encoding)
-> ([MkTxLog] -> Value)
-> ([MkTxLog] -> Encoding)
-> ToJSON MkTxLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MkTxLog] -> Encoding
$ctoEncodingList :: [MkTxLog] -> Encoding
toJSONList :: [MkTxLog] -> Value
$ctoJSONList :: [MkTxLog] -> Value
toEncoding :: MkTxLog -> Encoding
$ctoEncoding :: MkTxLog -> Encoding
toJSON :: MkTxLog -> Value
$ctoJSON :: MkTxLog -> Value
ToJSON, Value -> Parser [MkTxLog]
Value -> Parser MkTxLog
(Value -> Parser MkTxLog)
-> (Value -> Parser [MkTxLog]) -> FromJSON MkTxLog
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MkTxLog]
$cparseJSONList :: Value -> Parser [MkTxLog]
parseJSON :: Value -> Parser MkTxLog
$cparseJSON :: Value -> Parser MkTxLog
FromJSON)

-- | Build a transaction that satisfies the constraints
mkTxConstraints :: forall a w s e.
  ( PlutusTx.ToData (RedeemerType a)
  , PlutusTx.FromData (DatumType a)
  , PlutusTx.ToData (DatumType a)
  , AsContractError e
  )
  => ScriptLookups a
  -> TxConstraints (RedeemerType a) (DatumType a)
  -> Contract w s e UnbalancedTx
mkTxConstraints :: ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints ScriptLookups a
sl TxConstraints (RedeemerType a) (DatumType a)
constraints =
  (MkTxError -> e)
-> Contract w s MkTxError UnbalancedTx
-> Contract w s e UnbalancedTx
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError (AReview e MkTxError -> MkTxError -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e MkTxError
forall r. AsContractError r => Prism' r MkTxError
_ConstraintResolutionContractError) (ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s MkTxError UnbalancedTx
forall w (s :: Row *) a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s MkTxError UnbalancedTx
mkTxContract ScriptLookups a
sl TxConstraints (RedeemerType a) (DatumType a)
constraints)

-- | Build a transaction that satisfies the constraints, then submit it to the
--   network. Using the given constraints.
submitTxConstraintsWith
  :: forall a w s e.
  ( PlutusTx.ToData (RedeemerType a)
  , PlutusTx.FromData (DatumType a)
  , PlutusTx.ToData (DatumType a)
  , AsContractError e
  )
  => ScriptLookups a
  -> TxConstraints (RedeemerType a) (DatumType a)
  -> Contract w s e CardanoTx
submitTxConstraintsWith :: ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraintsWith ScriptLookups a
sl TxConstraints (RedeemerType a) (DatumType a)
constraints = ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
mkTxConstraints ScriptLookups a
sl TxConstraints (RedeemerType a) (DatumType a)
constraints Contract w s e UnbalancedTx
-> (UnbalancedTx -> Contract w s e CardanoTx)
-> Contract w s e CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s e CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
submitUnbalancedTx

-- | A version of 'submitTx' that waits until the transaction has been
--   confirmed on the ledger before returning.
submitTxConfirmed :: forall w s e. (AsContractError e) => UnbalancedTx -> Contract w s e ()
submitTxConfirmed :: UnbalancedTx -> Contract w s e ()
submitTxConfirmed UnbalancedTx
t = UnbalancedTx -> Contract w s e CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
submitUnbalancedTx UnbalancedTx
t Contract w s e CardanoTx
-> (CardanoTx -> Contract w s e ()) -> Contract w s e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxId -> Contract w s e ()
forall w (s :: Row *) e.
AsContractError e =>
TxId -> Contract w s e ()
awaitTxConfirmed (TxId -> Contract w s e ())
-> (CardanoTx -> TxId) -> CardanoTx -> Contract w s e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> TxId
getCardanoTxId

-- | Take an 'UnbalancedTx' then balance, sign and submit it to the blockchain
-- without returning any results.
yieldUnbalancedTx
    :: forall w s e. (AsContractError e)
    => UnbalancedTx
    -> Contract w s e ()
yieldUnbalancedTx :: UnbalancedTx -> Contract w s e ()
yieldUnbalancedTx UnbalancedTx
utx = PABReq -> Prism' PABResp () -> Contract w s e ()
forall w (s :: Row *) e a.
AsContractError e =>
PABReq -> Prism' PABResp a -> Contract w s e a
pabReq (UnbalancedTx -> PABReq
YieldUnbalancedTxReq UnbalancedTx
utx) Prism' PABResp ()
E._YieldUnbalancedTxResp