aboutsummaryrefslogtreecommitdiff
path: root/server/src/Controller/Index.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Controller/Index.hs')
-rw-r--r--server/src/Controller/Index.hs76
1 files changed, 0 insertions, 76 deletions
diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs
deleted file mode 100644
index 4f4ae77..0000000
--- a/server/src/Controller/Index.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-module Controller.Index
- ( get
- , signIn
- , signOut
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Data.Text (Text)
-import qualified Data.Text.Lazy as TL
-import Data.Validation (Validation (..))
-import qualified Network.HTTP.Types.Status as Status
-import Prelude hiding (error, init)
-import Web.Scotty (ActionM)
-import qualified Web.Scotty as S
-
-import Common.Model (Init (..), SignInForm (..),
- User (..))
-import qualified Common.Msg as Msg
-
-import Conf (Conf (..))
-import qualified LoginSession
-import Model.Query (Query)
-import qualified Model.Query as Query
-import Model.SignIn (SignIn (..))
-import qualified Persistence.User as UserPersistence
-import qualified Validation.SignIn as SignInValidation
-import View.Page (page)
-
-get :: Conf -> ActionM ()
-get conf = do
- init <- do
- mbToken <- LoginSession.get
- case mbToken of
- Nothing ->
- return Nothing
- Just token -> do
- liftIO . Query.run $ getInit conf token
- S.html $ page init
-
-signIn :: Conf -> SignInForm -> ActionM ()
-signIn conf form =
- case SignInValidation.signIn form of
- Failure _ ->
- textKey Status.badRequest400 Msg.SignIn_InvalidCredentials
- Success (SignIn email password) -> do
- result <- liftIO . Query.run $ do
- isPasswordValid <- UserPersistence.checkPassword email password
- if isPasswordValid then
- do
- signInToken <- UserPersistence.createSignInToken email
- init <- getInit conf signInToken
- return $ Just (signInToken, init)
- else
- return Nothing
- case result of
- Just (signInToken, init) -> do
- LoginSession.put conf signInToken
- S.json init
-
- Nothing ->
- textKey Status.badRequest400 Msg.SignIn_InvalidCredentials
- where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key)
-
-getInit :: Conf -> Text -> Query (Maybe Init)
-getInit conf signInToken = do
- user <- UserPersistence.get signInToken
- case user of
- Just u ->
- do
- users <- UserPersistence.list
- return . Just $ Init users (_user_id u) (Conf.currency conf)
- Nothing ->
- return Nothing
-
-signOut :: Conf -> ActionM ()
-signOut conf = LoginSession.delete conf >> S.status Status.ok200