From 6c8b9664a2430771d8c1fc9242339bf5517b29e6 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sat, 11 Apr 2020 14:58:38 +0000 Subject: [PATCH] When HTTP-fetching actors, remember their 'followers' as a LocalURI The implementation felt quite weird, had to add an extra field to Fetched and to VerifKeyDetail. Should probably figure out the whole mess in that code, have something clean there. Easily add fields. Easily and safely re-fetch an actor or key. --- config/models | 3 ++- src/Vervis/Federation/Auth.hs | 31 ++++++++++++++----------- src/Vervis/Federation/Ticket.hs | 10 ++++---- src/Vervis/Migration.hs | 5 ++++ src/Vervis/RemoteActorStore.hs | 32 ++++++++++++++----------- src/Web/ActivityPub.hs | 41 ++++++++++++++++++--------------- 6 files changed, 70 insertions(+), 52 deletions(-) diff --git a/config/models b/config/models index 5726ea4..0f9cd1d 100644 --- a/config/models +++ b/config/models @@ -146,7 +146,8 @@ RemoteActor ident RemoteObjectId name Text Maybe inbox LocalURI - errorSince UTCTime Maybe + followers LocalURI Maybe + errorSince UTCTime Maybe UniqueRemoteActor ident diff --git a/src/Vervis/Federation/Auth.hs b/src/Vervis/Federation/Auth.hs index ffcd62c..bf18812 100644 --- a/src/Vervis/Federation/Auth.hs +++ b/src/Vervis/Federation/Auth.hs @@ -152,7 +152,7 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do return (vk, mremote) case ments of Just (Entity vkid vk, mremote) -> do - (ua, s, rsid) <- + (ua, s, rsid, ra) <- case mremote of Just (ro, rsid, rs) -> do let sharer = remoteObjectIdent ro @@ -160,22 +160,24 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do if sharer == lu then return () else throwE "Key's owner doesn't match actor header" - return (sharer, False, rsid) + return (sharer, False, rsid, rs) Nothing -> do ua <- case mluActorHeader of Nothing -> throwE "Got a sig with an instance key, but actor header not specified!" Just u -> return u let iid = verifKeyInstance vk rsid <- withHostLock' host $ keyListedByActorShared iid vkid host luKey ua - return (ua, True, rsid) + ra <- lift $ runDB $ getJust rsid + return (ua, True, rsid, ra) return ( Right (verifKeyInstance vk, vkid, rsid) , VerifKeyDetail - { vkdKeyId = luKey - , vkdKey = verifKeyPublic vk - , vkdExpires = verifKeyExpires vk - , vkdActorId = ua - , vkdShared = s + { vkdKeyId = luKey + , vkdKey = verifKeyPublic vk + , vkdExpires = verifKeyExpires vk + , vkdActorId = ua + , vkdActorFollowers = remoteActorFollowers ra + , vkdShared = s } ) Nothing -> fetched2vkd luKey <$> fetchUnknownKey manager malgo host mluActorHeader luKey @@ -226,14 +228,15 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do -- , actdDigest = digest } where - fetched2vkd uk (Fetched k mexp ua mname uinb s) = + fetched2vkd uk (Fetched k mexp ua mname uinb mufol s) = ( Left (mname, uinb) , VerifKeyDetail - { vkdKeyId = uk - , vkdKey = k - , vkdExpires = mexp - , vkdActorId = ua - , vkdShared = s + { vkdKeyId = uk + , vkdKey = k + , vkdExpires = mexp + , vkdActorId = ua + , vkdActorFollowers = mufol + , vkdShared = s } ) updateVerifKey vkid vkd = diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index bcb148d..1c68244 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -611,9 +611,9 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do , outboxItemPublished = now } obikhidAccept <- encodeKeyHashid obiidAccept + ra <- getJust $ remoteAuthorId author summary <- do let uAuthor@(ObjURI hAuthor luAuthor) = remoteAuthorURI author - ra <- getJust $ remoteAuthorId author TextHtml . TL.toStrict . renderHtml <$> withUrlRenderer [hamlet| @@ -639,10 +639,10 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do ] remoteRecipsA = objUriLocal (remoteAuthorURI author) :| [] - remoteRecipsC = - [ LocalURI $ localUriPath (objUriLocal $ remoteAuthorURI author) <> "/followers" - , AP.ticketParticipants tlocal - , AP.ticketTeam tlocal + remoteRecipsC = catMaybes + [ remoteActorFollowers ra + , Just $ AP.ticketParticipants tlocal + , Just $ AP.ticketTeam tlocal ] localRecips = map encodeRouteHome $ diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 81c74a8..5971b69 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1513,6 +1513,11 @@ changes hLocal ctx = , addEntities model_2020_04_07 -- 236 , addEntities model_2020_04_09 + -- 237 + , addFieldPrimOptional + "RemoteActor" + (Nothing :: Maybe Text) + "followers" ] migrateDB diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs index c7c6899..36ff9d2 100644 --- a/src/Vervis/RemoteActorStore.hs +++ b/src/Vervis/RemoteActorStore.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2019 by fr33domlover . + - Written in 2019, 2020 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -135,12 +135,14 @@ instanceAndActor -> LocalURI -> Maybe Text -> LocalURI + -> Maybe LocalURI -> YesodDB site (InstanceId, RemoteActorId, Maybe Bool) -instanceAndActor host luActor mname luInbox = do +instanceAndActor host luActor mname luInbox mluFollowers = do (iid, inew) <- idAndNew <$> insertBy' (Instance host) (raid, ranew) <- do roid <- either entityKey id <$> insertBy' (RemoteObject iid luActor) - idAndNew <$> insertBy' (RemoteActor roid mname luInbox Nothing) + idAndNew <$> + insertBy' (RemoteActor roid mname luInbox mluFollowers Nothing) return $ ( iid , raid @@ -340,7 +342,7 @@ keyListedByActorShared iid vkid host luKey luActor = do actor <- ExceptT (keyListedByActor manager host luKey luActor) lift $ runDB $ do roid <- either entityKey id <$> insertBy' (RemoteObject iid luActor) - either entityKey id <$> insertBy' (RemoteActor roid (actorName actor <|> actorUsername actor) (actorInbox actor) Nothing) + either entityKey id <$> insertBy' (RemoteActor roid (actorName actor <|> actorUsername actor) (actorInbox actor) (actorFollowers actor) Nothing) RoomModeCached m -> do eresult <- do ments <- lift $ runDB $ do @@ -367,7 +369,7 @@ keyListedByActorShared iid vkid host luKey luActor = do Nothing -> do rsid <- do roid <- either entityKey id <$> insertBy' (RemoteObject iid luActor) - either entityKey id <$> insertBy' (RemoteActor roid (actorName actor <|> actorUsername actor) (actorInbox actor) Nothing) + either entityKey id <$> insertBy' (RemoteActor roid (actorName actor <|> actorUsername actor) (actorInbox actor) (actorFollowers actor) Nothing) when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid return $ Right rsid Just rsid -> runExceptT $ do @@ -384,11 +386,12 @@ keyListedByActorShared iid vkid host luKey luActor = do return rsid data VerifKeyDetail = VerifKeyDetail - { vkdKeyId :: LocalRefURI - , vkdKey :: PublicVerifKey - , vkdExpires :: Maybe UTCTime - , vkdActorId :: LocalURI - , vkdShared :: Bool + { vkdKeyId :: LocalRefURI + , vkdKey :: PublicVerifKey + , vkdExpires :: Maybe UTCTime + , vkdActorId :: LocalURI + , vkdActorFollowers :: Maybe LocalURI + , vkdShared :: Bool } addVerifKey @@ -407,11 +410,11 @@ addVerifKey h mname uinb vkd = then addSharedKey h uinb vkd else addPersonalKey h uinb vkd where - addSharedKey host luInbox (VerifKeyDetail luKey key mexpires luActor _) = do + addSharedKey host luInbox (VerifKeyDetail luKey key mexpires luActor mluFollowers _) = do reject <- getsYesod siteRejectOnMaxKeys roomModeA <- getsYesod $ roomModeFromLimit . siteActorRoomMode roomModeI <- getsYesod $ roomModeFromLimit . siteInstanceRoomMode - (iid, rsid, inew) <- lift $ instanceAndActor host luActor mname luInbox + (iid, rsid, inew) <- lift $ instanceAndActor host luActor mname luInbox mluFollowers case roomModeI of RoomModeInstant -> when reject $ throwE "Instance key storage limit is 0 and set to reject" @@ -442,10 +445,10 @@ addVerifKey h mname uinb vkd = where instanceRoom n iid = (< n) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing] - addPersonalKey host luInbox (VerifKeyDetail luKey key mexpires luActor _) = do + addPersonalKey host luInbox (VerifKeyDetail luKey key mexpires luActor mluFollowers _) = do reject <- getsYesod siteRejectOnMaxKeys roomMode <- getsYesod $ roomModeFromLimit . siteActorRoomMode - (iid, rsid, inew) <- lift $ instanceAndActor host luActor mname luInbox + (iid, rsid, inew) <- lift $ instanceAndActor host luActor mname luInbox mluFollowers case roomMode of RoomModeInstant -> when reject $ throwE "Actor key storage limit is 0 and set to reject" @@ -498,6 +501,7 @@ actorFetchShareAction u (site, iid) = flip runWorkerT site $ do , remoteActorName = actorName actor <|> actorUsername actor , remoteActorInbox = actorInbox actor + , remoteActorFollowers = actorFollowers actor , remoteActorErrorSince = Nothing } Just . either id (flip Entity ra) <$> insertBy' ra diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 42b9659..b2704b2 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -1421,17 +1421,20 @@ httpPostAPBytes manager uri headers keyid sign uSender mfwd body = -- | Result of GETing the keyId URI and processing the JSON document. data Fetched = Fetched - { fetchedPublicKey :: PublicVerifKey + { fetchedPublicKey :: PublicVerifKey -- ^ The Ed25519 or RSA public key corresponding to the URI we requested. - , fetchedKeyExpires :: Maybe UTCTime + , fetchedKeyExpires :: Maybe UTCTime -- ^ Optional expiration time declared for the key we received. - , fetchedActorId :: LocalURI + , fetchedActorId :: LocalURI -- ^ The @id URI of the actor for whom the key's signature applies. - , fetchedActorName :: Maybe Text + , fetchedActorName :: Maybe Text -- ^ Name of the actor for whom the key's signature applies. - , fetchedActorInbox :: LocalURI + , fetchedActorInbox :: LocalURI -- ^ The inbox URI of the actor for whom the key's signature applies. - , fetchedKeyShared :: Bool + , fetchedActorFollowers :: Maybe LocalURI + -- ^ The follower collection URI of the actor for whom the key's + -- signature applies. + , fetchedKeyShared :: Bool -- ^ Whether the key we received is shared. A shared key can sign -- requests for any actor on the same instance, while a personal key is -- only for one actor. Knowing whether the key is shared will allow us @@ -1608,12 +1611,13 @@ fetchUnknownKey manager malgo host mluActor luKey = do return (False, owner) actor <- ExceptT $ keyListedByActor manager host luKey luActor return Fetched - { fetchedPublicKey = publicKeyMaterial pkey - , fetchedKeyExpires = publicKeyExpires pkey - , fetchedActorId = luActor - , fetchedActorName = actorName actor <|> actorUsername actor - , fetchedActorInbox = actorInbox actor - , fetchedKeyShared = oi + { fetchedPublicKey = publicKeyMaterial pkey + , fetchedKeyExpires = publicKeyExpires pkey + , fetchedActorId = luActor + , fetchedActorName = actorName actor <|> actorUsername actor + , fetchedActorInbox = actorInbox actor + , fetchedActorFollowers = actorFollowers actor + , fetchedKeyShared = oi } Right actor -> do case luKey of @@ -1632,12 +1636,13 @@ fetchUnknownKey manager malgo host mluActor luKey = do then return owner else throwE "Actor's publicKey's owner doesn't match the actor's ID" return Fetched - { fetchedPublicKey = publicKeyMaterial pk - , fetchedKeyExpires = publicKeyExpires pk - , fetchedActorId = owner - , fetchedActorName = actorName actor <|> actorUsername actor - , fetchedActorInbox = actorInbox actor - , fetchedKeyShared = False + { fetchedPublicKey = publicKeyMaterial pk + , fetchedKeyExpires = publicKeyExpires pk + , fetchedActorId = owner + , fetchedActorName = actorName actor <|> actorUsername actor + , fetchedActorInbox = actorInbox actor + , fetchedActorFollowers = actorFollowers actor + , fetchedKeyShared = False } ExceptT . pure $ verifyAlgo malgo $ fetchedPublicKey fetched return fetched