{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
{-| Custom class to encapsulate the general purpose
queries that we need for building transactions
-}
module Convex.Query(
  MonadUtxoQuery(..),
  utxosByPayment,
  BalancingError(..),
  balanceTx,

  -- * Tx balancing for operator
  balanceAndSubmitOperator,
  balanceOperator,
  signTxOperator,
  signAndSubmitOperator,
  operatorUtxos,
  selectOperatorUTxO,
  BalanceAndSubmitError(..),

  -- * Wallet API queries
  WalletAPIQueryT(..),
  runWalletAPIQueryT
) where

import           Cardano.Api                        (BabbageEra, BalancedTxBody,
                                                     BuildTx, CtxTx,
                                                     PaymentCredential (..),
                                                     TxBodyContent, TxOut,
                                                     UTxO (..))
import qualified Cardano.Api                        as C
import           Control.Monad.Except               (MonadError)
import           Control.Monad.IO.Class             (MonadIO (..))
import           Control.Monad.Reader               (ReaderT, ask, runReaderT)
import           Control.Monad.Trans.Class          (MonadTrans (..))
import           Control.Monad.Trans.Except         (ExceptT, runExceptT)
import           Control.Monad.Trans.Except.Result  (ResultT)
import qualified Control.Monad.Trans.State          as StrictState
import qualified Control.Monad.Trans.State.Strict   as LazyState
import           Convex.Class                       (MonadBlockchain (..),
                                                     MonadBlockchainCardanoNodeT)
import qualified Convex.CoinSelection
import           Convex.MockChain                   (MockchainT, utxoSet)
import           Convex.MonadLog                    (MonadLog, MonadLogIgnoreT)
import           Convex.NodeClient.WaitForTxnClient (MonadBlockchainWaitingT (..))
import           Convex.Utils                       (liftEither, liftResult)
import           Convex.Utxos                       (BalanceChanges,
                                                     fromApiUtxo, fromUtxoTx,
                                                     onlyCredentials, toApiUtxo)
import qualified Convex.Wallet.API                  as Wallet.API
import           Convex.Wallet.Operator             (Operator (..), Signing,
                                                     operatorPaymentCredential,
                                                     returnOutputFor,
                                                     signTxOperator)
import           Data.Functor                       (($>))
import qualified Data.Map                           as Map
import           Data.Maybe                         (listToMaybe)
import           Data.Set                           (Set)
import qualified Data.Set                           as Set
import           Servant.Client                     (ClientEnv)

class Monad m => MonadUtxoQuery m where
  utxosByPaymentCredentials :: Set PaymentCredential -> m (UTxO BabbageEra)

utxosByPayment :: MonadUtxoQuery m => PaymentCredential -> m (UTxO BabbageEra)
utxosByPayment :: forall (m :: * -> *).
MonadUtxoQuery m =>
PaymentCredential -> m (UTxO BabbageEra)
utxosByPayment = forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
Set.singleton

instance Monad m => MonadUtxoQuery (MockchainT m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> MockchainT m (UTxO BabbageEra)
utxosByPaymentCredentials Set PaymentCredential
cred = UtxoSet CtxUTxO () -> UTxO BabbageEra
toApiUtxo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ctx a.
Set PaymentCredential -> UtxoSet ctx a -> UtxoSet ctx a
onlyCredentials Set PaymentCredential
cred forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadMockchain m => m (UtxoSet CtxUTxO ())
utxoSet

instance MonadUtxoQuery m => MonadUtxoQuery (ResultT m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> ResultT m (UTxO BabbageEra)
utxosByPaymentCredentials = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials

instance MonadUtxoQuery m => MonadUtxoQuery (ExceptT e m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> ExceptT e m (UTxO BabbageEra)
utxosByPaymentCredentials = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials

instance MonadUtxoQuery m => MonadUtxoQuery (ReaderT e m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> ReaderT e m (UTxO BabbageEra)
utxosByPaymentCredentials = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials

instance MonadUtxoQuery m => MonadUtxoQuery (StrictState.StateT s m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> StateT s m (UTxO BabbageEra)
utxosByPaymentCredentials = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials

instance MonadUtxoQuery m => MonadUtxoQuery (LazyState.StateT s m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> StateT s m (UTxO BabbageEra)
utxosByPaymentCredentials = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials

instance MonadUtxoQuery m => MonadUtxoQuery (MonadBlockchainCardanoNodeT e m) where
  utxosByPaymentCredentials :: Set PaymentCredential
-> MonadBlockchainCardanoNodeT e m (UTxO BabbageEra)
utxosByPaymentCredentials = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials

instance MonadUtxoQuery m => MonadUtxoQuery (MonadLogIgnoreT m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> MonadLogIgnoreT m (UTxO BabbageEra)
utxosByPaymentCredentials = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadUtxoQuery m =>
Set PaymentCredential -> m (UTxO BabbageEra)
utxosByPaymentCredentials

deriving newtype instance MonadUtxoQuery m => MonadUtxoQuery (MonadBlockchainWaitingT m)

newtype BalancingError = BalancingError String
  deriving stock (BalancingError -> BalancingError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BalancingError -> BalancingError -> Bool
$c/= :: BalancingError -> BalancingError -> Bool
== :: BalancingError -> BalancingError -> Bool
$c== :: BalancingError -> BalancingError -> Bool
Eq, Eq BalancingError
BalancingError -> BalancingError -> Bool
BalancingError -> BalancingError -> Ordering
BalancingError -> BalancingError -> BalancingError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BalancingError -> BalancingError -> BalancingError
$cmin :: BalancingError -> BalancingError -> BalancingError
max :: BalancingError -> BalancingError -> BalancingError
$cmax :: BalancingError -> BalancingError -> BalancingError
>= :: BalancingError -> BalancingError -> Bool
$c>= :: BalancingError -> BalancingError -> Bool
> :: BalancingError -> BalancingError -> Bool
$c> :: BalancingError -> BalancingError -> Bool
<= :: BalancingError -> BalancingError -> Bool
$c<= :: BalancingError -> BalancingError -> Bool
< :: BalancingError -> BalancingError -> Bool
$c< :: BalancingError -> BalancingError -> Bool
compare :: BalancingError -> BalancingError -> Ordering
$ccompare :: BalancingError -> BalancingError -> Ordering
Ord, Int -> BalancingError -> ShowS
[BalancingError] -> ShowS
BalancingError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalancingError] -> ShowS
$cshowList :: [BalancingError] -> ShowS
show :: BalancingError -> String
$cshow :: BalancingError -> String
showsPrec :: Int -> BalancingError -> ShowS
$cshowsPrec :: Int -> BalancingError -> ShowS
Show)

{-| Balance the transaction body using the UTxOs locked by the payment credential,
and returning any unused funds to the given payment credential and stake credential
|-}
balanceTx :: (MonadBlockchain m, MonadUtxoQuery m) => PaymentCredential -> TxOut CtxTx BabbageEra -> TxBodyContent BuildTx BabbageEra -> m (Either BalancingError (BalancedTxBody BabbageEra, BalanceChanges))
balanceTx :: forall (m :: * -> *).
(MonadBlockchain m, MonadUtxoQuery m) =>
PaymentCredential
-> TxOut CtxTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
-> m (Either
        BalancingError (BalancedTxBody BabbageEra, BalanceChanges))
balanceTx PaymentCredential
operator TxOut CtxTx BabbageEra
changeOutput TxBodyContent BuildTx BabbageEra
txBody = do
  UtxoSet CtxUTxO ()
o <- UTxO BabbageEra -> UtxoSet CtxUTxO ()
fromApiUtxo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadUtxoQuery m =>
PaymentCredential -> m (UTxO BabbageEra)
utxosByPayment PaymentCredential
operator
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
(String -> e) -> ResultT m a -> m a
liftResult String -> BalancingError
BalancingError (forall (m :: * -> *) a.
(MonadBlockchain m, MonadFail m) =>
TxOut CtxTx BabbageEra
-> UtxoSet CtxUTxO a
-> TxBodyContent BuildTx BabbageEra
-> m (BalancedTxBody BabbageEra, BalanceChanges)
Convex.CoinSelection.balanceTx TxOut CtxTx BabbageEra
changeOutput UtxoSet CtxUTxO ()
o TxBodyContent BuildTx BabbageEra
txBody)

newtype WalletAPIQueryT m a = WalletAPIQueryT{ forall (m :: * -> *) a.
WalletAPIQueryT m a -> ReaderT ClientEnv m a
runWalletAPIQueryT_ :: ReaderT ClientEnv m a }
  deriving newtype (forall a b. a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
forall a b. (a -> b) -> WalletAPIQueryT m a -> WalletAPIQueryT m b
forall (m :: * -> *) a b.
Functor m =>
a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WalletAPIQueryT m a -> WalletAPIQueryT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
fmap :: forall a b. (a -> b) -> WalletAPIQueryT m a -> WalletAPIQueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WalletAPIQueryT m a -> WalletAPIQueryT m b
Functor, forall a. a -> WalletAPIQueryT m a
forall a b.
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
forall a b.
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
forall a b.
WalletAPIQueryT m (a -> b)
-> WalletAPIQueryT m a -> WalletAPIQueryT m b
forall a b c.
(a -> b -> c)
-> WalletAPIQueryT m a
-> WalletAPIQueryT m b
-> WalletAPIQueryT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (WalletAPIQueryT m)
forall (m :: * -> *) a. Applicative m => a -> WalletAPIQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
forall (m :: * -> *) a b.
Applicative m =>
WalletAPIQueryT m (a -> b)
-> WalletAPIQueryT m a -> WalletAPIQueryT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WalletAPIQueryT m a
-> WalletAPIQueryT m b
-> WalletAPIQueryT m c
<* :: forall a b.
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m a
*> :: forall a b.
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> WalletAPIQueryT m a
-> WalletAPIQueryT m b
-> WalletAPIQueryT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WalletAPIQueryT m a
-> WalletAPIQueryT m b
-> WalletAPIQueryT m c
<*> :: forall a b.
WalletAPIQueryT m (a -> b)
-> WalletAPIQueryT m a -> WalletAPIQueryT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WalletAPIQueryT m (a -> b)
-> WalletAPIQueryT m a -> WalletAPIQueryT m b
pure :: forall a. a -> WalletAPIQueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> WalletAPIQueryT m a
Applicative, forall a. a -> WalletAPIQueryT m a
forall a b.
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
forall a b.
WalletAPIQueryT m a
-> (a -> WalletAPIQueryT m b) -> WalletAPIQueryT m b
forall {m :: * -> *}. Monad m => Applicative (WalletAPIQueryT m)
forall (m :: * -> *) a. Monad m => a -> WalletAPIQueryT m a
forall (m :: * -> *) a b.
Monad m =>
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
forall (m :: * -> *) a b.
Monad m =>
WalletAPIQueryT m a
-> (a -> WalletAPIQueryT m b) -> WalletAPIQueryT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> WalletAPIQueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WalletAPIQueryT m a
>> :: forall a b.
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WalletAPIQueryT m a -> WalletAPIQueryT m b -> WalletAPIQueryT m b
>>= :: forall a b.
WalletAPIQueryT m a
-> (a -> WalletAPIQueryT m b) -> WalletAPIQueryT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WalletAPIQueryT m a
-> (a -> WalletAPIQueryT m b) -> WalletAPIQueryT m b
Monad, forall a. IO a -> WalletAPIQueryT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (WalletAPIQueryT m)
forall (m :: * -> *) a. MonadIO m => IO a -> WalletAPIQueryT m a
liftIO :: forall a. IO a -> WalletAPIQueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> WalletAPIQueryT m a
MonadIO, WalletAPIQueryT m (SlotNo, SlotLength, UTCTime)
WalletAPIQueryT m (Set PoolId)
WalletAPIQueryT m SystemStart
WalletAPIQueryT m NetworkId
WalletAPIQueryT m (BundledProtocolParameters BabbageEra)
WalletAPIQueryT m (EraHistory CardanoMode)
Set TxIn -> WalletAPIQueryT m (UTxO BabbageEra)
Tx BabbageEra -> WalletAPIQueryT m TxId
forall (m :: * -> *).
Monad m
-> (Tx BabbageEra -> m TxId)
-> (Set TxIn -> m (UTxO BabbageEra))
-> m (BundledProtocolParameters BabbageEra)
-> m (Set PoolId)
-> m SystemStart
-> m (EraHistory CardanoMode)
-> m (SlotNo, SlotLength, UTCTime)
-> m NetworkId
-> MonadBlockchain m
forall {m :: * -> *}.
MonadBlockchain m =>
Monad (WalletAPIQueryT m)
forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (SlotNo, SlotLength, UTCTime)
forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (Set PoolId)
forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m SystemStart
forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m NetworkId
forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (BundledProtocolParameters BabbageEra)
forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (EraHistory CardanoMode)
forall (m :: * -> *).
MonadBlockchain m =>
Set TxIn -> WalletAPIQueryT m (UTxO BabbageEra)
forall (m :: * -> *).
MonadBlockchain m =>
Tx BabbageEra -> WalletAPIQueryT m TxId
networkId :: WalletAPIQueryT m NetworkId
$cnetworkId :: forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m NetworkId
querySlotNo :: WalletAPIQueryT m (SlotNo, SlotLength, UTCTime)
$cquerySlotNo :: forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (SlotNo, SlotLength, UTCTime)
queryEraHistory :: WalletAPIQueryT m (EraHistory CardanoMode)
$cqueryEraHistory :: forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (EraHistory CardanoMode)
querySystemStart :: WalletAPIQueryT m SystemStart
$cquerySystemStart :: forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m SystemStart
queryStakePools :: WalletAPIQueryT m (Set PoolId)
$cqueryStakePools :: forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (Set PoolId)
queryProtocolParameters :: WalletAPIQueryT m (BundledProtocolParameters BabbageEra)
$cqueryProtocolParameters :: forall (m :: * -> *).
MonadBlockchain m =>
WalletAPIQueryT m (BundledProtocolParameters BabbageEra)
utxoByTxIn :: Set TxIn -> WalletAPIQueryT m (UTxO BabbageEra)
$cutxoByTxIn :: forall (m :: * -> *).
MonadBlockchain m =>
Set TxIn -> WalletAPIQueryT m (UTxO BabbageEra)
sendTx :: Tx BabbageEra -> WalletAPIQueryT m TxId
$csendTx :: forall (m :: * -> *).
MonadBlockchain m =>
Tx BabbageEra -> WalletAPIQueryT m TxId
MonadBlockchain, Doc Void -> WalletAPIQueryT m ()
forall (m :: * -> *).
Monad m
-> (Doc Void -> m ())
-> (Doc Void -> m ())
-> (Doc Void -> m ())
-> MonadLog m
forall {m :: * -> *}. MonadLog m => Monad (WalletAPIQueryT m)
forall (m :: * -> *).
MonadLog m =>
Doc Void -> WalletAPIQueryT m ()
logDebug' :: Doc Void -> WalletAPIQueryT m ()
$clogDebug' :: forall (m :: * -> *).
MonadLog m =>
Doc Void -> WalletAPIQueryT m ()
logWarn' :: Doc Void -> WalletAPIQueryT m ()
$clogWarn' :: forall (m :: * -> *).
MonadLog m =>
Doc Void -> WalletAPIQueryT m ()
logInfo' :: Doc Void -> WalletAPIQueryT m ()
$clogInfo' :: forall (m :: * -> *).
MonadLog m =>
Doc Void -> WalletAPIQueryT m ()
MonadLog)

runWalletAPIQueryT :: ClientEnv -> WalletAPIQueryT m a -> m a
runWalletAPIQueryT :: forall (m :: * -> *) a. ClientEnv -> WalletAPIQueryT m a -> m a
runWalletAPIQueryT ClientEnv
env (WalletAPIQueryT ReaderT ClientEnv m a
action) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ClientEnv m a
action ClientEnv
env

instance MonadIO m => MonadUtxoQuery (WalletAPIQueryT m) where
  utxosByPaymentCredentials :: Set PaymentCredential -> WalletAPIQueryT m (UTxO BabbageEra)
utxosByPaymentCredentials Set PaymentCredential
credentials = forall (m :: * -> *) a.
ReaderT ClientEnv m a -> WalletAPIQueryT m a
WalletAPIQueryT forall a b. (a -> b) -> a -> b
$ do
    Either ClientError (UtxoSet CtxTx ())
result <- forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientEnv -> IO (Either ClientError (UtxoSet CtxTx ()))
Wallet.API.getUTxOs
    case Either ClientError (UtxoSet CtxTx ())
result of
      Left ClientError
err -> do
        -- TODO: Better error handling
        let msg :: String
msg = String
"WalletAPI: Error when calling remote server: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClientError
err
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn String
msg)
        forall a. HasCallStack => String -> a
error String
msg
      Right UtxoSet CtxTx ()
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (UtxoSet CtxUTxO () -> UTxO BabbageEra
toApiUtxo forall a b. (a -> b) -> a -> b
$ forall ctx a.
Set PaymentCredential -> UtxoSet ctx a -> UtxoSet ctx a
onlyCredentials Set PaymentCredential
credentials forall a b. (a -> b) -> a -> b
$ forall a. UtxoSet CtxTx a -> UtxoSet CtxUTxO a
fromUtxoTx UtxoSet CtxTx ()
x)

deriving newtype instance MonadError e m => MonadError e (WalletAPIQueryT m)

{-| Balance a transaction body using the funds locked by the payment credential
-}
balanceOperator :: (MonadBlockchain m, MonadUtxoQuery m, MonadError BalanceAndSubmitError m) => C.PaymentCredential -> Maybe (C.TxOut C.CtxTx C.BabbageEra) -> C.TxBodyContent C.BuildTx C.BabbageEra -> m (C.Tx C.BabbageEra)
balanceOperator :: forall (m :: * -> *).
(MonadBlockchain m, MonadUtxoQuery m,
 MonadError BalanceAndSubmitError m) =>
PaymentCredential
-> Maybe (TxOut CtxTx BabbageEra)
-> TxBodyContent BuildTx BabbageEra
-> m (Tx BabbageEra)
balanceOperator PaymentCredential
cred Maybe (TxOut CtxTx BabbageEra)
returnOutput TxBodyContent BuildTx BabbageEra
txBody = do
  TxOut CtxTx BabbageEra
output <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *).
MonadBlockchain m =>
PaymentCredential -> m (TxOut CtxTx BabbageEra)
returnOutputFor PaymentCredential
cred) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TxOut CtxTx BabbageEra)
returnOutput
  (C.BalancedTxBody TxBodyContent BuildTx BabbageEra
_ TxBody BabbageEra
txbody TxOut CtxTx BabbageEra
_changeOutput Lovelace
_fee, BalanceChanges
_) <- forall e (m :: * -> *) ee a.
MonadError e m =>
(ee -> e) -> m (Either ee a) -> m a
liftEither BalancingError -> BalanceAndSubmitError
BalanceError (forall (m :: * -> *).
(MonadBlockchain m, MonadUtxoQuery m) =>
PaymentCredential
-> TxOut CtxTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
-> m (Either
        BalancingError (BalancedTxBody BabbageEra, BalanceChanges))
balanceTx PaymentCredential
cred TxOut CtxTx BabbageEra
output TxBodyContent BuildTx BabbageEra
txBody)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. [KeyWitness era] -> TxBody era -> Tx era
C.makeSignedTransaction [] TxBody BabbageEra
txbody)

-- | Balance a transaction body, sign it with the operator's key, and submit it to the network.
balanceAndSubmitOperator :: (MonadBlockchain m, MonadUtxoQuery m, MonadError BalanceAndSubmitError m) => Operator Signing -> Maybe (C.TxOut C.CtxTx C.BabbageEra) -> C.TxBodyContent C.BuildTx C.BabbageEra -> m (C.Tx C.BabbageEra)
balanceAndSubmitOperator :: forall (m :: * -> *).
(MonadBlockchain m, MonadUtxoQuery m,
 MonadError BalanceAndSubmitError m) =>
Operator Signing
-> Maybe (TxOut CtxTx BabbageEra)
-> TxBodyContent BuildTx BabbageEra
-> m (Tx BabbageEra)
balanceAndSubmitOperator Operator Signing
op Maybe (TxOut CtxTx BabbageEra)
changeOut TxBodyContent BuildTx BabbageEra
txBody = forall (m :: * -> *).
(MonadBlockchain m, MonadUtxoQuery m,
 MonadError BalanceAndSubmitError m) =>
PaymentCredential
-> Maybe (TxOut CtxTx BabbageEra)
-> TxBodyContent BuildTx BabbageEra
-> m (Tx BabbageEra)
balanceOperator (forall k. Operator k -> PaymentCredential
operatorPaymentCredential Operator Signing
op) Maybe (TxOut CtxTx BabbageEra)
changeOut TxBodyContent BuildTx BabbageEra
txBody forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadBlockchain m, MonadError BalanceAndSubmitError m) =>
Operator Signing -> Tx BabbageEra -> m (Tx BabbageEra)
signAndSubmitOperator Operator Signing
op

{-| Add the operator's signature to the transaction and send it to the blockchain
-}
signAndSubmitOperator :: (MonadBlockchain m, MonadError BalanceAndSubmitError m) => Operator Signing -> C.Tx C.BabbageEra -> m (C.Tx C.BabbageEra)
signAndSubmitOperator :: forall (m :: * -> *).
(MonadBlockchain m, MonadError BalanceAndSubmitError m) =>
Operator Signing -> Tx BabbageEra -> m (Tx BabbageEra)
signAndSubmitOperator Operator Signing
op Tx BabbageEra
tx = do
  let finalTx :: Tx BabbageEra
finalTx = Operator Signing -> Tx BabbageEra -> Tx BabbageEra
signTxOperator Operator Signing
op Tx BabbageEra
tx
  forall e (m :: * -> *) a.
MonadError e m =>
(String -> e) -> ResultT m a -> m a
liftResult String -> BalanceAndSubmitError
SubmitError (forall (m :: * -> *). MonadBlockchain m => Tx BabbageEra -> m TxId
sendTx Tx BabbageEra
finalTx) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Tx BabbageEra
finalTx

{-| UTxOs that are locked by the operator's payment credential
|-}
operatorUtxos :: MonadUtxoQuery m => Operator k -> m (C.UTxO C.BabbageEra)
operatorUtxos :: forall (m :: * -> *) k.
MonadUtxoQuery m =>
Operator k -> m (UTxO BabbageEra)
operatorUtxos = forall (m :: * -> *).
MonadUtxoQuery m =>
PaymentCredential -> m (UTxO BabbageEra)
utxosByPayment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. Operator k -> PaymentCredential
operatorPaymentCredential

{-| Select a single UTxO that is controlled by the operator. |-}
selectOperatorUTxO :: MonadUtxoQuery m => Operator k -> m (Maybe (C.TxIn, C.TxOut C.CtxUTxO C.BabbageEra))
selectOperatorUTxO :: forall (m :: * -> *) k.
MonadUtxoQuery m =>
Operator k -> m (Maybe (TxIn, TxOut CtxUTxO BabbageEra))
selectOperatorUTxO Operator k
operator = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
C.unUTxO) (forall (m :: * -> *) k.
MonadUtxoQuery m =>
Operator k -> m (UTxO BabbageEra)
operatorUtxos Operator k
operator)

-- | Failures during txn balancing and submission
data BalanceAndSubmitError =
  BalanceError BalancingError
  | SubmitError String
  deriving Int -> BalanceAndSubmitError -> ShowS
[BalanceAndSubmitError] -> ShowS
BalanceAndSubmitError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalanceAndSubmitError] -> ShowS
$cshowList :: [BalanceAndSubmitError] -> ShowS
show :: BalanceAndSubmitError -> String
$cshow :: BalanceAndSubmitError -> String
showsPrec :: Int -> BalanceAndSubmitError -> ShowS
$cshowsPrec :: Int -> BalanceAndSubmitError -> ShowS
Show