{-# LANGUAGE CPP #-}

module Servant.Auth.JWT where

import           Control.Lens         ((^.))
import qualified Crypto.JWT           as Jose
import           Data.Aeson           (FromJSON, Result (..), ToJSON, fromJSON,
                                       toJSON)
#if MIN_VERSION_aeson(2,0,0)                                                                                    
import qualified Data.Map as KM                                                                        
#else                                                                                                           
import qualified Data.HashMap.Strict as KM                                                                      
#endif

import qualified Data.Text            as T


-- This should probably also be from ClaimSet
--
-- | How to decode data from a JWT.
--
-- The default implementation assumes the data is stored in the unregistered
-- @dat@ claim, and uses the @FromJSON@ instance to decode value from there.
class FromJWT a where
  decodeJWT :: Jose.ClaimsSet -> Either T.Text a
  default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a
  decodeJWT ClaimsSet
m = case Text -> Map Text Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
KM.lookup Text
"dat" (ClaimsSet
m ClaimsSet
-> Getting (Map Text Value) ClaimsSet (Map Text Value)
-> Map Text Value
forall s a. s -> Getting a s a -> a
^. Getting (Map Text Value) ClaimsSet (Map Text Value)
Lens' ClaimsSet (Map Text Value)
Jose.unregisteredClaims) of
    Maybe Value
Nothing -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"Missing 'dat' claim"
    Just Value
v  -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
      Error String
e -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
e
      Success a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a

-- | How to encode data from a JWT.
--
-- The default implementation stores data in the unregistered @dat@ claim, and
-- uses the type's @ToJSON@ instance to encode the data.
class ToJWT a where
  encodeJWT :: a -> Jose.ClaimsSet
  default encodeJWT :: ToJSON a => a -> Jose.ClaimsSet
  encodeJWT a
a = Text -> Value -> ClaimsSet -> ClaimsSet
Jose.addClaim Text
"dat" (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a) ClaimsSet
Jose.emptyClaimsSet