Store names of remote actors in DB for display

config/models

@@ -121,6 +121,7 @@ UnfetchedRemoteActor
 RemoteActor
     ident      LocalURI
     instance   InstanceId
+    name       Text Maybe
     inbox      LocalURI
     errorSince UTCTime Maybe
 

src/Vervis/Federation.hs

@@ -167,10 +167,10 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
     (iid, rsid) <-
         if valid1 && stillValid (vkdExpires vkd)
             then case inboxOrVkid of
-                Left uinb -> ExceptT $ withHostLock host $ runDB $ runExceptT $ addVerifKey host uinb vkd
+                Left (mname, uinb) -> ExceptT $ withHostLock host $ runDB $ runExceptT $ addVerifKey host mname uinb vkd
                 Right (iid, _vkid, rsid) -> return (iid, rsid)
             else case inboxOrVkid of
-                Left _uinb ->
+                Left _ ->
                     if stillValid $ vkdExpires vkd
                         then errSig1
                         else errTime
@@ -202,8 +202,8 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
         -- , actdDigest    = digest
         }
     where
-    fetched2vkd uk (Fetched k mexp ua uinb s) =
+    fetched2vkd uk (Fetched k mexp ua mname uinb s) =
-        ( Left uinb
+        ( Left (mname, uinb)
         , VerifKeyDetail
             { vkdKeyId     = uk
             , vkdKey       = k

src/Vervis/Migration.hs

@@ -276,6 +276,8 @@ changes =
     , addUnique "InboxItemRemote" $ Unique "UniqueInboxItemRemoteItem" ["item"]
       -- 74
     , addEntities model_2019_05_17
+      -- 75
+    , addFieldPrimOptional "RemoteActor" (Nothing :: Maybe Text) "name"
     ]
 
 migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int))

src/Vervis/RemoteActorStore.hs

@@ -142,12 +142,13 @@ instanceAndActor
        )
     => Text
     -> LocalURI
+    -> Maybe Text
     -> LocalURI
     -> YesodDB site (InstanceId, RemoteActorId, Maybe Bool)
-instanceAndActor host luActor luInbox = do
+instanceAndActor host luActor mname luInbox = do
     (iid, inew) <- idAndNew <$> insertBy' (Instance host)
     (raid, ranew) <-
-        idAndNew <$> insertBy' (RemoteActor luActor iid luInbox Nothing)
+        idAndNew <$> insertBy' (RemoteActor luActor iid mname luInbox Nothing)
     return $
         ( iid
         , raid
@@ -344,8 +345,8 @@ keyListedByActorShared iid vkid host luKey luActor = do
     case roomMode of
         RoomModeInstant -> do
             when reject $ throwE "Actor key storage limit is 0 and set to reject"
-            luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
+            actor <- ExceptT (keyListedByActor manager host luKey luActor)
-            lift $ runDB $ either entityKey id <$> insertBy' (RemoteActor luActor iid luInbox Nothing)
+            lift $ runDB $ either entityKey id <$> insertBy' (RemoteActor luActor iid (actorName actor <|> actorUsername actor) (actorInbox actor) Nothing)
         RoomModeCached m -> do
             eresult <- do
                 ments <- lift $ runDB $ do
@@ -363,12 +364,12 @@ keyListedByActorShared iid vkid host luKey luActor = do
             case eresult of
                 Left rsid -> return rsid
                 Right mrsid -> do
-                    luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
+                    actor <- ExceptT (keyListedByActor manager host luKey luActor)
                     ExceptT $ runDB $ do
                         vkExists <- isJust <$> get vkid
                         case mrsid of
                             Nothing -> do
-                                rsid <- either entityKey id <$> insertBy' (RemoteActor luActor iid luInbox Nothing)
+                                rsid <- either entityKey id <$> insertBy' (RemoteActor luActor iid (actorName actor <|> actorUsername actor) (actorInbox actor) Nothing)
                                 when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid
                                 return $ Right rsid
                             Just rsid -> runExceptT $ do
@@ -399,10 +400,11 @@ addVerifKey
        , PersistUniqueWrite (YesodPersistBackend site)
        )
     => Text
+    -> Maybe Text
     -> LocalURI
     -> VerifKeyDetail
     -> ExceptT String (YesodDB site) (InstanceId, RemoteActorId)
-addVerifKey h uinb vkd =
+addVerifKey h mname uinb vkd =
     if vkdShared vkd
         then addSharedKey h uinb vkd
         else addPersonalKey h uinb vkd
@@ -411,7 +413,7 @@ addVerifKey h uinb vkd =
         reject <- getsYesod siteRejectOnMaxKeys
         roomModeA <- getsYesod $ roomModeFromLimit . siteActorRoomMode
         roomModeI <- getsYesod $ roomModeFromLimit . siteInstanceRoomMode
-        (iid, rsid, inew) <- lift $ instanceAndActor host luActor luInbox
+        (iid, rsid, inew) <- lift $ instanceAndActor host luActor mname luInbox
         case roomModeI of
             RoomModeInstant ->
                 when reject $ throwE "Instance key storage limit is 0 and set to reject"
@@ -445,7 +447,7 @@ addVerifKey h uinb vkd =
     addPersonalKey host luInbox (VerifKeyDetail luKey key mexpires luActor _) = do
         reject <- getsYesod siteRejectOnMaxKeys
         roomMode <- getsYesod $ roomModeFromLimit . siteActorRoomMode
-        (iid, rsid, inew) <- lift $ instanceAndActor host luActor luInbox
+        (iid, rsid, inew) <- lift $ instanceAndActor host luActor mname luInbox
         case roomMode of
             RoomModeInstant ->
                 when reject $ throwE "Actor key storage limit is 0 and set to reject"
@@ -491,7 +493,14 @@ actorFetchShareAction u (site, iid) = flip runWorkerT site $ do
             for erecip $ \ recip ->
                 case recip of
                     RecipientActor actor -> runSiteDB $
-                        let ra = RemoteActor lu iid (actorInbox actor) Nothing
+                        let ra = RemoteActor
+                                { remoteActorIdent      = lu
+                                , remoteActorInstance   = iid
+                                , remoteActorName       =
+                                    actorName actor <|> actorUsername actor
+                                , remoteActorInbox      = actorInbox actor
+                                , remoteActorErrorSince = Nothing
+                                }
                         in  Just . either id (flip Entity ra) <$> insertBy' ra
                     RecipientCollection _ -> runSiteDB $ do
                         insertUnique_ $ RemoteCollection iid lu

src/Web/ActivityPub.hs

@@ -836,6 +836,8 @@ data Fetched = Fetched
       -- ^ Optional expiration time declared for the key we received.
     , fetchedActorId    :: LocalURI
       -- ^ The @id URI of the actor for whom the key's signature applies.
+    , fetchedActorName  :: Maybe Text
+      -- ^ Name of the actor for whom the key's signature applies.
     , fetchedActorInbox :: LocalURI
       -- ^ The inbox URI of the actor for whom the key's signature applies.
     , fetchedKeyShared  :: Bool
@@ -1003,12 +1005,13 @@ fetchUnknownKey manager malgo host mluActor luKey = do
                                     then return ()
                                     else throwE "Key's owner doesn't match actor header"
                             return (False, owner)
-                inbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
+                actor <- ExceptT $ keyListedByActor manager host luKey luActor
                 return Fetched
                     { fetchedPublicKey  = publicKeyMaterial pkey
                     , fetchedKeyExpires = publicKeyExpires pkey
                     , fetchedActorId    = luActor
-                    , fetchedActorInbox = inbox
+                    , fetchedActorName  = actorName actor <|> actorUsername actor
+                    , fetchedActorInbox = actorInbox actor
                     , fetchedKeyShared  = oi
                     }
             Right actor -> do
@@ -1030,6 +1033,7 @@ fetchUnknownKey manager malgo host mluActor luKey = do
                     { fetchedPublicKey  = publicKeyMaterial pk
                     , fetchedKeyExpires = publicKeyExpires pk
                     , fetchedActorId    = owner
+                    , fetchedActorName  = actorName actor <|> actorUsername actor
                     , fetchedActorInbox = actorInbox actor
                     , fetchedKeyShared  = False
                     }