From 89dd4de13896f8e37d1bf133080eb881ab42b292 Mon Sep 17 00:00:00 2001 From: Joris Guyonvarch Date: Sat, 18 Jul 2015 15:19:48 +0200 Subject: Adding login/logout functions thanks to a client session --- src/server/Application.hs | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) (limited to 'src/server/Application.hs') 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" -- cgit v1.2.3