From 7946fe441d4ad19cda3543aa9c9bfb8f248ac4e4 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Fri, 12 Apr 2019 01:09:45 +0000
Subject: [PATCH] Add field errorSince to RemoteActor to track inbox POST
 unreachability

---
 config/models                  | 7 ++++---
 src/Vervis/Federation.hs       | 2 +-
 src/Vervis/Handler/Inbox.hs    | 2 +-
 src/Vervis/Migration.hs        | 5 +++++
 src/Vervis/RemoteActorStore.hs | 8 ++++----
 5 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/config/models b/config/models
index 5a417d7..3bf2236 100644
--- a/config/models
+++ b/config/models
@@ -70,9 +70,10 @@ VerifKeySharedUsage
     UniqueVerifKeySharedUsage key user
 
 RemoteActor
-    ident    LocalURI
-    instance InstanceId
-    inbox    LocalURI
+    ident      LocalURI
+    instance   InstanceId
+    inbox      LocalURI
+    errorSince UTCTime Maybe
 
     UniqueRemoteActor instance ident
 
diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs
index 30fb9c6..99acc54 100644
--- a/src/Vervis/Federation.hs
+++ b/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
diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs
index 6b1f798..a543a80 100644
--- a/src/Vervis/Handler/Inbox.hs
+++ b/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
diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index d724897..4fed60e 100644
--- a/src/Vervis/Migration.hs
+++ b/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))
diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs
index a1fbf6f..b8bc82c 100644
--- a/src/Vervis/RemoteActorStore.hs
+++ b/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