--   This Source Code Form is subject to the terms of the Mozilla Public
--   License, v. 2.0. If a copy of the MPL was not distributed with this
--   file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

-- | JWT representation, signing and decoding.

module Libjwt.Jwt
  ( Jwt(..)
  , Encoded
  , getToken
  , sign
  , signJwt
  , Decoded
  , getDecoded
  , decodeString
  , decodeByteString
  , Validated
  , getValid
  , validateJwt
  , jwtFromString
  , jwtFromByteString
  )
where

import           Libjwt.Encoding
import           Libjwt.Exceptions              ( SomeDecodeException
                                                , AlgorithmMismatch(..)
                                                , DecodeException(..)
                                                )
import           Libjwt.Decoding
import           Libjwt.FFI.Jwt
import           Libjwt.FFI.Libjwt
import           Libjwt.Header
import           Libjwt.JwtValidation
import           Libjwt.Keys
import           Libjwt.Payload
import           Libjwt.PrivateClaims

import           Control.Monad.Catch

import           Control.Monad.Extra            ( unlessM )

import           Control.Monad.Time
import           Control.Monad                  ( (<=<) )

import           Data.ByteString                ( ByteString )
import qualified Data.ByteString.Char8         as C8

import qualified Data.CaseInsensitive          as CI

import           GHC.IO.Exception               ( IOErrorType(InvalidArgument) )

import           System.IO.Error                ( ioeGetErrorType )

-- | JSON Web Token representation
data Jwt pc ns = Jwt { Jwt pc ns -> Header
header :: Header, Jwt pc ns -> Payload pc ns
payload :: Payload pc ns }
deriving stock instance Show (PrivateClaims pc ns) => Show (Jwt pc ns)
deriving stock instance Eq (PrivateClaims pc ns) => Eq (Jwt pc ns)

instance Encode (PrivateClaims pc ns) => Encode (Jwt pc ns) where
  encode :: Jwt pc ns -> JwtT -> EncodeResult
encode Jwt { Header
header :: Header
header :: forall (pc :: [Claim *]) (ns :: Namespace). Jwt pc ns -> Header
header, Payload pc ns
payload :: Payload pc ns
payload :: forall (pc :: [Claim *]) (ns :: Namespace).
Jwt pc ns -> Payload pc ns
payload } JwtT
jwt = Payload pc ns -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Payload pc ns
payload JwtT
jwt EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Header -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Header
header JwtT
jwt

-- | base64url-encoded value of type @t@
newtype Encoded t = MkEncoded { Encoded t -> ByteString
getToken :: ByteString -- ^ octets of the UTF-8 representation
                              }
  deriving stock (Int -> Encoded t -> ShowS
[Encoded t] -> ShowS
Encoded t -> String
(Int -> Encoded t -> ShowS)
-> (Encoded t -> String)
-> ([Encoded t] -> ShowS)
-> Show (Encoded t)
forall t. Int -> Encoded t -> ShowS
forall t. [Encoded t] -> ShowS
forall t. Encoded t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Encoded t] -> ShowS
$cshowList :: forall t. [Encoded t] -> ShowS
show :: Encoded t -> String
$cshow :: forall t. Encoded t -> String
showsPrec :: Int -> Encoded t -> ShowS
$cshowsPrec :: forall t. Int -> Encoded t -> ShowS
Show, Encoded t -> Encoded t -> Bool
(Encoded t -> Encoded t -> Bool)
-> (Encoded t -> Encoded t -> Bool) -> Eq (Encoded t)
forall t. Encoded t -> Encoded t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Encoded t -> Encoded t -> Bool
$c/= :: forall t. Encoded t -> Encoded t -> Bool
== :: Encoded t -> Encoded t -> Bool
$c== :: forall t. Encoded t -> Encoded t -> Bool
Eq)

-- | Compute the encoded JWT value with the JWS Signature in the manner defined for the algorithm @alg@ .
--   'typ' of the JWT 'Header' is set to "JWT"
--
--   Creates the serialized ouput, that is: 
--   @
--   BASE64URL(UTF8(JWT Header)) || . || BASE64URL(JWT Payload) || . || BASE64URL(JWT Signature)
--   @
sign
  :: Encode (PrivateClaims pc ns) => Alg -> Payload pc ns -> Encoded (Jwt pc ns)
sign :: Alg -> Payload pc ns -> Encoded (Jwt pc ns)
sign Alg
alg Payload pc ns
payload =
  Jwt pc ns -> Encoded (Jwt pc ns)
forall (pc :: [Claim *]) (ns :: Namespace).
Encode (PrivateClaims pc ns) =>
Jwt pc ns -> Encoded (Jwt pc ns)
signJwt (Jwt pc ns -> Encoded (Jwt pc ns))
-> Jwt pc ns -> Encoded (Jwt pc ns)
forall a b. (a -> b) -> a -> b
$ Jwt :: forall (pc :: [Claim *]) (ns :: Namespace).
Header -> Payload pc ns -> Jwt pc ns
Jwt { header :: Header
header = Header :: Alg -> Typ -> Header
Header { Alg
alg :: Alg
alg :: Alg
alg, typ :: Typ
typ = Typ
JWT }, Payload pc ns
payload :: Payload pc ns
payload :: Payload pc ns
payload }

-- | Compute the encoded JWT value with the JWS Signature in the manner defined for the algorithm 'alg' present in the JWT's 'header' .
--
--   Creates the serialized ouput, that is: 
--   @
--   BASE64URL(UTF8(JWT Header)) || . || BASE64URL(JWT Payload) || . || BASE64URL(JWT Signature)
--   @
signJwt :: Encode (PrivateClaims pc ns) => Jwt pc ns -> Encoded (Jwt pc ns)
signJwt :: Jwt pc ns -> Encoded (Jwt pc ns)
signJwt Jwt pc ns
it = ByteString -> Encoded (Jwt pc ns)
forall t. ByteString -> Encoded t
MkEncoded (ByteString -> Encoded (Jwt pc ns))
-> ByteString -> Encoded (Jwt pc ns)
forall a b. (a -> b) -> a -> b
$ JwtIO ByteString -> ByteString
forall a. JwtIO a -> a
unsafePerformJwtIO JwtIO ByteString
signTokenJwtIo
 where
  signTokenJwtIo :: JwtIO ByteString
signTokenJwtIo = do
    JwtT
jwt <- JwtIO JwtT
mkJwtT
    Jwt pc ns -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Jwt pc ns
it JwtT
jwt
    JwtT -> JwtIO ByteString
jwtEncode JwtT
jwt

{-# NOINLINE signJwt #-}

-- | Decoded value of type @t@
newtype Decoded t = MkDecoded { Decoded t -> t
getDecoded :: t }
  deriving stock (Int -> Decoded t -> ShowS
[Decoded t] -> ShowS
Decoded t -> String
(Int -> Decoded t -> ShowS)
-> (Decoded t -> String)
-> ([Decoded t] -> ShowS)
-> Show (Decoded t)
forall t. Show t => Int -> Decoded t -> ShowS
forall t. Show t => [Decoded t] -> ShowS
forall t. Show t => Decoded t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decoded t] -> ShowS
$cshowList :: forall t. Show t => [Decoded t] -> ShowS
show :: Decoded t -> String
$cshow :: forall t. Show t => Decoded t -> String
showsPrec :: Int -> Decoded t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Decoded t -> ShowS
Show, Decoded t -> Decoded t -> Bool
(Decoded t -> Decoded t -> Bool)
-> (Decoded t -> Decoded t -> Bool) -> Eq (Decoded t)
forall t. Eq t => Decoded t -> Decoded t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decoded t -> Decoded t -> Bool
$c/= :: forall t. Eq t => Decoded t -> Decoded t -> Bool
== :: Decoded t -> Decoded t -> Bool
$c== :: forall t. Eq t => Decoded t -> Decoded t -> Bool
Eq)

-- | See 'decodeByteString'
decodeString
  :: (MonadThrow m, Decode (PrivateClaims pc ns))
  => Alg
  -> String
  -> m (Decoded (Jwt pc ns))
decodeString :: Alg -> String -> m (Decoded (Jwt pc ns))
decodeString Alg
alg = Alg -> ByteString -> m (Decoded (Jwt pc ns))
forall (ns :: Namespace) (pc :: [Claim *]) (m :: * -> *).
(MonadThrow m, Decode (PrivateClaims pc ns)) =>
Alg -> ByteString -> m (Decoded (Jwt pc ns))
decodeByteString Alg
alg (ByteString -> m (Decoded (Jwt pc ns)))
-> (String -> ByteString) -> String -> m (Decoded (Jwt pc ns))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack

-- | Parse the base64url-encoded representation to extract the serialized values for the components of the JWT.
--   Verify that:
--   
--       (1) @token@ is a valid UTF-8 encoded representation of a completely valid JSON object,
--       (1) input JWT signature matches,
--       (1) the correct algorithm was used,
--       (1) all required fields are present.
--
--   If steps 1-2 are unuccessful, 'DecodeException' will be thrown.
--   If step 3 fails, 'AlgorithmMismatch' will be thrown.
--   If the last step fails, 'Libjwt.Exceptions.MissingClaim' will be thrown.
decodeByteString
  :: forall ns pc m
   . (MonadThrow m, Decode (PrivateClaims pc ns))
  => Alg
  -> ByteString
  -> m (Decoded (Jwt pc ns))
decodeByteString :: Alg -> ByteString -> m (Decoded (Jwt pc ns))
decodeByteString Alg
alg ByteString
token = (SomeDecodeException -> m (Decoded (Jwt pc ns)))
-> (Jwt pc ns -> m (Decoded (Jwt pc ns)))
-> Either SomeDecodeException (Jwt pc ns)
-> m (Decoded (Jwt pc ns))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeDecodeException -> m (Decoded (Jwt pc ns))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Decoded (Jwt pc ns) -> m (Decoded (Jwt pc ns))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoded (Jwt pc ns) -> m (Decoded (Jwt pc ns)))
-> (Jwt pc ns -> Decoded (Jwt pc ns))
-> Jwt pc ns
-> m (Decoded (Jwt pc ns))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Jwt pc ns -> Decoded (Jwt pc ns)
forall t. t -> Decoded t
MkDecoded)
  (Either SomeDecodeException (Jwt pc ns) -> m (Decoded (Jwt pc ns)))
-> Either SomeDecodeException (Jwt pc ns)
-> m (Decoded (Jwt pc ns))
forall a b. (a -> b) -> a -> b
$ JwtIO (Either SomeDecodeException (Jwt pc ns))
-> Either SomeDecodeException (Jwt pc ns)
forall a. JwtIO a -> a
unsafePerformJwtIO JwtIO (Either SomeDecodeException (Jwt pc ns))
decodeTokenJwtIo
 where
  decodeTokenJwtIo :: JwtIO (Either SomeDecodeException (Jwt pc ns))
  decodeTokenJwtIo :: JwtIO (Either SomeDecodeException (Jwt pc ns))
decodeTokenJwtIo = JwtIO (Jwt pc ns) -> JwtIO (Either SomeDecodeException (Jwt pc ns))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (JwtIO (Jwt pc ns)
 -> JwtIO (Either SomeDecodeException (Jwt pc ns)))
-> JwtIO (Jwt pc ns)
-> JwtIO (Either SomeDecodeException (Jwt pc ns))
forall a b. (a -> b) -> a -> b
$ do
    JwtT
jwt <- Alg -> ByteString -> JwtIO JwtT
safeJwtDecode Alg
alg ByteString
token
    JwtIO Bool -> EncodeResult -> EncodeResult
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Alg -> JwtAlgT -> Bool
matchAlg Alg
alg (JwtAlgT -> Bool) -> JwtIO JwtAlgT -> JwtIO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JwtT -> JwtIO JwtAlgT
jwtGetAlg JwtT
jwt) (EncodeResult -> EncodeResult) -> EncodeResult -> EncodeResult
forall a b. (a -> b) -> a -> b
$ AlgorithmMismatch -> EncodeResult
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM AlgorithmMismatch
AlgorithmMismatch
    Header -> Payload pc ns -> Jwt pc ns
forall (pc :: [Claim *]) (ns :: Namespace).
Header -> Payload pc ns -> Jwt pc ns
Jwt (Header -> Payload pc ns -> Jwt pc ns)
-> JwtIO Header -> JwtIO (Payload pc ns -> Jwt pc ns)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JwtT -> JwtIO Header
decodeHeader JwtT
jwt JwtIO (Payload pc ns -> Jwt pc ns)
-> JwtIO (Payload pc ns) -> JwtIO (Jwt pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO (Payload pc ns)
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt

  decodeHeader :: JwtT -> JwtIO Header
decodeHeader = (Typ -> Header) -> JwtIO Typ -> JwtIO Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Alg -> Typ -> Header
Header Alg
alg) (JwtIO Typ -> JwtIO Header)
-> (JwtT -> JwtIO Typ) -> JwtT -> JwtIO Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JwtT -> JwtIO Typ
decodeTyp

  decodeTyp :: JwtT -> JwtIO Typ
decodeTyp =
    (Maybe ByteString -> Typ) -> JwtIO (Maybe ByteString) -> JwtIO Typ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( Typ -> (ByteString -> Typ) -> Maybe ByteString -> Typ
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ByteString -> Typ
Typ Maybe ByteString
forall a. Maybe a
Nothing)
        ((ByteString -> Typ) -> Maybe ByteString -> Typ)
-> (ByteString -> Typ) -> Maybe ByteString -> Typ
forall a b. (a -> b) -> a -> b
$ \ByteString
s -> if ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
s CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"jwt" then Typ
JWT else Maybe ByteString -> Typ
Typ (Maybe ByteString -> Typ) -> Maybe ByteString -> Typ
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
        )
      (JwtIO (Maybe ByteString) -> JwtIO Typ)
-> (JwtT -> JwtIO (Maybe ByteString)) -> JwtT -> JwtIO Typ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JwtT -> JwtIO (Maybe ByteString)
getHeader String
"typ"

  matchAlg :: Alg -> JwtAlgT -> Bool
matchAlg (HS256 Secret
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgHs256)
  matchAlg (HS384 Secret
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgHs384)
  matchAlg (HS512 Secret
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgHs512)
  matchAlg (RS256 RsaKeyPair
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgRs256)
  matchAlg (RS384 RsaKeyPair
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgRs384)
  matchAlg (RS512 RsaKeyPair
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgRs512)
  matchAlg (ES256 EcKeyPair
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgEs256)
  matchAlg (ES384 EcKeyPair
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgEs384)
  matchAlg (ES512 EcKeyPair
_) = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgEs512)
  matchAlg Alg
None      = (JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgNone)

{-# NOINLINE decodeByteString #-}

safeJwtDecode :: Alg -> ByteString -> JwtIO JwtT
safeJwtDecode :: Alg -> ByteString -> JwtIO JwtT
safeJwtDecode Alg
alg ByteString
token =
  (IOError -> Bool)
-> JwtIO JwtT -> (IOError -> JwtIO JwtT) -> JwtIO JwtT
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> Bool) -> m a -> (e -> m a) -> m a
catchIf (\IOError
e -> IOError -> IOErrorType
ioeGetErrorType IOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
InvalidArgument)
          (Maybe ByteString -> ByteString -> JwtIO JwtT
jwtDecode (Alg -> Maybe ByteString
getKey Alg
alg) ByteString
token)
    ((IOError -> JwtIO JwtT) -> JwtIO JwtT)
-> (IOError -> JwtIO JwtT) -> JwtIO JwtT
forall a b. (a -> b) -> a -> b
$ JwtIO JwtT -> IOError -> JwtIO JwtT
forall a b. a -> b -> a
const
    (JwtIO JwtT -> IOError -> JwtIO JwtT)
-> JwtIO JwtT -> IOError -> JwtIO JwtT
forall a b. (a -> b) -> a -> b
$ DecodeException -> JwtIO JwtT
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
    (DecodeException -> JwtIO JwtT) -> DecodeException -> JwtIO JwtT
forall a b. (a -> b) -> a -> b
$ String -> DecodeException
DecodeException
    (String -> DecodeException) -> String -> DecodeException
forall a b. (a -> b) -> a -> b
$ ByteString -> String
C8.unpack ByteString
token
 where
  getKey :: Alg -> Maybe ByteString
getKey (HS256 Secret
secret) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Secret -> ByteString
reveal Secret
secret
  getKey (HS384 Secret
secret) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Secret -> ByteString
reveal Secret
secret
  getKey (HS512 Secret
secret) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Secret -> ByteString
reveal Secret
secret
  getKey (RS256 RsaKeyPair
pem   ) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ RsaKeyPair -> ByteString
pubKey RsaKeyPair
pem
  getKey (RS384 RsaKeyPair
pem   ) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ RsaKeyPair -> ByteString
pubKey RsaKeyPair
pem
  getKey (RS512 RsaKeyPair
pem   ) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ RsaKeyPair -> ByteString
pubKey RsaKeyPair
pem
  getKey (ES256 EcKeyPair
pem   ) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ EcKeyPair -> ByteString
ecPubKey EcKeyPair
pem
  getKey (ES384 EcKeyPair
pem   ) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ EcKeyPair -> ByteString
ecPubKey EcKeyPair
pem
  getKey (ES512 EcKeyPair
pem   ) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ EcKeyPair -> ByteString
ecPubKey EcKeyPair
pem
  getKey Alg
None           = Maybe ByteString
forall a. Maybe a
Nothing

-- | Successfully validated value of type @t@
newtype Validated t = MkValid { Validated t -> t
getValid :: t }
 deriving stock (Int -> Validated t -> ShowS
[Validated t] -> ShowS
Validated t -> String
(Int -> Validated t -> ShowS)
-> (Validated t -> String)
-> ([Validated t] -> ShowS)
-> Show (Validated t)
forall t. Show t => Int -> Validated t -> ShowS
forall t. Show t => [Validated t] -> ShowS
forall t. Show t => Validated t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Validated t] -> ShowS
$cshowList :: forall t. Show t => [Validated t] -> ShowS
show :: Validated t -> String
$cshow :: forall t. Show t => Validated t -> String
showsPrec :: Int -> Validated t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Validated t -> ShowS
Show, Validated t -> Validated t -> Bool
(Validated t -> Validated t -> Bool)
-> (Validated t -> Validated t -> Bool) -> Eq (Validated t)
forall t. Eq t => Validated t -> Validated t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Validated t -> Validated t -> Bool
$c/= :: forall t. Eq t => Validated t -> Validated t -> Bool
== :: Validated t -> Validated t -> Bool
$c== :: forall t. Eq t => Validated t -> Validated t -> Bool
Eq)

-- | Accept or reject successfully decoded JWT value.
--   In addition to the default rules mandated by the RFC, the application can add its own rules.
--
--   The default rules are:
--
--       * check 'exp' claim to see if the current time is before the expiration time,
--       * check 'nbf' claim to see if the current time is after or equal the not-before time,
--       * check 'aud' claim if the application identifies itself with a value in the 'aud' list (if present)
--
--   You may allow a little 'leeway' when checking time-based claims.
--
--   'aud' claim is checked against 'appName'.
validateJwt
  :: MonadTime m
  => ValidationSettings -- ^ 'leeway' and 'appName'
  -> JwtValidation pc ns -- ^ additional validation rules
  -> Decoded (Jwt pc ns) -- ^ decoded token
  -> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
validateJwt :: ValidationSettings
-> JwtValidation pc ns
-> Decoded (Jwt pc ns)
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
validateJwt ValidationSettings
settings JwtValidation pc ns
v (MkDecoded Jwt pc ns
jwt) =
  (Validation (NonEmpty ValidationFailure) Valid
 -> ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
-> m (Validation (NonEmpty ValidationFailure) Valid)
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Jwt pc ns -> Validated (Jwt pc ns)
forall t. t -> Validated t
MkValid Jwt pc ns
jwt Validated (Jwt pc ns)
-> Validation (NonEmpty ValidationFailure) Valid
-> ValidationNEL ValidationFailure (Validated (Jwt pc ns))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m (Validation (NonEmpty ValidationFailure) Valid)
 -> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns))))
-> m (Validation (NonEmpty ValidationFailure) Valid)
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
forall a b. (a -> b) -> a -> b
$ ValidationSettings
-> JwtValidation pc ns
-> Payload pc ns
-> m (Validation (NonEmpty ValidationFailure) Valid)
forall (m :: * -> *) (pc :: [Claim *]) (any :: Namespace).
MonadTime m =>
ValidationSettings
-> JwtValidation pc any
-> Payload pc any
-> m (Validation (NonEmpty ValidationFailure) Valid)
runValidation ValidationSettings
settings JwtValidation pc ns
v (Payload pc ns
 -> m (Validation (NonEmpty ValidationFailure) Valid))
-> Payload pc ns
-> m (Validation (NonEmpty ValidationFailure) Valid)
forall a b. (a -> b) -> a -> b
$ Jwt pc ns -> Payload pc ns
forall (pc :: [Claim *]) (ns :: Namespace).
Jwt pc ns -> Payload pc ns
payload Jwt pc ns
jwt

-- | See 'jwtFromByteString'
jwtFromString
  :: (Decode (PrivateClaims pc ns), MonadTime m, MonadThrow m)
  => ValidationSettings
  -> JwtValidation pc ns
  -> Alg
  -> String
  -> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
jwtFromString :: ValidationSettings
-> JwtValidation pc ns
-> Alg
-> String
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
jwtFromString ValidationSettings
settings JwtValidation pc ns
v Alg
alg = ValidationSettings
-> JwtValidation pc ns
-> Decoded (Jwt pc ns)
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
forall (m :: * -> *) (pc :: [Claim *]) (ns :: Namespace).
MonadTime m =>
ValidationSettings
-> JwtValidation pc ns
-> Decoded (Jwt pc ns)
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
validateJwt ValidationSettings
settings JwtValidation pc ns
v (Decoded (Jwt pc ns)
 -> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns))))
-> (String -> m (Decoded (Jwt pc ns)))
-> String
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Alg -> String -> m (Decoded (Jwt pc ns))
forall (m :: * -> *) (pc :: [Claim *]) (ns :: Namespace).
(MonadThrow m, Decode (PrivateClaims pc ns)) =>
Alg -> String -> m (Decoded (Jwt pc ns))
decodeString Alg
alg

-- | @jwtFromByteString = 'validateJwt' settings v <=< 'decodeByteString' alg@
--
--   In other words, it:
-- 
--   Parses the base64url-encoded representation to extract the serialized values for the components of the JWT.
--   Verifies that:
--   
--       (1) @token@ is a valid UTF-8 encoded representation of a completely valid JSON object,
--       (1) input JWT signature matches,
--       (1) the correct algorithm was used,
--       (1) all required fields are present.
--
--   If steps 1-2 are unuccessful, 'DecodeException' will be thrown.
--   If step 3 fails, 'AlgorithmMismatch' will be thrown.
--   If the last step fails, 'Libjwt.Exceptions.MissingClaim' will be thrown.
--   
--   Once the token has been successfully decoded, it is validated.
--
--   In addition to the default rules mandated by the RFC, the application can add its own rules.
--
--   The default rules are:
--
--       * check 'exp' claim to see if the current time is before the expiration time,
--       * check 'nbf' claim to see if the current time is after or equal the not-before time,
--       * check 'aud' claim if the application identifies itself with a value in the 'aud' list (if present)
--
--   You may allow a little 'leeway' when checking time-based claims.
--
--   'aud' claim is checked against 'appName'.
jwtFromByteString
  :: (Decode (PrivateClaims pc ns), MonadTime m, MonadThrow m)
  => ValidationSettings -- ^ 'leeway' and 'appName'
  -> JwtValidation pc ns -- ^ additional validation rules 
  -> Alg -- ^ algorithm used to verify the signature
  -> ByteString -- ^ base64url-encoded representation (a token)
  -> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
jwtFromByteString :: ValidationSettings
-> JwtValidation pc ns
-> Alg
-> ByteString
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
jwtFromByteString ValidationSettings
settings JwtValidation pc ns
v Alg
alg =
  ValidationSettings
-> JwtValidation pc ns
-> Decoded (Jwt pc ns)
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
forall (m :: * -> *) (pc :: [Claim *]) (ns :: Namespace).
MonadTime m =>
ValidationSettings
-> JwtValidation pc ns
-> Decoded (Jwt pc ns)
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
validateJwt ValidationSettings
settings JwtValidation pc ns
v (Decoded (Jwt pc ns)
 -> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns))))
-> (ByteString -> m (Decoded (Jwt pc ns)))
-> ByteString
-> m (ValidationNEL ValidationFailure (Validated (Jwt pc ns)))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Alg -> ByteString -> m (Decoded (Jwt pc ns))
forall (ns :: Namespace) (pc :: [Claim *]) (m :: * -> *).
(MonadThrow m, Decode (PrivateClaims pc ns)) =>
Alg -> ByteString -> m (Decoded (Jwt pc ns))
decodeByteString Alg
alg