aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller/Index.hs
diff options
context:
space:
mode:
authorJoris2017-11-08 23:47:26 +0100
committerJoris2017-11-08 23:47:26 +0100
commit27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 (patch)
tree845f54d7fe876c9a3078036975ba85ec21d224a1 /src/server/Controller/Index.hs
parenta3601b5e6f5a3e41fa31752a2c704ccd3632790e (diff)
downloadbudget-27e11b20b06f2f2dbfb56c0998a63169b4b8abc4.tar.gz
budget-27e11b20b06f2f2dbfb56c0998a63169b4b8abc4.tar.bz2
budget-27e11b20b06f2f2dbfb56c0998a63169b4b8abc4.zip
Use a better project structure
Diffstat (limited to 'src/server/Controller/Index.hs')
-rw-r--r--src/server/Controller/Index.hs86
1 files changed, 0 insertions, 86 deletions
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
deleted file mode 100644
index 8473c5c..0000000
--- a/src/server/Controller/Index.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-module Controller.Index
- ( get
- , signOut
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Data.Text (Text)
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
-import Network.HTTP.Types.Status (ok200)
-import Prelude hiding (error)
-import Web.Scotty hiding (get)
-
-import qualified Common.Message as Message
-import Common.Message.Key (Key)
-import qualified Common.Message.Key as Key
-import Common.Model (InitResult(..), User(..))
-
-import Conf (Conf(..))
-import Model.Init (getInit)
-import qualified LoginSession
-import qualified Model.Query as Query
-import qualified Model.SignIn as SignIn
-import qualified Model.User as User
-import Secure (getUserFromToken)
-import View.Page (page)
-
-get :: Conf -> Maybe Text -> ActionM ()
-get conf mbToken = do
- initResult <- case mbToken of
- Just token -> do
- userOrError <- validateSignIn conf token
- case userOrError of
- Left errorKey ->
- return . InitEmpty . Left . Message.get $ errorKey
- Right user ->
- liftIO . Query.run . fmap InitSuccess $ getInit user conf
- Nothing -> do
- mbLoggedUser <- getLoggedUser
- case mbLoggedUser of
- Nothing ->
- return . InitEmpty . Right $ Nothing
- Just user ->
- liftIO . Query.run . fmap InitSuccess $ getInit user conf
- html $ page initResult
-
-validateSignIn :: Conf -> Text -> ActionM (Either Key User)
-validateSignIn conf textToken = do
- mbLoggedUser <- getLoggedUser
- case mbLoggedUser of
- Just loggedUser ->
- return . Right $ loggedUser
- Nothing -> do
- mbSignIn <- liftIO . Query.run $ SignIn.getSignIn textToken
- now <- liftIO getCurrentTime
- case mbSignIn of
- Nothing ->
- return . Left $ Key.SignIn_LinkInvalid
- Just signIn ->
- if SignIn.isUsed signIn
- then
- return . Left $ Key.SignIn_LinkUsed
- else
- let diffTime = now `diffUTCTime` (SignIn.creation signIn)
- in if diffTime > signInExpiration conf
- then
- return . Left $ Key.SignIn_LinkExpired
- else do
- LoginSession.put conf (SignIn.token signIn)
- mbUser <- liftIO . Query.run $ do
- SignIn.signInTokenToUsed . SignIn.id $ signIn
- User.get . SignIn.email $ signIn
- return $ case mbUser of
- Nothing -> Left Key.Secure_Unauthorized
- Just user -> Right user
-
-getLoggedUser :: ActionM (Maybe User)
-getLoggedUser = do
- mbToken <- LoginSession.get
- case mbToken of
- Nothing ->
- return Nothing
- Just token -> do
- liftIO . Query.run . getUserFromToken $ token
-
-signOut :: Conf -> ActionM ()
-signOut conf = LoginSession.delete conf >> status ok200