Store names of remote actors in DB for display
This commit is contained in:
parent
2573ff1d93
commit
d1fea9eb51
5 changed files with 32 additions and 16 deletions
|
@ -121,6 +121,7 @@ UnfetchedRemoteActor
|
|||
RemoteActor
|
||||
ident LocalURI
|
||||
instance InstanceId
|
||||
name Text Maybe
|
||||
inbox LocalURI
|
||||
errorSince UTCTime Maybe
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue