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