Skip to content

Commit

Permalink
Merge pull request #1275 from haskell/master
Browse files Browse the repository at this point in the history
email templates for endorsements -> central server
  • Loading branch information
gbaz authored Dec 8, 2023
2 parents ae1f78a + 8e36558 commit 60d5710
Show file tree
Hide file tree
Showing 5 changed files with 28 additions and 21 deletions.
3 changes: 3 additions & 0 deletions datafiles/templates/UserNotify/endorsements-complete.txt.st
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
You have received all necessary endorsements, and have been added the the 'uploaders' group.
Note that packages cannot be deleted, so be careful.

24 changes: 10 additions & 14 deletions src/Distribution/Server/Features/UserNotify.hs
Original file line number Diff line number Diff line change
Expand Up @@ -92,6 +92,7 @@ import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Vector as Vec


-- A feature to manage notifications to users when package metadata, etc is updated.

{-
Expand Down Expand Up @@ -448,7 +449,7 @@ initUserNotifyFeature env@ServerEnv{ serverStateDir, serverTemplatesDir,
-- Page templates
templates <- loadTemplates serverTemplatesMode
[serverTemplatesDir, serverTemplatesDir </> "UserNotify"]
[ "user-notify-form.html" ]
[ "user-notify-form.html", "endorsements-complete.txt" ]

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

emails <-
getNotificationEmails serverEnv userDetailsFeature users $
getNotificationEmails serverEnv userDetailsFeature users templates $
concat
[ revisionUploadNotifications
, groupActionNotifications
Expand Down Expand Up @@ -924,18 +925,20 @@ getNotificationEmails
:: ServerEnv
-> UserDetailsFeature
-> Users.Users
-> Templates
-> [(UserId, Notification)]
-> IO [Mail]
getNotificationEmails
ServerEnv{serverBaseURI}
UserDetailsFeature{queryUserDetails}
allUsers
templates
notifications = do
let userIds = Set.fromList $ map fst notifications
userIdToDetails <- Map.mapMaybe id <$> fromSetM queryUserDetails userIds

vouchTemplate <- renderTemplate . ($ []) <$> getTemplate templates "endorsements-complete.txt"
pure $
let emails = groupNotifications $ map (fmap renderNotification) notifications
let emails = groupNotifications $ map (fmap (renderNotification vouchTemplate)) notifications
in flip mapMaybe (Map.toList emails) $ \((uid, group), emailContent) ->
case uid `Map.lookup` userIdToDetails of
Nothing -> Nothing
Expand Down Expand Up @@ -991,8 +994,8 @@ getNotificationEmails

{----- Render notifications -----}

renderNotification :: Notification -> (EmailContent, NotificationGroup)
renderNotification = \case
renderNotification :: BS.ByteString -> Notification -> (EmailContent, NotificationGroup)
renderNotification vouchTemplate = \case
NotifyNewVersion{..} ->
generalNotification $
renderNotifyNewVersion
Expand Down Expand Up @@ -1031,7 +1034,7 @@ getNotificationEmails
)
NotifyVouchingCompleted ->
generalNotification
renderNotifyVouchingCompleted
(EmailContentParagraph . EmailContentText . T.pack $ BS.unpack vouchTemplate)

where
generalNotification = (, GeneralNotification)
Expand Down Expand Up @@ -1098,13 +1101,6 @@ getNotificationEmails
]
<> EmailContentList (map renderPkgLink revDeps)

renderNotifyVouchingCompleted =
EmailContentParagraph
"You have received all necessary endorsements. \
\You have been added the the 'uploaders' group. \
\You can now upload packages to Hackage. \
\Note that packages cannot be deleted, so be careful."

{----- Rendering helpers -----}

renderPackageName = emailContentStr . unPackageName
Expand Down
4 changes: 4 additions & 0 deletions src/Distribution/Server/Framework/Templating.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ module Distribution.Server.Framework.Templating (
utcTimeTemplateVal,
templateEnumDesriptor,
templateUnescaped,
mockTemplates,
ToSElem(..),
) where

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

data TemplatesMode = NormalMode | DesignMode

mockTemplates :: [FilePath] -> [String] -> Templates
mockTemplates = TemplatesDesignMode

loadTemplates :: TemplatesMode -> [FilePath] -> [String] -> IO Templates
loadTemplates templateMode templateDirs expectedTemplates = do
templateGroup <- loadTemplateGroup templateDirs
Expand Down
4 changes: 3 additions & 1 deletion tests/ReverseDependenciesTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@ import Distribution.Server.Framework.MemState (newMemStateWHNF)
import Distribution.Server.Framework.ServerEnv (ServerEnv(..))
import Distribution.Server.Packages.PackageIndex as PackageIndex
import Distribution.Server.Packages.Types (CabalFileText(..), PkgInfo(..))
import Distribution.Server.Framework.Templating
import Distribution.Server.Users.Types
( PasswdHash(..)
, UserAuth(..)
Expand Down Expand Up @@ -483,7 +484,7 @@ getNotificationEmailsTests =
<*> addUser "user-subject"

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

Expand All @@ -509,6 +510,7 @@ getNotificationEmailsTests =
testServerEnv
testUserDetailsFeature
allUsers
(mockTemplates ["datafiles/templates/UserNotify"] ["endorsements-complete.txt"])
getNotificationEmailMocked =
getNotificationEmail
testServerEnv
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,10 @@ Content-Type: multipart/alternative; boundary="YIYrWcf3to"
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable

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


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


<p>
You have received all necessary endorsements=2E You have been added the the=
'uploaders' group=2E You can now upload packages to Hackage=2E Note that p=
ackages cannot be deleted, so be careful=2E
You have received all necessary endorsements, and have been added the the '=
uploaders' group=2E
Note that packages cannot be deleted, so be careful=2E

</p>
<p>
You can adjust your notification preferences at
Expand Down

0 comments on commit 60d5710

Please sign in to comment.