forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Store names of remote actors in DB for display

Browse source
This commit is contained in:
fr33domlover 2019-05-21 08:44:11 +00:00
parent 2573ff1d93
commit d1fea9eb51
5 changed files with 32 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
config/models
View file

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

8
src/Vervis/Federation.hs
View file

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

2
src/Vervis/Migration.hs
View file

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

29
src/Vervis/RemoteActorStore.hs
View file

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

8
src/Web/ActivityPub.hs
View file

@ -836,6 +836,8 @@ data Fetched = Fetched
-- ^ 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
-- ^ 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 , fetchedKeyShared :: Bool
@ -1003,12 +1005,13 @@ fetchUnknownKey manager malgo host mluActor luKey = do
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 (False, owner) return (False, owner)
inbox <- actorInbox <$> 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
, fetchedActorInbox = inbox , fetchedActorName = actorName actor <|> actorUsername actor
, fetchedActorInbox = actorInbox actor
, fetchedKeyShared = oi , fetchedKeyShared = oi
} }
Right actor -> do Right actor -> do
@ -1030,6 +1033,7 @@ fetchUnknownKey manager malgo host mluActor luKey = do
{ fetchedPublicKey = publicKeyMaterial pk { fetchedPublicKey = publicKeyMaterial pk
, fetchedKeyExpires = publicKeyExpires pk , fetchedKeyExpires = publicKeyExpires pk
, fetchedActorId = owner , fetchedActorId = owner
, fetchedActorName = actorName actor <|> actorUsername actor
, fetchedActorInbox = actorInbox actor , fetchedActorInbox = actorInbox actor
, fetchedKeyShared = False , fetchedKeyShared = False
} }