Safe Haskell | None |
---|---|
Language | Haskell2010 |
Types and functions for working with JOSE header parameters.
Synopsis
- data HeaderParam p a = HeaderParam p a
- class Eq a => ProtectionIndicator a where
- getProtected :: a
- getUnprotected :: Maybe a
- data Protection
- protection :: Lens' (HeaderParam p a) p
- isProtected :: ProtectionIndicator p => Getter (HeaderParam p a) Bool
- param :: Lens' (HeaderParam p a) a
- class HasParams (a :: Type -> Type) where
- params :: ProtectionIndicator p => a p -> [(Bool, Pair)]
- extensions :: Proxy a -> [Text]
- parseParamsFor :: (HasParams b, ProtectionIndicator p) => Proxy b -> Maybe Object -> Maybe Object -> Parser (a p)
- headerRequired :: (FromJSON a, ProtectionIndicator p) => Text -> Maybe Object -> Maybe Object -> Parser (HeaderParam p a)
- headerRequiredProtected :: FromJSON a => Text -> Maybe Object -> Maybe Object -> Parser a
- headerOptional :: (FromJSON a, ProtectionIndicator p) => Text -> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
- headerOptionalProtected :: FromJSON a => Text -> Maybe Object -> Maybe Object -> Parser (Maybe a)
- parseParams :: forall a p. (HasParams a, ProtectionIndicator p) => Maybe Object -> Maybe Object -> Parser (a p)
- parseCrit :: (Foldable t0, Foldable t1, Traversable t2, Traversable t3, MonadFail m) => t0 Text -> t1 Text -> Object -> t2 (t3 Text) -> m (t2 (t3 Text))
- protectedParamsEncoded :: (HasParams a, ProtectionIndicator p) => a p -> ByteString
- unprotectedParams :: (HasParams a, ProtectionIndicator p) => a p -> Maybe Value
- class HasAlg a where
- alg :: Lens' (a p) (HeaderParam p Alg)
- class HasJku a where
- jku :: Lens' (a p) (Maybe (HeaderParam p URI))
- class HasJwk a where
- jwk :: Lens' (a p) (Maybe (HeaderParam p JWK))
- class HasKid a where
- kid :: Lens' (a p) (Maybe (HeaderParam p Text))
- class HasX5u a where
- x5u :: Lens' (a p) (Maybe (HeaderParam p URI))
- class HasX5c a where
- x5c :: Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
- class HasX5t a where
- x5t :: Lens' (a p) (Maybe (HeaderParam p Base64SHA1))
- class HasX5tS256 a where
- x5tS256 :: Lens' (a p) (Maybe (HeaderParam p Base64SHA256))
- class HasTyp a where
- typ :: Lens' (a p) (Maybe (HeaderParam p Text))
- class HasCty a where
- cty :: Lens' (a p) (Maybe (HeaderParam p Text))
- class HasCrit a where
Defining header data types
data HeaderParam p a Source #
A header value, along with a protection indicator.
HeaderParam p a |
Instances
Functor (HeaderParam p) Source # | |
Defined in Crypto.JOSE.Header fmap :: (a -> b) -> HeaderParam p a -> HeaderParam p b # (<$) :: a -> HeaderParam p b -> HeaderParam p a # | |
(Eq p, Eq a) => Eq (HeaderParam p a) Source # | |
Defined in Crypto.JOSE.Header (==) :: HeaderParam p a -> HeaderParam p a -> Bool # (/=) :: HeaderParam p a -> HeaderParam p a -> Bool # | |
(Show p, Show a) => Show (HeaderParam p a) Source # | |
Defined in Crypto.JOSE.Header showsPrec :: Int -> HeaderParam p a -> ShowS # show :: HeaderParam p a -> String # showList :: [HeaderParam p a] -> ShowS # |
class Eq a => ProtectionIndicator a where Source #
Instances
ProtectionIndicator () Source # | |
Defined in Crypto.JOSE.Header getProtected :: () Source # getUnprotected :: Maybe () Source # | |
ProtectionIndicator Protection Source # | |
Defined in Crypto.JOSE.Header |
data Protection Source #
Whether a header is protected or unprotected
Instances
Eq Protection Source # | |
Defined in Crypto.JOSE.Header (==) :: Protection -> Protection -> Bool # (/=) :: Protection -> Protection -> Bool # | |
Show Protection Source # | |
Defined in Crypto.JOSE.Header showsPrec :: Int -> Protection -> ShowS # show :: Protection -> String # showList :: [Protection] -> ShowS # | |
ProtectionIndicator Protection Source # | |
Defined in Crypto.JOSE.Header |
protection :: Lens' (HeaderParam p a) p Source #
Lens for the Protection
of a HeaderParam
isProtected :: ProtectionIndicator p => Getter (HeaderParam p a) Bool Source #
Getter for whether a parameter is protected
param :: Lens' (HeaderParam p a) a Source #
Lens for a HeaderParam
value
Defining header parsers
The parseParamsFor
function defines the parser for a header type.
parseParamsFor
:: (HasParams
a, HasParams b) => Proxy b -> Maybe Object -> Maybe Object ->Parser
a
It is defined over two objects: the protected header and the unprotected header. The following functions are provided for parsing header parameters:
headerOptional
- An optional parameter that may be protected or unprotected.
headerRequired
- A required parameter that may be protected or unprotected.
headerOptionalProtected
- An optional parameter that, if present, MUST be carried in the protected header.
headerRequiredProtected
- A required parameter that, if present, MUST be carried in the protected header.
Duplicate headers are forbidden. The above functions all perform duplicate header detection. If you do not use them, be sure to perform this detection yourself!
An example parser:
instance HasParams ACMEHeader whereparseParamsFor
proxy hp hu = ACMEHeader <$>parseParamsFor
proxy hp hu <*>headerRequiredProtected
"nonce" hp hu
class HasParams (a :: Type -> Type) where Source #
A thing with parameters.
params :: ProtectionIndicator p => a p -> [(Bool, Pair)] Source #
Return a list of parameters, each paired with whether it is protected or not.
extensions :: Proxy a -> [Text] Source #
List of "known extensions", i.e. keys that may appear in the "crit" header parameter.
parseParamsFor :: (HasParams b, ProtectionIndicator p) => Proxy b -> Maybe Object -> Maybe Object -> Parser (a p) Source #
Instances
HasParams JWSHeader Source # | |
Defined in Crypto.JOSE.JWS | |
HasParams JWEHeader Source # | |
Defined in Crypto.JOSE.JWE |
headerRequired :: (FromJSON a, ProtectionIndicator p) => Text -> Maybe Object -> Maybe Object -> Parser (HeaderParam p a) Source #
Parse a required parameter that may be carried in either the protected or the unprotected header.
headerRequiredProtected :: FromJSON a => Text -> Maybe Object -> Maybe Object -> Parser a Source #
Parse a required parameter that MUST be carried in the protected header.
headerOptional :: (FromJSON a, ProtectionIndicator p) => Text -> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a)) Source #
Parse an optional parameter that may be carried in either the protected or the unprotected header.
headerOptionalProtected :: FromJSON a => Text -> Maybe Object -> Maybe Object -> Parser (Maybe a) Source #
Parse an optional parameter that, if present, MUST be carried in the protected header.
Parsing headers
:: forall a p. (HasParams a, ProtectionIndicator p) | |
=> Maybe Object | protected header |
-> Maybe Object | unprotected header |
-> Parser (a p) |
Parse a pair of objects (protected and unprotected header)
This internally invokes parseParamsFor
applied to a proxy for
the target type. (This allows the parsing of the "crit" parameter
to access "known extensions" understood by the target type.)
:: (Foldable t0, Foldable t1, Traversable t2, Traversable t3, MonadFail m) | |
=> t0 Text | reserved header parameters |
-> t1 Text | recognised extensions |
-> Object | full header (union of protected and unprotected headers) |
-> t2 (t3 Text) | crit header |
-> m (t2 (t3 Text)) |
Parse a "crit" header param
Fails if:
- any reserved header appears in "crit" header
- any value in "crit" is not a recognised extension
- any value in "crit" does not have a corresponding key in the object
Encoding headers
protectedParamsEncoded :: (HasParams a, ProtectionIndicator p) => a p -> ByteString Source #
Return the base64url-encoded protected parameters
:: (HasParams a, ProtectionIndicator p) | |
=> a p | |
-> Maybe Value | Object |
Return unprotected params as a JSON Value
(always an object)
Header fields shared by JWS and JWE
Instances
HasJWSHeader a => HasAlg a Source # | |
Defined in Crypto.JOSE.JWS |
Instances
HasJWSHeader a => HasJku a Source # | |
Defined in Crypto.JOSE.JWS |
Instances
HasJWSHeader a => HasJwk a Source # | |
Defined in Crypto.JOSE.JWS |
Instances
HasJWSHeader a => HasKid a Source # | |
Defined in Crypto.JOSE.JWS |
Instances
HasJWSHeader a => HasX5u a Source # | |
Defined in Crypto.JOSE.JWS |
x5c :: Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate))) Source #
Instances
HasJWSHeader a => HasX5c a Source # | |
Defined in Crypto.JOSE.JWS x5c :: Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate))) Source # |
x5t :: Lens' (a p) (Maybe (HeaderParam p Base64SHA1)) Source #
Instances
HasJWSHeader a => HasX5t a Source # | |
Defined in Crypto.JOSE.JWS x5t :: Lens' (a p) (Maybe (HeaderParam p Base64SHA1)) Source # |
class HasX5tS256 a where Source #
x5tS256 :: Lens' (a p) (Maybe (HeaderParam p Base64SHA256)) Source #
Instances
HasJWSHeader a => HasX5tS256 a Source # | |
Defined in Crypto.JOSE.JWS x5tS256 :: Lens' (a p) (Maybe (HeaderParam p Base64SHA256)) Source # |
Instances
HasJWSHeader a => HasTyp a Source # | |
Defined in Crypto.JOSE.JWS |
Instances
HasJWSHeader a => HasCty a Source # | |
Defined in Crypto.JOSE.JWS |