-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathMain.hs
45 lines (37 loc) · 1.61 KB
/
Main.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
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.ConfigFile (emptyCP, readfile, simpleAccess)
import Data.Monoid ((<>))
import Data.Tuple.Sequence (sequenceT)
import Hasql.Pool (release)
import Network.Wai.Middleware.RequestLogger (logStdout)
import System.Exit (die)
import Web.Scotty (ActionM, get, liftAndCatchIO, middleware, next, notFound, post, put, request, scotty)
import DBHelpers (dbPool)
import Endpoints (handleLogin, homepage, noteConsumption)
dieOnConfigError = let handleError cpError = die $ concat ["There was a config file error: ", show $ fst cpError, " ", snd cpError]
in either handleError return
configurationParser fileName = do
eitherErrorParser <- readfile emptyCP fileName
dieOnConfigError eitherErrorParser
main = do
conf <- configurationParser "defaults.config"
dbSettings <- let dbConf = dieOnConfigError . (simpleAccess conf "DatabaseConnectionPool")
in sequenceT (
dbConf "maxconnections",
dbConf "maxidleseconds",
dbConf "host",
dbConf "port",
dbConf "user",
dbConf "password",
dbConf "database"
)
pool <- dbPool dbSettings
baseURL <- dieOnConfigError $ simpleAccess conf "SiteSettings" "baseurl"
port <- fmap read $ dieOnConfigError $ simpleAccess conf "SiteSettings" "port" -- deliberatly unsafe.
scotty port $ do
middleware logStdout
get "/" $ homepage pool baseURL
post "/login" $ handleLogin pool
get "/consume" $ noteConsumption pool
release pool -- should we do this?