src/server/Controller/SignIn.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

{-# LANGUAGE OverloadedStrings #-}

module Controller.SignIn
  ( signIn
  ) where

import Web.Scotty

import Network.HTTP.Types.Status (ok200)

import Control.Monad.IO.Class (liftIO)

import Data.Text (Text)
import Data.Maybe (isJust)

import qualified LoginSession

import Config

import Model.Database
import Model.User
import Model.SignIn
import Model.Message.Key
import Model.Message (getMessage)

import Json (jsonError)

import Persona (verifyEmail)

signIn :: Config -> Text -> ActionM ()
signIn config assertion = do
  mbEmail <- liftIO $ verifyEmail config assertion
  case mbEmail of
    Nothing ->
      jsonError (getMessage InvalidEmail)
    Just email -> do
      isAuthorized <- liftIO . fmap isJust . runDb $ getUser email
      if isAuthorized
        then do
          token <- liftIO . runDb $ createSignInToken email
          LoginSession.put token
          status ok200
        else
          jsonError (getMessage UnauthorizedSignIn)