Key stores. Instances are provided for JWK and JWKSet. These
instances ignore the header and payload and just return the JWK/s
they contain. More complex scenarios, such as efficient key lookup
by "kid" or searching a database, can be implemented by writing a
new instance.
For example, the following instance looks in a filesystem directory
for keys based on either the JWS Header's "kid" parameter, or the
"iss" claim in a JWT Claims Set:
-- | A KeyDB is just a filesystem directory
newtype KeyDB = KeyDB FilePath
instance (MonadIO m, HasKid h)
=> VerificationKeyStore m (h p) ClaimsSet KeyDB where
getVerificationKeys h claims (KeyDB dir) = liftIO $
fmap catMaybes . traverse findKey $ catMaybes
[ preview (kid . _Just . param) h
, preview (claimIss . _Just . string) claims]
where
findKey :: T.Text -> IO (Maybe JWK)
findKey s =
let path = dir <> "/" <> T.unpack s <> ".jwk"
in handle
(\(_ :: IOException) -> pure Nothing)
(decode <$> L.readFile path)
The next example shows how to retrieve public keys from a JWK Set
(/.well-known/jwks.json) resource. For production use, it would
be a good idea to cache the HTTP response. Thanks to Steve Mao for
this example.
-- | URI of JWK Set
newtype JWKsURI = JWKsURI String
instance (MonadIO m, HasKid h)
=> VerificationKeyStore m (h p) ClaimsSet JWKsURI where
getVerificationKeys h claims (JWKsURI url) = liftIO $
maybe [] (:[]) . join
<$> traverse findKey (preview (kid . _Just . param) h)
where
findKey :: T.Text -> IO (Maybe JWK)
findKey kid' =
handle (\(_ :: SomeException) -> pure Nothing) $ do
request <- setRequestCheckStatus <$> parseRequest url
response <- getResponseBody <$> httpJSON request
keys <- getVerificationKeys h claims response
pure $ find (\j -> view jwkKid j == Just kid') keys
Use a JWKSet as a VerificationKeyStore. Can be used with
any payload type. Returns all keys in the set; header and
payload are ignored. No filtering is performed.