Look up only mentioned users for notifications and the legacy index

src/Distribution/Server/Features/Core.hs

@@ -30,6 +30,7 @@ import qualified Data.Foldable                                      as Foldable
 import qualified Data.Text                                          as Text
 import           Data.Time.Clock                                    (UTCTime, getCurrentTime)
 import           Data.Time.Format                                   (defaultTimeLocale, formatTime)
+import           Data.Containers.ListUtils                          (nubOrd)
 import qualified Data.Vector                                        as Vec
 
 -- hackage
@@ -621,12 +622,13 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
     --
     getIndexTarball :: IO IndexTarballInfo
     getIndexTarball = do
-      users <- queryGetUserDb  -- note, changes here don't automatically propagate
       time  <- getCurrentTime
       Acid.PackagesState index (Right updateSeq) <- Store.getPackagesState packagesStore
+      -- note, changes to users here don't automatically propagate
+      userIdToName <- queryUserNamesFor (nubOrd (map pkgLatestUploadUser (PackageIndex.allPackages index)))
       let updateLog     = Foldable.toList updateSeq
           legacyTarball = Packages.Index.writeLegacy
-                            users
+                            userIdToName
                             (Packages.Index.legacyExtras updateLog)
                             index
           incremTarball = Packages.Index.writeIncremental

src/Distribution/Server/Features/UserNotify.hs

@@ -15,6 +15,7 @@ module Distribution.Server.Features.UserNotify (
 
     -- * getNotificationEmails
     getNotificationEmails,
+    notificationUserIds,
   ) where
 
 import Distribution.Server.Features.UserDetails.Types
@@ -29,9 +30,8 @@ import Distribution.Package
 import Distribution.Pretty
 import Distribution.Version
 
-import qualified Distribution.Server.Users.Users as Users
 import Distribution.Server.Users.Group
-import Distribution.Server.Users.Types (UserId, UserInfo (..))
+import Distribution.Server.Users.Types (UserId, UserInfo (..), UserName)
 import Distribution.Server.Users.UserIdSet as UserIdSet
 
 import Distribution.Server.Packages.Types
@@ -481,8 +481,6 @@ userNotifyFeature UserFeature{..}
         let trimLastTime = if diffUTCTime now lastNotifyTime > (60*60*6) -- cap at 6hr
                              then addUTCTime (negate $ (60*60*6)) now
                              else lastNotifyTime -- for testing you can increase this
-        users <- queryGetUserDb
-
         revisionsAndUploads <- queryLatestUploadsBetween trimLastTime now
         revisionUploadNotifications <- concatMapM (genRevUploadList notifyPrefs trimLastTime now) revisionsAndUploads
 
@@ -501,16 +499,18 @@ userNotifyFeature UserFeature{..}
 
         vouchNotifications <- fmap (, NotifyVouchingCompleted) <$> drainQueuedNotifications
 
+        let notifications =
+              concat
+                [ revisionUploadNotifications
+                , groupActionNotifications
+                , docReportNotifications
+                , tagProposalNotifications
+                , dependencyUpdateNotifications
+                , vouchNotifications
+                ]
+        userIdToName <- queryUserNamesFor (concatMap notificationUserIds notifications)
         emails <-
-          getNotificationEmails userFeatureServerEnv userDetailsFeature users templates $
-            concat
-              [ revisionUploadNotifications
-              , groupActionNotifications
-              , docReportNotifications
-              , tagProposalNotifications
-              , dependencyUpdateNotifications
-              , vouchNotifications
-              ]
+          getNotificationEmails userFeatureServerEnv userDetailsFeature userIdToName templates notifications
         mapM_ sendNotifyEmailAndDelay emails
 
         Store.setNotifyTime notifyStore now
@@ -649,6 +649,19 @@ userNotifyFeature UserFeature{..}
       -- send out too many emails
       threadDelay 250000
 
+-- | The users whose names the email for a notification shows, including its
+-- recipient.
+notificationUserIds :: (UserId, Notification) -> [UserId]
+notificationUserIds (recipient, notif) =
+  recipient : case notif of
+    NotifyNewVersion{notifyPackageInfo} -> [pkgLatestUploadUser notifyPackageInfo]
+    NotifyNewRevision{notifyRevisions} -> map snd notifyRevisions
+    NotifyMaintainerUpdate{notifyUserActor, notifyUserSubject} -> [notifyUserActor, notifyUserSubject]
+    NotifyDocsBuild{} -> []
+    NotifyUpdateTags{} -> []
+    NotifyDependencyUpdate{} -> []
+    NotifyVouchingCompleted -> []
+
 -- | Notifications in the same group are batched in the same email.
 --
 -- TODO: How often do multiple notifications come in at once? Maybe it's
@@ -662,14 +675,14 @@ data NotificationGroup
 getNotificationEmails
   :: ServerEnv
   -> UserDetailsFeature
-  -> Users.Users
+  -> (UserId -> UserName)
   -> Templates
   -> [(UserId, Notification)]
   -> IO [Mail]
 getNotificationEmails
   ServerEnv{serverBaseURI}
   UserDetailsFeature{queryUserDetails}
-  allUsers
+  userIdToName
   templates
   notifications = do
     let userIds = Set.fromList $ map fst notifications
@@ -725,7 +738,7 @@ getNotificationEmails
               { uriPath =
                   concatMap ("/" <>)
                     [ "user"
-                    , display $ Users.userIdToName allUsers uid
+                    , display $ userIdToName uid
                     , "notify"
                     ]
               }
@@ -850,7 +863,7 @@ getNotificationEmails
           { uriPath = "/package/" <> display (packageName pkg) <> "-" <> display (packageVersion pkg)
           }
 
-    renderUser = emailContentDisplay . Users.userIdToName allUsers
+    renderUser = emailContentDisplay . userIdToName
 
     renderTime = emailContentStr . formatTime defaultTimeLocale "%c"
 

src/Distribution/Server/Packages/Index.hs

@@ -22,8 +22,6 @@ import Distribution.Server.Packages.Types
          , pkgLatestCabalFileText, pkgLatestUploadInfo
          )
 import Distribution.Server.Packages.Metadata
-import Distribution.Server.Users.Users
-         ( Users, userIdToName )
 import Distribution.Server.Users.Types
          ( UserId(..), UserName(..) )
 
@@ -170,8 +168,8 @@ legacyExtras = go Map.empty
 -- compression), contains at most one preferred-version per package (important
 -- because of a bug in cabal which would otherwise merge all preferred-versions
 -- files for a package), and does not contain the TUF files.
-writeLegacy :: Users -> Map String (LazyByteString, UTCTime) -> PackageIndex PkgInfo -> LazyByteString
-writeLegacy users =
+writeLegacy :: (UserId -> UserName) -> Map String (LazyByteString, UTCTime) -> PackageIndex PkgInfo -> LazyByteString
+writeLegacy userIdToName =
     writeLegacyAux (fromStrict . cabalFileByteString . pkgLatestCabalFileText) setModTime
   . extraEntries
   where
@@ -187,7 +185,7 @@ writeLegacy users =
         }
       }
 
-    userName = display . userIdToName users
+    userName = display . userIdToName
 
     extraEntries :: Map FilePath (LazyByteString, UTCTime) -> [Tar.Entry]
     extraEntries emap = do

src/Distribution/Server/Users/Users.hs

@@ -25,7 +25,6 @@ module Distribution.Server.Users.Users (
     lookupAuthToken,
 
     -- ** Lookup utils
-    userIdToName,
     userIdToNameIn,
     userNameOrPlaceholder,
 
@@ -169,14 +168,8 @@ lookupAuthToken authTok users =
        uinfo <- lookupUserId uid users
        return (uid, uinfo)
 
--- | Convert a 'UserId' to a 'UserName'. If the user id doesn't exist,
--- an ugly placeholder is used instead.
---
-userIdToName :: Users -> UserId -> UserName
-userIdToName users userId =
-    userNameOrPlaceholder userId (lookupUserId userId users)
-
--- | Like 'userIdToName', but for users that have already been looked up.
+-- | Convert a 'UserId' to a 'UserName' using users that have already been
+-- looked up. If the user id is missing, an ugly placeholder is used instead.
 --
 userIdToNameIn :: Map.Map UserId UserInfo -> UserId -> UserName
 userIdToNameIn infos userId =

tests/ReverseDependenciesTest.hs

@@ -377,7 +377,6 @@ getNotificationEmailsTests =
           . getNotificationEmail
               testServerEnv
               testUserDetailsFeature
-              allUsers
               userWatcher
           $ NotifyDependencyUpdate
               { notifyPackageId = PackageIdentifier "base" (mkVersion [4, 18, 0, 0])
@@ -389,7 +388,6 @@ getNotificationEmailsTests =
           . getNotificationEmail
               testServerEnv
               testUserDetailsFeature
-              allUsers
               userWatcher
           $ NotifyDependencyUpdate
               { notifyPackageId = PackageIdentifier "base" (mkVersion [4, 18, 0, 0])
@@ -401,7 +399,6 @@ getNotificationEmailsTests =
           . getNotificationEmail
               testServerEnv
               testUserDetailsFeature
-              allUsers
               userWatcher
           $ NotifyDependencyUpdate
               { notifyPackageId = PackageIdentifier "base" (mkVersion [4, 18, 0, 0])
@@ -468,8 +465,8 @@ getNotificationEmailsTests =
           <*> addUser "user-actor"
           <*> addUser "user-subject"
 
-    getNotificationEmail env details users uid notif =
-      getNotificationEmails env details users (mockTemplates ["datafiles/templates/UserNotify"] ["endorsements-complete.txt"]) [(uid, notif)] >>= \case
+    getNotificationEmail env details uid notif =
+      getNotificationEmails env details (mentionedUserNames [(uid, notif)]) (mockTemplates ["datafiles/templates/UserNotify"] ["endorsements-complete.txt"]) [(uid, notif)] >>= \case
         [email] -> pure email
         _ -> error "Did not get exactly one email"
 
@@ -490,17 +487,25 @@ getNotificationEmailsTests =
                   , accountAdminNotes = ""
                   }
         }
-    getNotificationEmailsMocked =
+    getNotificationEmailsMocked notifs =
       getNotificationEmails
         testServerEnv
         testUserDetailsFeature
-        allUsers
+        (mentionedUserNames notifs)
         (mockTemplates ["datafiles/templates/UserNotify"] ["endorsements-complete.txt"])
+        notifs
     getNotificationEmailMocked =
       getNotificationEmail
         testServerEnv
         testUserDetailsFeature
-        allUsers
+    -- Resolves only the users that notificationUserIds lists, as the
+    -- notification job does.
+    mentionedUserNames notifs =
+      Users.userIdToNameIn . Map.fromList $
+        [ (uid, uinfo)
+        | uid <- concatMap notificationUserIds notifs
+        , Just uinfo <- [Users.lookupUserId uid allUsers]
+        ]
 
     renderMail = fst . Mail.renderMail (mkStdGen 0)
     timestamp = Time.UTCTime (Time.fromGregorian 2020 1 1) 0