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

-- | JWT header representation
module Libjwt.Header
  ( Alg(..)
  , Typ(..)
  , Header(..)
  )
where

import           Libjwt.Decoding
import           Libjwt.Encoding
import           Libjwt.FFI.Jwt
import           Libjwt.FFI.Libjwt

import           Data.ByteString                ( ByteString )

import qualified Data.CaseInsensitive          as CI

-- | @"alg"@ header parameter
data Alg = None
         | HS256
         | HS384
         | HS512
         | RS256
         | RS384
         | RS512
         | ES256
         | ES384
         | ES512
  deriving stock (Int -> Alg -> ShowS
[Alg] -> ShowS
Alg -> String
(Int -> Alg -> ShowS)
-> (Alg -> String) -> ([Alg] -> ShowS) -> Show Alg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alg] -> ShowS
$cshowList :: [Alg] -> ShowS
show :: Alg -> String
$cshow :: Alg -> String
showsPrec :: Int -> Alg -> ShowS
$cshowsPrec :: Int -> Alg -> ShowS
Show, Alg -> Alg -> Bool
(Alg -> Alg -> Bool) -> (Alg -> Alg -> Bool) -> Eq Alg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alg -> Alg -> Bool
$c/= :: Alg -> Alg -> Bool
== :: Alg -> Alg -> Bool
$c== :: Alg -> Alg -> Bool
Eq)

instance Decode Alg where
  decode :: JwtT -> JwtIO Alg
decode = (JwtAlgT -> Alg) -> JwtIO JwtAlgT -> JwtIO Alg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JwtAlgT -> Alg
matchJwtAlg (JwtIO JwtAlgT -> JwtIO Alg)
-> (JwtT -> JwtIO JwtAlgT) -> JwtT -> JwtIO Alg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JwtT -> JwtIO JwtAlgT
jwtGetAlg
   where
    matchJwtAlg :: JwtAlgT -> Alg
matchJwtAlg JwtAlgT
jwtAlg | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgHs256 = Alg
HS256
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgHs384 = Alg
HS384
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgHs512 = Alg
HS512
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgRs256 = Alg
RS256
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgRs384 = Alg
RS384
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgRs512 = Alg
RS512
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgEs256 = Alg
ES256
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgEs384 = Alg
ES384
                       | JwtAlgT
jwtAlg JwtAlgT -> JwtAlgT -> Bool
forall a. Eq a => a -> a -> Bool
== JwtAlgT
jwtAlgEs512 = Alg
ES512
                       | Bool
otherwise             = Alg
None

-- | @"typ"@ header parameter
data Typ = JWT | Typ (Maybe ByteString)
  deriving stock (Int -> Typ -> ShowS
[Typ] -> ShowS
Typ -> String
(Int -> Typ -> ShowS)
-> (Typ -> String) -> ([Typ] -> ShowS) -> Show Typ
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Typ] -> ShowS
$cshowList :: [Typ] -> ShowS
show :: Typ -> String
$cshow :: Typ -> String
showsPrec :: Int -> Typ -> ShowS
$cshowsPrec :: Int -> Typ -> ShowS
Show, Typ -> Typ -> Bool
(Typ -> Typ -> Bool) -> (Typ -> Typ -> Bool) -> Eq Typ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Typ -> Typ -> Bool
$c/= :: Typ -> Typ -> Bool
== :: Typ -> Typ -> Bool
$c== :: Typ -> Typ -> Bool
Eq)

instance Encode Typ where
  encode :: Typ -> JwtT -> EncodeResult
encode (Typ (Just ByteString
s)) = String -> ByteString -> JwtT -> EncodeResult
addHeader String
"typ" ByteString
s
  encode Typ
_              = JwtT -> EncodeResult
forall b. b -> EncodeResult
nullEncode

instance Decode Typ where
  decode :: JwtT -> JwtIO Typ
decode =
    (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"

-- | JWT header representation
data Header = Header { Header -> Alg
alg :: Alg, Header -> Typ
typ :: Typ }
  deriving stock (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq)

instance Decode Header where
  decode :: JwtT -> JwtIO Header
decode JwtT
jwt = Alg -> Typ -> Header
Header (Alg -> Typ -> Header) -> JwtIO Alg -> JwtIO (Typ -> Header)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JwtT -> JwtIO Alg
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt JwtIO (Typ -> Header) -> JwtIO Typ -> JwtIO Header
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO Typ
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt