sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 22:34:50 +09:00
Code Issues Activity

Accept HTTP signatures made with shared instance-scope actor keys

Browse source
This commit is contained in:
fr33domlover 2019-02-05 13:02:15 +00:00
parent e8a5ef4e86
commit 400245cf34
1 changed files with 19 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
src/Web/ActivityPub.hs
View file

@ -371,13 +371,17 @@ fetchKey manager sigAlgo u = runExceptT $ do
let fetch :: (MonadIO m, FromJSON a) => URI -> ExceptT String m a let fetch :: (MonadIO m, FromJSON a) => URI -> ExceptT String m a
fetch u = ExceptT $ bimap displayException responseBody <$> httpGetAP manager u fetch u = ExceptT $ bimap displayException responseBody <$> httpGetAP manager u
obj <- fetch u obj <- fetch u
(actor, pkey) <- (actor, pkey, separate) <-
case obj of case obj of
Left' pkey -> do Left' pkey -> do
if publicKeyId pkey == u if publicKeyId pkey == u
then return () then return ()
else throwE "Public key's ID doesn't match the keyid URI" else throwE "Public key's ID doesn't match the keyid URI"
if uriAuthority (publicKeyOwner pkey) == uriAuthority u let authority =
case uriAuthority u of
Nothing -> error "BUG! We were supposed to verify URI authority is non-empty!"
Just a -> a
if uriAuthority (publicKeyOwner pkey) == Just authority
then return () then return ()
else throwE "Actor and key on different domains, we reject" else throwE "Actor and key on different domains, we reject"
actor <- fetch $ publicKeyOwner pkey actor <- fetch $ publicKeyOwner pkey
@ -385,7 +389,7 @@ fetchKey manager sigAlgo u = runExceptT $ do
match (Left uri) = uri == u match (Left uri) = uri == u
match (Right _) = False match (Right _) = False
if match k1 || maybe False match mk2 if match k1 || maybe False match mk2
then return (actor, pkey) then return (actor, pkey, True)
else throwE "Actor publicKey has no URI matching pkey @id" else throwE "Actor publicKey has no URI matching pkey @id"
Right' actor -> do Right' actor -> do
if actorId actor == u { uriFragment = "" } if actorId actor == u { uriFragment = "" }
@ -399,14 +403,20 @@ fetchKey manager sigAlgo u = runExceptT $ do
else Nothing else Nothing
case match k1 <|> (match =<< mk2) of case match k1 <|> (match =<< mk2) of
Nothing -> throwE "keyId resolved to actor which doesn't have a key object with that ID" Nothing -> throwE "keyId resolved to actor which doesn't have a key object with that ID"
Just pk -> return (actor, pk) Just pk -> return (actor, pk, False)
ExceptT . pure $ do ExceptT . pure $ do
if publicKeyShared pkey if publicKeyShared pkey
then Left "Actor's publicKey is shared, we're rejecting it!" then do
else Right () if separate
if publicKeyOwner pkey == actorId actor then Right ()
then Right () else Left "Actor's publicKey is shared, but embedded in actor document! We allow shared keys only if they're in a separate document"
else Left "Actor's publicKey's owner doesn't match the actor's ID" let inztance = u { uriPath = "", uriQuery = "", uriFragment = "" }
if publicKeyOwner pkey == inztance
then Right ()
else Left "Key is shared but its owner isn't the top-level instance URI"
else if publicKeyOwner pkey == actorId actor
then Right ()
else Left "Actor's publicKey's owner doesn't match the actor's ID"
case publicKeyAlgo pkey of case publicKeyAlgo pkey of
Nothing -> Nothing ->
Left $ Left $