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

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

module Cardano.Wallet.RemoteClient
    ( handleWalletClient
    ) where

import Cardano.Wallet.LocalClient.ExportTx (export)
import Control.Concurrent.STM qualified as STM
import Control.Monad.Freer (Eff, LastMember, Member, type (~>))
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Reader (Reader, ask)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Text qualified as Text
import Plutus.PAB.Core.ContractInstance.STM (InstancesState)
import Plutus.PAB.Core.ContractInstance.STM qualified as Instances
import Wallet.API qualified as WAPI
import Wallet.Effects (WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx))
import Wallet.Error (WalletAPIError (OtherError, RemoteClientFunctionNotYetSupported), throwOtherError)
import Wallet.Types (ContractInstanceId)

-- | Wallet effect handler to remote client scenario.
--
-- Useful for browser-based wallets (Nami, Yoroi, etc.) where the PAB doesn't
-- have direct access.
--
-- TODO: All wallet effects, except 'YieldUnbalancedTx' need to be implemented. See SCP-3094.
handleWalletClient
    :: forall m effs.
    ( LastMember m effs
    , MonadIO m
    , Member WAPI.NodeClientEffect effs
    , Member (Error WalletAPIError) effs
    , Member (Reader InstancesState) effs
    )
    => Maybe ContractInstanceId
    -> WalletEffect
    ~> Eff effs
handleWalletClient :: Maybe ContractInstanceId -> WalletEffect ~> Eff effs
handleWalletClient Maybe ContractInstanceId
cidM WalletEffect x
event =
    case WalletEffect x
event of
        WalletEffect x
OwnAddresses -> do
            WalletAPIError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs x) -> WalletAPIError -> Eff effs x
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
RemoteClientFunctionNotYetSupported Text
"Cardano.Wallet.RemoteClient.OwnAddresses"

        WalletAddSignature CardanoTx
_ -> do
            WalletAPIError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs x) -> WalletAPIError -> Eff effs x
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
RemoteClientFunctionNotYetSupported Text
"Cardano.Wallet.RemoteClient.WalletAddSignature"

        WalletEffect x
TotalFunds -> do
            WalletAPIError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs x) -> WalletAPIError -> Eff effs x
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
RemoteClientFunctionNotYetSupported Text
"Cardano.Wallet.RemoteClient.TotalFunds"

        SubmitTxn CardanoTx
_ -> do
            WalletAPIError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs x) -> WalletAPIError -> Eff effs x
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
RemoteClientFunctionNotYetSupported Text
"Cardano.Wallet.RemoteClient.SubmitTxn"

        BalanceTx UnbalancedTx
_ ->
            WalletAPIError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs x) -> WalletAPIError -> Eff effs x
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
RemoteClientFunctionNotYetSupported Text
"Cardano.Wallet.RemoteClient.BalanceTx"

        YieldUnbalancedTx UnbalancedTx
utx -> do
            Params
params <- Eff effs Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
WAPI.getClientParams
            case Params -> UnbalancedTx -> Either CardanoLedgerError ExportTx
export Params
params UnbalancedTx
utx of
                Left CardanoLedgerError
err -> Text -> Eff effs x
forall (effs :: [* -> *]) a.
Member (Error WalletAPIError) effs =>
Text -> Eff effs a
throwOtherError (Text -> Eff effs x) -> Text -> Eff effs x
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CardanoLedgerError -> String
forall a. Show a => a -> String
show CardanoLedgerError
err
                Right ExportTx
ex -> do
                  case Maybe ContractInstanceId
cidM of
                    Maybe ContractInstanceId
Nothing -> Text -> Eff effs x
forall (effs :: [* -> *]) a.
Member (Error WalletAPIError) effs =>
Text -> Eff effs a
throwOtherError Text
"RemoteWalletClient: No contract instance id"
                    Just ContractInstanceId
cid -> do
                        Maybe InstanceState
s <- forall (effs :: [* -> *]).
Member (Reader InstancesState) effs =>
Eff effs InstancesState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @InstancesState Eff effs InstancesState
-> (InstancesState -> Eff effs (Maybe InstanceState))
-> Eff effs (Maybe InstanceState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe InstanceState) -> Eff effs (Maybe InstanceState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InstanceState) -> Eff effs (Maybe InstanceState))
-> (InstancesState -> IO (Maybe InstanceState))
-> InstancesState
-> Eff effs (Maybe InstanceState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceId -> InstancesState -> IO (Maybe InstanceState)
Instances.instanceState ContractInstanceId
cid
                        case Maybe InstanceState
s of
                            Maybe InstanceState
Nothing -> WalletAPIError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs x) -> WalletAPIError -> Eff effs x
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
OtherError (Text -> WalletAPIError) -> Text -> WalletAPIError
forall a b. (a -> b) -> a -> b
$ Text
"RemoteWalletClient: Contract instance not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ContractInstanceId -> String
forall a. Show a => a -> String
show ContractInstanceId
cid)
                            Just InstanceState
instanceState -> IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                                TVar [ExportTx] -> ([ExportTx] -> [ExportTx]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar (InstanceState -> TVar [ExportTx]
Instances.issYieldedExportTxs InstanceState
instanceState) (\[ExportTx]
txs -> [ExportTx]
txs [ExportTx] -> [ExportTx] -> [ExportTx]
forall a. [a] -> [a] -> [a]
++ [ExportTx
ex])