Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Network.OAuth2.Experiment
Description
This module contains a new way of doing OAuth2 authorization and authentication in order to obtain Access Token and maybe Refresh Token base on rfc6749.
This module will become default in future release. (TBD but likely 3.0).
The key concept/change is to introduce the GrantTypeFlow
, which determines the entire work flow per spec.
Each work flow will have slight different request parameters, which often time you'll see
different configuration when creating OAuth2 application in the IdP developer application page.
Here are supported flows
- Authorization Code. This flow requires authorize call to obtain an authorize code, then exchange the code for tokens.
- Resource Owner Password. This flow only requires to hit token endpoint with, of course, username and password, to obtain tokens.
- Client Credentials. This flow also only requires to hit token endpoint but with different parameters. Client credentials flow does not involve an end user hence you won't be able to hit userinfo endpoint with access token obtained.
- PKCE (rfc7636). This is enhancement on top of authorization code flow.
Implicit flow is not supported because it is more for SPA (single page app) and more or less obsolete by Authorization Code flow with PKCE.
Here is quick sample for how to use vocabularies from this new module.
Firstly, initialize your IdP (use google as example) and the application.
data Google = Google deriving (Eq, Show) googleIdp = Idp Google Idp { idpFetchUserInfo = authGetJSON @(IdpUserInfo Google), idpAuthorizeEndpoint = [uri|https://accounts.google.com/o/oauth2/v2/auth|], idpTokenEndpoint = [uri|https://oauth2.googleapis.com/token|], idpUserInfoEndpoint = [uri|https://www.googleapis.com/oauth2/v2/userinfo|] } fooApp :: IdpApplication 'AuthorizationCode Google fooApp = AuthorizationCodeIdpApplication { idpAppClientId = "xxxxx", idpAppClientSecret = "xxxxx", idpAppScope = Set.fromList [ "https://www.googleapis.com/auth/userinfo.email", "https://www.googleapis.com/auth/userinfo.profile" ], idpAppAuthorizeState = "CHANGE_ME", idpAppAuthorizeExtraParams = Map.empty, idpAppRedirectUri = [uri|http://localhost/oauth2/callback|], idpAppName = "default-google-App", idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, idp = googleIdp }
Secondly, construct the authorize URL.
authorizeUrl = mkAuthorizeRequest fooApp
Thirdly, after a successful redirect with authorize code, you could exchange for access token
mgr <- liftIO $ newManager tlsManagerSettings tokenResp <- conduitTokenRequest fooApp mgr authorizeCode
Lastly, you probably like to fetch user info
conduitUserInfoRequest fooApp mgr (accessToken tokenResp)
Also you could find example from hoauth2-providers-tutorials
module.
Synopsis
- data GrantTypeFlow
- class ToResponseTypeValue (a :: GrantTypeFlow) where
- toResponseTypeValue :: IsString b => b
- toResponseTypeParam :: forall a b req. (ToResponseTypeValue a, IsString b) => req a -> Map b b
- newtype UrnOAuthParam a = UrnOAuthParam a
- data GrantTypeValue
- newtype Scope = Scope {}
- newtype ClientId = ClientId {
- unClientId :: Text
- newtype ClientSecret = ClientSecret {}
- toOAuth2Key :: ClientId -> ClientSecret -> OAuth2
- newtype RedirectUri = RedirectUri {
- unRedirectUri :: URI
- newtype AuthorizeState = AuthorizeState {}
- newtype Username = Username {
- unUsername :: Text
- newtype Password = Password {
- unPassword :: Text
- class ToQueryParam a where
- toQueryParam :: a -> Map Text Text
- class HasAuthorizeRequest (a :: GrantTypeFlow) where
- class HasTokenRequest (a :: GrantTypeFlow) where
- data TokenRequest a
- type WithExchangeToken a b
- mkTokenRequest :: IdpApplication a i -> WithExchangeToken a (TokenRequest a)
- conduitTokenRequest :: MonadIO m => IdpApplication a i -> Manager -> WithExchangeToken a (ExceptT TokenRequestError m OAuth2Token)
- class HasPkceAuthorizeRequest (a :: GrantTypeFlow) where
- mkPkceAuthorizeRequest :: MonadIO m => IdpApplication a i -> m (Text, CodeVerifier)
- class HasPkceTokenRequest (b :: GrantTypeFlow) where
- conduitPkceTokenRequest :: MonadIO m => IdpApplication b i -> Manager -> (ExchangeToken, CodeVerifier) -> ExceptT TokenRequestError m OAuth2Token
- class HasRefreshTokenRequest (a :: GrantTypeFlow) where
- data RefreshTokenRequest a
- mkRefreshTokenRequest :: IdpApplication a i -> RefreshToken -> RefreshTokenRequest a
- conduitRefreshTokenRequest :: MonadIO m => IdpApplication a i -> Manager -> RefreshToken -> ExceptT TokenRequestError m OAuth2Token
- type family IdpUserInfo a
- class HasUserInfoRequest (a :: GrantTypeFlow) where
- conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication a i -> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i)
- data Idp a = Idp {
- idpUserInfoEndpoint :: URI
- idpAuthorizeEndpoint :: URI
- idpTokenEndpoint :: URI
- idpFetchUserInfo :: forall m. (FromJSON (IdpUserInfo a), MonadIO m) => Manager -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo a)
- data family IdpApplication (a :: GrantTypeFlow) (i :: Type)
- mkPkceParam :: MonadIO m => m PkceRequestParam
- newtype CodeChallenge = CodeChallenge {}
- newtype CodeVerifier = CodeVerifier {}
- data CodeChallengeMethod = S256
- data PkceRequestParam = PkceRequestParam {}
Grant Type
data GrantTypeFlow Source #
Response Type value
class ToResponseTypeValue (a :: GrantTypeFlow) where Source #
Methods
toResponseTypeValue :: IsString b => b Source #
Instances
ToResponseTypeValue 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toResponseTypeValue :: IsString b => b Source # |
toResponseTypeParam :: forall a b req. (ToResponseTypeValue a, IsString b) => req a -> Map b b Source #
Grant Type value
newtype UrnOAuthParam a Source #
Constructors
UrnOAuthParam a |
data GrantTypeValue Source #
Grant type query parameter has association with GrantTypeFlow
but not completely strict.
e.g. Both AuthorizationCode
and ResourceOwnerPassword
flow could support refresh token flow.
Instances
Show GrantTypeValue Source # | |
Defined in Network.OAuth2.Experiment.Types Methods showsPrec :: Int -> GrantTypeValue -> ShowS # show :: GrantTypeValue -> String # showList :: [GrantTypeValue] -> ShowS # | |
Eq GrantTypeValue Source # | |
Defined in Network.OAuth2.Experiment.Types Methods (==) :: GrantTypeValue -> GrantTypeValue -> Bool # (/=) :: GrantTypeValue -> GrantTypeValue -> Bool # | |
ToQueryParam GrantTypeValue Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toQueryParam :: GrantTypeValue -> Map Text Text Source # |
Scope
Credentials
Constructors
ClientId | |
Fields
|
newtype ClientSecret Source #
Can be either "Client Secret" or JWT base on client authentication method
Constructors
ClientSecret | |
Fields |
Instances
IsString ClientSecret Source # | |
Defined in Network.OAuth2.Experiment.Types Methods fromString :: String -> ClientSecret # | |
Eq ClientSecret Source # | |
Defined in Network.OAuth2.Experiment.Types | |
ToQueryParam ClientSecret Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toQueryParam :: ClientSecret -> Map Text Text Source # |
toOAuth2Key :: ClientId -> ClientSecret -> OAuth2 Source #
In order to reuse some methods from legacy Network.OAuth.OAuth2. Will be removed when Experiment module becomes default.
newtype RedirectUri Source #
Constructors
RedirectUri | |
Fields
|
Instances
Eq RedirectUri Source # | |
Defined in Network.OAuth2.Experiment.Types | |
ToQueryParam RedirectUri Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toQueryParam :: RedirectUri -> Map Text Text Source # |
newtype AuthorizeState Source #
Constructors
AuthorizeState | |
Fields |
Instances
IsString AuthorizeState Source # | |
Defined in Network.OAuth2.Experiment.Types Methods fromString :: String -> AuthorizeState # | |
Eq AuthorizeState Source # | |
Defined in Network.OAuth2.Experiment.Types Methods (==) :: AuthorizeState -> AuthorizeState -> Bool # (/=) :: AuthorizeState -> AuthorizeState -> Bool # | |
ToQueryParam AuthorizeState Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toQueryParam :: AuthorizeState -> Map Text Text Source # |
Constructors
Username | |
Fields
|
Instances
IsString Username Source # | |
Defined in Network.OAuth2.Experiment.Types Methods fromString :: String -> Username # | |
Eq Username Source # | |
ToQueryParam Username Source # | |
Defined in Network.OAuth2.Experiment.Types |
Constructors
Password | |
Fields
|
Instances
IsString Password Source # | |
Defined in Network.OAuth2.Experiment.Types Methods fromString :: String -> Password # | |
Eq Password Source # | |
ToQueryParam Password Source # | |
Defined in Network.OAuth2.Experiment.Types |
Query parameters
class ToQueryParam a where Source #
Instances
Authorization and Token Requests types
class HasAuthorizeRequest (a :: GrantTypeFlow) where Source #
Methods
mkAuthorizeRequestParameter :: IdpApplication a i -> AuthorizationRequest a Source #
mkAuthorizeRequest :: IdpApplication a i -> MkAuthorizationRequestResponse a Source #
Instances
HasAuthorizeRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types Associated Types data AuthorizationRequest 'AuthorizationCode Source # type MkAuthorizationRequestResponse 'AuthorizationCode Source # |
class HasTokenRequest (a :: GrantTypeFlow) where Source #
Associated Types
data TokenRequest a Source #
Each GrantTypeFlow has slightly different request parameter to /token endpoint.
type WithExchangeToken a b Source #
Only 'AuthorizationCode flow (but not resource owner password nor client credentials) will use ExchangeToken
in the token request
create type family to be explicit on it.
with 'type instance WithExchangeToken a b = b' implies no exchange token
v.s. 'type instance WithExchangeToken a b = ExchangeToken -> b' implies needing an exchange token
Methods
mkTokenRequest :: IdpApplication a i -> WithExchangeToken a (TokenRequest a) Source #
conduitTokenRequest :: MonadIO m => IdpApplication a i -> Manager -> WithExchangeToken a (ExceptT TokenRequestError m OAuth2Token) Source #
Instances
class HasPkceAuthorizeRequest (a :: GrantTypeFlow) where Source #
Methods
mkPkceAuthorizeRequest :: MonadIO m => IdpApplication a i -> m (Text, CodeVerifier) Source #
Instances
HasPkceAuthorizeRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types Methods mkPkceAuthorizeRequest :: MonadIO m => IdpApplication 'AuthorizationCode i -> m (Text, CodeVerifier) Source # |
class HasPkceTokenRequest (b :: GrantTypeFlow) where Source #
Methods
conduitPkceTokenRequest :: MonadIO m => IdpApplication b i -> Manager -> (ExchangeToken, CodeVerifier) -> ExceptT TokenRequestError m OAuth2Token Source #
Instances
HasPkceTokenRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types Methods conduitPkceTokenRequest :: forall (m :: Type -> Type) i. MonadIO m => IdpApplication 'AuthorizationCode i -> Manager -> (ExchangeToken, CodeVerifier) -> ExceptT TokenRequestError m OAuth2Token Source # |
class HasRefreshTokenRequest (a :: GrantTypeFlow) where Source #
Methods
mkRefreshTokenRequest :: IdpApplication a i -> RefreshToken -> RefreshTokenRequest a Source #
conduitRefreshTokenRequest :: MonadIO m => IdpApplication a i -> Manager -> RefreshToken -> ExceptT TokenRequestError m OAuth2Token Source #
Instances
HasRefreshTokenRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types Associated Types Methods mkRefreshTokenRequest :: IdpApplication 'AuthorizationCode i -> RefreshToken -> RefreshTokenRequest 'AuthorizationCode Source # conduitRefreshTokenRequest :: forall (m :: Type -> Type) i. MonadIO m => IdpApplication 'AuthorizationCode i -> Manager -> RefreshToken -> ExceptT TokenRequestError m OAuth2Token Source # | |
HasRefreshTokenRequest 'ResourceOwnerPassword Source # | TODO: TBD |
Defined in Network.OAuth2.Experiment.Types Associated Types Methods mkRefreshTokenRequest :: IdpApplication 'ResourceOwnerPassword i -> RefreshToken -> RefreshTokenRequest 'ResourceOwnerPassword Source # conduitRefreshTokenRequest :: forall (m :: Type -> Type) i. MonadIO m => IdpApplication 'ResourceOwnerPassword i -> Manager -> RefreshToken -> ExceptT TokenRequestError m OAuth2Token Source # |
User Info types
type family IdpUserInfo a Source #
class HasUserInfoRequest (a :: GrantTypeFlow) where Source #
Methods
conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication a i -> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i) Source #
Instances
HasUserInfoRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types Methods conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication 'AuthorizationCode i -> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i) Source # | |
HasUserInfoRequest 'JwtBearer Source # | |
Defined in Network.OAuth2.Experiment.Types Methods conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication 'JwtBearer i -> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i) Source # | |
HasUserInfoRequest 'ResourceOwnerPassword Source # | |
Defined in Network.OAuth2.Experiment.Types Methods conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication 'ResourceOwnerPassword i -> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i) Source # |
Idp App
Shall IdpApplication has a field of 'Idp a'??
Constructors
Idp | |
Fields
|
Idp App Config
data family IdpApplication (a :: GrantTypeFlow) (i :: Type) Source #
Instances
data IdpApplication 'AuthorizationCode i Source # | An Application that supports "Authorization code" flow |
Defined in Network.OAuth2.Experiment.Types | |
data IdpApplication 'ClientCredentials i Source # | |
Defined in Network.OAuth2.Experiment.Types | |
data IdpApplication 'JwtBearer i Source # | An Application that supports "Authorization code" flow |
Defined in Network.OAuth2.Experiment.Types data IdpApplication 'JwtBearer i = JwtBearerIdpApplication {
| |
data IdpApplication 'ResourceOwnerPassword i Source # | |
Defined in Network.OAuth2.Experiment.Types |
Authorization Code flow
JWTBearer
Password flow
Client Credentials flow
mkPkceParam :: MonadIO m => m PkceRequestParam Source #
newtype CodeChallenge Source #
Constructors
CodeChallenge | |
Fields |
Instances
ToQueryParam CodeChallenge Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toQueryParam :: CodeChallenge -> Map Text Text Source # |
newtype CodeVerifier Source #
Constructors
CodeVerifier | |
Fields |
Instances
Show CodeVerifier Source # | |
Defined in Network.OAuth2.Experiment.Pkce Methods showsPrec :: Int -> CodeVerifier -> ShowS # show :: CodeVerifier -> String # showList :: [CodeVerifier] -> ShowS # | |
ToQueryParam CodeVerifier Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toQueryParam :: CodeVerifier -> Map Text Text Source # |
data CodeChallengeMethod Source #
Constructors
S256 |
Instances
Show CodeChallengeMethod Source # | |
Defined in Network.OAuth2.Experiment.Pkce Methods showsPrec :: Int -> CodeChallengeMethod -> ShowS # show :: CodeChallengeMethod -> String # showList :: [CodeChallengeMethod] -> ShowS # | |
ToQueryParam CodeChallengeMethod Source # | |
Defined in Network.OAuth2.Experiment.Types Methods toQueryParam :: CodeChallengeMethod -> Map Text Text Source # |
data PkceRequestParam Source #
Constructors
PkceRequestParam | |
Fields
|