{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings  #-}
{-|
    Module: Web.OIDC.Client.Types
    Maintainer: krdlab@gmail.com
    Stability: experimental
-}
module Web.OIDC.Client.Types
    (
      ScopeValue
    , openId, profile, email, address, phone, offlineAccess
    , Scope
    , State
    , Nonce
    , Parameters
    , Code
    , IssuerLocation
    , OpenIdException(..)
    , SessionStore (..)
    ) where

import           Control.Exception   (Exception)
import           Data.ByteString     (ByteString)
import           Data.Text           (Text)
import           Data.Typeable       (Typeable)
import           Jose.Jwt            (JwtError)
import           Network.HTTP.Client (HttpException)

type IssuerLocation = Text

type ScopeValue = Text

openId, profile, email, address, phone, offlineAccess :: ScopeValue
openId :: ScopeValue
openId        = ScopeValue
"openid"
profile :: ScopeValue
profile       = ScopeValue
"profile"
email :: ScopeValue
email         = ScopeValue
"email"
address :: ScopeValue
address       = ScopeValue
"address"
phone :: ScopeValue
phone         = ScopeValue
"phone"
offlineAccess :: ScopeValue
offlineAccess = ScopeValue
"offline_access"

type Scope = [ScopeValue]

type State = ByteString

type Nonce = ByteString

type Parameters = [(ByteString, Maybe ByteString)]

type Code = ByteString

data OpenIdException =
      DiscoveryException Text
    | InternalHttpException HttpException
    | JsonException Text
    | UnsecuredJwt ByteString
    | JwtException JwtError
    | ValidationException Text
    | UnknownState
    | MissingNonceInResponse
    | MismatchedNonces
  deriving (Int -> OpenIdException -> ShowS
[OpenIdException] -> ShowS
OpenIdException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenIdException] -> ShowS
$cshowList :: [OpenIdException] -> ShowS
show :: OpenIdException -> String
$cshow :: OpenIdException -> String
showsPrec :: Int -> OpenIdException -> ShowS
$cshowsPrec :: Int -> OpenIdException -> ShowS
Show, Typeable)

instance Exception OpenIdException

-- | Manages state and nonce.
--   (Maybe 'OIDC' should have them)
data SessionStore m = SessionStore
    { forall (m :: * -> *). SessionStore m -> m ByteString
sessionStoreGenerate :: m ByteString
    -- ^ Generate state and nonce at random
    , forall (m :: * -> *).
SessionStore m -> ByteString -> ByteString -> m ()
sessionStoreSave :: State -> Nonce -> m ()
    , forall (m :: * -> *).
SessionStore m -> ByteString -> m (Maybe ByteString)
sessionStoreGet :: State -> m (Maybe Nonce)
    -- ^ Returns 'Nothing' if 'State' is unknown
    , forall (m :: * -> *). SessionStore m -> m ()
sessionStoreDelete :: m ()
    -- ^ Should delete at least nonce
    }