--   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 ExistentialQuantification #-}

-- | Exceptions that may be thrown while decoding a token
module Libjwt.Exceptions
  ( SomeDecodeException
  , DecodeException(..)
  , MissingClaim(..)
  , AlgorithmMismatch(..)
  )
where

import           Control.Exception              ( Exception(..) )
import           Data.Typeable                  ( cast )

-- | The root of the decoding exceptions hierarchy.
--   You can use it to catch all possible exceptions that may occur while decoding a token. 
data SomeDecodeException = forall e . Exception e => SomeDecodeException e

instance Show SomeDecodeException where
  show :: SomeDecodeException -> String
show (SomeDecodeException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception SomeDecodeException where
  displayException :: SomeDecodeException -> String
displayException (SomeDecodeException e
e) = e -> String
forall e. Exception e => e -> String
displayException e
e

-- | Thrown when the token does not represent a decodable JWT object i.e.
-- 
--       * invalid UTF-8
--       * malformed JSON
--       * its signature cannot be verified
--
--   Basically, this token cannot be accepted for further processing because either we cannot determine its authenticity or it is garbage.
newtype DecodeException = DecodeException String
  deriving stock (Int -> DecodeException -> ShowS
[DecodeException] -> ShowS
DecodeException -> String
(Int -> DecodeException -> ShowS)
-> (DecodeException -> String)
-> ([DecodeException] -> ShowS)
-> Show DecodeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodeException] -> ShowS
$cshowList :: [DecodeException] -> ShowS
show :: DecodeException -> String
$cshow :: DecodeException -> String
showsPrec :: Int -> DecodeException -> ShowS
$cshowsPrec :: Int -> DecodeException -> ShowS
Show)

instance Exception DecodeException where
  toException :: DecodeException -> SomeException
toException = SomeDecodeException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeDecodeException -> SomeException)
-> (DecodeException -> SomeDecodeException)
-> DecodeException
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeException -> SomeDecodeException
forall e. Exception e => e -> SomeDecodeException
SomeDecodeException

  fromException :: SomeException -> Maybe DecodeException
fromException SomeException
x = do
    SomeDecodeException e
a <- SomeException -> Maybe SomeDecodeException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe DecodeException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

  displayException :: DecodeException -> String
displayException (DecodeException String
token) =
    String
"The token \n----\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
token
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n----\ndoes not represent a decodable JWT object.\
      \ The possible reasons include:\
      \ its signature cannot be verified;\
      \ malformed JSON;\
      \ it uses an unsupported encoding algorithm.\
      \ We cannot accept this token for further processing because either we cannot determine its authenticity or it is garbage."

-- | Raised when a required claim is not present in the JWT object
newtype MissingClaim = Missing String
  deriving stock (Int -> MissingClaim -> ShowS
[MissingClaim] -> ShowS
MissingClaim -> String
(Int -> MissingClaim -> ShowS)
-> (MissingClaim -> String)
-> ([MissingClaim] -> ShowS)
-> Show MissingClaim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MissingClaim] -> ShowS
$cshowList :: [MissingClaim] -> ShowS
show :: MissingClaim -> String
$cshow :: MissingClaim -> String
showsPrec :: Int -> MissingClaim -> ShowS
$cshowsPrec :: Int -> MissingClaim -> ShowS
Show)

instance Exception MissingClaim where
  toException :: MissingClaim -> SomeException
toException = SomeDecodeException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeDecodeException -> SomeException)
-> (MissingClaim -> SomeDecodeException)
-> MissingClaim
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MissingClaim -> SomeDecodeException
forall e. Exception e => e -> SomeDecodeException
SomeDecodeException

  fromException :: SomeException -> Maybe MissingClaim
fromException SomeException
x = do
    SomeDecodeException e
a <- SomeException -> Maybe SomeDecodeException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe MissingClaim
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

  displayException :: MissingClaim -> String
displayException (Missing String
name) =
    String
"required claim '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is missing"

-- | Raised when the JWT object uses a different algorithm in the header then the one we are trying to decode it with
data AlgorithmMismatch = AlgorithmMismatch
  deriving stock (Int -> AlgorithmMismatch -> ShowS
[AlgorithmMismatch] -> ShowS
AlgorithmMismatch -> String
(Int -> AlgorithmMismatch -> ShowS)
-> (AlgorithmMismatch -> String)
-> ([AlgorithmMismatch] -> ShowS)
-> Show AlgorithmMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlgorithmMismatch] -> ShowS
$cshowList :: [AlgorithmMismatch] -> ShowS
show :: AlgorithmMismatch -> String
$cshow :: AlgorithmMismatch -> String
showsPrec :: Int -> AlgorithmMismatch -> ShowS
$cshowsPrec :: Int -> AlgorithmMismatch -> ShowS
Show)

instance Exception AlgorithmMismatch where
  toException :: AlgorithmMismatch -> SomeException
toException = SomeDecodeException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeDecodeException -> SomeException)
-> (AlgorithmMismatch -> SomeDecodeException)
-> AlgorithmMismatch
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlgorithmMismatch -> SomeDecodeException
forall e. Exception e => e -> SomeDecodeException
SomeDecodeException

  fromException :: SomeException -> Maybe AlgorithmMismatch
fromException SomeException
x = do
    SomeDecodeException e
a <- SomeException -> Maybe SomeDecodeException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe AlgorithmMismatch
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

  displayException :: AlgorithmMismatch -> String
displayException AlgorithmMismatch
_ =
    String
"The token was signed using a different algorithm than expected"