Rework paging for all paged endpoints

src/Share/Notifications/API.hs

@@ -9,7 +9,7 @@ module Share.Notifications.API
     SubscriptionRoutes (..),
     EmailRoutes (..),
     WebhookRoutes (..),
-    GetHubEntriesResponse (..),
+    GetHubEntriesCursor,
     StatusFilter (..),
     UpdateHubEntriesRequest (..),
     GetSubscriptionsResponse (..),
@@ -42,6 +42,7 @@ import Share.IDs
 import Share.Notifications.Types (DeliveryMethodId, HydratedEvent, NotificationDeliveryMethod, NotificationHubEntry, NotificationStatus, NotificationSubscription, NotificationTopic, NotificationTopicGroup, SubscriptionFilter)
 import Share.OAuth.Session (AuthenticatedUserId)
 import Share.Prelude
+import Share.Utils.API (Cursor, Paged)
 import Share.Utils.URI (URIParam)
 import Share.Web.Share.DisplayInfo.Types (UnifiedDisplayInfo)
 
@@ -209,20 +210,14 @@ instance FromJSON StatusFilter where
       Nothing -> fail "Empty status filter"
       Just statuses -> pure $ StatusFilter $ NESet.fromList statuses
 
+type GetHubEntriesCursor = (UTCTime, NotificationHubEntryId)
+
 type GetHubEntriesEndpoint =
   AuthenticatedUserId
     :> QueryParam "limit" Int
-    :> QueryParam "after" UTCTime
+    :> QueryParam "cursor" (Cursor GetHubEntriesCursor)
     :> QueryParam "status" StatusFilter
-    :> Get '[JSON] GetHubEntriesResponse
-
-data GetHubEntriesResponse = GetHubEntriesResponse
-  { notifications :: [NotificationHubEntry UnifiedDisplayInfo HydratedEvent]
-  }
-
-instance ToJSON GetHubEntriesResponse where
-  toJSON GetHubEntriesResponse {notifications} =
-    object ["notifications" .= notifications]
+    :> Get '[JSON] (Paged GetHubEntriesCursor (NotificationHubEntry UnifiedDisplayInfo HydratedEvent))
 
 type UpdateHubEntriesEndpoint =
   AuthenticatedUserId

src/Share/Notifications/Impl.hs

@@ -1,18 +1,21 @@
 module Share.Notifications.Impl (server) where
 
-import Control.Lens (forOf, traversed)
-import Data.Time
+import Control.Lens
 import Servant
 import Servant.Server.Generic (AsServerT)
 import Share.IDs
+import Share.Notifications.API (GetHubEntriesCursor)
 import Share.Notifications.API qualified as API
 import Share.Notifications.Ops qualified as NotifOps
 import Share.Notifications.Queries qualified as NotificationQ
+import Share.Notifications.Types
 import Share.Postgres qualified as PG
 import Share.Postgres.Ops qualified as UserQ
 import Share.User (User (..))
+import Share.Utils.API (Cursor, Paged, pagedOn)
 import Share.Web.App
 import Share.Web.Authorization qualified as AuthZ
+import Share.Web.Share.DisplayInfo.Types (UnifiedDisplayInfo)
 
 hubRoutes :: UserHandle -> API.HubEntriesRoutes (AsServerT WebApp)
 hubRoutes userHandle =
@@ -77,14 +80,22 @@ server userHandle =
       subscriptionsRoutes = subscriptionsRoutes userHandle
     }
 
-getHubEntriesEndpoint :: UserHandle -> UserId -> Maybe Int -> Maybe UTCTime -> Maybe API.StatusFilter -> WebApp API.GetHubEntriesResponse
-getHubEntriesEndpoint userHandle callerUserId limit afterTime mayStatusFilter = do
+getHubEntriesEndpoint ::
+  UserHandle ->
+  UserId ->
+  Maybe Int ->
+  Maybe (Cursor GetHubEntriesCursor) ->
+  Maybe API.StatusFilter ->
+  WebApp (Paged GetHubEntriesCursor (NotificationHubEntry UnifiedDisplayInfo HydratedEvent))
+getHubEntriesEndpoint userHandle callerUserId limit mayCursor mayStatusFilter = do
   User {user_id = notificationUserId} <- UserQ.expectUserByHandle userHandle
   _authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkNotificationsGet callerUserId notificationUserId
-  notifications <- PG.runTransaction do
-    notifs <- NotificationQ.listNotificationHubEntryPayloads notificationUserId limit afterTime (API.getStatusFilter <$> mayStatusFilter)
+  notifications <- PG.runTransaction $ do
+    notifs <- NotificationQ.listNotificationHubEntryPayloads notificationUserId limit mayCursor (API.getStatusFilter <$> mayStatusFilter)
     forOf (traversed . traversed) notifs NotifOps.hydrateEvent
-  pure $ API.GetHubEntriesResponse {notifications}
+  notifications
+    & pagedOn (\(NotificationHubEntry {hubEntryId, hubEntryCreatedAt}) -> (hubEntryCreatedAt, hubEntryId))
+    & pure
 
 updateHubEntriesEndpoint :: UserHandle -> UserId -> API.UpdateHubEntriesRequest -> WebApp ()
 updateHubEntriesEndpoint userHandle callerUserId API.UpdateHubEntriesRequest {notificationStatus, notificationIds} = do

src/Share/Notifications/Queries.hs

@@ -26,15 +26,16 @@ import Control.Lens
 import Data.Foldable qualified as Foldable
 import Data.Ord (clamp)
 import Data.Set.NonEmpty (NESet)
-import Data.Time (UTCTime)
 import Share.Contribution
 import Share.IDs
+import Share.Notifications.API (GetHubEntriesCursor)
 import Share.Notifications.Types
 import Share.Postgres
 import Share.Postgres qualified as PG
 import Share.Postgres.Contributions.Queries qualified as ContributionQ
 import Share.Postgres.Users.Queries qualified as UsersQ
 import Share.Prelude
+import Share.Utils.API (Cursor (..), CursorDirection (..))
 import Share.Web.Share.DisplayInfo.Queries qualified as DisplayInfoQ
 import Share.Web.Share.DisplayInfo.Types (UnifiedDisplayInfo)
 
@@ -55,19 +56,23 @@ expectEvent eventId = do
       WHERE id = #{eventId}
     |]
 
-listNotificationHubEntryPayloads :: UserId -> Maybe Int -> Maybe UTCTime -> Maybe (NESet NotificationStatus) -> Transaction e [NotificationHubEntry UnifiedDisplayInfo HydratedEventPayload]
-listNotificationHubEntryPayloads notificationUserId mayLimit afterTime statusFilter = do
+listNotificationHubEntryPayloads :: UserId -> Maybe Int -> Maybe (Cursor GetHubEntriesCursor) -> Maybe (NESet NotificationStatus) -> Transaction e [NotificationHubEntry UnifiedDisplayInfo HydratedEventPayload]
+listNotificationHubEntryPayloads notificationUserId mayLimit mayCursor statusFilter = do
   let limit = clamp (0, 1000) . fromIntegral @Int @Int32 . fromMaybe 50 $ mayLimit
   let statusFilterList = Foldable.toList <$> statusFilter
+  let cursorFilter = case mayCursor of
+        Nothing -> mempty
+        Just (Cursor (beforeTime, entryId) Previous) -> [PG.sql| AND (hub.created_at, hub.id) < (#{beforeTime}, #{entryId})|]
+        Just (Cursor (afterTime, entryId) Next) -> [PG.sql| AND (hub.created_at, hub.id) > (#{afterTime}, #{entryId})|]
   dbNotifications <-
     queryListRows @(NotificationHubEntry UserId NotificationEventData)
       [sql|
-      SELECT hub.id, hub.status, event.id, event.occurred_at, event.scope_user_id, event.actor_user_id, event.resource_id, event.topic, event.data
+      SELECT hub.id, hub.status, hub.created_at, event.id, event.occurred_at, event.scope_user_id, event.actor_user_id, event.resource_id, event.topic, event.data
         FROM notification_hub_entries hub
         JOIN notification_events event ON hub.event_id = event.id
       WHERE hub.user_id = #{notificationUserId}
             AND (#{statusFilterList} IS NULL OR hub.status = ANY(#{statusFilterList}::notification_status[]))
-            AND (#{afterTime} IS NULL OR event.occurred_at > #{afterTime})
+            ^{cursorFilter}
       ORDER BY hub.created_at DESC
       LIMIT #{limit}
     |]

src/Share/Notifications/Types.hs

@@ -390,24 +390,27 @@ instance Aeson.ToJSON (NotificationSubscription NotificationSubscriptionId) wher
 data NotificationHubEntry userInfo eventPayload = NotificationHubEntry
   { hubEntryId :: NotificationHubEntryId,
     hubEntryEvent :: NotificationEvent NotificationEventId userInfo UTCTime eventPayload,
-    hubEntryStatus :: NotificationStatus
+    hubEntryStatus :: NotificationStatus,
+    hubEntryCreatedAt :: UTCTime
   }
   deriving stock (Functor, Foldable, Traversable)
 
 instance (Aeson.ToJSON eventPayload, Aeson.ToJSON userInfo) => Aeson.ToJSON (NotificationHubEntry userInfo eventPayload) where
-  toJSON NotificationHubEntry {hubEntryId, hubEntryEvent, hubEntryStatus} =
+  toJSON NotificationHubEntry {hubEntryId, hubEntryEvent, hubEntryStatus, hubEntryCreatedAt} =
     Aeson.object
       [ "id" Aeson..= hubEntryId,
         "event" Aeson..= hubEntryEvent,
-        "status" Aeson..= hubEntryStatus
+        "status" Aeson..= hubEntryStatus,
+        "createdAt" Aeson..= hubEntryCreatedAt
       ]
 
 instance Hasql.DecodeRow (NotificationHubEntry UserId NotificationEventData) where
   decodeRow = do
     hubEntryId <- PG.decodeField
     hubEntryStatus <- PG.decodeField
+    hubEntryCreatedAt <- PG.decodeField
     hubEntryEvent <- PG.decodeRow
-    pure $ NotificationHubEntry {hubEntryId, hubEntryEvent, hubEntryStatus}
+    pure $ NotificationHubEntry {hubEntryId, hubEntryEvent, hubEntryStatus, hubEntryCreatedAt}
 
 hubEntryUserInfo_ :: Traversal (NotificationHubEntry userInfo eventPayload) (NotificationHubEntry userInfo' eventPayload) userInfo userInfo'
 hubEntryUserInfo_ f (NotificationHubEntry {hubEntryEvent, ..}) = do

src/Share/Postgres/Contributions/Queries.hs

@@ -28,7 +28,7 @@ import Data.List qualified as List
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Time (UTCTime)
-import Safe (lastMay)
+import Safe (headMay, lastMay)
 import Share.Codebase.Types (CodebaseEnv (..))
 import Share.Contribution (Contribution (..), ContributionStatus (..))
 import Share.IDs
@@ -112,7 +112,7 @@ listContributionsByProjectId ::
   Maybe UserId ->
   Maybe ContributionStatus ->
   Maybe ContributionKindFilter ->
-  PG.Transaction e (Maybe (Cursor ListContributionsCursor), [ShareContribution UserId])
+  PG.Transaction e (Paged ListContributionsCursor (ShareContribution UserId))
 listContributionsByProjectId projectId limit mayCursor mayUserFilter mayStatusFilter mayKindFilter = do
   let kindFilter = case mayKindFilter of
         Nothing -> "true"
@@ -122,11 +122,15 @@ listContributionsByProjectId projectId limit mayCursor mayUserFilter mayStatusFi
           OnlyContributorContributions -> [PG.sql| source_branch.contributor_id IS NOT NULL |]
   let cursorFilter = case mayCursor of
         Nothing -> "true"
-        Just (Cursor (beforeTime, contributionId)) ->
+        Just (Cursor (beforeTime, contributionId) Next) ->
           [PG.sql|
           (contribution.updated_at, contribution.id) < (#{beforeTime}, #{contributionId})
           |]
-  addCursor
+        Just (Cursor (afterTime, contributionId) Previous) ->
+          [PG.sql|
+          (contribution.updated_at, contribution.id) > (#{afterTime}, #{contributionId})
+          |]
+  paged
     <$> PG.queryListRows @(ShareContribution UserId)
       [PG.sql|
         SELECT
@@ -162,12 +166,15 @@ listContributionsByProjectId projectId limit mayCursor mayUserFilter mayStatusFi
         LIMIT #{limit}
       |]
   where
-    addCursor :: [ShareContribution UserId] -> (Maybe (Cursor ListContributionsCursor), [ShareContribution UserId])
-    addCursor xs =
-      ( lastMay xs <&> \(ShareContribution {updatedAt, contributionId}) ->
-          Cursor (updatedAt, contributionId),
-        xs
-      )
+    paged :: [ShareContribution UserId] -> Paged ListContributionsCursor (ShareContribution UserId)
+    paged items =
+      let prevCursor = headMay items <&> \(ShareContribution {updatedAt, contributionId}) -> Cursor (updatedAt, contributionId) Previous
+          nextCursor = lastMay items <&> \(ShareContribution {updatedAt, contributionId}) -> Cursor (updatedAt, contributionId) Next
+       in Paged
+            { items,
+              prevCursor,
+              nextCursor
+            }
 
 contributionById :: (PG.QueryA m) => ContributionId -> m Contribution
 contributionById contributionId = do
@@ -268,7 +275,7 @@ listContributionsByUserId ::
   Maybe (Cursor (UTCTime, ContributionId)) ->
   Maybe ContributionStatus ->
   Maybe ContributionKindFilter ->
-  PG.Transaction e (Maybe (Cursor (UTCTime, ContributionId)), [ShareContribution UserId])
+  PG.Transaction e (Paged (UTCTime, ContributionId) (ShareContribution UserId))
 listContributionsByUserId callerUserId userId limit mayCursor mayStatusFilter mayKindFilter = do
   let kindFilter = case mayKindFilter of
         Nothing -> "true"
@@ -278,11 +285,15 @@ listContributionsByUserId callerUserId userId limit mayCursor mayStatusFilter ma
           OnlyContributorContributions -> [PG.sql| source_branch.contributor_id IS NOT NULL |]
   let cursorFilter = case mayCursor of
         Nothing -> "true"
-        Just (Cursor (beforeTime, contributionId)) ->
+        Just (Cursor (beforeTime, contributionId) Next) ->
           [PG.sql|
           (contribution.updated_at, contribution.id) < (#{beforeTime}, #{contributionId})
           |]
-  addCursor
+        Just (Cursor (afterTime, contributionId) Previous) ->
+          [PG.sql|
+          (contribution.updated_at, contribution.id) > (#{afterTime}, #{contributionId})
+          |]
+  paged
     <$> PG.queryListRows @(ShareContribution UserId)
       [PG.sql|
       SELECT
@@ -313,12 +324,15 @@ listContributionsByUserId callerUserId userId limit mayCursor mayStatusFilter ma
       LIMIT #{limit}
       |]
   where
-    addCursor :: [ShareContribution UserId] -> (Maybe (Cursor ListContributionsCursor), [ShareContribution UserId])
-    addCursor xs =
-      ( lastMay xs <&> \(ShareContribution {updatedAt, contributionId}) ->
-          Cursor (updatedAt, contributionId),
-        xs
-      )
+    paged :: [ShareContribution UserId] -> (Paged ListContributionsCursor (ShareContribution UserId))
+    paged items =
+      let prevCursor = headMay items <&> \(ShareContribution {updatedAt, contributionId}) -> Cursor (updatedAt, contributionId) Previous
+          nextCursor = lastMay items <&> \(ShareContribution {updatedAt, contributionId}) -> Cursor (updatedAt, contributionId) Next
+       in Paged
+            { items,
+              prevCursor,
+              nextCursor
+            }
 
 -- | Note: Doesn't perform auth checks, the assumption is that if you already have access to
 -- the branchId you have access to all associated contributions.

src/Share/Postgres/Queries.hs

@@ -772,7 +772,8 @@ listBranchesByProject limit mayCursor mayBranchNamePrefix mayContributorQuery ki
         Just (Query branchNamePrefix) -> [PG.sql| AND starts_with(b.name, #{branchNamePrefix}) |]
   let cursorFilter = case mayCursor of
         Nothing -> mempty
-        Just (Cursor (beforeTime, branchId)) -> [PG.sql| AND (b.updated_at, b.id) < (#{beforeTime}, #{branchId})|]
+        Just (Cursor (beforeTime, branchId) Previous) -> [PG.sql| AND (b.updated_at, b.id) < (#{beforeTime}, #{branchId})|]
+        Just (Cursor (afterTime, branchId) Next) -> [PG.sql| AND (b.updated_at, b.id) > (#{afterTime}, #{branchId})|]
   let sql =
         intercalateMap
           "\n"
@@ -873,7 +874,8 @@ listContributorBranchesOfUserAccessibleToCaller contributorUserId mayCallerUserI
         Just (Query branchNamePrefix) -> [PG.sql| AND starts_with(b.name, #{branchNamePrefix}) |]
   let cursorFilter = case mayCursor of
         Nothing -> mempty
-        Just (Cursor (beforeTime, branchId)) -> [PG.sql| AND (b.updated_at, b.id) < (#{beforeTime}, #{branchId}) |]
+        Just (Cursor (beforeTime, branchId) Previous) -> [PG.sql| AND (b.updated_at, b.id) < (#{beforeTime}, #{branchId}) |]
+        Just (Cursor (afterTime, branchId) Next) -> [PG.sql| AND (b.updated_at, b.id) > (#{afterTime}, #{branchId}) |]
   let projectFilter = case mayProjectId of
         Nothing -> mempty
         Just projId -> [PG.sql| AND b.project_id = #{projId} |]
@@ -1128,8 +1130,10 @@ listReleasesByProject limit mayCursor mayVersionPrefix status projectId = do
              in numericalFilters
   let cursorFilter = case mayCursor of
         Nothing -> mempty
-        Just (Cursor (major, minor, patch, releaseId)) ->
+        Just (Cursor (major, minor, patch, releaseId) Previous) ->
           [PG.sql| AND (release.major_version, release.minor_version, release.patch_version, release.id) < (#{major}, #{minor}, #{patch}, #{releaseId}) |]
+        Just (Cursor (major, minor, patch, releaseId) Next) ->
+          [PG.sql| AND (release.major_version, release.minor_version, release.patch_version, release.id) >= (#{major}, #{minor}, #{patch}, #{releaseId}) |]
   let (sql) =
         intercalateMap
           "\n"