aboutsummaryrefslogtreecommitdiff
path: root/src/server
diff options
context:
space:
mode:
Diffstat (limited to 'src/server')
-rw-r--r--src/server/Application.hs22
-rw-r--r--src/server/Design/Global.hs33
-rw-r--r--src/server/Main.hs16
3 files changed, 39 insertions, 32 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs
index 7e93fe1..24342dc 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -69,16 +69,18 @@ deleteUserAction email = do
_ <- liftIO . runDb $ deleteUser email
status ok200
-createPaymentAction :: Text -> Text -> Int -> ActionM ()
-createPaymentAction email name cost = do
- maybeUser <- liftIO . runDb $ getUser email
- case maybeUser of
- Just user -> do
- _ <- liftIO . runDb $ createPayment (entityKey user) name cost
- return ()
- Nothing -> do
- status badRequest400
- status ok200
+createPaymentAction :: Text -> Int -> ActionM ()
+createPaymentAction name cost =
+ Secure.loggedAction (\login -> do
+ maybeUser <- liftIO . runDb $ getUser login
+ case maybeUser of
+ Just user -> do
+ _ <- liftIO . runDb $ createPayment (entityKey user) name cost
+ return ()
+ Nothing -> do
+ status badRequest400
+ status ok200
+ )
signInAction :: Text -> ActionM ()
signInAction login =
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 6985174..9d096e4 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -51,21 +51,26 @@ global = do
fontSize (px iconFontSize)
hover & transform (scale 1.2 1.2)
- table ? do
- width (pct 100)
- textAlign (alignSide (sideCenter))
- "border-spacing" -: "10 px"
-
- th ? do
- backgroundColor C.brown
- color C.white
- fontSize (px iconFontSize)
- lineHeight (px 70)
+ ".payments" ? do
+ ".add" ? do
+ marginBottom (px 20)
+ marginLeft (px 20)
+
+ table ? do
+ width (pct 100)
+ textAlign (alignSide (sideCenter))
+ "border-spacing" -: "10 px"
+
+ th ? do
+ backgroundColor C.brown
+ color C.white
+ fontSize (px iconFontSize)
+ lineHeight (px 70)
- tr ? do
- fontSize (px 20)
- lineHeight (px 60)
- nthChild "odd" & backgroundColor C.lightGrey
+ tr ? do
+ fontSize (px 20)
+ lineHeight (px 60)
+ nthChild "odd" & backgroundColor C.lightGrey
".signIn" ? do
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 7fd42a7..d534c4e 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -29,12 +29,17 @@ main = do
token <- param "token" :: ActionM Text
validateSignInAction token
- post "/signOut" $
- signOutAction
-
get "/payments" $
getPaymentsAction
+ post "/payment/add" $ do
+ name <- param "name" :: ActionM Text
+ cost <- param "cost" :: ActionM Int
+ createPaymentAction name cost
+
+ post "/signOut" $
+ signOutAction
+
get "/users" getUsersAction
post "/user/add" $ do
email <- param "email" :: ActionM Text
@@ -43,8 +48,3 @@ main = do
post "/user/delete" $ do
email <- param "email" :: ActionM Text
deleteUserAction email
- post "/payment/add" $ do
- email <- param "email" :: ActionM Text
- name <- param "name" :: ActionM Text
- cost <- param "cost" :: ActionM Int
- createPaymentAction email name cost