stern: Optimize RAM usage of /i/users/meta-info

changelog.d/5-internal/optimize-stern

@@ -0,0 +1 @@
+stern: Optimize RAM usage of /i/users/meta-info

tools/stern/src/Stern/API.hs

@@ -402,9 +402,9 @@ getUserData :: UserId -> Maybe Int -> Maybe Int -> Handler UserMetaInfo
 getUserData uid mMaxConvs mMaxNotifs = do
   account <- Intra.getUserProfiles (Left [uid]) >>= noSuchUser . listToMaybe
   conns <- Intra.getUserConnections uid
-  convs <- Intra.getUserConversations uid <&> take (fromMaybe 1 mMaxConvs)
+  convs <- Intra.getUserConversations uid (fromMaybe 1 mMaxConvs)
   clts <- Intra.getUserClients uid
-  notfs <- (Intra.getUserNotifications uid <&> take (fromMaybe 10 mMaxNotifs) <&> toJSON @[QueuedNotification]) `catchE` (pure . String . cs . show)
+  notfs <- (Intra.getUserNotifications uid (fromMaybe 10 mMaxNotifs) <&> toJSON @[QueuedNotification]) `catchE` (pure . String . cs . show)
   consent <- (Intra.getUserConsentValue uid <&> toJSON @ConsentValue) `catchE` (pure . String . cs . show)
   consentLog <- (Intra.getUserConsentLog uid <&> toJSON @ConsentLog) `catchE` (pure . String . cs . show)
   cookies <- Intra.getUserCookies uid

tools/stern/src/Stern/Intra.hs

@@ -749,25 +749,27 @@ getUserCookies uid = do
         )
   parseResponse (mkError status502 "bad-upstream") r
 
-getUserConversations :: UserId -> Handler [Conversation]
-getUserConversations uid = do
+getUserConversations :: UserId -> Int -> Handler [Conversation]
+getUserConversations uid maxConvs = do
   info $ msg "Getting user conversations"
-  fetchAll [] Nothing
+  fetchAll [] Nothing maxConvs
   where
-    fetchAll xs start = do
-      userConversationList <- fetchBatch start
+    fetchAll :: [Conversation] -> Maybe ConvId -> Int -> Handler [Conversation]
+    fetchAll xs start remaining = do
+      userConversationList <- fetchBatch start (min 100 remaining)
       let batch = convList userConversationList
-      if (not . null) batch && convHasMore userConversationList
-        then fetchAll (batch ++ xs) (Just . qUnqualified . cnvQualifiedId $ last batch)
+          remaining' = remaining - length batch
+      if (not . null) batch && convHasMore userConversationList && remaining' > 0
+        then fetchAll (batch ++ xs) (Just . qUnqualified . cnvQualifiedId $ last batch) remaining'
         else pure (batch ++ xs)
-    fetchBatch :: Maybe ConvId -> Handler (ConversationList Conversation)
-    fetchBatch start = do
-      b <- view galley
+    fetchBatch :: Maybe ConvId -> Int -> Handler (ConversationList Conversation)
+    fetchBatch start batchSize = do
+      baseReq <- view galley
       r <-
         catchRpcErrors $
           rpc'
             "galley"
-            b
+            baseReq
             ( method GET
                 . header "Z-User" (toByteString' uid)
                 . versionedPath "conversations"
@@ -776,7 +778,6 @@ getUserConversations uid = do
                 . expect2xx
             )
       unVersioned @'V2 <$> parseResponse (mkError status502 "bad-upstream") r
-    batchSize = 100 :: Int
 
 getUserClients :: UserId -> Handler [Client]
 getUserClients uid = do
@@ -829,25 +830,27 @@ getUserProperties uid = do
       value <- parseResponse (mkError status502 "bad-upstream") r
       fetchProperty b xs (Map.insert x value acc)
 
-getUserNotifications :: UserId -> Handler [QueuedNotification]
-getUserNotifications uid = do
+getUserNotifications :: UserId -> Int -> Handler [QueuedNotification]
+getUserNotifications uid maxNotifs = do
   info $ msg "Getting user notifications"
-  fetchAll [] Nothing
+  fetchAll [] Nothing maxNotifs
   where
-    fetchAll xs start = do
-      userNotificationList <- fetchBatch start
+    fetchAll :: [QueuedNotification] -> Maybe NotificationId -> Int -> ExceptT Error App [QueuedNotification]
+    fetchAll xs start remaining = do
+      userNotificationList <- fetchBatch start (min 100 remaining)
       let batch = view queuedNotifications userNotificationList
-      if (not . null) batch && view queuedHasMore userNotificationList
-        then fetchAll (batch ++ xs) (Just . view queuedNotificationId $ last batch)
+          remaining' = remaining - length batch
+      if (not . null) batch && view queuedHasMore userNotificationList && remaining' > 0
+        then fetchAll (batch ++ xs) (Just . view queuedNotificationId $ last batch) remaining'
         else pure (batch ++ xs)
-    fetchBatch :: Maybe NotificationId -> Handler QueuedNotificationList
-    fetchBatch start = do
-      b <- view gundeck
+    fetchBatch :: Maybe NotificationId -> Int -> Handler QueuedNotificationList
+    fetchBatch start batchSize = do
+      baseReq <- view gundeck
       r <-
         catchRpcErrors $
           rpc'
-            "galley"
-            b
+            "gundeck"
+            baseReq
             ( method GET
                 . header "Z-User" (toByteString' uid)
                 . versionedPath "notifications"
@@ -861,7 +864,6 @@ getUserNotifications uid = do
         200 -> parseResponse (mkError status502 "bad-upstream") r
         404 -> parseResponse (mkError status502 "bad-upstream") r
         _ -> throwE (mkError status502 "bad-upstream" "")
-    batchSize = 100 :: Int
 
 getSsoDomainRedirect :: Text -> Handler (Maybe CustomBackend)
 getSsoDomainRedirect domain = do