From fa5c509a25065ee65d62cf1f21bcc386cf2c8e9a Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Sun, 17 Feb 2019 00:14:05 +0000
Subject: [PATCH] When we fetch a stand-alone personal key, make sure AP-Actor
 matches key owner

If the key we fetched is a shared key, the only way to determine the actor to
which the signature applies is to read the HTTP header ActivityPub-Actor. But
if it's a personal key, we can detect the actor by checking the key's owner
field. Still, if that actor header is provided, we now compare it to the key
owner and make sure they're identical.

When fetching a key that is embedded in the actor document, we were already
comparing the actor ID with the actor header, so that part didn't require
changes.
---
 src/Web/ActivityPub.hs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs
index edde43b..24d4d9f 100644
--- a/src/Web/ActivityPub.hs
+++ b/src/Web/ActivityPub.hs
@@ -54,6 +54,7 @@ import Data.Aeson.Types (Parser)
 import Data.Bifunctor (bimap, first)
 import Data.Bitraversable (bitraverse)
 import Data.ByteString (ByteString)
+import Data.Foldable (for_)
 import Data.List.NonEmpty (NonEmpty)
 import Data.PEM
 import Data.Semigroup (Endo)
@@ -429,7 +430,13 @@ fetchKey manager sigAlgo muActor uKey = runExceptT $ do
                         then case muActor of
                             Nothing -> throwE "Key is shared but actor header not specified!"
                             Just u  -> return u
-                        else return $ publicKeyOwner pkey
+                        else do
+                            let owner = publicKeyOwner pkey
+                            for_ muActor $ \ u ->
+                                if owner == u
+                                    then return ()
+                                    else throwE "Key's owner doesn't match actor header"
+                            return owner
                 actor <- fetch uActor
                 let PublicKeySet k1 mk2 = actorPublicKeys actor
                     match (Left uri) = uri == uKey
@@ -441,12 +448,10 @@ fetchKey manager sigAlgo muActor uKey = runExceptT $ do
                 if actorId actor == uKey { furiFragment = "" }
                     then return ()
                     else throwE "Actor ID doesn't match the keyid URI we fetched"
-                case muActor of
-                    Nothing -> return ()
-                    Just u ->
-                        if actorId actor == u
-                            then return ()
-                            else throwE "Key's owner doesn't match actor header"
+                for_ muActor $ \ u ->
+                    if actorId actor == u
+                        then return ()
+                        else throwE "Key's owner doesn't match actor header"
                 let PublicKeySet k1 mk2 = actorPublicKeys actor
                     match (Left _)   = Nothing
                     match (Right pk) =