module Conduit.Identity.JWT where

import Conduit.Features.Account.Types (UserID, unID)
import Data.Aeson (FromJSON)
import Data.Time (NominalDiffTime)
import Web.JWT (EncodeSigner, JWTClaimsSet(..), VerifySigner, hmacSecret, numericDate, stringOrURI, toVerify)

-- | A datatype enforcing units be in Seconds.
newtype Seconds = Seconds { Seconds -> Int
unSeconds :: Int }
  deriving (Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Seconds -> ShowS
showsPrec :: Int -> Seconds -> ShowS
$cshow :: Seconds -> String
show :: Seconds -> String
$cshowList :: [Seconds] -> ShowS
showList :: [Seconds] -> ShowS
Show)
  deriving newtype (Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
(Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Integer -> Seconds)
-> Num Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$cnegate :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
abs :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
signum :: Seconds -> Seconds
$cfromInteger :: Integer -> Seconds
fromInteger :: Integer -> Seconds
Num, Maybe Seconds
Value -> Parser [Seconds]
Value -> Parser Seconds
(Value -> Parser Seconds)
-> (Value -> Parser [Seconds]) -> Maybe Seconds -> FromJSON Seconds
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Seconds
parseJSON :: Value -> Parser Seconds
$cparseJSONList :: Value -> Parser [Seconds]
parseJSONList :: Value -> Parser [Seconds]
$comittedField :: Maybe Seconds
omittedField :: Maybe Seconds
FromJSON)

-- | Application JWT config state.
data JWTInfo = JWTInfo
  { JWTInfo -> EncodeSigner
jwtEncodeSigner :: !EncodeSigner
  , JWTInfo -> VerifySigner
jwtVerifySigner :: !VerifySigner
  , JWTInfo -> Seconds
jwtExpTime      :: !Seconds
  }

-- | Initial JWT config state @ application startup, converted to 'JWTInfo'.
data JWTOps = JWTOps
  { JWTOps -> Text
jwtOpsSecret  :: !Text
  , JWTOps -> Seconds
jwtOpsExpTime :: !Seconds
  }

-- | Creates an 'JWTInfo' instance from 'JWTOps'.
mkJWTInfo :: JWTOps -> JWTInfo
mkJWTInfo :: JWTOps -> JWTInfo
mkJWTInfo JWTOps {Text
Seconds
$sel:jwtOpsSecret:JWTOps :: JWTOps -> Text
$sel:jwtOpsExpTime:JWTOps :: JWTOps -> Seconds
jwtOpsSecret :: Text
jwtOpsExpTime :: Seconds
..} = EncodeSigner -> VerifySigner -> Seconds -> JWTInfo
JWTInfo EncodeSigner
signer (EncodeSigner -> VerifySigner
toVerify EncodeSigner
signer) Seconds
jwtOpsExpTime
  where signer :: EncodeSigner
signer = Text -> EncodeSigner
hmacSecret Text
jwtOpsSecret

-- | Populates the desired claims:
--
--   [iss] Issuer of the JWT
--
--   [aud] Audience for the JWT
--
--   [sub] Subject of the JWT; a UserID
--
--   [exp] Expiration time of the JWT
mkClaims :: NominalDiffTime -> Seconds -> UserID -> JWTClaimsSet
mkClaims :: NominalDiffTime -> Seconds -> UserID -> JWTClaimsSet
mkClaims NominalDiffTime
currTime (Seconds Int
ttl) UserID
userID = JWTClaimsSet
forall a. Monoid a => a
mempty
  { iss :: Maybe StringOrURI
iss = Text -> Maybe StringOrURI
stringOrURI Text
"conduit-api"
  , aud :: Maybe (Either StringOrURI [StringOrURI])
aud = StringOrURI -> Either StringOrURI [StringOrURI]
forall a b. a -> Either a b
Left (StringOrURI -> Either StringOrURI [StringOrURI])
-> Maybe StringOrURI -> Maybe (Either StringOrURI [StringOrURI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe StringOrURI
stringOrURI Text
"conduit-client"
  , sub :: Maybe StringOrURI
sub = Text -> Maybe StringOrURI
stringOrURI (Text -> Maybe StringOrURI) -> Text -> Maybe StringOrURI
forall a b. (a -> b) -> a -> b
$ Int64 -> Text
forall b a. (Show a, IsString b) => a -> b
show UserID
userID.unID
  , exp :: Maybe IntDate
exp = NominalDiffTime -> Maybe IntDate
numericDate (NominalDiffTime -> Maybe IntDate)
-> NominalDiffTime -> Maybe IntDate
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
currTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ttl
  }