{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
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
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
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"
data = { 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