{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}

{-# OPTIONS_GHC -Wno-deprecations #-} -- TODO Remove once TotalFunds gets removed

module Cardano.Wallet.LocalClient where

import Cardano.Api (shelleyAddressInEra)
import Cardano.Api qualified
import Cardano.Node.Types (PABServerConfig (pscPassphrase))
import Cardano.Wallet.Api qualified as C
import Cardano.Wallet.Api.Client qualified as C
import Cardano.Wallet.Api.Types (ApiWallet (assets, balance))
import Cardano.Wallet.Api.Types qualified as C
import Cardano.Wallet.LocalClient.ExportTx (export)
import Cardano.Wallet.Primitive.AddressDerivation qualified as C
import Cardano.Wallet.Primitive.Types qualified as C
import Cardano.Wallet.Primitive.Types.Hash qualified as C
import Cardano.Wallet.Primitive.Types.TokenMap qualified as C
import Cardano.Wallet.Primitive.Types.TokenPolicy qualified as C
import Cardano.Wallet.Primitive.Types.TokenQuantity qualified as C
import Cardano.Wallet.Primitive.Types.Tx qualified as C
import Cardano.Wallet.Shelley.Compatibility ()
import Control.Monad ((>=>))
import Control.Monad.Freer (Eff, LastMember, Member, sendM, type (~>))
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Extras.Log (LogMsg, logWarn)
import Control.Monad.Freer.Reader (Reader, ask)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (toJSON)
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (parseMaybe, (.:))
import Data.Bifunctor (bimap)
import Data.Foldable (toList)
import Data.Functor (void)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (mapMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Quantity (Quantity (Quantity))
import Data.Text (Text, pack)
import Data.Text.Class (fromText)
import Ledger (CardanoAddress)
import Ledger.Tx.CardanoAPI (CardanoTx (CardanoTx), ToCardanoError)
import Ledger.Tx.Constraints.OffChain (UnbalancedTx)
import Plutus.PAB.Monitoring.PABLogMsg (WalletClientMsg (BalanceTxError, WalletClientError))
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.Value (Value (Value), currencySymbol, tokenName)
import PlutusTx.AssocMap qualified as Map
import Prettyprinter (Pretty (pretty))
import Servant ((:<|>) ((:<|>)), (:>))
import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM)
import Wallet.API qualified as WAPI
import Wallet.Effects (WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx))
import Wallet.Emulator.Error (WalletAPIError (OtherError, ToCardanoError))
import Wallet.Emulator.Wallet (Wallet (Wallet), WalletId (WalletId))

getWalletKey :: C.ApiT C.WalletId -> C.ApiT C.Role -> C.ApiT C.DerivationIndex -> Maybe Bool -> ClientM C.ApiVerificationKeyShelley
ApiT WalletId
-> ApiT Role
-> ApiT DerivationIndex
-> Maybe Bool
-> ClientM ApiVerificationKeyShelley
getWalletKey :<|> ApiT WalletId
-> ApiT Role
-> ApiT DerivationIndex
-> ApiWalletSignData
-> ClientM ByteString
_ :<|> ApiT WalletId
-> ApiT DerivationIndex
-> ApiPostAccountKeyDataWithPurpose
-> ClientM ApiAccountKey
_ :<|> (ApiT WalletId -> Maybe KeyFormat -> ClientM ApiAccountKey)
:<|> ((ApiT WalletId -> Maybe Bool -> ClientM ApiPolicyKey)
      :<|> ((ApiT WalletId
             -> Maybe Bool -> ApiPostPolicyKeyData -> ClientM ApiPolicyKey)
            :<|> (ApiT WalletId
                  -> ApiPostPolicyIdData -> ClientM ApiPolicyId)))
_ = Proxy ("v2" :> WalletKeys) -> Client ClientM ("v2" :> WalletKeys)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy ("v2" :> WalletKeys)
forall k (t :: k). Proxy t
Proxy @("v2" :> C.WalletKeys))

handleWalletClient
    :: forall m effs.
    ( LastMember m effs
    , MonadIO m
    , Member WAPI.NodeClientEffect effs
    , Member (Error ClientError) effs
    , Member (Error WalletAPIError) effs
    , Member (Reader ClientEnv) effs
    , Member (LogMsg WalletClientMsg) effs
    )
    => PABServerConfig -- TODO: Rename. Not mock
    -> Wallet
    -> WalletEffect
    ~> Eff effs
handleWalletClient :: PABServerConfig -> Wallet -> WalletEffect ~> Eff effs
handleWalletClient PABServerConfig
config (Wallet Maybe String
_ (WalletId Digest Blake2b_160
wId)) WalletEffect x
event = do
    ClientEnv
clientEnv <- forall (effs :: [* -> *]).
Member (Reader ClientEnv) effs =>
Eff effs ClientEnv
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @ClientEnv
    Params
params <- Eff effs Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
WAPI.getClientParams
    let walletId :: WalletId
walletId = Digest Blake2b_160 -> WalletId
C.WalletId Digest Blake2b_160
wId
        mpassphrase :: Maybe Text
mpassphrase = PABServerConfig -> Maybe Text
pscPassphrase PABServerConfig
config

        runClient :: ClientM a -> Eff effs a
        runClient :: ClientM a -> Eff effs a
runClient ClientM a
a = do
            Either ClientError a
result <- ClientM a -> Eff effs (Either ClientError a)
forall a. ClientM a -> Eff effs (Either ClientError a)
runClient' ClientM a
a
            case Either ClientError a
result of
                Left ClientError
err -> do
                    WalletClientMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (String -> WalletClientMsg
WalletClientError (String -> WalletClientMsg) -> String -> WalletClientMsg
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
err)
                    ClientError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError ClientError
err
                Right a
e -> a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
e
        runClient' :: ClientM a -> Eff effs (Either ClientError a)
        runClient' :: ClientM a -> Eff effs (Either ClientError a)
runClient' ClientM a
a = do
            Either ClientError a
result <- m (Either ClientError a) -> Eff effs (Either ClientError a)
forall (m :: * -> *) (effs :: [* -> *]) a.
(Monad m, LastMember m effs) =>
m a -> Eff effs a
sendM (m (Either ClientError a) -> Eff effs (Either ClientError a))
-> m (Either ClientError a) -> Eff effs (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ IO (Either ClientError a) -> m (Either ClientError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError a) -> m (Either ClientError a))
-> IO (Either ClientError a) -> m (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
a ClientEnv
clientEnv
            case Either ClientError a
result of
                Left ClientError
err -> do
                    WalletClientMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (String -> WalletClientMsg
WalletClientError (String -> WalletClientMsg) -> String -> WalletClientMsg
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
err)
                    Either ClientError a -> Eff effs (Either ClientError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClientError a -> Eff effs (Either ClientError a))
-> (ClientError -> Either ClientError a)
-> ClientError
-> Eff effs (Either ClientError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> Either ClientError a
forall a b. a -> Either a b
Left (ClientError -> Eff effs (Either ClientError a))
-> ClientError -> Eff effs (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ ClientError
err
                Right a
_ -> Either ClientError a -> Eff effs (Either ClientError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ClientError a
result

        submitTxnH :: CardanoTx -> Eff effs ()
        submitTxnH :: CardanoTx -> Eff effs ()
submitTxnH CardanoTx
tx = do
            SealedTx
sealedTx <- (ToCardanoError -> Eff effs SealedTx)
-> (SealedTx -> Eff effs SealedTx)
-> Either ToCardanoError SealedTx
-> Eff effs SealedTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (WalletAPIError -> Eff effs SealedTx
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs SealedTx)
-> (ToCardanoError -> WalletAPIError)
-> ToCardanoError
-> Eff effs SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> WalletAPIError
ToCardanoError) SealedTx -> Eff effs SealedTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError SealedTx -> Eff effs SealedTx)
-> Either ToCardanoError SealedTx -> Eff effs SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoTx -> Either ToCardanoError SealedTx
toSealedTx CardanoTx
tx
            Eff effs ApiTxId -> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff effs ApiTxId -> Eff effs ())
-> (ClientM ApiTxId -> Eff effs ApiTxId)
-> ClientM ApiTxId
-> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM ApiTxId -> Eff effs ApiTxId
forall a. ClientM a -> Eff effs a
runClient (ClientM ApiTxId -> Eff effs ()) -> ClientM ApiTxId -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ TransactionClient
-> ApiBytesT 'Base64 SerialisedTx -> ClientM ApiTxId
C.postExternalTransaction TransactionClient
C.transactionClient (SerialisedTx -> ApiBytesT 'Base64 SerialisedTx
forall (base :: Base) bs. bs -> ApiBytesT base bs
C.ApiBytesT (ByteString -> SerialisedTx
C.SerialisedTx (ByteString -> SerialisedTx) -> ByteString -> SerialisedTx
forall a b. (a -> b) -> a -> b
$ SealedTx -> ByteString
C.serialisedTx SealedTx
sealedTx))

        ownAddressesH :: Eff effs (NonEmpty CardanoAddress)
        ownAddressesH :: Eff effs (NonEmpty CardanoAddress)
ownAddressesH = do
            [Value]
addressValues <- ClientM [Value] -> Eff effs [Value]
forall a. ClientM a -> Eff effs a
runClient (ClientM [Value] -> Eff effs [Value])
-> ClientM [Value] -> Eff effs [Value]
forall a b. (a -> b) -> a -> b
$ AddressClient
-> ApiT WalletId -> Maybe (ApiT AddressState) -> ClientM [Value]
C.listAddresses  AddressClient
C.addressClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
C.ApiT WalletId
walletId) Maybe (ApiT AddressState)
forall a. Maybe a
Nothing
            NonEmpty CardanoAddress -> Eff effs (NonEmpty CardanoAddress)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty CardanoAddress -> Eff effs (NonEmpty CardanoAddress))
-> NonEmpty CardanoAddress -> Eff effs (NonEmpty CardanoAddress)
forall a b. (a -> b) -> a -> b
$ [CardanoAddress] -> NonEmpty CardanoAddress
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([CardanoAddress] -> NonEmpty CardanoAddress)
-> [CardanoAddress] -> NonEmpty CardanoAddress
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe CardanoAddress) -> [Value] -> [CardanoAddress]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Value -> Maybe Text
decodeApiAddress (Value -> Maybe Text)
-> (Text -> Maybe CardanoAddress) -> Value -> Maybe CardanoAddress
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe CardanoAddress
fromApiAddress) [Value]
addressValues
         where
             decodeApiAddress :: Aeson.Value -> Maybe Text
             decodeApiAddress :: Value -> Maybe Text
decodeApiAddress Value
v = (Value -> Parser Text) -> Value -> Maybe Text
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe (String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ApiAddress" (\Object
o -> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id")) Value
v

             fromApiAddress :: Text -> Maybe CardanoAddress
             fromApiAddress :: Text -> Maybe CardanoAddress
fromApiAddress Text
addrBech32 = do
                 case AsType (Address ShelleyAddr)
-> Text -> Either Bech32DecodeError (Address ShelleyAddr)
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
Cardano.Api.deserialiseFromBech32 (AsType ShelleyAddr -> AsType (Address ShelleyAddr)
forall addrtype. AsType addrtype -> AsType (Address addrtype)
Cardano.Api.AsAddress AsType ShelleyAddr
Cardano.Api.AsShelleyAddr) Text
addrBech32 of
                   Left Bech32DecodeError
_         -> Maybe CardanoAddress
forall a. Maybe a
Nothing
                   Right Address ShelleyAddr
addrCApi -> CardanoAddress -> Maybe CardanoAddress
forall a. a -> Maybe a
Just (CardanoAddress -> Maybe CardanoAddress)
-> CardanoAddress -> Maybe CardanoAddress
forall a b. (a -> b) -> a -> b
$ Address ShelleyAddr -> CardanoAddress
forall era.
IsShelleyBasedEra era =>
Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra Address ShelleyAddr
addrCApi

        balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
        balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH UnbalancedTx
utx = do
            case Params -> UnbalancedTx -> Either CardanoLedgerError ExportTx
export Params
params UnbalancedTx
utx of
                Left CardanoLedgerError
err -> do
                    WalletClientMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (WalletClientMsg -> Eff effs ()) -> WalletClientMsg -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ String -> WalletClientMsg
BalanceTxError (String -> WalletClientMsg) -> String -> WalletClientMsg
forall a b. (a -> b) -> a -> b
$ Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ CardanoLedgerError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty CardanoLedgerError
err
                    Doc Any -> Eff effs (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]) err a.
(Member (Error WalletAPIError) effs, Show err) =>
err -> Eff effs a
throwOtherError (Doc Any -> Eff effs (Either WalletAPIError CardanoTx))
-> Doc Any -> Eff effs (Either WalletAPIError CardanoTx)
forall a b. (a -> b) -> a -> b
$ CardanoLedgerError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty CardanoLedgerError
err
                Right ExportTx
ex -> do
                    Either ClientError ApiSerialisedTransaction
res <- ClientM ApiSerialisedTransaction
-> Eff effs (Either ClientError ApiSerialisedTransaction)
forall a. ClientM a -> Eff effs (Either ClientError a)
runClient' (ClientM ApiSerialisedTransaction
 -> Eff effs (Either ClientError ApiSerialisedTransaction))
-> ClientM ApiSerialisedTransaction
-> Eff effs (Either ClientError ApiSerialisedTransaction)
forall a b. (a -> b) -> a -> b
$ TransactionClient
-> ApiT WalletId
-> ApiBalanceTransactionPostDataT Value
-> ClientM ApiSerialisedTransaction
C.balanceTransaction TransactionClient
C.transactionClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
C.ApiT WalletId
walletId) (ExportTx -> Value
forall a. ToJSON a => a -> Value
toJSON ExportTx
ex)
                    case Either ClientError ApiSerialisedTransaction
res of
                        -- TODO: use the right error case based on http error code
                        Left ClientError
err -> Either WalletAPIError CardanoTx
-> Eff effs (Either WalletAPIError CardanoTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either WalletAPIError CardanoTx
 -> Eff effs (Either WalletAPIError CardanoTx))
-> Either WalletAPIError CardanoTx
-> Eff effs (Either WalletAPIError CardanoTx)
forall a b. (a -> b) -> a -> b
$ WalletAPIError -> Either WalletAPIError CardanoTx
forall a b. a -> Either a b
Left (WalletAPIError -> Either WalletAPIError CardanoTx)
-> WalletAPIError -> Either WalletAPIError CardanoTx
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
OtherError (Text -> WalletAPIError) -> Text -> WalletAPIError
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
err
                        Right ApiSerialisedTransaction
r  -> do
                            Either WalletAPIError CardanoTx
-> Eff effs (Either WalletAPIError CardanoTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoTx -> Either WalletAPIError CardanoTx
forall a b. b -> Either a b
Right (CardanoTx -> Either WalletAPIError CardanoTx)
-> CardanoTx -> Either WalletAPIError CardanoTx
forall a b. (a -> b) -> a -> b
$ ApiSerialisedTransaction -> CardanoTx
fromApiSerialisedTransaction ApiSerialisedTransaction
r)

        walletAddSignatureH :: CardanoTx -> Eff effs CardanoTx
        walletAddSignatureH :: CardanoTx -> Eff effs CardanoTx
walletAddSignatureH CardanoTx
tx = do
            SealedTx
sealedTx <- (ToCardanoError -> Eff effs SealedTx)
-> (SealedTx -> Eff effs SealedTx)
-> Either ToCardanoError SealedTx
-> Eff effs SealedTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (WalletAPIError -> Eff effs SealedTx
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs SealedTx)
-> (ToCardanoError -> WalletAPIError)
-> ToCardanoError
-> Eff effs SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> WalletAPIError
ToCardanoError) SealedTx -> Eff effs SealedTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError SealedTx -> Eff effs SealedTx)
-> Either ToCardanoError SealedTx -> Eff effs SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoTx -> Either ToCardanoError SealedTx
toSealedTx CardanoTx
tx
            Text
passphrase <- Eff effs Text
-> (Text -> Eff effs Text) -> Maybe Text -> Eff effs Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (WalletAPIError -> Eff effs Text
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs Text)
-> WalletAPIError -> Eff effs Text
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
OtherError Text
"Wallet passphrase required") Text -> Eff effs Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
mpassphrase
            Passphrase "lenient"
lenientPP <- (TextDecodingError -> Eff effs (Passphrase "lenient"))
-> (Passphrase "lenient" -> Eff effs (Passphrase "lenient"))
-> Either TextDecodingError (Passphrase "lenient")
-> Eff effs (Passphrase "lenient")
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TextDecodingError -> Eff effs (Passphrase "lenient")
forall (effs :: [* -> *]) err a.
(Member (Error WalletAPIError) effs, Show err) =>
err -> Eff effs a
throwOtherError Passphrase "lenient" -> Eff effs (Passphrase "lenient")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextDecodingError (Passphrase "lenient")
 -> Eff effs (Passphrase "lenient"))
-> Either TextDecodingError (Passphrase "lenient")
-> Eff effs (Passphrase "lenient")
forall a b. (a -> b) -> a -> b
$ Text -> Either TextDecodingError (Passphrase "lenient")
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
passphrase
            let postData :: ApiSignTransactionPostData
postData = ApiT SealedTx
-> ApiT (Passphrase "lenient") -> ApiSignTransactionPostData
C.ApiSignTransactionPostData (SealedTx -> ApiT SealedTx
forall a. a -> ApiT a
C.ApiT SealedTx
sealedTx) (Passphrase "lenient" -> ApiT (Passphrase "lenient")
forall a. a -> ApiT a
C.ApiT Passphrase "lenient"
lenientPP)
            (ApiSerialisedTransaction -> CardanoTx)
-> Eff effs ApiSerialisedTransaction -> Eff effs CardanoTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiSerialisedTransaction -> CardanoTx
fromApiSerialisedTransaction (Eff effs ApiSerialisedTransaction -> Eff effs CardanoTx)
-> (ClientM ApiSerialisedTransaction
    -> Eff effs ApiSerialisedTransaction)
-> ClientM ApiSerialisedTransaction
-> Eff effs CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM ApiSerialisedTransaction
-> Eff effs ApiSerialisedTransaction
forall a. ClientM a -> Eff effs a
runClient (ClientM ApiSerialisedTransaction -> Eff effs CardanoTx)
-> ClientM ApiSerialisedTransaction -> Eff effs CardanoTx
forall a b. (a -> b) -> a -> b
$ TransactionClient
-> ApiT WalletId
-> ApiSignTransactionPostData
-> ClientM ApiSerialisedTransaction
C.signTransaction TransactionClient
C.transactionClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
C.ApiT WalletId
walletId) ApiSignTransactionPostData
postData

        totalFundsH :: Eff effs Value
        totalFundsH :: Eff effs Value
totalFundsH = do
            C.ApiWallet{ApiWalletBalance
balance :: ApiWalletBalance
$sel:balance:ApiWallet :: ApiWallet -> ApiWalletBalance
balance, ApiWalletAssetsBalance
assets :: ApiWalletAssetsBalance
$sel:assets:ApiWallet :: ApiWallet -> ApiWalletAssetsBalance
assets} <- ClientM ApiWallet -> Eff effs ApiWallet
forall a. ClientM a -> Eff effs a
runClient (ClientM ApiWallet -> Eff effs ApiWallet)
-> ClientM ApiWallet -> Eff effs ApiWallet
forall a b. (a -> b) -> a -> b
$ WalletClient ApiWallet -> ApiT WalletId -> ClientM ApiWallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
C.getWallet WalletClient ApiWallet
C.walletClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
C.ApiT WalletId
walletId)
            let C.ApiWalletBalance (Quantity Natural
avAda) Quantity "lovelace" Natural
_ Quantity "lovelace" Natural
_ = ApiWalletBalance
balance
                C.ApiWalletAssetsBalance (C.ApiT TokenMap
avAssets) ApiT TokenMap
_ = ApiWalletAssetsBalance
assets
            Value -> Eff effs Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eff effs Value) -> Value -> Eff effs Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Ada.lovelaceValueOf (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
avAda) Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> TokenMap -> Value
tokenMapToValue TokenMap
avAssets

        yieldUnbalancedTxH :: UnbalancedTx -> Eff effs ()
        yieldUnbalancedTxH :: UnbalancedTx -> Eff effs ()
yieldUnbalancedTxH UnbalancedTx
utx = do
            Either WalletAPIError CardanoTx
balancedTxM <- UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH UnbalancedTx
utx
            case Either WalletAPIError CardanoTx
balancedTxM of
                Left WalletAPIError
err         -> WalletAPIError -> Eff effs ()
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError WalletAPIError
err
                Right CardanoTx
balancedTx -> CardanoTx -> Eff effs CardanoTx
walletAddSignatureH CardanoTx
balancedTx Eff effs CardanoTx -> (CardanoTx -> Eff effs ()) -> Eff effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CardanoTx -> Eff effs ()
submitTxnH

    case WalletEffect x
event of
        SubmitTxn CardanoTx
tx          -> CardanoTx -> Eff effs ()
submitTxnH CardanoTx
tx
        WalletEffect x
OwnAddresses          -> Eff effs x
Eff effs (NonEmpty CardanoAddress)
ownAddressesH
        BalanceTx UnbalancedTx
utx         -> UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH UnbalancedTx
utx
        WalletAddSignature CardanoTx
tx -> CardanoTx -> Eff effs CardanoTx
walletAddSignatureH CardanoTx
tx
        WalletEffect x
TotalFunds            -> Eff effs x
Eff effs Value
totalFundsH
        YieldUnbalancedTx UnbalancedTx
utx -> UnbalancedTx -> Eff effs ()
yieldUnbalancedTxH UnbalancedTx
utx

tokenMapToValue :: C.TokenMap -> Value
tokenMapToValue :: TokenMap -> Value
tokenMapToValue = Map CurrencySymbol (Map TokenName Integer) -> Value
Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> (TokenMap -> Map CurrencySymbol (Map TokenName Integer))
-> TokenMap
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
Map.fromList ([(CurrencySymbol, Map TokenName Integer)]
 -> Map CurrencySymbol (Map TokenName Integer))
-> (TokenMap -> [(CurrencySymbol, Map TokenName Integer)])
-> TokenMap
-> Map CurrencySymbol (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
 -> (CurrencySymbol, Map TokenName Integer))
-> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
-> [(CurrencySymbol, Map TokenName Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TokenPolicyId -> CurrencySymbol)
-> (NonEmpty (TokenName, TokenQuantity) -> Map TokenName Integer)
-> (TokenPolicyId, NonEmpty (TokenName, TokenQuantity))
-> (CurrencySymbol, Map TokenName Integer)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString -> CurrencySymbol
currencySymbol (ByteString -> CurrencySymbol)
-> (TokenPolicyId -> ByteString) -> TokenPolicyId -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash "TokenPolicy" -> ByteString
forall (tag :: Symbol). Hash tag -> ByteString
C.getHash (Hash "TokenPolicy" -> ByteString)
-> (TokenPolicyId -> Hash "TokenPolicy")
-> TokenPolicyId
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenPolicyId -> Hash "TokenPolicy"
C.unTokenPolicyId) ([(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
Map.fromList ([(TokenName, Integer)] -> Map TokenName Integer)
-> (NonEmpty (TokenName, TokenQuantity) -> [(TokenName, Integer)])
-> NonEmpty (TokenName, TokenQuantity)
-> Map TokenName Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenName, TokenQuantity) -> (TokenName, Integer))
-> [(TokenName, TokenQuantity)] -> [(TokenName, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TokenName -> TokenName)
-> (TokenQuantity -> Integer)
-> (TokenName, TokenQuantity)
-> (TokenName, Integer)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString -> TokenName
tokenName (ByteString -> TokenName)
-> (TokenName -> ByteString) -> TokenName -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenName -> ByteString
C.unTokenName) (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer)
-> (TokenQuantity -> Natural) -> TokenQuantity -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenQuantity -> Natural
C.unTokenQuantity)) ([(TokenName, TokenQuantity)] -> [(TokenName, Integer)])
-> (NonEmpty (TokenName, TokenQuantity)
    -> [(TokenName, TokenQuantity)])
-> NonEmpty (TokenName, TokenQuantity)
-> [(TokenName, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (TokenName, TokenQuantity) -> [(TokenName, TokenQuantity)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)) ([(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
 -> [(CurrencySymbol, Map TokenName Integer)])
-> (TokenMap
    -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))])
-> TokenMap
-> [(CurrencySymbol, Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
C.toNestedList

fromApiSerialisedTransaction :: C.ApiSerialisedTransaction -> CardanoTx
fromApiSerialisedTransaction :: ApiSerialisedTransaction -> CardanoTx
fromApiSerialisedTransaction (C.ApiSerialisedTransaction (C.ApiT SealedTx
sealedTx)) = case AnyCardanoEra -> SealedTx -> InAnyCardanoEra Tx
C.cardanoTxIdeallyNoLaterThan (CardanoEra BabbageEra -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
Cardano.Api.anyCardanoEra CardanoEra BabbageEra
Cardano.Api.BabbageEra) SealedTx
sealedTx of
    Cardano.Api.InAnyCardanoEra CardanoEra era
Cardano.Api.ByronEra Tx era
tx   -> Tx era -> EraInMode era CardanoMode -> CardanoTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> CardanoTx
CardanoTx Tx era
tx EraInMode era CardanoMode
EraInMode ByronEra CardanoMode
Cardano.Api.ByronEraInCardanoMode
    Cardano.Api.InAnyCardanoEra CardanoEra era
Cardano.Api.ShelleyEra Tx era
tx -> Tx era -> EraInMode era CardanoMode -> CardanoTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> CardanoTx
CardanoTx Tx era
tx EraInMode era CardanoMode
EraInMode ShelleyEra CardanoMode
Cardano.Api.ShelleyEraInCardanoMode
    Cardano.Api.InAnyCardanoEra CardanoEra era
Cardano.Api.AllegraEra Tx era
tx -> Tx era -> EraInMode era CardanoMode -> CardanoTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> CardanoTx
CardanoTx Tx era
tx EraInMode era CardanoMode
EraInMode AllegraEra CardanoMode
Cardano.Api.AllegraEraInCardanoMode
    Cardano.Api.InAnyCardanoEra CardanoEra era
Cardano.Api.MaryEra Tx era
tx    -> Tx era -> EraInMode era CardanoMode -> CardanoTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> CardanoTx
CardanoTx Tx era
tx EraInMode era CardanoMode
EraInMode MaryEra CardanoMode
Cardano.Api.MaryEraInCardanoMode
    Cardano.Api.InAnyCardanoEra CardanoEra era
Cardano.Api.AlonzoEra Tx era
tx  -> Tx era -> EraInMode era CardanoMode -> CardanoTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> CardanoTx
CardanoTx Tx era
tx EraInMode era CardanoMode
EraInMode AlonzoEra CardanoMode
Cardano.Api.AlonzoEraInCardanoMode
    Cardano.Api.InAnyCardanoEra CardanoEra era
Cardano.Api.BabbageEra Tx era
tx -> Tx era -> EraInMode era CardanoMode -> CardanoTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> CardanoTx
CardanoTx Tx era
tx EraInMode era CardanoMode
EraInMode BabbageEra CardanoMode
Cardano.Api.BabbageEraInCardanoMode

toSealedTx :: CardanoTx -> Either ToCardanoError C.SealedTx
toSealedTx :: CardanoTx -> Either ToCardanoError SealedTx
toSealedTx (CardanoTx Tx era
tx EraInMode era CardanoMode
Cardano.Api.ByronEraInCardanoMode) = SealedTx -> Either ToCardanoError SealedTx
forall a b. b -> Either a b
Right (SealedTx -> Either ToCardanoError SealedTx)
-> SealedTx -> Either ToCardanoError SealedTx
forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra Tx -> SealedTx
C.sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx) -> InAnyCardanoEra Tx -> SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoEra ByronEra -> Tx ByronEra -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
Cardano.Api.InAnyCardanoEra CardanoEra ByronEra
Cardano.Api.ByronEra Tx era
Tx ByronEra
tx
toSealedTx (CardanoTx Tx era
tx EraInMode era CardanoMode
Cardano.Api.ShelleyEraInCardanoMode) = SealedTx -> Either ToCardanoError SealedTx
forall a b. b -> Either a b
Right (SealedTx -> Either ToCardanoError SealedTx)
-> SealedTx -> Either ToCardanoError SealedTx
forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra Tx -> SealedTx
C.sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx) -> InAnyCardanoEra Tx -> SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoEra ShelleyEra -> Tx ShelleyEra -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
Cardano.Api.InAnyCardanoEra CardanoEra ShelleyEra
Cardano.Api.ShelleyEra Tx era
Tx ShelleyEra
tx
toSealedTx (CardanoTx Tx era
tx EraInMode era CardanoMode
Cardano.Api.AllegraEraInCardanoMode) = SealedTx -> Either ToCardanoError SealedTx
forall a b. b -> Either a b
Right (SealedTx -> Either ToCardanoError SealedTx)
-> SealedTx -> Either ToCardanoError SealedTx
forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra Tx -> SealedTx
C.sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx) -> InAnyCardanoEra Tx -> SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoEra AllegraEra -> Tx AllegraEra -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
Cardano.Api.InAnyCardanoEra CardanoEra AllegraEra
Cardano.Api.AllegraEra Tx era
Tx AllegraEra
tx
toSealedTx (CardanoTx Tx era
tx EraInMode era CardanoMode
Cardano.Api.MaryEraInCardanoMode) = SealedTx -> Either ToCardanoError SealedTx
forall a b. b -> Either a b
Right (SealedTx -> Either ToCardanoError SealedTx)
-> SealedTx -> Either ToCardanoError SealedTx
forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra Tx -> SealedTx
C.sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx) -> InAnyCardanoEra Tx -> SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoEra MaryEra -> Tx MaryEra -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
Cardano.Api.InAnyCardanoEra CardanoEra MaryEra
Cardano.Api.MaryEra Tx era
Tx MaryEra
tx
toSealedTx (CardanoTx Tx era
tx EraInMode era CardanoMode
Cardano.Api.AlonzoEraInCardanoMode) = SealedTx -> Either ToCardanoError SealedTx
forall a b. b -> Either a b
Right (SealedTx -> Either ToCardanoError SealedTx)
-> SealedTx -> Either ToCardanoError SealedTx
forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra Tx -> SealedTx
C.sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx) -> InAnyCardanoEra Tx -> SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoEra AlonzoEra -> Tx AlonzoEra -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
Cardano.Api.InAnyCardanoEra CardanoEra AlonzoEra
Cardano.Api.AlonzoEra Tx era
Tx AlonzoEra
tx
toSealedTx (CardanoTx Tx era
tx EraInMode era CardanoMode
Cardano.Api.BabbageEraInCardanoMode) = SealedTx -> Either ToCardanoError SealedTx
forall a b. b -> Either a b
Right (SealedTx -> Either ToCardanoError SealedTx)
-> SealedTx -> Either ToCardanoError SealedTx
forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra Tx -> SealedTx
C.sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx) -> InAnyCardanoEra Tx -> SealedTx
forall a b. (a -> b) -> a -> b
$ CardanoEra BabbageEra -> Tx BabbageEra -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
Cardano.Api.InAnyCardanoEra CardanoEra BabbageEra
Cardano.Api.BabbageEra Tx era
Tx BabbageEra
tx

throwOtherError :: (Member (Error WalletAPIError) effs, Show err) => err -> Eff effs a
throwOtherError :: err -> Eff effs a
throwOtherError = WalletAPIError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs a)
-> (err -> WalletAPIError) -> err -> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WalletAPIError
OtherError (Text -> WalletAPIError) -> (err -> Text) -> err -> WalletAPIError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (err -> String) -> err -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> String
forall a. Show a => a -> String
show