{-# LANGUAGE TemplateHaskell #-}

module Tendermint.SDK.Modules.Bank.Keeper
  ( BankEffs
  , BankKeeper(..)
  , getBalance
  , transfer
  , burn
  , mint
  , eval
  ) where

import           Data.List                         (find)
import           Data.Maybe                        (fromMaybe)
import           Polysemy
import           Polysemy.Error                    (Error, mapError, throw)
import           Polysemy.Output                   (Output)
import qualified Tendermint.SDK.BaseApp            as BaseApp
import qualified Tendermint.SDK.Modules.Auth       as Auth
import           Tendermint.SDK.Modules.Bank.Types (BankError (..),
                                                    TransferEvent (..))
import           Tendermint.SDK.Types.Address      (Address)

type BankEffs = '[BankKeeper, Error BankError]

data BankKeeper m a where
  GetBalance :: Address -> Auth.CoinId -> BankKeeper m Auth.Coin
  Transfer :: Address -> Auth.Coin -> Address -> BankKeeper m ()
  Burn :: Address -> Auth.Coin -> BankKeeper m ()
  Mint :: Address -> Auth.Coin -> BankKeeper m ()

makeSem ''BankKeeper

eval
  :: Members [BaseApp.Logger, Output BaseApp.Event, Error BaseApp.AppError] r
  => Members Auth.AuthEffs r
  => forall a. Sem (BankKeeper ': Error BankError ': r) a -> Sem r a
eval :: forall a. Sem (BankKeeper : Error BankError : r) a -> Sem r a
eval = (BankError -> AppError) -> Sem (Error BankError : r) a -> Sem r a
forall e1 e2 (r :: [(* -> *) -> * -> *]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError BankError -> AppError
forall e. IsAppError e => e -> AppError
BaseApp.makeAppError (Sem (Error BankError : r) a -> Sem r a)
-> (Sem (BankKeeper : Error BankError : r) a
    -> Sem (Error BankError : r) a)
-> Sem (BankKeeper : Error BankError : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (BankKeeper : Error BankError : r) a
-> Sem (Error BankError : r) a
forall (r :: [(* -> *) -> * -> *]) a.
(Members AuthEffs r,
 Members '[Logger, Output Event, Error BankError] r) =>
Sem (BankKeeper : r) a -> Sem r a
evalBankKeeper
  where
    evalBankKeeper
      :: forall r.
         Members Auth.AuthEffs r
      => Members [BaseApp.Logger, Output BaseApp.Event, Error BankError ] r
      => forall a.
         Sem (BankKeeper ': r) a
      -> Sem r a
    evalBankKeeper :: forall a. Sem (BankKeeper : r) a -> Sem r a
evalBankKeeper = (forall x (m :: * -> *). BankKeeper m x -> Sem r x)
-> Sem (BankKeeper : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\case
      GetBalance addr coinId -> Address -> CoinId -> Sem r Coin
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> CoinId -> Sem r Coin
getCoinBalance Address
addr CoinId
coinId
      Transfer from coin to -> Address -> Coin -> Address -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
(Members '[Logger, Output Event, Error BankError] r,
 Members AuthEffs r) =>
Address -> Coin -> Address -> Sem r ()
transferF Address
from Coin
coin Address
to
      Burn addr coin -> Address -> Coin -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
(Members AuthEffs r, Member (Error BankError) r) =>
Address -> Coin -> Sem r ()
burnF Address
addr Coin
coin
      Mint addr coin -> Address -> Coin -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> Coin -> Sem r ()
mintF Address
addr Coin
coin
      )

--------------------------------------------------------------------------------

transferF
  :: Members [BaseApp.Logger, Output BaseApp.Event, Error BankError] r
  => Members Auth.AuthEffs r
  => Address
  -> Auth.Coin
  -> Address
  -> Sem r ()
transferF :: Address -> Coin -> Address -> Sem r ()
transferF addr1 :: Address
addr1 (Auth.Coin cid :: CoinId
cid amount :: Amount
amount) addr2 :: Address
addr2 = do
  -- check if addr1 has amt
  (Auth.Coin _ addr1Bal :: Amount
addr1Bal) <- Address -> CoinId -> Sem r Coin
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> CoinId -> Sem r Coin
getCoinBalance Address
addr1 CoinId
cid
  if Amount
addr1Bal Amount -> Amount -> Bool
forall a. Ord a => a -> a -> Bool
>= Amount
amount
    then do
      (Auth.Coin _ addr2Bal :: Amount
addr2Bal) <- Address -> CoinId -> Sem r Coin
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> CoinId -> Sem r Coin
getCoinBalance Address
addr2 CoinId
cid
      let newCoinBalance1 :: Coin
newCoinBalance1 = CoinId -> Amount -> Coin
Auth.Coin CoinId
cid (Amount
addr1Bal Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Amount
amount)
          newCoinBalance2 :: Coin
newCoinBalance2 = CoinId -> Amount -> Coin
Auth.Coin CoinId
cid (Amount
addr2Bal Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
amount)
      -- update both balances
      Address -> Coin -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> Coin -> Sem r ()
putCoinBalance Address
addr1 Coin
newCoinBalance1
      Address -> Coin -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> Coin -> Sem r ()
putCoinBalance Address
addr2 Coin
newCoinBalance2
      let event :: TransferEvent
event = TransferEvent :: CoinId -> Amount -> Address -> Address -> TransferEvent
TransferEvent
            { transferEventAmount :: Amount
transferEventAmount = Amount
amount
            , transferEventCoinId :: CoinId
transferEventCoinId = CoinId
cid
            , transferEventTo :: Address
transferEventTo = Address
addr2
            , transferEventFrom :: Address
transferEventFrom = Address
addr1
            }
      TransferEvent -> Sem r ()
forall e (r :: [(* -> *) -> * -> *]).
(ToEvent e, Member (Output Event) r) =>
e -> Sem r ()
BaseApp.emit TransferEvent
event
      TransferEvent -> Sem r ()
forall e (r :: [(* -> *) -> * -> *]).
(ToJSON e, ToEvent e, Select e, Member Logger r) =>
e -> Sem r ()
BaseApp.logEvent TransferEvent
event
    else BankError -> Sem r ()
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw @BankError (Text -> BankError
InsufficientFunds "Insufficient funds for transfer.")

burnF
  :: Members Auth.AuthEffs r
  => Member (Error BankError) r
  => Address
  -> Auth.Coin
  -> Sem r ()
burnF :: Address -> Coin -> Sem r ()
burnF addr :: Address
addr (Auth.Coin cid :: CoinId
cid amount :: Amount
amount) = do
  (Auth.Coin _ bal :: Amount
bal) <- Address -> CoinId -> Sem r Coin
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> CoinId -> Sem r Coin
getCoinBalance Address
addr CoinId
cid
  if Amount
bal Amount -> Amount -> Bool
forall a. Ord a => a -> a -> Bool
< Amount
amount
    then forall (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error BankError) r =>
BankError -> Sem r a
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw @BankError (BankError -> Sem r ()) -> BankError -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> BankError
InsufficientFunds "Insufficient funds for burn."
    else Address -> Coin -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> Coin -> Sem r ()
putCoinBalance Address
addr (CoinId -> Amount -> Coin
Auth.Coin CoinId
cid (Amount
bal Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
- Amount
amount))

mintF
  :: Members Auth.AuthEffs r
  => Address
  -> Auth.Coin
  -> Sem r ()
mintF :: Address -> Coin -> Sem r ()
mintF addr :: Address
addr (Auth.Coin cid :: CoinId
cid amount :: Amount
amount) = do
  (Auth.Coin _ bal :: Amount
bal) <- Address -> CoinId -> Sem r Coin
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> CoinId -> Sem r Coin
getCoinBalance Address
addr CoinId
cid
  Address -> Coin -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members AuthEffs r =>
Address -> Coin -> Sem r ()
putCoinBalance Address
addr (CoinId -> Amount -> Coin
Auth.Coin CoinId
cid (Amount
bal Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
amount))

--------------------------------------------------------------------------------

getCoinBalance
  :: Members Auth.AuthEffs r
  => Address
  -> Auth.CoinId
  -> Sem r Auth.Coin
getCoinBalance :: Address -> CoinId -> Sem r Coin
getCoinBalance address :: Address
address cid :: CoinId
cid = do
  Maybe Account
mAcnt <- Address -> Sem r (Maybe Account)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Accounts r =>
Address -> Sem r (Maybe Account)
Auth.getAccount Address
address
  let zeroBalance :: Coin
zeroBalance = CoinId -> Amount -> Coin
Auth.Coin CoinId
cid 0
  case Maybe Account
mAcnt of
    Nothing -> Coin -> Sem r Coin
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
zeroBalance
    Just (Auth.Account coins :: [Coin]
coins _) ->
      let mCoin :: Maybe Coin
mCoin = (Coin -> Bool) -> [Coin] -> Maybe Coin
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Auth.Coin cid1 :: CoinId
cid1 _) -> CoinId
cid CoinId -> CoinId -> Bool
forall a. Eq a => a -> a -> Bool
== CoinId
cid1) [Coin]
coins
      in Coin -> Sem r Coin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Coin -> Sem r Coin) -> Coin -> Sem r Coin
forall a b. (a -> b) -> a -> b
$ Coin -> Maybe Coin -> Coin
forall a. a -> Maybe a -> a
fromMaybe Coin
zeroBalance Maybe Coin
mCoin

replaceCoinValue
  :: Auth.Coin
  -> [Auth.Coin]
  -> [Auth.Coin]
replaceCoinValue :: Coin -> [Coin] -> [Coin]
replaceCoinValue c :: Coin
c [] = [Coin
c]
replaceCoinValue c :: Coin
c@(Auth.Coin cid :: CoinId
cid _) (c1 :: Coin
c1@(Auth.Coin cid' :: CoinId
cid' _):rest :: [Coin]
rest) =
  if CoinId
cid' CoinId -> CoinId -> Bool
forall a. Eq a => a -> a -> Bool
== CoinId
cid
  then Coin
c Coin -> [Coin] -> [Coin]
forall a. a -> [a] -> [a]
: [Coin]
rest
  else Coin
c1 Coin -> [Coin] -> [Coin]
forall a. a -> [a] -> [a]
: Coin -> [Coin] -> [Coin]
replaceCoinValue Coin
c [Coin]
rest

putCoinBalance
  :: Members Auth.AuthEffs r
  => Address
  -> Auth.Coin
  -> Sem r ()
putCoinBalance :: Address -> Coin -> Sem r ()
putCoinBalance address :: Address
address coin :: Coin
coin = do
  Maybe Account
mAcnt <- Address -> Sem r (Maybe Account)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Accounts r =>
Address -> Sem r (Maybe Account)
Auth.getAccount Address
address
  Account
acnt <- case Maybe Account
mAcnt of
            Nothing -> Address -> Sem r Account
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Accounts r =>
Address -> Sem r Account
Auth.createAccount Address
address
            Just a :: Account
a  -> Account -> Sem r Account
forall (f :: * -> *) a. Applicative f => a -> f a
pure Account
a
  let f :: Account -> Account
f a :: Account
a = Account
a { accountCoins :: [Coin]
Auth.accountCoins = Coin -> [Coin] -> [Coin]
replaceCoinValue Coin
coin ([Coin] -> [Coin]) -> [Coin] -> [Coin]
forall a b. (a -> b) -> a -> b
$ Account -> [Coin]
Auth.accountCoins Account
acnt }
  Address -> (Account -> Account) -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Accounts r =>
Address -> (Account -> Account) -> Sem r ()
Auth.updateAccount Address
address Account -> Account
f