diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/server/Application.hs | 40 | ||||
| -rw-r--r-- | src/server/Main.hs | 30 |
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 |