diff --git a/hoauth2-providers-tutorial.cabal b/hoauth2-providers-tutorial.cabal --- a/hoauth2-providers-tutorial.cabal +++ b/hoauth2-providers-tutorial.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hoauth2-providers-tutorial -version: 0.2 +version: 0.3.0 synopsis: tutorial for hoauth2-providers module description: A tutorial that demostrates how to use hoauth2-providers package @@ -11,24 +11,22 @@ author: Haisheng Wu (M) maintainer: freizl@gmail.com category: Network +tested-with: GHC <=9.6.1 library exposed-modules: HOAuth2ProvidersTutorial build-depends: - , aeson >=2.0 && <2.2 , base >=4.14 && <5 , bytestring >=0.9 && <0.12 - , containers - , hoauth2 >=2.7 - , hoauth2-providers >=0.2 + , containers ^>=0.6 + , hoauth2 ^>=2.9 + , hoauth2-providers ^>=0.3 , http-conduit >=2.1 && <2.4 , http-types >=0.11 && <0.13 , scotty >=0.10.0 && <0.13 - , text >=0.11 && <1.3 - , transformers ^>=0.5 + , text >=0.11 && <2.1 + , transformers >=0.4 && <0.7 , uri-bytestring >=0.2.3 && <0.4 - , wai ^>=3.2 - , warp >=3.2 && <3.4 hs-source-dirs: src default-language: Haskell2010 @@ -36,14 +34,11 @@ -Wall -Wtabs -Wno-unused-do-bind -Wunused-packages -Wpartial-fields -Wwarnings-deprecations + if impl(ghc <9.4) + ghc-options: -Wno-unticked-promoted-constructors + executable hoauth2-providers-tutorial main-is: Main.hs - - -- Modules included in this executable, other than Main. - -- other-modules: - - -- LANGUAGE extensions used by modules in this package. - -- other-extensions: build-depends: , base >=4.14 && <5 , hoauth2-providers-tutorial diff --git a/src/HOAuth2ProvidersTutorial.hs b/src/HOAuth2ProvidersTutorial.hs --- a/src/HOAuth2ProvidersTutorial.hs +++ b/src/HOAuth2ProvidersTutorial.hs @@ -1,10 +1,7 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} module HOAuth2ProvidersTutorial where @@ -13,30 +10,23 @@ import Control.Monad.Trans.Except import Data.ByteString.Lazy.Char8 qualified as BSL import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.Map.Strict qualified as Map import Data.Set qualified as Set -import Data.Text.Encoding qualified as T +import Data.Text.Lazy (Text) import Data.Text.Lazy qualified as TL import Network.HTTP.Conduit (newManager, tlsManagerSettings) import Network.HTTP.Types (status302) import Network.OAuth.OAuth2 ( ExchangeToken (ExchangeToken), OAuth2Token (accessToken), - TokenRequestError, + TokenResponseError, ) import Network.OAuth2.Experiment -import Network.OAuth2.Provider.Auth0 ( - Auth0, - Auth0User (Auth0User, email, name, sub), - defaultAuth0App, - defaultAuth0Idp, - ) -import Network.OAuth2.Provider.Google ( - Google, - GoogleUser (GoogleUser, email, id, name), - defaultGoogleApp, - defaultGoogleIdp, - ) -import URI.ByteString (URI, serializeURIRef') +import Network.OAuth2.Provider +import Network.OAuth2.Provider.Auth0 (Auth0User (..), mkAuth0Idp) +import Network.OAuth2.Provider.Auth0 qualified as Auth0 +import Network.OAuth2.Provider.Google (GoogleUser (..)) +import Network.OAuth2.Provider.Google qualified as Google import URI.ByteString.QQ (uri) import Web.Scotty (ActionM, scotty) import Web.Scotty qualified as Scotty @@ -48,38 +38,44 @@ ------------------------------ -testAuth0App :: IdpApplication 'AuthorizationCode Auth0 -testAuth0App = - (defaultAuth0App testAuth0Idp) - { idpAppClientId = "" - , idpAppClientSecret = "" - , idpAppAuthorizeState = AuthorizeState ("auth0." <> randomStateValue) - , idpAppScope = Set.fromList ["openid", "email", "profile"] - , idpAppRedirectUri = [uri|http://localhost:9988/oauth2/callback|] - , idpAppName = "foo-auth0-app" - } - -testAuth0Idp :: Idp Auth0 -testAuth0Idp = - defaultAuth0Idp - { idpUserInfoEndpoint = [uri|https://freizl.auth0.com/userinfo|] - , idpAuthorizeEndpoint = [uri|https://freizl.auth0.com/authorize|] - , idpTokenEndpoint = [uri|https://freizl.auth0.com/oauth/token|] - } +mkTestAuth0App :: ExceptT Text IO (IdpApplication Auth0 AuthorizationCodeApplication) +mkTestAuth0App = do + idp <- mkTestAuth0Idp + let application = + AuthorizationCodeApplication + { acClientId = "" + , acClientSecret = "" + , acAuthorizeState = AuthorizeState ("auth0." <> randomStateValue) + , acScope = Set.fromList ["openid", "email", "profile"] + , acRedirectUri = [uri|http://localhost:9988/oauth2/callback|] + , acName = "foo-auth0-app" + , acAuthorizeRequestExtraParams = Map.empty + , acTokenRequestAuthenticationMethod = ClientSecretBasic + } + pure IdpApplication {..} -testGoogleIdp :: Idp Google -testGoogleIdp = defaultGoogleIdp +mkTestAuth0Idp :: ExceptT Text IO (Idp Auth0) +mkTestAuth0Idp = mkAuth0Idp "freizl.auth0.com" -testGoogleApp :: IdpApplication 'AuthorizationCode Google -testGoogleApp = - defaultGoogleApp - { idpAppClientId = "" - , idpAppClientSecret = "" - , idpAppAuthorizeState = AuthorizeState ("google." <> randomStateValue) - , idpAppRedirectUri = [uri|http://localhost:9988/oauth2/callback|] - , idpAppName = "foo-google-app" - , idp = testGoogleIdp - } +mkTestGoogleApp :: IdpApplication Google AuthorizationCodeApplication +mkTestGoogleApp = + let application = + AuthorizationCodeApplication + { acClientId = "" + , acClientSecret = "" + , acAuthorizeState = AuthorizeState ("google." <> randomStateValue) + , acRedirectUri = [uri|http://localhost:9988/oauth2/callback|] + , acScope = + Set.fromList + [ "https://www.googleapis.com/auth/userinfo.email" + , "https://www.googleapis.com/auth/userinfo.profile" + ] + , acName = "foo-google-app" + , acAuthorizeRequestExtraParams = Map.empty + , acTokenRequestAuthenticationMethod = ClientSecretBasic + } + idp = Google.defaultGoogleIdp + in IdpApplication {..} -- | You'll need to find out an better way to create @state@ -- which is recommended in @@ -100,14 +96,20 @@ -- | The 'scotty' application app :: IO () app = do - -- Poor man's solution for creating user session. - refUser <- newIORef Nothing - scotty 9988 $ do - Scotty.get "/" $ indexH refUser - Scotty.get "/login/auth0" loginAuth0H - Scotty.get "/login/google" loginGoogleH - Scotty.get "/logout" (logoutH refUser) - Scotty.get "/oauth2/callback" $ callbackH refUser + eAuth0App <- runExceptT mkTestAuth0App + either (error . TL.unpack) runApp eAuth0App + where + runApp :: IdpApplication Auth0 AuthorizationCodeApplication -> IO () + runApp auth0App = do + -- Poor man's solution for creating user session. + refUser <- newIORef Nothing + let googleApp = mkTestGoogleApp + scotty 9988 $ do + Scotty.get "/" $ indexH refUser + Scotty.get "/login/auth0" (loginAuth0H auth0App) + Scotty.get "/login/google" (loginGoogleH googleApp) + Scotty.get "/logout" (logoutH refUser) + Scotty.get "/oauth2/callback" $ callbackH auth0App googleApp refUser -- | @/@ endpoint handler indexH :: IORef (Maybe DemoUser) -> ActionM () @@ -138,15 +140,15 @@ Scotty.html . mconcat $ "

hoauth2 providers Tutorial

" : info -- | @/login/auth0@ endpoint handler -loginAuth0H :: ActionM () -loginAuth0H = do - Scotty.setHeader "Location" (mkAuthorizeRequest testAuth0App) +loginAuth0H :: IdpApplication Auth0 AuthorizationCodeApplication -> ActionM () +loginAuth0H auth0App = do + Scotty.setHeader "Location" (TL.fromStrict $ uriToText $ mkAuthorizationRequest auth0App) Scotty.status status302 -- | @/login/google@ endpoint handler -loginGoogleH :: ActionM () -loginGoogleH = do - Scotty.setHeader "Location" (mkAuthorizeRequest testGoogleApp) +loginGoogleH :: IdpApplication Google AuthorizationCodeApplication -> ActionM () +loginGoogleH googleApp = do + Scotty.setHeader "Location" (TL.fromStrict $ uriToText $ mkAuthorizationRequest googleApp) Scotty.status status302 -- | @/logout@ endpoint handler @@ -156,8 +158,12 @@ Scotty.redirect "/" -- | @/oauth2/callback@ endpoint handler -callbackH :: IORef (Maybe DemoUser) -> ActionM () -callbackH refUser = do +callbackH :: + IdpApplication Auth0 AuthorizationCodeApplication -> + IdpApplication Google AuthorizationCodeApplication -> + IORef (Maybe DemoUser) -> + ActionM () +callbackH auth0App googleApp refUser = do pas <- Scotty.params excepttToActionM $ do @@ -168,28 +174,32 @@ let idpName = TL.takeWhile ('.' /=) state user <- case idpName of - "google" -> handleGoogleCallback code - "auth0" -> handleAuth0Callback code + "google" -> handleGoogleCallback googleApp code + "auth0" -> handleAuth0Callback auth0App code _ -> throwE $ "unable to find idp app of: " <> idpName liftIO $ writeIORef refUser (Just user) Scotty.redirect "/" -handleAuth0Callback :: ExchangeToken -> ExceptT TL.Text IO DemoUser -handleAuth0Callback code = do - let idpApp = testAuth0App +handleAuth0Callback :: + IdpApplication Auth0 AuthorizationCodeApplication -> + ExchangeToken -> + ExceptT TL.Text IO DemoUser +handleAuth0Callback idpApp code = do mgr <- liftIO $ newManager tlsManagerSettings tokenResp <- withExceptT oauth2ErrorToText (conduitTokenRequest idpApp mgr code) - Auth0User {..} <- withExceptT bslToText $ conduitUserInfoRequest idpApp mgr (accessToken tokenResp) + Auth0User {..} <- withExceptT bslToText $ Auth0.fetchUserInfo idpApp mgr (accessToken tokenResp) pure (DemoUser name (Just email)) -handleGoogleCallback :: ExchangeToken -> ExceptT TL.Text IO DemoUser -handleGoogleCallback code = do - let idpApp = testGoogleApp +handleGoogleCallback :: + IdpApplication Google AuthorizationCodeApplication -> + ExchangeToken -> + ExceptT TL.Text IO DemoUser +handleGoogleCallback idpApp code = do mgr <- liftIO $ newManager tlsManagerSettings tokenResp <- withExceptT oauth2ErrorToText (conduitTokenRequest idpApp mgr code) - GoogleUser {..} <- withExceptT bslToText $ conduitUserInfoRequest idpApp mgr (accessToken tokenResp) + GoogleUser {..} <- withExceptT bslToText $ Google.fetchUserInfo idpApp mgr (accessToken tokenResp) pure (DemoUser name (Just email)) ------------------------------ @@ -198,9 +208,6 @@ ------------------------------ -uriToText :: URI -> TL.Text -uriToText = TL.fromStrict . T.decodeUtf8 . serializeURIRef' - bslToText :: BSL.ByteString -> TL.Text bslToText = TL.pack . BSL.unpack @@ -225,5 +232,5 @@ result <- liftIO $ runExceptT e either Scotty.raise pure result -oauth2ErrorToText :: TokenRequestError -> TL.Text +oauth2ErrorToText :: TokenResponseError -> TL.Text oauth2ErrorToText e = TL.pack $ "Unable fetch access token. error detail: " ++ show e