{-# LANGUAGE OverloadedStrings #-}
{-|
    Module: Web.OIDC.Client.Settings
    Maintainer: krdlab@gmail.com
    Stability: experimental
-}
module Web.OIDC.Client.Settings
    (
      OIDC(..)
    , def
    , newOIDC
    , setCredentials
    ) where

import           Data.ByteString                    (ByteString)
import           Data.Text                          (Text)

import           Web.OIDC.Client.Discovery.Provider (Provider)
import qualified Web.OIDC.Client.Discovery.Provider as P

-- | This data type represents information needed in the OpenID flow.
data OIDC = OIDC
    { OIDC -> Text
oidcAuthorizationServerUrl :: Text
    , OIDC -> Text
oidcTokenEndpoint          :: Text
    , OIDC -> ByteString
oidcClientId               :: ByteString
    , OIDC -> ByteString
oidcClientSecret           :: ByteString
    , OIDC -> ByteString
oidcRedirectUri            :: ByteString
    , OIDC -> Provider
oidcProvider               :: Provider
    }

def :: OIDC
def :: OIDC
def = OIDC :: Text
-> Text
-> ByteString
-> ByteString
-> ByteString
-> Provider
-> OIDC
OIDC
    { oidcAuthorizationServerUrl :: Text
oidcAuthorizationServerUrl = [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"You must specify authorizationServerUrl"
    , oidcTokenEndpoint :: Text
oidcTokenEndpoint          = [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"You must specify tokenEndpoint"
    , oidcClientId :: ByteString
oidcClientId               = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"You must specify clientId"
    , oidcClientSecret :: ByteString
oidcClientSecret           = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"You must specify clientSecret"
    , oidcRedirectUri :: ByteString
oidcRedirectUri            = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"You must specify redirectUri"
    , oidcProvider :: Provider
oidcProvider               = [Char] -> Provider
forall a. HasCallStack => [Char] -> a
error [Char]
"You must specify provider"
    }

newOIDC
    :: Provider     -- ^ OP's information (obtained by 'Web.OIDC.Client.Discovery.discover')
    -> OIDC
newOIDC :: Provider -> OIDC
newOIDC Provider
p =
    OIDC
def { oidcAuthorizationServerUrl :: Text
oidcAuthorizationServerUrl = Configuration -> Text
P.authorizationEndpoint (Configuration -> Text)
-> (Provider -> Configuration) -> Provider -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Provider -> Configuration
P.configuration (Provider -> Text) -> Provider -> Text
forall a b. (a -> b) -> a -> b
$ Provider
p
        , oidcTokenEndpoint :: Text
oidcTokenEndpoint          = Configuration -> Text
P.tokenEndpoint (Configuration -> Text)
-> (Provider -> Configuration) -> Provider -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Provider -> Configuration
P.configuration (Provider -> Text) -> Provider -> Text
forall a b. (a -> b) -> a -> b
$ Provider
p
        , oidcProvider :: Provider
oidcProvider               = Provider
p
        }

setCredentials
    :: ByteString   -- ^ client ID
    -> ByteString   -- ^ client secret
    -> ByteString   -- ^ redirect URI (the HTTP endpont on your server that will receive a response from OP)
    -> OIDC
    -> OIDC
setCredentials :: ByteString -> ByteString -> ByteString -> OIDC -> OIDC
setCredentials ByteString
cid ByteString
secret ByteString
redirect OIDC
oidc =
    OIDC
oidc { oidcClientId :: ByteString
oidcClientId     = ByteString
cid
         , oidcClientSecret :: ByteString
oidcClientSecret = ByteString
secret
         , oidcRedirectUri :: ByteString
oidcRedirectUri  = ByteString
redirect
         }