Skip to content

Commit b13bc6e

Browse files
AliasQligbaz
AliasQli
and
gbaz
authored
Maintainer notifications
Co-authored-by: Gershom <gershomb@gmail.com>
1 parent 5f5b814 commit b13bc6e

File tree

10 files changed

+727
-14
lines changed

10 files changed

+727
-14
lines changed

‎.github/workflows/nix-shell.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,4 +24,4 @@ jobs:
2424
# https://nix.dev/tutorials/continuous-integration-github-actions#setting-up-github-actions
2525
name: hackage-server
2626
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'
27-
- run: nix-shell --pure --run ./.github/workflows/test-nix-shell.sh
27+
- run: nix-shell --pure --run ./.github/workflows/test-nix-shell.sh

‎datafiles/templates/UserNotify/user-notify-form.html.st

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
<!DOCTYPE html>
2+
<html>
3+
<head>
4+
$hackageCssTheme()$
5+
<title>Set user notification preferences | Hackage</title>
6+
</head>
7+
8+
<body>
9+
$hackagePageHeader()$
10+
11+
<div id="content">
12+
<h2>Change notification preferences</h2>
13+
14+
$if(showConfirmationOfSave)$
15+
<p class=box>
16+
Notification preferences saved! The updated preferences are shown below.
17+
</p>
18+
$endif$
19+
20+
<form action="/user/$username$/notify" method=POST enctype="multipart/form-data">
21+
<input type="hidden" name="_method" value="PUT"/>
22+
<input type="hidden" name="_return" value="/user/$username$/notify?showConfirmationOfSave=True"/>
23+
<input type="hidden" name="_transform" value="form2json"/>
24+
<table>
25+
<tr>
26+
<td><label>Email notification enabled:
27+
<td>$notifyEnabled$
28+
29+
<tr>
30+
<td><label>Notify on maintained package metadata revision:
31+
<td>$notifyRevisionRange$
32+
33+
<tr>
34+
<td><label>Notify on maintained package upload:
35+
<td>$notifyUpload$
36+
37+
<tr>
38+
<td><label>Notify on maintained package maintainer group change:
39+
<td>$notifyMaintainerGroup$
40+
41+
<tr>
42+
<td><label>Notify on maintained package docbuilder report:
43+
<td>$notifyDocBuilderReport$
44+
45+
<tr>
46+
<td><label>Notify on maintained package pending proposed tags:
47+
<td>$notifyPendingTags$
48+
</table>
49+
<input type="submit" value="Save notify preference" />
50+
</form>
51+
</div>
52+
</body></html>

‎datafiles/templates/Users/manage.html.st

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,9 @@ $hackagePageHeader(deauthUser="1")$
1515
<h3>Change full name or e-mail address</h3>
1616
<p>You can <a href="/user/$username$/name-contact">change your full name or e-mail address</a>.</p>
1717

18+
<h3>Change notification preferences</h3>
19+
<p>You can <a href="/user/$username$/notify">change your notification preferences</a>.</p>
20+
1821
<h3>Authentication Tokens</h3>
1922
<p>
2023
You can register API authentication token to use them to for example have services like continuous integration upload packages on your behalf without providing them your username and/or password.

‎datafiles/templates/accounts.html.st

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,8 @@ maintainer group.</p>
2626

2727
<h2>Account Management</h2>
2828
You can modify various settings for your account, including changing
29-
the email address and password, as well as creating authentication
29+
the email address and password, setting email notification
30+
preferences, as well as creating authentication
3031
tokens, at the <a href="/users/account-management">account
3132
management page</a>.
3233

‎hackage-server.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -291,6 +291,7 @@ library lib-server
291291
Distribution.Server.Features.Upload.State
292292
Distribution.Server.Features.Upload.Backup
293293
Distribution.Server.Features.Users
294+
Distribution.Server.Features.UserNotify
294295

295296

296297
if flag(minimal)

‎src/Distribution/Server/Features.hs

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ import Distribution.Server.Features.AdminLog (initAdminLogFeature)
4949
import Distribution.Server.Features.HoogleData (initHoogleDataFeature)
5050
import Distribution.Server.Features.Votes (initVotesFeature)
5151
import Distribution.Server.Features.Sitemap (initSitemapFeature)
52+
import Distribution.Server.Features.UserNotify (initUserNotifyFeature)
5253
import Distribution.Server.Features.PackageFeed (initPackageFeedFeature)
5354
#endif
5455
import Distribution.Server.Features.ServerIntrospect (serverIntrospectFeature)
@@ -154,6 +155,8 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
154155
initAdminLogFeature env
155156
mkSitemapFeature <- logStartup "sitemap" $
156157
initSitemapFeature env
158+
mkUserNotifyFeature <- logStartup "user notify" $
159+
initUserNotifyFeature env
157160
mkPackageFeedFeature <- logStartup "package feed" $
158161
initPackageFeedFeature env
159162
mkBrowseFeature <- logStartup "browse" $
@@ -341,6 +344,15 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
341344
tagsFeature
342345
tarIndexCacheFeature
343346

347+
userNotifyFeature <- mkUserNotifyFeature
348+
usersFeature
349+
coreFeature
350+
uploadFeature
351+
adminLogFeature
352+
userDetailsFeature
353+
reportsCoreFeature
354+
tagsFeature
355+
344356
packageFeedFeature <- mkPackageFeedFeature
345357
coreFeature
346358
usersFeature
@@ -399,6 +411,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
399411
, getFeatureInterface votesFeature
400412
, getFeatureInterface adminLogFeature
401413
, getFeatureInterface siteMapFeature
414+
, getFeatureInterface userNotifyFeature
402415
, getFeatureInterface packageFeedFeature
403416
, getFeatureInterface packageInfoJSONFeature
404417
#endif

‎src/Distribution/Server/Features/AdminLog.hs

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
{-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell, BangPatterns,
22
GeneralizedNewtypeDeriving, NamedFieldPuns, RecordWildCards,
3-
PatternGuards #-}
3+
PatternGuards, RankNTypes #-}
44

55
module Distribution.Server.Features.AdminLog where
66

@@ -77,6 +77,7 @@ makeAcidic ''AdminLog ['getAdminLog
7777

7878
data AdminLogFeature = AdminLogFeature {
7979
adminLogFeatureInterface :: HackageFeature
80+
, queryGetAdminLog :: forall m. MonadIO m => m AdminLog
8081
}
8182

8283
instance IsHackageFeature AdminLogFeature where
@@ -117,6 +118,9 @@ adminLogFeature UserFeature{..} adminLogState
117118
resourceGet = [("html", serveAdminLogGet)]
118119
}
119120

121+
queryGetAdminLog :: MonadIO m => m AdminLog
122+
queryGetAdminLog = queryState adminLogState GetAdminLog
123+
120124
serveAdminLogGet _ = do
121125
aLog <- queryState adminLogState GetAdminLog
122126
users <- queryGetUserDb

‎src/Distribution/Server/Features/Tags.hs

Lines changed: 13 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,6 @@ import Data.Function (fix)
3939
import Data.List (foldl')
4040
import Data.Char (toLower)
4141

42-
4342
data TagsFeature = TagsFeature {
4443
tagsFeatureInterface :: HackageFeature,
4544

@@ -64,6 +63,8 @@ data TagsFeature = TagsFeature {
6463
-- initial import.
6564
setCalculatedTag :: Tag -> Set PackageName -> IO (),
6665

66+
tagProposalLog :: MemState (Map PackageName (Set Tag, Set Tag)),
67+
6768
withTagPath :: forall a. DynamicPath -> (Tag -> Set PackageName -> ServerPartE a) -> ServerPartE a,
6869
collectTags :: forall m. MonadIO m => Set PackageName -> m (Map PackageName (Set Tag)),
6970
putTags :: Maybe String -> Maybe String -> Maybe String -> Maybe String -> PackageName -> ServerPartE (),
@@ -97,9 +98,10 @@ initTagsFeature ServerEnv{serverStateDir} = do
9798
tagAlias <- tagsAliasComponent serverStateDir
9899
specials <- newMemStateWHNF emptyPackageTags
99100
updateTag <- newHook
101+
tagProposalLog <- newMemStateWHNF Map.empty
100102

101103
return $ \core@CoreFeature{..} upload user -> do
102-
let feature = tagsFeature core upload user tagsState tagAlias specials updateTag
104+
let feature = tagsFeature core upload user tagsState tagAlias specials updateTag tagProposalLog
103105

104106
registerHookJust packageChangeHook isPackageChangeAny $ \(pkgid, mpkginfo) ->
105107
case mpkginfo of
@@ -148,6 +150,7 @@ tagsFeature :: CoreFeature
148150
-> StateComponent AcidState TagAlias
149151
-> MemState PackageTags
150152
-> Hook (Set PackageName, Set Tag) ()
153+
-> MemState (Map PackageName (Set Tag, Set Tag))
151154
-> TagsFeature
152155

153156
tagsFeature CoreFeature{ queryGetPackageIndex }
@@ -157,6 +160,7 @@ tagsFeature CoreFeature{ queryGetPackageIndex }
157160
tagsAlias
158161
calculatedTags
159162
tagsUpdated
163+
tagProposalLog
160164
= TagsFeature{..}
161165
where
162166
tagsResource = fix $ \r -> TagsResource
@@ -277,8 +281,10 @@ tagsFeature CoreFeature{ queryGetPackageIndex }
277281
Nothing -> []
278282
addRev = Set.difference (fst revTags) (Set.fromList add `Set.union` Set.fromList radd')
279283
delRev = Set.difference (snd revTags) (Set.fromList del `Set.union` Set.fromList rdel')
280-
void $ updateState tagsState $ SetPackageTags pkgname tagSet
281-
void $ updateState tagsState $ InsertReviewTags' pkgname addRev delRev
284+
modifyTags (a, d) = (a `Set.intersection` addRev, d `Set.intersection` delRev)
285+
updateState tagsState $ SetPackageTags pkgname tagSet
286+
updateState tagsState $ InsertReviewTags' pkgname addRev delRev
287+
modifyMemState tagProposalLog (Map.adjust modifyTags pkgname)
282288
runHook_ tagsUpdated (Set.singleton pkgname, tagSet)
283289
return ()
284290
else if user
@@ -287,7 +293,9 @@ tagsFeature CoreFeature{ queryGetPackageIndex }
287293
calcTags <- queryTagsForPackage pkgname
288294
let addTags = Set.fromList aliases `Set.difference` calcTags
289295
delTags = Set.fromList del `Set.intersection` calcTags
290-
void $ updateState tagsState $ InsertReviewTags pkgname addTags delTags
296+
updateState tagsState $ InsertReviewTags pkgname addTags delTags
297+
modifyMemState tagProposalLog (Map.insertWith (<>) pkgname (addTags, delTags))
298+
return ()
291299
else errBadRequest "Authorization Error" [MText "You need to be logged in to propose tags"]
292300
_ -> errBadRequest "Tags not recognized" [MText "Couldn't parse your tag list. It should be comma separated with any number of alphanumerical tags. Tags can also also have -+#*."]
293301
Nothing -> errBadRequest "Tags not recognized" [MText "Couldn't parse your tag list. It should be comma separated with any number of alphanumerical tags. Tags can also also have -+#*."]

0 commit comments

Comments
 (0)