Actor public key specifies whether it's shared

Shared key means the key is used for multiple actors. I'm not sure explicitly
specifying this will be necessary, but I prefer to have it in place to help
with debugging in case something unexpected comes from other servers, or my
format overlaps with stuff used in other software and encodes a different
meaning.

Each public key can specify whether it's shared or personal, and this patch
checks for that when verifying a request signature. It rejects shared keys,
accepting valid sigs only from personal keys.

Very soon I'll add shared key support.

src/Vervis/Foundation.hs

@@ -584,6 +584,9 @@ instance YesodHttpSig App where
                 then Right ()
                 else Left "Actor ID doesn't match the keyid URI we fetched"
             let pkey = actorPublicKey actor
+            if publicKeyShared pkey
+                then Left "Actor's publicKey is shared, we're rejecting it!"
+                else Right ()
             if publicKeyId pkey == u
                 then Right ()
                 else Left "Actor's publicKey's ID doesn't match the keyid URI"

src/Vervis/Handler/Person.hs

@@ -158,6 +158,7 @@ getPersonR shr = do
                 , publicKeyOwner  = me
                 , publicKeyPem    = PEM "PUBLIC KEY" [] actorKey
                 , publicKeyAlgo   = Just AlgorithmEd25519
+                , publicKeyShared = False
                 }
             }
 

src/Web/ActivityPub.hs

@@ -112,6 +112,7 @@ data PublicKey = PublicKey
     , publicKeyOwner  :: URI
     , publicKeyPem    :: PEM
     , publicKeyAlgo   :: Maybe Algorithm
+    , publicKeyShared :: Bool
     }
 
 instance FromJSON PublicKey where
@@ -121,6 +122,7 @@ instance FromJSON PublicKey where
             <*> (parseHttpsURI =<< o .: "owner")
             <*> (parsePEM =<< o .: "publicKeyPem")
             <*> o .:? (frg <> "algorithm")
+            <*> o .:? (frg <> "shared") .!= False
         where
         parsePEM t =
             case pemParseBS $ encodeUtf8 t of
@@ -133,12 +135,13 @@ instance FromJSON PublicKey where
 
 instance ToJSON PublicKey where
     toJSON = error "toJSON PublicKey"
-    toEncoding (PublicKey id_ owner pem malgo) =
+    toEncoding (PublicKey id_ owner pem malgo shared) =
         pairs
             $  "id"                 .=  renderURI id_
             <> "owner"              .=  renderURI owner
             <> "publicKeyPem"       .=  decodeUtf8 (pemWriteBS pem)
-            <> maybe mempty ((frg <> "algorithm") .=) malgo
+            <> (frg <> "algorithm") .=? malgo
+            <> (frg <> "shared")    .=  shared
 
 data Actor = Actor
     { actorId        :: URI