Add field errorSince to RemoteActor to track inbox POST unreachability

config/models

@@ -70,9 +70,10 @@ VerifKeySharedUsage
     UniqueVerifKeySharedUsage key user
 
 RemoteActor
-    ident    LocalURI
+    ident      LocalURI
-    instance InstanceId
+    instance   InstanceId
-    inbox    LocalURI
+    inbox      LocalURI
+    errorSince UTCTime Maybe
 
     UniqueRemoteActor instance ident
 

src/Vervis/Federation.hs

@@ -384,7 +384,7 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c
                                 Right actor -> withHostLock hRecip $ runDB $ do
                                     iid <- either entityKey id <$> insertBy (Instance hRecip)
                                     let luInbox = actorInbox actor
-                                    rsid <- either entityKey id <$> insertBy (RemoteActor luRecip iid luInbox)
+                                    rsid <- either entityKey id <$> insertBy (RemoteActor luRecip iid luInbox Nothing)
                                     update rdid [RemoteDiscussionActor =. Just rsid, RemoteDiscussionUnlinkedActor =. Nothing]
                                     return $ l2f hRecip luInbox
         -- TODO based on the httpPostAP usage in postOutboxR

src/Vervis/Handler/Inbox.hs

@@ -319,7 +319,7 @@ postOutboxR shr = do
                                 case miid of
                                     Just iid -> return (iid, False)
                                     Nothing -> idAndNew <$> insertBy (Instance h)
-                            let rs = RemoteActor lto iid inbox
+                            let rs = RemoteActor lto iid inbox Nothing
                             if inew
                                 then insert_ rs
                                 else insertUnique_ rs

src/Vervis/Migration.hs

@@ -238,6 +238,11 @@ changes =
     , renameEntity "RemoteSharer" "RemoteActor"
       -- 57
     , renameUnique "RemoteActor" "UniqueRemoteSharer" "UniqueRemoteActor"
+      -- 58
+    , addFieldPrimOptional
+        "RemoteActor"
+        (Nothing :: Maybe UTCTime)
+        "errorSince"
     ]
 
 migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int))

src/Vervis/RemoteActorStore.hs

@@ -135,7 +135,7 @@ instanceAndActor
     -> YesodDB site (InstanceId, RemoteActorId, Maybe Bool)
 instanceAndActor host luActor luInbox = do
     (iid, inew) <- idAndNew <$> insertBy (Instance host)
-    let rs = RemoteActor luActor iid luInbox
+    let rs = RemoteActor luActor iid luInbox Nothing
     if inew
         then do
             rsid <- insert rs
@@ -329,7 +329,7 @@ keyListedByActorShared iid vkid host luKey luActor = do
         RoomModeInstant -> do
             when reject $ throwE "Actor key storage limit is 0 and set to reject"
             luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
-            lift $ runDB $ either entityKey id <$> insertBy (RemoteActor luActor iid luInbox)
+            lift $ runDB $ either entityKey id <$> insertBy (RemoteActor luActor iid luInbox Nothing)
         RoomModeCached m -> do
             eresult <- do
                 ments <- lift $ runDB $ do
@@ -352,7 +352,7 @@ keyListedByActorShared iid vkid host luKey luActor = do
                         vkExists <- isJust <$> get vkid
                         case mrsid of
                             Nothing -> do
-                                rsid <- insert $ RemoteActor luActor iid luInbox
+                                rsid <- insert $ RemoteActor luActor iid luInbox Nothing
                                 when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid
                                 return $ Right rsid
                             Just rsid -> runExceptT $ do
@@ -464,7 +464,7 @@ actorFetchShareSettings = ResultShareSettings
                 manager <- getsYesod getHttpManager
                 eactor <- fetchAPID manager actorId h lu
                 for eactor $ \ actor -> runDB $
-                    insertEntity $ RemoteActor lu iid (actorInbox actor)
+                    insertEntity $ RemoteActor lu iid (actorInbox actor) Nothing
     }
 
 fetchRemoteActor