From a7db22556b91bc7c499e010b4c051f4442ad8ce2 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 29 Dec 2015 22:38:42 +0100
Subject: Using persona to validate emails

---
 src/server/Model/Database.hs             |  1 -
 src/server/Model/Message/Key.hs          |  6 +-----
 src/server/Model/Message/Translations.hs | 26 +++-----------------------
 src/server/Model/SignIn.hs               | 17 +----------------
 4 files changed, 5 insertions(+), 45 deletions(-)

(limited to 'src/server/Model')

diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 8d1da25..67cc8b3 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -44,7 +44,6 @@ SignIn
   token Text
   creation UTCTime
   email Text
-  isUsed Bool
   UniqSignInToken token
   deriving Show
 Job
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index e9f8ef6..7f49ae7 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -12,12 +12,8 @@ data Key =
 
   | SharedCost
   | SignIn
-  | SendEmailFail
+  | InvalidEmail
   | Unauthorized
-  | EnterValidEmail
-  | SignInUsed
-  | SignInExpired
-  | SignInInvalid
   | SignInMailTitle
   | SignInMail
   | SignInEmailSent
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index a2e9a30..29b21ea 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -34,36 +34,16 @@ m l SignIn =
     English -> "Sign in"
     French  -> "Connexion"
 
-m l SendEmailFail =
+m l InvalidEmail =
   case l of
-    English -> "Sorry, we failed to send you the sign up email."
-    French  -> "Désolé, nous n'avons pas pu t'envoyer le courriel de connexion."
+    English -> "Your email is not valid."
+    French  -> "Votre courriel n'est pas valide."
 
 m l Unauthorized =
   case l of
     English -> "You are not authorized to sign in."
     French  -> "Tu n'es pas autorisé à te connecter."
 
-m l EnterValidEmail =
-  case l of
-    English -> "Please enter a valid email address."
-    French  -> "Ton courriel n'est pas valide."
-
-m l SignInUsed =
-  case l of
-    English -> "You already used this link, please sign in again."
-    French  -> "Tu as déjà utilisé ce lien, connecte-toi à nouveau."
-
-m l SignInExpired =
-  case l of
-    English -> "The link expired, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué a expiré, connecte-toi à nouveau."
-
-m l SignInInvalid =
-  case l of
-    English -> "The link is invalid, please sign in again."
-    French  -> "Le lien sur lequel tu as cliqué est invalide, connecte-toi à nouveau."
-
 m l SignInMailTitle =
   case l of
     English -> T.concat ["Sign in to ", m l SharedCost]
diff --git a/src/server/Model/SignIn.hs b/src/server/Model/SignIn.hs
index 117b8b5..b475fdb 100644
--- a/src/server/Model/SignIn.hs
+++ b/src/server/Model/SignIn.hs
@@ -1,8 +1,6 @@
 module Model.SignIn
   ( createSignInToken
   , getSignInToken
-  , signInTokenToUsed
-  , isLastValidToken
   ) where
 
 import Data.Text (Text)
@@ -19,22 +17,9 @@ createSignInToken :: Text -> Persist Text
 createSignInToken email = do
   now <- liftIO getCurrentTime
   token <- liftIO generateUUID
-  _ <- insert $ SignIn token now email False
+  _ <- insert $ SignIn token now email
   return token
 
 getSignInToken :: Text -> Persist (Maybe (Entity SignIn))
 getSignInToken token =
   selectFirst [SignInToken ==. token] []
-
-signInTokenToUsed :: SignInId -> Persist ()
-signInTokenToUsed tokenId =
-  update tokenId [SignInIsUsed =. True]
-
-isLastValidToken :: SignIn -> Persist Bool
-isLastValidToken signIn = do
-  maybe False ((== (signInToken signIn)) . signInToken . entityVal) <$>
-    selectFirst
-      [ SignInEmail ==. (signInEmail signIn)
-      , SignInIsUsed ==. True
-      ]
-      [ Desc SignInCreation ]
-- 
cgit v1.2.3