diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT 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. diff --git a/hoauth2-providers.cabal b/hoauth2-providers.cabal new file mode 100644 --- /dev/null +++ b/hoauth2-providers.cabal @@ -0,0 +1,73 @@ +cabal-version: 2.4 +name: hoauth2-providers +version: 0.1 +synopsis: OAuth2 Identity Providers +description: + A list of Identity Providers base on hoauth2 Haskell OAuth2 binding + +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: + +source-repository head + type: git + location: git://github.com/freizl/hoauth2.git + +library + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: + DataKinds + DeriveGeneric + GeneralizedNewtypeDeriving + ImportQualifiedPost + OverloadedStrings + RecordWildCards + TypeApplications + TypeFamilies + + exposed-modules: + Network.OAuth2.Provider.Auth0 + Network.OAuth2.Provider.AzureAD + Network.OAuth2.Provider.Dropbox + Network.OAuth2.Provider.Facebook + Network.OAuth2.Provider.Fitbit + Network.OAuth2.Provider.Github + Network.OAuth2.Provider.Google + Network.OAuth2.Provider.Linkedin + Network.OAuth2.Provider.Okta + Network.OAuth2.Provider.Slack + Network.OAuth2.Provider.StackExchange + Network.OAuth2.Provider.Weibo + Network.OAuth2.Provider.ZOHO + Network.OIDC.WellKnown + + build-depends: + , aeson >=2.0 && <2.2 + , base >=4.5 && <5 + , bytestring >=0.9 && <0.12 + , containers ^>=0.6 + , data-default ^>=0.7 + , directory ^>=1.3 + , hoauth2 ^>=2.6 + , http-conduit >=2.1 && <2.4 + , http-types >=0.11 && <0.13 + , mtl + , parsec >=3.1.11 && <3.2.0 + , text >=0.11 && <1.3 + , transformers ^>=0.5 + , unordered-containers >=0.2.5 + , uri-bytestring >=0.2.3 && <0.4 + + ghc-options: + -Wall -Wtabs -Wno-unused-do-bind -Wunused-packages -Wpartial-fields + -Wwarnings-deprecations diff --git a/src/Network/OAuth2/Provider/Auth0.hs b/src/Network/OAuth2/Provider/Auth0.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Auth0.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Auth0 where + +import Control.Monad.IO.Class +import Control.Monad.Trans.Except +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import Network.OIDC.WellKnown +import URI.ByteString.QQ + +data Auth0 = Auth0 + deriving (Show, Eq) + +type instance IdpUserInfo Auth0 = Auth0User + +defaultAuth0App :: Idp Auth0 -> IdpApplication 'AuthorizationCode Auth0 +defaultAuth0App i = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.fromList ["openid", "profile", "email", "offline_access"], + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-auth0-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = i + } + +defaultAuth0Idp :: Idp Auth0 +defaultAuth0Idp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo Auth0), + -- https://auth0.com/docs/api/authentication#user-profile + idpUserInfoEndpoint = [uri|https://foo.auth0.com/userinfo|], + -- https://auth0.com/docs/api/authentication#authorization-code-flow + idpAuthorizeEndpoint = [uri|https://foo.auth0.com/authorize|], + -- https://auth0.com/docs/api/authentication#authorization-code-flow44 + idpTokenEndpoint = [uri|https://foo.auth0.com/oauth/token|] + } + +mkAuth0Idp :: + MonadIO m => + -- | Full domain with no http protocol. e.g. @foo.auth0.com@ + Text -> + ExceptT Text m (Idp Auth0) +mkAuth0Idp domain = do + OpenIDConfigurationUris {..} <- fetchWellKnownUris domain + pure + ( defaultAuth0Idp + { idpUserInfoEndpoint = userinfoUri, + idpAuthorizeEndpoint = authorizationUri, + idpTokenEndpoint = tokenUri + } + ) + +-- | scopes: ["openid", "profile", "email"] +data Auth0User = Auth0User + { name :: Text, + email :: Text, + sub :: Text + } + deriving (Show, Generic) + +instance FromJSON Auth0User diff --git a/src/Network/OAuth2/Provider/AzureAD.hs b/src/Network/OAuth2/Provider/AzureAD.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/AzureAD.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Network.OAuth2.Provider.AzureAD where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +data AzureAD = AzureAD deriving (Eq, Show) + +type instance IdpUserInfo AzureAD = AzureADUser + +defaultAzureADApp :: IdpApplication 'AuthorizationCode AzureAD +defaultAzureADApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.empty, + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.fromList [("resource", "https://graph.microsoft.com")], + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-azure-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = defaultAzureADIdp + } + +defaultAzureADIdp :: Idp AzureAD +defaultAzureADIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo AzureAD), + idpUserInfoEndpoint = [uri|https://graph.microsoft.com/v1.0/me|], + idpAuthorizeEndpoint = [uri|https://login.windows.net/common/oauth2/authorize|], + idpTokenEndpoint = [uri|https://login.windows.net/common/oauth2/token|] + } + +newtype AzureADUser = AzureADUser {mail :: Text} deriving (Show, Generic) + +instance FromJSON AzureADUser diff --git a/src/Network/OAuth2/Provider/Dropbox.hs b/src/Network/OAuth2/Provider/Dropbox.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Dropbox.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Dropbox where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +data Dropbox = Dropbox deriving (Eq, Show) + +type instance IdpUserInfo Dropbox = DropboxUser + +defaultDropboxApp :: IdpApplication 'AuthorizationCode Dropbox +defaultDropboxApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.empty, + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-dropbox-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = defaultDropboxIdp + } + +defaultDropboxIdp :: Idp Dropbox +defaultDropboxIdp = + Idp + { idpFetchUserInfo = \mgr at url -> authPostJSON @(IdpUserInfo Dropbox) mgr at url [], + idpAuthorizeEndpoint = [uri|https://www.dropbox.com/1/oauth2/authorize|], + idpTokenEndpoint = [uri|https://api.dropboxapi.com/oauth2/token|], + idpUserInfoEndpoint = [uri|https://api.dropboxapi.com/2/users/get_current_account|] + } + +newtype DropboxName = DropboxName {displayName :: Text} + deriving (Show, Generic) + +data DropboxUser = DropboxUser + { email :: Text, + name :: DropboxName + } + deriving (Show, Generic) + +instance FromJSON DropboxName where + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} + +instance FromJSON DropboxUser diff --git a/src/Network/OAuth2/Provider/Facebook.hs b/src/Network/OAuth2/Provider/Facebook.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Facebook.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Facebook where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +-- | TODO: rename to Meta +data Facebook = Facebook deriving (Eq, Show) + +type instance IdpUserInfo Facebook = FacebookUser + +defaultFacebookApp :: IdpApplication 'AuthorizationCode Facebook +defaultFacebookApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.fromList ["user_about_me", "email"], + idpAppAuthorizeExtraParams = Map.empty, + idpAppAuthorizeState = "CHANGE_ME", + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-facebook-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretPost, + idp = defaultFacebookIdp + } + +defaultFacebookIdp :: Idp Facebook +defaultFacebookIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo Facebook), + idpUserInfoEndpoint = [uri|https://graph.facebook.com/me?fields=id,name,email|], + idpAuthorizeEndpoint = [uri|https://www.facebook.com/dialog/oauth|], + idpTokenEndpoint = [uri|https://graph.facebook.com/v2.3/oauth/access_token|] + } + +data FacebookUser = FacebookUser + { id :: Text, + name :: Text, + email :: Text + } + deriving (Show, Generic) + +instance FromJSON FacebookUser diff --git a/src/Network/OAuth2/Provider/Fitbit.hs b/src/Network/OAuth2/Provider/Fitbit.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Fitbit.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Fitbit where + +import Control.Monad (mzero) +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +data Fitbit = Fitbit deriving (Eq, Show) + +type instance IdpUserInfo Fitbit = FitbitUser + +defaultFitbitApp :: IdpApplication 'AuthorizationCode Fitbit +defaultFitbitApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.empty, + idpAppAuthorizeExtraParams = Map.empty, + idpAppAuthorizeState = "CHANGE_ME", + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-fitbit-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = defaultFitbitIdp + } + +defaultFitbitIdp :: Idp Fitbit +defaultFitbitIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo Fitbit), + idpUserInfoEndpoint = [uri|https://api.fitbit.com/1/user/-/profile.json|], + idpAuthorizeEndpoint = [uri|https://www.fitbit.com/oauth2/authorize|], + idpTokenEndpoint = [uri|https://api.fitbit.com/oauth2/token|] + } + +data FitbitUser = FitbitUser + { userId :: Text, + userName :: Text, + userAge :: Int + } + deriving (Show, Eq) + +instance FromJSON FitbitUser where + parseJSON (Object o) = + FitbitUser + <$> ((o .: "user") >>= (.: "encodedId")) + <*> ((o .: "user") >>= (.: "fullName")) + <*> ((o .: "user") >>= (.: "age")) + parseJSON _ = mzero diff --git a/src/Network/OAuth2/Provider/Github.hs b/src/Network/OAuth2/Provider/Github.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Github.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Github where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +-- | http://developer.github.com/v3/oauth/ +data Github = Github deriving (Eq, Show) + +type instance IdpUserInfo Github = GithubUser + +defaultGithubApp :: IdpApplication 'AuthorizationCode Github +defaultGithubApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.empty, + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-github-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = defaultGithubIdp + } + +defaultGithubIdp :: Idp Github +defaultGithubIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo Github), + idpUserInfoEndpoint = [uri|https://api.github.com/user|], + idpAuthorizeEndpoint = [uri|https://github.com/login/oauth/authorize|], + idpTokenEndpoint = [uri|https://github.com/login/oauth/access_token|] + } + +data GithubUser = GithubUser + { name :: Text, + id :: Integer + } + deriving (Show, Generic) + +instance FromJSON GithubUser diff --git a/src/Network/OAuth2/Provider/Google.hs b/src/Network/OAuth2/Provider/Google.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Google.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Google where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +{- +To test at google playground, set redirect uri to "https://developers.google.com/oauthplayground" +-} + +data Google = Google deriving (Eq, Show) + +type instance IdpUserInfo Google = GoogleUser + +defaultGoogleApp :: IdpApplication 'AuthorizationCode Google +defaultGoogleApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + 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|], + idpAppName = "default-google-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = defaultGoogleIdp + } + +defaultGoogleIdp :: Idp Google +defaultGoogleIdp = + 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|] + } + +data GoogleUser = GoogleUser + { -- | "scope": "https://www.googleapis.com/auth/userinfo.profile"] + name :: Text, + id :: Text, + -- | "scopes": "https://www.googleapis.com/auth/userinfo.email", + email :: Text + } + deriving (Show, Generic) + +instance FromJSON GoogleUser diff --git a/src/Network/OAuth2/Provider/Linkedin.hs b/src/Network/OAuth2/Provider/Linkedin.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Linkedin.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Linkedin where + +{- +https://docs.microsoft.com/en-us/linkedin/shared/authentication/authorization-code-flow?context=linkedin%2Fcontext&tabs=HTTPS +module Network.OAuth2.Provider.Linkedin where +-} + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +data Linkedin = Linkedin deriving (Eq, Show) + +type instance IdpUserInfo Linkedin = LinkedinUser + +defaultLinkedinApp :: IdpApplication 'AuthorizationCode Linkedin +defaultLinkedinApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.fromList ["r_liteprofile"], + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-linkedin-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretPost, + idp = defaultLinkedinIdp + } + +defaultLinkedinIdp :: Idp Linkedin +defaultLinkedinIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo Linkedin), + idpUserInfoEndpoint = [uri|https://api.linkedin.com/v2/me|], + idpAuthorizeEndpoint = [uri|https://www.linkedin.com/oauth/v2/authorization|], + idpTokenEndpoint = [uri|https://www.linkedin.com/oauth/v2/accessToken|] + } + +data LinkedinUser = LinkedinUser + { localizedFirstName :: Text, + localizedLastName :: Text + } + deriving (Show, Generic, Eq) + +instance FromJSON LinkedinUser diff --git a/src/Network/OAuth2/Provider/Okta.hs b/src/Network/OAuth2/Provider/Okta.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Okta.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Okta where + +import Control.Monad.IO.Class +import Control.Monad.Trans.Except +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import Network.OIDC.WellKnown +import URI.ByteString.QQ + +data Okta = Okta deriving (Eq, Show) + +type instance IdpUserInfo Okta = OktaUser + +defaultOktaApp :: Idp Okta -> IdpApplication 'AuthorizationCode Okta +defaultOktaApp i = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.fromList ["openid", "profile", "email"], + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-okta-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = i + } + +defaultOktaIdp :: Idp Okta +defaultOktaIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo Okta), + idpUserInfoEndpoint = [uri|https://foo.okta.com/oauth2/v1/userinfo|], + idpAuthorizeEndpoint = + [uri|https://foo.okta.com/oauth2/v1/authorize|], + idpTokenEndpoint = + [uri|https://foo.okta.com/oauth2/v1/token|] + } + +mkOktaIdp :: + MonadIO m => + -- | Full domain with no http protocol. e.g. @foo.okta.com@ + Text -> + ExceptT Text m (Idp Okta) +mkOktaIdp domain = do + OpenIDConfigurationUris {..} <- fetchWellKnownUris domain + pure + ( defaultOktaIdp + { idpUserInfoEndpoint = userinfoUri, + idpAuthorizeEndpoint = authorizationUri, + idpTokenEndpoint = tokenUri + } + ) + +-- | https://developer.okta.com/docs/reference/api/oidc/#request-parameters +-- Okta Org AS doesn't support consent +-- Okta Custom AS does support consent via config (what scope shall prompt consent) +data OktaUser = OktaUser + { name :: Text, + preferredUsername :: Text + } + deriving (Show, Generic) + +instance FromJSON OktaUser where + parseJSON = + genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} diff --git a/src/Network/OAuth2/Provider/Slack.hs b/src/Network/OAuth2/Provider/Slack.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Slack.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.Slack where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +data Slack = Slack deriving (Show, Eq) + +type instance IdpUserInfo Slack = SlackUser + +defaultSlackApp :: IdpApplication 'AuthorizationCode Slack +defaultSlackApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.fromList ["openid", "profile"], + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idpAppName = "default-slack-App", + idp = defaultSlackIdp + } + +-- https://api.slack.com/authentication/sign-in-with-slack +-- https://slack.com/.well-known/openid-configuration +defaultSlackIdp :: Idp Slack +defaultSlackIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo Slack), + idpUserInfoEndpoint = [uri|https://slack.com/api/openid.connect.userInfo|], + idpAuthorizeEndpoint = [uri|https://slack.com/openid/connect/authorize|], + idpTokenEndpoint = [uri|https://slack.com/api/openid.connect.token|] + } + +data SlackUser = SlackUser + { name :: Text, + email :: Text + } + deriving (Show, Generic) + +instance FromJSON SlackUser diff --git a/src/Network/OAuth2/Provider/StackExchange.hs b/src/Network/OAuth2/Provider/StackExchange.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/StackExchange.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +{- + NOTES: stackexchange API spec and its document just sucks! +-} +module Network.OAuth2.Provider.StackExchange where + +import Data.Aeson +import Data.ByteString (ByteString) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString +import URI.ByteString.QQ + +-- fix key from your application edit page +-- https://stackapps.com/apps/oauth +stackexchangeAppKey :: ByteString +stackexchangeAppKey = "" + +data StackExchange = StackExchange deriving (Eq, Show) + +type instance IdpUserInfo StackExchange = StackExchangeResp + +defaultStackExchangeApp :: IdpApplication 'AuthorizationCode StackExchange +defaultStackExchangeApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.empty, + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppName = "default-stackexchange-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretPost, + idp = defaultStackexchangeIdp + } + +defaultStackexchangeIdp :: Idp StackExchange +defaultStackexchangeIdp = + Idp + { idpFetchUserInfo = authGetJSONWithAuthMethod @_ @(IdpUserInfo StackExchange) AuthInRequestQuery, + -- Only StackExchange has such specical app key which has to be append in userinfo uri. + -- I feel it's not worth to invent a way to read from config + -- file which would break the generic of Idp data type. + -- Until discover a easier way, hard code for now. + idpUserInfoEndpoint = + appendStackExchangeAppKey + [uri|https://api.stackexchange.com/2.2/me?site=stackoverflow|] + stackexchangeAppKey, + idpAuthorizeEndpoint = [uri|https://stackexchange.com/oauth|], + idpTokenEndpoint = [uri|https://stackexchange.com/oauth/access_token|] + } + +data StackExchangeResp = StackExchangeResp + { hasMore :: Bool, + quotaMax :: Integer, + quotaRemaining :: Integer, + items :: [StackExchangeUser] + } + deriving (Show, Generic) + +data StackExchangeUser = StackExchangeUser + { userId :: Integer, + displayName :: Text, + profileImage :: Text + } + deriving (Show, Generic) + +instance FromJSON StackExchangeResp where + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} + +instance FromJSON StackExchangeUser where + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} + +appendStackExchangeAppKey :: URI -> ByteString -> URI +appendStackExchangeAppKey useruri k = appendQueryParams [("key", k)] useruri diff --git a/src/Network/OAuth2/Provider/Weibo.hs b/src/Network/OAuth2/Provider/Weibo.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/Weibo.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Network.OAuth2.Provider.Weibo where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +data Weibo = Weibo deriving (Eq, Show) + +type instance IdpUserInfo Weibo = WeiboUID + +defaultWeiboApp :: IdpApplication 'AuthorizationCode Weibo +defaultWeiboApp = + AuthorizationCodeIdpApplication + { idpAppName = "default-weibo-App", + idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.empty, + idpAppAuthorizeState = "CHANGE_ME", + idpAppAuthorizeExtraParams = Map.empty, + idpAppRedirectUri = [uri|http://localhost|], + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = defaultWeiboIdp + } + +defaultWeiboIdp :: Idp Weibo +defaultWeiboIdp = + Idp + { idpFetchUserInfo = authGetJSONWithAuthMethod @_ @(IdpUserInfo Weibo) AuthInRequestQuery, + idpUserInfoEndpoint = [uri|https://api.weibo.com/2/account/get_uid.json|], + idpAuthorizeEndpoint = [uri|https://api.weibo.com/oauth2/authorize|], + idpTokenEndpoint = [uri|https://api.weibo.com/oauth2/access_token|] + } + +-- | UserInfor API: http://open.weibo.com/wiki/2/users/show +data WeiboUser = WeiboUser + { id :: Integer, + name :: Text, + screenName :: Text + } + deriving (Show, Generic) + +newtype WeiboUID = WeiboUID {uid :: Integer} + deriving (Show, Generic) + +instance FromJSON WeiboUID + +instance FromJSON WeiboUser where + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} diff --git a/src/Network/OAuth2/Provider/ZOHO.hs b/src/Network/OAuth2/Provider/ZOHO.hs new file mode 100644 --- /dev/null +++ b/src/Network/OAuth2/Provider/ZOHO.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} + +module Network.OAuth2.Provider.ZOHO where + +import Data.Aeson +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy (Text) +import GHC.Generics +import Network.OAuth.OAuth2 +import Network.OAuth2.Experiment +import URI.ByteString.QQ + +-- `oauth/user/info` url does not work and find answer from +-- https://help.zoho.com/portal/community/topic/oauth2-api-better-document-oauth-user-info + +data ZOHO = ZOHO deriving (Eq, Show) + +type instance IdpUserInfo ZOHO = ZOHOUserResp + +defaultZohoApp :: IdpApplication 'AuthorizationCode ZOHO +defaultZohoApp = + AuthorizationCodeIdpApplication + { idpAppClientId = "", + idpAppClientSecret = "", + idpAppScope = Set.fromList ["ZohoCRM.users.READ"], + idpAppAuthorizeExtraParams = Map.fromList [("access_type", "offline"), ("prompt", "consent")], + idpAppAuthorizeState = "CHANGE_ME", + idpAppRedirectUri = [uri|http://localhost/oauth2/callback|], + idpAppName = "default-zoho-App", + idpAppTokenRequestAuthenticationMethod = ClientSecretBasic, + idp = defaultZohoIdp + } + +defaultZohoIdp :: Idp ZOHO +defaultZohoIdp = + Idp + { idpFetchUserInfo = authGetJSON @(IdpUserInfo ZOHO), + idpUserInfoEndpoint = [uri|https://www.zohoapis.com/crm/v2/users|], + idpAuthorizeEndpoint = [uri|https://accounts.zoho.com/oauth/v2/auth|], + idpTokenEndpoint = [uri|https://accounts.zoho.com/oauth/v2/token|] + } + +data ZOHOUser = ZOHOUser + { email :: Text, + fullName :: Text + } + deriving (Show, Generic) + +newtype ZOHOUserResp = ZOHOUserResp {users :: [ZOHOUser]} + deriving (Show, Generic) + +instance FromJSON ZOHOUserResp + +instance FromJSON ZOHOUser where + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} diff --git a/src/Network/OIDC/WellKnown.hs b/src/Network/OIDC/WellKnown.hs new file mode 100644 --- /dev/null +++ b/src/Network/OIDC/WellKnown.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module Network.OIDC.WellKnown where + +import Control.Monad.Except +import Data.Aeson +import Data.Bifunctor +import Data.ByteString.Lazy (ByteString) +import Data.ByteString.Lazy qualified as BSL +import Data.Text.Lazy (Text) +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.Encoding qualified as TL +import GHC.Generics +import Network.HTTP.Simple +import Network.HTTP.Types.Status +import URI.ByteString + +-- | Slim OpenID Configuration +-- TODO: could add more fields to be complete. +data OpenIDConfiguration = OpenIDConfiguration + { issuer :: Text, + authorizationEndpoint :: Text, + tokenEndpoint :: Text, + userinfoEndpoint :: Text, + jwksUri :: Text + } + deriving (Generic) + +data OpenIDConfigurationUris = OpenIDConfigurationUris + { authorizationUri :: URI, + tokenUri :: URI, + userinfoUri :: URI, + jwksUri :: URI + } + deriving (Generic) + +instance FromJSON OpenIDConfiguration where + parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} + +wellknownUrl :: TL.Text +wellknownUrl = "/.well-known/openid-configuration" + +fetchWellKnown :: + MonadIO m => + -- | Domain + TL.Text -> + ExceptT Text m OpenIDConfiguration +fetchWellKnown domain = ExceptT $ do + let uri = "https://" <> domain <> wellknownUrl + req <- liftIO $ parseRequest (TL.unpack uri) + resp <- httpLbs req + return (handleWellKnownResponse resp) + +fetchWellKnownUris :: MonadIO m => TL.Text -> ExceptT Text m OpenIDConfigurationUris +fetchWellKnownUris domain = do + OpenIDConfiguration {..} <- fetchWellKnown domain + withExceptT (TL.pack . show) $ do + ae <- ExceptT $ pure (parseURI strictURIParserOptions $ BSL.toStrict $ TL.encodeUtf8 authorizationEndpoint) + te <- ExceptT $ pure (parseURI strictURIParserOptions $ BSL.toStrict $ TL.encodeUtf8 tokenEndpoint) + ue <- ExceptT $ pure (parseURI strictURIParserOptions $ BSL.toStrict $ TL.encodeUtf8 userinfoEndpoint) + jwks <- ExceptT $ pure (parseURI strictURIParserOptions $ BSL.toStrict $ TL.encodeUtf8 jwksUri) + pure + OpenIDConfigurationUris + { authorizationUri = ae, + tokenUri = te, + userinfoUri = ue, + jwksUri = jwks + } + +handleWellKnownResponse :: Response ByteString -> Either Text OpenIDConfiguration +handleWellKnownResponse resp = do + let rawBody = getResponseBody resp + let rStatus = getResponseStatus resp + if rStatus == status200 + then first (("handleWellKnownResponse decode response failed: " <>) . TL.pack) (eitherDecode rawBody) + else Left $ "handleWellKnownResponse failed: " <> TL.pack (show rStatus) <> TL.decodeUtf8 rawBody