diff options
author | Joris | 2017-06-05 18:02:13 +0200 |
---|---|---|
committer | Joris | 2017-06-05 18:02:13 +0200 |
commit | 0b191f5c48edffc9da3e38c284e9640fd82e7cb1 (patch) | |
tree | c729e53822e7c41c1a854d82d25636e58ee65c9f /src/server/Secure.hs | |
parent | 5c110716cfda6e616a795edd12f2012b132dca9f (diff) |
Replace persistent by sqlite-simple
Diffstat (limited to 'src/server/Secure.hs')
-rw-r--r-- | src/server/Secure.hs | 34 |
1 files changed, 15 insertions, 19 deletions
diff --git a/src/server/Secure.hs b/src/server/Secure.hs index 93d5a60..da48878 100644 --- a/src/server/Secure.hs +++ b/src/server/Secure.hs @@ -5,31 +5,27 @@ module Secure , getUserFromToken ) where -import Web.Scotty - -import Network.HTTP.Types.Status (forbidden403) - -import Database.Persist (Entity, entityVal) - +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 Model.User (getUser) -import Model.SignIn (getSignIn) -import Model.Database import Model.Message (getMessage) -import qualified Model.Message.Key as Key - -import Control.Monad.IO.Class (liftIO) - +import Model.Query (Query) +import Model.User (User) import qualified LoginSession +import qualified Model.Message.Key as Key +import qualified Model.Query as Query +import qualified Model.SignIn as SignIn +import qualified Model.User as User -loggedAction :: (Entity User -> ActionM ()) -> ActionM () +loggedAction :: (User -> ActionM ()) -> ActionM () loggedAction action = do maybeToken <- LoginSession.get case maybeToken of Just token -> do - maybeUser <- liftIO . runDb . getUserFromToken $ token + maybeUser <- liftIO . Query.run . getUserFromToken $ token case maybeUser of Just user -> action user @@ -40,11 +36,11 @@ loggedAction action = do status forbidden403 html . fromStrict . getMessage $ Key.Forbidden -getUserFromToken :: Text -> Persist (Maybe (Entity User)) +getUserFromToken :: Text -> Query (Maybe User) getUserFromToken token = do - mbSignIn <- fmap entityVal <$> getSignIn token + mbSignIn <- SignIn.getSignIn token case mbSignIn of - Just signIn -> do - getUser (signInEmail signIn) + Just signIn -> + User.getUser (SignIn.email signIn) Nothing -> return Nothing |