From 3b738e0d4cc65f314da7389d4542ec826ba0f454 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 5 Sep 2015 13:53:36 +0200 Subject: Using UserId instead of UserName to indentify users --- src/server/Controller/Index.hs | 38 -------------------------------------- src/server/Controller/User.hs | 25 +++++++++++++++++++++++++ 2 files changed, 25 insertions(+), 38 deletions(-) create mode 100644 src/server/Controller/User.hs (limited to 'src/server/Controller') diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs index 2d8c40c..17f5ae9 100644 --- a/src/server/Controller/Index.hs +++ b/src/server/Controller/Index.hs @@ -1,58 +1,20 @@ module Controller.Index ( getIndexAction - , getUserName , signOutAction - , getUsersAction - , addUserAction - , deleteUserAction ) where import Web.Scotty import Network.HTTP.Types.Status (ok200) -import Database.Persist - -import Control.Monad.IO.Class (liftIO) - -import Data.Text (Text) -import Data.String (fromString) - import qualified LoginSession -import qualified Secure - -import Model.Database -import Model.User -import Model.Json.Message - import View.Page (page) getIndexAction :: ActionM () getIndexAction = html page -getUserName :: ActionM () -getUserName = - Secure.loggedAction (\user -> do - json . Message . userName . entityVal $ user - ) - signOutAction :: ActionM () signOutAction = do LoginSession.delete status ok200 - -getUsersAction :: ActionM () -getUsersAction = do - users <- liftIO $ runDb getUsers - html . fromString . show $ users - -addUserAction :: Text -> Text -> ActionM () -addUserAction email name = do - _ <- liftIO . runDb $ createUser email name - status ok200 - -deleteUserAction :: Text -> ActionM () -deleteUserAction email = do - _ <- liftIO . runDb $ deleteUser email - status ok200 diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs new file mode 100644 index 0000000..95e5fa8 --- /dev/null +++ b/src/server/Controller/User.hs @@ -0,0 +1,25 @@ +module Controller.User + ( getUsersAction + , whoAmIAction + ) where + +import Web.Scotty + +import Control.Monad.IO.Class (liftIO) + +import qualified Secure + +import Model.Database +import Model.User + +getUsersAction :: ActionM () +getUsersAction = + Secure.loggedAction (\_ -> do + (liftIO $ map getJsonUser <$> runDb getUsers) >>= json + ) + +whoAmIAction :: ActionM () +whoAmIAction = + Secure.loggedAction (\user -> do + json (getJsonUser user) + ) -- cgit v1.2.3