{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module Web.JWT
(
decode
, verify
, decodeAndVerifySignature
, encodeSigned
, encodeUnsigned
, tokenIssuer
, hmacSecret
, readRsaSecret
, claims
, header
, signature
, auds
, intDate
, numericDate
, stringOrURI
, stringOrURIToText
, secondsSinceEpoch
, UnverifiedJWT
, VerifiedJWT
, Signature
, Signer(..)
, JWT
, Algorithm(..)
, JWTClaimsSet(..)
, ClaimsMap(..)
, IntDate
, NumericDate
, StringOrURI
, JWTHeader
, JOSEHeader(..)
, rsaKeySecret
) where
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict)
import qualified Data.ByteString.Extended as BS
import qualified Data.Text.Extended as T
import qualified Data.Text.Encoding as TE
import Control.Applicative
import Control.Monad
import Crypto.Hash.Algorithms
import Crypto.MAC.HMAC
import Crypto.PubKey.RSA (PrivateKey)
import Crypto.PubKey.RSA.PKCS15 (sign)
import Data.ByteArray.Encoding
import Data.Aeson hiding (decode, encode)
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as StrictMap
import qualified Data.Map as Map
import Data.Maybe
import Data.Scientific
import qualified Data.Semigroup as Semigroup
import Data.Time.Clock (NominalDiffTime)
import Data.X509 (PrivKey (PrivKeyRSA))
import Data.X509.Memory (readKeyFileFromMemory)
import qualified Network.URI as URI
import Prelude hiding (exp)
{-# DEPRECATED JWTHeader "Use JOSEHeader instead. JWTHeader will be removed in 1.0" #-}
type = JOSEHeader
data Signer = HMACSecret BS.ByteString
| RSAPrivateKey PrivateKey
newtype Signature = Signature T.Text deriving (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show)
instance Eq Signature where
(Signature s1 :: Text
s1) == :: Signature -> Signature -> Bool
== (Signature s2 :: Text
s2) = Text
s1 Text -> Text -> Bool
`T.constTimeCompare` Text
s2
data UnverifiedJWT
data VerifiedJWT
data JWT r where
Unverified :: JWTHeader -> JWTClaimsSet -> Signature -> T.Text -> JWT UnverifiedJWT
Verified :: JWTHeader -> JWTClaimsSet -> Signature -> JWT VerifiedJWT
deriving instance Show (JWT r)
claims :: JWT r -> JWTClaimsSet
claims :: JWT r -> JWTClaimsSet
claims (Unverified _ c :: JWTClaimsSet
c _ _) = JWTClaimsSet
c
claims (Verified _ c :: JWTClaimsSet
c _) = JWTClaimsSet
c
header :: JWT r -> JOSEHeader
(Unverified h :: JOSEHeader
h _ _ _) = JOSEHeader
h
header (Verified h :: JOSEHeader
h _ _) = JOSEHeader
h
signature :: JWT r -> Maybe Signature
signature :: JWT r -> Maybe Signature
signature Unverified{} = Maybe Signature
forall a. Maybe a
Nothing
signature (Verified _ _ s :: Signature
s) = Signature -> Maybe Signature
forall a. a -> Maybe a
Just Signature
s
{-# DEPRECATED IntDate "Use NumericDate instead. IntDate will be removed in 1.0" #-}
type IntDate = NumericDate
newtype NumericDate = NumericDate Integer deriving (Int -> NumericDate -> ShowS
[NumericDate] -> ShowS
NumericDate -> String
(Int -> NumericDate -> ShowS)
-> (NumericDate -> String)
-> ([NumericDate] -> ShowS)
-> Show NumericDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumericDate] -> ShowS
$cshowList :: [NumericDate] -> ShowS
show :: NumericDate -> String
$cshow :: NumericDate -> String
showsPrec :: Int -> NumericDate -> ShowS
$cshowsPrec :: Int -> NumericDate -> ShowS
Show, NumericDate -> NumericDate -> Bool
(NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool) -> Eq NumericDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumericDate -> NumericDate -> Bool
$c/= :: NumericDate -> NumericDate -> Bool
== :: NumericDate -> NumericDate -> Bool
$c== :: NumericDate -> NumericDate -> Bool
Eq, Eq NumericDate
Eq NumericDate =>
(NumericDate -> NumericDate -> Ordering)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> NumericDate)
-> (NumericDate -> NumericDate -> NumericDate)
-> Ord NumericDate
NumericDate -> NumericDate -> Bool
NumericDate -> NumericDate -> Ordering
NumericDate -> NumericDate -> NumericDate
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 :: NumericDate -> NumericDate -> NumericDate
$cmin :: NumericDate -> NumericDate -> NumericDate
max :: NumericDate -> NumericDate -> NumericDate
$cmax :: NumericDate -> NumericDate -> NumericDate
>= :: NumericDate -> NumericDate -> Bool
$c>= :: NumericDate -> NumericDate -> Bool
> :: NumericDate -> NumericDate -> Bool
$c> :: NumericDate -> NumericDate -> Bool
<= :: NumericDate -> NumericDate -> Bool
$c<= :: NumericDate -> NumericDate -> Bool
< :: NumericDate -> NumericDate -> Bool
$c< :: NumericDate -> NumericDate -> Bool
compare :: NumericDate -> NumericDate -> Ordering
$ccompare :: NumericDate -> NumericDate -> Ordering
$cp1Ord :: Eq NumericDate
Ord)
secondsSinceEpoch :: NumericDate -> NominalDiffTime
secondsSinceEpoch :: NumericDate -> NominalDiffTime
secondsSinceEpoch (NumericDate s :: Integer
s) = Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger Integer
s
data StringOrURI = S T.Text | U URI.URI deriving (StringOrURI -> StringOrURI -> Bool
(StringOrURI -> StringOrURI -> Bool)
-> (StringOrURI -> StringOrURI -> Bool) -> Eq StringOrURI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringOrURI -> StringOrURI -> Bool
$c/= :: StringOrURI -> StringOrURI -> Bool
== :: StringOrURI -> StringOrURI -> Bool
$c== :: StringOrURI -> StringOrURI -> Bool
Eq)
instance Show StringOrURI where
show :: StringOrURI -> String
show (S s :: Text
s) = Text -> String
T.unpack Text
s
show (U u :: URI
u) = URI -> String
forall a. Show a => a -> String
show URI
u
data Algorithm = HS256
| RS256
deriving (Algorithm -> Algorithm -> Bool
(Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Bool) -> Eq Algorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Algorithm -> Algorithm -> Bool
$c/= :: Algorithm -> Algorithm -> Bool
== :: Algorithm -> Algorithm -> Bool
$c== :: Algorithm -> Algorithm -> Bool
Eq, Int -> Algorithm -> ShowS
[Algorithm] -> ShowS
Algorithm -> String
(Int -> Algorithm -> ShowS)
-> (Algorithm -> String)
-> ([Algorithm] -> ShowS)
-> Show Algorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Algorithm] -> ShowS
$cshowList :: [Algorithm] -> ShowS
show :: Algorithm -> String
$cshow :: Algorithm -> String
showsPrec :: Int -> Algorithm -> ShowS
$cshowsPrec :: Int -> Algorithm -> ShowS
Show)
data = {
JOSEHeader -> Maybe Text
typ :: Maybe T.Text
, JOSEHeader -> Maybe Text
cty :: Maybe T.Text
, JOSEHeader -> Maybe Algorithm
alg :: Maybe Algorithm
, JOSEHeader -> Maybe Text
kid :: Maybe T.Text
} deriving (JOSEHeader -> JOSEHeader -> Bool
(JOSEHeader -> JOSEHeader -> Bool)
-> (JOSEHeader -> JOSEHeader -> Bool) -> Eq JOSEHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JOSEHeader -> JOSEHeader -> Bool
$c/= :: JOSEHeader -> JOSEHeader -> Bool
== :: JOSEHeader -> JOSEHeader -> Bool
$c== :: JOSEHeader -> JOSEHeader -> Bool
Eq, Int -> JOSEHeader -> ShowS
[JOSEHeader] -> ShowS
JOSEHeader -> String
(Int -> JOSEHeader -> ShowS)
-> (JOSEHeader -> String)
-> ([JOSEHeader] -> ShowS)
-> Show JOSEHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JOSEHeader] -> ShowS
$cshowList :: [JOSEHeader] -> ShowS
show :: JOSEHeader -> String
$cshow :: JOSEHeader -> String
showsPrec :: Int -> JOSEHeader -> ShowS
$cshowsPrec :: Int -> JOSEHeader -> ShowS
Show)
instance Monoid JOSEHeader where
mempty :: JOSEHeader
mempty =
Maybe Text
-> Maybe Text -> Maybe Algorithm -> Maybe Text -> JOSEHeader
JOSEHeader Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Algorithm
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
mappend :: JOSEHeader -> JOSEHeader -> JOSEHeader
mappend = JOSEHeader -> JOSEHeader -> JOSEHeader
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
instance Semigroup.Semigroup JOSEHeader where
JOSEHeader a :: Maybe Text
a b :: Maybe Text
b c :: Maybe Algorithm
c d :: Maybe Text
d <> :: JOSEHeader -> JOSEHeader -> JOSEHeader
<> JOSEHeader a' :: Maybe Text
a' b' :: Maybe Text
b' c' :: Maybe Algorithm
c' d' :: Maybe Text
d' =
Maybe Text
-> Maybe Text -> Maybe Algorithm -> Maybe Text -> JOSEHeader
JOSEHeader (Maybe Text
a Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
a') (Maybe Text
b Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
b') (Maybe Algorithm
c Maybe Algorithm -> Maybe Algorithm -> Maybe Algorithm
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Algorithm
c') (Maybe Text
d Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
d')
data JWTClaimsSet = JWTClaimsSet {
JWTClaimsSet -> Maybe StringOrURI
iss :: Maybe StringOrURI
, JWTClaimsSet -> Maybe StringOrURI
sub :: Maybe StringOrURI
, JWTClaimsSet -> Maybe (Either StringOrURI [StringOrURI])
aud :: Maybe (Either StringOrURI [StringOrURI])
, JWTClaimsSet -> Maybe NumericDate
exp :: Maybe IntDate
, JWTClaimsSet -> Maybe NumericDate
nbf :: Maybe IntDate
, JWTClaimsSet -> Maybe NumericDate
iat :: Maybe IntDate
, JWTClaimsSet -> Maybe StringOrURI
jti :: Maybe StringOrURI
, JWTClaimsSet -> ClaimsMap
unregisteredClaims :: ClaimsMap
} deriving (Int -> JWTClaimsSet -> ShowS
[JWTClaimsSet] -> ShowS
JWTClaimsSet -> String
(Int -> JWTClaimsSet -> ShowS)
-> (JWTClaimsSet -> String)
-> ([JWTClaimsSet] -> ShowS)
-> Show JWTClaimsSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JWTClaimsSet] -> ShowS
$cshowList :: [JWTClaimsSet] -> ShowS
show :: JWTClaimsSet -> String
$cshow :: JWTClaimsSet -> String
showsPrec :: Int -> JWTClaimsSet -> ShowS
$cshowsPrec :: Int -> JWTClaimsSet -> ShowS
Show, JWTClaimsSet -> JWTClaimsSet -> Bool
(JWTClaimsSet -> JWTClaimsSet -> Bool)
-> (JWTClaimsSet -> JWTClaimsSet -> Bool) -> Eq JWTClaimsSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JWTClaimsSet -> JWTClaimsSet -> Bool
$c/= :: JWTClaimsSet -> JWTClaimsSet -> Bool
== :: JWTClaimsSet -> JWTClaimsSet -> Bool
$c== :: JWTClaimsSet -> JWTClaimsSet -> Bool
Eq)
instance Monoid JWTClaimsSet where
mempty :: JWTClaimsSet
mempty =
Maybe StringOrURI
-> Maybe StringOrURI
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet
JWTClaimsSet Maybe StringOrURI
forall a. Maybe a
Nothing Maybe StringOrURI
forall a. Maybe a
Nothing Maybe (Either StringOrURI [StringOrURI])
forall a. Maybe a
Nothing Maybe NumericDate
forall a. Maybe a
Nothing Maybe NumericDate
forall a. Maybe a
Nothing Maybe NumericDate
forall a. Maybe a
Nothing Maybe StringOrURI
forall a. Maybe a
Nothing (ClaimsMap -> JWTClaimsSet) -> ClaimsMap -> JWTClaimsSet
forall a b. (a -> b) -> a -> b
$ Map Text Value -> ClaimsMap
ClaimsMap Map Text Value
forall k a. Map k a
Map.empty
mappend :: JWTClaimsSet -> JWTClaimsSet -> JWTClaimsSet
mappend = JWTClaimsSet -> JWTClaimsSet -> JWTClaimsSet
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
instance Semigroup.Semigroup JWTClaimsSet where
JWTClaimsSet a :: Maybe StringOrURI
a b :: Maybe StringOrURI
b c :: Maybe (Either StringOrURI [StringOrURI])
c d :: Maybe NumericDate
d e :: Maybe NumericDate
e f :: Maybe NumericDate
f g :: Maybe StringOrURI
g h :: ClaimsMap
h <> :: JWTClaimsSet -> JWTClaimsSet -> JWTClaimsSet
<> JWTClaimsSet a' :: Maybe StringOrURI
a' b' :: Maybe StringOrURI
b' c' :: Maybe (Either StringOrURI [StringOrURI])
c' d' :: Maybe NumericDate
d' e' :: Maybe NumericDate
e' f' :: Maybe NumericDate
f' g' :: Maybe StringOrURI
g' h' :: ClaimsMap
h' =
Maybe StringOrURI
-> Maybe StringOrURI
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet
JWTClaimsSet (Maybe StringOrURI
a Maybe StringOrURI -> Maybe StringOrURI -> Maybe StringOrURI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StringOrURI
a') (Maybe StringOrURI
b Maybe StringOrURI -> Maybe StringOrURI -> Maybe StringOrURI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StringOrURI
b') (Maybe (Either StringOrURI [StringOrURI])
c Maybe (Either StringOrURI [StringOrURI])
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe (Either StringOrURI [StringOrURI])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Either StringOrURI [StringOrURI])
c') (Maybe NumericDate
d Maybe NumericDate -> Maybe NumericDate -> Maybe NumericDate
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe NumericDate
d') (Maybe NumericDate
e Maybe NumericDate -> Maybe NumericDate -> Maybe NumericDate
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe NumericDate
e') (Maybe NumericDate
f Maybe NumericDate -> Maybe NumericDate -> Maybe NumericDate
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe NumericDate
f') (Maybe StringOrURI
g Maybe StringOrURI -> Maybe StringOrURI -> Maybe StringOrURI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StringOrURI
g') (ClaimsMap
h ClaimsMap -> ClaimsMap -> ClaimsMap
forall a. Semigroup a => a -> a -> a
Semigroup.<> ClaimsMap
h')
encodeSigned :: Signer -> JOSEHeader -> JWTClaimsSet -> T.Text
encodeSigned :: Signer -> JOSEHeader -> JWTClaimsSet -> Text
encodeSigned signer :: Signer
signer header' :: JOSEHeader
header' claims' :: JWTClaimsSet
claims' = [Text] -> Text
dotted [Text
header'', Text
claim, Text
signature']
where claim :: Text
claim = JWTClaimsSet -> Text
forall a. ToJSON a => a -> Text
encodeJWT JWTClaimsSet
claims'
algo :: Algorithm
algo = case Signer
signer of
HMACSecret _ -> Algorithm
HS256
RSAPrivateKey _ -> Algorithm
RS256
header'' :: Text
header'' = JOSEHeader -> Text
forall a. ToJSON a => a -> Text
encodeJWT JOSEHeader
header' {
typ :: Maybe Text
typ = Text -> Maybe Text
forall a. a -> Maybe a
Just "JWT"
, alg :: Maybe Algorithm
alg = Algorithm -> Maybe Algorithm
forall a. a -> Maybe a
Just Algorithm
algo
}
signature' :: Text
signature' = Signer -> Text -> Text
calculateDigest Signer
signer ([Text] -> Text
dotted [Text
header'', Text
claim])
encodeUnsigned :: JWTClaimsSet -> JOSEHeader -> T.Text
encodeUnsigned :: JWTClaimsSet -> JOSEHeader -> Text
encodeUnsigned claims' :: JWTClaimsSet
claims' header' :: JOSEHeader
header' = [Text] -> Text
dotted [Text
header'', Text
claim, ""]
where claim :: Text
claim = JWTClaimsSet -> Text
forall a. ToJSON a => a -> Text
encodeJWT JWTClaimsSet
claims'
header'' :: Text
header'' = JOSEHeader -> Text
forall a. ToJSON a => a -> Text
encodeJWT JOSEHeader
header' {
typ :: Maybe Text
typ = Text -> Maybe Text
forall a. a -> Maybe a
Just "JWT"
, alg :: Maybe Algorithm
alg = Algorithm -> Maybe Algorithm
forall a. a -> Maybe a
Just Algorithm
HS256
}
decode :: T.Text -> Maybe (JWT UnverifiedJWT)
decode :: Text -> Maybe (JWT UnverifiedJWT)
decode input :: Text
input = do
(h :: Text
h,c :: Text
c,s :: Text
s) <- [Text] -> Maybe (Text, Text, Text)
forall c. [c] -> Maybe (c, c, c)
extractElems ([Text] -> Maybe (Text, Text, Text))
-> [Text] -> Maybe (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn "." Text
input
let header' :: Maybe JOSEHeader
header' = Text -> Maybe JOSEHeader
forall a. FromJSON a => Text -> Maybe a
parseJWT Text
h
claims' :: Maybe JWTClaimsSet
claims' = Text -> Maybe JWTClaimsSet
forall a. FromJSON a => Text -> Maybe a
parseJWT Text
c
JOSEHeader
-> JWTClaimsSet -> Signature -> Text -> JWT UnverifiedJWT
Unverified (JOSEHeader
-> JWTClaimsSet -> Signature -> Text -> JWT UnverifiedJWT)
-> Maybe JOSEHeader
-> Maybe (JWTClaimsSet -> Signature -> Text -> JWT UnverifiedJWT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe JOSEHeader
header' Maybe (JWTClaimsSet -> Signature -> Text -> JWT UnverifiedJWT)
-> Maybe JWTClaimsSet
-> Maybe (Signature -> Text -> JWT UnverifiedJWT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe JWTClaimsSet
claims' Maybe (Signature -> Text -> JWT UnverifiedJWT)
-> Maybe Signature -> Maybe (Text -> JWT UnverifiedJWT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Signature -> Maybe Signature
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> Maybe Signature)
-> (Text -> Signature) -> Text -> Maybe Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Signature
Signature (Text -> Maybe Signature) -> Text -> Maybe Signature
forall a b. (a -> b) -> a -> b
$ Text
s) Maybe (Text -> JWT UnverifiedJWT)
-> Maybe Text -> Maybe (JWT UnverifiedJWT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
dotted ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text
h,Text
c])
where
extractElems :: [c] -> Maybe (c, c, c)
extractElems (h :: c
h:c :: c
c:s :: c
s:_) = (c, c, c) -> Maybe (c, c, c)
forall a. a -> Maybe a
Just (c
h,c
c,c
s)
extractElems _ = Maybe (c, c, c)
forall a. Maybe a
Nothing
verify :: Signer -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT)
verify :: Signer -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT)
verify signer :: Signer
signer (Unverified header' :: JOSEHeader
header' claims' :: JWTClaimsSet
claims' unverifiedSignature :: Signature
unverifiedSignature originalClaim :: Text
originalClaim) = do
let calculatedSignature :: Signature
calculatedSignature = Text -> Signature
Signature (Text -> Signature) -> Text -> Signature
forall a b. (a -> b) -> a -> b
$ Signer -> Text -> Text
calculateDigest Signer
signer Text
originalClaim
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Signature
unverifiedSignature Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== Signature
calculatedSignature)
JWT VerifiedJWT -> Maybe (JWT VerifiedJWT)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWT VerifiedJWT -> Maybe (JWT VerifiedJWT))
-> JWT VerifiedJWT -> Maybe (JWT VerifiedJWT)
forall a b. (a -> b) -> a -> b
$ JOSEHeader -> JWTClaimsSet -> Signature -> JWT VerifiedJWT
Verified JOSEHeader
header' JWTClaimsSet
claims' Signature
calculatedSignature
decodeAndVerifySignature :: Signer -> T.Text -> Maybe (JWT VerifiedJWT)
decodeAndVerifySignature :: Signer -> Text -> Maybe (JWT VerifiedJWT)
decodeAndVerifySignature signer :: Signer
signer input :: Text
input = Signer -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT)
verify Signer
signer (JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT))
-> Maybe (JWT UnverifiedJWT) -> Maybe (JWT VerifiedJWT)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe (JWT UnverifiedJWT)
decode Text
input
tokenIssuer :: T.Text -> Maybe StringOrURI
tokenIssuer :: Text -> Maybe StringOrURI
tokenIssuer = Text -> Maybe (JWT UnverifiedJWT)
decode (Text -> Maybe (JWT UnverifiedJWT))
-> (JWT UnverifiedJWT -> Maybe StringOrURI)
-> Text
-> Maybe StringOrURI
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (JWTClaimsSet -> Maybe JWTClaimsSet)
-> (JWT UnverifiedJWT -> JWTClaimsSet)
-> JWT UnverifiedJWT
-> Maybe JWTClaimsSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JWTClaimsSet -> Maybe JWTClaimsSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure JWT UnverifiedJWT -> JWTClaimsSet
forall r. JWT r -> JWTClaimsSet
claims (JWT UnverifiedJWT -> Maybe JWTClaimsSet)
-> (JWTClaimsSet -> Maybe StringOrURI)
-> JWT UnverifiedJWT
-> Maybe StringOrURI
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> JWTClaimsSet -> Maybe StringOrURI
iss
hmacSecret :: T.Text -> Signer
hmacSecret :: Text -> Signer
hmacSecret = ByteString -> Signer
HMACSecret (ByteString -> Signer) -> (Text -> ByteString) -> Text -> Signer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
rsaKeySecret :: String -> IO (Maybe Signer)
rsaKeySecret :: String -> IO (Maybe Signer)
rsaKeySecret = Maybe Signer -> IO (Maybe Signer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Signer -> IO (Maybe Signer))
-> (String -> Maybe Signer) -> String -> IO (Maybe Signer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivateKey -> Signer) -> Maybe PrivateKey -> Maybe Signer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrivateKey -> Signer
RSAPrivateKey (Maybe PrivateKey -> Maybe Signer)
-> (String -> Maybe PrivateKey) -> String -> Maybe Signer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe PrivateKey
readRsaSecret (ByteString -> Maybe PrivateKey)
-> (String -> ByteString) -> String -> Maybe PrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack
readRsaSecret :: BS.ByteString -> Maybe PrivateKey
readRsaSecret :: ByteString -> Maybe PrivateKey
readRsaSecret bs :: ByteString
bs =
case ByteString -> [PrivKey]
readKeyFileFromMemory ByteString
bs of
[(PrivKeyRSA k :: PrivateKey
k)] -> PrivateKey -> Maybe PrivateKey
forall a. a -> Maybe a
Just PrivateKey
k
_ -> Maybe PrivateKey
forall a. Maybe a
Nothing
{-# DEPRECATED intDate "Use numericDate instead. intDate will be removed in 1.0" #-}
intDate :: NominalDiffTime -> Maybe IntDate
intDate :: NominalDiffTime -> Maybe NumericDate
intDate = NominalDiffTime -> Maybe NumericDate
numericDate
numericDate :: NominalDiffTime -> Maybe NumericDate
numericDate :: NominalDiffTime -> Maybe NumericDate
numericDate i :: NominalDiffTime
i | NominalDiffTime
i NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Maybe NumericDate
forall a. Maybe a
Nothing
numericDate i :: NominalDiffTime
i = NumericDate -> Maybe NumericDate
forall a. a -> Maybe a
Just (NumericDate -> Maybe NumericDate)
-> NumericDate -> Maybe NumericDate
forall a b. (a -> b) -> a -> b
$ Integer -> NumericDate
NumericDate (Integer -> NumericDate) -> Integer -> NumericDate
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
i
stringOrURI :: T.Text -> Maybe StringOrURI
stringOrURI :: Text -> Maybe StringOrURI
stringOrURI t :: Text
t | String -> Bool
URI.isURI (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t = URI -> StringOrURI
U (URI -> StringOrURI) -> Maybe URI -> Maybe StringOrURI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe URI
URI.parseURI (Text -> String
T.unpack Text
t)
stringOrURI t :: Text
t = StringOrURI -> Maybe StringOrURI
forall a. a -> Maybe a
Just (Text -> StringOrURI
S Text
t)
stringOrURIToText :: StringOrURI -> T.Text
stringOrURIToText :: StringOrURI -> Text
stringOrURIToText (S t :: Text
t) = Text
t
stringOrURIToText (U uri :: URI
uri) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
URI.uriToString ShowS
forall a. a -> a
id URI
uri (""::String)
auds :: JWTClaimsSet -> [StringOrURI]
auds :: JWTClaimsSet -> [StringOrURI]
auds jwt :: JWTClaimsSet
jwt = case JWTClaimsSet -> Maybe (Either StringOrURI [StringOrURI])
aud JWTClaimsSet
jwt of
Nothing -> []
Just (Left a :: StringOrURI
a) -> [StringOrURI
a]
Just (Right as :: [StringOrURI]
as) -> [StringOrURI]
as
encodeJWT :: ToJSON a => a -> T.Text
encodeJWT :: a -> Text
encodeJWT = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64URLUnpadded (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode
parseJWT :: FromJSON a => T.Text -> Maybe a
parseJWT :: Text -> Maybe a
parseJWT x :: Text
x = case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64URLUnpadded (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
x of
Left _ -> Maybe a
forall a. Maybe a
Nothing
Right s :: ByteString
s -> ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
JSON.decode (ByteString -> Maybe a) -> ByteString -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
s
dotted :: [T.Text] -> T.Text
dotted :: [Text] -> Text
dotted = Text -> [Text] -> Text
T.intercalate "."
calculateDigest :: Signer -> T.Text -> T.Text
calculateDigest :: Signer -> Text -> Text
calculateDigest (HMACSecret key :: ByteString
key) msg :: Text
msg =
ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Base -> HMAC SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64URLUnpadded (ByteString -> ByteString -> HMAC SHA256
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
key (Text -> ByteString
TE.encodeUtf8 Text
msg) :: HMAC SHA256)
calculateDigest (RSAPrivateKey key :: PrivateKey
key) msg :: Text
msg = ByteString -> Text
TE.decodeUtf8
(ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64URLUnpadded
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sign'
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
msg
where
sign' :: BS.ByteString -> BS.ByteString
sign' :: ByteString -> ByteString
sign' bs :: ByteString
bs = case Maybe Blinder
-> Maybe SHA256
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
sign Maybe Blinder
forall a. Maybe a
Nothing (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
SHA256) PrivateKey
key ByteString
bs of
Right sig :: ByteString
sig -> ByteString
sig
Left _ -> String -> ByteString
forall a. HasCallStack => String -> a
error "impossible"
newtype ClaimsMap = ClaimsMap { ClaimsMap -> Map Text Value
unClaimsMap :: Map.Map T.Text Value }
deriving (ClaimsMap -> ClaimsMap -> Bool
(ClaimsMap -> ClaimsMap -> Bool)
-> (ClaimsMap -> ClaimsMap -> Bool) -> Eq ClaimsMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClaimsMap -> ClaimsMap -> Bool
$c/= :: ClaimsMap -> ClaimsMap -> Bool
== :: ClaimsMap -> ClaimsMap -> Bool
$c== :: ClaimsMap -> ClaimsMap -> Bool
Eq, Int -> ClaimsMap -> ShowS
[ClaimsMap] -> ShowS
ClaimsMap -> String
(Int -> ClaimsMap -> ShowS)
-> (ClaimsMap -> String)
-> ([ClaimsMap] -> ShowS)
-> Show ClaimsMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClaimsMap] -> ShowS
$cshowList :: [ClaimsMap] -> ShowS
show :: ClaimsMap -> String
$cshow :: ClaimsMap -> String
showsPrec :: Int -> ClaimsMap -> ShowS
$cshowsPrec :: Int -> ClaimsMap -> ShowS
Show)
instance Monoid ClaimsMap where
mempty :: ClaimsMap
mempty =
Map Text Value -> ClaimsMap
ClaimsMap Map Text Value
forall a. Monoid a => a
mempty
mappend :: ClaimsMap -> ClaimsMap -> ClaimsMap
mappend = ClaimsMap -> ClaimsMap -> ClaimsMap
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
instance Semigroup.Semigroup ClaimsMap where
ClaimsMap a :: Map Text Value
a <> :: ClaimsMap -> ClaimsMap -> ClaimsMap
<> ClaimsMap b :: Map Text Value
b =
Map Text Value -> ClaimsMap
ClaimsMap (Map Text Value -> ClaimsMap) -> Map Text Value -> ClaimsMap
forall a b. (a -> b) -> a -> b
$ Map Text Value
a Map Text Value -> Map Text Value -> Map Text Value
forall a. Semigroup a => a -> a -> a
Semigroup.<> Map Text Value
b
fromHashMap :: Object -> ClaimsMap
fromHashMap :: Object -> ClaimsMap
fromHashMap = Map Text Value -> ClaimsMap
ClaimsMap (Map Text Value -> ClaimsMap)
-> (Object -> Map Text Value) -> Object -> ClaimsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Value)] -> Map Text Value)
-> (Object -> [(Text, Value)]) -> Object -> Map Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
StrictMap.toList
removeRegisteredClaims :: ClaimsMap -> ClaimsMap
removeRegisteredClaims :: ClaimsMap -> ClaimsMap
removeRegisteredClaims (ClaimsMap input :: Map Text Value
input) = Map Text Value -> ClaimsMap
ClaimsMap (Map Text Value -> ClaimsMap) -> Map Text Value -> ClaimsMap
forall a b. (a -> b) -> a -> b
$ (Text -> Value -> Value -> Maybe Value)
-> Map Text Value -> Map Text Value -> Map Text Value
forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWithKey (\_ _ _ -> Maybe Value
forall a. Maybe a
Nothing) Map Text Value
input Map Text Value
registeredClaims
where
registeredClaims :: Map Text Value
registeredClaims = [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Value)] -> Map Text Value)
-> [(Text, Value)] -> Map Text Value
forall a b. (a -> b) -> a -> b
$ (Text -> (Text, Value)) -> [Text] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\e :: Text
e -> (Text
e, Value
Null)) ["iss", "sub", "aud", "exp", "nbf", "iat", "jti"]
instance ToJSON JWTClaimsSet where
toJSON :: JWTClaimsSet -> Value
toJSON JWTClaimsSet{..} = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, Value)] -> [(Text, Value)]
forall a. [Maybe a] -> [a]
catMaybes [
(StringOrURI -> (Text, Value))
-> Maybe StringOrURI -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("iss" Text -> StringOrURI -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe StringOrURI
iss
, (StringOrURI -> (Text, Value))
-> Maybe StringOrURI -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("sub" Text -> StringOrURI -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe StringOrURI
sub
, (StringOrURI -> (Text, Value))
-> ([StringOrURI] -> (Text, Value))
-> Either StringOrURI [StringOrURI]
-> (Text, Value)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ("aud" Text -> StringOrURI -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) ("aud" Text -> [StringOrURI] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Either StringOrURI [StringOrURI] -> (Text, Value))
-> Maybe (Either StringOrURI [StringOrURI]) -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Either StringOrURI [StringOrURI])
aud
, (NumericDate -> (Text, Value))
-> Maybe NumericDate -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("exp" Text -> NumericDate -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe NumericDate
exp
, (NumericDate -> (Text, Value))
-> Maybe NumericDate -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("nbf" Text -> NumericDate -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe NumericDate
nbf
, (NumericDate -> (Text, Value))
-> Maybe NumericDate -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("iat" Text -> NumericDate -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe NumericDate
iat
, (StringOrURI -> (Text, Value))
-> Maybe StringOrURI -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("jti" Text -> StringOrURI -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe StringOrURI
jti
] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList (ClaimsMap -> Map Text Value
unClaimsMap (ClaimsMap -> Map Text Value) -> ClaimsMap -> Map Text Value
forall a b. (a -> b) -> a -> b
$ ClaimsMap -> ClaimsMap
removeRegisteredClaims ClaimsMap
unregisteredClaims)
instance FromJSON JWTClaimsSet where
parseJSON :: Value -> Parser JWTClaimsSet
parseJSON = String
-> (Object -> Parser JWTClaimsSet) -> Value -> Parser JWTClaimsSet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "JWTClaimsSet"
(\o :: Object
o -> Maybe StringOrURI
-> Maybe StringOrURI
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet
JWTClaimsSet
(Maybe StringOrURI
-> Maybe StringOrURI
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
-> Parser (Maybe StringOrURI)
-> Parser
(Maybe StringOrURI
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe StringOrURI)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "iss"
Parser
(Maybe StringOrURI
-> Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
-> Parser (Maybe StringOrURI)
-> Parser
(Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe StringOrURI)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "sub"
Parser
(Maybe (Either StringOrURI [StringOrURI])
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
-> Parser (Maybe (Either StringOrURI [StringOrURI]))
-> Parser
(Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
StrictMap.lookup "aud" Object
o of
(Just as :: Value
as@(JSON.Array _)) -> Either StringOrURI [StringOrURI]
-> Maybe (Either StringOrURI [StringOrURI])
forall a. a -> Maybe a
Just (Either StringOrURI [StringOrURI]
-> Maybe (Either StringOrURI [StringOrURI]))
-> ([StringOrURI] -> Either StringOrURI [StringOrURI])
-> [StringOrURI]
-> Maybe (Either StringOrURI [StringOrURI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StringOrURI] -> Either StringOrURI [StringOrURI]
forall a b. b -> Either a b
Right ([StringOrURI] -> Maybe (Either StringOrURI [StringOrURI]))
-> Parser [StringOrURI]
-> Parser (Maybe (Either StringOrURI [StringOrURI]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [StringOrURI]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
as
(Just (JSON.String t :: Text
t)) -> Maybe (Either StringOrURI [StringOrURI])
-> Parser (Maybe (Either StringOrURI [StringOrURI]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either StringOrURI [StringOrURI])
-> Parser (Maybe (Either StringOrURI [StringOrURI])))
-> Maybe (Either StringOrURI [StringOrURI])
-> Parser (Maybe (Either StringOrURI [StringOrURI]))
forall a b. (a -> b) -> a -> b
$ StringOrURI -> Either StringOrURI [StringOrURI]
forall a b. a -> Either a b
Left (StringOrURI -> Either StringOrURI [StringOrURI])
-> Maybe StringOrURI -> Maybe (Either StringOrURI [StringOrURI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe StringOrURI
stringOrURI Text
t
_ -> Maybe (Either StringOrURI [StringOrURI])
-> Parser (Maybe (Either StringOrURI [StringOrURI]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either StringOrURI [StringOrURI])
forall a. Maybe a
Nothing
Parser
(Maybe NumericDate
-> Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
-> Parser (Maybe NumericDate)
-> Parser
(Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe NumericDate)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "exp"
Parser
(Maybe NumericDate
-> Maybe NumericDate
-> Maybe StringOrURI
-> ClaimsMap
-> JWTClaimsSet)
-> Parser (Maybe NumericDate)
-> Parser
(Maybe NumericDate
-> Maybe StringOrURI -> ClaimsMap -> JWTClaimsSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe NumericDate)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "nbf"
Parser
(Maybe NumericDate
-> Maybe StringOrURI -> ClaimsMap -> JWTClaimsSet)
-> Parser (Maybe NumericDate)
-> Parser (Maybe StringOrURI -> ClaimsMap -> JWTClaimsSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe NumericDate)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "iat"
Parser (Maybe StringOrURI -> ClaimsMap -> JWTClaimsSet)
-> Parser (Maybe StringOrURI) -> Parser (ClaimsMap -> JWTClaimsSet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe StringOrURI)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "jti"
Parser (ClaimsMap -> JWTClaimsSet)
-> Parser ClaimsMap -> Parser JWTClaimsSet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClaimsMap -> Parser ClaimsMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClaimsMap -> ClaimsMap
removeRegisteredClaims (ClaimsMap -> ClaimsMap) -> ClaimsMap -> ClaimsMap
forall a b. (a -> b) -> a -> b
$ Object -> ClaimsMap
fromHashMap Object
o))
instance FromJSON JOSEHeader where
parseJSON :: Value -> Parser JOSEHeader
parseJSON = String
-> (Object -> Parser JOSEHeader) -> Value -> Parser JOSEHeader
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "JOSEHeader"
(\o :: Object
o -> Maybe Text
-> Maybe Text -> Maybe Algorithm -> Maybe Text -> JOSEHeader
JOSEHeader
(Maybe Text
-> Maybe Text -> Maybe Algorithm -> Maybe Text -> JOSEHeader)
-> Parser (Maybe Text)
-> Parser
(Maybe Text -> Maybe Algorithm -> Maybe Text -> JOSEHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "typ"
Parser (Maybe Text -> Maybe Algorithm -> Maybe Text -> JOSEHeader)
-> Parser (Maybe Text)
-> Parser (Maybe Algorithm -> Maybe Text -> JOSEHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "cty"
Parser (Maybe Algorithm -> Maybe Text -> JOSEHeader)
-> Parser (Maybe Algorithm) -> Parser (Maybe Text -> JOSEHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Algorithm)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "alg"
Parser (Maybe Text -> JOSEHeader)
-> Parser (Maybe Text) -> Parser JOSEHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "kid")
instance ToJSON JOSEHeader where
toJSON :: JOSEHeader -> Value
toJSON JOSEHeader{..} = [(Text, Value)] -> Value
object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, Value)] -> [(Text, Value)]
forall a. [Maybe a] -> [a]
catMaybes [
(Text -> (Text, Value)) -> Maybe Text -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("typ" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe Text
typ
, (Text -> (Text, Value)) -> Maybe Text -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("cty" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe Text
cty
, (Algorithm -> (Text, Value))
-> Maybe Algorithm -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("alg" Text -> Algorithm -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe Algorithm
alg
, (Text -> (Text, Value)) -> Maybe Text -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ("kid" Text -> Text -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe Text
kid
]
instance ToJSON NumericDate where
toJSON :: NumericDate -> Value
toJSON (NumericDate i :: Integer
i) = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) 0
instance FromJSON NumericDate where
parseJSON :: Value -> Parser NumericDate
parseJSON (Number x :: Scientific
x) = NumericDate -> Parser NumericDate
forall (m :: * -> *) a. Monad m => a -> m a
return (NumericDate -> Parser NumericDate)
-> NumericDate -> Parser NumericDate
forall a b. (a -> b) -> a -> b
$ Integer -> NumericDate
NumericDate (Integer -> NumericDate) -> Integer -> NumericDate
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
coefficient Scientific
x
parseJSON _ = Parser NumericDate
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance ToJSON Algorithm where
toJSON :: Algorithm -> Value
toJSON HS256 = Text -> Value
String ("HS256"::T.Text)
toJSON RS256 = Text -> Value
String ("RS256"::T.Text)
instance FromJSON Algorithm where
parseJSON :: Value -> Parser Algorithm
parseJSON (String "HS256") = Algorithm -> Parser Algorithm
forall (m :: * -> *) a. Monad m => a -> m a
return Algorithm
HS256
parseJSON (String "RS256") = Algorithm -> Parser Algorithm
forall (m :: * -> *) a. Monad m => a -> m a
return Algorithm
RS256
parseJSON _ = Parser Algorithm
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance ToJSON StringOrURI where
toJSON :: StringOrURI -> Value
toJSON (S s :: Text
s) = Text -> Value
String Text
s
toJSON (U uri :: URI
uri) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
URI.uriToString ShowS
forall a. a -> a
id URI
uri ""
instance FromJSON StringOrURI where
parseJSON :: Value -> Parser StringOrURI
parseJSON (String s :: Text
s) | String -> Bool
URI.isURI (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s = StringOrURI -> Parser StringOrURI
forall (m :: * -> *) a. Monad m => a -> m a
return (StringOrURI -> Parser StringOrURI)
-> StringOrURI -> Parser StringOrURI
forall a b. (a -> b) -> a -> b
$ URI -> StringOrURI
U (URI -> StringOrURI) -> URI -> StringOrURI
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe URI
URI.nullURI (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
URI.parseURI (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
parseJSON (String s :: Text
s) = StringOrURI -> Parser StringOrURI
forall (m :: * -> *) a. Monad m => a -> m a
return (StringOrURI -> Parser StringOrURI)
-> StringOrURI -> Parser StringOrURI
forall a b. (a -> b) -> a -> b
$ Text -> StringOrURI
S Text
s
parseJSON _ = Parser StringOrURI
forall (m :: * -> *) a. MonadPlus m => m a
mzero