From 169d52bfbe8b7f95dcece3cef245cdd62336e2f8 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sun, 9 Aug 2015 00:21:03 +0200
Subject: Wording for sign in email

---
 src/server/Application.hs | 147 ----------------------------------------------
 1 file changed, 147 deletions(-)
 delete mode 100644 src/server/Application.hs

(limited to 'src/server/Application.hs')

diff --git a/src/server/Application.hs b/src/server/Application.hs
deleted file mode 100644
index 5306e17..0000000
--- a/src/server/Application.hs
+++ /dev/null
@@ -1,147 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Application
-  ( signInAction
-  , validateSignInAction
-  , getUserName
-  , getPaymentsAction
-  , createPaymentAction
-  , signOutAction
-
-  , getIndexAction
-  , getUsersAction
-  , addUserAction
-  , deleteUserAction
-  ) where
-
-import Web.Scotty
-
-import Network.HTTP.Types.Status (ok200, badRequest400)
-
-import Database.Persist
-
-import Control.Monad.IO.Class (liftIO)
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Encoding as TE
-import Data.String (fromString)
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
-import Data.Maybe (isJust)
-
-import Text.Email.Validate (isValid)
-
-import qualified LoginSession
-
-import qualified Secure
-
-import Model.Database
-import Model.User
-import Model.Payment
-import Model.SignIn
-import Model.Message
-
-import Config
-
-import View.Page (page)
-
-import Mail
-
-signInAction :: Config -> Text -> ActionM ()
-signInAction config login =
-  if isValid (TE.encodeUtf8 login)
-    then do
-      maybeUser <- liftIO . runDb $ getUser login
-      if isJust maybeUser
-        then do
-          token <- liftIO . runDb $ createSignInToken login
-          let url = T.concat ["http://", hostname config, "/validateSignIn?token=", token]
-          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."
-        else
-            errorResponse "You are not authorized to sign in."
-    else
-      errorResponse "Please enter a valid email address."
-
-validateSignInAction :: Text -> ActionM ()
-validateSignInAction token = do
-  maybeSignIn <- liftIO . runDb $ getSignInToken token
-  now <- liftIO getCurrentTime
-  case maybeSignIn of
-    Just signIn ->
-      if signInIsUsed . entityVal $ signIn
-        then
-          redirectError "The token has already been used."
-        else
-          let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn)
-          in  if diffTime > 2 * 60 -- 2 minutes
-                then
-                  redirectError "The token has expired."
-                else do
-                  LoginSession.put (signInEmail . entityVal $ signIn)
-                  liftIO . runDb . signInTokenToUsed . entityKey $ signIn
-                  redirect "/"
-    Nothing ->
-      redirectError "The token is invalid."
-
-redirectError :: Text -> ActionM ()
-redirectError msg =
-  redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]
-
-getUserName :: ActionM ()
-getUserName =
-  Secure.loggedAction (\user -> do
-    json . Message . userName . entityVal $ user
-  )
-
-getPaymentsAction :: ActionM ()
-getPaymentsAction =
-  Secure.loggedAction (\_ -> do
-    payments <- liftIO $ runDb getPayments
-    json payments
-  )
-
-createPaymentAction :: Text -> Int -> ActionM ()
-createPaymentAction name cost =
-  Secure.loggedAction (\user -> do
-    _ <- liftIO . runDb $ createPayment (entityKey user) name cost
-    return ()
-  )
-
-signOutAction :: ActionM ()
-signOutAction = do
-  LoginSession.delete
-  status ok200
-
-errorResponse :: Text -> ActionM ()
-errorResponse msg = do
-  status badRequest400
-  json (Message msg)
-
-
-
-
-
-getIndexAction :: ActionM ()
-getIndexAction = html page
-
-getUsersAction :: ActionM ()
-getUsersAction = do
-  users <- liftIO $ runDb getUsers
-  html . fromString . show $ users
-
-addUserAction :: Text -> Text -> ActionM ()
-addUserAction email name = do
-  _ <- liftIO . runDb $ createUser email name
-  status ok200
-
-deleteUserAction :: Text -> ActionM ()
-deleteUserAction email = do
-  _ <- liftIO . runDb $ deleteUser email
-  status ok200
-- 
cgit v1.2.3