{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.JOSE.Header
(
HeaderParam(..)
, ProtectionIndicator(..)
, Protection(..)
, protection
, isProtected
, param
, HasParams(..)
, headerRequired
, headerRequiredProtected
, headerOptional
, headerOptionalProtected
, parseParams
, parseCrit
, protectedParamsEncoded
, unprotectedParams
, HasAlg(..)
, HasJku(..)
, HasJwk(..)
, HasKid(..)
, HasX5u(..)
, HasX5c(..)
, HasX5t(..)
, HasX5tS256(..)
, HasTyp(..)
, HasCty(..)
, HasCrit(..)
) where
import qualified Control.Monad.Fail as Fail
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Monoid ((<>))
import Data.Proxy (Proxy(..))
import Control.Lens (Lens', Getter, review, to)
import Data.Aeson (FromJSON(..), Object, Value, encode, object)
import Data.Aeson.Types (Pair, Parser)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as M
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Crypto.JOSE.JWA.JWS as JWA.JWS
import Crypto.JOSE.JWK (JWK)
import Crypto.JOSE.Types.Orphans ()
import Crypto.JOSE.Types.Internal (base64url)
import qualified Crypto.JOSE.Types as Types
class HasParams (a :: Type -> Type) where
params :: ProtectionIndicator p => a p -> [(Bool, Pair)]
extensions :: Proxy a -> [T.Text]
extensions = [Text] -> Proxy a -> [Text]
forall a b. a -> b -> a
const []
parseParamsFor
:: (HasParams b, ProtectionIndicator p)
=> Proxy b -> Maybe Object -> Maybe Object -> Parser (a p)
parseParams
:: forall a p. (HasParams a, ProtectionIndicator p)
=> Maybe Object
-> Maybe Object
-> Parser (a p)
parseParams :: Maybe Object -> Maybe Object -> Parser (a p)
parseParams = Proxy a -> Maybe Object -> Maybe Object -> Parser (a p)
forall (a :: * -> *) (b :: * -> *) p.
(HasParams a, HasParams b, ProtectionIndicator p) =>
Proxy b -> Maybe Object -> Maybe Object -> Parser (a p)
parseParamsFor (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
protectedParams
:: (HasParams a, ProtectionIndicator p)
=> a p -> Maybe Value
protectedParams :: a p -> Maybe Value
protectedParams a p
h =
case (((Bool, Pair) -> Pair) -> [(Bool, Pair)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Pair) -> Pair
forall a b. (a, b) -> b
snd ([(Bool, Pair)] -> [Pair])
-> (a p -> [(Bool, Pair)]) -> a p -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, Pair) -> Bool) -> [(Bool, Pair)] -> [(Bool, Pair)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, Pair) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, Pair)] -> [(Bool, Pair)])
-> (a p -> [(Bool, Pair)]) -> a p -> [(Bool, Pair)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a p -> [(Bool, Pair)]
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
a p -> [(Bool, Pair)]
params) a p
h of
[] -> Maybe Value
forall a. Maybe a
Nothing
[Pair]
xs -> Value -> Maybe Value
forall a. a -> Maybe a
Just ([Pair] -> Value
object [Pair]
xs)
protectedParamsEncoded
:: (HasParams a, ProtectionIndicator p)
=> a p -> L.ByteString
protectedParamsEncoded :: a p -> ByteString
protectedParamsEncoded =
ByteString -> (Value -> ByteString) -> Maybe Value -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty (AReview ByteString ByteString -> ByteString -> ByteString
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview ByteString ByteString
forall s1 s2.
(AsEmpty s1, AsEmpty s2, Cons s1 s1 Word8 Word8,
Cons s2 s2 Word8 Word8) =>
Prism' s1 s2
base64url (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode) (Maybe Value -> ByteString)
-> (a p -> Maybe Value) -> a p -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a p -> Maybe Value
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
a p -> Maybe Value
protectedParams
unprotectedParams
:: (HasParams a, ProtectionIndicator p)
=> a p -> Maybe Value
unprotectedParams :: a p -> Maybe Value
unprotectedParams a p
h =
case (((Bool, Pair) -> Pair) -> [(Bool, Pair)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Pair) -> Pair
forall a b. (a, b) -> b
snd ([(Bool, Pair)] -> [Pair])
-> (a p -> [(Bool, Pair)]) -> a p -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool, Pair) -> Bool) -> [(Bool, Pair)] -> [(Bool, Pair)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Bool, Pair) -> Bool) -> (Bool, Pair) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Pair) -> Bool
forall a b. (a, b) -> a
fst) ([(Bool, Pair)] -> [(Bool, Pair)])
-> (a p -> [(Bool, Pair)]) -> a p -> [(Bool, Pair)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a p -> [(Bool, Pair)]
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
a p -> [(Bool, Pair)]
params) a p
h of
[] -> Maybe Value
forall a. Maybe a
Nothing
[Pair]
xs -> Value -> Maybe Value
forall a. a -> Maybe a
Just ([Pair] -> Value
object [Pair]
xs)
data Protection = Protected | Unprotected
deriving (Protection -> Protection -> Bool
(Protection -> Protection -> Bool)
-> (Protection -> Protection -> Bool) -> Eq Protection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protection -> Protection -> Bool
$c/= :: Protection -> Protection -> Bool
== :: Protection -> Protection -> Bool
$c== :: Protection -> Protection -> Bool
Eq, Int -> Protection -> ShowS
[Protection] -> ShowS
Protection -> String
(Int -> Protection -> ShowS)
-> (Protection -> String)
-> ([Protection] -> ShowS)
-> Show Protection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protection] -> ShowS
$cshowList :: [Protection] -> ShowS
show :: Protection -> String
$cshow :: Protection -> String
showsPrec :: Int -> Protection -> ShowS
$cshowsPrec :: Int -> Protection -> ShowS
Show)
class Eq a => ProtectionIndicator a where
getProtected :: a
getUnprotected :: Maybe a
instance ProtectionIndicator Protection where
getProtected :: Protection
getProtected = Protection
Protected
getUnprotected :: Maybe Protection
getUnprotected = Protection -> Maybe Protection
forall a. a -> Maybe a
Just Protection
Unprotected
instance ProtectionIndicator () where
getProtected :: ()
getProtected = ()
getUnprotected :: Maybe ()
getUnprotected = Maybe ()
forall a. Maybe a
Nothing
data p a = p a
deriving (HeaderParam p a -> HeaderParam p a -> Bool
(HeaderParam p a -> HeaderParam p a -> Bool)
-> (HeaderParam p a -> HeaderParam p a -> Bool)
-> Eq (HeaderParam p a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p a.
(Eq p, Eq a) =>
HeaderParam p a -> HeaderParam p a -> Bool
/= :: HeaderParam p a -> HeaderParam p a -> Bool
$c/= :: forall p a.
(Eq p, Eq a) =>
HeaderParam p a -> HeaderParam p a -> Bool
== :: HeaderParam p a -> HeaderParam p a -> Bool
$c== :: forall p a.
(Eq p, Eq a) =>
HeaderParam p a -> HeaderParam p a -> Bool
Eq, Int -> HeaderParam p a -> ShowS
[HeaderParam p a] -> ShowS
HeaderParam p a -> String
(Int -> HeaderParam p a -> ShowS)
-> (HeaderParam p a -> String)
-> ([HeaderParam p a] -> ShowS)
-> Show (HeaderParam p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> HeaderParam p a -> ShowS
forall p a. (Show p, Show a) => [HeaderParam p a] -> ShowS
forall p a. (Show p, Show a) => HeaderParam p a -> String
showList :: [HeaderParam p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [HeaderParam p a] -> ShowS
show :: HeaderParam p a -> String
$cshow :: forall p a. (Show p, Show a) => HeaderParam p a -> String
showsPrec :: Int -> HeaderParam p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> HeaderParam p a -> ShowS
Show)
instance Functor (HeaderParam p) where
fmap :: (a -> b) -> HeaderParam p a -> HeaderParam p b
fmap a -> b
f (HeaderParam p
p a
a) = p -> b -> HeaderParam p b
forall p a. p -> a -> HeaderParam p a
HeaderParam p
p (a -> b
f a
a)
protection :: Lens' (HeaderParam p a) p
protection :: (p -> f p) -> HeaderParam p a -> f (HeaderParam p a)
protection p -> f p
f (HeaderParam p
p a
v) = (p -> HeaderParam p a) -> f p -> f (HeaderParam p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\p
p' -> p -> a -> HeaderParam p a
forall p a. p -> a -> HeaderParam p a
HeaderParam p
p' a
v) (p -> f p
f p
p)
{-# ANN protection "HLint: ignore Avoid lambda using `infix`" #-}
param :: Lens' (HeaderParam p a) a
param :: (a -> f a) -> HeaderParam p a -> f (HeaderParam p a)
param a -> f a
f (HeaderParam p
p a
v) = (a -> HeaderParam p a) -> f a -> f (HeaderParam p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
v' -> p -> a -> HeaderParam p a
forall p a. p -> a -> HeaderParam p a
HeaderParam p
p a
v') (a -> f a
f a
v)
{-# ANN param "HLint: ignore Avoid lambda" #-}
isProtected :: (ProtectionIndicator p) => Getter (HeaderParam p a) Bool
isProtected :: Getter (HeaderParam p a) Bool
isProtected = (p -> f p) -> HeaderParam p a -> f (HeaderParam p a)
forall p a. Lens' (HeaderParam p a) p
protection ((p -> f p) -> HeaderParam p a -> f (HeaderParam p a))
-> ((Bool -> f Bool) -> p -> f p)
-> (Bool -> f Bool)
-> HeaderParam p a
-> f (HeaderParam p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> Bool) -> (Bool -> f Bool) -> p -> f p
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
forall a. ProtectionIndicator a => a
getProtected)
headerOptional
:: (FromJSON a, ProtectionIndicator p)
=> T.Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p a))
Text
kText Maybe Object
hp Maybe Object
hu = case (Maybe Object
hp Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k, Maybe Object
hu Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k) of
(Just Value
_, Just Value
_) -> String -> Parser (Maybe (HeaderParam p a))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Maybe (HeaderParam p a)))
-> String -> Parser (Maybe (HeaderParam p a))
forall a b. (a -> b) -> a -> b
$ String
"duplicate header " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kText
(Just Value
v, Maybe Value
Nothing) -> HeaderParam p a -> Maybe (HeaderParam p a)
forall a. a -> Maybe a
Just (HeaderParam p a -> Maybe (HeaderParam p a))
-> (a -> HeaderParam p a) -> a -> Maybe (HeaderParam p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> a -> HeaderParam p a
forall p a. p -> a -> HeaderParam p a
HeaderParam p
forall a. ProtectionIndicator a => a
getProtected (a -> Maybe (HeaderParam p a))
-> Parser a -> Parser (Maybe (HeaderParam p a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
(Maybe Value
Nothing, Just Value
v) -> Parser (Maybe (HeaderParam p a))
-> (p -> Parser (Maybe (HeaderParam p a)))
-> Maybe p
-> Parser (Maybe (HeaderParam p a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(String -> Parser (Maybe (HeaderParam p a))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unprotected header not supported")
(\p
p -> HeaderParam p a -> Maybe (HeaderParam p a)
forall a. a -> Maybe a
Just (HeaderParam p a -> Maybe (HeaderParam p a))
-> (a -> HeaderParam p a) -> a -> Maybe (HeaderParam p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> a -> HeaderParam p a
forall p a. p -> a -> HeaderParam p a
HeaderParam p
p (a -> Maybe (HeaderParam p a))
-> Parser a -> Parser (Maybe (HeaderParam p a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
Maybe p
forall a. ProtectionIndicator a => Maybe a
getUnprotected
(Maybe Value
Nothing, Maybe Value
Nothing) -> Maybe (HeaderParam p a) -> Parser (Maybe (HeaderParam p a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HeaderParam p a)
forall a. Maybe a
Nothing
where
k :: Key
k = Text -> Key
Key.fromText Text
kText
headerOptionalProtected
:: FromJSON a
=> T.Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe a)
Text
kText Maybe Object
hp Maybe Object
hu = case (Maybe Object
hp Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k, Maybe Object
hu Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k) of
(Just Value
_, Just Value
_) -> String -> Parser (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Maybe a)) -> String -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ String
"duplicate header " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kText
(Maybe Value
_, Just Value
_) -> String -> Parser (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Maybe a)) -> String -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ String
"header must be protected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kText
(Just Value
v, Maybe Value
_) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
(Maybe Value, Maybe Value)
_ -> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
where
k :: Key
k = Text -> Key
Key.fromText Text
kText
headerRequired
:: (FromJSON a, ProtectionIndicator p)
=> T.Text
-> Maybe Object
-> Maybe Object
-> Parser (HeaderParam p a)
Text
kText Maybe Object
hp Maybe Object
hu = case (Maybe Object
hp Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k, Maybe Object
hu Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k) of
(Just Value
_, Just Value
_) -> String -> Parser (HeaderParam p a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (HeaderParam p a))
-> String -> Parser (HeaderParam p a)
forall a b. (a -> b) -> a -> b
$ String
"duplicate header " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kText
(Just Value
v, Maybe Value
Nothing) -> p -> a -> HeaderParam p a
forall p a. p -> a -> HeaderParam p a
HeaderParam p
forall a. ProtectionIndicator a => a
getProtected (a -> HeaderParam p a) -> Parser a -> Parser (HeaderParam p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
(Maybe Value
Nothing, Just Value
v) -> Parser (HeaderParam p a)
-> (p -> Parser (HeaderParam p a))
-> Maybe p
-> Parser (HeaderParam p a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(String -> Parser (HeaderParam p a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unprotected header not supported")
(\p
p -> p -> a -> HeaderParam p a
forall p a. p -> a -> HeaderParam p a
HeaderParam p
p (a -> HeaderParam p a) -> Parser a -> Parser (HeaderParam p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
Maybe p
forall a. ProtectionIndicator a => Maybe a
getUnprotected
(Maybe Value
Nothing, Maybe Value
Nothing) -> String -> Parser (HeaderParam p a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (HeaderParam p a))
-> String -> Parser (HeaderParam p a)
forall a b. (a -> b) -> a -> b
$ String
"missing required header " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
forall a. Show a => a -> String
show Key
k
where
k :: Key
k = Text -> Key
Key.fromText Text
kText
headerRequiredProtected
:: FromJSON a
=> T.Text
-> Maybe Object
-> Maybe Object
-> Parser a
Text
kText Maybe Object
hp Maybe Object
hu = case (Maybe Object
hp Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k, Maybe Object
hu Maybe Object -> (Object -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
k) of
(Just Value
_, Just Value
_) -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"duplicate header " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
kText
(Maybe Value
_, Just Value
_) -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"header must be protected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
kText
(Just Value
v, Maybe Value
_) -> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
(Maybe Value, Maybe Value)
_ -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"missing required protected header: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
kText
where
k :: Key
k = Text -> Key
Key.fromText Text
kText
critObjectParser
:: (Foldable t0, Foldable t1, Fail.MonadFail m)
=> t0 T.Text -> t1 T.Text -> Object -> T.Text -> m T.Text
critObjectParser :: t0 Text -> t1 Text -> Object -> Text -> m Text
critObjectParser t0 Text
reserved t1 Text
exts Object
o Text
s
| Text
s Text -> t0 Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t0 Text
reserved = String -> m Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
"crit key is reserved"
| Text
s Text -> t1 Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t1 Text
exts = String -> m Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
"crit key is not understood"
| Bool -> Bool
not (Text -> Key
Key.fromText Text
s Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
`M.member` Object
o) = String -> m Text
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
"crit key is not present in headers"
| Bool
otherwise = Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
parseCrit
:: (Foldable t0, Foldable t1, Traversable t2, Traversable t3, Fail.MonadFail m)
=> t0 T.Text
-> t1 T.Text
-> Object
-> t2 (t3 T.Text)
-> m (t2 (t3 T.Text))
parseCrit :: t0 Text -> t1 Text -> Object -> t2 (t3 Text) -> m (t2 (t3 Text))
parseCrit t0 Text
reserved t1 Text
exts Object
o = (t3 Text -> m (t3 Text)) -> t2 (t3 Text) -> m (t2 (t3 Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> m Text) -> t3 Text -> m (t3 Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (t0 Text -> t1 Text -> Object -> Text -> m Text
forall (t0 :: * -> *) (t1 :: * -> *) (m :: * -> *).
(Foldable t0, Foldable t1, MonadFail m) =>
t0 Text -> t1 Text -> Object -> Text -> m Text
critObjectParser t0 Text
reserved t1 Text
exts Object
o))
class HasAlg a where
alg :: Lens' (a p) (HeaderParam p JWA.JWS.Alg)
class HasJku a where
jku :: Lens' (a p) (Maybe (HeaderParam p Types.URI))
class HasJwk a where
jwk :: Lens' (a p) (Maybe (HeaderParam p JWK))
class HasKid a where
kid :: Lens' (a p) (Maybe (HeaderParam p T.Text))
class HasX5u a where
x5u :: Lens' (a p) (Maybe (HeaderParam p Types.URI))
class HasX5c a where
x5c :: Lens' (a p) (Maybe (HeaderParam p (NonEmpty Types.SignedCertificate)))
class HasX5t a where
x5t :: Lens' (a p) (Maybe (HeaderParam p Types.Base64SHA1))
class HasX5tS256 a where
x5tS256 :: Lens' (a p) (Maybe (HeaderParam p Types.Base64SHA256))
class HasTyp a where
typ :: Lens' (a p) (Maybe (HeaderParam p T.Text))
class HasCty a where
cty :: Lens' (a p) (Maybe (HeaderParam p T.Text))
class HasCrit a where
crit :: Lens' (a p) (Maybe (NonEmpty T.Text))