hoauth2-providers-tutorial 0.2 → 0.3.0

raw patch · 2 files changed

+95/−93 lines, 2 filesdep −aesondep −waidep −warpdep ~containersdep ~hoauth2dep ~hoauth2-providersPVP ok

version bump matches the API change (PVP)

Dependencies removed: aeson, wai, warp

Dependency ranges changed: containers, hoauth2, hoauth2-providers, text, transformers

API changes (from Hackage documentation)

Files

• hoauth2-providers-tutorial.cabal +10/−15
• src/HOAuth2ProvidersTutorial.hs +85/−78

@@ -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

@@ -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 <https://www.rfc-editor.org/rfc/rfc6749#section-10.12>@@ -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 $ "<h1>hoauth2 providers Tutorial</h1>" : 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