{-| 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/sthenauth/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 The /Authorization Code/ Flow as defined in OpenID Connect 1.0. Flow outline: 1. Perform (and optionally cache) the provider's discovery document and keys. This is done with a combination of 'OpenID.Connect.Client.Provider.discovery' and 'OpenID.Connect.Client.Provider.keysFromDiscovery'. 2. Send the end-user to the provider for authentication by applying the 'authenticationRedirect' function. It will generate a 'RedirectTo' response with a URI and cookie. 3. The provider will redirect the end-user back to your site with some query parameters. Bundle those up and apply the 'authenticationSuccess' function. It will respond with a validated identity token if everything checks out. -} module OpenID.Connect.Client.Flow.AuthorizationCode ( -- * Flow authenticationRedirect , authenticationSuccess , RedirectTo(..) -- * Authentication settings , defaultAuthenticationRequest -- * End-user provided details , UserReturnFromRedirect(..) -- * Errors that can occur , FlowError(..) -- * Ancillary types and re-exports , HTTPS , ErrorResponse(..) , module OpenID.Connect.Authentication , module OpenID.Connect.Client.Provider , module OpenID.Connect.Scope ) where -------------------------------------------------------------------------------- -- Imports: import Control.Category ((>>>)) import Control.Exception (Exception) import Control.Monad.Except import qualified Crypto.Hash as Hash import qualified Crypto.JOSE.Error as JOSE import Crypto.JOSE.JWK (JWKSet) import Crypto.JWT (SignedJWT, ClaimsSet, JWTError) import Crypto.Random (MonadRandom(..)) import Data.Bifunctor (bimap, first, second) import Data.ByteArray.Encoding import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as Char8 import qualified Data.ByteString.Lazy as LByteString import Data.Function ((&)) import Data.Functor ((<&>)) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text.Encoding as Text import Data.Time.Clock (UTCTime) import qualified Network.HTTP.Client as HTTP import Network.HTTP.Types (QueryItem, renderQuery) import qualified Network.URI as Network import OpenID.Connect.Authentication import OpenID.Connect.Client.Authentication import OpenID.Connect.Client.HTTP import OpenID.Connect.Client.Provider import OpenID.Connect.JSON import OpenID.Connect.Scope import OpenID.Connect.TokenResponse (TokenResponse) import Web.Cookie (SetCookie) import qualified Web.Cookie as Cookie import OpenID.Connect.Client.TokenResponse ( decodeIdentityToken , verifyIdentityTokenClaims ) -------------------------------------------------------------------------------- -- | Internal type for calculating secrets. data Secrets = Secrets { requestForgeryProtectionToken :: ByteString , replayProtectionNonce :: ByteString , valueForHttpOnlyCookie :: ByteString } -------------------------------------------------------------------------------- -- | Generate a new set of secrets. generateRandomSecrets :: forall m. MonadRandom m => m Secrets generateRandomSecrets = do bytes <- getRandomBytes 64 :: m ByteString let hash1 = Hash.hash (ByteString.take 32 bytes) :: Hash.Digest Hash.SHA256 hash2 = Hash.hash (ByteString.drop 32 bytes) :: Hash.Digest Hash.SHA256 pure Secrets { requestForgeryProtectionToken = convertToBase Base64URLUnpadded hash2 , replayProtectionNonce = convertToBase Base64URLUnpadded hash1 , valueForHttpOnlyCookie = convertToBase Base64URLUnpadded bytes } -------------------------------------------------------------------------------- -- | Extract the expected state value from the session cookie. expectedStateParam :: ByteString -> Either FlowError ByteString expectedStateParam cookie = extractTokenFromSessionCookie cookie (ByteString.drop 32) & first (const InvalidStateParameterError) -------------------------------------------------------------------------------- -- | Given the session cookie, return the expected nonce value. expectedNonce :: ByteString -> Either FlowError Text expectedNonce cookie = extractTokenFromSessionCookie cookie (ByteString.take 32) & bimap (const InvalidNonceFromProviderError) Text.decodeUtf8 -------------------------------------------------------------------------------- -- | Higher-order function of extracting bytes from a session cookie. extractTokenFromSessionCookie :: ByteString -- ^ The session cookie -> (ByteString -> ByteString) -- ^ Function to extract token bytes -> Either String ByteString -- ^ Error or token. extractTokenFromSessionCookie cookie f = convertFromBase Base64URLUnpadded cookie <&> rehash . f where rehash :: ByteString -> ByteString rehash bs = let hash = Hash.hash bs :: Hash.Digest Hash.SHA256 in convertToBase Base64URLUnpadded hash -------------------------------------------------------------------------------- -- | Create an 'AuthenticationRequest' value for the authorization -- code flow. -- -- @since 0.1.0.0 defaultAuthenticationRequest :: Scope -- ^ Requested scope. -> Credentials -- ^ Provider assigned credentials. -> AuthenticationRequest -- ^ An 'AuthenticationRequest'. defaultAuthenticationRequest scope creds = AuthenticationRequest { authRequestRedirectURI = clientRedirectUri creds , authRequestScope = scope , authRequestResponseType = "code" , authRequestClientId = assignedClientId creds , authRequestDisplay = Nothing , authRequestPrompt = Nothing , authRequestMaxAge = Nothing , authRequestUiLocales = Nothing , authRequestIdTokenHint = Nothing , authRequestLoginHint = Nothing , authRequestAcrValues = Nothing , authRequestOtherParams = [] } -------------------------------------------------------------------------------- -- | Values to collect from the end-user after they return from -- provider authentication as per §3.1.2.5. -- -- When the end-user is sent to the 'ClientRedirectURI' they /must/ -- provide the following values. If any of these fields are not -- provided by the end-user you should assume the authentication -- failed. -- -- If the @state@ and/or @code@ parameters are missing in the HTTP -- request you should look for an @error@ query parameter as specified -- in §3.1.2.6. -- -- @since 0.1.0.0 data UserReturnFromRedirect = UserReturnFromRedirect { afterRedirectSessionCookie :: ByteString -- ^ The end-user /must/ provide a cookie value set by the -- 'RedirectTo' response. This is needed to validate the @state@ -- parameter and the @nonce@ claim in the identity token. , afterRedirectCodeParam :: ByteString -- ^ The @code@ parameter which contains the authorization code. , afterRedirectStateParam :: ByteString -- ^ The @state@ parameter which is used to prevent request -- forgery. } -------------------------------------------------------------------------------- -- | Errors that may occur during the authentication code flow. -- -- @since 0.1.0.0 data FlowError = ProviderDiscoveryError DiscoveryError -- ^ Something is wrong with the discovery document. | InvalidStateParameterError -- ^ The @state@ query parameter provided by the end-user doesn't -- match their session cookie. It's possible that the current -- request was forged and therefore didn't originate from an -- actual end-user. | InvalidNonceFromProviderError -- ^ The @nonce@ claim in the identity token doesn't match the -- value in the end-user's session cookie. It's possible that the -- response from the provider is a replay of a previous response. | ProviderMissingTokenEndpointError -- ^ The provider does not support the Authorization Code flow. -- To work with this provider you must use another flow type -- (i.e. implicit or hybrid). | InvalidProviderTokenEndpointError Text -- ^ The provider's discovery document includes a @token_endpoint@ -- which is not a valid URL. The invalid URL is provided for -- reference. | NoAuthenticationMethodsAvailableError -- ^ The provided 'Credentials' do not include any authentication -- secrets that match what the provider accepts in the -- 'tokenEndpointAuthMethodsSupported' field. Therefore we can't -- make a token exchange request with this provider without using -- a different set of 'Credentials'. | InvalidProviderTokenResponseError ErrorResponse -- ^ While exchanging an authorization code for an identity token -- the provider responded in a way that we couldn't parse. A -- decoding error message is provided for debugging. | TokenDecodingError JOSE.Error -- ^ The 'TokenResponse' from the provider failed to decode or -- validate. More information is provided by the @jose@ error. | IdentityTokenValidationFailed JWTError -- ^ The identity token from the provider is invalid (i.e. one of -- the claims is incorrect) or the digital signature on the token -- doesn't match any of the keys in the provided key set. deriving (Show, Exception) -------------------------------------------------------------------------------- -- | Send the end-user to this URI after setting a cookie. -- -- The function for generating a cookie accepts the name of the -- cookie. This allows you to give the cookie any name you -- choose. Just be sure to retrieve the same cookie from the -- end-user when creating the 'UserReturnFromRedirect' value. -- -- The returned cookie has all of its security-related features -- enabled. Depending on your hosting requirements you may need -- to use the @cookie@ package to loosen these restrictions. -- -- Setting (and retrieving) the given cookie is mandatory. It is -- used to cryptographically derive the @state@ and @nonce@ values -- for request forgery protection and replay protection. data RedirectTo = RedirectTo Network.URI (ByteString -> SetCookie) -------------------------------------------------------------------------------- -- | __Step 1: Send the end-user to the provider.__ -- -- This request will create a URI pointing to the provider's -- authorization end point and a session cookie that must be set -- in the end-user's browser. -- -- To create a 'Discovery' value, use the -- 'OpenID.Connect.Client.Provider.discovery' function. -- -- To create an 'AuthenticationRequest' value use the -- 'defaultAuthenticationRequest' function. authenticationRedirect :: MonadRandom m => Discovery -> AuthenticationRequest -> m (Either FlowError RedirectTo) authenticationRedirect disco req = do let uri = authRequestRedirectURI req secrets <- generateRandomSecrets makeRedirectURI secrets disco req & second (`RedirectTo` makeSessionCookie secrets uri) & pure -------------------------------------------------------------------------------- -- | __Step 2. Turn the end-user's authorization token into an identity token.__ -- -- When the end-user returns from the provider they will make a -- request to your site with some query parameters and a session -- cookie. With those values in hand, this function represents -- a request to receive and validate an identity token from the -- provider. -- -- In order to create this function you'll need a few records: -- -- * The current time given as a 'UTCTime' -- * A 'Provider' record (discovery document and key set) -- * Your client 'Credentials' -- * The request details from the end-user in 'UserReturnFromRedirect' authenticationSuccess :: MonadRandom m => HTTPS m -> UTCTime -> Provider -> Credentials -> UserReturnFromRedirect -> m (Either FlowError (TokenResponse ClaimsSet)) authenticationSuccess https time (Provider disco keys) creds user = runExceptT $ do _ <- ExceptT (pure (verifyPostRedirectRequest user)) token <- ExceptT (exchangeCodeForIdentityToken https time disco creds user) ExceptT (pure (extractClaimsSetFromTokenResponse disco creds token keys time user)) -------------------------------------------------------------------------------- -- | Create the provider authorization redirect URI for the end-user. makeRedirectURI :: Secrets -> Discovery -> AuthenticationRequest -> Either FlowError Network.URI makeRedirectURI secrets disco AuthenticationRequest{..} = let uri = getURI (authorizationEndpoint disco) in Right $ uri { Network.uriQuery = Char8.unpack (renderQuery True (params <> authRequestOtherParams)) } where params :: [QueryItem] params = filter (isJust . snd) [ ("response_type", Just authRequestResponseType) , ("client_id", Just (Text.encodeUtf8 authRequestClientId)) , ("redirect_uri", Just redir) , ("nonce", Just (replayProtectionNonce secrets)) , ("state", Just (requestForgeryProtectionToken secrets)) , ("display", authRequestDisplay) , ("prompt", authRequestPrompt) , ("max_age", Char8.pack . show <$> authRequestMaxAge) , ("ui_locales", Text.encodeUtf8 . fromWords <$> authRequestUiLocales) , ("id_token_hint", authRequestIdTokenHint) , ("login_hint", Text.encodeUtf8 <$> authRequestLoginHint) , ("acr_values", Text.encodeUtf8 . fromWords <$> authRequestAcrValues) , scopeQueryItem authRequestScope ] redir :: ByteString redir = Char8.pack (Network.uriToString id authRequestRedirectURI []) -------------------------------------------------------------------------------- -- | Create a session cookie for the end-user. makeSessionCookie :: Secrets -> ClientRedirectURI -> ByteString -> SetCookie makeSessionCookie Secrets{valueForHttpOnlyCookie} uri name = Cookie.defaultSetCookie { Cookie.setCookieName = name , Cookie.setCookieValue = valueForHttpOnlyCookie , Cookie.setCookiePath = Just (Char8.pack (Network.uriPath uri)) , Cookie.setCookieHttpOnly = True , Cookie.setCookieSecure = True , Cookie.setCookieSameSite = Just Cookie.sameSiteLax } -------------------------------------------------------------------------------- -- | Validate the @state@ parameter from the end-user. verifyPostRedirectRequest :: UserReturnFromRedirect -> Either FlowError () verifyPostRedirectRequest UserReturnFromRedirect{..} = do expectState <- expectedStateParam afterRedirectSessionCookie if afterRedirectStateParam == expectState then Right () else Left InvalidStateParameterError -------------------------------------------------------------------------------- -- | Use HTTP to exchange an access token for an identity token. exchangeCodeForIdentityToken :: forall m. MonadRandom m => HTTPS m -> UTCTime -> Discovery -> Credentials -> UserReturnFromRedirect -> m (Either FlowError (TokenResponse SignedJWT)) exchangeCodeForIdentityToken https now disco creds user = do res <- performRequest pure (processResponse =<< res) where performRequest :: m (Either FlowError (HTTP.Response LByteString.ByteString)) performRequest = runExceptT $ do uri <- maybe (throwError ProviderMissingTokenEndpointError) pure (tokenEndpoint disco) req <- maybe (throwError (InvalidProviderTokenEndpointError (uriToText (getURI uri)))) pure (requestFromURI (Right (getURI uri))) applyRequestAuthentication creds authMethods uri now body req >>= \case Nothing -> throwError NoAuthenticationMethodsAvailableError Just r -> lift (https r) processResponse :: HTTP.Response LByteString.ByteString -> Either FlowError (TokenResponse SignedJWT) processResponse res = parseResponse res & bimap InvalidProviderTokenResponseError fst >>= (decodeIdentityToken >>> first TokenDecodingError) authMethods :: [ClientAuthentication] authMethods = maybe [ClientSecretPost] NonEmpty.toList (tokenEndpointAuthMethodsSupported disco) body :: [ (ByteString, ByteString) ] body = [ ("grant_type", "authorization_code") , ("code", afterRedirectCodeParam user) , ("redirect_uri", Char8.pack (Network.uriToString id (clientRedirectUri creds) [])) , ("client_id", Text.encodeUtf8 (assignedClientId creds)) ] -------------------------------------------------------------------------------- -- | Verify an identity token and then expose the claims it holds. extractClaimsSetFromTokenResponse :: Discovery -> Credentials -> TokenResponse SignedJWT -> JWKSet -> UTCTime -> UserReturnFromRedirect -> Either FlowError (TokenResponse ClaimsSet) extractClaimsSetFromTokenResponse disco creds token keys time user = do nonce <- expectedNonce (afterRedirectSessionCookie user) verifyIdentityTokenClaims disco (assignedClientId creds) time keys nonce token & first IdentityTokenValidationFailed