forge/Vervis
1
0
Fork 0
Code Pull requests 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

24
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,12 +403,18 @@ 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 ()
else Left "Actor's publicKey is shared, but embedded in actor document! We allow shared keys only if they're in a separate document"
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 () then Right ()
else Left "Actor's publicKey's owner doesn't match the actor's ID" else Left "Actor's publicKey's owner doesn't match the actor's ID"
case publicKeyAlgo pkey of case publicKeyAlgo pkey of