Skip to content

Commit 294110b

Browse files
gbazgbaz
authored
Merge pull request #1257 from haskell/janus/vouch
Add vouching
2 parents 22b5612 + 36ab220 commit 294110b

File tree

8 files changed

+458
-3
lines changed

8 files changed

+458
-3
lines changed

‎datafiles/templates/Html/vouch.html.st

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
<!DOCTYPE html>
2+
<html>
3+
<head>
4+
$hackageCssTheme()$
5+
<title>Endorse user | Hackage</title>
6+
</head>
7+
8+
<body>
9+
$hackagePageHeader()$
10+
11+
<div id="content">
12+
<h2>Endorse user</h2>
13+
14+
<p>$msg$</p>
15+
16+
<form action="" method=POST>
17+
<input type=submit value="Endorse this user">
18+
</form>
19+
20+
<p>Endorsing cannot be undone! When the user has $requiredNumber$ endorsements, the user
21+
will be added to the uploaders group, and allowed to upload packages. Only endorse people who you trust to upload packages responsibly.</p>
22+
<ul>
23+
$vouches$
24+
</ul>
25+
26+
</div>
27+
</body></html>

‎hackage-server.cabal

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -374,8 +374,9 @@ library lib-server
374374
Distribution.Server.Features.Search.TermBag
375375
Distribution.Server.Features.Sitemap.Functions
376376
Distribution.Server.Features.Votes
377-
Distribution.Server.Features.Votes.State
378377
Distribution.Server.Features.Votes.Render
378+
Distribution.Server.Features.Votes.State
379+
Distribution.Server.Features.Vouch
379380
Distribution.Server.Features.RecentPackages
380381
Distribution.Server.Features.PreferredVersions
381382
Distribution.Server.Features.PreferredVersions.State
@@ -574,6 +575,14 @@ test-suite HighLevelTest
574575
, io-streams ^>= 1.5.0.1
575576
, http-io-streams ^>= 0.1.6.1
576577

578+
test-suite VouchTest
579+
import: test-defaults
580+
type: exitcode-stdio-1.0
581+
main-is: VouchTest.hs
582+
build-depends:
583+
, tasty ^>= 1.4
584+
, tasty-hunit ^>= 0.10
585+
577586
test-suite ReverseDependenciesTest
578587
import: test-defaults
579588
type: exitcode-stdio-1.0

‎src/Distribution/Server/Features.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ import Distribution.Server.Features.Votes (initVotesFeature)
5151
import Distribution.Server.Features.Sitemap (initSitemapFeature)
5252
import Distribution.Server.Features.UserNotify (initUserNotifyFeature)
5353
import Distribution.Server.Features.PackageFeed (initPackageFeedFeature)
54+
import Distribution.Server.Features.Vouch (initVouchFeature)
5455
#endif
5556
import Distribution.Server.Features.ServerIntrospect (serverIntrospectFeature)
5657

@@ -159,6 +160,8 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
159160
initUserNotifyFeature env
160161
mkPackageFeedFeature <- logStartup "package feed" $
161162
initPackageFeedFeature env
163+
mkVouchFeature <- logStartup "vouch" $
164+
initVouchFeature env
162165
mkBrowseFeature <- logStartup "browse" $
163166
initBrowseFeature env
164167
mkPackageJSONFeature <- logStartup "package info JSON" $
@@ -344,6 +347,10 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
344347
tagsFeature
345348
tarIndexCacheFeature
346349

350+
vouchFeature <- mkVouchFeature
351+
usersFeature
352+
uploadFeature
353+
347354
userNotifyFeature <- mkUserNotifyFeature
348355
usersFeature
349356
coreFeature
@@ -353,6 +360,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
353360
reportsCoreFeature
354361
tagsFeature
355362
reverseFeature
363+
vouchFeature
356364

357365
packageFeedFeature <- mkPackageFeedFeature
358366
coreFeature
@@ -415,6 +423,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
415423
, getFeatureInterface userNotifyFeature
416424
, getFeatureInterface packageFeedFeature
417425
, getFeatureInterface packageInfoJSONFeature
426+
, getFeatureInterface vouchFeature
418427
#endif
419428
, staticFilesFeature
420429
, serverIntrospectFeature allFeatures

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

Lines changed: 21 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ import Distribution.Server.Features.Tags
5252
import Distribution.Server.Features.Upload
5353
import Distribution.Server.Features.UserDetails
5454
import Distribution.Server.Features.Users
55+
import Distribution.Server.Features.Vouch
5556

5657
import Distribution.Server.Util.Email
5758

@@ -437,6 +438,7 @@ initUserNotifyFeature :: ServerEnv
437438
-> ReportsFeature
438439
-> TagsFeature
439440
-> ReverseFeature
441+
-> VouchFeature
440442
-> IO UserNotifyFeature)
441443
initUserNotifyFeature env@ServerEnv{ serverStateDir, serverTemplatesDir,
442444
serverTemplatesMode } = do
@@ -448,10 +450,10 @@ initUserNotifyFeature env@ServerEnv{ serverStateDir, serverTemplatesDir,
448450
[serverTemplatesDir, serverTemplatesDir </> "UserNotify"]
449451
[ "user-notify-form.html" ]
450452

451-
return $ \users core uploadfeature adminlog userdetails reports tags revers -> do
453+
return $ \users core uploadfeature adminlog userdetails reports tags revers vouch -> do
452454
let feature = userNotifyFeature env
453455
users core uploadfeature adminlog userdetails reports tags
454-
revers notifyState templates
456+
revers vouch notifyState templates
455457
return feature
456458

457459
data InRange = InRange | OutOfRange
@@ -582,6 +584,7 @@ userNotifyFeature :: ServerEnv
582584
-> ReportsFeature
583585
-> TagsFeature
584586
-> ReverseFeature
587+
-> VouchFeature
585588
-> StateComponent AcidState NotifyData
586589
-> Templates
587590
-> UserNotifyFeature
@@ -594,6 +597,7 @@ userNotifyFeature serverEnv@ServerEnv{serverCron}
594597
ReportsFeature{..}
595598
TagsFeature{..}
596599
ReverseFeature{queryReverseIndex}
600+
VouchFeature{drainQueuedNotifications}
597601
notifyState templates
598602
= UserNotifyFeature {..}
599603

@@ -709,6 +713,8 @@ userNotifyFeature serverEnv@ServerEnv{serverCron}
709713
revIdx <- liftIO queryReverseIndex
710714
dependencyUpdateNotifications <- concatMapM (genDependencyUpdateList notifyPrefs idx revIdx . pkgInfoToPkgId) revisionsAndUploads
711715

716+
vouchNotifications <- fmap (, NotifyVouchingCompleted) <$> drainQueuedNotifications
717+
712718
emails <-
713719
getNotificationEmails serverEnv userDetailsFeature users $
714720
concat
@@ -717,6 +723,7 @@ userNotifyFeature serverEnv@ServerEnv{serverCron}
717723
, docReportNotifications
718724
, tagProposalNotifications
719725
, dependencyUpdateNotifications
726+
, vouchNotifications
720727
]
721728
mapM_ sendNotifyEmailAndDelay emails
722729

@@ -897,6 +904,7 @@ data Notification
897904
-- ^ Packages maintained by user that depend on updated dep
898905
, notifyTriggerBounds :: NotifyTriggerBounds
899906
}
907+
| NotifyVouchingCompleted
900908
deriving (Show)
901909

902910
data NotifyMaintainerUpdateType = MaintainerAdded | MaintainerRemoved
@@ -1021,6 +1029,10 @@ getNotificationEmails
10211029
notifyWatchedPackages
10221030
, DependencyNotification notifyPackageId
10231031
)
1032+
NotifyVouchingCompleted ->
1033+
generalNotification
1034+
renderNotifyVouchingCompleted
1035+
10241036
where
10251037
generalNotification = (, GeneralNotification)
10261038

@@ -1086,6 +1098,13 @@ getNotificationEmails
10861098
]
10871099
<> EmailContentList (map renderPkgLink revDeps)
10881100

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+
10891108
{----- Rendering helpers -----}
10901109

10911110
renderPackageName = emailContentStr . unPackageName

0 commit comments

Comments
 (0)