aboutsummaryrefslogtreecommitdiff
path: root/src/server/Application.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Application.hs')
-rw-r--r--src/server/Application.hs27
1 files changed, 18 insertions, 9 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs
index 6a18102..7bb305e 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -23,7 +23,6 @@ import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE
import Data.String (fromString)
@@ -41,6 +40,8 @@ import Model.Message
import View.Page (page)
+import Mail
+
getIndexAction :: ActionM ()
getIndexAction = html page
@@ -87,14 +88,22 @@ signInAction login =
(Just _, Just host) -> do
token <- liftIO . runDb $ createSignInToken login
let url = T.concat ["http://", host ,"/validateSignIn?token=", token]
- liftIO . TIO.putStrLn $ url
- status ok200
- _ -> do
- status badRequest400
- json (Message "You are not authorized to sign in.")
- else do
- status badRequest400
- json (Message "Please enter a valid email address.")
+ let mail = Mail [login] "Sign in" url url
+ maybeSentMail <- liftIO . sendMail $ mail
+ case maybeSentMail of
+ Right _ ->
+ status ok200
+ Left _ ->
+ errorResponse "Sorry, we failed to send you the sign up email."
+ _ ->
+ errorResponse "You are not authorized to sign in."
+ else
+ errorResponse "Please enter a valid email address."
+
+errorResponse :: Text -> ActionM ()
+errorResponse message = do
+ status badRequest400
+ json (Message message)
validateSignInAction :: Text -> ActionM ()
validateSignInAction token = do