{-# LANGUAGE TemplateHaskell #-}

module Tendermint.SDK.Modules.Auth.Keeper
  ( AuthEffs
  , Accounts(..)
  , createAccount
  , updateAccount
  , getAccount
  , eval
  -- stores
  , accountsMap
  ) where

import           Polysemy
import           Polysemy.Error                    (Error, mapError, throw)
import           Tendermint.SDK.BaseApp            (AppError, KeyRoot (..),
                                                    ReadStore, Store,
                                                    WriteStore, makeAppError,
                                                    makeStore)
import qualified Tendermint.SDK.BaseApp.Store.Map  as M
import           Tendermint.SDK.BaseApp.Store.TH   (makeSubStore)
import           Tendermint.SDK.Modules.Auth.Keys  (accountsKey)
import           Tendermint.SDK.Modules.Auth.Types

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

data AuthNamespace

store :: Store AuthNamespace
store :: Store AuthNamespace
store = KeyRoot AuthNamespace -> Store AuthNamespace
forall k (ns :: k). KeyRoot ns -> Store ns
makeStore (KeyRoot AuthNamespace -> Store AuthNamespace)
-> KeyRoot AuthNamespace -> Store AuthNamespace
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyRoot AuthNamespace
forall k (ns :: k). ByteString -> KeyRoot ns
KeyRoot "auth"

$(makeSubStore 'store "accountsMap" [t| M.Map Address Account|] accountsKey)

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

data Accounts m a where
  CreateAccount :: Address -> Accounts m Account
  UpdateAccount :: Address -> (Account -> Account) -> Accounts m ()
  GetAccount :: Address -> Accounts m (Maybe Account)

makeSem ''Accounts

type AuthEffs = '[Accounts, Error AuthError]

eval
  :: Members [ReadStore, WriteStore, Error AppError] r
  => Sem (Accounts : Error AuthError : r) a
  -> Sem r a
eval :: Sem (Accounts : Error AuthError : r) a -> Sem r a
eval = (AuthError -> AppError) -> Sem (Error AuthError : 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 AuthError -> AppError
forall e. IsAppError e => e -> AppError
makeAppError (Sem (Error AuthError : r) a -> Sem r a)
-> (Sem (Accounts : Error AuthError : r) a
    -> Sem (Error AuthError : r) a)
-> Sem (Accounts : Error AuthError : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Accounts : Error AuthError : r) a
-> Sem (Error AuthError : r) a
forall (r :: [(* -> *) -> * -> *]) a.
Members
  '[ReadStore, WriteStore, Error AuthError, Error AppError] r =>
Sem (Accounts : r) a -> Sem r a
evalAuth
  where
    evalAuth :: Members [ReadStore, WriteStore, Error AuthError, Error AppError] r
             => Sem (Accounts : r) a
             -> Sem r a
    evalAuth :: Sem (Accounts : r) a -> Sem r a
evalAuth =
      (forall x (m :: * -> *). Accounts m x -> Sem r x)
-> Sem (Accounts : 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
          CreateAccount addr -> Address -> Sem r Account
forall (r :: [(* -> *) -> * -> *]).
Members
  '[ReadStore, WriteStore, Error AppError, Error AuthError] r =>
Address -> Sem r Account
createAccountF Address
addr
          UpdateAccount addr f -> Address -> (Account -> Account) -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members
  '[ReadStore, WriteStore, Error AppError, Error AuthError] r =>
Address -> (Account -> Account) -> Sem r ()
updateAccountF Address
addr Account -> Account
f
          GetAccount addr -> Address -> Sem r (Maybe Account)
forall (r :: [(* -> *) -> * -> *]).
Members '[ReadStore, Error AppError] r =>
Address -> Sem r (Maybe Account)
getAccountF Address
addr
        )

createAccountF
  :: Members [ReadStore, WriteStore, Error AppError, Error AuthError] r
  => Address
  -> Sem r Account
createAccountF :: Address -> Sem r Account
createAccountF addr :: Address
addr = do
  Maybe Account
mAcct <- Address -> Map Address Account -> Sem r (Maybe Account)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Address
addr Map Address Account
accountsMap
  case Maybe Account
mAcct of
    Just _ -> AuthError -> Sem r Account
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (AuthError -> Sem r Account) -> AuthError -> Sem r Account
forall a b. (a -> b) -> a -> b
$ Address -> AuthError
AccountAlreadyExists Address
addr
    Nothing -> do
      let emptyAccount :: Account
emptyAccount = Account :: [Coin] -> Word64 -> Account
Account
            { accountCoins :: [Coin]
accountCoins = []
            , accountNonce :: Word64
accountNonce = 0
            }
      Address -> Account -> Map Address Account -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
M.insert Address
addr Account
emptyAccount Map Address Account
accountsMap
      Account -> Sem r Account
forall (f :: * -> *) a. Applicative f => a -> f a
pure Account
emptyAccount

updateAccountF
  :: Members [ReadStore, WriteStore, Error AppError, Error AuthError] r
  => Address
  -> (Account -> Account)
  -> Sem r ()
updateAccountF :: Address -> (Account -> Account) -> Sem r ()
updateAccountF addr :: Address
addr f :: Account -> Account
f = do
  Maybe Account
mAcct <- Address -> Map Address Account -> Sem r (Maybe Account)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Address
addr Map Address Account
accountsMap
  case Maybe Account
mAcct of
    Nothing   -> AuthError -> Sem r ()
forall e (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw (AuthError -> Sem r ()) -> AuthError -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Address -> AuthError
AccountNotFound Address
addr
    Just acct :: Account
acct -> Address -> Account -> Map Address Account -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
M.insert Address
addr (Account -> Account
f Account
acct) Map Address Account
accountsMap

getAccountF
  :: Members [ReadStore, Error AppError] r
  => Address
  -> Sem r (Maybe Account)
getAccountF :: Address -> Sem r (Maybe Account)
getAccountF addr :: Address
addr = Address -> Map Address Account -> Sem r (Maybe Account)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Address
addr Map Address Account
accountsMap