Safe Haskell | None |
---|---|
Language | Haskell2010 |
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 wheregetVerificationKeys
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 wheregetVerificationKeys
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 -> viewjwkKid
j == Just kid') keys
Synopsis
- class VerificationKeyStore m h s a where
- getVerificationKeys :: h -> s -> a -> m [JWK]
Documentation
class VerificationKeyStore m h s a where Source #
Verification keys. Lookup operates in effect m
with access
to the JWS header of type h
and a payload of type s
.
The returned keys are not guaranteed to be used, e.g. if the JWK
"use"
or "key_ops"
field does not allow use for verification.
:: h | JWS header |
-> s | Payload |
-> a | |
-> m [JWK] |
Look up verification keys by JWS header and payload.
Instances
Applicative m => VerificationKeyStore m h s JWKSet Source # | Use a |
Defined in Crypto.JOSE.JWK.Store getVerificationKeys :: h -> s -> JWKSet -> m [JWK] Source # | |
Applicative m => VerificationKeyStore m h s JWK Source # | Use a |
Defined in Crypto.JOSE.JWK.Store getVerificationKeys :: h -> s -> JWK -> m [JWK] Source # |