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

86
src/Web/ActivityPub.hs
View file

@ -581,48 +581,54 @@ 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) = OwnerInstance -> throwE "Actor's publicKey is shared, but embedded in actor document! We allow shared keys only if they're in a separate document"
if publicKeyId pk == luKey OwnerActor owner -> do
then Just pk if owner == actorId actor
else Nothing then return owner
case match k1 <|> (match =<< mk2) of else throwE "Actor's publicKey's owner doesn't match the actor's ID"
Nothing -> throwE "keyId resolved to actor which doesn't have a key object with that ID" return
Just pk -> ( publicKeyPem pk
case publicKeyOwner pk of , \ k ->
OwnerInstance -> throwE "Actor's publicKey is shared, but embedded in actor document! We allow shared keys only if they're in a separate document" Fetched
OwnerActor owner -> do { fetchedPublicKey = k
if owner == actorId actor , fetchedKeyExpires = publicKeyExpires pk
then return () , fetchedActorId = owner
else throwE "Actor's publicKey's owner doesn't match the actor's ID" , fetchedActorInbox = actorInbox actor
return , fetchedKeyShared = False
( publicKeyPem pk }
, \ k -> , publicKeyAlgo pk
Fetched )
{ fetchedPublicKey = k
, fetchedKeyExpires = publicKeyExpires pk
, fetchedActorId = owner
, fetchedActorInbox = actorInbox actor
, fetchedKeyShared = False
}
, 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 $
if sigAlgo
then "Algo mismatch, Ed25519 in Sig but none in actor"
else "Algo not given in Sig nor actor"
verifyAlgo sigAlgo (Just algo) =
case algo of
AlgorithmEd25519 -> Right ()
AlgorithmOther _ ->
Left $ Left $
if sigAlgo if sigAlgo
then "Algo mismatch, Ed25519 in Sig but none in actor" then "Algo mismatch, Ed25519 in Sig but unsupported algo in actor"
else "Algo not given in Sig nor actor" else "No algo in Sig, unsupported algo in actor"
Just algo -> parseKey pem =
case algo of
AlgorithmEd25519 -> Right ()
AlgorithmOther _ ->
Left $
if sigAlgo
then "Algo mismatch, Ed25519 in Sig but unsupported algo in actor"
else "No algo in Sig, unsupported algo in actor"
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"