Skip to content

Commit 8e36558

Browse files
authored
Merge pull request #1274 from haskell/gb/endorse-complete-email
email template for endorsements complete
2 parents fcc5c51 + cd989e8 commit 8e36558

File tree

5 files changed

+28
-21
lines changed

5 files changed

+28
-21
lines changed
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
You have received all necessary endorsements, and have been added the the 'uploaders' group.
2+
Note that packages cannot be deleted, so be careful.
3+

src/Distribution/Server/Features/UserNotify.hs

Lines changed: 10 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@ import qualified Data.Text.Lazy as TL
9292
import qualified Data.Text.Lazy.Encoding as TL
9393
import qualified Data.Vector as Vec
9494

95+
9596
-- A feature to manage notifications to users when package metadata, etc is updated.
9697

9798
{-
@@ -448,7 +449,7 @@ initUserNotifyFeature env@ServerEnv{ serverStateDir, serverTemplatesDir,
448449
-- Page templates
449450
templates <- loadTemplates serverTemplatesMode
450451
[serverTemplatesDir, serverTemplatesDir </> "UserNotify"]
451-
[ "user-notify-form.html" ]
452+
[ "user-notify-form.html", "endorsements-complete.txt" ]
452453

453454
return $ \users core uploadfeature adminlog userdetails reports tags revers vouch -> do
454455
let feature = userNotifyFeature env
@@ -716,7 +717,7 @@ userNotifyFeature serverEnv@ServerEnv{serverCron}
716717
vouchNotifications <- fmap (, NotifyVouchingCompleted) <$> drainQueuedNotifications
717718

718719
emails <-
719-
getNotificationEmails serverEnv userDetailsFeature users $
720+
getNotificationEmails serverEnv userDetailsFeature users templates $
720721
concat
721722
[ revisionUploadNotifications
722723
, groupActionNotifications
@@ -924,18 +925,20 @@ getNotificationEmails
924925
:: ServerEnv
925926
-> UserDetailsFeature
926927
-> Users.Users
928+
-> Templates
927929
-> [(UserId, Notification)]
928930
-> IO [Mail]
929931
getNotificationEmails
930932
ServerEnv{serverBaseURI}
931933
UserDetailsFeature{queryUserDetails}
932934
allUsers
935+
templates
933936
notifications = do
934937
let userIds = Set.fromList $ map fst notifications
935938
userIdToDetails <- Map.mapMaybe id <$> fromSetM queryUserDetails userIds
936-
939+
vouchTemplate <- renderTemplate . ($ []) <$> getTemplate templates "endorsements-complete.txt"
937940
pure $
938-
let emails = groupNotifications $ map (fmap renderNotification) notifications
941+
let emails = groupNotifications $ map (fmap (renderNotification vouchTemplate)) notifications
939942
in flip mapMaybe (Map.toList emails) $ \((uid, group), emailContent) ->
940943
case uid `Map.lookup` userIdToDetails of
941944
Nothing -> Nothing
@@ -991,8 +994,8 @@ getNotificationEmails
991994

992995
{----- Render notifications -----}
993996

994-
renderNotification :: Notification -> (EmailContent, NotificationGroup)
995-
renderNotification = \case
997+
renderNotification :: BS.ByteString -> Notification -> (EmailContent, NotificationGroup)
998+
renderNotification vouchTemplate = \case
996999
NotifyNewVersion{..} ->
9971000
generalNotification $
9981001
renderNotifyNewVersion
@@ -1031,7 +1034,7 @@ getNotificationEmails
10311034
)
10321035
NotifyVouchingCompleted ->
10331036
generalNotification
1034-
renderNotifyVouchingCompleted
1037+
(EmailContentParagraph . EmailContentText . T.pack $ BS.unpack vouchTemplate)
10351038

10361039
where
10371040
generalNotification = (, GeneralNotification)
@@ -1098,13 +1101,6 @@ getNotificationEmails
10981101
]
10991102
<> EmailContentList (map renderPkgLink revDeps)
11001103

1101-
renderNotifyVouchingCompleted =
1102-
EmailContentParagraph
1103-
"You have received all necessary endorsements. \
1104-
\You have been added the the 'uploaders' group. \
1105-
\You can now upload packages to Hackage. \
1106-
\Note that packages cannot be deleted, so be careful."
1107-
11081104
{----- Rendering helpers -----}
11091105

11101106
renderPackageName = emailContentStr . unPackageName

src/Distribution/Server/Framework/Templating.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ module Distribution.Server.Framework.Templating (
2727
utcTimeTemplateVal,
2828
templateEnumDesriptor,
2929
templateUnescaped,
30+
mockTemplates,
3031
ToSElem(..),
3132
) where
3233

@@ -144,6 +145,9 @@ data Templates = TemplatesNormalMode !(IORef RawTemplateGroup)
144145

145146
data TemplatesMode = NormalMode | DesignMode
146147

148+
mockTemplates :: [FilePath] -> [String] -> Templates
149+
mockTemplates = TemplatesDesignMode
150+
147151
loadTemplates :: TemplatesMode -> [FilePath] -> [String] -> IO Templates
148152
loadTemplates templateMode templateDirs expectedTemplates = do
149153
templateGroup <- loadTemplateGroup templateDirs

tests/ReverseDependenciesTest.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ import Distribution.Server.Framework.MemState (newMemStateWHNF)
4848
import Distribution.Server.Framework.ServerEnv (ServerEnv(..))
4949
import Distribution.Server.Packages.PackageIndex as PackageIndex
5050
import Distribution.Server.Packages.Types (CabalFileText(..), PkgInfo(..))
51+
import Distribution.Server.Framework.Templating
5152
import Distribution.Server.Users.Types
5253
( PasswdHash(..)
5354
, UserAuth(..)
@@ -483,7 +484,7 @@ getNotificationEmailsTests =
483484
<*> addUser "user-subject"
484485

485486
getNotificationEmail env details users uid notif =
486-
getNotificationEmails env details users [(uid, notif)] >>= \case
487+
getNotificationEmails env details users (mockTemplates ["datafiles/templates/UserNotify"] ["endorsements-complete.txt"]) [(uid, notif)] >>= \case
487488
[email] -> pure email
488489
_ -> error "Did not get exactly one email"
489490

@@ -509,6 +510,7 @@ getNotificationEmailsTests =
509510
testServerEnv
510511
testUserDetailsFeature
511512
allUsers
513+
(mockTemplates ["datafiles/templates/UserNotify"] ["endorsements-complete.txt"])
512514
getNotificationEmailMocked =
513515
getNotificationEmail
514516
testServerEnv

tests/golden/ReverseDependenciesTest/getNotificationEmails-NotifyVouchingCompleted.golden

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,10 @@ Content-Type: multipart/alternative; boundary="YIYrWcf3to"
88
Content-Type: text/plain; charset=utf-8
99
Content-Transfer-Encoding: quoted-printable
1010

11-
You have received all necessary endorsements=2E You have been added the the=
12-
'uploaders' group=2E You can now upload packages to Hackage=2E Note that p=
13-
ackages cannot be deleted, so be careful=2E
11+
You have received all necessary endorsements, and have been added the the '=
12+
uploaders' group=2E
13+
Note that packages cannot be deleted, so be careful=2E
14+
1415

1516
You can adjust your notification preferences at
1617
https://hackage=2Ehaskell=2Eorg/user/user-watcher/notify (https://hackage=
@@ -23,9 +24,10 @@ Content-Transfer-Encoding: quoted-printable
2324

2425

2526
<p>
26-
You have received all necessary endorsements=2E You have been added the the=
27-
'uploaders' group=2E You can now upload packages to Hackage=2E Note that p=
28-
ackages cannot be deleted, so be careful=2E
27+
You have received all necessary endorsements, and have been added the the '=
28+
uploaders' group=2E
29+
Note that packages cannot be deleted, so be careful=2E
30+
2931
</p>
3032
<p>
3133
You can adjust your notification preferences at

0 commit comments

Comments
 (0)