jose-0.9: JSON Object Signing and Encryption (JOSE) and JSON Web Token (JWT) library
Safe HaskellNone
LanguageHaskell2010

Crypto.JOSE.JWK.Store

Description

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
Synopsis

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.

Methods

getVerificationKeys Source #

Arguments

:: h

JWS header

-> s

Payload

-> a 
-> m [JWK] 

Look up verification keys by JWS header and payload.

Instances

Instances details
Applicative m => VerificationKeyStore m h s JWKSet Source #

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.

Instance details

Defined in Crypto.JOSE.JWK.Store

Methods

getVerificationKeys :: h -> s -> JWKSet -> m [JWK] Source #

Applicative m => VerificationKeyStore m h s JWK Source #

Use a JWK as a VerificationKeyStore. Can be used with any payload type. Header and payload are ignored. No filtering is performed.

Instance details

Defined in Crypto.JOSE.JWK.Store

Methods

getVerificationKeys :: h -> s -> JWK -> m [JWK] Source #