Store names of remote actors in DB for display

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

View file

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

View file

@ -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

View file

@ -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))

View file

@ -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

View file

@ -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
}