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

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

module Cardano.Wallet.Mock.Client where

import Cardano.Wallet.Mock.API (API)
import Cardano.Wallet.Mock.Types (WalletInfo)
import Control.Monad (void)
import Control.Monad.Freer (Eff, LastMember, Member, sendM, type (~>))
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Reader (Reader, ask)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy (Proxy (Proxy))
import Ledger (CardanoAddress, PaymentPubKeyHash)
import Ledger.Tx (CardanoTx)
import Ledger.Tx.Constraints.OffChain (UnbalancedTx)
import Plutus.V1.Ledger.Api (Value)
import Servant ((:<|>) ((:<|>)))
import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM)
import Wallet.Effects (WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx))
import Wallet.Emulator.Error (WalletAPIError)
import Wallet.Emulator.Wallet (Wallet (Wallet, getWalletId), WalletId)

{-# DEPRECATED ownPaymentPubKeyHash "Use ownAddresses instead" #-}

createWallet :: Maybe Integer -> ClientM WalletInfo
submitTxn :: Wallet -> CardanoTx -> ClientM ()
ownPaymentPubKeyHash :: Wallet -> ClientM PaymentPubKeyHash
ownAddresses :: Wallet -> ClientM (NonEmpty CardanoAddress)
balanceTx :: Wallet -> UnbalancedTx -> ClientM (Either WalletAPIError CardanoTx)
totalFunds :: Wallet -> ClientM Value
sign :: Wallet -> CardanoTx -> ClientM CardanoTx
(Maybe Integer -> ClientM WalletInfo
createWallet, Wallet -> CardanoTx -> ClientM ()
submitTxn, Wallet -> ClientM PaymentPubKeyHash
ownPaymentPubKeyHash, Wallet -> ClientM (NonEmpty CardanoAddress)
ownAddresses, Wallet -> UnbalancedTx -> ClientM (Either WalletAPIError CardanoTx)
balanceTx, Wallet -> ClientM Value
totalFunds, Wallet -> CardanoTx -> ClientM CardanoTx
sign) =
  ( Maybe Integer -> ClientM WalletInfo
createWallet_
  , \(Wallet Maybe String
_ WalletId
wid) CardanoTx
tx -> ClientM NoContent -> ClientM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (WalletId -> CardanoTx -> ClientM NoContent
submitTxn_ WalletId
wid CardanoTx
tx)
  , WalletId -> ClientM PaymentPubKeyHash
ownPaymentPubKeyHash_ (WalletId -> ClientM PaymentPubKeyHash)
-> (Wallet -> WalletId) -> Wallet -> ClientM PaymentPubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId
  , WalletId -> ClientM (NonEmpty CardanoAddress)
ownAddresses_ (WalletId -> ClientM (NonEmpty CardanoAddress))
-> (Wallet -> WalletId)
-> Wallet
-> ClientM (NonEmpty CardanoAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId
  , WalletId
-> UnbalancedTx -> ClientM (Either WalletAPIError CardanoTx)
balanceTx_ (WalletId
 -> UnbalancedTx -> ClientM (Either WalletAPIError CardanoTx))
-> (Wallet -> WalletId)
-> Wallet
-> UnbalancedTx
-> ClientM (Either WalletAPIError CardanoTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId
  , WalletId -> ClientM Value
totalFunds_ (WalletId -> ClientM Value)
-> (Wallet -> WalletId) -> Wallet -> ClientM Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId
  , WalletId -> CardanoTx -> ClientM CardanoTx
sign_ (WalletId -> CardanoTx -> ClientM CardanoTx)
-> (Wallet -> WalletId) -> Wallet -> CardanoTx -> ClientM CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId)
  where
    ( Maybe Integer -> ClientM WalletInfo
createWallet_
      :<|> (WalletId -> CardanoTx -> ClientM NoContent
submitTxn_
      :<|> WalletId -> ClientM PaymentPubKeyHash
ownPaymentPubKeyHash_
      :<|> WalletId -> ClientM (NonEmpty CardanoAddress)
ownAddresses_
      :<|> WalletId
-> UnbalancedTx -> ClientM (Either WalletAPIError CardanoTx)
balanceTx_
      :<|> WalletId -> ClientM Value
totalFunds_
      :<|> WalletId -> CardanoTx -> ClientM CardanoTx
sign_)) = Proxy (API WalletId) -> Client ClientM (API WalletId)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy (API WalletId)
forall k (t :: k). Proxy t
Proxy @(API WalletId))

handleWalletClient ::
  forall m effs.
  ( LastMember m effs
  , MonadIO m
  , Member (Error ClientError) effs
  , Member (Error WalletAPIError) effs
  , Member (Reader ClientEnv) effs
  )
  => Wallet
  -> WalletEffect
  ~> Eff effs
handleWalletClient :: Wallet -> WalletEffect ~> Eff effs
handleWalletClient Wallet
wallet 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
    let
        runClient :: forall a. ClientM a -> Eff effs a
        runClient :: ClientM a -> Eff effs a
runClient ClientM a
a = (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) Eff effs (Either ClientError a)
-> (Either ClientError a -> Eff effs a) -> Eff effs a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ClientError -> Eff effs a)
-> (a -> Eff effs a) -> Either ClientError a -> Eff effs a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ClientError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

        submitTxnH :: CardanoTx -> Eff effs ()
        submitTxnH :: CardanoTx -> Eff effs ()
submitTxnH CardanoTx
tx = ClientM () -> Eff effs ()
forall a. ClientM a -> Eff effs a
runClient (Wallet -> CardanoTx -> ClientM ()
submitTxn Wallet
wallet CardanoTx
tx)

        ownAddressesH :: Eff effs (NonEmpty CardanoAddress)
        ownAddressesH :: Eff effs (NonEmpty CardanoAddress)
ownAddressesH = ClientM (NonEmpty CardanoAddress)
-> Eff effs (NonEmpty CardanoAddress)
forall a. ClientM a -> Eff effs a
runClient (Wallet -> ClientM (NonEmpty CardanoAddress)
ownAddresses Wallet
wallet)

        balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
        balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH UnbalancedTx
utx = ClientM (Either WalletAPIError CardanoTx)
-> Eff effs (Either WalletAPIError CardanoTx)
forall a. ClientM a -> Eff effs a
runClient (Wallet -> UnbalancedTx -> ClientM (Either WalletAPIError CardanoTx)
balanceTx Wallet
wallet UnbalancedTx
utx)

        walletAddSignatureH :: CardanoTx -> Eff effs CardanoTx
        walletAddSignatureH :: CardanoTx -> Eff effs CardanoTx
walletAddSignatureH CardanoTx
tx = ClientM CardanoTx -> Eff effs CardanoTx
forall a. ClientM a -> Eff effs a
runClient (ClientM CardanoTx -> Eff effs CardanoTx)
-> ClientM CardanoTx -> Eff effs CardanoTx
forall a b. (a -> b) -> a -> b
$ Wallet -> CardanoTx -> ClientM CardanoTx
sign Wallet
wallet CardanoTx
tx

        totalFundsH :: Eff effs Value
        totalFundsH :: Eff effs Value
totalFundsH = ClientM Value -> Eff effs Value
forall a. ClientM a -> Eff effs a
runClient (Wallet -> ClientM Value
totalFunds Wallet
wallet)

        yieldUnbalancedTx :: UnbalancedTx -> Eff effs ()
        yieldUnbalancedTx :: UnbalancedTx -> Eff effs ()
yieldUnbalancedTx 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 ()
yieldUnbalancedTx UnbalancedTx
utx