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