Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
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
- 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 HasIdpAppName (a :: GrantTypeFlow) where
- getIdpAppName :: IdpApplication a i -> 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 (OAuth2Error Errors) 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 (OAuth2Error Errors) 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 (OAuth2Error Errors) 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)
Grant Type
Response Type value
class ToResponseTypeValue (a :: GrantTypeFlow) where Source #
toResponseTypeValue :: IsString b => b Source #
Instances
ToResponseTypeValue 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types toResponseTypeValue :: IsString b => b Source # |
toResponseTypeParam :: forall a b req. (ToResponseTypeValue a, IsString b) => req a -> Map b b Source #
Grant Type value
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 showsPrec :: Int -> GrantTypeValue -> ShowS # show :: GrantTypeValue -> String # showList :: [GrantTypeValue] -> ShowS # | |
Eq GrantTypeValue Source # | |
Defined in Network.OAuth2.Experiment.Types (==) :: GrantTypeValue -> GrantTypeValue -> Bool # (/=) :: GrantTypeValue -> GrantTypeValue -> Bool # | |
ToQueryParam GrantTypeValue Source # | |
Defined in Network.OAuth2.Experiment.Types toQueryParam :: GrantTypeValue -> Map Text Text Source # |
Scope
Credentials
newtype ClientSecret Source #
Instances
IsString ClientSecret Source # | |
Defined in Network.OAuth2.Experiment.Types fromString :: String -> ClientSecret # | |
Eq ClientSecret Source # | |
Defined in Network.OAuth2.Experiment.Types (==) :: ClientSecret -> ClientSecret -> Bool # (/=) :: ClientSecret -> ClientSecret -> Bool # | |
ToQueryParam ClientSecret Source # | |
Defined in Network.OAuth2.Experiment.Types 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 #
Instances
Eq RedirectUri Source # | |
Defined in Network.OAuth2.Experiment.Types (==) :: RedirectUri -> RedirectUri -> Bool # (/=) :: RedirectUri -> RedirectUri -> Bool # | |
ToQueryParam RedirectUri Source # | |
Defined in Network.OAuth2.Experiment.Types toQueryParam :: RedirectUri -> Map Text Text Source # |
newtype AuthorizeState Source #
Instances
IsString AuthorizeState Source # | |
Defined in Network.OAuth2.Experiment.Types fromString :: String -> AuthorizeState # | |
Eq AuthorizeState Source # | |
Defined in Network.OAuth2.Experiment.Types (==) :: AuthorizeState -> AuthorizeState -> Bool # (/=) :: AuthorizeState -> AuthorizeState -> Bool # | |
ToQueryParam AuthorizeState Source # | |
Defined in Network.OAuth2.Experiment.Types toQueryParam :: AuthorizeState -> Map Text Text Source # |
Instances
IsString Username Source # | |
Defined in Network.OAuth2.Experiment.Types fromString :: String -> Username # | |
Eq Username Source # | |
ToQueryParam Username Source # | |
Defined in Network.OAuth2.Experiment.Types |
Instances
IsString Password Source # | |
Defined in Network.OAuth2.Experiment.Types 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 HasIdpAppName (a :: GrantTypeFlow) where Source #
getIdpAppName :: IdpApplication a i -> Text Source #
Instances
HasIdpAppName 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types getIdpAppName :: IdpApplication 'AuthorizationCode i -> Text Source # | |
HasIdpAppName 'ClientCredentials Source # | |
Defined in Network.OAuth2.Experiment.Types getIdpAppName :: IdpApplication 'ClientCredentials i -> Text Source # | |
HasIdpAppName 'ResourceOwnerPassword Source # | |
Defined in Network.OAuth2.Experiment.Types |
class HasAuthorizeRequest (a :: GrantTypeFlow) where Source #
data AuthorizationRequest a Source #
mkAuthorizeRequestParameter :: IdpApplication a i -> AuthorizationRequest a Source #
mkAuthorizeRequest :: IdpApplication a i -> MkAuthorizationRequestResponse a Source #
Instances
class HasTokenRequest (a :: GrantTypeFlow) where Source #
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
mkTokenRequest :: IdpApplication a i -> WithExchangeToken a (TokenRequest a) Source #
conduitTokenRequest :: MonadIO m => IdpApplication a i -> Manager -> WithExchangeToken a (ExceptT (OAuth2Error Errors) m OAuth2Token) Source #
Instances
class HasPkceAuthorizeRequest (a :: GrantTypeFlow) where Source #
mkPkceAuthorizeRequest :: MonadIO m => IdpApplication a i -> m (Text, CodeVerifier) Source #
Instances
HasPkceAuthorizeRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types mkPkceAuthorizeRequest :: MonadIO m => IdpApplication 'AuthorizationCode i -> m (Text, CodeVerifier) Source # |
class HasPkceTokenRequest (b :: GrantTypeFlow) where Source #
conduitPkceTokenRequest :: MonadIO m => IdpApplication b i -> Manager -> (ExchangeToken, CodeVerifier) -> ExceptT (OAuth2Error Errors) m OAuth2Token Source #
Instances
HasPkceTokenRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types conduitPkceTokenRequest :: forall (m :: Type -> Type) i. MonadIO m => IdpApplication 'AuthorizationCode i -> Manager -> (ExchangeToken, CodeVerifier) -> ExceptT (OAuth2Error Errors) m OAuth2Token Source # |
class HasRefreshTokenRequest (a :: GrantTypeFlow) where Source #
mkRefreshTokenRequest :: IdpApplication a i -> RefreshToken -> RefreshTokenRequest a Source #
conduitRefreshTokenRequest :: MonadIO m => IdpApplication a i -> Manager -> RefreshToken -> ExceptT (OAuth2Error Errors) m OAuth2Token Source #
Instances
HasRefreshTokenRequest 'AuthorizationCode Source # | |
Defined in Network.OAuth2.Experiment.Types mkRefreshTokenRequest :: IdpApplication 'AuthorizationCode i -> RefreshToken -> RefreshTokenRequest 'AuthorizationCode Source # conduitRefreshTokenRequest :: forall (m :: Type -> Type) i. MonadIO m => IdpApplication 'AuthorizationCode i -> Manager -> RefreshToken -> ExceptT (OAuth2Error Errors) m OAuth2Token Source # | |
HasRefreshTokenRequest 'ResourceOwnerPassword Source # | TODO: TBD |
Defined in Network.OAuth2.Experiment.Types mkRefreshTokenRequest :: IdpApplication 'ResourceOwnerPassword i -> RefreshToken -> RefreshTokenRequest 'ResourceOwnerPassword Source # conduitRefreshTokenRequest :: forall (m :: Type -> Type) i. MonadIO m => IdpApplication 'ResourceOwnerPassword i -> Manager -> RefreshToken -> ExceptT (OAuth2Error Errors) m OAuth2Token Source # |
User Info types
type family IdpUserInfo a Source #
class HasUserInfoRequest (a :: GrantTypeFlow) where Source #
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 conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication 'AuthorizationCode i -> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i) Source # | |
HasUserInfoRequest 'ResourceOwnerPassword Source # | |
Defined in Network.OAuth2.Experiment.Types 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'??
Idp | |
|
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 'ResourceOwnerPassword i Source # | |
Defined in Network.OAuth2.Experiment.Types |