DB: Add received::UTCTime field to InboxItem

To record *when* an activity, local or remote, was inserted into the specific
inbox. I'm surprised I haven't been keeping that data until now :P

src/Vervis/API.hs

@@ -1441,9 +1441,9 @@ createTicketTrackerC (Entity pidUser personUser) senderActor summary audience tr
         -- Deliver the Follow and Accept by simply manually inserting them to
         -- deck and sender inboxes respectively
         lift $ do
-            ibiidF <- insert $ InboxItem False
+            ibiidF <- insert $ InboxItem False now
             insert_ $ InboxItemLocal ibidDeck obiidFollow ibiidF
-            ibiidA <- insert $ InboxItem False
+            ibiidA <- insert $ InboxItem False now
             insert_ $ InboxItemLocal (actorInbox senderActor) obiidAccept ibiidA
 
         -- Return instructions for HTTP delivery to remote recipients
@@ -1634,6 +1634,7 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
     federation <- asksSite $ appFederation . appSettings
     unless (federation || null remoteRecips) $
         throwE "Federation disabled, but remote recipients specified"
+    now <- liftIO getCurrentTime
     senderHash <- encodeKeyHashid pidSender
     mfollowee <- do
         let ObjURI h luObject = uObject
@@ -1665,7 +1666,7 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
         actorSender <- lift $ getJust actorSenderID
         let ibidSender = actorInbox actorSender
             obidSender = actorOutbox actorSender
-        (obiidFollow, doc, luFollow) <- lift $ insertFollowToOutbox senderHash obidSender blinded
+        (obiidFollow, doc, luFollow) <- lift $ insertFollowToOutbox now senderHash obidSender blinded
         case mfollowee of
             Nothing -> lift $ insert_ $ FollowRemoteRequest pidSender uObject muContext (not hide) obiidFollow
             Just (followee, actorRecip) -> do
@@ -1675,8 +1676,8 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
                 obiidAccept <- lift $ insertAcceptToOutbox senderHash luFollow actorRecip obidRecip
                 let ibidRecip = actorInbox actorRecipDB
                     fsid = fromMaybe (actorFollowers actorRecipDB) mfsid
-                deliverFollowLocal actorSenderID fsid unread obiidFollow obiidAccept ibidRecip
+                deliverFollowLocal now actorSenderID fsid unread obiidFollow obiidAccept ibidRecip
-                lift $ deliverAcceptLocal obiidAccept ibidSender
+                lift $ deliverAcceptLocal now obiidAccept ibidSender
         remotesHttp <- lift $ deliverRemoteDB'' fwdHosts obiidFollow remoteRecips []
         return (obiidFollow, doc, remotesHttp)
     lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp' fwdHosts obiidFollow doc remotesHttp
@@ -1731,10 +1732,9 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
             fromMaybeE mticket "Follow object: No such cloth in DB"
         return (actor, Just $ ticketFollowers ticket, False)
 
-    insertFollowToOutbox senderHash obid blinded = do
+    insertFollowToOutbox now senderHash obid blinded = do
         encodeRouteLocal <- getEncodeRouteLocal
         hLocal <- asksSite siteInstanceHost
-        now <- liftIO getCurrentTime
         obiid <- insertEmptyOutboxItem obid now
         obikhid <- encodeKeyHashid obiid
         let luFollow = encodeRouteLocal $ PersonOutboxItemR senderHash obikhid
@@ -1791,14 +1791,14 @@ followC (Entity pidSender personSender) summary audience follow@(AP.Follow uObje
         update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
         return obiid
 
-    deliverFollowLocal aidSender fsid unread obiidF obiidA ibidRecip = do
+    deliverFollowLocal now aidSender fsid unread obiidF obiidA ibidRecip = do
         mfid <- lift $ insertUnique $ Follow aidSender fsid (not hide) obiidF obiidA
         _ <- fromMaybeE mfid "Already following this object"
-        ibiid <- lift $ insert $ InboxItem unread
+        ibiid <- lift $ insert $ InboxItem unread now
         lift $ insert_ $ InboxItemLocal ibidRecip obiidF ibiid
 
-    deliverAcceptLocal obiidAccept ibidAuthor = do
+    deliverAcceptLocal now obiidAccept ibidAuthor = do
-        ibiid <- insert $ InboxItem True
+        ibiid <- insert $ InboxItem True now
         insert_ $ InboxItemLocal ibidAuthor obiidAccept ibiid
 
 data Result
@@ -3122,11 +3122,11 @@ pushCommitsC eperson summary push shrRepo rpRepo = do
                 ( L.delete pidAuthor $ union repoPids $ union pfsPids rfsPids
                 , repoRemotes `unionRemotes` pfsRemotes `unionRemotes` rfsRemotes
                 )
-        ibiid <- insert $ InboxItem False
+        ibiid <- insert $ InboxItem False now
         insert_ $ InboxItemLocal (repoInbox repo) obiid ibiid
         for_ pids $ \ pid -> do
             ibid <- personInbox <$> getJust pid
-            ibiid <- insert $ InboxItem True
+            ibiid <- insert $ InboxItem True now
             insert_ $ InboxItemLocal ibid obiid ibiid
         return remotes
 -}

src/Vervis/Delivery.hs

@@ -655,7 +655,8 @@ insertActivityToLocalInboxes makeInboxItem requireOwner mauthor maidAuthor recip
     inboxIDs <-
         map (actorInbox . entityVal) <$>
             selectList [ActorId <-. localRecipients] []
-    inboxItemIDs <- insertMany $ replicate (length inboxIDs) $ InboxItem True
+    now <- liftIO getCurrentTime
+    inboxItemIDs <- insertMany $ replicate (length inboxIDs) $ InboxItem True now
     insertMany_ $ zipWith makeInboxItem inboxIDs inboxItemIDs
 
     -- Return remote followers, to whom we need to deliver via HTTP

src/Vervis/Federation/Util.hs

@@ -67,7 +67,7 @@ insertToInbox' now author body ibid luAct unread = do
         , remoteActivityContent  = persistJSONFromBL $ actbBL body
         , remoteActivityReceived = now
         }
-    ibiid <- insert $ InboxItem unread
+    ibiid <- insert $ InboxItem unread now
     mibrid <- insertUnique $ InboxItemRemote ibid ractid ibiid
     case mibrid of
         Nothing -> do

src/Vervis/Handler/Person.hs

@@ -151,10 +151,11 @@ verifyLocalActivityExistsInDB actorByKey outboxItemID = do
         throwE "Actor-in-URI and Actor-owning-the-outbox-item-in-DB mismatch"
 
 insertActivityToInbox
-    :: MonadIO m => ActorId -> OutboxItemId -> ReaderT SqlBackend m Bool
+    :: MonadIO m
-insertActivityToInbox recipActorID outboxItemID = do
+    => UTCTime -> ActorId -> OutboxItemId -> ReaderT SqlBackend m Bool
+insertActivityToInbox now recipActorID outboxItemID = do
     inboxID <- actorInbox <$> getJust recipActorID
-    inboxItemID <- insert $ InboxItem True
+    inboxItemID <- insert $ InboxItem True now
     maybeItem <- insertUnique $ InboxItemLocal inboxID outboxItemID inboxItemID
     case maybeItem of
         Nothing -> do
@@ -171,7 +172,7 @@ postPersonInboxR recipPersonHash = postInbox handle
         -> ActivityBody
         -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
 
-    handle _ (ActivityAuthLocal authorByKey) body = (,Nothing) <$> do
+    handle now (ActivityAuthLocal authorByKey) body = (,Nothing) <$> do
         outboxItemID <-
             parseAuthenticatedLocalActivityURI
                 authorByKey
@@ -183,7 +184,7 @@ postPersonInboxR recipPersonHash = postInbox handle
             if LocalActorPerson recipPersonID == authorByKey
                 then return "Received activity authored by self, ignoring"
                 else lift $ do
-                    inserted <- insertActivityToInbox (personActor recipPerson) outboxItemID
+                    inserted <- insertActivityToInbox now (personActor recipPerson) outboxItemID
                     return $
                         if inserted
                             then "Activity inserted to recipient's inbox"

src/Vervis/Migration.hs

@@ -2552,6 +2552,8 @@ changes hLocal ctx =
     , renameField "CollabTopicLocalAccept" "collabNew" "collab"
       -- 451
     , addEntities model_451_collab_remote_accept
+      -- 452
+    , addFieldPrimRequired "InboxItem" defaultTime "received"
     ]
 
 migrateDB

th/models

@@ -77,7 +77,8 @@ OutboxItem
 Inbox
 
 InboxItem
-    unread Bool
+    unread   Bool
+    received UTCTime
 
 InboxItemLocal
     inbox    InboxId