From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 8 Nov 2017 23:47:26 +0100 Subject: Use a better project structure --- server/src/Secure.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 server/src/Secure.hs (limited to 'server/src/Secure.hs') diff --git a/server/src/Secure.hs b/server/src/Secure.hs new file mode 100644 index 0000000..f427304 --- /dev/null +++ b/server/src/Secure.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Secure + ( loggedAction + , getUserFromToken + ) where + +import Control.Monad.IO.Class (liftIO) +import Data.Text (Text) +import Data.Text.Lazy (fromStrict) +import Network.HTTP.Types.Status (forbidden403) +import Web.Scotty + +import qualified Common.Message as Message +import qualified Common.Message.Key as Key +import Common.Model (User) + +import Model.Query (Query) +import qualified LoginSession +import qualified Model.Query as Query +import qualified Model.SignIn as SignIn +import qualified Model.User as User + +loggedAction :: (User -> ActionM ()) -> ActionM () +loggedAction action = do + maybeToken <- LoginSession.get + case maybeToken of + Just token -> do + maybeUser <- liftIO . Query.run . getUserFromToken $ token + case maybeUser of + Just user -> + action user + Nothing -> do + status forbidden403 + html . fromStrict . Message.get $ Key.Secure_Unauthorized + Nothing -> do + status forbidden403 + html . fromStrict . Message.get $ Key.Secure_Forbidden + +getUserFromToken :: Text -> Query (Maybe User) +getUserFromToken token = do + mbSignIn <- SignIn.getSignIn token + case mbSignIn of + Just signIn -> + User.get (SignIn.email signIn) + Nothing -> + return Nothing -- cgit v1.2.3 From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 13 Nov 2017 23:56:40 +0100 Subject: Setup stylish-haskell --- server/src/Secure.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'server/src/Secure.hs') diff --git a/server/src/Secure.hs b/server/src/Secure.hs index f427304..88bdcda 100644 --- a/server/src/Secure.hs +++ b/server/src/Secure.hs @@ -5,21 +5,21 @@ module Secure , getUserFromToken ) where -import Control.Monad.IO.Class (liftIO) -import Data.Text (Text) -import Data.Text.Lazy (fromStrict) -import Network.HTTP.Types.Status (forbidden403) -import Web.Scotty +import Control.Monad.IO.Class (liftIO) +import Data.Text (Text) +import Data.Text.Lazy (fromStrict) +import Network.HTTP.Types.Status (forbidden403) +import Web.Scotty -import qualified Common.Message as Message -import qualified Common.Message.Key as Key -import Common.Model (User) +import qualified Common.Message as Message +import qualified Common.Message.Key as Key +import Common.Model (User) -import Model.Query (Query) import qualified LoginSession -import qualified Model.Query as Query -import qualified Model.SignIn as SignIn -import qualified Model.User as User +import Model.Query (Query) +import qualified Model.Query as Query +import qualified Model.SignIn as SignIn +import qualified Model.User as User loggedAction :: (User -> ActionM ()) -> ActionM () loggedAction action = do -- cgit v1.2.3 From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 00:20:25 +0100 Subject: Show payment count and partition - Also fixes exceedingPayer in back by using only punctual payments --- server/src/Secure.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'server/src/Secure.hs') diff --git a/server/src/Secure.hs b/server/src/Secure.hs index 88bdcda..6e5b998 100644 --- a/server/src/Secure.hs +++ b/server/src/Secure.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Secure ( loggedAction , getUserFromToken @@ -11,9 +9,8 @@ import Data.Text.Lazy (fromStrict) import Network.HTTP.Types.Status (forbidden403) import Web.Scotty -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (User) +import qualified Common.Msg as Msg import qualified LoginSession import Model.Query (Query) @@ -32,10 +29,10 @@ loggedAction action = do action user Nothing -> do status forbidden403 - html . fromStrict . Message.get $ Key.Secure_Unauthorized + html . fromStrict . Msg.get $ Msg.Secure_Unauthorized Nothing -> do status forbidden403 - html . fromStrict . Message.get $ Key.Secure_Forbidden + html . fromStrict . Msg.get $ Msg.Secure_Forbidden getUserFromToken :: Text -> Query (Maybe User) getUserFromToken token = do -- cgit v1.2.3 From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- server/src/Secure.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'server/src/Secure.hs') diff --git a/server/src/Secure.hs b/server/src/Secure.hs index 6e5b998..4fb2333 100644 --- a/server/src/Secure.hs +++ b/server/src/Secure.hs @@ -16,7 +16,7 @@ import qualified LoginSession import Model.Query (Query) import qualified Model.Query as Query import qualified Model.SignIn as SignIn -import qualified Model.User as User +import qualified Persistence.User as UserPersistence loggedAction :: (User -> ActionM ()) -> ActionM () loggedAction action = do @@ -39,6 +39,6 @@ getUserFromToken token = do mbSignIn <- SignIn.getSignIn token case mbSignIn of Just signIn -> - User.get (SignIn.email signIn) + UserPersistence.get (SignIn.email signIn) Nothing -> return Nothing -- cgit v1.2.3 From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Jan 2020 14:03:31 +0100 Subject: Sign in with email and password --- server/src/Secure.hs | 27 +++++++-------------------- 1 file changed, 7 insertions(+), 20 deletions(-) (limited to 'server/src/Secure.hs') diff --git a/server/src/Secure.hs b/server/src/Secure.hs index 4fb2333..a30941f 100644 --- a/server/src/Secure.hs +++ b/server/src/Secure.hs @@ -1,21 +1,17 @@ module Secure ( loggedAction - , getUserFromToken ) where import Control.Monad.IO.Class (liftIO) -import Data.Text (Text) -import Data.Text.Lazy (fromStrict) -import Network.HTTP.Types.Status (forbidden403) +import qualified Data.Text.Lazy as TL +import qualified Network.HTTP.Types.Status as HTTP import Web.Scotty import Common.Model (User) import qualified Common.Msg as Msg import qualified LoginSession -import Model.Query (Query) import qualified Model.Query as Query -import qualified Model.SignIn as SignIn import qualified Persistence.User as UserPersistence loggedAction :: (User -> ActionM ()) -> ActionM () @@ -23,22 +19,13 @@ loggedAction action = do maybeToken <- LoginSession.get case maybeToken of Just token -> do - maybeUser <- liftIO . Query.run . getUserFromToken $ token + maybeUser <- liftIO . Query.run . UserPersistence.get $ token case maybeUser of Just user -> action user Nothing -> do - status forbidden403 - html . fromStrict . Msg.get $ Msg.Secure_Unauthorized + status HTTP.forbidden403 + html . TL.fromStrict . Msg.get $ Msg.Secure_Unauthorized Nothing -> do - status forbidden403 - html . fromStrict . Msg.get $ Msg.Secure_Forbidden - -getUserFromToken :: Text -> Query (Maybe User) -getUserFromToken token = do - mbSignIn <- SignIn.getSignIn token - case mbSignIn of - Just signIn -> - UserPersistence.get (SignIn.email signIn) - Nothing -> - return Nothing + status HTTP.forbidden403 + html . TL.fromStrict . Msg.get $ Msg.Secure_Forbidden -- cgit v1.2.3