{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE TypeOperators      #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}

module Cardano.Wallet.Mock.Handlers
    ( processWalletEffects
    , integer2ByteString32
    , byteString2Integer
    , newWallet
    , distributeNewWalletFunds
    ) where

import Cardano.BM.Data.Trace (Trace)
import Cardano.Node.Client qualified as NodeClient
import Cardano.Node.Emulator.Internal.Node.Params (Params)
import Cardano.Node.Types (ChainSyncHandle)
import Cardano.Protocol.Socket.Mock.Client qualified as MockClient
import Cardano.Wallet.Mock.Types (MultiWalletEffect (..), WalletEffects, WalletInfo (..), WalletMsg (..), Wallets,
                                  fromWalletState)
import Control.Concurrent (MVar)
import Control.Concurrent.MVar (putMVar, takeMVar)
import Control.Lens (at, (?~))
import Control.Monad.Error (MonadError)
import Control.Monad.Except qualified as MonadError
import Control.Monad.Freer
import Control.Monad.Freer.Error
import Control.Monad.Freer.Extras hiding (Error)
import Control.Monad.Freer.Reader (runReader)
import Control.Monad.Freer.State (State, evalState, get, put, runState)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Crypto.Random (getRandomBytes)
import Data.Bits (shiftL, shiftR)
import Data.ByteArray (ScrubbedBytes, unpack)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.Lazy.Char8 qualified as BSL8
import Data.ByteString.Lazy.Char8 qualified as Char8
import Data.Function ((&))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Text (Text, pack)
import Data.Text.Encoding (encodeUtf8)
import Ledger.Address (PaymentPubKeyHash)
import Ledger.CardanoWallet (MockWallet)
import Ledger.CardanoWallet qualified as CW
import Ledger.Tx (CardanoTx)
import Plutus.ChainIndex (ChainIndexQueryEffect)
import Plutus.ChainIndex.Client qualified as ChainIndex
import Plutus.PAB.Arbitrary ()
import Plutus.PAB.Monitoring.Monitoring qualified as LM
import Plutus.PAB.Types (PABError)
import Plutus.Script.Utils.Ada qualified as Ada
import Prettyprinter (pretty)
import Servant (ServerError (..), err400, err401, err404)
import Servant.Client (ClientEnv)
import Servant.Server (err500)
import Wallet.API (WalletAPIError (..))
import Wallet.API qualified as WAPI
import Wallet.Effects (NodeClientEffect)
import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg)
import Wallet.Emulator.Wallet qualified as Wallet

newtype Seed = Seed ScrubbedBytes

generateSeed :: (LastMember m effs, MonadIO m) => Eff effs Seed
generateSeed :: Eff effs Seed
generateSeed = do
    (ScrubbedBytes
bytes :: ScrubbedBytes) <- m ScrubbedBytes -> Eff effs ScrubbedBytes
forall (m :: * -> *) (effs :: [* -> *]) a.
(Monad m, LastMember m effs) =>
m a -> Eff effs a
sendM (m ScrubbedBytes -> Eff effs ScrubbedBytes)
-> m ScrubbedBytes -> Eff effs ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ IO ScrubbedBytes -> m ScrubbedBytes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScrubbedBytes -> m ScrubbedBytes)
-> IO ScrubbedBytes -> m ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ Int -> IO ScrubbedBytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32
    Seed -> Eff effs Seed
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seed -> Eff effs Seed) -> Seed -> Eff effs Seed
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> Seed
Seed ScrubbedBytes
bytes

{-# INLINE byteString2Integer #-}
-- |Helper function to convert bytestrings to integers
byteString2Integer :: BS.ByteString -> Integer
byteString2Integer :: ByteString -> Integer
byteString2Integer = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\Integer
i Word8
b -> (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Integer
0

{-# INLINE integer2ByteString32 #-}
-- |@i2bs bitLen i@ converts @i@ to a 'ByteString' of @bitLen@ bits (must be a multiple of 8).
integer2ByteString32 :: Integer -> BS.ByteString
integer2ByteString32 :: Integer -> ByteString
integer2ByteString32 Integer
i = (Int -> Maybe (Word8, Int)) -> Int -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr (\Int
l' -> if Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Maybe (Word8, Int)
forall a. Maybe a
Nothing else (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
l'), Int
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)) (Int
31Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8)

distributeNewWalletFunds :: forall effs.
    ( Member WAPI.WalletEffect effs
    , Member (Error WalletAPIError) effs
    , Member (LogMsg Text) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => Params
    -> Maybe Ada.Ada
    -> PaymentPubKeyHash
    -> Eff effs CardanoTx
distributeNewWalletFunds :: Params -> Maybe Ada -> PaymentPubKeyHash -> Eff effs CardanoTx
distributeNewWalletFunds Params
params Maybe Ada
funds = Params
-> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs,
 Member (LogMsg Text) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
Params
-> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
WAPI.payToPaymentPublicKeyHash Params
params SlotRange
WAPI.defaultSlotRange
    (Value -> (Ada -> Value) -> Maybe Ada -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Micro -> Value
Ada.adaValueOf Micro
10_000) Ada -> Value
Ada.toValue Maybe Ada
funds)

newWallet :: forall m effs. (LastMember m effs, MonadIO m) => Eff effs MockWallet
newWallet :: Eff effs MockWallet
newWallet = do
    Seed ScrubbedBytes
seed <- Eff effs Seed
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Eff effs Seed
generateSeed
    let secretKeyBytes :: ByteString
secretKeyBytes = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (ScrubbedBytes -> [Word8]) -> ScrubbedBytes -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
unpack (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> ByteString
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes
seed
    MockWallet -> Eff effs MockWallet
forall (m :: * -> *) a. Monad m => a -> m a
return (MockWallet -> Eff effs MockWallet)
-> MockWallet -> Eff effs MockWallet
forall a b. (a -> b) -> a -> b
$ ByteString -> MockWallet
CW.fromSeed' ByteString
secretKeyBytes

-- | Handle multiple wallets using existing @Wallet.handleWallet@ handler
handleMultiWallet :: forall m effs.
    ( Member NodeClientEffect effs
    , Member ChainIndexQueryEffect effs
    , Member (State Wallets) effs
    , Member (Error WAPI.WalletAPIError) effs
    , Member (LogMsg WalletMsg) effs
    , Member (LogMsg Text) effs
    , LastMember m effs
    , MonadIO m
    )
    => Params -> MultiWalletEffect ~> Eff effs
handleMultiWallet :: Params -> MultiWalletEffect ~> Eff effs
handleMultiWallet Params
params = \case
    MultiWallet (Wallet.Wallet Maybe String
_ WalletId
walletId) Eff '[WalletEffect] x
action -> do
        Wallets
wallets <- forall (effs :: [* -> *]).
Member (State Wallets) effs =>
Eff effs Wallets
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @Wallets
        case WalletId -> Wallets -> Maybe WalletState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WalletId
walletId Wallets
wallets of
            Just WalletState
walletState -> do
                (x
x, WalletState
newState) <- WalletState
-> Eff (State WalletState : effs) x -> Eff effs (x, WalletState)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState WalletState
walletState
                    (Eff (State WalletState : effs) x -> Eff effs (x, WalletState))
-> Eff (State WalletState : effs) x -> Eff effs (x, WalletState)
forall a b. (a -> b) -> a -> b
$ Eff '[WalletEffect] x
action
                        Eff '[WalletEffect] x
-> (Eff '[WalletEffect] x
    -> Eff
         (WalletEffect : LogMsg TxBalanceMsg : State WalletState : effs) x)
-> Eff
     (WalletEffect : LogMsg TxBalanceMsg : State WalletState : effs) x
forall a b. a -> (a -> b) -> b
& Eff '[WalletEffect] x
-> Eff
     (WalletEffect : LogMsg TxBalanceMsg : State WalletState : effs) x
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd
                        Eff
  (WalletEffect : LogMsg TxBalanceMsg : State WalletState : effs) x
-> (Eff
      (WalletEffect : LogMsg TxBalanceMsg : State WalletState : effs) x
    -> Eff (LogMsg TxBalanceMsg : State WalletState : effs) x)
-> Eff (LogMsg TxBalanceMsg : State WalletState : effs) x
forall a b. a -> (a -> b) -> b
& (WalletEffect
 ~> Eff (LogMsg TxBalanceMsg : State WalletState : effs))
-> Eff
     (WalletEffect : LogMsg TxBalanceMsg : State WalletState : effs)
   ~> Eff (LogMsg TxBalanceMsg : State WalletState : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(Member (Error WalletAPIError) effs, Member NodeClientEffect effs,
 Member ChainIndexQueryEffect effs, Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs) =>
WalletEffect ~> Eff effs
WalletEffect
~> Eff (LogMsg TxBalanceMsg : State WalletState : effs)
Wallet.handleWallet
                        Eff (LogMsg TxBalanceMsg : State WalletState : effs) x
-> (Eff (LogMsg TxBalanceMsg : State WalletState : effs) x
    -> Eff (State WalletState : effs) x)
-> Eff (State WalletState : effs) x
forall a b. a -> (a -> b) -> b
& (LogMsg TxBalanceMsg ~> Eff (State WalletState : effs))
-> Eff (LogMsg TxBalanceMsg : State WalletState : effs)
   ~> Eff (State WalletState : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((TxBalanceMsg -> WalletMsg)
-> LogMsg TxBalanceMsg ~> Eff (State WalletState : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @TxBalanceMsg @WalletMsg TxBalanceMsg -> WalletMsg
Balancing)
                Wallets -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put @Wallets (Wallets
wallets Wallets -> (Wallets -> Wallets) -> Wallets
forall a b. a -> (a -> b) -> b
& Index Wallets -> Lens' Wallets (Maybe (IxValue Wallets))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Wallets
WalletId
walletId ((Maybe WalletState -> Identity (Maybe WalletState))
 -> Wallets -> Identity Wallets)
-> WalletState -> Wallets -> Wallets
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ WalletState
newState)
                x -> Eff effs x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x
            Maybe WalletState
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
WAPI.OtherError Text
"Wallet not found"
    CreateWallet Maybe Ada
funds -> do
        Wallets
wallets <- forall (effs :: [* -> *]).
Member (State Wallets) effs =>
Eff effs Wallets
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @Wallets
        MockWallet
mockWallet <- Eff effs MockWallet
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Eff effs MockWallet
newWallet
        let walletId :: WalletId
walletId = Digest Blake2b_160 -> WalletId
Wallet.WalletId (Digest Blake2b_160 -> WalletId) -> Digest Blake2b_160 -> WalletId
forall a b. (a -> b) -> a -> b
$ MockWallet -> Digest Blake2b_160
CW.mwWalletId MockWallet
mockWallet
            wallets' :: Wallets
wallets' = WalletId -> WalletState -> Wallets -> Wallets
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert WalletId
walletId (MockWallet -> WalletState
Wallet.fromMockWallet MockWallet
mockWallet) Wallets
wallets
            pkh :: PaymentPubKeyHash
pkh = MockWallet -> PaymentPubKeyHash
CW.paymentPubKeyHash MockWallet
mockWallet
            addr :: CardanoAddress
addr = MockWallet -> CardanoAddress
CW.mockWalletAddress MockWallet
mockWallet
        Wallets -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put Wallets
wallets'
        -- For some reason this doesn't work with (Wallet 1)/privateKey1,
        -- works just fine with (Wallet 2)/privateKey2
        -- ¯\_(ツ)_/¯
        let sourceWallet :: WalletState
sourceWallet = MockWallet -> WalletState
Wallet.fromMockWallet (Integer -> MockWallet
CW.knownMockWallet Integer
2)
        CardanoTx
_ <- WalletState
-> Eff (State WalletState : effs) CardanoTx -> Eff effs CardanoTx
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs a
evalState WalletState
sourceWallet (Eff (State WalletState : effs) CardanoTx -> Eff effs CardanoTx)
-> Eff (State WalletState : effs) CardanoTx -> Eff effs CardanoTx
forall a b. (a -> b) -> a -> b
$
            (LogMsg TxBalanceMsg ~> Eff (State WalletState : effs))
-> Eff (LogMsg TxBalanceMsg : State WalletState : effs)
   ~> Eff (State WalletState : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((TxBalanceMsg -> WalletMsg)
-> LogMsg TxBalanceMsg ~> Eff (State WalletState : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @TxBalanceMsg @WalletMsg TxBalanceMsg -> WalletMsg
Balancing)
            (Eff (LogMsg TxBalanceMsg : State WalletState : effs) CardanoTx
 -> Eff (State WalletState : effs) CardanoTx)
-> Eff (LogMsg TxBalanceMsg : State WalletState : effs) CardanoTx
-> Eff (State WalletState : effs) CardanoTx
forall a b. (a -> b) -> a -> b
$ (LogMsg RequestHandlerLogMsg
 ~> Eff (LogMsg TxBalanceMsg : State WalletState : effs))
-> Eff
     (LogMsg RequestHandlerLogMsg
        : LogMsg TxBalanceMsg : State WalletState : effs)
   ~> Eff (LogMsg TxBalanceMsg : State WalletState : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((RequestHandlerLogMsg -> WalletMsg)
-> LogMsg RequestHandlerLogMsg
   ~> Eff (LogMsg TxBalanceMsg : State WalletState : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @RequestHandlerLogMsg @WalletMsg RequestHandlerLogMsg -> WalletMsg
RequestHandling)
            (Eff
   (LogMsg RequestHandlerLogMsg
      : LogMsg TxBalanceMsg : State WalletState : effs)
   CardanoTx
 -> Eff (LogMsg TxBalanceMsg : State WalletState : effs) CardanoTx)
-> Eff
     (LogMsg RequestHandlerLogMsg
        : LogMsg TxBalanceMsg : State WalletState : effs)
     CardanoTx
-> Eff (LogMsg TxBalanceMsg : State WalletState : effs) CardanoTx
forall a b. (a -> b) -> a -> b
$ (WalletEffect
 ~> Eff
      (LogMsg RequestHandlerLogMsg
         : LogMsg TxBalanceMsg : State WalletState : effs))
-> Eff
     (WalletEffect
        : LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg
        : State WalletState : effs)
   ~> Eff
        (LogMsg RequestHandlerLogMsg
           : LogMsg TxBalanceMsg : State WalletState : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(Member (Error WalletAPIError) effs, Member NodeClientEffect effs,
 Member ChainIndexQueryEffect effs, Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs) =>
WalletEffect ~> Eff effs
WalletEffect
~> Eff
     (LogMsg RequestHandlerLogMsg
        : LogMsg TxBalanceMsg : State WalletState : effs)
Wallet.handleWallet
            (Eff
   (WalletEffect
      : LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg
      : State WalletState : effs)
   CardanoTx
 -> Eff
      (LogMsg RequestHandlerLogMsg
         : LogMsg TxBalanceMsg : State WalletState : effs)
      CardanoTx)
-> Eff
     (WalletEffect
        : LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg
        : State WalletState : effs)
     CardanoTx
-> Eff
     (LogMsg RequestHandlerLogMsg
        : LogMsg TxBalanceMsg : State WalletState : effs)
     CardanoTx
forall a b. (a -> b) -> a -> b
$ Params
-> Maybe Ada
-> PaymentPubKeyHash
-> Eff
     (WalletEffect
        : LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg
        : State WalletState : effs)
     CardanoTx
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs,
 Member (LogMsg Text) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
Params -> Maybe Ada -> PaymentPubKeyHash -> Eff effs CardanoTx
distributeNewWalletFunds Params
params Maybe Ada
funds PaymentPubKeyHash
pkh
        WalletInfo -> Eff effs WalletInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (WalletInfo -> Eff effs WalletInfo)
-> WalletInfo -> Eff effs WalletInfo
forall a b. (a -> b) -> a -> b
$ WalletInfo :: Wallet
-> PaymentPubKeyHash -> NonEmpty CardanoAddress -> WalletInfo
WalletInfo
            { wiWallet :: Wallet
wiWallet = MockWallet -> Wallet
Wallet.toMockWallet MockWallet
mockWallet
            , wiPaymentPubKeyHash :: PaymentPubKeyHash
wiPaymentPubKeyHash = PaymentPubKeyHash
pkh
            , wiAddresses :: NonEmpty CardanoAddress
wiAddresses = [CardanoAddress] -> NonEmpty CardanoAddress
forall a. [a] -> NonEmpty a
NonEmpty.fromList [CardanoAddress
addr]
            }
    GetWalletInfo WalletId
wllt -> do
        Wallets
wallets <- forall (effs :: [* -> *]).
Member (State Wallets) effs =>
Eff effs Wallets
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @Wallets
        Maybe WalletInfo -> Eff effs (Maybe WalletInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WalletInfo -> Eff effs (Maybe WalletInfo))
-> Maybe WalletInfo -> Eff effs (Maybe WalletInfo)
forall a b. (a -> b) -> a -> b
$ (WalletState -> WalletInfo)
-> Maybe WalletState -> Maybe WalletInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletState -> WalletInfo
fromWalletState (Maybe WalletState -> Maybe WalletInfo)
-> Maybe WalletState -> Maybe WalletInfo
forall a b. (a -> b) -> a -> b
$ WalletId -> Wallets -> Maybe WalletState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WalletId
wllt Wallets
wallets

-- | Process wallet effects. Retain state and yield HTTP400 on error
--   or set new state on success.
processWalletEffects ::
    (MonadIO m, MonadError ServerError m)
    => Trace IO WalletMsg -- ^ trace for logging
    -> MockClient.TxSendHandle -- ^ node client
    -> ChainSyncHandle -- ^ node client
    -> ClientEnv          -- ^ chain index client
    -> MVar Wallets   -- ^ wallets state
    -> Params
    -> Eff (WalletEffects IO) a -- ^ wallet effect
    -> m a
processWalletEffects :: Trace IO WalletMsg
-> TxSendHandle
-> ChainSyncHandle
-> ClientEnv
-> MVar Wallets
-> Params
-> Eff (WalletEffects IO) a
-> m a
processWalletEffects Trace IO WalletMsg
trace TxSendHandle
txSendHandle ChainSyncHandle
chainSyncHandle ClientEnv
chainIndexEnv MVar Wallets
mVarState Params
params Eff (WalletEffects IO) a
action = do
    Wallets
oldState <- IO Wallets -> m Wallets
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Wallets -> m Wallets) -> IO Wallets -> m Wallets
forall a b. (a -> b) -> a -> b
$ MVar Wallets -> IO Wallets
forall a. MVar a -> IO a
takeMVar MVar Wallets
mVarState
    Either ServerError (a, Wallets)
result <- IO (Either ServerError (a, Wallets))
-> m (Either ServerError (a, Wallets))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ServerError (a, Wallets))
 -> m (Either ServerError (a, Wallets)))
-> IO (Either ServerError (a, Wallets))
-> m (Either ServerError (a, Wallets))
forall a b. (a -> b) -> a -> b
$ Trace IO WalletMsg
-> TxSendHandle
-> ChainSyncHandle
-> ClientEnv
-> Wallets
-> Params
-> Eff (WalletEffects IO) a
-> IO (Either ServerError (a, Wallets))
forall a.
Trace IO WalletMsg
-> TxSendHandle
-> ChainSyncHandle
-> ClientEnv
-> Wallets
-> Params
-> Eff (WalletEffects IO) a
-> IO (Either ServerError (a, Wallets))
runWalletEffects Trace IO WalletMsg
trace
                                        TxSendHandle
txSendHandle
                                        ChainSyncHandle
chainSyncHandle
                                        ClientEnv
chainIndexEnv
                                        Wallets
oldState
                                        Params
params
                                        Eff (WalletEffects IO) a
action
    case Either ServerError (a, Wallets)
result of
        Left ServerError
e -> do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar Wallets -> Wallets -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Wallets
mVarState Wallets
oldState
            ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
MonadError.throwError (ServerError -> m a) -> ServerError -> m a
forall a b. (a -> b) -> a -> b
$ ServerError
err400 { errBody :: ByteString
errBody = String -> ByteString
Char8.pack (ServerError -> String
forall a. Show a => a -> String
show ServerError
e) }
        Right (a
result_, Wallets
newState) -> do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar Wallets -> Wallets -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Wallets
mVarState Wallets
newState
            a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result_

-- | Interpret wallet effects
runWalletEffects ::
    Trace IO WalletMsg -- ^ trace for logging
    -> MockClient.TxSendHandle -- ^ node client
    -> ChainSyncHandle -- ^ node client
    -> ClientEnv -- ^ chain index client
    -> Wallets -- ^ current state
    -> Params
    -> Eff (WalletEffects IO) a -- ^ wallet effect
    -> IO (Either ServerError (a, Wallets))
runWalletEffects :: Trace IO WalletMsg
-> TxSendHandle
-> ChainSyncHandle
-> ClientEnv
-> Wallets
-> Params
-> Eff (WalletEffects IO) a
-> IO (Either ServerError (a, Wallets))
runWalletEffects Trace IO WalletMsg
trace TxSendHandle
txSendHandle ChainSyncHandle
chainSyncHandle ClientEnv
chainIndexEnv Wallets
wallets Params
params Eff (WalletEffects IO) a
action =
    (MultiWalletEffect
 ~> Eff
      '[LogMsg WalletMsg, NodeClientEffect, ChainIndexQueryEffect,
        State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO])
-> Eff (WalletEffects IO) a
-> Eff
     '[LogMsg WalletMsg, NodeClientEffect, ChainIndexQueryEffect,
       State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (Params
-> MultiWalletEffect
   ~> Eff
        '[LogMsg WalletMsg, NodeClientEffect, ChainIndexQueryEffect,
          State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
          Error ClientError, Error ServerError, IO]
forall (m :: * -> *) (effs :: [* -> *]).
(Member NodeClientEffect effs, Member ChainIndexQueryEffect effs,
 Member (State Wallets) effs, Member (Error WalletAPIError) effs,
 Member (LogMsg WalletMsg) effs, Member (LogMsg Text) effs,
 LastMember m effs, MonadIO m) =>
Params -> MultiWalletEffect ~> Eff effs
handleMultiWallet Params
params) Eff (WalletEffects IO) a
action
    Eff
  '[LogMsg WalletMsg, NodeClientEffect, ChainIndexQueryEffect,
    State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  a
-> (Eff
      '[LogMsg WalletMsg, NodeClientEffect, ChainIndexQueryEffect,
        State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO]
      a
    -> Eff
         '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
           Error PABError, LogMsg Text, Error WalletAPIError,
           Error ClientError, Error ServerError, IO]
         a)
-> Eff
     '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
       Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
forall a b. a -> (a -> b) -> b
& (LogMsg WalletMsg
 ~> Eff
      '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
        Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO])
-> Eff
     '[LogMsg WalletMsg, NodeClientEffect, ChainIndexQueryEffect,
       State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
   ~> Eff
        '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
          Error PABError, LogMsg Text, Error WalletAPIError,
          Error ClientError, Error ServerError, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO WalletMsg
-> LogMsg WalletMsg
   ~> Eff
        '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
          Error PABError, LogMsg Text, Error WalletAPIError,
          Error ClientError, Error ServerError, IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace Trace IO WalletMsg
trace)
    Eff
  '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
    Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  a
-> (Eff
      '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
        Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO]
      a
    -> Eff
         '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
           ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
           Error WalletAPIError, Error ClientError, Error ServerError, IO]
         a)
-> Eff
     '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
       ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
       Error WalletAPIError, Error ClientError, Error ServerError, IO]
     a
forall a b. a -> (a -> b) -> b
& (NodeClientEffect
 ~> Eff
      '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
        ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
        Error WalletAPIError, Error ClientError, Error ServerError, IO])
-> Eff
     '[NodeClientEffect, ChainIndexQueryEffect, State Wallets,
       Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
   ~> Eff
        '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
          ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
          Error WalletAPIError, Error ClientError, Error ServerError, IO]
forall (f :: * -> *) (g :: * -> *) (h :: * -> *)
       (effs :: [* -> *]).
(f ~> Eff (g : h : effs)) -> Eff (f : effs) ~> Eff (g : h : effs)
reinterpret2 (Params
-> NodeClientEffect
   ~> Eff
        '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
          ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
          Error WalletAPIError, Error ClientError, Error ServerError, IO]
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m, Member (Error PABError) effs,
 Member (Reader (Maybe TxSendHandle)) effs,
 Member (Reader ChainSyncHandle) effs) =>
Params -> NodeClientEffect ~> Eff effs
NodeClient.handleNodeClientClient Params
params)
    Eff
  '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
    ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
    Error WalletAPIError, Error ClientError, Error ServerError, IO]
  a
-> (Eff
      '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
        ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
        Error WalletAPIError, Error ClientError, Error ServerError, IO]
      a
    -> Eff
         '[Reader (Maybe TxSendHandle), ChainIndexQueryEffect,
           State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
           Error ClientError, Error ServerError, IO]
         a)
-> Eff
     '[Reader (Maybe TxSendHandle), ChainIndexQueryEffect,
       State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
forall a b. a -> (a -> b) -> b
& ChainSyncHandle
-> Eff
     '[Reader ChainSyncHandle, Reader (Maybe TxSendHandle),
       ChainIndexQueryEffect, State Wallets, Error PABError, LogMsg Text,
       Error WalletAPIError, Error ClientError, Error ServerError, IO]
     a
-> Eff
     '[Reader (Maybe TxSendHandle), ChainIndexQueryEffect,
       State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader ChainSyncHandle
chainSyncHandle
    Eff
  '[Reader (Maybe TxSendHandle), ChainIndexQueryEffect,
    State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  a
-> (Eff
      '[Reader (Maybe TxSendHandle), ChainIndexQueryEffect,
        State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO]
      a
    -> Eff
         '[ChainIndexQueryEffect, State Wallets, Error PABError,
           LogMsg Text, Error WalletAPIError, Error ClientError,
           Error ServerError, IO]
         a)
-> Eff
     '[ChainIndexQueryEffect, State Wallets, Error PABError,
       LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
forall a b. a -> (a -> b) -> b
& Maybe TxSendHandle
-> Eff
     '[Reader (Maybe TxSendHandle), ChainIndexQueryEffect,
       State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
-> Eff
     '[ChainIndexQueryEffect, State Wallets, Error PABError,
       LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader (TxSendHandle -> Maybe TxSendHandle
forall a. a -> Maybe a
Just TxSendHandle
txSendHandle)
    Eff
  '[ChainIndexQueryEffect, State Wallets, Error PABError,
    LogMsg Text, Error WalletAPIError, Error ClientError,
    Error ServerError, IO]
  a
-> (Eff
      '[ChainIndexQueryEffect, State Wallets, Error PABError,
        LogMsg Text, Error WalletAPIError, Error ClientError,
        Error ServerError, IO]
      a
    -> Eff
         '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
           Error WalletAPIError, Error ClientError, Error ServerError, IO]
         a)
-> Eff
     '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
       Error WalletAPIError, Error ClientError, Error ServerError, IO]
     a
forall a b. a -> (a -> b) -> b
& (ChainIndexQueryEffect
 ~> Eff
      '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
        Error WalletAPIError, Error ClientError, Error ServerError, IO])
-> Eff
     '[ChainIndexQueryEffect, State Wallets, Error PABError,
       LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
   ~> Eff
        '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
          Error WalletAPIError, Error ClientError, Error ServerError, IO]
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ChainIndexQueryEffect
~> Eff
     '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
       Error WalletAPIError, Error ClientError, Error ServerError, IO]
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, Member (Reader ClientEnv) effs, MonadIO m,
 Member (Error ClientError) effs) =>
ChainIndexQueryEffect ~> Eff effs
ChainIndex.handleChainIndexClient
    Eff
  '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
    Error WalletAPIError, Error ClientError, Error ServerError, IO]
  a
-> (Eff
      '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
        Error WalletAPIError, Error ClientError, Error ServerError, IO]
      a
    -> Eff
         '[State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
           Error ClientError, Error ServerError, IO]
         a)
-> Eff
     '[State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
forall a b. a -> (a -> b) -> b
& ClientEnv
-> Eff
     '[Reader ClientEnv, State Wallets, Error PABError, LogMsg Text,
       Error WalletAPIError, Error ClientError, Error ServerError, IO]
     a
-> Eff
     '[State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader ClientEnv
chainIndexEnv
    Eff
  '[State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  a
-> (Eff
      '[State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO]
      a
    -> Eff
         '[Error PABError, LogMsg Text, Error WalletAPIError,
           Error ClientError, Error ServerError, IO]
         (a, Wallets))
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     (a, Wallets)
forall a b. a -> (a -> b) -> b
& Wallets
-> Eff
     '[State Wallets, Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     (a, Wallets)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState Wallets
wallets
    Eff
  '[Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  (a, Wallets)
-> (Eff
      '[Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO]
      (a, Wallets)
    -> Eff
         '[Error PABError, LogMsg Text, Error WalletAPIError,
           Error ClientError, Error ServerError, IO]
         (a, Wallets))
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     (a, Wallets)
forall a b. a -> (a -> b) -> b
& (Eff
   '[Error PABError, LogMsg Text, Error WalletAPIError,
     Error ClientError, Error ServerError, IO]
   (a, Wallets)
 -> (PABError
     -> Eff
          '[Error PABError, LogMsg Text, Error WalletAPIError,
            Error ClientError, Error ServerError, IO]
          (a, Wallets))
 -> Eff
      '[Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO]
      (a, Wallets))
-> (PABError
    -> Eff
         '[Error PABError, LogMsg Text, Error WalletAPIError,
           Error ClientError, Error ServerError, IO]
         (a, Wallets))
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     (a, Wallets)
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     (a, Wallets)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff
  '[Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  (a, Wallets)
-> (PABError
    -> Eff
         '[Error PABError, LogMsg Text, Error WalletAPIError,
           Error ClientError, Error ServerError, IO]
         (a, Wallets))
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     (a, Wallets)
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
Eff effs a -> (e -> Eff effs a) -> Eff effs a
catchError PABError
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     (a, Wallets)
forall (effs :: [* -> *]) b.
(FindElem (LogMsg Text) effs, FindElem (Error PABError) effs) =>
PABError -> Eff effs b
logPabErrorAndRethrow
    Eff
  '[Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  (a, Wallets)
-> (Eff
      '[Error PABError, LogMsg Text, Error WalletAPIError,
        Error ClientError, Error ServerError, IO]
      (a, Wallets)
    -> Eff
         '[LogMsg Text, Error WalletAPIError, Error ClientError,
           Error ServerError, IO]
         (a, Wallets))
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     (a, Wallets)
forall a b. a -> (a -> b) -> b
& Eff
  '[Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  (a, Wallets)
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     (a, Wallets)
forall a.
Eff
  '[Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  a
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
handlePrettyErrors
    Eff
  '[LogMsg Text, Error WalletAPIError, Error ClientError,
    Error ServerError, IO]
  (a, Wallets)
-> (Eff
      '[LogMsg Text, Error WalletAPIError, Error ClientError,
        Error ServerError, IO]
      (a, Wallets)
    -> Eff
         '[Error WalletAPIError, Error ClientError, Error ServerError, IO]
         (a, Wallets))
-> Eff
     '[Error WalletAPIError, Error ClientError, Error ServerError, IO]
     (a, Wallets)
forall a b. a -> (a -> b) -> b
& (LogMsg Text
 ~> Eff
      '[Error WalletAPIError, Error ClientError, Error ServerError, IO])
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
   ~> Eff
        '[Error WalletAPIError, Error ClientError, Error ServerError, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO Text
-> LogMsg Text
   ~> Eff
        '[Error WalletAPIError, Error ClientError, Error ServerError, IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace (Trace IO WalletMsg -> Trace IO Text
forall (m :: * -> *). Trace m WalletMsg -> Trace m Text
toWalletMsg Trace IO WalletMsg
trace))
    Eff
  '[Error WalletAPIError, Error ClientError, Error ServerError, IO]
  (a, Wallets)
-> (Eff
      '[Error WalletAPIError, Error ClientError, Error ServerError, IO]
      (a, Wallets)
    -> Eff '[Error ClientError, Error ServerError, IO] (a, Wallets))
-> Eff '[Error ClientError, Error ServerError, IO] (a, Wallets)
forall a b. a -> (a -> b) -> b
& Eff
  '[Error WalletAPIError, Error ClientError, Error ServerError, IO]
  (a, Wallets)
-> Eff '[Error ClientError, Error ServerError, IO] (a, Wallets)
forall a.
Eff
  '[Error WalletAPIError, Error ClientError, Error ServerError, IO] a
-> Eff '[Error ClientError, Error ServerError, IO] a
handleWalletApiErrors
    Eff '[Error ClientError, Error ServerError, IO] (a, Wallets)
-> (Eff '[Error ClientError, Error ServerError, IO] (a, Wallets)
    -> Eff '[Error ServerError, IO] (a, Wallets))
-> Eff '[Error ServerError, IO] (a, Wallets)
forall a b. a -> (a -> b) -> b
& Eff '[Error ClientError, Error ServerError, IO] (a, Wallets)
-> Eff '[Error ServerError, IO] (a, Wallets)
forall a.
Eff '[Error ClientError, Error ServerError, IO] a
-> Eff '[Error ServerError, IO] a
handleClientErrors
    Eff '[Error ServerError, IO] (a, Wallets)
-> (Eff '[Error ServerError, IO] (a, Wallets)
    -> Eff '[IO] (Either ServerError (a, Wallets)))
-> Eff '[IO] (Either ServerError (a, Wallets))
forall a b. a -> (a -> b) -> b
& Eff '[Error ServerError, IO] (a, Wallets)
-> Eff '[IO] (Either ServerError (a, Wallets))
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError
    Eff '[IO] (Either ServerError (a, Wallets))
-> (Eff '[IO] (Either ServerError (a, Wallets))
    -> IO (Either ServerError (a, Wallets)))
-> IO (Either ServerError (a, Wallets))
forall a b. a -> (a -> b) -> b
& Eff '[IO] (Either ServerError (a, Wallets))
-> IO (Either ServerError (a, Wallets))
forall (m :: * -> *) a. Monad m => Eff '[m] a -> m a
runM
        where
            handleWalletApiErrors :: Eff
  '[Error WalletAPIError, Error ClientError, Error ServerError, IO] a
-> Eff '[Error ClientError, Error ServerError, IO] a
handleWalletApiErrors = (Eff
   '[Error WalletAPIError, Error ClientError, Error ServerError, IO] a
 -> (WalletAPIError
     -> Eff '[Error ClientError, Error ServerError, IO] a)
 -> Eff '[Error ClientError, Error ServerError, IO] a)
-> (WalletAPIError
    -> Eff '[Error ClientError, Error ServerError, IO] a)
-> Eff
     '[Error WalletAPIError, Error ClientError, Error ServerError, IO] a
-> Eff '[Error ClientError, Error ServerError, IO] a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff
  '[Error WalletAPIError, Error ClientError, Error ServerError, IO] a
-> (WalletAPIError
    -> Eff '[Error ClientError, Error ServerError, IO] a)
-> Eff '[Error ClientError, Error ServerError, IO] a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError (ServerError -> Eff '[Error ClientError, Error ServerError, IO] a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (ServerError -> Eff '[Error ClientError, Error ServerError, IO] a)
-> (WalletAPIError -> ServerError)
-> WalletAPIError
-> Eff '[Error ClientError, Error ServerError, IO] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletAPIError -> ServerError
fromWalletAPIError)
            handleClientErrors :: Eff '[Error ClientError, Error ServerError, IO] a
-> Eff '[Error ServerError, IO] a
handleClientErrors = (Eff '[Error ClientError, Error ServerError, IO] a
 -> (ClientError -> Eff '[Error ServerError, IO] a)
 -> Eff '[Error ServerError, IO] a)
-> (ClientError -> Eff '[Error ServerError, IO] a)
-> Eff '[Error ClientError, Error ServerError, IO] a
-> Eff '[Error ServerError, IO] a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff '[Error ClientError, Error ServerError, IO] a
-> (ClientError -> Eff '[Error ServerError, IO] a)
-> Eff '[Error ServerError, IO] a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError (\ClientError
e -> ServerError -> Eff '[Error ServerError, IO] a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (ServerError -> Eff '[Error ServerError, IO] a)
-> ServerError -> Eff '[Error ServerError, IO] a
forall a b. (a -> b) -> a -> b
$ ServerError
err500 { errBody :: ByteString
errBody = String -> ByteString
Char8.pack (ClientError -> String
forall a. Show a => a -> String
show ClientError
e) })
            handlePrettyErrors :: Eff
  '[Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  a
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
handlePrettyErrors = (Eff
   '[Error PABError, LogMsg Text, Error WalletAPIError,
     Error ClientError, Error ServerError, IO]
   a
 -> (PABError
     -> Eff
          '[LogMsg Text, Error WalletAPIError, Error ClientError,
            Error ServerError, IO]
          a)
 -> Eff
      '[LogMsg Text, Error WalletAPIError, Error ClientError,
        Error ServerError, IO]
      a)
-> (PABError
    -> Eff
         '[LogMsg Text, Error WalletAPIError, Error ClientError,
           Error ServerError, IO]
         a)
-> Eff
     '[Error PABError, LogMsg Text, Error WalletAPIError,
       Error ClientError, Error ServerError, IO]
     a
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff
  '[Error PABError, LogMsg Text, Error WalletAPIError,
    Error ClientError, Error ServerError, IO]
  a
-> (PABError
    -> Eff
         '[LogMsg Text, Error WalletAPIError, Error ClientError,
           Error ServerError, IO]
         a)
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError (\PABError
e -> ServerError
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (ServerError
 -> Eff
      '[LogMsg Text, Error WalletAPIError, Error ClientError,
        Error ServerError, IO]
      a)
-> ServerError
-> Eff
     '[LogMsg Text, Error WalletAPIError, Error ClientError,
       Error ServerError, IO]
     a
forall a b. (a -> b) -> a -> b
$ ServerError
err500 { errBody :: ByteString
errBody = String -> ByteString
Char8.pack (Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ PABError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty PABError
e) })
            toWalletMsg :: Trace m WalletMsg -> Trace m Text
toWalletMsg = (Text -> WalletMsg) -> Trace m WalletMsg -> Trace m Text
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog Text -> WalletMsg
ChainClientMsg
            logPabErrorAndRethrow :: PABError -> Eff effs b
logPabErrorAndRethrow (PABError
e :: PABError) = do
                Text -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logError (String -> Text
pack (String -> Text) -> String -> Text
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
$ PABError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty PABError
e)
                PABError -> Eff effs b
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError PABError
e

-- | Convert Wallet errors to Servant error responses
fromWalletAPIError :: WalletAPIError -> ServerError
fromWalletAPIError :: WalletAPIError -> ServerError
fromWalletAPIError (InsufficientFunds Text
text) =
    ServerError
err401 {errBody :: ByteString
errBody = ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
text}
fromWalletAPIError e :: WalletAPIError
e@WalletAPIError
NoPaymentPubKeyHashError =
    ServerError
err404 {errBody :: ByteString
errBody = String -> ByteString
BSL8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ WalletAPIError -> String
forall a. Show a => a -> String
show WalletAPIError
e}
fromWalletAPIError e :: WalletAPIError
e@(PaymentPrivateKeyNotFound PaymentPubKeyHash
_) =
    ServerError
err404 {errBody :: ByteString
errBody = String -> ByteString
BSL8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ WalletAPIError -> String
forall a. Show a => a -> String
show WalletAPIError
e}
fromWalletAPIError e :: WalletAPIError
e@(ValidationError ValidationError
_) =
    ServerError
err500 {errBody :: ByteString
errBody = String -> ByteString
BSL8.pack (String -> ByteString) -> String -> ByteString
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
$ WalletAPIError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty WalletAPIError
e}
fromWalletAPIError e :: WalletAPIError
e@(ToCardanoError ToCardanoError
_) =
    ServerError
err500 {errBody :: ByteString
errBody = String -> ByteString
BSL8.pack (String -> ByteString) -> String -> ByteString
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
$ WalletAPIError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty WalletAPIError
e}
fromWalletAPIError e :: WalletAPIError
e@ChangeHasLessThanNAda {} =
    ServerError
err500 {errBody :: ByteString
errBody = String -> ByteString
BSL8.pack (String -> ByteString) -> String -> ByteString
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
$ WalletAPIError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty WalletAPIError
e}
fromWalletAPIError e :: WalletAPIError
e@PaymentMkTxError {} =
    ServerError
err500 {errBody :: ByteString
errBody = String -> ByteString
BSL8.pack (String -> ByteString) -> String -> ByteString
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
$ WalletAPIError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty WalletAPIError
e}
fromWalletAPIError e :: WalletAPIError
e@(RemoteClientFunctionNotYetSupported Text
_) =
    ServerError
err500 {errBody :: ByteString
errBody = String -> ByteString
BSL8.pack (String -> ByteString) -> String -> ByteString
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
$ WalletAPIError -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty WalletAPIError
e}
fromWalletAPIError (OtherError Text
text) =
    ServerError
err500 {errBody :: ByteString
errBody = ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
text}