forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Refactor actor key fetching code a bit

Browse source
This commit is contained in:
fr33domlover 2019-02-22 08:30:43 +00:00
parent 1affe269bb
commit b53a7b4f48
1 changed files with 46 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
src/Web/ActivityPub.hs
View file

@ -581,20 +581,12 @@ fetchKey manager sigAlgo host mluActor luKey = runExceptT $ do
if actorId actor == lu
then return ()
else throwE "Key's owner doesn't match actor header"
let PublicKeySet k1 mk2 = actorPublicKeys actor
match (Left _) = Nothing
match (Right pk) =
if publicKeyId pk == luKey
then Just pk
else Nothing
case match k1 <|> (match =<< mk2) of
Nothing -> throwE "keyId resolved to actor which doesn't have a key object with that ID"
Just pk ->
case publicKeyOwner pk of
pk <- matchKeyObj luKey $ actorPublicKeys actor
owner <- case publicKeyOwner pk of
OwnerInstance -> throwE "Actor's publicKey is shared, but embedded in actor document! We allow shared keys only if they're in a separate document"
OwnerActor owner -> do
if owner == actorId actor
then return ()
then return owner
else throwE "Actor's publicKey's owner doesn't match the actor's ID"
return
( publicKeyPem pk
@ -609,13 +601,26 @@ fetchKey manager sigAlgo host mluActor luKey = runExceptT $ do
, publicKeyAlgo pk
)
ExceptT . pure $ do
case malgo of
Nothing ->
verifyAlgo sigAlgo malgo
mkFetched <$> parseKey pem
where
matchKeyObj luKey (PublicKeySet k1 mk2) =
let match' = match luKey
in case match' k1 <|> (match' =<< mk2) of
Nothing -> throwE "keyId resolved to actor which doesn't have a key object with that ID"
Just pk -> return pk
where
match _ (Left _) = Nothing
match luk (Right pk) =
if publicKeyId pk == luk
then Just pk
else Nothing
verifyAlgo sigAlgo Nothing =
Left $
if sigAlgo
then "Algo mismatch, Ed25519 in Sig but none in actor"
else "Algo not given in Sig nor actor"
Just algo ->
verifyAlgo sigAlgo (Just algo) =
case algo of
AlgorithmEd25519 -> Right ()
AlgorithmOther _ ->
@ -623,6 +628,7 @@ fetchKey manager sigAlgo host mluActor luKey = runExceptT $ do
if sigAlgo
then "Algo mismatch, Ed25519 in Sig but unsupported algo in actor"
else "No algo in Sig, unsupported algo in actor"
parseKey pem =
case E.publicKey $ pemContent pem of
CryptoPassed k -> Right $ mkFetched k
CryptoPassed k -> Right k
CryptoFailed _ -> Left "Parsing Ed25519 public key failed"