From d1fea9eb51c18e6c77680fbb82fe911131943464 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Tue, 21 May 2019 08:44:11 +0000 Subject: [PATCH] Store names of remote actors in DB for display --- config/models | 1 + src/Vervis/Federation.hs | 8 ++++---- src/Vervis/Migration.hs | 2 ++ src/Vervis/RemoteActorStore.hs | 29 +++++++++++++++++++---------- src/Web/ActivityPub.hs | 8 ++++++-- 5 files changed, 32 insertions(+), 16 deletions(-) diff --git a/config/models b/config/models index 3b49c95..6f7b885 100644 --- a/config/models +++ b/config/models @@ -121,6 +121,7 @@ UnfetchedRemoteActor RemoteActor ident LocalURI instance InstanceId + name Text Maybe inbox LocalURI errorSince UTCTime Maybe diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 794378d..3344d11 100644 --- a/src/Vervis/Federation.hs +++ b/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) = - ( Left uinb + fetched2vkd uk (Fetched k mexp ua mname uinb s) = + ( Left (mname, uinb) , VerifKeyDetail { vkdKeyId = uk , vkdKey = k diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index bace23c..058e4b2 100644 --- a/src/Vervis/Migration.hs +++ b/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)) diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs index ae3e5f3..ed409a0 100644 --- a/src/Vervis/RemoteActorStore.hs +++ b/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) - lift $ runDB $ either entityKey id <$> insertBy' (RemoteActor luActor iid luInbox Nothing) + actor <- ExceptT (keyListedByActor manager host luKey luActor) + 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 diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index b88ac77..34d49e7 100644 --- a/src/Web/ActivityPub.hs +++ b/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 }