hoauth2-2.8.0/0000755000000000000000000000000007346545000011264 5ustar0000000000000000hoauth2-2.8.0/LICENSE0000644000000000000000000000205407346545000012272 0ustar0000000000000000MIT License Copyright (c) 2022 Haisheng Wu Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hoauth2-2.8.0/README.org0000644000000000000000000000103107346545000012725 0ustar0000000000000000* Introduction Haskell binding for - [[https://datatracker.ietf.org/doc/html/rfc6749][The OAuth 2.0 Authorization Framework]] - If the Identity Provider also implements [[https://openid.net/specs/openid-connect-core-1_0.html][OIDC spec]], ID Token will also be present in token response (see ~OAuth2Token~). - [[https://www.rfc-editor.org/rfc/rfc7523.html][JWT Profile for OAuth2 Client Authentication and Authorization Grants]] - [[https://www.rfc-editor.org/rfc/rfc6750][The OAuth 2.0 Authorization Framework: Bearer Token Usage]] hoauth2-2.8.0/hoauth2.cabal0000644000000000000000000000512707346545000013627 0ustar0000000000000000cabal-version: 2.4 name: hoauth2 -- http://wiki.haskell.org/Package_versioning_policy version: 2.8.0 synopsis: Haskell OAuth2 authentication client description: See readme for more details. homepage: https://github.com/freizl/hoauth2 license: MIT license-file: LICENSE author: Haisheng Wu maintainer: Haisheng Wu copyright: Haisheng Wu category: Network build-type: Simple stability: Beta tested-with: GHC <=9.2.2 extra-source-files: README.org source-repository head type: git location: git://github.com/freizl/hoauth2.git library hs-source-dirs: src default-language: Haskell2010 autogen-modules: Paths_hoauth2 other-modules: Network.OAuth.OAuth2.Internal Network.OAuth2.Experiment.Pkce Network.OAuth2.Experiment.Types Network.OAuth2.Experiment.Utils Paths_hoauth2 exposed-modules: Network.OAuth.OAuth2 Network.OAuth.OAuth2.AuthorizationRequest Network.OAuth.OAuth2.HttpClient Network.OAuth.OAuth2.TokenRequest Network.OAuth2.Experiment default-extensions: DataKinds DeriveGeneric GeneralizedNewtypeDeriving ImportQualifiedPost OverloadedStrings RecordWildCards TypeApplications TypeFamilies build-depends: , aeson >=2.0 && <2.2 , base >=4 && <5 , base64 ^>=0.4 , binary ^>=0.8 , bytestring >=0.9 && <0.12 , containers ^>=0.6 , cryptonite ^>=0.30 , data-default ^>=0.7 , exceptions >=0.8.3 && <0.11 , http-conduit >=2.1 && <2.4 , http-types >=0.11 && <0.13 , memory ^>=0.18 , microlens ^>=0.4.0 , text ^>=2.0 , transformers ^>=0.5 , uri-bytestring >=0.2.3 && <0.4 , uri-bytestring-aeson ^>=0.1 ghc-options: -Wall -Wtabs -Wno-unused-do-bind -Wunused-packages -Wpartial-fields -Wwarnings-deprecations test-suite hoauth-tests type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test ghc-options: -Wall build-depends: , aeson >=2.0 && <2.2 , base >=4 && <5 , hoauth2 , hspec >=2 && <3 other-modules: Network.OAuth.OAuth2.TokenRequestSpec default-language: Haskell2010 default-extensions: ImportQualifiedPost OverloadedStrings build-tool-depends: hspec-discover:hspec-discover >=2 && <3 hoauth2-2.8.0/src/Network/OAuth/0000755000000000000000000000000007346545000014524 5ustar0000000000000000hoauth2-2.8.0/src/Network/OAuth/OAuth2.hs0000644000000000000000000000110107346545000016153 0ustar0000000000000000-- | A lightweight oauth2 Haskell binding. -- See Readme for more details module Network.OAuth.OAuth2 ( module Network.OAuth.OAuth2.HttpClient, module Network.OAuth.OAuth2.AuthorizationRequest, module Network.OAuth.OAuth2.TokenRequest, module Network.OAuth.OAuth2.Internal, ) where {- Hiding Errors data type from default. Shall qualified import given the naming collision. -} import Network.OAuth.OAuth2.AuthorizationRequest hiding (Errors (..)) import Network.OAuth.OAuth2.HttpClient import Network.OAuth.OAuth2.Internal import Network.OAuth.OAuth2.TokenRequest hoauth2-2.8.0/src/Network/OAuth/OAuth2/0000755000000000000000000000000007346545000015626 5ustar0000000000000000hoauth2-2.8.0/src/Network/OAuth/OAuth2/AuthorizationRequest.hs0000644000000000000000000000417107346545000022376 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -- | Bindings Authorization part of The OAuth 2.0 Authorization Framework -- RFC6749 module Network.OAuth.OAuth2.AuthorizationRequest where import Data.Aeson import Data.Function (on) import Data.List qualified as List import Data.Text.Encoding qualified as T import GHC.Generics (Generic) import Lens.Micro (over) import Network.OAuth.OAuth2.Internal import URI.ByteString -------------------------------------------------- -- * Errors -------------------------------------------------- instance FromJSON Errors where parseJSON = genericParseJSON defaultOptions {constructorTagModifier = camelTo2 '_'} -- | Authorization Code Grant Error Responses https://tools.ietf.org/html/rfc6749#section-4.1.2.1 -- I found hard time to figure a way to test the authorization error flow -- When anything wrong in @/authorize@ request, it will stuck at the Provider page -- hence no way for this library to parse error response. -- In other words, @/authorize@ ends up with 4xx or 5xx. -- Revisit this whenever find a case OAuth2 provider redirects back to Relying party with errors. data Errors = InvalidRequest | UnauthorizedClient | AccessDenied | UnsupportedResponseType | InvalidScope | ServerError | TemporarilyUnavailable deriving (Show, Eq, Generic) -------------------------------------------------- -- * URLs -------------------------------------------------- -- | See 'authorizationUrlWithParams' authorizationUrl :: OAuth2 -> URI authorizationUrl = authorizationUrlWithParams [] -- | Prepare the authorization URL. Redirect to this URL -- asking for user interactive authentication. -- -- @since 2.6.0 authorizationUrlWithParams :: QueryParams -> OAuth2 -> URI authorizationUrlWithParams qs oa = over (queryL . queryPairsL) (++ queryParts) (oauth2AuthorizeEndpoint oa) where queryParts = List.nubBy ((==) `on` fst) $ qs ++ [ ("client_id", T.encodeUtf8 $ oauth2ClientId oa) , ("response_type", "code") , ("redirect_uri", serializeURIRef' $ oauth2RedirectUri oa) ] hoauth2-2.8.0/src/Network/OAuth/OAuth2/HttpClient.hs0000644000000000000000000002477507346545000020257 0ustar0000000000000000{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -- | Bindings for The OAuth 2.0 Authorization Framework: Bearer Token Usage -- RFC6750 module Network.OAuth.OAuth2.HttpClient ( -- * AUTH requests authGetJSON, authGetBS, authGetBS2, authGetJSONWithAuthMethod, authGetJSONInternal, authGetBSWithAuthMethod, authGetBSInternal, authPostJSON, authPostBS, authPostBS2, authPostBS3, authPostJSONWithAuthMethod, authPostJSONInternal, authPostBSWithAuthMethod, authPostBSInternal, -- * Types APIAuthenticationMethod (..), ) where import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT (..), throwE) import Data.Aeson (FromJSON, eitherDecode) import Data.ByteString.Char8 qualified as BS import Data.ByteString.Lazy.Char8 qualified as BSL import Data.Maybe (fromJust, isJust) import Data.Text.Encoding qualified as T import Lens.Micro (over) import Network.HTTP.Conduit import Network.HTTP.Types qualified as HT import Network.OAuth.OAuth2.Internal import URI.ByteString (URI, URIRef, queryL, queryPairsL) -------------------------------------------------- -- * AUTH requests -- Making request with Access Token appended to Header, Request body or query string. -- -------------------------------------------------- -- | Conduct an authorized GET request and return response as JSON. -- Inject Access Token to Authorization Header. authGetJSON :: (FromJSON a, MonadIO m) => -- | HTTP connection manager. Manager -> AccessToken -> URI -> -- | Response as JSON ExceptT BSL.ByteString m a authGetJSON = authGetJSONWithAuthMethod AuthInRequestHeader authGetJSONInternal :: (FromJSON a, MonadIO m) => APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> -- | Response as JSON ExceptT BSL.ByteString m a authGetJSONInternal = authGetJSONWithAuthMethod {-# DEPRECATED authGetJSONInternal "use authGetJSONWithAuthMethod" #-} -- | Conduct an authorized GET request and return response as JSON. -- Allow to specify how to append AccessToken. -- -- @since 2.6.0 authGetJSONWithAuthMethod :: (MonadIO m, FromJSON a) => APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> -- | Response as JSON ExceptT BSL.ByteString m a authGetJSONWithAuthMethod authTypes manager t uri = do resp <- authGetBSWithAuthMethod authTypes manager t uri either (throwE . BSL.pack) return (eitherDecode resp) -- | Conduct an authorized GET request. -- Inject Access Token to Authorization Header. authGetBS :: (MonadIO m) => -- | HTTP connection manager. Manager -> AccessToken -> URI -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authGetBS = authGetBSWithAuthMethod AuthInRequestHeader -- | Same to 'authGetBS' but set access token to query parameter rather than header authGetBS2 :: (MonadIO m) => -- | HTTP connection manager. Manager -> AccessToken -> URI -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authGetBS2 = authGetBSWithAuthMethod AuthInRequestQuery {-# DEPRECATED authGetBS2 "use authGetBSWithAuthMethod" #-} authGetBSInternal :: (MonadIO m) => APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authGetBSInternal = authGetBSWithAuthMethod {-# DEPRECATED authGetBSInternal "use authGetBSWithAuthMethod" #-} -- | Conduct an authorized GET request and return response as ByteString. -- Allow to specify how to append AccessToken. -- -- @since 2.6.0 authGetBSWithAuthMethod :: (MonadIO m) => -- | Specify the way that how to append the 'AccessToken' in the request APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authGetBSWithAuthMethod authTypes manager token url = do let appendToUrl = AuthInRequestQuery == authTypes let appendToHeader = AuthInRequestHeader == authTypes let uri = if appendToUrl then url `appendAccessToken` token else url let upReq = updateRequestHeaders (if appendToHeader then Just token else Nothing) . setMethod HT.GET req <- liftIO $ uriToRequest uri authRequest req upReq manager -- | Conduct POST request and return response as JSON. -- Inject Access Token to Authorization Header. authPostJSON :: (FromJSON a, MonadIO m) => -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as JSON ExceptT BSL.ByteString m a authPostJSON = authPostJSONWithAuthMethod AuthInRequestHeader authPostJSONInternal :: (FromJSON a, MonadIO m) => APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as ByteString ExceptT BSL.ByteString m a authPostJSONInternal = authPostJSONWithAuthMethod {-# DEPRECATED authPostJSONInternal "use 'authPostJSONWithAuthMethod'" #-} -- | Conduct POST request and return response as JSON. -- Allow to specify how to append AccessToken. -- -- @since 2.6.0 authPostJSONWithAuthMethod :: (FromJSON a, MonadIO m) => APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as ByteString ExceptT BSL.ByteString m a authPostJSONWithAuthMethod authTypes manager token url body = do resp <- authPostBSWithAuthMethod authTypes manager token url body either (throwE . BSL.pack) return (eitherDecode resp) -- | Conduct POST request. -- Inject Access Token to http header (Authorization) authPostBS :: (MonadIO m) => -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authPostBS = authPostBSWithAuthMethod AuthInRequestHeader -- | Conduct POST request with access token only in the request body but header. authPostBS2 :: (MonadIO m) => -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authPostBS2 = authPostBSWithAuthMethod AuthInRequestBody {-# DEPRECATED authPostBS2 "use 'authPostBSWithAuthMethod'" #-} -- | Conduct POST request with access token only in the header and not in body authPostBS3 :: (MonadIO m) => -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authPostBS3 = authPostBSWithAuthMethod AuthInRequestHeader {-# DEPRECATED authPostBS3 "use 'authPostBSWithAuthMethod'" #-} authPostBSInternal :: (MonadIO m) => APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authPostBSInternal = authPostBSWithAuthMethod {-# DEPRECATED authPostBSInternal "use 'authPostBSWithAuthMethod'" #-} -- | Conduct POST request and return response as ByteString. -- Allow to specify how to append AccessToken. -- -- @since 2.6.0 authPostBSWithAuthMethod :: (MonadIO m) => APIAuthenticationMethod -> -- | HTTP connection manager. Manager -> AccessToken -> URI -> PostBody -> -- | Response as ByteString ExceptT BSL.ByteString m BSL.ByteString authPostBSWithAuthMethod authTypes manager token url body = do let appendToBody = AuthInRequestBody == authTypes let appendToHeader = AuthInRequestHeader == authTypes let reqBody = if appendToBody then body ++ accessTokenToParam token else body -- TODO: urlEncodedBody send request as 'application/x-www-form-urlencoded' -- seems shall go with application/json which is more common? let upBody = if null reqBody then id else urlEncodedBody reqBody let upHeaders = updateRequestHeaders (if appendToHeader then Just token else Nothing) . setMethod HT.POST let upReq = upHeaders . upBody req <- liftIO $ uriToRequest url authRequest req upReq manager -------------------------------------------------- -- * Types -------------------------------------------------- -- | https://www.rfc-editor.org/rfc/rfc6750#section-2 data APIAuthenticationMethod = -- | Provides in Authorization header AuthInRequestHeader | -- | Provides in request body AuthInRequestBody | -- | Provides in request query parameter AuthInRequestQuery deriving (Eq, Ord) -------------------------------------------------- -- * Utilities -------------------------------------------------- -- | Send an HTTP request. authRequest :: (MonadIO m) => -- | Request to perform Request -> -- | Modify request before sending (Request -> Request) -> -- | HTTP connection manager. Manager -> ExceptT BSL.ByteString m BSL.ByteString authRequest req upReq manage = ExceptT $ do resp <- httpLbs (upReq req) manage pure (handleResponse resp) -- | Get response body out of a @Response@ handleResponse :: Response BSL.ByteString -> Either BSL.ByteString BSL.ByteString handleResponse rsp | HT.statusIsSuccessful (responseStatus rsp) = Right (responseBody rsp) -- FIXME: better to surface up entire resp so that client can decide what to do when error happens. -- e.g. when 404, the response body could be empty hence library user has no idea what's happening. -- Which will be breaking changes. -- The current work around is surface up entire response as string. | BSL.null (responseBody rsp) = Left (BSL.pack $ show rsp) | otherwise = Left (responseBody rsp) -- | Set several header values: -- + userAgennt : `hoauth2` -- + accept : `application/json` -- + authorization : 'Bearer' `xxxxx` if 'AccessToken' provided. updateRequestHeaders :: Maybe AccessToken -> Request -> Request updateRequestHeaders t req = let bearer = [(HT.hAuthorization, "Bearer " `BS.append` T.encodeUtf8 (atoken (fromJust t))) | isJust t] headers = bearer ++ defaultRequestHeaders ++ requestHeaders req in req {requestHeaders = headers} -- | Set the HTTP method to use. setMethod :: HT.StdMethod -> Request -> Request setMethod m req = req {method = HT.renderStdMethod m} -- | For `GET` method API. appendAccessToken :: -- | Base URI URIRef a -> -- | Authorized Access Token AccessToken -> -- | Combined Result URIRef a appendAccessToken uri t = over (queryL . queryPairsL) (\query -> query ++ accessTokenToParam t) uri -- | Create 'QueryParams' with given access token value. accessTokenToParam :: AccessToken -> [(BS.ByteString, BS.ByteString)] accessTokenToParam t = [("access_token", T.encodeUtf8 $ atoken t)] hoauth2-2.8.0/src/Network/OAuth/OAuth2/Internal.hs0000644000000000000000000001366607346545000017752 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} module Network.OAuth.OAuth2.Internal where import Control.Arrow (second) import Control.Monad.Catch import Data.Aeson import Data.Aeson.Types (Parser, explicitParseFieldMaybe) import Data.Binary (Binary) import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as BS8 import Data.Default import Data.Maybe import Data.Text (Text, unpack) import Data.Version (showVersion) import GHC.Generics import Lens.Micro import Lens.Micro.Extras import Network.HTTP.Conduit as C import Network.HTTP.Types qualified as H import Network.HTTP.Types qualified as HT import Paths_hoauth2 (version) import URI.ByteString import URI.ByteString.Aeson () import URI.ByteString.QQ -------------------------------------------------- -- * Data Types -------------------------------------------------- -- | Query Parameter Representation data OAuth2 = OAuth2 { oauth2ClientId :: Text , oauth2ClientSecret :: Text , oauth2AuthorizeEndpoint :: URIRef Absolute , oauth2TokenEndpoint :: URIRef Absolute , oauth2RedirectUri :: URIRef Absolute } deriving (Show, Eq) instance Default OAuth2 where def = OAuth2 { oauth2ClientId = "" , oauth2ClientSecret = "" , oauth2AuthorizeEndpoint = [uri|https://www.example.com/|] , oauth2TokenEndpoint = [uri|https://www.example.com/|] , oauth2RedirectUri = [uri|https://www.example.com/|] } newtype AccessToken = AccessToken {atoken :: Text} deriving (Binary, Eq, Show, FromJSON, ToJSON) newtype RefreshToken = RefreshToken {rtoken :: Text} deriving (Binary, Eq, Show, FromJSON, ToJSON) newtype IdToken = IdToken {idtoken :: Text} deriving (Binary, Eq, Show, FromJSON, ToJSON) -- | Authorization Code newtype ExchangeToken = ExchangeToken {extoken :: Text} deriving (Show, FromJSON, ToJSON) -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.1.4 data OAuth2Token = OAuth2Token { accessToken :: AccessToken , refreshToken :: Maybe RefreshToken -- ^ Exists when @offline_access@ scope is in the 'authorizeUrl' and the provider supports Refresh Access Token. , expiresIn :: Maybe Int , tokenType :: Maybe Text -- ^ See https://www.rfc-editor.org/rfc/rfc6749#section-5.1. It's required per spec. But OAuth2 provider implementation are vary. Maybe will remove 'Maybe' in future release. , idToken :: Maybe IdToken -- ^ Exists when @openid@ scope is in the 'authorizeUrl' and the provider supports OpenID. } deriving (Eq, Show, Generic) instance Binary OAuth2Token -- | Parse JSON data into 'OAuth2Token' instance FromJSON OAuth2Token where parseJSON = withObject "OAuth2Token" $ \v -> OAuth2Token <$> v .: "access_token" <*> v .:? "refresh_token" <*> explicitParseFieldMaybe parseIntFlexible v "expires_in" <*> v .:? "token_type" <*> v .:? "id_token" where parseIntFlexible :: Value -> Parser Int parseIntFlexible (String s) = pure . read $ unpack s parseIntFlexible v = parseJSON v instance ToJSON OAuth2Token where toJSON = genericToJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} toEncoding = genericToEncoding defaultOptions {fieldLabelModifier = camelTo2 '_'} -- | https://www.rfc-editor.org/rfc/rfc6749#section-2.3 -- According to spec: -- -- The client MUST NOT use more than one authentication method in each request. -- -- Which means use Authorization header or Post body. -- -- However, in reality, I always have to include authentication in the header. -- -- In other words, 'ClientSecrectBasic' is always assured. 'ClientSecretPost' is optional. -- -- Maybe consider an alternative implementation that boolean kind of data type is good enough. data ClientAuthenticationMethod = ClientSecretBasic | ClientSecretPost | ClientAssertionJwt deriving (Eq, Ord) -------------------------------------------------- -- * Types Synonym -------------------------------------------------- -- | type synonym of post body content type PostBody = [(BS.ByteString, BS.ByteString)] type QueryParams = [(BS.ByteString, BS.ByteString)] -------------------------------------------------- -- * Utilies -------------------------------------------------- defaultRequestHeaders :: [(HT.HeaderName, BS.ByteString)] defaultRequestHeaders = [ (HT.hUserAgent, "hoauth2-" <> BS8.pack (showVersion version)) , (HT.hAccept, "application/json") ] appendQueryParams :: [(BS.ByteString, BS.ByteString)] -> URIRef a -> URIRef a appendQueryParams params = over (queryL . queryPairsL) (params ++) uriToRequest :: MonadThrow m => URI -> m Request uriToRequest auri = do ssl <- case view (uriSchemeL . schemeBSL) auri of "http" -> return False "https" -> return True s -> throwM $ InvalidUrlException (show auri) ("Invalid scheme: " ++ show s) let query = fmap (second Just) (view (queryL . queryPairsL) auri) hostL = authorityL . _Just . authorityHostL . hostBSL portL = authorityL . _Just . authorityPortL . _Just . portNumberL defaultPort = (if ssl then 443 else 80) :: Int req = setQueryString query $ defaultRequest { secure = ssl , path = view pathL auri } req2 = (over hostLens . maybe id const . preview hostL) auri req req3 = (over portLens . (const . fromMaybe defaultPort) . preview portL) auri req2 return req3 requestToUri :: Request -> URI requestToUri req = URI ( Scheme ( if secure req then "https" else "http" ) ) (Just (Authority Nothing (Host $ host req) (Just $ Port $ port req))) (path req) (Query $ H.parseSimpleQuery $ queryString req) Nothing hostLens :: Lens' Request BS.ByteString hostLens f req = f (C.host req) <&> \h' -> req {C.host = h'} {-# INLINE hostLens #-} portLens :: Lens' Request Int portLens f req = f (C.port req) <&> \p' -> req {C.port = p'} {-# INLINE portLens #-} hoauth2-2.8.0/src/Network/OAuth/OAuth2/TokenRequest.hs0000644000000000000000000002533007346545000020616 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Bindings Access Token and Refresh Token part of The OAuth 2.0 Authorization Framework -- RFC6749 module Network.OAuth.OAuth2.TokenRequest where import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT (..), throwE) import Data.Aeson import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Lazy.Char8 qualified as BSL import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T import GHC.Generics (Generic) import Network.HTTP.Conduit import Network.HTTP.Types qualified as HT import Network.HTTP.Types.URI (parseQuery) import Network.OAuth.OAuth2.Internal import URI.ByteString -------------------------------------------------- -- * Token Request Errors -------------------------------------------------- data TokenRequestError = TokenRequestError { error :: TokenRequestErrorCode , errorDescription :: Maybe Text , errorUri :: Maybe (URIRef Absolute) } deriving (Show, Eq, Generic) -- | Token Error Responses https://tools.ietf.org/html/rfc6749#section-5.2 data TokenRequestErrorCode = InvalidRequest | InvalidClient | InvalidGrant | UnauthorizedClient | UnsupportedGrantType | InvalidScope | UnknownErrorCode Text deriving (Show, Eq) instance FromJSON TokenRequestErrorCode where parseJSON = withText "parseJSON TokenRequestErrorCode" $ \t -> pure $ case t of "invalid_request" -> InvalidRequest "invalid_client" -> InvalidClient "invalid_grant" -> InvalidGrant "unauthorized_client" -> UnauthorizedClient "unsupported_grant_type" -> UnsupportedGrantType "invalid_scope" -> InvalidScope _ -> UnknownErrorCode t instance FromJSON TokenRequestError where parseJSON = genericParseJSON defaultOptions {constructorTagModifier = camelTo2 '_'} parseTokeRequestError :: BSL.ByteString -> TokenRequestError parseTokeRequestError string = either (mkDecodeOAuth2Error string) id (eitherDecode string) where mkDecodeOAuth2Error :: BSL.ByteString -> String -> TokenRequestError mkDecodeOAuth2Error response err = TokenRequestError (UnknownErrorCode "") (Just $ T.pack $ "Decode TokenRequestError failed: " <> err <> "\n Original Response:\n" <> show (T.decodeUtf8 $ BSL.toStrict response)) Nothing -------------------------------------------------- -- * URL -------------------------------------------------- -- | Prepare the URL and the request body query for fetching an access token. accessTokenUrl :: OAuth2 -> -- | access code gained via authorization URL ExchangeToken -> -- | access token request URL plus the request body. (URI, PostBody) accessTokenUrl oa code = let uri = oauth2TokenEndpoint oa body = [ ("code", T.encodeUtf8 $ extoken code) , ("redirect_uri", serializeURIRef' $ oauth2RedirectUri oa) , ("grant_type", "authorization_code") ] in (uri, body) -- | Obtain a new access token by sending a Refresh Token to the Authorization server. refreshAccessTokenUrl :: OAuth2 -> -- | Refresh Token gained via authorization URL RefreshToken -> -- | Refresh Token request URL plus the request body. (URI, PostBody) refreshAccessTokenUrl oa token = (uri, body) where uri = oauth2TokenEndpoint oa body = [ ("grant_type", "refresh_token") , ("refresh_token", T.encodeUtf8 $ rtoken token) ] -------------------------------------------------- -- * Token management -------------------------------------------------- -- | Exchange @code@ for an Access Token with authenticate in request header. fetchAccessToken :: (MonadIO m) => -- | HTTP connection manager Manager -> -- | OAuth Data OAuth2 -> -- | OAuth2 Code ExchangeToken -> -- | Access Token ExceptT TokenRequestError m OAuth2Token fetchAccessToken = fetchAccessTokenWithAuthMethod ClientSecretBasic fetchAccessToken2 :: (MonadIO m) => -- | HTTP connection manager Manager -> -- | OAuth Data OAuth2 -> -- | Authorization Code ExchangeToken -> -- | Access Token ExceptT TokenRequestError m OAuth2Token fetchAccessToken2 = fetchAccessTokenWithAuthMethod ClientSecretPost {-# DEPRECATED fetchAccessToken2 "use 'fetchAccessTokenWithAuthMethod'" #-} fetchAccessTokenInternal :: (MonadIO m) => ClientAuthenticationMethod -> -- | HTTP connection manager Manager -> -- | OAuth Data OAuth2 -> -- | Authorization Code ExchangeToken -> -- | Access Token ExceptT TokenRequestError m OAuth2Token fetchAccessTokenInternal = fetchAccessTokenWithAuthMethod {-# DEPRECATED fetchAccessTokenInternal "use 'fetchAccessTokenWithAuthMethod'" #-} -- | Exchange @code@ for an Access Token -- -- OAuth2 spec allows credential (`client_id`, `client_secret`) to be sent -- either in the header (a.k.a 'ClientSecretBasic'). -- or as form/url params (a.k.a 'ClientSecretPost'). -- -- The OAuth provider can choose to implement only one, or both. -- Look for API document from the OAuth provider you're dealing with. -- If you're uncertain, try 'fetchAccessToken' which sends credential -- in authorization http header, which is common case. -- -- @since 2.6.0 fetchAccessTokenWithAuthMethod :: (MonadIO m) => ClientAuthenticationMethod -> -- | HTTP connection manager Manager -> -- | OAuth Data OAuth2 -> -- | Authorization Code ExchangeToken -> -- | Access Token ExceptT TokenRequestError m OAuth2Token fetchAccessTokenWithAuthMethod authMethod manager oa code = do let (uri, body) = accessTokenUrl oa code let extraBody = if authMethod == ClientSecretPost then clientSecretPost oa else [] doJSONPostRequest manager oa uri (body ++ extraBody) -- | Fetch a new AccessToken using the Refresh Token with authentication in request header. refreshAccessToken :: (MonadIO m) => -- | HTTP connection manager. Manager -> -- | OAuth context OAuth2 -> -- | Refresh Token gained after authorization RefreshToken -> ExceptT TokenRequestError m OAuth2Token refreshAccessToken = refreshAccessTokenWithAuthMethod ClientSecretBasic refreshAccessToken2 :: (MonadIO m) => -- | HTTP connection manager. Manager -> -- | OAuth context OAuth2 -> -- | Refresh Token gained after authorization RefreshToken -> ExceptT TokenRequestError m OAuth2Token refreshAccessToken2 = refreshAccessTokenWithAuthMethod ClientSecretPost {-# DEPRECATED refreshAccessToken2 "use 'refreshAccessTokenWithAuthMethod'" #-} refreshAccessTokenInternal :: (MonadIO m) => ClientAuthenticationMethod -> -- | HTTP connection manager. Manager -> -- | OAuth context OAuth2 -> -- | Refresh Token gained after authorization RefreshToken -> ExceptT TokenRequestError m OAuth2Token refreshAccessTokenInternal = refreshAccessTokenWithAuthMethod {-# DEPRECATED refreshAccessTokenInternal "use 'refreshAccessTokenWithAuthMethod'" #-} -- | Fetch a new AccessToken using the Refresh Token. -- -- OAuth2 spec allows credential (`client_id`, `client_secret`) to be sent -- either in the header (a.k.a 'ClientSecretBasic'). -- or as form/url params (a.k.a 'ClientSecretPost'). -- -- The OAuth provider can choose to implement only one, or both. -- Look for API document from the OAuth provider you're dealing with. -- If you're uncertain, try 'refreshAccessToken' which sends credential -- in authorization http header, which is common case. -- -- @since 2.6.0 refreshAccessTokenWithAuthMethod :: (MonadIO m) => ClientAuthenticationMethod -> -- | HTTP connection manager. Manager -> -- | OAuth context OAuth2 -> -- | Refresh Token gained after authorization RefreshToken -> ExceptT TokenRequestError m OAuth2Token refreshAccessTokenWithAuthMethod authMethod manager oa token = do let (uri, body) = refreshAccessTokenUrl oa token let extraBody = if authMethod == ClientSecretPost then clientSecretPost oa else [] doJSONPostRequest manager oa uri (body ++ extraBody) -------------------------------------------------- -- * Utilies -------------------------------------------------- -- | Conduct post request and return response as JSON. doJSONPostRequest :: (MonadIO m, FromJSON a) => -- | HTTP connection manager. Manager -> -- | OAuth options OAuth2 -> -- | The URL URI -> -- | request body PostBody -> -- | Response as JSON ExceptT TokenRequestError m a doJSONPostRequest manager oa uri body = do resp <- doSimplePostRequest manager oa uri body case parseResponseFlexible resp of Right obj -> return obj Left e -> throwE e -- | Conduct post request. doSimplePostRequest :: (MonadIO m) => -- | HTTP connection manager. Manager -> -- | OAuth options OAuth2 -> -- | URL URI -> -- | Request body. PostBody -> -- | Response as ByteString ExceptT TokenRequestError m BSL.ByteString doSimplePostRequest manager oa url body = ExceptT . liftIO $ fmap handleOAuth2TokenResponse go where addBasicAuth = applyBasicAuth (T.encodeUtf8 $ oauth2ClientId oa) (T.encodeUtf8 $ oauth2ClientSecret oa) go = do req <- uriToRequest url let req' = (addBasicAuth . addDefaultRequestHeaders) req httpLbs (urlEncodedBody body req') manager -- | Gets response body from a @Response@ if 200 otherwise assume 'OAuth2Error' handleOAuth2TokenResponse :: Response BSL.ByteString -> Either TokenRequestError BSL.ByteString handleOAuth2TokenResponse rsp = if HT.statusIsSuccessful (responseStatus rsp) then Right $ responseBody rsp else Left $ parseTokeRequestError (responseBody rsp) -- | Try to parses response as JSON, if failed, try to parse as like query string. parseResponseFlexible :: (FromJSON a) => BSL.ByteString -> Either TokenRequestError a parseResponseFlexible r = case eitherDecode r of Left _ -> parseResponseString r Right x -> Right x -- | Parses the response that contains not JSON but a Query String parseResponseString :: (FromJSON a) => BSL.ByteString -> Either TokenRequestError a parseResponseString b = case parseQuery $ BSL.toStrict b of [] -> Left errorMessage a -> case fromJSON $ queryToValue a of Error _ -> Left errorMessage Success x -> Right x where queryToValue = Object . KeyMap.fromList . map paramToPair paramToPair (k, mv) = (Key.fromText $ T.decodeUtf8 k, maybe Null (String . T.decodeUtf8) mv) errorMessage = parseTokeRequestError b -- | Set several header values: -- + userAgennt : `hoauth2` -- + accept : `application/json` addDefaultRequestHeaders :: Request -> Request addDefaultRequestHeaders req = let headers = defaultRequestHeaders ++ requestHeaders req in req {requestHeaders = headers} -- | Add Credential (client_id, client_secret) to the request post body. clientSecretPost :: OAuth2 -> PostBody clientSecretPost oa = [ ("client_id", T.encodeUtf8 $ oauth2ClientId oa) , ("client_secret", T.encodeUtf8 $ oauth2ClientSecret oa) ] hoauth2-2.8.0/src/Network/OAuth2/0000755000000000000000000000000007346545000014606 5ustar0000000000000000hoauth2-2.8.0/src/Network/OAuth2/Experiment.hs0000644000000000000000000000704407346545000017267 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | 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 -- -- 1. Authorization Code. This flow requires authorize call to obtain an authorize code, -- then exchange the code for tokens. -- -- 2. Resource Owner Password. This flow only requires to hit token endpoint with, of course, -- username and password, to obtain tokens. -- -- 3. 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. -- -- 5. 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. -- -- @ -- {\-# LANGUAGE DataKinds #-\} -- -- data Google = Google deriving (Eq, Show) -- googleIdp :: Idp Google -- googleIdp = -- 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. module Network.OAuth2.Experiment ( module Network.OAuth2.Experiment.Types, module Network.OAuth2.Experiment.Pkce, ) where import Network.OAuth2.Experiment.Pkce import Network.OAuth2.Experiment.Types hoauth2-2.8.0/src/Network/OAuth2/Experiment/0000755000000000000000000000000007346545000016726 5ustar0000000000000000hoauth2-2.8.0/src/Network/OAuth2/Experiment/Pkce.hs0000644000000000000000000000445307346545000020152 0ustar0000000000000000module Network.OAuth2.Experiment.Pkce ( mkPkceParam, CodeChallenge (..), CodeVerifier (..), CodeChallengeMethod (..), PkceRequestParam (..), ) where import Control.Monad.IO.Class import Crypto.Hash qualified as H import Crypto.Random qualified as Crypto import Data.ByteArray qualified as ByteArray import Data.ByteString qualified as BS import Data.ByteString.Base64.URL qualified as B64 import Data.Text (Text) import Data.Text.Encoding qualified as T import Data.Word newtype CodeChallenge = CodeChallenge {unCodeChallenge :: Text} newtype CodeVerifier = CodeVerifier {unCodeVerifier :: Text} deriving (Show) data CodeChallengeMethod = S256 deriving (Show) data PkceRequestParam = PkceRequestParam { codeVerifier :: CodeVerifier , codeChallenge :: CodeChallenge , codeChallengeMethod :: CodeChallengeMethod -- ^ spec says optional but really it shall be s256 or can be omitted? -- https://datatracker.ietf.org/doc/html/rfc7636#section-4.3 } mkPkceParam :: MonadIO m => m PkceRequestParam mkPkceParam = do codeV <- genCodeVerifier pure PkceRequestParam { codeVerifier = CodeVerifier (T.decodeUtf8 codeV) , codeChallenge = CodeChallenge (encodeCodeVerifier codeV) , codeChallengeMethod = S256 } encodeCodeVerifier :: BS.ByteString -> Text encodeCodeVerifier = B64.encodeBase64Unpadded . BS.pack . ByteArray.unpack . hashSHA256 genCodeVerifier :: MonadIO m => m BS.ByteString genCodeVerifier = liftIO $ getBytesInternal BS.empty cvMaxLen :: Int cvMaxLen = 128 -- The default 'getRandomBytes' generates bytes out of unreverved characters scope. -- code-verifier = 43*128unreserved -- unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" -- ALPHA = %x41-5A / %x61-7A -- DIGIT = %x30-39 getBytesInternal :: BS.ByteString -> IO BS.ByteString getBytesInternal ba | BS.length ba >= cvMaxLen = pure (BS.take cvMaxLen ba) | otherwise = do bs <- Crypto.getRandomBytes cvMaxLen let bsUnreserved = ba `BS.append` BS.filter isUnreversed bs getBytesInternal bsUnreserved hashSHA256 :: BS.ByteString -> H.Digest H.SHA256 hashSHA256 = H.hash isUnreversed :: Word8 -> Bool isUnreversed w = w `BS.elem` unreverseBS {- a-z: 97-122 A-Z: 65-90 -: 45 .: 46 _: 95 ~: 126 -} unreverseBS :: BS.ByteString unreverseBS = BS.pack $ [97 .. 122] ++ [65 .. 90] ++ [45, 46, 95, 126] hoauth2-2.8.0/src/Network/OAuth2/Experiment/Types.hs0000644000000000000000000006706207346545000020401 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Network.OAuth2.Experiment.Types where import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT (..), throwE) import Data.Aeson (FromJSON) import Data.Bifunctor import Data.ByteString qualified as BS import Data.ByteString.Lazy.Char8 qualified as BSL import Data.Default (Default (def)) import Data.Kind import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set (Set) import Data.Set qualified as Set import Data.String import Data.Text.Encoding qualified as T import Data.Text.Lazy (Text) import Data.Text.Lazy qualified as TL import Network.HTTP.Conduit import Network.OAuth.OAuth2 hiding (RefreshToken) import Network.OAuth.OAuth2 qualified as OAuth2 import Network.OAuth2.Experiment.Pkce import Network.OAuth2.Experiment.Utils import URI.ByteString hiding (UserInfo) {- NOTE 1. shall I lift the constrain of all 'a :: GrantTypeFlow' so that user has max customization/flexibility? -} ------------------------------------------------------------------------------- -- * Grant Type ------------------------------------------------------------------------------- data GrantTypeFlow = -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.1 AuthorizationCode | -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.3 ResourceOwnerPassword | -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.4 ClientCredentials | -- | https://www.rfc-editor.org/rfc/rfc7523.html#section-2.1 JwtBearer ------------------------------------------------------------------------------- -- * Response Type value ------------------------------------------------------------------------------- class ToResponseTypeValue (a :: GrantTypeFlow) where toResponseTypeValue :: IsString b => b instance ToResponseTypeValue 'AuthorizationCode where -- https://www.rfc-editor.org/rfc/rfc6749#section-3.1.1 -- Only support "authorization code" flow toResponseTypeValue :: IsString b => b toResponseTypeValue = "code" toResponseTypeParam :: forall a b req. (ToResponseTypeValue a, IsString b) => req a -> Map b b toResponseTypeParam _ = Map.singleton "response_type" (toResponseTypeValue @a) ------------------------------------------------------------------------------- -- * Grant Type value ------------------------------------------------------------------------------- newtype UrnOAuthParam a = UrnOAuthParam a -- | Grant type query parameter has association with 'GrantTypeFlow' but not completely strict. -- -- e.g. Both 'AuthorizationCode' and 'ResourceOwnerPassword' flow could support refresh token flow. data GrantTypeValue = GTAuthorizationCode | GTPassword | GTClientCredentials | GTRefreshToken | GTJwtBearer deriving (Eq, Show) ------------------------------------------------------------------------------- -- * Scope ------------------------------------------------------------------------------- -- TODO: following data type is not ideal as Idp would have lots of 'Custom Text' -- -- @ -- data Scope = OPENID | PROFILE | EMAIL | OFFLINE_ACCESS | Custom Text -- @ -- -- Would be nice to define Enum for standard Scope, plus allow user to define their own define (per Idp) and plugin somehow. newtype Scope = Scope {unScope :: Text} deriving (Show, Eq, Ord) instance IsString Scope where fromString :: String -> Scope fromString = Scope . TL.pack ------------------------------------------------------------------------------- -- * Credentials ------------------------------------------------------------------------------- newtype ClientId = ClientId {unClientId :: Text} deriving (Show, Eq, IsString) -- | Can be either "Client Secret" or JWT base on client authentication method newtype ClientSecret = ClientSecret {unClientSecret :: Text} deriving (Eq, IsString) -- | In order to reuse some methods from legacy "Network.OAuth.OAuth2". -- Will be removed when Experiment module becomes default. toOAuth2Key :: ClientId -> ClientSecret -> OAuth2 toOAuth2Key cid csecret = def { oauth2ClientId = TL.toStrict $ unClientId cid , oauth2ClientSecret = TL.toStrict $ unClientSecret csecret } newtype RedirectUri = RedirectUri {unRedirectUri :: URI} deriving (Eq) newtype AuthorizeState = AuthorizeState {unAuthorizeState :: Text} deriving (Eq) instance IsString AuthorizeState where fromString :: String -> AuthorizeState fromString = AuthorizeState . TL.pack newtype Username = Username {unUsername :: Text} deriving (Eq) instance IsString Username where fromString :: String -> Username fromString = Username . TL.pack newtype Password = Password {unPassword :: Text} deriving (Eq) instance IsString Password where fromString :: String -> Password fromString = Password . TL.pack ------------------------------------------------------------------------------- -- * Query parameters ------------------------------------------------------------------------------- class ToQueryParam a where toQueryParam :: a -> Map Text Text instance ToQueryParam a => ToQueryParam (Maybe a) where toQueryParam :: ToQueryParam a => Maybe a -> Map Text Text toQueryParam Nothing = Map.empty toQueryParam (Just a) = toQueryParam a instance ToQueryParam GrantTypeValue where toQueryParam :: GrantTypeValue -> Map Text Text toQueryParam x = Map.singleton "grant_type" (val x) where val :: GrantTypeValue -> Text val GTAuthorizationCode = "authorization_code" val GTPassword = "password" val GTClientCredentials = "client_credentials" val GTRefreshToken = "refresh_token" val GTJwtBearer = "urn:ietf:params:oauth:grant-type:jwt-bearer" instance ToQueryParam ClientId where toQueryParam :: ClientId -> Map Text Text toQueryParam (ClientId i) = Map.singleton "client_id" i instance ToQueryParam ClientSecret where toQueryParam :: ClientSecret -> Map Text Text toQueryParam (ClientSecret x) = Map.singleton "client_secret" x instance ToQueryParam Username where toQueryParam :: Username -> Map Text Text toQueryParam (Username x) = Map.singleton "username" x instance ToQueryParam Password where toQueryParam :: Password -> Map Text Text toQueryParam (Password x) = Map.singleton "password" x instance ToQueryParam AuthorizeState where toQueryParam :: AuthorizeState -> Map Text Text toQueryParam (AuthorizeState x) = Map.singleton "state" x instance ToQueryParam RedirectUri where toQueryParam (RedirectUri uri) = Map.singleton "redirect_uri" (bs8ToLazyText $ serializeURIRef' uri) instance ToQueryParam (Set Scope) where toQueryParam :: Set Scope -> Map Text Text toQueryParam = toScopeParam . Set.map unScope where toScopeParam :: (IsString a) => Set Text -> Map a Text toScopeParam scope = Map.singleton "scope" (TL.intercalate " " $ Set.toList scope) instance ToQueryParam CodeVerifier where toQueryParam :: CodeVerifier -> Map Text Text toQueryParam (CodeVerifier x) = Map.singleton "code_verifier" (TL.fromStrict x) instance ToQueryParam CodeChallenge where toQueryParam :: CodeChallenge -> Map Text Text toQueryParam (CodeChallenge x) = Map.singleton "code_challenge" (TL.fromStrict x) instance ToQueryParam CodeChallengeMethod where toQueryParam :: CodeChallengeMethod -> Map Text Text toQueryParam x = Map.singleton "code_challenge_method" (TL.pack $ show x) instance ToQueryParam ExchangeToken where toQueryParam :: ExchangeToken -> Map Text Text toQueryParam (ExchangeToken x) = Map.singleton "code" (TL.fromStrict x) instance ToQueryParam OAuth2.RefreshToken where toQueryParam :: OAuth2.RefreshToken -> Map Text Text toQueryParam (OAuth2.RefreshToken x) = Map.singleton "refresh_token" (TL.fromStrict x) ------------------------------------------------------------------------------- -- * Authorization and Token Requests types ------------------------------------------------------------------------------- class HasAuthorizeRequest (a :: GrantTypeFlow) where data AuthorizationRequest a type MkAuthorizationRequestResponse a mkAuthorizeRequestParameter :: IdpApplication a i -> AuthorizationRequest a mkAuthorizeRequest :: IdpApplication a i -> MkAuthorizationRequestResponse a class HasTokenRequest (a :: GrantTypeFlow) where -- | Each GrantTypeFlow has slightly different request parameter to /token endpoint. data TokenRequest a -- | 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 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 (TL.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 -- | https://www.rfc-editor.org/rfc/rfc6749#page-47 data RefreshTokenRequest a mkRefreshTokenRequest :: IdpApplication a i -> OAuth2.RefreshToken -> RefreshTokenRequest a conduitRefreshTokenRequest :: (MonadIO m) => IdpApplication a i -> Manager -> OAuth2.RefreshToken -> ExceptT TokenRequestError m OAuth2Token ------------------------------------------------------------------------------- -- * User Info types ------------------------------------------------------------------------------- type family IdpUserInfo a class HasUserInfoRequest (a :: GrantTypeFlow) where conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication a i -> Manager -> AccessToken -> ExceptT BSL.ByteString IO (IdpUserInfo i) ------------------------------------------------------------------------------- -- * Idp App ------------------------------------------------------------------------------- -- | Shall IdpApplication has a field of 'Idp a'?? data Idp a = Idp { idpUserInfoEndpoint :: URI , -- NOTE: maybe worth data type to distinguish authorize and token endpoint -- as I made mistake at passing to Authorize and Token Request idpAuthorizeEndpoint :: URI , idpTokenEndpoint :: URI , idpFetchUserInfo :: forall m. (FromJSON (IdpUserInfo a), MonadIO m) => Manager -> AccessToken -> URI -> ExceptT BSL.ByteString m (IdpUserInfo a) } ------------------------------------------------------------------------------- -- * Idp App Config ------------------------------------------------------------------------------- data family IdpApplication (a :: GrantTypeFlow) (i :: Type) ------------------------------------------------------------------------------- -- * Authorization Code flow ------------------------------------------------------------------------------- -- | An Application that supports "Authorization code" flow data instance IdpApplication 'AuthorizationCode i = AuthorizationCodeIdpApplication { idpAppName :: Text , idpAppClientId :: ClientId , idpAppClientSecret :: ClientSecret , idpAppScope :: Set Scope , idpAppRedirectUri :: URI , idpAppAuthorizeState :: AuthorizeState , idpAppAuthorizeExtraParams :: Map Text Text -- ^ Though technically one key can have multiple value in query, but who actually does it?! , idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod , idp :: Idp i } -- NOTE: maybe add function for parase authorization response -- though seems overkill. https://github.com/freizl/hoauth2/issues/149 -- parseAuthorizationResponse :: String -> AuthorizationResponse -- parseAuthorizationResponse :: ( String, String ) -> AuthorizationResponse instance HasAuthorizeRequest 'AuthorizationCode where -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.1.1 data AuthorizationRequest 'AuthorizationCode = AuthorizationCodeAuthorizationRequest { scope :: Set Scope , state :: AuthorizeState , clientId :: ClientId , redirectUri :: Maybe RedirectUri } type MkAuthorizationRequestResponse 'AuthorizationCode = Text mkAuthorizeRequestParameter :: IdpApplication 'AuthorizationCode i -> AuthorizationRequest 'AuthorizationCode mkAuthorizeRequestParameter AuthorizationCodeIdpApplication {..} = AuthorizationCodeAuthorizationRequest { scope = if null idpAppScope then Set.empty else idpAppScope , state = idpAppAuthorizeState , clientId = idpAppClientId , redirectUri = Just (RedirectUri idpAppRedirectUri) } mkAuthorizeRequest :: IdpApplication 'AuthorizationCode i -> Text mkAuthorizeRequest idpAppConfig@AuthorizationCodeIdpApplication {..} = let req = mkAuthorizeRequestParameter idpAppConfig allParams = map (bimap tlToBS tlToBS) $ Map.toList $ Map.unions [idpAppAuthorizeExtraParams, toQueryParam req] in TL.fromStrict $ T.decodeUtf8 $ serializeURIRef' $ appendQueryParams allParams $ idpAuthorizeEndpoint idp instance HasTokenRequest 'AuthorizationCode where -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.1.3 data TokenRequest 'AuthorizationCode = AuthorizationCodeTokenRequest { code :: ExchangeToken , clientId :: ClientId , grantType :: GrantTypeValue , redirectUri :: RedirectUri } type WithExchangeToken 'AuthorizationCode a = ExchangeToken -> a mkTokenRequest :: IdpApplication 'AuthorizationCode i -> ExchangeToken -> TokenRequest 'AuthorizationCode mkTokenRequest AuthorizationCodeIdpApplication {..} authCode = AuthorizationCodeTokenRequest { code = authCode , clientId = idpAppClientId , grantType = GTAuthorizationCode , redirectUri = RedirectUri idpAppRedirectUri } conduitTokenRequest :: forall m i. (MonadIO m) => IdpApplication 'AuthorizationCode i -> Manager -> ExchangeToken -> ExceptT TokenRequestError m OAuth2Token conduitTokenRequest idpAppConfig@AuthorizationCodeIdpApplication {..} mgr exchangeToken = let req = mkTokenRequest idpAppConfig exchangeToken key = toOAuth2Key idpAppClientId idpAppClientSecret body = mapsToParams [ toQueryParam req , toQueryParam ( if idpAppTokenRequestAuthenticationMethod == ClientSecretPost then Just idpAppClientSecret else Nothing ) ] in doJSONPostRequest mgr key (idpTokenEndpoint idp) body instance HasPkceAuthorizeRequest 'AuthorizationCode where mkPkceAuthorizeRequest :: MonadIO m => IdpApplication 'AuthorizationCode i -> m (Text, CodeVerifier) mkPkceAuthorizeRequest idpAppConfig@AuthorizationCodeIdpApplication {..} = do PkceRequestParam {..} <- mkPkceParam let req = mkAuthorizeRequestParameter idpAppConfig let allParams = mapsToParams [ idpAppAuthorizeExtraParams , toQueryParam req , toQueryParam codeChallenge , toQueryParam codeChallengeMethod ] let url = TL.fromStrict $ T.decodeUtf8 $ serializeURIRef' $ appendQueryParams allParams $ idpAuthorizeEndpoint idp pure (url, codeVerifier) instance HasPkceTokenRequest 'AuthorizationCode where conduitPkceTokenRequest :: MonadIO m => IdpApplication 'AuthorizationCode i -> Manager -> (ExchangeToken, CodeVerifier) -> ExceptT TokenRequestError m OAuth2Token conduitPkceTokenRequest idpAppConfig@AuthorizationCodeIdpApplication {..} mgr (exchangeToken, codeVerifier) = let req = mkTokenRequest idpAppConfig exchangeToken key = toOAuth2Key idpAppClientId idpAppClientSecret body = mapsToParams [ toQueryParam req , toQueryParam codeVerifier , toQueryParam (if idpAppTokenRequestAuthenticationMethod == ClientSecretPost then Just idpAppClientSecret else Nothing) ] in doJSONPostRequest mgr key (idpTokenEndpoint idp) body instance HasRefreshTokenRequest 'AuthorizationCode where data RefreshTokenRequest 'AuthorizationCode = AuthorizationCodeTokenRefreshRequest { refreshToken :: OAuth2.RefreshToken , grantType :: GrantTypeValue , scope :: Set Scope } mkRefreshTokenRequest :: IdpApplication 'AuthorizationCode i -> OAuth2.RefreshToken -> RefreshTokenRequest 'AuthorizationCode mkRefreshTokenRequest AuthorizationCodeIdpApplication {..} rt = AuthorizationCodeTokenRefreshRequest { scope = idpAppScope , grantType = GTRefreshToken , refreshToken = rt } conduitRefreshTokenRequest :: (MonadIO m) => IdpApplication 'AuthorizationCode i -> Manager -> OAuth2.RefreshToken -> ExceptT TokenRequestError m OAuth2Token conduitRefreshTokenRequest idpAppConfig@AuthorizationCodeIdpApplication {..} mgr rt = let req = mkRefreshTokenRequest idpAppConfig rt key = toOAuth2Key idpAppClientId idpAppClientSecret body = mapsToParams [ toQueryParam req , toQueryParam (if idpAppTokenRequestAuthenticationMethod == ClientSecretPost then Just idpAppClientSecret else Nothing) ] in doJSONPostRequest mgr key (idpTokenEndpoint idp) body instance HasUserInfoRequest 'AuthorizationCode where conduitUserInfoRequest :: FromJSON (IdpUserInfo i) => IdpApplication 'AuthorizationCode i -> Manager -> AccessToken -> ExceptT BSL.ByteString IO (IdpUserInfo i) conduitUserInfoRequest AuthorizationCodeIdpApplication {..} mgr at = do idpFetchUserInfo idp mgr at (idpUserInfoEndpoint idp) instance ToQueryParam (AuthorizationRequest 'AuthorizationCode) where toQueryParam :: AuthorizationRequest 'AuthorizationCode -> Map Text Text toQueryParam req@AuthorizationCodeAuthorizationRequest {..} = Map.unions [ toResponseTypeParam req , toQueryParam scope , toQueryParam clientId , toQueryParam state , toQueryParam redirectUri ] instance ToQueryParam (TokenRequest 'AuthorizationCode) where toQueryParam :: TokenRequest 'AuthorizationCode -> Map Text Text toQueryParam AuthorizationCodeTokenRequest {..} = Map.unions [ toQueryParam grantType , toQueryParam code , toQueryParam redirectUri ] instance ToQueryParam (RefreshTokenRequest 'AuthorizationCode) where toQueryParam :: RefreshTokenRequest 'AuthorizationCode -> Map Text Text toQueryParam AuthorizationCodeTokenRefreshRequest {..} = Map.unions [ toQueryParam grantType , toQueryParam scope , toQueryParam refreshToken ] ------------------------------------------------------------------------------- -- * JWTBearer ------------------------------------------------------------------------------- -- | An Application that supports "Authorization code" flow data instance IdpApplication 'JwtBearer i = JwtBearerIdpApplication { idpAppName :: Text , idpAppJwt :: BS.ByteString , idp :: Idp i } instance HasTokenRequest 'JwtBearer where data TokenRequest 'JwtBearer = JwtBearerTokenRequest { grantType :: GrantTypeValue -- \| 'GTJwtBearer' , assertion :: BS.ByteString -- \| The the signed JWT token } type WithExchangeToken 'JwtBearer a = a mkTokenRequest :: IdpApplication 'JwtBearer i -> TokenRequest 'JwtBearer mkTokenRequest JwtBearerIdpApplication {..} = JwtBearerTokenRequest { grantType = GTJwtBearer , assertion = idpAppJwt } conduitTokenRequest :: forall m i. (MonadIO m) => IdpApplication 'JwtBearer i -> Manager -> ExceptT TokenRequestError m OAuth2Token conduitTokenRequest idpAppConfig@JwtBearerIdpApplication {..} mgr = do resp <- ExceptT . liftIO $ do let tokenReq = mkTokenRequest idpAppConfig let body = mapsToParams [toQueryParam tokenReq] req <- uriToRequest (idpTokenEndpoint idp) handleOAuth2TokenResponse <$> httpLbs (urlEncodedBody body (addDefaultRequestHeaders req)) mgr case parseResponseFlexible resp of Right obj -> return obj Left e -> throwE e instance ToQueryParam (TokenRequest 'JwtBearer) where toQueryParam :: TokenRequest 'JwtBearer -> Map Text Text toQueryParam JwtBearerTokenRequest {..} = Map.unions [ toQueryParam grantType , Map.fromList [("assertion", bs8ToLazyText assertion)] ] instance HasUserInfoRequest 'JwtBearer where conduitUserInfoRequest JwtBearerIdpApplication {..} mgr at = do idpFetchUserInfo idp mgr at (idpUserInfoEndpoint idp) ------------------------------------------------------------------------------- -- * Password flow ------------------------------------------------------------------------------- -- https://www.rfc-editor.org/rfc/rfc6749#section-4.3.1 -- 4.3.1. Authorization Request and Response (Password grant type) -- The method through which the client obtains the resource owner -- credentials is beyond the scope of this specification. The client -- MUST discard the credentials once an access token has been obtained. -- -- Hence no AuhorizationRequest instance data instance IdpApplication 'ResourceOwnerPassword i = ResourceOwnerPasswordIDPApplication { idpAppClientId :: ClientId , idpAppClientSecret :: ClientSecret , idpAppName :: Text , idpAppScope :: Set Scope , idpAppUserName :: Username , idpAppPassword :: Password , idpAppTokenRequestExtraParams :: Map Text Text -- ^ Any parameter that required by your Idp and not mentioned in the OAuth2 spec , idp :: Idp i } instance HasUserInfoRequest 'ResourceOwnerPassword where conduitUserInfoRequest ResourceOwnerPasswordIDPApplication {..} mgr at = do idpFetchUserInfo idp mgr at (idpUserInfoEndpoint idp) instance HasTokenRequest 'ResourceOwnerPassword where -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.3.2 data TokenRequest 'ResourceOwnerPassword = PasswordTokenRequest { scope :: Set Scope , username :: Username , password :: Password , grantType :: GrantTypeValue } type WithExchangeToken 'ResourceOwnerPassword a = a mkTokenRequest :: IdpApplication 'ResourceOwnerPassword i -> TokenRequest 'ResourceOwnerPassword mkTokenRequest ResourceOwnerPasswordIDPApplication {..} = PasswordTokenRequest { username = idpAppUserName , password = idpAppPassword , grantType = GTPassword , scope = idpAppScope } conduitTokenRequest :: (MonadIO m) => IdpApplication 'ResourceOwnerPassword i -> Manager -> ExceptT TokenRequestError m OAuth2Token conduitTokenRequest idpAppConfig@ResourceOwnerPasswordIDPApplication {..} mgr = let req = mkTokenRequest idpAppConfig key = toOAuth2Key idpAppClientId idpAppClientSecret body = mapsToParams [idpAppTokenRequestExtraParams, toQueryParam req] in doJSONPostRequest mgr key (idpTokenEndpoint idp) body -- | TODO: TBD instance HasRefreshTokenRequest 'ResourceOwnerPassword where data RefreshTokenRequest 'ResourceOwnerPassword = PasswordRefreshTokenRequest mkRefreshTokenRequest :: IdpApplication 'ResourceOwnerPassword i -> OAuth2.RefreshToken -> RefreshTokenRequest 'ResourceOwnerPassword mkRefreshTokenRequest = undefined conduitRefreshTokenRequest :: MonadIO m => IdpApplication 'ResourceOwnerPassword i -> Manager -> OAuth2.RefreshToken -> ExceptT TokenRequestError m OAuth2Token conduitRefreshTokenRequest = undefined instance ToQueryParam (TokenRequest 'ResourceOwnerPassword) where toQueryParam :: TokenRequest 'ResourceOwnerPassword -> Map Text Text toQueryParam PasswordTokenRequest {..} = Map.unions [ toQueryParam grantType , toQueryParam scope , toQueryParam username , toQueryParam password ] ------------------------------------------------------------------------------- -- * Client Credentials flow ------------------------------------------------------------------------------- -- https://www.rfc-editor.org/rfc/rfc6749#section-4.4.1 -- 4.4.1. Authorization Request and Response (Client Credentials grant type) -- Since the client authentication is used as the authorization grant, -- no additional authorization request is needed. -- -- Hence no AuhorizationRequest instance data instance IdpApplication 'ClientCredentials i = ClientCredentialsIDPApplication { idpAppClientId :: ClientId , idpAppClientSecret :: ClientSecret , idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod -- ^ FIXME: rename to ClientCredential , idpAppName :: Text , idpAppScope :: Set Scope , idpAppTokenRequestExtraParams :: Map Text Text -- ^ Any parameter that required by your Idp and not mentioned in the OAuth2 spec , idp :: Idp i } instance HasTokenRequest 'ClientCredentials where -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.4.2 data TokenRequest 'ClientCredentials = ClientCredentialsTokenRequest { scope :: Set Scope , grantType :: GrantTypeValue , clientAssertionType :: Text , clientAssertion :: BS.ByteString , clientAuthenticationMethod :: ClientAuthenticationMethod } type WithExchangeToken 'ClientCredentials a = a mkTokenRequest :: IdpApplication 'ClientCredentials i -> TokenRequest 'ClientCredentials mkTokenRequest ClientCredentialsIDPApplication {..} = ClientCredentialsTokenRequest { scope = idpAppScope , grantType = GTClientCredentials , clientAssertionType = "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" , clientAssertion = tlToBS $ unClientSecret idpAppClientSecret , clientAuthenticationMethod = idpAppTokenRequestAuthenticationMethod } conduitTokenRequest :: (MonadIO m) => IdpApplication 'ClientCredentials i -> Manager -> ExceptT TokenRequestError m OAuth2Token conduitTokenRequest idpAppConfig@ClientCredentialsIDPApplication {..} mgr = do let tokenReq = mkTokenRequest idpAppConfig key = toOAuth2Key idpAppClientId idpAppClientSecret body = mapsToParams [ idpAppTokenRequestExtraParams , toQueryParam tokenReq ] if clientAuthenticationMethod tokenReq == ClientAssertionJwt then do resp <- ExceptT . liftIO $ do req <- uriToRequest (idpTokenEndpoint idp) let req' = urlEncodedBody body (addDefaultRequestHeaders req) handleOAuth2TokenResponse <$> httpLbs req' mgr case parseResponseFlexible resp of Right obj -> return obj Left e -> throwE e else doJSONPostRequest mgr key (idpTokenEndpoint idp) body instance ToQueryParam (TokenRequest 'ClientCredentials) where toQueryParam :: TokenRequest 'ClientCredentials -> Map Text Text toQueryParam ClientCredentialsTokenRequest {..} = Map.unions $ [ toQueryParam grantType , toQueryParam scope ] ++ [ Map.fromList ( if clientAuthenticationMethod == ClientAssertionJwt then [ ("client_assertion_type", clientAssertionType) , ("client_assertion", bs8ToLazyText clientAssertion) ] else [] ) ] hoauth2-2.8.0/src/Network/OAuth2/Experiment/Utils.hs0000644000000000000000000000112407346545000020360 0ustar0000000000000000module Network.OAuth2.Experiment.Utils where import Data.Bifunctor import Data.ByteString (ByteString) import Data.ByteString.Char8 qualified as BS8 import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text.Encoding qualified as TE import Data.Text.Lazy qualified as TL tlToBS :: TL.Text -> ByteString tlToBS = TE.encodeUtf8 . TL.toStrict bs8ToLazyText :: BS8.ByteString -> TL.Text bs8ToLazyText = TL.pack . BS8.unpack mapsToParams :: [Map TL.Text TL.Text] -> [(ByteString, ByteString)] mapsToParams = map (bimap tlToBS tlToBS) . Map.toList . Map.unions hoauth2-2.8.0/test/Network/OAuth/OAuth2/0000755000000000000000000000000007346545000016016 5ustar0000000000000000hoauth2-2.8.0/test/Network/OAuth/OAuth2/TokenRequestSpec.hs0000644000000000000000000000175007346545000021621 0ustar0000000000000000module Network.OAuth.OAuth2.TokenRequestSpec where import Data.Aeson qualified as Aeson import Network.OAuth.OAuth2.TokenRequest import Test.Hspec spec :: Spec spec = describe "parseJSON TokenRequestErrorCode" $ do it "invalid_request" $ do Aeson.eitherDecode "\"invalid_request\"" `shouldBe` Right InvalidRequest it "invalid_client" $ do Aeson.eitherDecode "\"invalid_client\"" `shouldBe` Right InvalidClient it "invalid_grant" $ do Aeson.eitherDecode "\"invalid_grant\"" `shouldBe` Right InvalidGrant it "unauthorized_client" $ do Aeson.eitherDecode "\"unauthorized_client\"" `shouldBe` Right UnauthorizedClient it "unsupported_grant_type" $ do Aeson.eitherDecode "\"unsupported_grant_type\"" `shouldBe` Right UnsupportedGrantType it "invalid_scope" $ do Aeson.eitherDecode "\"invalid_scope\"" `shouldBe` Right InvalidScope it "foo_code" $ do Aeson.eitherDecode "\"foo_code\"" `shouldBe` Right (UnknownErrorCode "foo_code") hoauth2-2.8.0/test/0000755000000000000000000000000007346545000012243 5ustar0000000000000000hoauth2-2.8.0/test/Spec.hs0000644000000000000000000000010107346545000013461 0ustar0000000000000000-- file test/Spec.hs {-# OPTIONS_GHC -F -pgmF hspec-discover #-}