aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/server/Application.hs40
-rw-r--r--src/server/Main.hs30
2 files changed, 31 insertions, 39 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs
index e480533..28ad3cd 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -1,21 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
module Application
- ( getIndexAction
+ ( signIn
+ , signOut
+ , getIndexAction
, getUsersAction
, getPaymentsAction
, addUserAction
, deleteUserAction
, insertPaymentAction
-
- , signIn
- , checkConnection
- , signOut
) where
import Web.Scotty
-import Network.HTTP.Types.Status (badRequest400)
+import Network.HTTP.Types.Status (ok200, badRequest400)
import Database.Persist
@@ -54,12 +52,12 @@ getPaymentsAction =
addUserAction :: Text -> Text -> ActionM ()
addUserAction email name = do
_ <- liftIO . runDb $ insertUser email name
- html "Ok"
+ status ok200
deleteUserAction :: Text -> ActionM ()
deleteUserAction email = do
_ <- liftIO . runDb $ deleteUser email
- html "Ok"
+ status ok200
insertPaymentAction :: Text -> Text -> Int -> ActionM ()
insertPaymentAction email name cost = do
@@ -70,29 +68,19 @@ insertPaymentAction email name cost = do
return ()
Nothing -> do
status badRequest400
- html "Not found"
+ status ok200
signIn :: Text -> ActionM ()
signIn login = do
- LoginSession.put login
- html "Ok"
-
-checkConnection :: ActionM ()
-checkConnection = do
- maybeLogin <- LoginSession.get
- case maybeLogin of
- Just login ->
- html . TL.fromStrict $
- T.intercalate
- " "
- [ "You are connected with the following login:"
- , login
- ]
- Nothing -> do
+ maybeUser <- liftIO . runDb $ getUser login
+ case maybeUser of
+ Just _ -> do
+ LoginSession.put login
+ status ok200
+ Nothing ->
status badRequest400
- html "You are not connected"
signOut :: ActionM ()
signOut = do
LoginSession.delete
- html "Ok"
+ status ok200
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 8d5a625..4461945 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -14,10 +14,24 @@ main :: IO ()
main = do
runMigrations
scotty 3000 $ do
- middleware $ staticPolicy (noDots >-> addBase "public")
- get "/" getIndexAction
+
+ middleware $
+ staticPolicy (noDots >-> addBase "public")
+
+ get "/" $
+ getIndexAction
+
+ post "/signIn" $ do
+ login <- param "login" :: ActionM Text
+ signIn login
+
+ post "/signOut" $
+ signOut
+
+ get "/payments" $
+ getPaymentsAction
+
get "/users" getUsersAction
- get "/payments" getPaymentsAction
post "/user/add" $ do
email <- param "email" :: ActionM Text
name <- param "name" :: ActionM Text
@@ -30,13 +44,3 @@ main = do
name <- param "name" :: ActionM Text
cost <- param "cost" :: ActionM Int
insertPaymentAction email name cost
-
- post "/signIn" $ do
- login <- param "login" :: ActionM Text
- signIn login
-
- post "/checkConnection" $
- checkConnection
-
- post "/signOut" $
- signOut