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 TODO put main configuration variables in gargantext.ini
  11
  12 -}
  13
  14 module Gargantext.Core.Mail
  15   where
  16
  17 import Data.Text (Text, unlines, splitOn)
  18 import Gargantext.Core.Types.Individu
  19 import Gargantext.Prelude
  20 import Gargantext.Prelude.Mail (gargMail, GargMail(..))
  21 import qualified Data.List as List
  22
  23 -- | Tool to put elsewhere
  24 isEmail :: Text -> Bool
  25 isEmail = ((==) 2) . List.length . (splitOn "@")
  26
  27 ------------------------------------------------------------------------
  28 data SendEmail    = SendEmail Bool
  29
  30 type EmailAddress  = Text
  31 type Name          = Text
  32 type ServerAddress = Text
  33
  34 data MailModel = Invitation { invitation_user :: NewUser GargPassword }
  35                | PassUpdate { passUpdate_user :: NewUser GargPassword }
  36                | MailInfo   { mailInfo_username :: Name
  37                             , mailInfo_address  :: EmailAddress
  38                             }
  39 ------------------------------------------------------------------------
  40 ------------------------------------------------------------------------
  41 mail :: ServerAddress -> MailModel -> IO ()
  42 mail server model = gargMail (GargMail m (Just u) subject body)
  43   where
  44     (m,u)   = email_to         model
  45     subject = email_subject    model
  46     body    = emailWith server model
  47
  48 ------------------------------------------------------------------------
  49 emailWith :: ServerAddress -> MailModel -> Text
  50 emailWith server model =
  51   unlines $ [ "Hello" ]
  52           <> bodyWith server model
  53           <> email_disclaimer
  54           <> email_signature
  55
  56 ------------------------------------------------------------------------
  57 email_to :: MailModel -> (EmailAddress, Name)
  58 email_to (Invitation user) = email_to' user
  59 email_to (PassUpdate user) = email_to' user
  60 email_to (MailInfo u m)    = (m, u)
  61
  62 email_to' :: NewUser GargPassword -> (EmailAddress, Name)
  63 email_to' (NewUser u m _) = (m,u)
  64
  65 ------------------------------------------------------------------------
  66 bodyWith :: ServerAddress -> MailModel -> [Text]
  67 bodyWith server (Invitation u) = [ "Congratulation, you have been granted a beta user account to test the"
  68                                  , "new GarganText platform!"
  69                                  ] <> (email_credentials server u)
  70
  71 bodyWith server (PassUpdate u) = [ "Your account password have been updated on the GarganText platform!"
  72                                  ] <> (email_credentials server u)
  73
  74 bodyWith server (MailInfo _ _) = [ "Your last analysis is over on the server: " <> server]
  75
  76 ------------------------------------------------------------------------
  77 email_subject :: MailModel -> Text
  78 email_subject (Invitation _) = "[GarganText] Invitation"
  79 email_subject (PassUpdate _) = "[GarganText] Update"
  80 email_subject (MailInfo _ _) = "[GarganText] Info"
  81
  82
  83 email_credentials :: ServerAddress -> NewUser GargPassword -> [Text]
  84 email_credentials server (NewUser u _ (GargPassword p)) =
  85           [ ""
  86           , "You can log in to: " <> server
  87           , "Your username is: "  <> u
  88           , "Your password is: "  <> p
  89           , ""
  90           ]
  91
  92 email_disclaimer :: [Text]
  93 email_disclaimer =
  94             [ ""
  95             , "If you log in you agree with the following terms of use:"
  96             , "          https://gitlab.iscpif.fr/humanities/tofu/tree/master"
  97             , ""
  98             , ""
  99             , "/!\\ Please note that your account is opened for beta tester only. Hence"
 100             , "we cannot guarantee neither the perenniality nor the stability of the"
 101             , "service at this stage. It is therefore advisable to back up important"
 102             , "data regularly."
 103             , ""
 104             , "/!\\ Gargantext is an academic service supported by ISC-PIF partners."
 105             , "In case of congestion on this service, access to members of the ISC-PIF"
 106             , "partners will be privileged."
 107             , ""
 108             , "Your feedback will be valuable for further development of the platform,"
 109             , "do not hesitate to contact us and to contribute on our forum:"
 110             , ""
 111             , "     https://discourse.iscpif.fr/c/gargantext"
 112             , ""
 113             ]
 114
 115 email_signature :: [Text]
 116 email_signature =
 117           [ "With our best regards,"
 118           , "-- "
 119           , "The Gargantext Team (CNRS)"
 120           ]
 121