sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 16:24:52 +09:00
Code Issues Activity

When HTTP-fetching actors, remember their 'followers' as a LocalURI

Browse source 
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.
This commit is contained in:
fr33domlover 2020-04-11 14:58:38 +00:00
parent 7dc0ba2bf1
commit 6c8b9664a2
6 changed files with 70 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
config/models
View file

@ -146,7 +146,8 @@ RemoteActor
ident RemoteObjectId ident RemoteObjectId
name Text Maybe name Text Maybe
inbox LocalURI inbox LocalURI
errorSince UTCTime Maybe followers LocalURI Maybe
errorSince UTCTime Maybe
UniqueRemoteActor ident UniqueRemoteActor ident

31
src/Vervis/Federation/Auth.hs
View file

@ -152,7 +152,7 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
return (vk, mremote) return (vk, mremote)
case ments of case ments of
Just (Entity vkid vk, mremote) -> do Just (Entity vkid vk, mremote) -> do
(ua, s, rsid) <- (ua, s, rsid, ra) <-
case mremote of case mremote of
Just (ro, rsid, rs) -> do Just (ro, rsid, rs) -> do
let sharer = remoteObjectIdent ro let sharer = remoteObjectIdent ro
@ -160,22 +160,24 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
if sharer == lu if sharer == lu
then return () then return ()
else throwE "Key's owner doesn't match actor header" else throwE "Key's owner doesn't match actor header"
return (sharer, False, rsid) return (sharer, False, rsid, rs)
Nothing -> do Nothing -> do
ua <- case mluActorHeader of ua <- case mluActorHeader of
Nothing -> throwE "Got a sig with an instance key, but actor header not specified!" Nothing -> throwE "Got a sig with an instance key, but actor header not specified!"
Just u -> return u Just u -> return u
let iid = verifKeyInstance vk let iid = verifKeyInstance vk
rsid <- withHostLock' host $ keyListedByActorShared iid vkid host luKey ua rsid <- withHostLock' host $ keyListedByActorShared iid vkid host luKey ua
return (ua, True, rsid) ra <- lift $ runDB $ getJust rsid
return (ua, True, rsid, ra)
return return
( Right (verifKeyInstance vk, vkid, rsid) ( Right (verifKeyInstance vk, vkid, rsid)
, VerifKeyDetail , VerifKeyDetail
{ vkdKeyId = luKey { vkdKeyId = luKey
, vkdKey = verifKeyPublic vk , vkdKey = verifKeyPublic vk
, vkdExpires = verifKeyExpires vk , vkdExpires = verifKeyExpires vk
, vkdActorId = ua , vkdActorId = ua
, vkdShared = s , vkdActorFollowers = remoteActorFollowers ra
, vkdShared = s
} }
) )
Nothing -> fetched2vkd luKey <$> fetchUnknownKey manager malgo host mluActorHeader luKey Nothing -> fetched2vkd luKey <$> fetchUnknownKey manager malgo host mluActorHeader luKey
@ -226,14 +228,15 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
-- , actdDigest = digest -- , actdDigest = digest
} }
where where
fetched2vkd uk (Fetched k mexp ua mname uinb s) = fetched2vkd uk (Fetched k mexp ua mname uinb mufol s) =
( Left (mname, uinb) ( Left (mname, uinb)
, VerifKeyDetail , VerifKeyDetail
{ vkdKeyId = uk { vkdKeyId = uk
, vkdKey = k , vkdKey = k
, vkdExpires = mexp , vkdExpires = mexp
, vkdActorId = ua , vkdActorId = ua
, vkdShared = s , vkdActorFollowers = mufol
, vkdShared = s
} }
) )
updateVerifKey vkid vkd = updateVerifKey vkid vkd =

10
src/Vervis/Federation/Ticket.hs
View file

@ -611,9 +611,9 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do
, outboxItemPublished = now , outboxItemPublished = now
} }
obikhidAccept <- encodeKeyHashid obiidAccept obikhidAccept <- encodeKeyHashid obiidAccept
ra <- getJust $ remoteAuthorId author
summary <- do summary <- do
let uAuthor@(ObjURI hAuthor luAuthor) = remoteAuthorURI author let uAuthor@(ObjURI hAuthor luAuthor) = remoteAuthorURI author
ra <- getJust $ remoteAuthorId author
TextHtml . TL.toStrict . renderHtml <$> TextHtml . TL.toStrict . renderHtml <$>
withUrlRenderer withUrlRenderer
[hamlet| [hamlet|
@ -639,10 +639,10 @@ projectCreateTicketF now shrRecip prjRecip author body ticket muTarget = do
] ]
remoteRecipsA = remoteRecipsA =
objUriLocal (remoteAuthorURI author) :| [] objUriLocal (remoteAuthorURI author) :| []
remoteRecipsC = remoteRecipsC = catMaybes
[ LocalURI $ localUriPath (objUriLocal $ remoteAuthorURI author) <> "/followers" [ remoteActorFollowers ra
, AP.ticketParticipants tlocal , Just $ AP.ticketParticipants tlocal
, AP.ticketTeam tlocal , Just $ AP.ticketTeam tlocal
] ]
localRecips = localRecips =
map encodeRouteHome $ map encodeRouteHome $

5
src/Vervis/Migration.hs
View file

@ -1513,6 +1513,11 @@ changes hLocal ctx =
, addEntities model_2020_04_07 , addEntities model_2020_04_07
-- 236 -- 236
, addEntities model_2020_04_09 , addEntities model_2020_04_09
-- 237
, addFieldPrimOptional
"RemoteActor"
(Nothing :: Maybe Text)
"followers"
] ]
migrateDB migrateDB

32
src/Vervis/RemoteActorStore.hs
View file

@ -1,6 +1,6 @@
{- This file is part of Vervis. {- This file is part of Vervis.
- -
- Written in 2019 by fr33domlover <fr33domlover@riseup.net>. - Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
- -
- ♡ Copying is an act of love. Please copy, reuse and share. - ♡ Copying is an act of love. Please copy, reuse and share.
- -
@ -135,12 +135,14 @@ instanceAndActor
-> LocalURI -> LocalURI
-> Maybe Text -> Maybe Text
-> LocalURI -> LocalURI
-> Maybe LocalURI
-> YesodDB site (InstanceId, RemoteActorId, Maybe Bool) -> 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) (iid, inew) <- idAndNew <$> insertBy' (Instance host)
(raid, ranew) <- do (raid, ranew) <- do
roid <- either entityKey id <$> insertBy' (RemoteObject iid luActor) roid <- either entityKey id <$> insertBy' (RemoteObject iid luActor)
idAndNew <$> insertBy' (RemoteActor roid mname luInbox Nothing) idAndNew <$>
insertBy' (RemoteActor roid mname luInbox mluFollowers Nothing)
return $ return $
( iid ( iid
, raid , raid
@ -340,7 +342,7 @@ keyListedByActorShared iid vkid host luKey luActor = do
actor <- ExceptT (keyListedByActor manager host luKey luActor) actor <- ExceptT (keyListedByActor manager host luKey luActor)
lift $ runDB $ do lift $ runDB $ do
roid <- either entityKey id <$> insertBy' (RemoteObject iid luActor) 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 RoomModeCached m -> do
eresult <- do eresult <- do
ments <- lift $ runDB $ do ments <- lift $ runDB $ do
@ -367,7 +369,7 @@ keyListedByActorShared iid vkid host luKey luActor = do
Nothing -> do Nothing -> do
rsid <- do rsid <- do
roid <- either entityKey id <$> insertBy' (RemoteObject iid luActor) 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 when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid
return $ Right rsid return $ Right rsid
Just rsid -> runExceptT $ do Just rsid -> runExceptT $ do
@ -384,11 +386,12 @@ keyListedByActorShared iid vkid host luKey luActor = do
return rsid return rsid
data VerifKeyDetail = VerifKeyDetail data VerifKeyDetail = VerifKeyDetail
{ vkdKeyId :: LocalRefURI { vkdKeyId :: LocalRefURI
, vkdKey :: PublicVerifKey , vkdKey :: PublicVerifKey
, vkdExpires :: Maybe UTCTime , vkdExpires :: Maybe UTCTime
, vkdActorId :: LocalURI , vkdActorId :: LocalURI
, vkdShared :: Bool , vkdActorFollowers :: Maybe LocalURI
, vkdShared :: Bool
} }
addVerifKey addVerifKey
@ -407,11 +410,11 @@ addVerifKey h mname uinb vkd =
then addSharedKey h uinb vkd then addSharedKey h uinb vkd
else addPersonalKey h uinb vkd else addPersonalKey h uinb vkd
where where
addSharedKey host luInbox (VerifKeyDetail luKey key mexpires luActor _) = do addSharedKey host luInbox (VerifKeyDetail luKey key mexpires luActor mluFollowers _) = do
reject <- getsYesod siteRejectOnMaxKeys reject <- getsYesod siteRejectOnMaxKeys
roomModeA <- getsYesod $ roomModeFromLimit . siteActorRoomMode roomModeA <- getsYesod $ roomModeFromLimit . siteActorRoomMode
roomModeI <- getsYesod $ roomModeFromLimit . siteInstanceRoomMode 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 case roomModeI of
RoomModeInstant -> RoomModeInstant ->
when reject $ throwE "Instance key storage limit is 0 and set to reject" when reject $ throwE "Instance key storage limit is 0 and set to reject"
@ -442,10 +445,10 @@ addVerifKey h mname uinb vkd =
where where
instanceRoom n iid = instanceRoom n iid =
(< n) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing] (< 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 reject <- getsYesod siteRejectOnMaxKeys
roomMode <- getsYesod $ roomModeFromLimit . siteActorRoomMode 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 case roomMode of
RoomModeInstant -> RoomModeInstant ->
when reject $ throwE "Actor key storage limit is 0 and set to reject" 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 = , remoteActorName =
actorName actor <|> actorUsername actor actorName actor <|> actorUsername actor
, remoteActorInbox = actorInbox actor , remoteActorInbox = actorInbox actor
, remoteActorFollowers = actorFollowers actor
, remoteActorErrorSince = Nothing , remoteActorErrorSince = Nothing
} }
Just . either id (flip Entity ra) <$> insertBy' ra Just . either id (flip Entity ra) <$> insertBy' ra

41
src/Web/ActivityPub.hs
View file

@ -1421,17 +1421,20 @@ httpPostAPBytes manager uri headers keyid sign uSender mfwd body =
-- | Result of GETing the keyId URI and processing the JSON document. -- | Result of GETing the keyId URI and processing the JSON document.
data Fetched = Fetched data Fetched = Fetched
{ fetchedPublicKey :: PublicVerifKey { fetchedPublicKey :: PublicVerifKey
-- ^ The Ed25519 or RSA public key corresponding to the URI we requested. -- ^ 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. -- ^ 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. -- ^ 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. -- ^ 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. -- ^ 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 -- ^ 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 -- 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 -- 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) return (False, owner)
actor <- ExceptT $ keyListedByActor manager host luKey luActor actor <- ExceptT $ keyListedByActor manager host luKey luActor
return Fetched return Fetched
{ fetchedPublicKey = publicKeyMaterial pkey { fetchedPublicKey = publicKeyMaterial pkey
, fetchedKeyExpires = publicKeyExpires pkey , fetchedKeyExpires = publicKeyExpires pkey
, fetchedActorId = luActor , fetchedActorId = luActor
, fetchedActorName = actorName actor <|> actorUsername actor , fetchedActorName = actorName actor <|> actorUsername actor
, fetchedActorInbox = actorInbox actor , fetchedActorInbox = actorInbox actor
, fetchedKeyShared = oi , fetchedActorFollowers = actorFollowers actor
, fetchedKeyShared = oi
} }
Right actor -> do Right actor -> do
case luKey of case luKey of
@ -1632,12 +1636,13 @@ fetchUnknownKey manager malgo host mluActor luKey = do
then return owner then return owner
else throwE "Actor's publicKey's owner doesn't match the actor's ID" else throwE "Actor's publicKey's owner doesn't match the actor's ID"
return Fetched return Fetched
{ fetchedPublicKey = publicKeyMaterial pk { fetchedPublicKey = publicKeyMaterial pk
, fetchedKeyExpires = publicKeyExpires pk , fetchedKeyExpires = publicKeyExpires pk
, fetchedActorId = owner , fetchedActorId = owner
, fetchedActorName = actorName actor <|> actorUsername actor , fetchedActorName = actorName actor <|> actorUsername actor
, fetchedActorInbox = actorInbox actor , fetchedActorInbox = actorInbox actor
, fetchedKeyShared = False , fetchedActorFollowers = actorFollowers actor
, fetchedKeyShared = False
} }
ExceptT . pure $ verifyAlgo malgo $ fetchedPublicKey fetched ExceptT . pure $ verifyAlgo malgo $ fetchedPublicKey fetched
return fetched return fetched