{-|

Copyright:

  This file is part of the package openid-connect.  It is subject to
  the license terms in the LICENSE file found in the top-level
  directory of this distribution and at:

    https://code.devalot.com/open/openid-connect

  No part of this package, including this file, may be copied,
  modified, propagated, or distributed except according to the terms
  contained in the LICENSE file.

License: BSD-2-Clause

-}
module Discover
  ( getProvider
  , getCredentials
  ) where

--------------------------------------------------------------------------------
-- Imports:
import Control.Lens ((^.))
import Crypto.JOSE (JWK, JWKSet(..), asPublicKey)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as Char8
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Network.HTTP.Client (Manager)
import OpenID.Connect.Authentication
import OpenID.Connect.Client.DynamicRegistration as R
import OpenID.Connect.Client.Provider
import OpenID.Connect.Provider.Key
import Options
import Util

--------------------------------------------------------------------------------
-- | Fetch the provider's discovery document and signing keys.
getProvider :: Options -> Manager -> IO Provider
getProvider opts mgr =
  discoveryAndKeys (https mgr) (optionsProviderUri opts) >>= \case
    Left err     -> fail (show err)
    Right (x, _) -> pure (x { providerDiscovery =
                              updateDisco (providerDiscovery x) })

  where
    updateDisco :: Discovery -> Discovery
    updateDisco d =
      case optionsForceAuthMode opts of
        ForceSecretPost ->
          d {tokenEndpointAuthMethodsSupported =
             Just (ClientSecretPost :| [])}
        ForceSecretJWT ->
          d {tokenEndpointAuthMethodsSupported =
             Just (ClientSecretJwt :| [])}
        ForcePrivateJWT ->
          d {tokenEndpointAuthMethodsSupported =
             Just (PrivateKeyJwt :| [])}
        NoForcedAuth ->
          d

--------------------------------------------------------------------------------
-- | Construct client credentials.
getCredentials
  :: Options
  -> Manager
  -> Provider
  -> IO Credentials
getCredentials opts mgr provider =
  case optionsClientDetails opts of
    Direct cid csec -> pure (build csec cid)
    Register email -> register email

  where
    register :: Text -> IO Credentials
    register email = do
      key <- newSigningJWK
      let metadata = clientMetadata (regReq email key) BasicRegistration
      putStrLn "Performing dynamic client registration:"
      Char8.putStrLn (Aeson.encode metadata)

      registerClient (https mgr) (providerDiscovery provider) metadata >>= \case
        Left e -> fail (show e)
        Right x -> do
          let res = clientSecretsFromResponse x
          putStrLn "Registration successful:" >> print res
          pure (build (R.clientId res) (toClientSecret key (R.clientSecret res)))

    regReq :: Text -> JWK -> Registration
    regReq email key =
      let reg = defaultRegistration (optionsClientUri opts)
      in  reg { R.contacts = Just (email :| [])
              , R.tokenEndpointAuthMethod = defaultAuthMethod
              , R.jwks = JWKSet . pure <$> (key ^. asPublicKey)
              }

    defaultAuthMethod :: ClientAuthentication
    defaultAuthMethod = case optionsForceAuthMode opts of
      ForceSecretPost -> ClientSecretPost
      ForceSecretJWT  -> ClientSecretJwt
      ForcePrivateJWT -> PrivateKeyJwt
      NoForcedAuth    -> ClientSecretBasic

    toClientSecret :: JWK -> Maybe Text -> ClientSecret
    toClientSecret key = \case
      Nothing ->
        case optionsForceAuthMode opts of
          ForceSecretPost -> AssignedSecretText "should fail"
          ForceSecretJWT  -> AssignedAssertionText "should fail"
          ForcePrivateJWT -> AssertionPrivateKey key
          NoForcedAuth    -> AssignedSecretText "should fail"
      Just sec ->
        case optionsForceAuthMode opts of
          ForceSecretPost -> AssignedSecretText sec
          ForceSecretJWT  -> AssignedAssertionText sec
          ForcePrivateJWT -> AssertionPrivateKey key
          NoForcedAuth    -> AssignedSecretText sec

    build :: Text -> ClientSecret -> Credentials
    build cid csec =
      Credentials
        { assignedClientId  = cid
        , clientSecret      = csec
        , clientRedirectUri = optionsClientUri opts
        }