sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 18:14:53 +09:00
Code Issues 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 if actorId actor == lu
then return () then return ()
else throwE "Key's owner doesn't match actor header" else throwE "Key's owner doesn't match actor header"
let PublicKeySet k1 mk2 = actorPublicKeys actor pk <- matchKeyObj luKey $ actorPublicKeys actor
match (Left _) = Nothing owner <- case publicKeyOwner pk of
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
OwnerInstance -> throwE "Actor's publicKey is shared, but embedded in actor document! We allow shared keys only if they're in a separate document" 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 OwnerActor owner -> do
if owner == actorId actor if owner == actorId actor
then return () then return owner
else throwE "Actor's publicKey's owner doesn't match the actor's ID" else throwE "Actor's publicKey's owner doesn't match the actor's ID"
return return
( publicKeyPem pk ( publicKeyPem pk
@ -609,13 +601,26 @@ fetchKey manager sigAlgo host mluActor luKey = runExceptT $ do
, publicKeyAlgo pk , publicKeyAlgo pk
) )
ExceptT . pure $ do ExceptT . pure $ do
case malgo of verifyAlgo sigAlgo malgo
Nothing -> 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 $ Left $
if sigAlgo if sigAlgo
then "Algo mismatch, Ed25519 in Sig but none in actor" then "Algo mismatch, Ed25519 in Sig but none in actor"
else "Algo not given in Sig nor actor" else "Algo not given in Sig nor actor"
Just algo -> verifyAlgo sigAlgo (Just algo) =
case algo of case algo of
AlgorithmEd25519 -> Right () AlgorithmEd25519 -> Right ()
AlgorithmOther _ -> AlgorithmOther _ ->
@ -623,6 +628,7 @@ fetchKey manager sigAlgo host mluActor luKey = runExceptT $ do
if sigAlgo if sigAlgo
then "Algo mismatch, Ed25519 in Sig but unsupported algo in actor" then "Algo mismatch, Ed25519 in Sig but unsupported algo in actor"
else "No algo in Sig, unsupported algo in actor" else "No algo in Sig, unsupported algo in actor"
parseKey pem =
case E.publicKey $ pemContent pem of case E.publicKey $ pemContent pem of
CryptoPassed k -> Right $ mkFetched k CryptoPassed k -> Right k
CryptoFailed _ -> Left "Parsing Ed25519 public key failed" CryptoFailed _ -> Left "Parsing Ed25519 public key failed"