diff options
author | Joris Guyonvarch | 2015-07-18 15:19:48 +0200 |
---|---|---|
committer | Joris Guyonvarch | 2015-07-18 15:19:48 +0200 |
commit | 89dd4de13896f8e37d1bf133080eb881ab42b292 (patch) | |
tree | f7d8cc5f412355524ef5b3f128aa09fce89c0afa /src/server/Application.hs | |
parent | 0041c546869f0a7fd59a085cc75b481237b6c380 (diff) |
Adding login/logout functions thanks to a client session
Diffstat (limited to 'src/server/Application.hs')
-rw-r--r-- | src/server/Application.hs | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs index 344b38c..377d1ff 100644 --- a/src/server/Application.hs +++ b/src/server/Application.hs @@ -7,6 +7,10 @@ module Application , addUserAction , deleteUserAction , insertPaymentAction + + , signIn + , checkConnection + , signOut ) where import Web.Scotty @@ -18,14 +22,17 @@ import Database.Persist import Control.Monad.IO.Class (liftIO) import Data.Text (Text) +import qualified Data.Text as T import Data.String (fromString) +import qualified Data.Text.Lazy as TL + +import qualified LoginSession import Model.Database (runDb) import Model.User import Model.Payment import View.Page (page) - getIndexAction :: ActionM () getIndexAction = do html $ page @@ -60,3 +67,28 @@ insertPaymentAction email name cost = do Nothing -> do status badRequest400 html "Not found" + +signIn :: Text -> ActionM () +signIn value = do + LoginSession.put value + 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 + status badRequest400 + html "You are not connected" + +signOut :: ActionM () +signOut = do + LoginSession.delete + html "Ok" |