blob: 5ac68dbb79b51487fa668868a459ea1d0b293987 (
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
80
81
82
|
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative (liftA3)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text.Lazy as LT
import Network.Wai.Middleware.Gzip (GzipFiles (GzipCompress))
import qualified Network.Wai.Middleware.Gzip as W
import Network.Wai.Middleware.Static
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 qualified Data.Time as Time
import Job.Daemon (runDaemons)
import qualified Model.Income as IncomeM
import Model.Payer (getOrderedExceedingPayers)
import qualified Model.Payment as PaymentM
import qualified Model.Query as Query
import qualified Model.User as UserM
main :: IO ()
main = do
conf <- Conf.get "application.conf"
_ <- runDaemons conf
scotty (Conf.port conf) $ do
middleware $ W.gzip $ W.def { W.gzipFiles = GzipCompress }
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)
|
