{-|

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 OpenID.Connect.Authentication
  ( ClientAuthentication(..)
  , ClientSecret(..)
  , Credentials(..)
  , ClientID
  , ClientRedirectURI
  , AuthenticationRequest(..)
  ) where

--------------------------------------------------------------------------------
-- Imports:
import Control.Applicative ((<|>))
import Crypto.JOSE.JWK (JWK)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.ByteString (ByteString)
import Data.Text (Text)
import GHC.Generics (Generic)
import Network.HTTP.Types (QueryItem)
import qualified Network.URI as Network
import OpenID.Connect.JSON (FromJSON, ToJSON, aesonOptions)
import OpenID.Connect.Scope

--------------------------------------------------------------------------------
-- | Private values needed by the client in order to authenticate with
-- the provider.
--
-- The method of authentication is established when the client
-- registers with the provider.
--
-- @since 0.1.0.0
data ClientSecret
  = AssignedSecretText Text
    -- ^ A @client_secret@ created by the provider and given to the
    -- client to use during authentication.
    --
    -- This is the most common way to authenticate with a provider.

  | AssignedAssertionText Text
    -- ^ A @client_secret@ created by the provider and given to the
    -- client.  The client must create a JWT and use the
    -- @client_secret@ to calculate a message authentication code for
    -- the JWT.

  | AssertionPrivateKey JWK
    -- ^ A private key that is solely in the client's possession.  The
    -- provider holds the public key portion of the given key.
    --
    -- The client creates and signs a JWT in order to authenticate.

--------------------------------------------------------------------------------
-- | A @client_id@ assigned by the provider.
--
-- @since 0.1.0.0
type ClientID = Text

--------------------------------------------------------------------------------
-- | The client (relying party) redirection URL previously registered
-- with the OpenID Provider (i.e. a URL to an endpoint on your web
-- site that receives authentication details from the provider via the
-- end-user's browser).
--
-- After the provider has authenticated the end-user, they will be
-- redirected to this URL to continue the flow.
--
-- NOTE: This URL must match exactly with the one registered with the
-- provider.  If they don't match the provider will not redirect the
-- end-user back to your site.
--
-- @since 0.1.0.0
type ClientRedirectURI = Network.URI

--------------------------------------------------------------------------------
-- | A complete set of credentials used by the client to authenticate
-- with the provider.
--
-- @since 0.1.0.0
data Credentials = Credentials
  { Credentials -> ClientID
assignedClientId :: ClientID
    -- ^ The provider-assigned @client_id@.

  , Credentials -> ClientSecret
clientSecret :: ClientSecret
    -- ^ The @client_secret@ or other means of authenticating.

  , Credentials -> ClientRedirectURI
clientRedirectUri :: ClientRedirectURI
    -- ^ The @redirect_uri@ shared between the client and provider.
    -- This URI must be registered with the provider.
  }

--------------------------------------------------------------------------------
-- | §3.1.2.1.  Authentication Request.
--
-- The fields of this record are send to the provider by way of a URI
-- given to the end-user.
--
-- Clients can use the
-- 'OpenID.Connect.Client.Flow.AuthorizationCode.defaultAuthenticationRequest'
-- function to easily create a value of this type.
--
-- @since 0.1.0.0
data AuthenticationRequest = AuthenticationRequest
  { AuthenticationRequest -> ClientRedirectURI
authRequestRedirectURI :: ClientRedirectURI
    -- ^ Where to redirect the end-user to after authentication.

  , AuthenticationRequest -> ClientID
authRequestClientId :: Text
    -- ^ The @client_id@ assigned by the provider.

  , AuthenticationRequest -> Scope
authRequestScope :: Scope
    -- ^ The @scope@ to request.  The @openid@ scope is always part of
    -- this list.

  , AuthenticationRequest -> ByteString
authRequestResponseType :: ByteString
    -- ^ The @response_type@ parameter.

  , AuthenticationRequest -> Maybe ByteString
authRequestDisplay :: Maybe ByteString
    -- ^ The @display@ parameter.

  , AuthenticationRequest -> Maybe ByteString
authRequestPrompt :: Maybe ByteString
    -- ^ The @prompt@ parameter.

  , AuthenticationRequest -> Maybe Int
authRequestMaxAge :: Maybe Int
    -- ^ The @max_age@ parameter.

  , AuthenticationRequest -> Maybe Words
authRequestUiLocales :: Maybe Words
    -- ^ The @ui_locales@ parameter.

  , AuthenticationRequest -> Maybe ByteString
authRequestIdTokenHint :: Maybe ByteString
    -- ^ The @id_token_hint@ parameter.

  , AuthenticationRequest -> Maybe ClientID
authRequestLoginHint :: Maybe Text
    -- ^ The @login_hint@ parameter.

  , AuthenticationRequest -> Maybe Words
authRequestAcrValues :: Maybe Words
    -- ^ The @acr_values@ parameter.

  , AuthenticationRequest -> [QueryItem]
authRequestOtherParams :: [QueryItem]
    -- ^ Any additional query parameters you wish to send to the
    -- provider.
  }

--------------------------------------------------------------------------------
-- | Methods that a client can use to authenticate with a provider.
--
-- Defined in OpenID Connect Core 1.0 §9.
--
-- @since 0.1.0.0
data ClientAuthentication
  = ClientSecretBasic
    -- ^ Send credentials using HTTP Basic Authentication.

  | ClientSecretPost
    -- ^ Send the credentials in the body of an HTTP POST.

  | ClientSecretJwt
    -- ^ Create a JWT and calculate a message authentication code
    -- using a shared secret.  The JWT confirms that the client is in
    -- possession of the shared secret.

  | PrivateKeyJwt
    -- ^ Create and sign a JWT using a private key.  The provider must
    -- already have access to the public key corresponding to the
    -- private key.

  | None
    -- ^ The Client does not authenticate itself at the Token
    -- Endpoint, either because it uses only the Implicit Flow (and so
    -- does not use the Token Endpoint) or because it is a Public
    -- Client with no Client Secret or other authentication mechanism.

  | UnsupportedAuthentication Text
    -- ^ Other unsupported possible ways to autenticate the client.
    --
    -- @since 0.2.0

  deriving stock (forall x. Rep ClientAuthentication x -> ClientAuthentication
forall x. ClientAuthentication -> Rep ClientAuthentication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientAuthentication x -> ClientAuthentication
$cfrom :: forall x. ClientAuthentication -> Rep ClientAuthentication x
Generic, ClientAuthentication -> ClientAuthentication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientAuthentication -> ClientAuthentication -> Bool
$c/= :: ClientAuthentication -> ClientAuthentication -> Bool
== :: ClientAuthentication -> ClientAuthentication -> Bool
$c== :: ClientAuthentication -> ClientAuthentication -> Bool
Eq, Int -> ClientAuthentication -> ShowS
[ClientAuthentication] -> ShowS
ClientAuthentication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientAuthentication] -> ShowS
$cshowList :: [ClientAuthentication] -> ShowS
show :: ClientAuthentication -> String
$cshow :: ClientAuthentication -> String
showsPrec :: Int -> ClientAuthentication -> ShowS
$cshowsPrec :: Int -> ClientAuthentication -> ShowS
Show)

clientAuthAesonOptions :: Aeson.Options
clientAuthAesonOptions :: Options
clientAuthAesonOptions = Options
aesonOptions{ sumEncoding :: SumEncoding
Aeson.sumEncoding = SumEncoding
Aeson.UntaggedValue }

instance ToJSON ClientAuthentication where
  toJSON :: ClientAuthentication -> Value
toJSON (UnsupportedAuthentication ClientID
txt) = ClientID -> Value
Aeson.String ClientID
txt
  toJSON ClientAuthentication
a = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
clientAuthAesonOptions ClientAuthentication
a

instance FromJSON ClientAuthentication where
  parseJSON :: Value -> Parser ClientAuthentication
parseJSON v :: Value
v@(Aeson.String ClientID
txt) =
    forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
clientAuthAesonOptions Value
v
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientID -> ClientAuthentication
UnsupportedAuthentication ClientID
txt)
  parseJSON Value
v =
    forall a. String -> Parser a -> Parser a
Aeson.prependFailure String
"parsing ClientAuthentication failed, " (forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"String" Value
v)