hoauth2-demo 1.12.1 → 1.12.2
raw patch · 9 files changed
+252/−183 lines, 9 filesdep +pretty-simpledep ~containersdep ~hoauth2dep ~hoauth2-providers
Dependencies added: pretty-simple
Dependency ranges changed: containers, hoauth2, hoauth2-providers, mustache, parsec, uri-bytestring, wai-middleware-static
Files
- hoauth2-demo.cabal +11/−10
- public/templates/index.mustache +1/−2
- sample.env.json +97/−91
- src/App.hs +46/−35
- src/Env.hs +42/−13
- src/Idp.hs +42/−25
- src/Session.hs +1/−1
- src/Types.hs +4/−4
- src/User.hs +8/−2
hoauth2-demo.cabal view
@@ -1,9 +1,9 @@ cabal-version: 2.4 name: hoauth2-demo-version: 1.12.1+version: 1.12.2 synopsis: hoauth2 demo application description:- Demo application to test oauth2 flow with many providers using hoauth2+ Demo application for testing OAuth2 flows with many providers using hoauth2 homepage: https://github.com/freizl/hoauth2 license: MIT@@ -25,7 +25,7 @@ source-repository head type: git- location: git://github.com/freizl/hoauth2.git+ location: https://github.com/freizl/hoauth2.git flag breakpoint description: Turn on breakpoint plugin@@ -64,22 +64,23 @@ , aeson >=2.0 && <2.3 , base >=4.11 && <5 , bytestring >=0.9 && <0.13- , containers >=0.6 && <0.8+ , containers >=0.6 && <0.9 , data-default ^>=0.8 , directory ^>=1.3- , hoauth2 >=2.9 && <2.15- , hoauth2-providers >=0.3 && <0.9+ , hoauth2 >=2.9 && <2.16+ , hoauth2-providers >=0.3 && <0.10 , http-conduit >=2.1 && <2.4 , http-types >=0.11 && <0.13 , jose-jwt >=0.10 && <0.11- , mustache >=2.2.3 && <2.5.0- , parsec >=3.1.11 && <3.2.0+ , mustache >=2.2.3 && <2.5+ , parsec >=3.1.11 && <3.2+ , pretty-simple >=4.1 && <4.2 , scotty >=0.10.0 && <0.13 , text >=2.0 && <2.3 , transformers >=0.4 && <0.7- , uri-bytestring >=0.2.3 && <0.4+ , uri-bytestring >=0.4 && <0.5 , wai ^>=3.2- , wai-middleware-static >=0.8.1 && <0.10.0+ , wai-middleware-static >=0.8.1 && <0.10 , warp >=3.2 && <3.4 ghc-options:
public/templates/index.mustache view
@@ -14,7 +14,7 @@ {{#isLogin}} <h2>Welcome to {{idpName}}</h2> {{#user}}- <div class="result">Hello, {{idpName}}</div>+ <div class="result">Hello, {{name}}</div> {{/user}} <a href="/logout?idp={{idpName}}">Logout</a> <a href="/refresh-token?idp={{idpName}}">Refresh</a>@@ -68,7 +68,6 @@ <h2>Notes</h2> <ol>- <li>For StackExchange, the callback URI cannot have port, hence have manually add port 9988 in browser when Stack Exchange redirects back.</li> <li>For Slack, the callback url has to be https and without any port hence also need manual intervention. (TODO: add tls to the server)</li> </ol> </p>
sample.env.json view
@@ -1,96 +1,102 @@ {- "sample-okta-authorization-code-app": {- "client_id": "",- "client_secret": ""- },- "sample-okta-device-authorization-app": {- "client_id": "",- "client_secret": "",- "scopes": [- "openid",- "profile",- "email"- ]- },- "sample-okta-client-credentials-app-jwt": {- "client_id": "",- "client_secret": "",- "scopes": [- "okta.users.read"- ]- },- "sample-okta-client-credentials-app": {- "client_id": "",- "client_secret": "",- "scopes": [- "hw-test"- ]- },- "sample-okta-resource-owner-app": {- "client_id": "",- "client_secret": "",- "scopes": [],- "user": {- "username": "",- "password": ""- }- },- "sample-twitter-authorization-code-app": {- "client_id": "",- "client_secret": ""- },- "sample-azure-device-authorization-app": {- "client_id": "",- "client_secret": ""- },- "sample-google-authorization-code-app": {- "client_id": "",- "client_secret": ""- },- "sample-google-device-authorization-app": {- "client_id": "",- "client_secret": "",- "scopes": [- "https://www.googleapis.com/auth/userinfo.email",- "https://www.googleapis.com/auth/userinfo.profile"- ]- },- "sample-auth0-authorization-code-app": {- "client_id": "",- "client_secret": ""- },- "sample-auth0-device-authorization-app": {- "client_id": "",- "client_secret": "",- "scopes": [- "openid",- "profile",- "email",- "offline_access"- ]- },- "sample-auth0-client-credentials-app": {- "client_id": "",- "client_secret": "",- "scopes": [- "read:users"- ]+ "domains": {+ "auth0": "xyz.auth0.com",+ "okta": "xyz.okta.com" },- "sample-auth0-resource-owner-app": {- "client_id": "",- "client_secret": "",- "scopes": [],- "user": {- "username": "",- "password": ""+ "apps": {+ "sample-okta-authorization-code-app": {+ "client_id": "",+ "client_secret": ""+ },+ "sample-okta-device-authorization-app": {+ "client_id": "",+ "client_secret": "",+ "scopes": [+ "openid",+ "profile",+ "email"+ ]+ },+ "sample-okta-client-credentials-app-jwt": {+ "client_id": "",+ "client_secret": "",+ "scopes": [+ "okta.users.read"+ ]+ },+ "sample-okta-client-credentials-app": {+ "client_id": "",+ "client_secret": "",+ "scopes": [+ "hw-test"+ ]+ },+ "sample-okta-resource-owner-app": {+ "client_id": "",+ "client_secret": "",+ "scopes": [],+ "user": {+ "username": "",+ "password": ""+ }+ },+ "sample-twitter-authorization-code-app": {+ "client_id": "",+ "client_secret": ""+ },+ "sample-azure-device-authorization-app": {+ "client_id": "",+ "client_secret": ""+ },+ "sample-google-authorization-code-app": {+ "client_id": "",+ "client_secret": ""+ },+ "sample-google-device-authorization-app": {+ "client_id": "",+ "client_secret": "",+ "scopes": [+ "https://www.googleapis.com/auth/userinfo.email",+ "https://www.googleapis.com/auth/userinfo.profile"+ ]+ },+ "sample-auth0-authorization-code-app": {+ "client_id": "",+ "client_secret": ""+ },+ "sample-auth0-device-authorization-app": {+ "client_id": "",+ "client_secret": "",+ "scopes": [+ "openid",+ "profile",+ "email",+ "offline_access"+ ]+ },+ "sample-auth0-client-credentials-app": {+ "client_id": "",+ "client_secret": "",+ "scopes": [+ "read:users"+ ]+ },+ "sample-auth0-resource-owner-app": {+ "client_id": "",+ "client_secret": "",+ "scopes": [],+ "user": {+ "username": "",+ "password": ""+ }+ },+ "sample-github-authorization-code-app": {+ "client_id": "",+ "client_secret": ""+ },+ "sample-github-device-authorization-app": {+ "client_id": "",+ "client_secret": "" }- },- "sample-github-authorization-code-app": {- "client_id": "",- "client_secret": ""- },- "sample-github-device-authorization-app": {- "client_id": "",- "client_secret": "" } }
src/App.hs view
@@ -16,8 +16,8 @@ import Idp import Network.HTTP.Conduit import Network.HTTP.Types-import Network.OAuth.OAuth2-import Network.OAuth.OAuth2 qualified as OAuth2+import Network.OAuth2+import Network.OAuth2 qualified as OAuth2 import Network.OAuth2.Experiment import Network.OAuth2.Provider import Network.OAuth2.Provider.Auth0 qualified as Auth0@@ -26,6 +26,7 @@ import Network.Wai.Handler.Warp (run) import Network.Wai.Middleware.Static import Session+import Text.Pretty.Simple import Types import URI.ByteString qualified as URI import User@@ -51,16 +52,15 @@ waiApp :: IO WAI.Application waiApp = do re <- runExceptT $ do- myAuth0Idp <- Auth0.mkAuth0Idp "freizl.auth0.com"- myOktaIdp <- Okta.mkOktaIdp "dev-494096.okta.com"- -- myOktaIdp <- Okta.mkOktaIdp "dev-494096.okta.com/oauth2/default"+ oauthConfigs <- readEnvFile+ myAuth0Idp <- Auth0.mkAuth0Idp (auth0Domain $ domains oauthConfigs)+ myOktaIdp <- Okta.mkOktaIdp (oktaDomain $ domains oauthConfigs) let oidcIdps = (myAuth0Idp, myOktaIdp)- oauthAppSettings <- readEnvFile sessionStore <- liftIO (initUserStore allIdpNames) let findIdpByName = findIdp oidcIdps pure AppEnv {..} case re of- Left e -> Prelude.error $ TL.unpack $ "unable to init demo server: \n" <> e+ Left e -> Prelude.error $ TL.unpack $ "Unable to initialize demo server:\n" <> e Right r -> initApp r initApp ::@@ -120,7 +120,6 @@ -- FIXME -- Assume it's Okta for now but shall parse iss and figure out the right IdP. -- let issUri = URI.parseURI URI.strictURIParserOptions (T.encodeUtf8 $ TL.toStrict iss)- -- authRequestUri <- exceptToActionM (createAuthorizationUri appEnv Okta) let authRequestUriText = TL.fromStrict (uriToText authRequestUri) if iss `TL.isPrefixOf` authRequestUriText@@ -165,14 +164,16 @@ -- (Text, Text) pas <- params let stateP = paramValue "state" pas- when (null stateP) (raise "callbackH: no state from callback request") let codeP = paramValue "code" pas- when (null codeP) (raise "callbackH: no code from callback request")- let idpName = fromText $ TL.takeWhile (/= '.') (head stateP)- exceptToActionM $ do- idpData <- lookupAppSessionData sessionStore idpName- fetchTokenAndUser appEnv idpData (ExchangeToken $ TL.toStrict $ head codeP)- redirectToHomeM+ case (stateP, codeP) of+ ([], _) -> raise "callbackH: no state from callback request"+ (_, []) -> raise "callbackH: no code from callback request"+ (state : _, code : _) -> do+ let idpName = fromText $ TL.takeWhile (/= '.') state+ exceptToActionM $ do+ idpData <- lookupAppSessionData sessionStore idpName+ fetchTokenAndUser appEnv idpData (ExchangeToken $ TL.toStrict code)+ redirectToHomeM refreshTokenH :: AppEnv ->@@ -184,9 +185,9 @@ idpData <- lookupAppSessionData sessionStore idpName newToken <- doRefreshToken authCodeApp idpData liftIO $ do- putStrLn "=== refreshTokenH === got new token"- print newToken- upsertAppSessionData sessionStore idpName (idpData {oauth2Token = Just newToken})+ putStrLn "[refreshTokenH] Get new token"+ pPrint newToken+ upsertAppSessionData sessionStore idpName (idpData {tokenResponse = Just newToken}) redirectToHomeM testPasswordGrantTypeH ::@@ -197,11 +198,19 @@ (DemoIdp idp) <- pure (findIdpByName idpName) idpApp <- createResourceOwnerPasswordApp idp idpName mgr <- liftIO $ newManager tlsManagerSettings- token <- withExceptT tokenRequestErrorErrorToText $ conduitTokenRequest idpApp mgr NoNeedExchangeToken+ token <-+ withExceptT tokenRequestErrorErrorToText $+ conduitTokenRequest+ idpApp+ mgr+ NoNeedExchangeToken+ liftIO $ do+ putStrLn "[testPasswordGrantTypeH] Find token"+ pPrint token user <- tryFetchUser idpName idpApp mgr token liftIO $ do- putStrLn "=== testPasswordGrantTypeH find token ==="- print user+ putStrLn "[testPasswordGrantTypeH] Find token"+ pPrint user redirectToHomeM testClientCredentialGrantTypeH ::@@ -235,10 +244,10 @@ TL.putStrLn $ TL.fromStrict $ uriToText (verificationUri deviceAuthResp) atoken <- withExceptT tokenRequestErrorErrorToText (pollDeviceTokenRequest deviceAuthApp mgr deviceAuthResp) liftIO $ do- putStrLn "=== testDeviceCodeGrantTypeH found token ==="- print atoken+ putStrLn "[testDeviceCodeGrantTypeH] Found token"+ pPrint atoken luser <- tryFetchUser idpName deviceAuthApp mgr atoken- liftIO $ print luser+ liftIO $ pPrint luser redirectToHomeM -- Only testing google for now@@ -283,21 +292,20 @@ mgr <- liftIO $ newManager tlsManagerSettings token <- tryFetchAccessToken authCodeIdpApp mgr exchangeToken liftIO $ do- putStrLn "[Authorization Code Flow] Found access token"- print token+ putStrLn $ "[Authorization Code Flow] Found access token for " <> show idpName+ pPrint token luser <- tryFetchUser idpName authCodeIdpApp mgr token liftIO $ do- print luser upsertAppSessionData sessionStore idpName- (idpData {loginUser = Just luser, oauth2Token = Just token})+ (idpData {loginUser = Just luser, tokenResponse = Just token}) where tryFetchAccessToken :: IdpApplication i AuthorizationCodeApplication -> Manager -> ExchangeToken ->- ExceptT Text IO OAuth2Token+ ExceptT Text IO TokenResponse tryFetchAccessToken idpApp mgr exchangeTokenText = do if isSupportPkce idpName then do@@ -310,7 +318,7 @@ else withExceptT tokenRequestErrorErrorToText $ conduitTokenRequest idpApp mgr exchangeTokenText tokenRequestErrorErrorToText :: TokenResponseError -> Text-tokenRequestErrorErrorToText e = TL.pack $ "conduitTokenRequest - cannot fetch access token. error detail: " ++ show e+tokenRequestErrorErrorToText e = "conduitTokenRequest - cannot fetch access token. error detail: " <> pShowNoColor e tryFetchUser :: forall i a.@@ -318,21 +326,24 @@ IdpName -> IdpApplication i a -> Manager ->- OAuth2Token ->+ TokenResponse -> ExceptT Text IO DemoLoginUser tryFetchUser idpName idpAppConfig mgr at = do let fetchMethod = findFetchUserInfoMethod idpName- user <- withExceptT bslToText $ do+ user <- withExceptT pShowNoColor $ do fetchMethod idpAppConfig mgr (accessToken at) pure $ toLoginUser @i user doRefreshToken :: IdpApplication i AuthorizationCodeApplication -> IdpAuthorizationCodeAppSessionData ->- ExceptT Text IO OAuth2Token+ ExceptT Text IO TokenResponse doRefreshToken idpAppConfig (IdpAuthorizationCodeAppSessionData {..}) = do- at <- maybe (throwE "no token response found for idp") pure oauth2Token+ at <- maybe (throwE "no token response found for idp") pure tokenResponse rt <- maybe (throwE "no refresh token found for idp") pure (OAuth2.refreshToken at)- withExceptT (TL.pack . show) $ do+ newTokenResponse <- withExceptT pShowNoColor $ do mgr <- liftIO $ newManager tlsManagerSettings conduitRefreshTokenRequest idpAppConfig mgr rt+ -- Issue a new refresh token is optional. Reuse the older if there is no new refresh token+ let refreshToken = fromMaybe rt (OAuth2.refreshToken newTokenResponse)+ pure newTokenResponse {OAuth2.refreshToken = Just refreshToken}
src/Env.hs view
@@ -13,26 +13,40 @@ import Network.OAuth2.Experiment import System.Directory -newtype OAuthAppSettings = OAuthAppSettings (Aeson.KeyMap OAuthAppSetting)+data OAuthDomains = OAuthDomains+ { auth0Domain :: Text+ , oktaDomain :: Text+ }++instance FromJSON OAuthDomains where+ parseJSON = withObject "parseJSON OAuthDomains" $ \t -> do+ auth0Domain <- t .: "auth0"+ oktaDomain <- t .: "okta"+ pure OAuthDomains {..}++newtype OAuthApps = OAuthApps (Aeson.KeyMap OAuthApp) deriving (Generic) -instance FromJSON OAuthAppSettings+unOAuthApps :: OAuthApps -> Aeson.KeyMap OAuthApp+unOAuthApps (OAuthApps x) = x -data OAuthAppSetting = OAuthAppSetting+instance FromJSON OAuthApps++data OAuthApp = OAuthApp { clientId :: ClientId , clientSecret :: ClientSecret , scopes :: Set.Set Scope , user :: Maybe UserConfig } -instance FromJSON OAuthAppSetting where- parseJSON = withObject "parseJSON OAuthAppSetting" $ \t -> do+instance FromJSON OAuthApp where+ parseJSON = withObject "parseJSON OAuthApp" $ \t -> do clientId <- ClientId <$> t .: "client_id" clientSecret <- ClientSecret <$> t .: "client_secret" scopeTexts <- t .:? "scopes" user <- t .:? "user" let scopes = Set.map Scope (Set.fromList (fromMaybe [] scopeTexts))- pure OAuthAppSetting {..}+ pure OAuthApp {..} data UserConfig = UserConfig { username :: Text@@ -42,10 +56,21 @@ instance FromJSON UserConfig +data OAuthConfigs = OAuthConfigs+ { domains :: OAuthDomains+ , apps :: OAuthApps+ }++instance FromJSON OAuthConfigs where+ parseJSON = withObject "parseJSON OAuthConfigs" $ \t -> do+ domains <- t .: "domains"+ apps <- t .: "apps"+ pure OAuthConfigs {..}+ envFilePath :: String envFilePath = ".env.json" -readEnvFile :: MonadIO m => ExceptT Text m OAuthAppSettings+readEnvFile :: MonadIO m => ExceptT Text m OAuthConfigs readEnvFile = do withExceptT wrapError $ ExceptT $@@ -56,17 +81,21 @@ wrapError :: String -> Text wrapError = TL.pack . ("Error when try to load .env.json\n" <>) -lookup :: MonadIO m => Text -> ExceptT Text m OAuthAppSetting-lookup idpAppName = do+lookupApp :: MonadIO m => Text -> ExceptT Text m OAuthApp+lookupApp idpAppName = do envs <- readEnvFile- lookupWith envs idpAppName+ lookupAppWith envs idpAppName -lookupWith :: MonadIO m => OAuthAppSettings -> Text -> ExceptT Text m OAuthAppSetting-lookupWith (OAuthAppSettings val) idpAppName = do+lookupAppWith :: MonadIO m => OAuthConfigs -> Text -> ExceptT Text m OAuthApp+lookupAppWith OAuthConfigs {..} idpAppName = do let key = TL.toLower idpAppName- resp = Aeson.lookup (Aeson.fromString $ TL.unpack key) val+ resp = Aeson.lookup (Aeson.fromString $ TL.unpack key) (unOAuthApps apps) except $ maybe (Left $ "[ Env.lookupWith ] Unable to load config for " <> key) Right resp++lookupAuth0Domain :: MonadIO m => ExceptT Text m Text+lookupAuth0Domain =+ auth0Domain . domains <$> readEnvFile
src/Idp.hs view
@@ -21,7 +21,7 @@ import Env qualified import Jose.Jwt import Network.HTTP.Conduit-import Network.OAuth.OAuth2+import Network.OAuth2 import Network.OAuth2.Experiment import Network.OAuth2.Provider import Network.OAuth2.Provider.Auth0 qualified as IAuth0@@ -31,6 +31,7 @@ import Network.OAuth2.Provider.Fitbit qualified as IFitbit import Network.OAuth2.Provider.GitHub qualified as IGitHub import Network.OAuth2.Provider.Google qualified as IGoogle+import Network.OAuth2.Provider.Linear qualified as ILinear import Network.OAuth2.Provider.LinkedIn qualified as ILinkedIn import Network.OAuth2.Provider.Okta qualified as IOkta import Network.OAuth2.Provider.Slack qualified as ISlack@@ -39,7 +40,7 @@ import Network.OAuth2.Provider.Weibo qualified as IWeibo import Network.OAuth2.Provider.ZOHO qualified as IZOHO import Types-import URI.ByteString (URI)+import URI.ByteString (URI, URIRef (uriPath)) import URI.ByteString.QQ (uri) import User import Prelude hiding (id)@@ -54,7 +55,7 @@ createAuthorizationCodeApp idp idpName = do let newAppName = "sample-" <> toText idpName <> "-authorization-code-app" let sampleApp = findAuthorizationCodeSampleApp idpName- Env.OAuthAppSetting {..} <- Env.lookup newAppName+ Env.OAuthApp {..} <- Env.lookupApp newAppName let newApp' = sampleApp { acClientId = clientId@@ -81,10 +82,11 @@ , ropUserName = "" , ropPassword = "" , ropTokenRequestExtraParams = Map.empty+ , ropClientAuthenticationMethod = ClientSecretBasic }- Env.OAuthAppSetting {..} <- Env.lookup newAppName+ Env.OAuthApp {..} <- Env.lookupApp newAppName newApp' <- case user of- Nothing -> throwE ("[createResourceOwnerPasswordApp] unable to load user config for " <> toText idpName)+ Nothing -> throwE ("[createResourceOwnerPasswordApp] Unable to load user config for " <> toText idpName) Just userConfig -> pure defaultApp@@ -110,32 +112,43 @@ ClientCredentialsApplication { ccClientId = "" , ccClientSecret = ""- , ccTokenRequestAuthenticationMethod = ClientSecretPost+ , ccClientAuthenticationMethod = ClientSecretBasic , ccName = "" , ccScope = Set.empty , ccTokenRequestExtraParams = Map.empty } - Env.OAuthAppSetting {..} <- Env.lookup newAppName+ appSetting@Env.OAuthApp {..} <- Env.lookupApp newAppName newApp <- case idpName of- Auth0 ->+ Auth0 -> do+ auth0Domain <- Env.lookupAuth0Domain+ let audience = "https://" <> auth0Domain <> "/api/v2/" pure defaultApp- { ccTokenRequestExtraParams = Map.fromList [("audience ", "https://freizl.auth0.com/api/v2/")]- }- -- Okta -> createOktaClientCredentialsGrantAppJwt i appSetting- _ -> pure defaultApp- let newApp' =- newApp- { ccClientId = clientId+ { ccTokenRequestExtraParams = Map.fromList [("audience", audience)]+ , ccClientId = clientId , ccClientSecret = clientSecret , ccScope = scopes , ccName = newAppName }+ Okta -> do+ -- ORG AS only support private key jwt+ -- Custom AS support both. In this demo app, just default to client secret+ if uriPath (idpTokenEndpoint i) == "/oauth2/v1/token"+ then createOktaClientCredentialsGrantAppJwt i appSetting+ else+ pure+ defaultApp+ { ccClientId = clientId+ , ccClientSecret = clientSecret+ , ccScope = scopes+ , ccName = newAppName+ }+ _ -> pure defaultApp pure $ IdpApplication { idp = i- , application = newApp'+ , application = newApp } -- Base on the document, it works well with both custom Athourization Server and Org As.@@ -144,12 +157,13 @@ -- But with Org AS, has to use jwt athentication method otherwise got error -- Client Credentials requests to the Org Authorization Server must use the private_key_jwt token_endpoint_auth_method ----- FIXME: Get error from Okta about parsing assertion error+-- FIXME: Get error from Okta "The parsing of the client_assertion failed."+-- createOktaClientCredentialsGrantAppJwt :: Idp i ->- Env.OAuthAppSetting ->+ Env.OAuthApp -> ExceptT Text IO ClientCredentialsApplication-createOktaClientCredentialsGrantAppJwt i Env.OAuthAppSetting {..} = do+createOktaClientCredentialsGrantAppJwt i Env.OAuthApp {..} = do keyJsonStr <- liftIO $ BS.readFile ".okta-key.json" jwk <- except (first TL.pack $ Aeson.eitherDecodeStrict keyJsonStr) jwt <- ExceptT $ IOkta.mkOktaClientCredentialAppJwt jwk clientId i@@ -157,9 +171,9 @@ ClientCredentialsApplication { ccClientId = clientId , ccClientSecret = ClientSecret (TL.decodeUtf8 $ bsFromStrict $ unJwt jwt)- , ccTokenRequestAuthenticationMethod = ClientAssertionJwt+ , ccClientAuthenticationMethod = ClientAssertionJwt , ccName = ""- , ccScope = Set.empty+ , ccScope = scopes , ccTokenRequestExtraParams = Map.empty } @@ -170,8 +184,8 @@ createDeviceAuthApp i idpName = do let authMethod = if Okta == idpName- then Just ClientSecretBasic- else Nothing+ then ClientSecretBasic+ else ClientSecretPost extraParams = if AzureAD == idpName then Map.singleton "tenant" "/common"@@ -186,7 +200,7 @@ , daAuthorizationRequestExtraParam = extraParams , daAuthorizationRequestAuthenticationMethod = authMethod }- Env.OAuthAppSetting {..} <- Env.lookup newAppName+ Env.OAuthApp {..} <- Env.lookupApp newAppName let newApp' = newApp { daClientId = clientId@@ -237,12 +251,13 @@ GitHub -> DemoIdp IGitHub.defaultGithubIdp DropBox -> DemoIdp IDropBox.defaultDropBoxIdp Google -> DemoIdp IGoogle.defaultGoogleIdp+ Linear -> DemoIdp ILinear.defaultLinearIdp LinkedIn -> DemoIdp ILinkedIn.defaultLinkedInIdp Twitter -> DemoIdp ITwitter.defaultTwitterIdp Slack -> DemoIdp ISlack.defaultSlackIdp Weibo -> DemoIdp IWeibo.defaultWeiboIdp ZOHO -> DemoIdp IZOHO.defaultZohoIdp- StackExchange -> DemoIdp IStackExchange.defaultStackExchangeIdp+ StackExchange -> DemoIdp (IStackExchange.defaultStackExchangeIdp "xyz") findAuthorizationCodeSampleApp :: IdpName -> AuthorizationCodeApplication findAuthorizationCodeSampleApp = \case@@ -254,6 +269,7 @@ GitHub -> IGitHub.sampleGithubAuthorizationCodeApp DropBox -> IDropBox.sampleDropBoxAuthorizationCodeApp Google -> IGoogle.sampleGoogleAuthorizationCodeApp+ Linear -> ILinear.sampleLinearAuthorizationCodeApp LinkedIn -> ILinkedIn.sampleLinkedInAuthorizationCodeApp Twitter -> ITwitter.sampleTwitterAuthorizationCodeApp Slack -> ISlack.sampleSlackAuthorizationCodeApp@@ -278,6 +294,7 @@ GitHub -> IGitHub.fetchUserInfo DropBox -> IDropBox.fetchUserInfo Google -> IGoogle.fetchUserInfo+ Linear -> ILinear.fetchUserInfo LinkedIn -> ILinkedIn.fetchUserInfo Twitter -> ITwitter.fetchUserInfo Slack -> ISlack.fetchUserInfo
src/Session.hs view
@@ -75,6 +75,6 @@ mm except $ maybe- (Left $ "[lookupAppSessionData] unable to find cache data for idp " <> toText idpName)+ (Left $ "[lookupAppSessionData] Unable to find cache data for IdP " <> toText idpName) Right (Map.lookup idpName m1)
src/Types.hs view
@@ -14,7 +14,7 @@ import Data.Text.Lazy (Text) import Data.Text.Lazy qualified as TL import Env-import Network.OAuth.OAuth2+import Network.OAuth2 import Network.OAuth2.Experiment import Network.OAuth2.Provider import Text.Mustache ((~>))@@ -38,7 +38,7 @@ type TenantBasedIdps = (Idp Auth0, Idp Okta) data AppEnv = AppEnv- { oauthAppSettings :: OAuthAppSettings+ { oauthConfigs :: OAuthConfigs , oidcIdps :: TenantBasedIdps , findIdpByName :: IdpName -> DemoIdp , sessionStore :: AuthorizationGrantUserStore@@ -52,7 +52,7 @@ data IdpAuthorizationCodeAppSessionData = IdpAuthorizationCodeAppSessionData { idpName :: IdpName , loginUser :: Maybe DemoLoginUser- , oauth2Token :: Maybe OAuth2Token+ , tokenResponse :: Maybe TokenResponse , authorizePkceCodeVerifier :: Maybe CodeVerifier , authorizeAbsUri :: TL.Text }@@ -62,7 +62,7 @@ IdpAuthorizationCodeAppSessionData { idpName = Okta , loginUser = Nothing- , oauth2Token = Nothing+ , tokenResponse = Nothing , authorizePkceCodeVerifier = Nothing , authorizeAbsUri = "" }
src/User.hs view
@@ -13,6 +13,7 @@ import Network.OAuth2.Provider.Fitbit qualified as IFitbit import Network.OAuth2.Provider.GitHub qualified as IGitHub import Network.OAuth2.Provider.Google qualified as IGoogle+import Network.OAuth2.Provider.Linear qualified as ILinear import Network.OAuth2.Provider.LinkedIn qualified as ILinkedIn import Network.OAuth2.Provider.Okta qualified as IOkta import Network.OAuth2.Provider.Slack qualified as ISlack@@ -90,12 +91,17 @@ toLoginUser :: IGitHub.GitHubUser -> DemoLoginUser toLoginUser guser = DemoLoginUser {loginUserName = IGitHub.name guser} +instance HasDemoLoginUser Linear where+ type IdpUser Linear = ILinear.LinearResponse ILinear.LinearUser+ toLoginUser :: ILinear.LinearResponse ILinear.LinearUser -> DemoLoginUser+ toLoginUser resp = DemoLoginUser {loginUserName = ILinear.name (ILinear.getUser resp)}+ instance HasDemoLoginUser LinkedIn where type IdpUser LinkedIn = ILinkedIn.LinkedInUser toLoginUser :: ILinkedIn.LinkedInUser -> DemoLoginUser toLoginUser ILinkedIn.LinkedInUser {..} = DemoLoginUser- { loginUserName = localizedFirstName <> " " <> localizedLastName+ { loginUserName = name <> " " <> email } instance HasDemoLoginUser Twitter where@@ -106,7 +112,7 @@ instance HasDemoLoginUser Okta where type IdpUser Okta = IOkta.OktaUser toLoginUser :: IOkta.OktaUser -> DemoLoginUser- toLoginUser ouser = DemoLoginUser {loginUserName = IOkta.name ouser}+ toLoginUser ouser = DemoLoginUser {loginUserName = IOkta.email ouser <> " " <> IOkta.preferredUsername ouser} instance HasDemoLoginUser Slack where type IdpUser Slack = ISlack.SlackUser