src/Gargantext/Core/Mail.hs

   1 {-|
   2 Module      : Gargantext.Core.Mail
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 module Gargantext.Core.Mail where
  13
  14 import Control.Lens (view)
  15 import Data.Text (Text, unlines, splitOn)
  16 import Gargantext.Core.Types.Individu
  17 import Gargantext.Database.Schema.User (UserLight(..))
  18 import Gargantext.Prelude
  19 import Gargantext.Prelude.Config (gc_url)
  20 import Gargantext.Database.Prelude
  21 -- import Gargantext.Prelude.Config (gc_url)
  22 import Gargantext.Prelude.Mail (gargMail, GargMail(..))
  23 import Gargantext.Prelude.Mail.Types (MailConfig)
  24 import qualified Data.List as List
  25
  26
  27 -- | Tool to put elsewhere
  28 isEmail :: Text -> Bool
  29 isEmail = ((==) 2) . List.length . (splitOn "@")
  30
  31 ------------------------------------------------------------------------
  32 data SendEmail    = SendEmail Bool
  33
  34 type EmailAddress  = Text
  35 type Name          = Text
  36 type ServerAddress = Text
  37
  38 data MailModel = Invitation { invitation_user :: NewUser GargPassword }
  39                | PassUpdate { passUpdate_user :: NewUser GargPassword }
  40                | MailInfo   { mailInfo_username :: Name
  41                             , mailInfo_address  :: EmailAddress
  42                             }
  43                | ForgotPassword { user :: UserLight }
  44 ------------------------------------------------------------------------
  45 ------------------------------------------------------------------------
  46 mail :: (CmdM env err m) => MailConfig -> MailModel -> m ()
  47 mail mailCfg model = do
  48   cfg <- view hasConfig
  49   let
  50     (m,u)   = email_to         model
  51     subject = email_subject    model
  52     body    = emailWith (view gc_url cfg)    model
  53   liftBase $ gargMail mailCfg (GargMail { gm_to = m
  54                                         , gm_name = Just u
  55                                         , gm_subject = subject
  56                                         , gm_body = body })
  57
  58 ------------------------------------------------------------------------
  59 emailWith :: ServerAddress -> MailModel -> Text
  60 emailWith server model =
  61   unlines $ [ "Hello" ]
  62           <> bodyWith server model
  63           <> email_disclaimer
  64           <> email_signature
  65
  66 ------------------------------------------------------------------------
  67 email_to :: MailModel -> (EmailAddress, Name)
  68 email_to (Invitation user) = email_to' user
  69 email_to (PassUpdate user) = email_to' user
  70 email_to (MailInfo { .. })    = (mailInfo_address, mailInfo_username)
  71 email_to (ForgotPassword { user = UserLight { .. }}) = (userLight_email, userLight_username)
  72
  73 email_to' :: NewUser GargPassword -> (EmailAddress, Name)
  74 email_to' (NewUser u m _) = (m,u)
  75
  76 ------------------------------------------------------------------------
  77 bodyWith :: ServerAddress -> MailModel -> [Text]
  78 bodyWith server (Invitation u) = [ "Congratulation, you have been granted a user account to test the"
  79                                  , "new GarganText platform!"
  80                                  ] <> (email_credentials server u)
  81
  82 bodyWith server (PassUpdate u) = [ "Your account password have been updated on the GarganText platform!"
  83                                  ] <> (email_credentials server u)
  84
  85 bodyWith server (MailInfo _ _) = [ "Your last analysis is over on the server: " <> server]
  86 bodyWith _server (ForgotPassword { user = UserLight { userLight_forgot_password_uuid = Nothing }}) =
  87   [ "Cannot send you link to forgot password, no UUID" ]
  88 bodyWith server (ForgotPassword { user = UserLight { userLight_forgot_password_uuid = Just uuid }}) =
  89   [ "Click on this link to restore your password: "
  90   , forgot_password_link server uuid ]
  91
  92 forgot_password_link :: ServerAddress -> Text -> Text
  93 forgot_password_link server uuid = server <> "/api/v1.0/forgot-password?uuid=" <> uuid
  94
  95 ------------------------------------------------------------------------
  96 email_subject :: MailModel -> Text
  97 email_subject (Invitation _)     = "[GarganText] Invitation"
  98 email_subject (PassUpdate _)     = "[GarganText] Update"
  99 email_subject (MailInfo _ _)     = "[GarganText] Info"
 100 email_subject (ForgotPassword _) = "[GarganText] Forgot Password"
 101
 102
 103 email_credentials :: ServerAddress -> NewUser GargPassword -> [Text]
 104 email_credentials server (NewUser u _ (GargPassword p)) =
 105           [ ""
 106           , "You can log in to: " <> server
 107           , "Your username is: "  <> u
 108           , "Your password is: "  <> p
 109           , ""
 110           ]
 111
 112 email_disclaimer :: [Text]
 113 email_disclaimer =
 114             [ ""
 115             , "If you log in you agree with the following terms of use:"
 116             , "          https://gitlab.iscpif.fr/humanities/tofu/tree/master"
 117             , ""
 118             , ""
 119             , "/!\\ Please note that your account is opened for beta tester only. Hence"
 120             , "we cannot guarantee neither the perenniality nor the stability of the"
 121             , "service at this stage. It is therefore advisable to back up important"
 122             , "data regularly."
 123             , ""
 124             , "/!\\ Gargantext is an academic service supported by ISC-PIF partners."
 125             , "In case of congestion on this service, access to members of the ISC-PIF"
 126             , "partners will be privileged."
 127             , ""
 128             , "Your feedback will be valuable for further development of the platform,"
 129             , "do not hesitate to contact us and to contribute on our forum:"
 130             , ""
 131             , "     https://discourse.iscpif.fr/c/gargantext"
 132             , ""
 133             ]
 134
 135 email_signature :: [Text]
 136 email_signature =
 137           [ "With our best regards,"
 138           , "-- "
 139           , "The Gargantext Team (CNRS)"
 140           ]
 141