-
Notifications
You must be signed in to change notification settings - Fork 10
/
Keeper.hs
92 lines (78 loc) · 2.77 KB
/
Keeper.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
{-# 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 = makeStore $ 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 = mapError makeAppError . evalAuth
where
evalAuth :: Members [ReadStore, WriteStore, Error AuthError, Error AppError] r
=> Sem (Accounts : r) a
-> Sem r a
evalAuth =
interpret (\case
CreateAccount addr -> createAccountF addr
UpdateAccount addr f -> updateAccountF addr f
GetAccount addr -> getAccountF addr
)
createAccountF
:: Members [ReadStore, WriteStore, Error AppError, Error AuthError] r
=> Address
-> Sem r Account
createAccountF addr = do
mAcct <- M.lookup addr accountsMap
case mAcct of
Just _ -> throw $ AccountAlreadyExists addr
Nothing -> do
let emptyAccount = Account
{ accountCoins = []
, accountNonce = 0
}
M.insert addr emptyAccount accountsMap
pure emptyAccount
updateAccountF
:: Members [ReadStore, WriteStore, Error AppError, Error AuthError] r
=> Address
-> (Account -> Account)
-> Sem r ()
updateAccountF addr f = do
mAcct <- M.lookup addr accountsMap
case mAcct of
Nothing -> throw $ AccountNotFound addr
Just acct -> M.insert addr (f acct) accountsMap
getAccountF
:: Members [ReadStore, Error AppError] r
=> Address
-> Sem r (Maybe Account)
getAccountF addr = M.lookup addr accountsMap