Translating sign in page and mail

7 files changed, 92 insertions, 20 deletions

diff --git a/src/client/View/SignIn.elm b/src/client/View/SignIn.elm
index 6fb809d..2a6cbca 100644
--- a/src/client/View/SignIn.elm
+++ b/src/client/View/SignIn.elm
@@ -37,18 +37,18 @@ renderSignIn model signInView =
         ]
     , div
         [ class "result" ]
-        [ signInResult signInView ]
+        [ signInResult model signInView ]
     ]
 
-signInResult : SignInView -> Html
-signInResult signInView =
+signInResult : Model -> SignInView -> Html
+signInResult model signInView =
   case signInView.result of
     Just result ->
       case result of
         Ok login ->
           div
             [ class "success" ]
-            [ text ("We sent you an email, please click to the provided link in order to sign in.") ]
+            [ text (getMessage "SignInEmailSent" model.translations) ]
         Err error ->
           div
             [ class "error" ]
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 263e470..80885bf 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -69,18 +69,18 @@ validateSignInAction token = do
     Just signIn ->
       if signInIsUsed . entityVal $ signIn
         then
-          redirectError "The token has already been used."
+          redirectError (getMessage SignInUsed)
         else
           let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn)
           in  if diffTime > 2 * 60 -- 2 minutes
                 then
-                  redirectError "The token has expired."
+                  redirectError (getMessage SignInExpired)
                 else do
                   LoginSession.put (signInEmail . entityVal $ signIn)
                   liftIO . runDb . signInTokenToUsed . entityKey $ signIn
                   redirect "/"
     Nothing ->
-      redirectError "The token is invalid."
+      redirectError (getMessage SignInInvalid)
 
 redirectError :: Text -> ActionM ()
 redirectError msg =
diff --git a/src/server/Model/Mail.hs b/src/server/Model/Mail.hs
index 7ee8a8e..20addee 100644
--- a/src/server/Model/Mail.hs
+++ b/src/server/Model/Mail.hs
@@ -6,7 +6,8 @@ import Data.Text (Text)
 import qualified Data.Text.Lazy as LT
 
 data Mail = Mail
-  { to :: [Text]
+  { from :: Text
+  , to :: [Text]
   , subject :: Text
   , plainBody :: LT.Text
   , htmlBody :: LT.Text
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index e1a382c..50486be 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -4,13 +4,24 @@ module Model.Message.Key
 
 data Key =
 
+  -- Mail
+
+  NoReplyMail
+
   -- Sign in
 
-  SharedCost
+  | SharedCost
   | SignIn
   | SendEmailFail
   | Unauthorized
   | EnterValidEmail
+  | SignInUsed
+  | SignInExpired
+  | SignInInvalid
+  | SignInMailTitle
+  | HiMail
+  | SignInLinkMail
+  | SignInEmailSent
 
   -- Dates
 
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 2cc1761..d680e6e 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -5,6 +5,7 @@ module Model.Message.Translations
   ) where
 
 import Data.Text (Text)
+import qualified Data.Text as T
 
 import Model.Message.Key
 import Model.Message.Lang
@@ -14,6 +15,15 @@ getNonFormattedMessage = m
 
 m :: Lang -> Key -> Text
 
+-- Mail
+
+m l NoReplyMail =
+  case l of
+    English -> "no-reply@shared-cost.guyonvarch.me"
+    French  -> "pas-de-reponse@shared-cost.guyonvarch.me"
+
+-- Sign in
+
 m l SharedCost =
   case l of
     English -> "Shared Cost"
@@ -27,17 +37,64 @@ m l SignIn =
 m l SendEmailFail =
   case l of
     English -> "Sorry, we failed to send you the sign up email."
-    French  -> "Désolé, nous n'avons pas pu vous envoyer le courriel de connexion."
+    French  -> "Désolé, nous n'avons pas pu t'envoyer le courriel de connexion."
 
 m l Unauthorized =
   case l of
     English -> "You are not authorized to sign in."
-    French  -> "Vous n'êtes pas authorisé à vous connecter."
+    French  -> "Tu n'es pas authorisé à te connecter."
 
 m l EnterValidEmail =
   case l of
     English -> "Please enter a valid email address."
-    French  -> "Entrez s'il vous plait un email valide."
+    French  -> "Entre un email 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é est 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]
+    French  -> T.concat ["Connexion à ", m l SharedCost]
+
+m l HiMail =
+  case l of
+    English -> "Hi {1},"
+    French  -> "Bonjour {1},"
+
+m l SignInLinkMail =
+  case l of
+    English ->
+      T.concat
+        [ "Click to the following link in order to sign in to Shared Cost:"
+        , m l SharedCost
+        , ":"
+        ]
+    French  ->
+      T.concat
+        [ "Clique sur le lien suivant pour te connecter à "
+        , m l SharedCost
+        , ":"
+        ]
+
+m l SignInEmailSent =
+  case l of
+    English -> "We sent you an email, please click to the provided link in order to sign in."
+    French  -> "Nous t'avons envoyé un courriel, clique sur le lien dans ce mail pour te connecter."
+
+-- Date
 
 m l January =
   case l of
diff --git a/src/server/SendMail.hs b/src/server/SendMail.hs
index 74d48ab..09d3d59 100644
--- a/src/server/SendMail.hs
+++ b/src/server/SendMail.hs
@@ -25,8 +25,8 @@ sendMail mail = do
   return result
 
 getMimeMail :: Mail -> M.Mail
-getMimeMail (Mail to subject plainBody htmlBody) =
-  let fromMail = M.emptyMail (address "no-reply@shared-cost.guyonvarch.me")
+getMimeMail (Mail from to subject plainBody htmlBody) =
+  let fromMail = M.emptyMail (address from)
   in  fromMail
         { M.mailTo = map address to
         , M.mailParts =
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs
index e11b876..5eb181b 100644
--- a/src/server/View/Mail/SignIn.hs
+++ b/src/server/View/Mail/SignIn.hs
@@ -14,12 +14,15 @@ import Text.Blaze.Html.Renderer.Text (renderHtml)
 
 import Model.Database (User(..))
 import qualified Model.Mail as M
+import Model.Message.Key
+import Model.Message
 
 getMail :: User -> Text -> [Text] -> M.Mail
 getMail user url to =
   M.Mail
-    { M.to = to
-    , M.subject = "Sign in to Shared Cost"
+    { M.from = (getMessage NoReplyMail)
+    , M.to = to
+    , M.subject = (getMessage SignInMailTitle)
     , M.plainBody = plainBody user url
     , M.htmlBody = htmlBody user url
     }
@@ -28,19 +31,19 @@ plainBody :: User -> Text -> LT.Text
 plainBody user url =
   LT.intercalate
     "\n"
-    [ LT.concat ["Hi ", strictToLazy . userName $ user, ","]
+    [ strictToLazy (getVarMessage [userName user] HiMail)
     , ""
-    , "Click to the following link in order to sign in to Shared Cost:"
+    , strictToLazy (getMessage SignInLinkMail)
     , strictToLazy url
     ]
 
 htmlBody :: User -> Text -> LT.Text
 htmlBody user url =
   renderHtml . docTypeHtml . body $ do
-    toHtml $ LT.concat ["Hi ", strictToLazy . userName $ user, ","]
+    toHtml $ strictToLazy (getVarMessage [userName user] HiMail)
     br
     br
-    "Click to the following link in order to sign in to Shared Cost:"
+    toHtml $ strictToLazy (getMessage SignInLinkMail)
     br
     toHtml url