blob: db734744c5edf8a344c370d4f553e3b3773d765a (
plain)
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
|
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative (liftA3)
import Control.Monad.IO.Class (liftIO)
import Network.Wai.Middleware.Static
import qualified Data.Text.Lazy as LT
import Web.Scotty
import qualified Conf
import qualified Controller.Category as Category
import qualified Controller.Income as Income
import qualified Controller.Index as Index
import qualified Controller.Payment as Payment
import qualified Controller.SignIn as SignIn
import Job.Daemon (runDaemons)
import Model.Payer (getOrderedExceedingPayers)
import qualified Data.Time as Time
import qualified Model.User as UserM
import qualified Model.Income as IncomeM
import qualified Model.Payment as PaymentM
import qualified Model.Query as Query
main :: IO ()
main = do
conf <- Conf.get "application.conf"
_ <- runDaemons conf
scotty (Conf.port conf) $ do
middleware . staticPolicy $ noDots >-> addBase "public"
get "/exceedingPayer" $ do
time <- liftIO Time.getCurrentTime
(users, incomes, payments) <- liftIO . Query.run $
liftA3 (,,) UserM.list IncomeM.list PaymentM.list
let exceedingPayers = getOrderedExceedingPayers time users incomes payments
text . LT.pack . show $ exceedingPayers
get "/" $ do
signInToken <- mbParam "signInToken"
Index.get conf signInToken
post "/signIn" $ do
jsonData >>= SignIn.signIn conf
post "/signOut" $
Index.signOut conf
post "/payment" $
jsonData >>= Payment.create
put "/payment" $
jsonData >>= Payment.editOwn
delete "/payment" $ do
paymentId <- param "id"
Payment.deleteOwn paymentId
post "/income" $
jsonData >>= Income.create
put "/income" $
jsonData >>= Income.editOwn
delete "/income" $ do
incomeId <- param "id"
Income.deleteOwn incomeId
post "/category" $
jsonData >>= Category.create
put "/category" $
jsonData >>= Category.edit
delete "/category" $ do
categoryId <- param "id"
Category.delete categoryId
mbParam :: Parsable a => LT.Text -> ActionM (Maybe a)
mbParam key = (Just <$> param key) `rescue` (const . return $ Nothing)
|
