sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 11:34: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

86
src/Web/ActivityPub.hs
View file

@ -581,48 +581,54 @@ 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
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 ()
else throwE "Actor's publicKey's owner doesn't match the actor's ID"
return
( publicKeyPem pk
, \ k ->
Fetched
{ fetchedPublicKey = k
, fetchedKeyExpires = publicKeyExpires pk
, fetchedActorId = owner
, fetchedActorInbox = actorInbox actor
, fetchedKeyShared = False
}
, publicKeyAlgo pk
)
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 owner
else throwE "Actor's publicKey's owner doesn't match the actor's ID"
return
( publicKeyPem pk
, \ k ->
Fetched
{ fetchedPublicKey = k
, fetchedKeyExpires = publicKeyExpires pk
, fetchedActorId = owner
, fetchedActorInbox = actorInbox actor
, fetchedKeyShared = False
}
, 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"
verifyAlgo sigAlgo (Just algo) =
case algo of
AlgorithmEd25519 -> Right ()
AlgorithmOther _ ->
Left $
if sigAlgo
then "Algo mismatch, Ed25519 in Sig but none in actor"
else "Algo not given in Sig nor actor"
Just algo ->
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"
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"