{-# LANGUAGE OverloadedStrings, DeriveGeneric, FlexibleContexts, GeneralizedNewtypeDeriving, CPP #-}
{-# OPTIONS_HADDOCK prune #-}

module Jose.Types
    ( Jwt (..)
    , Jwe
    , Jws
    , JwtClaims (..)
    , JwtHeader (..)
    , JwsHeader (..)
    , JweHeader (..)
    , JwtContent (..)
    , JwtEncoding (..)
    , JwtError (..)
    , IntDate (..)
    , Payload (..)
    , KeyId (..)
    , parseHeader
    , encodeHeader
    , defJwsHdr
    , defJweHdr
    )
where

import Data.Aeson
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as H
#endif
import Data.Char (toUpper, toLower)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Int (Int64)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Vector (singleton)
import GHC.Generics

import Jose.Jwa (JweAlg(..), JwsAlg (..), Enc(..))

-- | An encoded JWT.
newtype Jwt = Jwt { Jwt -> ByteString
unJwt :: ByteString } deriving (Int -> Jwt -> ShowS
[Jwt] -> ShowS
Jwt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Jwt] -> ShowS
$cshowList :: [Jwt] -> ShowS
show :: Jwt -> String
$cshow :: Jwt -> String
showsPrec :: Int -> Jwt -> ShowS
$cshowsPrec :: Int -> Jwt -> ShowS
Show, Jwt -> Jwt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Jwt -> Jwt -> Bool
$c/= :: Jwt -> Jwt -> Bool
== :: Jwt -> Jwt -> Bool
$c== :: Jwt -> Jwt -> Bool
Eq)

-- | The payload to be encoded in a JWT.
data Payload = Nested Jwt
             | Claims ByteString
             deriving (Int -> Payload -> ShowS
[Payload] -> ShowS
Payload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Payload] -> ShowS
$cshowList :: [Payload] -> ShowS
show :: Payload -> String
$cshow :: Payload -> String
showsPrec :: Int -> Payload -> ShowS
$cshowsPrec :: Int -> Payload -> ShowS
Show, Payload -> Payload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Payload -> Payload -> Bool
$c/= :: Payload -> Payload -> Bool
== :: Payload -> Payload -> Bool
$c== :: Payload -> Payload -> Bool
Eq)

-- | The header and claims of a decoded JWS.
type Jws = (JwsHeader, ByteString)

-- | The header and claims of a decoded JWE.
type Jwe = (JweHeader, ByteString)

-- | A decoded JWT which can be either a JWE or a JWS, or an unsecured JWT.
data JwtContent = Unsecured !ByteString | Jws !Jws | Jwe !Jwe deriving (Int -> JwtContent -> ShowS
[JwtContent] -> ShowS
JwtContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwtContent] -> ShowS
$cshowList :: [JwtContent] -> ShowS
show :: JwtContent -> String
$cshow :: JwtContent -> String
showsPrec :: Int -> JwtContent -> ShowS
$cshowsPrec :: Int -> JwtContent -> ShowS
Show, JwtContent -> JwtContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JwtContent -> JwtContent -> Bool
$c/= :: JwtContent -> JwtContent -> Bool
== :: JwtContent -> JwtContent -> Bool
$c== :: JwtContent -> JwtContent -> Bool
Eq)

-- | Defines the encoding information for a JWT.
--
-- Used for both encoding new JWTs and validating existing ones.
data JwtEncoding
    = JwsEncoding JwsAlg
    | JweEncoding JweAlg Enc
      deriving (JwtEncoding -> JwtEncoding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JwtEncoding -> JwtEncoding -> Bool
$c/= :: JwtEncoding -> JwtEncoding -> Bool
== :: JwtEncoding -> JwtEncoding -> Bool
$c== :: JwtEncoding -> JwtEncoding -> Bool
Eq, Int -> JwtEncoding -> ShowS
[JwtEncoding] -> ShowS
JwtEncoding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwtEncoding] -> ShowS
$cshowList :: [JwtEncoding] -> ShowS
show :: JwtEncoding -> String
$cshow :: JwtEncoding -> String
showsPrec :: Int -> JwtEncoding -> ShowS
$cshowsPrec :: Int -> JwtEncoding -> ShowS
Show)

data JwtHeader = JweH JweHeader
               | JwsH JwsHeader
               | UnsecuredH
                 deriving (Int -> JwtHeader -> ShowS
[JwtHeader] -> ShowS
JwtHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwtHeader] -> ShowS
$cshowList :: [JwtHeader] -> ShowS
show :: JwtHeader -> String
$cshow :: JwtHeader -> String
showsPrec :: Int -> JwtHeader -> ShowS
$cshowsPrec :: Int -> JwtHeader -> ShowS
Show)

data KeyId
    = KeyId    Text
    | UTCKeyId UTCTime
      deriving (KeyId -> KeyId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyId -> KeyId -> Bool
$c/= :: KeyId -> KeyId -> Bool
== :: KeyId -> KeyId -> Bool
$c== :: KeyId -> KeyId -> Bool
Eq, Int -> KeyId -> ShowS
[KeyId] -> ShowS
KeyId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyId] -> ShowS
$cshowList :: [KeyId] -> ShowS
show :: KeyId -> String
$cshow :: KeyId -> String
showsPrec :: Int -> KeyId -> ShowS
$cshowsPrec :: Int -> KeyId -> ShowS
Show, Eq KeyId
KeyId -> KeyId -> Bool
KeyId -> KeyId -> Ordering
KeyId -> KeyId -> KeyId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyId -> KeyId -> KeyId
$cmin :: KeyId -> KeyId -> KeyId
max :: KeyId -> KeyId -> KeyId
$cmax :: KeyId -> KeyId -> KeyId
>= :: KeyId -> KeyId -> Bool
$c>= :: KeyId -> KeyId -> Bool
> :: KeyId -> KeyId -> Bool
$c> :: KeyId -> KeyId -> Bool
<= :: KeyId -> KeyId -> Bool
$c<= :: KeyId -> KeyId -> Bool
< :: KeyId -> KeyId -> Bool
$c< :: KeyId -> KeyId -> Bool
compare :: KeyId -> KeyId -> Ordering
$ccompare :: KeyId -> KeyId -> Ordering
Ord)

instance ToJSON KeyId
  where
    toJSON :: KeyId -> Value
toJSON (KeyId Text
t)    = forall a. ToJSON a => a -> Value
toJSON Text
t
    toJSON (UTCKeyId UTCTime
t) = forall a. ToJSON a => a -> Value
toJSON UTCTime
t

instance FromJSON KeyId
  where
    parseJSON :: Value -> Parser KeyId
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"KeyId" forall a b. (a -> b) -> a -> b
$ \Text
t -> do
        let asTime :: Result UTCTime
asTime = forall a. FromJSON a => Value -> Result a
fromJSON (Text -> Value
String Text
t) :: Result UTCTime
        case Result UTCTime
asTime of
            Success UTCTime
d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> KeyId
UTCKeyId UTCTime
d)
            Result UTCTime
_         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> KeyId
KeyId Text
t)

-- | Header content for a JWS.
data JwsHeader = JwsHeader {
    JwsHeader -> JwsAlg
jwsAlg :: JwsAlg
  , JwsHeader -> Maybe Text
jwsTyp :: Maybe Text
  , JwsHeader -> Maybe Text
jwsCty :: Maybe Text
  , JwsHeader -> Maybe KeyId
jwsKid :: Maybe KeyId
  } deriving (JwsHeader -> JwsHeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JwsHeader -> JwsHeader -> Bool
$c/= :: JwsHeader -> JwsHeader -> Bool
== :: JwsHeader -> JwsHeader -> Bool
$c== :: JwsHeader -> JwsHeader -> Bool
Eq, Int -> JwsHeader -> ShowS
[JwsHeader] -> ShowS
JwsHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwsHeader] -> ShowS
$cshowList :: [JwsHeader] -> ShowS
show :: JwsHeader -> String
$cshow :: JwsHeader -> String
showsPrec :: Int -> JwsHeader -> ShowS
$cshowsPrec :: Int -> JwsHeader -> ShowS
Show, forall x. Rep JwsHeader x -> JwsHeader
forall x. JwsHeader -> Rep JwsHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JwsHeader x -> JwsHeader
$cfrom :: forall x. JwsHeader -> Rep JwsHeader x
Generic)

-- | Header content for a JWE.
data JweHeader = JweHeader {
    JweHeader -> JweAlg
jweAlg :: JweAlg
  , JweHeader -> Enc
jweEnc :: Enc
  , JweHeader -> Maybe Text
jweTyp :: Maybe Text
  , JweHeader -> Maybe Text
jweCty :: Maybe Text
  , JweHeader -> Maybe Text
jweZip :: Maybe Text
  , JweHeader -> Maybe KeyId
jweKid :: Maybe KeyId
  } deriving (JweHeader -> JweHeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JweHeader -> JweHeader -> Bool
$c/= :: JweHeader -> JweHeader -> Bool
== :: JweHeader -> JweHeader -> Bool
$c== :: JweHeader -> JweHeader -> Bool
Eq, Int -> JweHeader -> ShowS
[JweHeader] -> ShowS
JweHeader -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JweHeader] -> ShowS
$cshowList :: [JweHeader] -> ShowS
show :: JweHeader -> String
$cshow :: JweHeader -> String
showsPrec :: Int -> JweHeader -> ShowS
$cshowsPrec :: Int -> JweHeader -> ShowS
Show, forall x. Rep JweHeader x -> JweHeader
forall x. JweHeader -> Rep JweHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JweHeader x -> JweHeader
$cfrom :: forall x. JweHeader -> Rep JweHeader x
Generic)

newtype IntDate = IntDate POSIXTime deriving (Int -> IntDate -> ShowS
[IntDate] -> ShowS
IntDate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntDate] -> ShowS
$cshowList :: [IntDate] -> ShowS
show :: IntDate -> String
$cshow :: IntDate -> String
showsPrec :: Int -> IntDate -> ShowS
$cshowsPrec :: Int -> IntDate -> ShowS
Show, IntDate -> IntDate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntDate -> IntDate -> Bool
$c/= :: IntDate -> IntDate -> Bool
== :: IntDate -> IntDate -> Bool
$c== :: IntDate -> IntDate -> Bool
Eq, Eq IntDate
IntDate -> IntDate -> Bool
IntDate -> IntDate -> Ordering
IntDate -> IntDate -> IntDate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IntDate -> IntDate -> IntDate
$cmin :: IntDate -> IntDate -> IntDate
max :: IntDate -> IntDate -> IntDate
$cmax :: IntDate -> IntDate -> IntDate
>= :: IntDate -> IntDate -> Bool
$c>= :: IntDate -> IntDate -> Bool
> :: IntDate -> IntDate -> Bool
$c> :: IntDate -> IntDate -> Bool
<= :: IntDate -> IntDate -> Bool
$c<= :: IntDate -> IntDate -> Bool
< :: IntDate -> IntDate -> Bool
$c< :: IntDate -> IntDate -> Bool
compare :: IntDate -> IntDate -> Ordering
$ccompare :: IntDate -> IntDate -> Ordering
Ord, Integer -> IntDate
IntDate -> IntDate
IntDate -> IntDate -> IntDate
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> IntDate
$cfromInteger :: Integer -> IntDate
signum :: IntDate -> IntDate
$csignum :: IntDate -> IntDate
abs :: IntDate -> IntDate
$cabs :: IntDate -> IntDate
negate :: IntDate -> IntDate
$cnegate :: IntDate -> IntDate
* :: IntDate -> IntDate -> IntDate
$c* :: IntDate -> IntDate -> IntDate
- :: IntDate -> IntDate -> IntDate
$c- :: IntDate -> IntDate -> IntDate
+ :: IntDate -> IntDate -> IntDate
$c+ :: IntDate -> IntDate -> IntDate
Num)

instance FromJSON IntDate where
    parseJSON :: Value -> Parser IntDate
parseJSON = forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"IntDate" forall a b. (a -> b) -> a -> b
$ \Scientific
n ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> IntDate
IntDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n :: Int64)

instance ToJSON IntDate where
    toJSON :: IntDate -> Value
toJSON (IntDate POSIXTime
t) = Scientific -> Value
Number forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
round POSIXTime
t :: Int64)

-- | Registered claims defined in section 4 of the JWT spec.
data JwtClaims = JwtClaims
    { JwtClaims -> Maybe Text
jwtIss :: !(Maybe Text)
    , JwtClaims -> Maybe Text
jwtSub :: !(Maybe Text)
    , JwtClaims -> Maybe [Text]
jwtAud :: !(Maybe [Text])
    , JwtClaims -> Maybe IntDate
jwtExp :: !(Maybe IntDate)
    , JwtClaims -> Maybe IntDate
jwtNbf :: !(Maybe IntDate)
    , JwtClaims -> Maybe IntDate
jwtIat :: !(Maybe IntDate)
    , JwtClaims -> Maybe Text
jwtJti :: !(Maybe Text)
    } deriving (Int -> JwtClaims -> ShowS
[JwtClaims] -> ShowS
JwtClaims -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwtClaims] -> ShowS
$cshowList :: [JwtClaims] -> ShowS
show :: JwtClaims -> String
$cshow :: JwtClaims -> String
showsPrec :: Int -> JwtClaims -> ShowS
$cshowsPrec :: Int -> JwtClaims -> ShowS
Show, forall x. Rep JwtClaims x -> JwtClaims
forall x. JwtClaims -> Rep JwtClaims x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JwtClaims x -> JwtClaims
$cfrom :: forall x. JwtClaims -> Rep JwtClaims x
Generic)

-- Deal with the case where "aud" may be a single value rather than an array
instance FromJSON JwtClaims where
#if MIN_VERSION_aeson(2,0,0)
    parseJSON :: Value -> Parser JwtClaims
parseJSON v :: Value
v@(Object Object
o) = case forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"aud" Object
o of
        Just (a :: Value
a@(String Text
_)) -> forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
claimsOptions forall a b. (a -> b) -> a -> b
$ Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
"aud" (Array -> Value
Array forall a b. (a -> b) -> a -> b
$ forall a. a -> Vector a
Data.Vector.singleton Value
a) Object
o
#else
    parseJSON v@(Object o) = case H.lookup "aud" o of
        Just (a@(String _)) -> genericParseJSON claimsOptions $ Object $ H.insert "aud" (Array $ singleton a) o
#endif
        Maybe Value
_                   -> forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
claimsOptions Value
v
    parseJSON Value
_            = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"JwtClaims must be an object"

instance ToJSON JwtClaims where
    toJSON :: JwtClaims -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
claimsOptions

instance ToJSON Jwt where
    toJSON :: Jwt -> Value
toJSON (Jwt ByteString
bytes) = Text -> Value
String (ByteString -> Text
TE.decodeUtf8 ByteString
bytes)

instance FromJSON Jwt where
    parseJSON :: Value -> Parser Jwt
parseJSON (String Text
token) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Jwt
Jwt (Text -> ByteString
TE.encodeUtf8 Text
token)
    parseJSON Value
_              = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Jwt must be a string"

claimsOptions :: Options
claimsOptions :: Options
claimsOptions = String -> Options
prefixOptions String
"jwt"

defJwsHdr :: JwsHeader
defJwsHdr :: JwsHeader
defJwsHdr = JwsAlg -> Maybe Text -> Maybe Text -> Maybe KeyId -> JwsHeader
JwsHeader JwsAlg
RS256 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defJweHdr :: JweHeader
defJweHdr :: JweHeader
defJweHdr = JweAlg
-> Enc
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe KeyId
-> JweHeader
JweHeader JweAlg
RSA_OAEP Enc
A128GCM forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Decoding errors.
data JwtError = KeyError Text      -- ^ No suitable key or wrong key type
              | BadAlgorithm Text  -- ^ The supplied algorithm is invalid
              | BadDots Int        -- ^ Wrong number of "." characters in the JWT
              | BadHeader Text     -- ^ Header couldn't be decoded or contains bad data
              | BadClaims          -- ^ Claims part couldn't be decoded or contains bad data
              | BadSignature       -- ^ Signature is invalid
              | BadCrypto          -- ^ A cryptographic operation failed
              | Base64Error String -- ^ A base64 decoding error
                deriving (JwtError -> JwtError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JwtError -> JwtError -> Bool
$c/= :: JwtError -> JwtError -> Bool
== :: JwtError -> JwtError -> Bool
$c== :: JwtError -> JwtError -> Bool
Eq, Int -> JwtError -> ShowS
[JwtError] -> ShowS
JwtError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JwtError] -> ShowS
$cshowList :: [JwtError] -> ShowS
show :: JwtError -> String
$cshow :: JwtError -> String
showsPrec :: Int -> JwtError -> ShowS
$cshowsPrec :: Int -> JwtError -> ShowS
Show)

instance ToJSON JwsHeader where
    toJSON :: JwsHeader -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jwsOptions

instance FromJSON JwsHeader where
    parseJSON :: Value -> Parser JwsHeader
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jwsOptions

instance ToJSON JweHeader where
    toJSON :: JweHeader -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jweOptions

instance FromJSON JweHeader where
    parseJSON :: Value -> Parser JweHeader
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jweOptions

instance FromJSON JwtHeader where
#if MIN_VERSION_aeson(2,0,0)
    parseJSON :: Value -> Parser JwtHeader
parseJSON v :: Value
v@(Object Object
o) = case forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"alg" Object
o of
        Just (String Text
"none") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure JwtHeader
UnsecuredH
        Maybe Value
_                    -> case forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"enc" Object
o of
#else
    parseJSON v@(Object o) = case H.lookup "alg" o of
        Just (String "none") -> pure UnsecuredH
        _                    -> case H.lookup "enc" o of
#endif
            Maybe Value
Nothing -> JwsHeader -> JwtHeader
JwsH forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
            Maybe Value
_       -> JweHeader -> JwtHeader
JweH forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    parseJSON Value
_            = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"JwtHeader must be an object"

encodeHeader :: ToJSON a => a -> ByteString
encodeHeader :: forall a. ToJSON a => a -> ByteString
encodeHeader a
h = ByteString -> ByteString
BL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode a
h

parseHeader :: ByteString -> Either JwtError JwtHeader
parseHeader :: ByteString -> Either JwtError JwtHeader
parseHeader ByteString
hdr = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> JwtError
BadHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
hdr

jwsOptions :: Options
jwsOptions :: Options
jwsOptions = String -> Options
prefixOptions String
"jws"

jweOptions :: Options
jweOptions :: Options
jweOptions = String -> Options
prefixOptions String
"jwe"

prefixOptions :: String -> Options
prefixOptions :: String -> Options
prefixOptions String
prefix = Options
omitNothingOptions
    { fieldLabelModifier :: ShowS
fieldLabelModifier     = Int -> ShowS
dropPrefix forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix
    , constructorTagModifier :: ShowS
constructorTagModifier = String -> ShowS
addPrefix String
prefix
    }
  where
    omitNothingOptions :: Options
omitNothingOptions = Options
defaultOptions { omitNothingFields :: Bool
omitNothingFields = Bool
True }
    dropPrefix :: Int -> ShowS
dropPrefix Int
l String
s = let remainder :: String
remainder = forall a. Int -> [a] -> [a]
drop Int
l String
s
                     in  (Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) String
remainder forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail String
remainder

    addPrefix :: String -> ShowS
addPrefix String
p String
s  = String
p forall a. [a] -> [a] -> [a]
++ Char -> Char
toUpper (forall a. [a] -> a
head String
s) forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail String
s