mirror of
https://github.com/freckle/yesod-auth-oauth2.git
synced 2026-01-11 19:58:28 +01:00
Compare commits
43 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
a4c3d9f049 | ||
|
|
3dd2318067 | ||
|
|
3e5dbdec77 | ||
|
|
a8de561848 | ||
|
|
a179049522 | ||
|
|
36bc61fa27 | ||
|
|
09cda079d4 | ||
|
|
560647fb01 | ||
|
|
7f6096079f | ||
|
|
4e123a9482 | ||
|
|
a916af9688 | ||
|
|
3b55cee63b | ||
|
|
fa54bc36aa | ||
|
|
e79d174821 | ||
|
|
51c6574183 | ||
|
|
50cc0ea49b | ||
|
|
56c2d0a30d | ||
|
|
624b2be5aa | ||
|
|
87a0231a6d | ||
|
|
7b0d4f6243 | ||
|
|
07c6ea6875 | ||
|
|
433e8b324b | ||
|
|
acb69f8da4 | ||
|
|
0b4f249bf4 | ||
|
|
f9f7e1b73b | ||
|
|
94ba2ebeab | ||
|
|
3624b7f2d5 | ||
|
|
8cc82e919c | ||
|
|
f968e42da6 | ||
|
|
11948a65c4 | ||
|
|
7d913b6fea | ||
|
|
d238c1f3b5 | ||
|
|
3700a89ada | ||
|
|
1aa3f29509 | ||
|
|
79a955edd0 | ||
|
|
cebba91cb0 | ||
|
|
cd3d377e83 | ||
|
|
3daf382e46 | ||
|
|
08d0f0eaa4 | ||
|
|
5d4e4f8d7b | ||
|
|
48a0ea64b2 | ||
|
|
4627cf1fdc | ||
|
|
940c0fc0a5 |
1
.github/CODEOWNERS
vendored
Normal file
1
.github/CODEOWNERS
vendored
Normal file
@ -0,0 +1 @@
|
||||
* @freckle/backenders
|
||||
16
.github/workflows/add-asana-comment.yml.bak
vendored
Normal file
16
.github/workflows/add-asana-comment.yml.bak
vendored
Normal file
@ -0,0 +1,16 @@
|
||||
name: Asana
|
||||
|
||||
on:
|
||||
pull_request:
|
||||
types: [opened]
|
||||
|
||||
jobs:
|
||||
link-asana-task:
|
||||
if: ${{ github.actor != 'dependabot[bot]' }}
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: Asana/create-app-attachment-github-action@v1.3
|
||||
id: postAttachment
|
||||
with:
|
||||
asana-secret: ${{ secrets.ASANA_API_ACCESS_KEY }}
|
||||
- run: echo "Status is ${{ steps.postAttachment.outputs.status }}"
|
||||
45
.github/workflows/ci.yml
vendored
45
.github/workflows/ci.yml
vendored
@ -9,36 +9,41 @@ concurrency:
|
||||
group: ${{ github.workflow }}-${{ github.ref }}
|
||||
cancel-in-progress: true
|
||||
|
||||
jobs:
|
||||
test:
|
||||
runs-on: ubuntu-latest
|
||||
permissions:
|
||||
contents: read
|
||||
|
||||
jobs:
|
||||
generate:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v5
|
||||
- id: generate
|
||||
uses: freckle/stack-action/generate-matrix@v5
|
||||
outputs:
|
||||
stack-yamls: ${{ steps.generate.outputs.stack-yamls }}
|
||||
|
||||
test:
|
||||
needs: generate
|
||||
strategy:
|
||||
matrix:
|
||||
stack-yaml:
|
||||
- stack-nightly.yaml
|
||||
- stack.yaml
|
||||
- stack-lts-17.4.yaml
|
||||
- stack-lts-16.10.yaml
|
||||
- stack-lts-13.2.yaml
|
||||
- stack-hoauth2-2.0.yaml
|
||||
- stack-hoauth2-2.2.yaml
|
||||
- stack-hoauth2-2.3.yaml
|
||||
- stack-hoauth2-2.6.yaml
|
||||
stack-yaml: ${{ fromJSON(needs.generate.outputs.stack-yamls) }}
|
||||
fail-fast: false
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: freckle/stack-action@v4
|
||||
- uses: actions/checkout@v5
|
||||
- uses: freckle/stack-action@v5
|
||||
with:
|
||||
stack-yaml: ${{ matrix.stack-yaml }}
|
||||
stack-arguments: --flag yesod-auth-oauth2:example
|
||||
stack-build-arguments: --flag yesod-auth-oauth2:example
|
||||
env:
|
||||
STACK_YAML: ${{ matrix.stack-yaml }}
|
||||
|
||||
lint:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: haskell/actions/hlint-setup@v2
|
||||
- uses: haskell/actions/hlint-run@v2
|
||||
- uses: actions/checkout@v5
|
||||
- uses: haskell-actions/hlint-setup@v2
|
||||
- uses: haskell-actions/hlint-run@v2
|
||||
with:
|
||||
fail-on: warning
|
||||
|
||||
15
.github/workflows/release.yml
vendored
15
.github/workflows/release.yml
vendored
@ -8,16 +8,15 @@ jobs:
|
||||
release:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
- uses: actions/checkout@v5
|
||||
|
||||
- id: tag
|
||||
uses: freckle/haskell-tag-action@main
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||
uses: freckle/haskell-tag-action@v1
|
||||
|
||||
- if: steps.tag.outputs.tag
|
||||
uses: freckle/stack-upload-action@main
|
||||
with:
|
||||
pvp-bounds: lower
|
||||
run: stack upload --pvp-bounds lower .
|
||||
env:
|
||||
HACKAGE_API_KEY: ${{ secrets.HACKAGE_UPLOAD_API_KEY }}
|
||||
HACKAGE_KEY: ${{ secrets.HACKAGE_UPLOAD_API_KEY }}
|
||||
|
||||
# Use minimum LTS to set lowest lower bounds
|
||||
STACK_YAML: stack-lts21.yaml
|
||||
|
||||
@ -1,10 +1,4 @@
|
||||
restylers:
|
||||
- brittany:
|
||||
include:
|
||||
- "**/*.hs"
|
||||
- "!src/Network/OAuth/OAuth2/Compat.hs" # CPP
|
||||
- stylish-haskell:
|
||||
include:
|
||||
- "**/*.hs"
|
||||
- "!src/Network/OAuth/OAuth2/Compat.hs" # CPP
|
||||
- fourmolu
|
||||
- "!stylish-haskell"
|
||||
- "*"
|
||||
|
||||
2
.stack-all
Normal file
2
.stack-all
Normal file
@ -0,0 +1,2 @@
|
||||
[versions]
|
||||
oldest = lts-21
|
||||
@ -1,21 +0,0 @@
|
||||
steps:
|
||||
- simple_align:
|
||||
cases: false
|
||||
top_level_patterns: false
|
||||
records: false
|
||||
- imports:
|
||||
align: none
|
||||
list_align: after_alias
|
||||
pad_module_names: false
|
||||
long_list_align: new_line_multiline
|
||||
empty_list_align: right_after
|
||||
list_padding: 4
|
||||
separate_lists: false
|
||||
space_surround: false
|
||||
- language_pragmas:
|
||||
style: vertical
|
||||
align: false
|
||||
remove_redundant: true
|
||||
- trailing_whitespace: {}
|
||||
columns: 80
|
||||
newline: native
|
||||
43
CHANGELOG.md
43
CHANGELOG.md
@ -1,4 +1,45 @@
|
||||
## [_Unreleased_](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.0...main)
|
||||
## [_Unreleased_](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.8.0.0...main)
|
||||
|
||||
## [v0.8.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.4.0...v0.8.0.0)
|
||||
|
||||
- Drop support for GHC < 9.4 and hoauth2 < 2.8
|
||||
- Add support for GHC 9.12 and hoauth2-2.15
|
||||
- To align our interfaces with hoauth2-2.15:
|
||||
- Make `OAuth2 {clientSecret}` non-`Maybe`
|
||||
- Replace `OAuthToken` with `TokenResponse`
|
||||
- Replace `Errors` with `TokenResponseError`
|
||||
- Replace `fetchAccessToken{,2}` with `fetchAccessToken{Basic,Post}`
|
||||
|
||||
While technically a major version bump, this change should only affect those
|
||||
users that maintain their own plugins.
|
||||
|
||||
## [v0.7.4.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.3.0...v0.7.4.0)
|
||||
|
||||
- Add `oauth2AzureADv2Widget` and `oauth2AzureADv2ScopedWidget`
|
||||
|
||||
## [v0.7.3.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.2.0...v0.7.3.0)
|
||||
|
||||
- Add ORCID provider
|
||||
- Drop support for LTS-12 / GHC-8.6
|
||||
- Replace `cryptonite` with `crypton`
|
||||
|
||||
## [v0.7.2.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.3...v0.7.2.0)
|
||||
|
||||
- Add `oauth2GitHubWidget` and `oauth2GitHubScopedWidget`
|
||||
[@jaanisfehling](https://github.com/freckle/yesod-auth-oauth2/pull/181)
|
||||
|
||||
## [v0.7.1.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.2...v0.7.1.3)
|
||||
|
||||
- Add support (with caveats) for relative approots
|
||||
[@cptrodolfox](https://github.com/freckle/yesod-auth-oauth2/pull/178)
|
||||
|
||||
## [v0.7.1.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.1...v0.7.1.2)
|
||||
|
||||
- Support `hoauth2-2.9`.
|
||||
|
||||
## [v0.7.1.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.1.0...v0.7.1.1)
|
||||
|
||||
- Support `mtl-2.3`, which no longer re-exports `Control.Monad`
|
||||
|
||||
## [v0.7.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.0.3...v0.7.1.0)
|
||||
|
||||
|
||||
@ -1,44 +0,0 @@
|
||||
---
|
||||
conf_debug:
|
||||
dconf_roundtrip_exactprint_only: false
|
||||
dconf_dump_bridoc_simpl_par: false
|
||||
dconf_dump_ast_unknown: false
|
||||
dconf_dump_bridoc_simpl_floating: false
|
||||
dconf_dump_config: false
|
||||
dconf_dump_bridoc_raw: false
|
||||
dconf_dump_bridoc_final: false
|
||||
dconf_dump_bridoc_simpl_alt: false
|
||||
dconf_dump_bridoc_simpl_indent: false
|
||||
dconf_dump_annotations: false
|
||||
dconf_dump_bridoc_simpl_columns: false
|
||||
dconf_dump_ast_full: false
|
||||
conf_errorHandling:
|
||||
econf_ExactPrintFallback: ExactPrintFallbackModeInline
|
||||
econf_Werror: false
|
||||
econf_omit_output_valid_check: false
|
||||
econf_produceOutputOnErrors: false
|
||||
conf_preprocessor:
|
||||
ppconf_CPPMode: CPPModeAbort
|
||||
ppconf_hackAroundIncludes: false
|
||||
conf_obfuscate: false
|
||||
conf_roundtrip_exactprint_only: false
|
||||
conf_version: 1
|
||||
conf_layout:
|
||||
lconfig_reformatModulePreamble: true
|
||||
lconfig_altChooser:
|
||||
tag: AltChooserBoundedSearch
|
||||
contents: 3
|
||||
lconfig_allowSingleLineExportList: false
|
||||
lconfig_importColumn: 60
|
||||
lconfig_hangingTypeSignature: false
|
||||
lconfig_importAsColumn: 50
|
||||
lconfig_alignmentLimit: 1
|
||||
lconfig_indentListSpecial: true
|
||||
lconfig_indentAmount: 2
|
||||
lconfig_alignmentBreakOnMultiline: true
|
||||
lconfig_cols: 80
|
||||
lconfig_indentPolicy: IndentPolicyLeft
|
||||
lconfig_indentWhereSpecial: true
|
||||
lconfig_columnAlignMode:
|
||||
tag: ColumnAlignModeDisabled
|
||||
contents: 0.7
|
||||
@ -13,7 +13,7 @@ import Data.Aeson.Encode.Pretty
|
||||
import Data.ByteString.Lazy (fromStrict, toStrict)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.String (IsString(fromString))
|
||||
import Data.String (IsString (fromString))
|
||||
import Data.Text (Text, pack)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
@ -34,6 +34,7 @@ import Yesod.Auth.OAuth2.GitHub
|
||||
import Yesod.Auth.OAuth2.GitLab
|
||||
import Yesod.Auth.OAuth2.Google
|
||||
import Yesod.Auth.OAuth2.Nylas
|
||||
import Yesod.Auth.OAuth2.ORCID
|
||||
import Yesod.Auth.OAuth2.Salesforce
|
||||
import Yesod.Auth.OAuth2.Slack
|
||||
import Yesod.Auth.OAuth2.Spotify
|
||||
@ -46,13 +47,15 @@ data App = App
|
||||
, appAuthPlugins :: [AuthPlugin App]
|
||||
}
|
||||
|
||||
mkYesod "App" [parseRoutes|
|
||||
mkYesod
|
||||
"App"
|
||||
[parseRoutes|
|
||||
/ RootR GET
|
||||
/auth AuthR Auth getAuth
|
||||
|]
|
||||
|
||||
instance Yesod App where
|
||||
-- see https://github.com/thoughtbot/yesod-auth-oauth2/issues/87
|
||||
-- see https://github.com/thoughtbot/yesod-auth-oauth2/issues/87
|
||||
approot = ApprootStatic "http://localhost:3000"
|
||||
|
||||
instance YesodAuth App where
|
||||
@ -65,9 +68,9 @@ instance YesodAuth App where
|
||||
|
||||
-- Copy the Creds response into the session for viewing after
|
||||
authenticate c = do
|
||||
mapM_ (uncurry setSession)
|
||||
$ [("credsIdent", credsIdent c), ("credsPlugin", credsPlugin c)]
|
||||
++ credsExtra c
|
||||
mapM_ (uncurry setSession) $
|
||||
[("credsIdent", credsIdent c), ("credsPlugin", credsPlugin c)]
|
||||
++ credsExtra c
|
||||
|
||||
return $ Authenticated "1"
|
||||
|
||||
@ -80,23 +83,24 @@ instance RenderMessage App FormMessage where
|
||||
|
||||
getRootR :: Handler Html
|
||||
getRootR = do
|
||||
sess <- getSession
|
||||
sess <- getSession
|
||||
|
||||
let
|
||||
prettify
|
||||
= decodeUtf8
|
||||
. toStrict
|
||||
. encodePretty
|
||||
. fromJust
|
||||
. decode @Value
|
||||
. fromStrict
|
||||
let
|
||||
prettify =
|
||||
decodeUtf8
|
||||
. toStrict
|
||||
. encodePretty
|
||||
. fromJust
|
||||
. decode @Value
|
||||
. fromStrict
|
||||
|
||||
mCredsIdent = decodeUtf8 <$> M.lookup "credsIdent" sess
|
||||
mCredsPlugin = decodeUtf8 <$> M.lookup "credsPlugin" sess
|
||||
mAccessToken = decodeUtf8 <$> M.lookup "accessToken" sess
|
||||
mUserResponse = prettify <$> M.lookup "userResponse" sess
|
||||
mCredsIdent = decodeUtf8 <$> M.lookup "credsIdent" sess
|
||||
mCredsPlugin = decodeUtf8 <$> M.lookup "credsPlugin" sess
|
||||
mAccessToken = decodeUtf8 <$> M.lookup "accessToken" sess
|
||||
mUserResponse = prettify <$> M.lookup "userResponse" sess
|
||||
|
||||
defaultLayout [whamlet|
|
||||
defaultLayout
|
||||
[whamlet|
|
||||
<h1>Yesod Auth OAuth2 Example
|
||||
<h2>
|
||||
<a href=@{AuthR LoginR}>Log in
|
||||
@ -123,32 +127,34 @@ mkFoundation = do
|
||||
azureTenant <- getEnv "AZURE_ADV2_TENANT_ID"
|
||||
|
||||
appHttpManager <- newManager tlsManagerSettings
|
||||
appAuthPlugins <- sequence
|
||||
appAuthPlugins <-
|
||||
sequence
|
||||
-- When Providers are added, add them here and update .env.example.
|
||||
-- Nothing else should need changing.
|
||||
--
|
||||
-- FIXME: oauth2BattleNet is quite annoying!
|
||||
--
|
||||
[ loadPlugin oauth2AzureAD "AZURE_AD"
|
||||
, loadPlugin (oauth2AzureADv2 $ pack azureTenant) "AZURE_ADV2"
|
||||
, loadPlugin (oauth2Auth0Host $ fromString auth0Host) "AUTH0"
|
||||
, loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET"
|
||||
, loadPlugin oauth2Bitbucket "BITBUCKET"
|
||||
, loadPlugin oauth2ClassLink "CLASSLINK"
|
||||
, loadPlugin (oauth2Eve Plain) "EVE_ONLINE"
|
||||
, loadPlugin oauth2GitHub "GITHUB"
|
||||
, loadPlugin oauth2GitLab "GITLAB"
|
||||
, loadPlugin oauth2Google "GOOGLE"
|
||||
, loadPlugin oauth2Nylas "NYLAS"
|
||||
, loadPlugin oauth2Salesforce "SALES_FORCE"
|
||||
, loadPlugin oauth2Slack "SLACK"
|
||||
, loadPlugin (oauth2Spotify []) "SPOTIFY"
|
||||
, loadPlugin oauth2Twitch "TWITCH"
|
||||
, loadPlugin oauth2WordPressDotCom "WORDPRESS_DOT_COM"
|
||||
, loadPlugin oauth2Upcase "UPCASE"
|
||||
]
|
||||
[ loadPlugin oauth2AzureAD "AZURE_AD"
|
||||
, loadPlugin (oauth2AzureADv2 $ pack azureTenant) "AZURE_ADV2"
|
||||
, loadPlugin (oauth2Auth0Host $ fromString auth0Host) "AUTH0"
|
||||
, loadPlugin (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET"
|
||||
, loadPlugin oauth2Bitbucket "BITBUCKET"
|
||||
, loadPlugin oauth2ClassLink "CLASSLINK"
|
||||
, loadPlugin (oauth2Eve Plain) "EVE_ONLINE"
|
||||
, loadPlugin oauth2GitHub "GITHUB"
|
||||
, loadPlugin oauth2GitLab "GITLAB"
|
||||
, loadPlugin oauth2Google "GOOGLE"
|
||||
, loadPlugin oauth2Nylas "NYLAS"
|
||||
, loadPlugin oauth2Salesforce "SALES_FORCE"
|
||||
, loadPlugin oauth2Slack "SLACK"
|
||||
, loadPlugin (oauth2Spotify []) "SPOTIFY"
|
||||
, loadPlugin oauth2Twitch "TWITCH"
|
||||
, loadPlugin oauth2WordPressDotCom "WORDPRESS_DOT_COM"
|
||||
, loadPlugin oauth2ORCID "ORCID"
|
||||
, loadPlugin oauth2Upcase "UPCASE"
|
||||
]
|
||||
|
||||
return App { .. }
|
||||
return App {..}
|
||||
where
|
||||
loadPlugin f prefix = do
|
||||
clientId <- getEnv $ prefix <> "_CLIENT_ID"
|
||||
|
||||
15
fourmolu.yaml
Normal file
15
fourmolu.yaml
Normal file
@ -0,0 +1,15 @@
|
||||
indentation: 2
|
||||
column-limit: 80 # ignored until v12 / ghc-9.6
|
||||
function-arrows: leading
|
||||
comma-style: leading # default
|
||||
import-export-style: leading
|
||||
indent-wheres: false # default
|
||||
record-brace-space: true
|
||||
newlines-between-decls: 1 # default
|
||||
haddock-style: single-line
|
||||
let-style: mixed
|
||||
in-style: left-align
|
||||
single-constraint-parens: never # ignored until v12 / ghc-9.6
|
||||
unicode: never # default
|
||||
respectful: true # default
|
||||
fixities: [] # default
|
||||
@ -1,6 +1,6 @@
|
||||
---
|
||||
name: yesod-auth-oauth2
|
||||
version: 0.7.1.0
|
||||
version: 0.8.0.0
|
||||
synopsis: OAuth 2.0 authentication plugins
|
||||
description: Library to authenticate with OAuth 2.0 for Yesod web applications.
|
||||
category: Web
|
||||
@ -27,9 +27,9 @@ library:
|
||||
dependencies:
|
||||
- aeson >=0.6
|
||||
- bytestring >=0.9.1.4
|
||||
- cryptonite >=0.25
|
||||
- crypton
|
||||
- errors
|
||||
- hoauth2 >=1.11.0
|
||||
- hoauth2 >=2.8.0 # TokenRequestError
|
||||
- http-client >=0.4.0
|
||||
- http-conduit >=2.0
|
||||
- http-types >=0.8
|
||||
|
||||
7
renovate.json
Normal file
7
renovate.json
Normal file
@ -0,0 +1,7 @@
|
||||
{
|
||||
"$schema": "https://docs.renovatebot.com/renovate-schema.json",
|
||||
"extends": [
|
||||
"local>freckle/renovate-config"
|
||||
],
|
||||
"minimumReleaseAge": "0 days"
|
||||
}
|
||||
@ -1,171 +1,118 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Network.OAuth.OAuth2.Compat
|
||||
( OAuth2(..)
|
||||
, OAuth2Result
|
||||
, Errors
|
||||
, authorizationUrl
|
||||
, fetchAccessToken
|
||||
, fetchAccessToken2
|
||||
, authGetBS
|
||||
( OAuth2 (..)
|
||||
, authorizationUrl
|
||||
, fetchAccessTokenBasic
|
||||
, fetchAccessTokenPost
|
||||
, authGetBS
|
||||
|
||||
-- * Re-exports
|
||||
, module Network.OAuth.OAuth2
|
||||
) where
|
||||
, AccessToken (..)
|
||||
, ExchangeToken (..)
|
||||
, RefreshToken (..)
|
||||
, TokenResponse
|
||||
, accessToken
|
||||
, refreshToken
|
||||
, expiresIn
|
||||
, tokenType
|
||||
, idToken
|
||||
, TokenResponseError
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.Trans.Except (runExceptT)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Text (Text)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import qualified Network.OAuth.OAuth2 as OAuth2
|
||||
#if MIN_VERSION_hoauth2(2,7,0)
|
||||
import Network.OAuth.OAuth2
|
||||
(AccessToken(..), ExchangeToken(..), OAuth2Token(..), RefreshToken(..))
|
||||
import Network.OAuth.OAuth2.TokenRequest (TokenRequestError)
|
||||
#else
|
||||
import Network.OAuth.OAuth2
|
||||
( AccessToken(..)
|
||||
, ExchangeToken(..)
|
||||
, OAuth2Error
|
||||
, OAuth2Token(..)
|
||||
, RefreshToken(..)
|
||||
)
|
||||
import qualified Network.OAuth.OAuth2.TokenRequest as LegacyTokenRequest
|
||||
#endif
|
||||
import URI.ByteString
|
||||
|
||||
#if MIN_VERSION_hoauth2(2,2,0)
|
||||
import Control.Monad.Trans.Except (ExceptT, runExceptT)
|
||||
import Data.Maybe (fromMaybe)
|
||||
#if MIN_VERSION_hoauth2(2,15,0)
|
||||
import Network.OAuth2
|
||||
( AccessToken (..)
|
||||
, ExchangeToken (..)
|
||||
, RefreshToken (..)
|
||||
, TokenResponse (..)
|
||||
, TokenResponseError
|
||||
)
|
||||
import qualified Network.OAuth2 as OAuth2
|
||||
|
||||
#elif MIN_VERSION_hoauth2(2,9,0)
|
||||
import Network.OAuth.OAuth2
|
||||
( AccessToken (..)
|
||||
, ExchangeToken (..)
|
||||
, RefreshToken (..)
|
||||
, OAuth2Token (..)
|
||||
, TokenResponseError
|
||||
)
|
||||
import qualified Network.OAuth.OAuth2 as OAuth2
|
||||
|
||||
type TokenResponse = OAuth2Token
|
||||
|
||||
#else
|
||||
-- hoauth2-2.8
|
||||
import Network.OAuth.OAuth2
|
||||
( AccessToken (..)
|
||||
, ExchangeToken (..)
|
||||
, RefreshToken (..)
|
||||
, OAuth2Token (..)
|
||||
)
|
||||
import Network.OAuth.OAuth2.TokenRequest (TokenRequestError)
|
||||
import qualified Network.OAuth.OAuth2 as OAuth2
|
||||
|
||||
type TokenResponse = OAuth2Token
|
||||
type TokenResponseError = TokenRequestError
|
||||
#endif
|
||||
|
||||
data OAuth2 = OAuth2
|
||||
{ oauth2ClientId :: Text
|
||||
, oauth2ClientSecret :: Maybe Text
|
||||
, oauth2AuthorizeEndpoint :: URIRef Absolute
|
||||
, oauth2TokenEndpoint :: URIRef Absolute
|
||||
, oauth2RedirectUri :: Maybe (URIRef Absolute)
|
||||
}
|
||||
|
||||
#if MIN_VERSION_hoauth2(2,7,0)
|
||||
type Errors = TokenRequestError
|
||||
#else
|
||||
type Errors = OAuth2Error LegacyTokenRequest.Errors
|
||||
#endif
|
||||
|
||||
type OAuth2Result err a = Either err a
|
||||
{ oauth2ClientId :: Text
|
||||
, oauth2ClientSecret :: Text
|
||||
, oauth2AuthorizeEndpoint :: URIRef Absolute
|
||||
, oauth2TokenEndpoint :: URIRef Absolute
|
||||
, oauth2RedirectUri :: Maybe (URIRef Absolute)
|
||||
}
|
||||
|
||||
authorizationUrl :: OAuth2 -> URI
|
||||
authorizationUrl = OAuth2.authorizationUrl . getOAuth2
|
||||
|
||||
fetchAccessToken
|
||||
:: Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (OAuth2Result Errors OAuth2Token)
|
||||
fetchAccessToken = fetchAccessTokenBasic
|
||||
|
||||
fetchAccessToken2
|
||||
:: Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (OAuth2Result Errors OAuth2Token)
|
||||
fetchAccessToken2 = fetchAccessTokenPost
|
||||
|
||||
authGetBS :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
|
||||
authGetBS m a u = runOAuth2 $ OAuth2.authGetBS m a u
|
||||
|
||||
-- Normalize the rename of record fields at hoauth2-2.0. Our type is the newer
|
||||
-- names and we up-convert if hoauth2-1.x is in use. getClientSecret and
|
||||
-- getRedirectUri handle the differences in hoauth2-2.2 and 2.3.
|
||||
|
||||
#if MIN_VERSION_hoauth2(2,0,0)
|
||||
getOAuth2 :: OAuth2 -> OAuth2.OAuth2
|
||||
getOAuth2 o = OAuth2.OAuth2
|
||||
{ OAuth2.oauth2ClientId = oauth2ClientId o
|
||||
, OAuth2.oauth2ClientSecret = getClientSecret $ oauth2ClientSecret o
|
||||
, OAuth2.oauth2AuthorizeEndpoint = oauth2AuthorizeEndpoint o
|
||||
, OAuth2.oauth2TokenEndpoint = oauth2TokenEndpoint o
|
||||
, OAuth2.oauth2RedirectUri = getRedirectUri $ oauth2RedirectUri o
|
||||
}
|
||||
#else
|
||||
getOAuth2 :: OAuth2 -> OAuth2.OAuth2
|
||||
getOAuth2 o = OAuth2.OAuth2
|
||||
{ OAuth2.oauthClientId = oauth2ClientId o
|
||||
, OAuth2.oauthClientSecret = getClientSecret $ oauth2ClientSecret o
|
||||
, OAuth2.oauthOAuthorizeEndpoint = oauth2AuthorizeEndpoint o
|
||||
, OAuth2.oauthAccessTokenEndpoint = oauth2TokenEndpoint o
|
||||
, OAuth2.oauthCallback = getRedirectUri $ oauth2RedirectUri o
|
||||
}
|
||||
#endif
|
||||
|
||||
-- hoauth2-2.2 made oauth2ClientSecret non-Maybe, after 2.0 had just made it
|
||||
-- Maybe so we have to adjust, twice. TODO: change ours type to non-Maybe (major
|
||||
-- bump) and reverse this to up-convert with Just in pre-2.2.
|
||||
|
||||
#if MIN_VERSION_hoauth2(2,2,0)
|
||||
getClientSecret :: Maybe Text -> Text
|
||||
getClientSecret =
|
||||
fromMaybe $ error "Cannot use OAuth2.oauth2ClientSecret with Nothing"
|
||||
#else
|
||||
getClientSecret :: Maybe Text -> Maybe Text
|
||||
getClientSecret = id
|
||||
#endif
|
||||
|
||||
-- hoauth2-2.3 then made oauth2RedirectUri non-Maybe too. We logically rely on
|
||||
-- instantiating with Nothing at definition-time, then setting it to the
|
||||
-- callback at use-time, which means we can't just change our type and invert
|
||||
-- this shim; we'll have to do something much more pervasive to avoid this
|
||||
-- fromMaybe.
|
||||
|
||||
#if MIN_VERSION_hoauth2(2,3,0)
|
||||
getRedirectUri :: Maybe (URIRef Absolute) -> (URIRef Absolute)
|
||||
getRedirectUri =
|
||||
fromMaybe $ error "Cannot use OAuth2.oauth2RedirectUri with Nothing"
|
||||
#else
|
||||
getRedirectUri :: Maybe (URIRef Absolute) -> Maybe (URIRef Absolute)
|
||||
getRedirectUri = id
|
||||
#endif
|
||||
|
||||
-- hoauth-2.2 moved most IO-Either functions to ExceptT. This reverses that.
|
||||
|
||||
#if MIN_VERSION_hoauth2(2,2,0)
|
||||
runOAuth2 :: ExceptT e m a -> m (Either e a)
|
||||
runOAuth2 = runExceptT
|
||||
#else
|
||||
runOAuth2 :: IO (Either e a) -> IO (Either e a)
|
||||
runOAuth2 = id
|
||||
#endif
|
||||
|
||||
-- The fetchAccessToken functions grew a nicer interface in hoauth2-2.3. This
|
||||
-- up-converts the older ones. We should update our code to use these functions
|
||||
-- directly.
|
||||
|
||||
fetchAccessTokenBasic
|
||||
:: Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (OAuth2Result Errors OAuth2Token)
|
||||
fetchAccessTokenBasic m o e = runOAuth2 $ f m (getOAuth2 o) e
|
||||
where
|
||||
#if MIN_VERSION_hoauth2(2,6,0)
|
||||
f = OAuth2.fetchAccessTokenWithAuthMethod OAuth2.ClientSecretBasic
|
||||
#elif MIN_VERSION_hoauth2(2,3,0)
|
||||
f = OAuth2.fetchAccessTokenInternal OAuth2.ClientSecretBasic
|
||||
#else
|
||||
f = OAuth2.fetchAccessToken
|
||||
#endif
|
||||
:: Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (Either TokenResponseError TokenResponse)
|
||||
fetchAccessTokenBasic =
|
||||
runFetchAccessToken OAuth2.ClientSecretBasic
|
||||
|
||||
fetchAccessTokenPost
|
||||
:: Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (OAuth2Result Errors OAuth2Token)
|
||||
fetchAccessTokenPost m o e = runOAuth2 $ f m (getOAuth2 o) e
|
||||
where
|
||||
#if MIN_VERSION_hoauth2(2, 6, 0)
|
||||
f = OAuth2.fetchAccessTokenWithAuthMethod OAuth2.ClientSecretPost
|
||||
#elif MIN_VERSION_hoauth2(2,3,0)
|
||||
f = OAuth2.fetchAccessTokenInternal OAuth2.ClientSecretPost
|
||||
#else
|
||||
f = OAuth2.fetchAccessToken2
|
||||
#endif
|
||||
:: Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (Either TokenResponseError TokenResponse)
|
||||
fetchAccessTokenPost =
|
||||
runFetchAccessToken OAuth2.ClientSecretPost
|
||||
|
||||
authGetBS :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
|
||||
authGetBS m a u = runExceptT $ OAuth2.authGetBS m a u
|
||||
|
||||
getOAuth2 :: OAuth2 -> OAuth2.OAuth2
|
||||
getOAuth2 o =
|
||||
OAuth2.OAuth2
|
||||
{ OAuth2.oauth2ClientId = oauth2ClientId o
|
||||
, OAuth2.oauth2ClientSecret = oauth2ClientSecret o
|
||||
, OAuth2.oauth2AuthorizeEndpoint = oauth2AuthorizeEndpoint o
|
||||
, OAuth2.oauth2TokenEndpoint = oauth2TokenEndpoint o
|
||||
, OAuth2.oauth2RedirectUri = case oauth2RedirectUri o of
|
||||
Nothing ->
|
||||
error
|
||||
"programmer error: yesod-auth-oauth2:OAuth2 must have a Just value set as oauth2RedirectUri before using as an hauth2:OAuth2 value"
|
||||
Just uri -> uri
|
||||
}
|
||||
|
||||
runFetchAccessToken
|
||||
:: MonadIO m
|
||||
=> OAuth2.ClientAuthenticationMethod
|
||||
-> Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> m (Either TokenResponseError TokenResponse)
|
||||
runFetchAccessToken am m o e = runExceptT $ OAuth2.fetchAccessTokenWithAuthMethod am m (getOAuth2 o) e
|
||||
|
||||
@ -1,9 +1,10 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module URI.ByteString.Extension where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.String (IsString(..))
|
||||
import Data.String (IsString (..))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
|
||||
import Lens.Micro
|
||||
@ -41,9 +42,12 @@ fromRelative :: Scheme -> Host -> RelativeRef -> URI
|
||||
fromRelative s h = flip withHost h . toAbsolute s
|
||||
|
||||
withHost :: URIRef a -> Host -> URIRef a
|
||||
withHost u h = u & authorityL %~ maybe
|
||||
(Just $ Authority Nothing h Nothing)
|
||||
(\a -> Just $ a & authorityHostL .~ h)
|
||||
withHost u h =
|
||||
u
|
||||
& authorityL
|
||||
%~ maybe
|
||||
(Just $ Authority Nothing h Nothing)
|
||||
(\a -> Just $ a & authorityHostL .~ h)
|
||||
|
||||
withPath :: URIRef a -> ByteString -> URIRef a
|
||||
withPath u p = u & pathL .~ p
|
||||
|
||||
@ -1,9 +1,9 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module UnliftIO.Except
|
||||
() where
|
||||
module UnliftIO.Except () where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Control.Monad ((<=<))
|
||||
import Control.Monad.Except (ExceptT (..), runExceptT)
|
||||
import UnliftIO
|
||||
|
||||
instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
|
||||
|
||||
@ -1,23 +1,23 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- Generic OAuth2 plugin for Yesod
|
||||
--
|
||||
-- See @"Yesod.Auth.OAuth2.GitHub"@ for example usage.
|
||||
--
|
||||
module Yesod.Auth.OAuth2
|
||||
( OAuth2(..)
|
||||
( OAuth2 (..)
|
||||
, FetchCreds
|
||||
, Manager
|
||||
, OAuth2Token(..)
|
||||
, Creds(..)
|
||||
, TokenResponse
|
||||
, Creds (..)
|
||||
, oauth2Url
|
||||
, authOAuth2
|
||||
, authOAuth2Widget
|
||||
|
||||
-- * Alternatives that use 'fetchAccessToken2'
|
||||
-- * Alternatives that use 'fetchAccessTokenPost'
|
||||
, authOAuth2'
|
||||
, authOAuth2Widget'
|
||||
|
||||
@ -46,14 +46,12 @@ oauth2Url name = PluginR name ["forward"]
|
||||
-- | Create an @'AuthPlugin'@ for the given OAuth2 provider
|
||||
--
|
||||
-- Presents a generic @"Login via #{name}"@ link
|
||||
--
|
||||
authOAuth2 :: YesodAuth m => Text -> OAuth2 -> FetchCreds m -> AuthPlugin m
|
||||
authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name
|
||||
|
||||
-- | A version of 'authOAuth2' that uses 'fetchAccessToken2'
|
||||
-- | A version of 'authOAuth2' that uses 'fetchAccessTokenPost'
|
||||
--
|
||||
-- See <https://github.com/thoughtbot/yesod-auth-oauth2/pull/129>
|
||||
--
|
||||
authOAuth2' :: YesodAuth m => Text -> OAuth2 -> FetchCreds m -> AuthPlugin m
|
||||
authOAuth2' name = authOAuth2Widget' [whamlet|Login via #{name}|] name
|
||||
|
||||
@ -61,7 +59,6 @@ authOAuth2' name = authOAuth2Widget' [whamlet|Login via #{name}|] name
|
||||
--
|
||||
-- Allows passing a custom widget for the login link. See @'oauth2Eve'@ for an
|
||||
-- example.
|
||||
--
|
||||
authOAuth2Widget
|
||||
:: YesodAuth m
|
||||
=> WidgetFor m ()
|
||||
@ -69,12 +66,11 @@ authOAuth2Widget
|
||||
-> OAuth2
|
||||
-> FetchCreds m
|
||||
-> AuthPlugin m
|
||||
authOAuth2Widget = buildPlugin fetchAccessToken
|
||||
authOAuth2Widget = buildPlugin fetchAccessTokenBasic
|
||||
|
||||
-- | A version of 'authOAuth2Widget' that uses 'fetchAccessToken2'
|
||||
-- | A version of 'authOAuth2Widget' that uses 'fetchAccessTokenPost'
|
||||
--
|
||||
-- See <https://github.com/thoughtbot/yesod-auth-oauth2/pull/129>
|
||||
--
|
||||
authOAuth2Widget'
|
||||
:: YesodAuth m
|
||||
=> WidgetFor m ()
|
||||
@ -82,7 +78,7 @@ authOAuth2Widget'
|
||||
-> OAuth2
|
||||
-> FetchCreds m
|
||||
-> AuthPlugin m
|
||||
authOAuth2Widget' = buildPlugin fetchAccessToken2
|
||||
authOAuth2Widget' = buildPlugin fetchAccessTokenPost
|
||||
|
||||
buildPlugin
|
||||
:: YesodAuth m
|
||||
@ -92,11 +88,13 @@ buildPlugin
|
||||
-> OAuth2
|
||||
-> FetchCreds m
|
||||
-> AuthPlugin m
|
||||
buildPlugin getToken widget name oauth getCreds = AuthPlugin
|
||||
name
|
||||
(dispatchAuthRequest name oauth getToken getCreds)
|
||||
login
|
||||
where login tm = [whamlet|<a href=@{tm $ oauth2Url name}>^{widget}|]
|
||||
buildPlugin getToken widget name oauth getCreds =
|
||||
AuthPlugin
|
||||
name
|
||||
(dispatchAuthRequest name oauth getToken getCreds)
|
||||
login
|
||||
where
|
||||
login tm = [whamlet|<a href=@{tm $ oauth2Url name}>^{widget}|]
|
||||
|
||||
-- | Read the @'AccessToken'@ from the values set via @'setExtra'@
|
||||
getAccessToken :: Creds m -> Maybe AccessToken
|
||||
@ -105,7 +103,6 @@ getAccessToken = (AccessToken <$>) . lookup "accessToken" . credsExtra
|
||||
-- | Read the @'RefreshToken'@ from the values set via @'setExtra'@
|
||||
--
|
||||
-- N.B. not all providers supply this value.
|
||||
--
|
||||
getRefreshToken :: Creds m -> Maybe RefreshToken
|
||||
getRefreshToken = (RefreshToken <$>) . lookup "refreshToken" . credsExtra
|
||||
|
||||
|
||||
@ -1,10 +1,10 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
-- OAuth2 plugin for <https://auth0.com>
|
||||
--
|
||||
-- * Authenticates against specific auth0 tenant
|
||||
-- * Uses Auth0 user id (a.k.a [sub](https://auth0.com/docs/api/authentication#get-user-info)) as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Auth0
|
||||
( oauth2Auth0HostScopes
|
||||
, oauth2Auth0Host
|
||||
@ -13,8 +13,8 @@ module Yesod.Auth.OAuth2.Auth0
|
||||
|
||||
import Data.Aeson as Aeson
|
||||
import qualified Data.Text as T
|
||||
import Prelude
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
import Prelude
|
||||
|
||||
-- | https://auth0.com/docs/api/authentication#get-user-info
|
||||
newtype User = User T.Text
|
||||
@ -36,22 +36,25 @@ oauth2Auth0HostScopes
|
||||
:: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2Auth0HostScopes host scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User uid, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
(host `withPath` "/userinfo")
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = uid
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
(User uid, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
(host `withPath` "/userinfo")
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = uid
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
host `withPath` "/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = host `withPath` "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
host `withPath` "/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = host `withPath` "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,18 +1,18 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for Azure AD.
|
||||
--
|
||||
-- * Authenticates against Azure AD
|
||||
-- * Uses email as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.AzureAD
|
||||
( oauth2AzureAD
|
||||
, oauth2AzureADScoped
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
import Prelude
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
@ -31,26 +31,29 @@ oauth2AzureAD = oauth2AzureADScoped defaultScopes
|
||||
oauth2AzureADScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2AzureADScoped scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://graph.microsoft.com/v1.0/me"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://graph.microsoft.com/v1.0/me"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://login.windows.net/common/oauth2/authorize"
|
||||
`withQuery` [ scopeParam "," scopes
|
||||
, ("resource", "https://graph.microsoft.com")
|
||||
]
|
||||
, oauth2TokenEndpoint = "https://login.windows.net/common/oauth2/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://login.windows.net/common/oauth2/authorize"
|
||||
`withQuery` [ scopeParam "," scopes
|
||||
, ("resource", "https://graph.microsoft.com")
|
||||
]
|
||||
, oauth2TokenEndpoint = "https://login.windows.net/common/oauth2/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,18 +1,22 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for Azure AD using the new v2 endpoints.
|
||||
--
|
||||
-- * Authenticates against Azure AD
|
||||
-- * Uses email as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.AzureADv2
|
||||
( oauth2AzureADv2
|
||||
, oauth2AzureADv2Scoped
|
||||
, oauth2AzureADv2Widget
|
||||
, oauth2AzureADv2ScopedWidget
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
import Yesod.Core (WidgetFor, whamlet)
|
||||
import Prelude
|
||||
|
||||
import Data.String
|
||||
import Data.Text (unpack)
|
||||
@ -34,49 +38,67 @@ oauth2AzureADv2
|
||||
-- ^ Tenant Id
|
||||
--
|
||||
-- If using a multi-tenant App, @common@ can be given here.
|
||||
--
|
||||
-> Text -- ^ Client Id
|
||||
-> Text -- ^ Client secret
|
||||
-> Text
|
||||
-- ^ Client Id
|
||||
-> Text
|
||||
-- ^ Client secret
|
||||
-> AuthPlugin m
|
||||
oauth2AzureADv2 = oauth2AzureADv2Scoped defaultScopes
|
||||
|
||||
oauth2AzureADv2Widget
|
||||
:: YesodAuth m => WidgetFor m () -> Text -> Text -> Text -> AuthPlugin m
|
||||
oauth2AzureADv2Widget widget =
|
||||
oauth2AzureADv2ScopedWidget widget defaultScopes
|
||||
|
||||
oauth2AzureADv2Scoped
|
||||
:: YesodAuth m => [Text] -> Text -> Text -> Text -> AuthPlugin m
|
||||
oauth2AzureADv2Scoped =
|
||||
oauth2AzureADv2ScopedWidget [whamlet|Login via #{pluginName}|]
|
||||
|
||||
oauth2AzureADv2ScopedWidget
|
||||
:: YesodAuth m
|
||||
=> [Text] -- ^ Scopes
|
||||
=> WidgetFor m ()
|
||||
-- ^ Widget
|
||||
-> [Text]
|
||||
-- ^ Scopes
|
||||
-> Text
|
||||
-- ^ Tenant Id
|
||||
--
|
||||
-- If using a multi-tenant App, @common@ can be given here.
|
||||
--
|
||||
-> Text -- ^ Client Id
|
||||
-> Text -- ^ Client Secret
|
||||
-> Text
|
||||
-- ^ Client Id
|
||||
-> Text
|
||||
-- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2AzureADv2Scoped scopes tenantId clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://graph.microsoft.com/v1.0/me"
|
||||
oauth2AzureADv2ScopedWidget widget scopes tenantId clientId clientSecret =
|
||||
authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://graph.microsoft.com/v1.0/me"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
tenantUrl "/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = tenantUrl "/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
tenantUrl "/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = tenantUrl "/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
tenantUrl path =
|
||||
fromString
|
||||
$ "https://login.microsoftonline.com/"
|
||||
<> unpack tenantId
|
||||
<> "/oauth2/v2.0"
|
||||
<> path
|
||||
fromString $
|
||||
"https://login.microsoftonline.com/"
|
||||
<> unpack tenantId
|
||||
<> "/oauth2/v2.0"
|
||||
<> path
|
||||
|
||||
@ -7,7 +7,6 @@
|
||||
-- * Authenticates against battle.net.
|
||||
-- * Uses user's id as credentials identifier.
|
||||
-- * Returns user's battletag in extras.
|
||||
--
|
||||
module Yesod.Auth.OAuth2.BattleNet
|
||||
( oauth2BattleNet
|
||||
, oAuth2BattleNet
|
||||
@ -28,32 +27,37 @@ pluginName = "battle.net"
|
||||
|
||||
oauth2BattleNet
|
||||
:: YesodAuth m
|
||||
=> WidgetFor m () -- ^ Login widget
|
||||
-> Text -- ^ User region (e.g. "eu", "cn", "us")
|
||||
-> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
=> WidgetFor m ()
|
||||
-- ^ Login widget
|
||||
-> Text
|
||||
-- ^ User region (e.g. "eu", "cn", "us")
|
||||
-> Text
|
||||
-- ^ Client ID
|
||||
-> Text
|
||||
-- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2BattleNet widget region clientId clientSecret =
|
||||
authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile pluginName manager token
|
||||
$ fromRelative "https" (apiHost $ T.toLower region) "/account/user"
|
||||
authGetProfile pluginName manager token $
|
||||
fromRelative "https" (apiHost $ T.toLower region) "/account/user"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
host = wwwHost $ T.toLower region
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize"
|
||||
, oauth2TokenEndpoint = fromRelative "https" host "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize"
|
||||
, oauth2TokenEndpoint = fromRelative "https" host "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
apiHost :: Text -> Host
|
||||
apiHost "cn" = "api.battlenet.com.cn"
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://bitbucket.com
|
||||
--
|
||||
-- * Authenticates against bitbucket
|
||||
-- * Uses bitbucket uuid as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Bitbucket
|
||||
( oauth2Bitbucket
|
||||
, oauth2BitbucketScoped
|
||||
@ -32,30 +32,33 @@ oauth2Bitbucket = oauth2BitbucketScoped defaultScopes
|
||||
oauth2BitbucketScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2BitbucketScoped scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://api.bitbucket.com/2.0/user"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://api.bitbucket.com/2.0/user"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
-- FIXME: Preserved bug. This should just be userId (it's already
|
||||
-- a Text), but because this code was shipped, folks likely have
|
||||
-- Idents in their database like @"\"...\""@, and if we fixed this
|
||||
-- they would need migrating. We're keeping it for now as it's a
|
||||
-- minor wart. Breaking typed APIs is one thing, causing data to go
|
||||
-- invalid is another.
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, -- FIXME: Preserved bug. This should just be userId (it's already
|
||||
-- a Text), but because this code was shipped, folks likely have
|
||||
-- Idents in their database like @"\"...\""@, and if we fixed this
|
||||
-- they would need migrating. We're keeping it for now as it's a
|
||||
-- minor wart. Breaking typed APIs is one thing, causing data to go
|
||||
-- invalid is another.
|
||||
credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://bitbucket.com/site/oauth2/authorize"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://bitbucket.com/site/oauth2/authorize"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -26,24 +26,27 @@ oauth2ClassLink = oauth2ClassLinkScoped defaultScopes
|
||||
oauth2ClassLinkScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2ClassLinkScoped scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://nodeapi.classlink.com/v2/my/info"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://nodeapi.classlink.com/v2/my/info"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://launchpad.classlink.com/oauth2/v2/auth"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://launchpad.classlink.com/oauth2/v2/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://launchpad.classlink.com/oauth2/v2/auth"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://launchpad.classlink.com/oauth2/v2/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -6,20 +6,21 @@
|
||||
|
||||
module Yesod.Auth.OAuth2.Dispatch
|
||||
( FetchToken
|
||||
, fetchAccessToken
|
||||
, fetchAccessToken2
|
||||
, fetchAccessTokenBasic
|
||||
, fetchAccessTokenPost
|
||||
, FetchCreds
|
||||
, dispatchAuthRequest
|
||||
) where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Control.Monad (unless)
|
||||
import Control.Monad.Except (MonadError (..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Network.OAuth.OAuth2.Compat
|
||||
import UnliftIO.Exception
|
||||
import URI.ByteString.Extension
|
||||
import UnliftIO.Exception
|
||||
import Yesod.Auth hiding (ServerError)
|
||||
import Yesod.Auth.OAuth2.DispatchError
|
||||
import Yesod.Auth.OAuth2.ErrorResponse
|
||||
@ -29,21 +30,29 @@ import Yesod.Core hiding (ErrorResponse)
|
||||
-- | How to fetch an @'OAuth2Token'@
|
||||
--
|
||||
-- This will be 'fetchAccessToken' or 'fetchAccessToken2'
|
||||
--
|
||||
type FetchToken
|
||||
= Manager -> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token)
|
||||
type FetchToken =
|
||||
Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (Either TokenResponseError TokenResponse)
|
||||
|
||||
-- | How to take an @'OAuth2Token'@ and retrieve user credentials
|
||||
type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m)
|
||||
type FetchCreds m = Manager -> TokenResponse -> IO (Creds m)
|
||||
|
||||
-- | Dispatch the various OAuth2 handshake routes
|
||||
dispatchAuthRequest
|
||||
:: Text -- ^ Name
|
||||
-> OAuth2 -- ^ Service details
|
||||
-> FetchToken -- ^ How to get a token
|
||||
-> FetchCreds m -- ^ How to get credentials
|
||||
-> Text -- ^ Method
|
||||
-> [Text] -- ^ Path pieces
|
||||
:: Text
|
||||
-- ^ Name
|
||||
-> OAuth2
|
||||
-- ^ Service details
|
||||
-> FetchToken
|
||||
-- ^ How to get a token
|
||||
-> FetchCreds m
|
||||
-- ^ How to get credentials
|
||||
-> Text
|
||||
-- ^ Method
|
||||
-> [Text]
|
||||
-- ^ Path pieces
|
||||
-> AuthHandler m TypedContent
|
||||
dispatchAuthRequest name oauth2 _ _ "GET" ["forward"] =
|
||||
handleDispatchError $ dispatchForward name oauth2
|
||||
@ -55,7 +64,6 @@ dispatchAuthRequest _ _ _ _ _ _ = notFound
|
||||
--
|
||||
-- 1. Set a random CSRF token in our session
|
||||
-- 2. Redirect to the Provider's authorization URL
|
||||
--
|
||||
dispatchForward
|
||||
:: (MonadError DispatchError m, MonadAuthHandler site m)
|
||||
=> Text
|
||||
@ -71,7 +79,6 @@ dispatchForward name oauth2 = do
|
||||
-- 1. Verify the URL's CSRF token matches our session
|
||||
-- 2. Use the code parameter to fetch an AccessToken for the Provider
|
||||
-- 3. Use the AccessToken to construct a @'Creds'@ value for the Provider
|
||||
--
|
||||
dispatchCallback
|
||||
:: (MonadError DispatchError m, MonadAuthHandler site m)
|
||||
=> Text
|
||||
@ -85,12 +92,13 @@ dispatchCallback name oauth2 getToken getCreds = do
|
||||
code <- requireGetParam "code"
|
||||
manager <- authHttpManager
|
||||
oauth2' <- withCallbackAndState name oauth2 csrf
|
||||
token <- either (throwError . OAuth2ResultError) pure
|
||||
=<< liftIO (getToken manager oauth2' $ ExchangeToken code)
|
||||
token <-
|
||||
either (throwError . OAuth2ResultError) pure
|
||||
=<< liftIO (getToken manager oauth2' $ ExchangeToken code)
|
||||
creds <-
|
||||
liftIO (getCreds manager token)
|
||||
`catch` (throwError . FetchCredsIOException)
|
||||
`catch` (throwError . FetchCredsYesodOAuth2Exception)
|
||||
`catch` (throwError . FetchCredsIOException)
|
||||
`catch` (throwError . FetchCredsYesodOAuth2Exception)
|
||||
setCredsRedirect creds
|
||||
|
||||
withCallbackAndState
|
||||
@ -100,31 +108,35 @@ withCallbackAndState
|
||||
-> Text
|
||||
-> m OAuth2
|
||||
withCallbackAndState name oauth2 csrf = do
|
||||
uri <- ($ PluginR name ["callback"]) <$> getParentUrlRender
|
||||
callback <- maybe (throwError $ InvalidCallbackUri uri) pure $ fromText uri
|
||||
pure oauth2
|
||||
{ oauth2RedirectUri = Just callback
|
||||
, oauth2AuthorizeEndpoint =
|
||||
oauth2AuthorizeEndpoint oauth2 `withQuery` [("state", encodeUtf8 csrf)]
|
||||
}
|
||||
callback <- maybe defaultCallback pure $ oauth2RedirectUri oauth2
|
||||
pure
|
||||
oauth2
|
||||
{ oauth2RedirectUri = Just callback
|
||||
, oauth2AuthorizeEndpoint =
|
||||
oauth2AuthorizeEndpoint oauth2 `withQuery` [("state", encodeUtf8 csrf)]
|
||||
}
|
||||
where
|
||||
defaultCallback = do
|
||||
uri <- ($ PluginR name ["callback"]) <$> getParentUrlRender
|
||||
maybe (throwError $ InvalidCallbackUri uri) pure $ fromText uri
|
||||
|
||||
getParentUrlRender :: MonadHandler m => m (Route (SubHandlerSite m) -> Text)
|
||||
getParentUrlRender = (.) <$> getUrlRender <*> getRouteToParent
|
||||
|
||||
-- | Set a random, ~30-character value in the session
|
||||
-- | Set a random, ~64-byte value in the session
|
||||
--
|
||||
-- Some (but not all) providers decode a @+@ in the state token as a space when
|
||||
-- sending it back to us. We don't expect this and fail. And if we did code for
|
||||
-- it, we'd then fail on the providers that /don't/ do that.
|
||||
--
|
||||
-- Therefore, we just exclude @+@ in our tokens, which means this function may
|
||||
-- return slightly less than 30 characters.
|
||||
--
|
||||
-- return slightly fewer than 64 bytes.
|
||||
setSessionCSRF :: MonadHandler m => Text -> m Text
|
||||
setSessionCSRF sessionKey = do
|
||||
csrfToken <- liftIO randomToken
|
||||
csrfToken <$ setSession sessionKey csrfToken
|
||||
where randomToken = T.filter (/= '+') <$> randomText 64
|
||||
where
|
||||
randomToken = T.filter (/= '+') <$> randomText 64
|
||||
|
||||
-- | Verify the callback provided the same CSRF token as in our session
|
||||
verifySessionCSRF
|
||||
@ -133,9 +145,10 @@ verifySessionCSRF sessionKey = do
|
||||
token <- requireGetParam "state"
|
||||
sessionToken <- lookupSession sessionKey
|
||||
deleteSession sessionKey
|
||||
token <$ unless
|
||||
(sessionToken == Just token)
|
||||
(throwError $ InvalidStateToken sessionToken token)
|
||||
token
|
||||
<$ unless
|
||||
(sessionToken == Just token)
|
||||
(throwError $ InvalidStateToken sessionToken token)
|
||||
|
||||
requireGetParam
|
||||
:: (MonadError DispatchError m, MonadHandler m) => Text -> m Text
|
||||
|
||||
@ -9,14 +9,14 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.DispatchError
|
||||
( DispatchError(..)
|
||||
( DispatchError (..)
|
||||
, handleDispatchError
|
||||
, onDispatchError
|
||||
) where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Data.Text (Text, pack)
|
||||
import Network.OAuth.OAuth2.Compat (Errors)
|
||||
import Network.OAuth.OAuth2.Compat (TokenResponseError)
|
||||
import UnliftIO.Except ()
|
||||
import UnliftIO.Exception
|
||||
import Yesod.Auth hiding (ServerError)
|
||||
@ -26,34 +26,33 @@ import Yesod.Auth.OAuth2.Random
|
||||
import Yesod.Core hiding (ErrorResponse)
|
||||
|
||||
data DispatchError
|
||||
= MissingParameter Text
|
||||
| InvalidStateToken (Maybe Text) Text
|
||||
| InvalidCallbackUri Text
|
||||
| OAuth2HandshakeError ErrorResponse
|
||||
| OAuth2ResultError Errors
|
||||
| FetchCredsIOException IOException
|
||||
| FetchCredsYesodOAuth2Exception YesodOAuth2Exception
|
||||
| OtherDispatchError Text
|
||||
deriving stock Show
|
||||
deriving anyclass Exception
|
||||
= MissingParameter Text
|
||||
| InvalidStateToken (Maybe Text) Text
|
||||
| InvalidCallbackUri Text
|
||||
| OAuth2HandshakeError ErrorResponse
|
||||
| OAuth2ResultError TokenResponseError
|
||||
| FetchCredsIOException IOException
|
||||
| FetchCredsYesodOAuth2Exception YesodOAuth2Exception
|
||||
| OtherDispatchError Text
|
||||
deriving stock (Show)
|
||||
deriving anyclass (Exception)
|
||||
|
||||
-- | User-friendly message for any given 'DispatchError'
|
||||
--
|
||||
-- Most of these are opaque to the user. The exception details are present for
|
||||
-- the server logs.
|
||||
--
|
||||
dispatchErrorMessage :: DispatchError -> Text
|
||||
dispatchErrorMessage = \case
|
||||
MissingParameter name ->
|
||||
"Parameter '" <> name <> "' is required, but not present in the URL"
|
||||
InvalidStateToken{} -> "State token is invalid, please try again"
|
||||
InvalidCallbackUri{} ->
|
||||
InvalidStateToken {} -> "State token is invalid, please try again"
|
||||
InvalidCallbackUri {} ->
|
||||
"Callback URI was not valid, this server may be misconfigured (no approot)"
|
||||
OAuth2HandshakeError er -> "OAuth2 handshake failure: " <> erUserMessage er
|
||||
OAuth2ResultError{} -> "Login failed, please try again"
|
||||
FetchCredsIOException{} -> "Login failed, please try again"
|
||||
FetchCredsYesodOAuth2Exception{} -> "Login failed, please try again"
|
||||
OtherDispatchError{} -> "Login failed, please try again"
|
||||
OAuth2ResultError {} -> "Login failed, please try again"
|
||||
FetchCredsIOException {} -> "Login failed, please try again"
|
||||
FetchCredsYesodOAuth2Exception {} -> "Login failed, please try again"
|
||||
OtherDispatchError {} -> "Login failed, please try again"
|
||||
|
||||
handleDispatchError
|
||||
:: MonadAuthHandler site m
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | OAuth callback error response
|
||||
--
|
||||
-- <https://tools.ietf.org/html/rfc6749#section-4.1.2.1>
|
||||
--
|
||||
module Yesod.Auth.OAuth2.ErrorResponse
|
||||
( ErrorResponse(..)
|
||||
( ErrorResponse (..)
|
||||
, erUserMessage
|
||||
, ErrorName(..)
|
||||
, ErrorName (..)
|
||||
, onErrorResponse
|
||||
, unknownError
|
||||
) where
|
||||
@ -17,22 +17,22 @@ import Data.Traversable (for)
|
||||
import Yesod.Core (MonadHandler, lookupGetParam)
|
||||
|
||||
data ErrorName
|
||||
= InvalidRequest
|
||||
| UnauthorizedClient
|
||||
| AccessDenied
|
||||
| UnsupportedResponseType
|
||||
| InvalidScope
|
||||
| ServerError
|
||||
| TemporarilyUnavailable
|
||||
| Unknown Text
|
||||
deriving Show
|
||||
= InvalidRequest
|
||||
| UnauthorizedClient
|
||||
| AccessDenied
|
||||
| UnsupportedResponseType
|
||||
| InvalidScope
|
||||
| ServerError
|
||||
| TemporarilyUnavailable
|
||||
| Unknown Text
|
||||
deriving (Show)
|
||||
|
||||
data ErrorResponse = ErrorResponse
|
||||
{ erName :: ErrorName
|
||||
, erDescription :: Maybe Text
|
||||
, erURI :: Maybe Text
|
||||
}
|
||||
deriving Show
|
||||
deriving (Show)
|
||||
|
||||
-- | Textual value suitable for display to a User
|
||||
erUserMessage :: ErrorResponse -> Text
|
||||
@ -48,13 +48,12 @@ erUserMessage err = case erName err of
|
||||
|
||||
unknownError :: Text -> ErrorResponse
|
||||
unknownError x =
|
||||
ErrorResponse { erName = Unknown x, erDescription = Nothing, erURI = Nothing }
|
||||
ErrorResponse {erName = Unknown x, erDescription = Nothing, erURI = Nothing}
|
||||
|
||||
-- | Check query parameters for an error, if found run the given action
|
||||
--
|
||||
-- The action is expected to use a short-circuit response function like
|
||||
-- @'permissionDenied'@, hence this returning @()@.
|
||||
--
|
||||
onErrorResponse :: MonadHandler m => (ErrorResponse -> m a) -> m ()
|
||||
onErrorResponse f = traverse_ f =<< checkErrorResponse
|
||||
|
||||
|
||||
@ -1,16 +1,16 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://eveonline.com
|
||||
--
|
||||
-- * Authenticates against eveonline
|
||||
-- * Uses EVEs unique account-user-char-hash as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.EveOnline
|
||||
( oauth2Eve
|
||||
, oauth2EveScoped
|
||||
, WidgetType(..)
|
||||
, WidgetType (..)
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
@ -24,23 +24,24 @@ instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "CharacterOwnerHash"
|
||||
|
||||
data WidgetType m
|
||||
= Plain -- ^ Simple "Login via eveonline" text
|
||||
| BigWhite
|
||||
| SmallWhite
|
||||
| BigBlack
|
||||
| SmallBlack
|
||||
| Custom (WidgetFor m ())
|
||||
= -- | Simple "Login via eveonline" text
|
||||
Plain
|
||||
| BigWhite
|
||||
| SmallWhite
|
||||
| BigBlack
|
||||
| SmallBlack
|
||||
| Custom (WidgetFor m ())
|
||||
|
||||
asWidget :: YesodAuth m => WidgetType m -> WidgetFor m ()
|
||||
asWidget Plain = [whamlet|Login via eveonline|]
|
||||
asWidget BigWhite =
|
||||
[whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|]
|
||||
asWidget BigBlack
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]
|
||||
asWidget SmallWhite
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/18BxKSXCymyqY4QKo8KwKe/c2bdded6118472dd587c8107f24104d7/EVE_SSO_Login_Buttons_Small_White.png?w=195&h=30">|]
|
||||
asWidget SmallBlack
|
||||
= [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/12vrPsIMBQi28QwCGOAqGk/33234da7672c6b0cdca394fc8e0b1c2b/EVE_SSO_Login_Buttons_Small_Black.png?w=195&h=30">|]
|
||||
asWidget BigBlack =
|
||||
[whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]
|
||||
asWidget SmallWhite =
|
||||
[whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/18BxKSXCymyqY4QKo8KwKe/c2bdded6118472dd587c8107f24104d7/EVE_SSO_Login_Buttons_Small_White.png?w=195&h=30">|]
|
||||
asWidget SmallBlack =
|
||||
[whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/12vrPsIMBQi28QwCGOAqGk/33234da7672c6b0cdca394fc8e0b1c2b/EVE_SSO_Login_Buttons_Small_Black.png?w=195&h=30">|]
|
||||
asWidget (Custom a) = a
|
||||
|
||||
pluginName :: Text
|
||||
@ -57,25 +58,28 @@ oauth2EveScoped
|
||||
oauth2EveScoped scopes widgetType clientId clientSecret =
|
||||
authOAuth2Widget (asWidget widgetType) pluginName oauth2 $ \manager token ->
|
||||
do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://login.eveonline.com/oauth/verify"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://login.eveonline.com/oauth/verify"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = "eveonline"
|
||||
-- FIXME: Preserved bug. See similar comment in Bitbucket provider.
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = "eveonline"
|
||||
, -- FIXME: Preserved bug. See similar comment in Bitbucket provider.
|
||||
credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://login.eveonline.com/oauth/authorize"
|
||||
`withQuery` [("response_type", "code"), scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://login.eveonline.com/oauth/authorize"
|
||||
`withQuery` [("response_type", "code"), scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,7 +1,5 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.Exception
|
||||
( YesodOAuth2Exception(..)
|
||||
( YesodOAuth2Exception (..)
|
||||
) where
|
||||
|
||||
import Control.Exception.Safe
|
||||
@ -9,21 +7,18 @@ import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Text (Text)
|
||||
|
||||
data YesodOAuth2Exception
|
||||
= OAuth2Error Text ByteString
|
||||
-- ^ HTTP error during OAuth2 handshake
|
||||
= -- | HTTP error during OAuth2 handshake
|
||||
--
|
||||
-- Plugin name and JSON-encoded @OAuth2Error@ from @hoauth2@.
|
||||
--
|
||||
| JSONDecodingError Text String
|
||||
-- ^ User profile was not as expected
|
||||
OAuth2Error Text ByteString
|
||||
| -- | User profile was not as expected
|
||||
--
|
||||
-- Plugin name and Aeson parse error message.
|
||||
--
|
||||
| GenericError Text String
|
||||
-- ^ Other error conditions
|
||||
JSONDecodingError Text String
|
||||
| -- | Other error conditions
|
||||
--
|
||||
-- Plugin name and error message.
|
||||
--
|
||||
deriving (Show, Typeable)
|
||||
GenericError Text String
|
||||
deriving (Show)
|
||||
|
||||
instance Exception YesodOAuth2Exception
|
||||
|
||||
@ -1,19 +1,22 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://github.com
|
||||
--
|
||||
-- * Authenticates against github
|
||||
-- * Uses github user id as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.GitHub
|
||||
( oauth2GitHub
|
||||
, oauth2GitHubWidget
|
||||
, oauth2GitHubScoped
|
||||
, oauth2GitHubScopedWidget
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
import Yesod.Core (WidgetFor, whamlet)
|
||||
|
||||
newtype User = User Int
|
||||
|
||||
@ -29,27 +32,39 @@ defaultScopes = ["user:email"]
|
||||
oauth2GitHub :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2GitHub = oauth2GitHubScoped defaultScopes
|
||||
|
||||
oauth2GitHubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2GitHubScoped scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://api.github.com/user"
|
||||
oauth2GitHubWidget
|
||||
:: YesodAuth m => WidgetFor m () -> Text -> Text -> AuthPlugin m
|
||||
oauth2GitHubWidget widget = oauth2GitHubScopedWidget widget defaultScopes
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
oauth2GitHubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2GitHubScoped =
|
||||
oauth2GitHubScopedWidget [whamlet|Login via #{pluginName}|]
|
||||
|
||||
oauth2GitHubScopedWidget
|
||||
:: YesodAuth m => WidgetFor m () -> [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2GitHubScopedWidget widget scopes clientId clientSecret =
|
||||
authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://api.github.com/user"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://github.com/login/oauth/authorize"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://github.com/login/oauth/access_token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://github.com/login/oauth/authorize"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://github.com/login/oauth/access_token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.GitLab
|
||||
( oauth2GitLab
|
||||
, oauth2GitLabHostScopes
|
||||
@ -32,7 +33,6 @@ defaultScopes = ["read_user"]
|
||||
--
|
||||
-- > oauth2GitLabHostScopes defaultHost ["api", "read_user"]
|
||||
-- > oauth2GitLabHostScopes "https://gitlab.example.com" defaultScopes
|
||||
--
|
||||
oauth2GitLab :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2GitLab = oauth2GitLabHostScopes defaultHost defaultScopes
|
||||
|
||||
@ -43,17 +43,19 @@ oauth2GitLabHostScopes host scopes clientId clientSecret =
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile pluginName manager token $ host `withPath` "/api/v4/user"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
host `withPath` "/oauth/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = host `withPath` "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
host `withPath` "/oauth/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = host `withPath` "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://www.google.com
|
||||
@ -23,7 +24,6 @@
|
||||
-- > updatedCreds = creds { credsIdent = email }
|
||||
-- >
|
||||
-- > -- continue normally with updatedCreds
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Google
|
||||
( oauth2Google
|
||||
, oauth2GoogleWidget
|
||||
@ -38,9 +38,9 @@ newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON =
|
||||
withObject "User" $ \o -> User
|
||||
withObject "User" $ \o ->
|
||||
-- Required for data backwards-compatibility
|
||||
<$> (("google-uid:" <>) <$> o .: "sub")
|
||||
User . ("google-uid:" <>) <$> o .: "sub"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "google"
|
||||
@ -63,24 +63,27 @@ oauth2GoogleScopedWidget
|
||||
:: YesodAuth m => WidgetFor m () -> [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2GoogleScopedWidget widget scopes clientId clientSecret =
|
||||
authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://www.googleapis.com/oauth2/v3/userinfo"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://www.googleapis.com/oauth2/v3/userinfo"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://accounts.google.com/o/oauth2/auth"
|
||||
`withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://accounts.google.com/o/oauth2/auth"
|
||||
`withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -26,41 +26,45 @@ defaultScopes = ["email"]
|
||||
oauth2Nylas :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2Nylas clientId clientSecret =
|
||||
authOAuth2 pluginName oauth $ \manager token -> do
|
||||
req <- applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) ""
|
||||
<$> parseRequest "https://api.nylas.com/account"
|
||||
req <-
|
||||
applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) ""
|
||||
<$> parseRequest "https://api.nylas.com/account"
|
||||
resp <- httpLbs req manager
|
||||
let userResponse = responseBody resp
|
||||
|
||||
-- FIXME: was this working? I'm 95% sure that the client will throw its
|
||||
-- own exception on unsuccessful status codes.
|
||||
unless (HT.statusIsSuccessful $ responseStatus resp)
|
||||
$ throwIO
|
||||
$ YesodOAuth2Exception.GenericError pluginName
|
||||
$ "Unsuccessful HTTP response: "
|
||||
<> BL8.unpack userResponse
|
||||
unless (HT.statusIsSuccessful $ responseStatus resp) $
|
||||
throwIO $
|
||||
YesodOAuth2Exception.GenericError pluginName $
|
||||
"Unsuccessful HTTP response: "
|
||||
<> BL8.unpack userResponse
|
||||
|
||||
either
|
||||
(throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
|
||||
(\(User userId) -> pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
)
|
||||
(throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
|
||||
( \(User userId) ->
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
)
|
||||
$ eitherDecode userResponse
|
||||
where
|
||||
oauth = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://api.nylas.com/oauth/authorize"
|
||||
`withQuery` [ ("response_type", "code")
|
||||
, ("client_id", encodeUtf8 clientId)
|
||||
-- N.B. The scopes delimeter is unknown/untested. Verify that before
|
||||
-- extracting this to an argument and offering a Scoped function. In
|
||||
-- its current state, it doesn't matter because it's only one scope.
|
||||
, scopeParam "," defaultScopes
|
||||
]
|
||||
, oauth2TokenEndpoint = "https://api.nylas.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://api.nylas.com/oauth/authorize"
|
||||
`withQuery` [ ("response_type", "code")
|
||||
, ("client_id", encodeUtf8 clientId)
|
||||
, -- N.B. The scopes delimeter is unknown/untested. Verify that before
|
||||
-- extracting this to an argument and offering a Scoped function. In
|
||||
-- its current state, it doesn't matter because it's only one scope.
|
||||
scopeParam "," defaultScopes
|
||||
]
|
||||
, oauth2TokenEndpoint = "https://api.nylas.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
50
src/Yesod/Auth/OAuth2/ORCID.hs
Normal file
50
src/Yesod/Auth/OAuth2/ORCID.hs
Normal file
@ -0,0 +1,50 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.ORCID
|
||||
( oauth2ORCID
|
||||
) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "orcid"
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "sub"
|
||||
|
||||
oauth2ORCID
|
||||
:: YesodAuth m
|
||||
=> Text
|
||||
-- ^ Client Id
|
||||
-> Text
|
||||
-- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2ORCID clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://orcid.org/oauth/userinfo"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://orcid.org/oauth/authorize"
|
||||
`withQuery` [scopeParam " " ["openid"]]
|
||||
, oauth2TokenEndpoint = "https://orcid.org/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
@ -1,10 +1,10 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- Modules and support functions required by most or all provider
|
||||
-- implementations. May also be useful for writing local providers.
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Prelude
|
||||
( authGetProfile
|
||||
, scopeParam
|
||||
@ -20,8 +20,8 @@ module Yesod.Auth.OAuth2.Prelude
|
||||
, (.:?)
|
||||
, (.=)
|
||||
, (<>)
|
||||
, FromJSON(..)
|
||||
, ToJSON(..)
|
||||
, FromJSON (..)
|
||||
, ToJSON (..)
|
||||
, eitherDecode
|
||||
, withObject
|
||||
|
||||
@ -29,22 +29,27 @@ module Yesod.Auth.OAuth2.Prelude
|
||||
, throwIO
|
||||
|
||||
-- * OAuth2
|
||||
, OAuth2(..)
|
||||
, OAuth2Token(..)
|
||||
, AccessToken(..)
|
||||
, RefreshToken(..)
|
||||
, OAuth2 (..)
|
||||
, TokenResponse
|
||||
, accessToken
|
||||
, refreshToken
|
||||
, expiresIn
|
||||
, tokenType
|
||||
, idToken
|
||||
, AccessToken (..)
|
||||
, RefreshToken (..)
|
||||
|
||||
-- * HTTP
|
||||
, Manager
|
||||
|
||||
-- * Yesod
|
||||
, YesodAuth(..)
|
||||
, AuthPlugin(..)
|
||||
, Creds(..)
|
||||
, YesodAuth (..)
|
||||
, AuthPlugin (..)
|
||||
, Creds (..)
|
||||
|
||||
-- * Bytestring URI types
|
||||
, URI
|
||||
, Host(..)
|
||||
, Host (..)
|
||||
|
||||
-- * Bytestring URI extensions
|
||||
, module URI.ByteString.Extension
|
||||
@ -74,12 +79,11 @@ import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
|
||||
-- The response should be parsed only far enough to read the required
|
||||
-- @'credsIdent'@. Additional information should either be re-parsed by or
|
||||
-- fetched via additional requests by consumers.
|
||||
--
|
||||
authGetProfile
|
||||
:: FromJSON a
|
||||
=> Text
|
||||
-> Manager
|
||||
-> OAuth2Token
|
||||
-> TokenResponse
|
||||
-> URI
|
||||
-> IO (a, BL.ByteString)
|
||||
authGetProfile name manager token url = do
|
||||
@ -101,7 +105,7 @@ fromAuthJSON name =
|
||||
|
||||
-- | A tuple of @\"scope\"@ and the given scopes separated by a delimiter
|
||||
scopeParam :: Text -> [Text] -> (ByteString, ByteString)
|
||||
scopeParam d = ("scope", ) . encodeUtf8 . T.intercalate d
|
||||
scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d
|
||||
|
||||
-- brittany-disable-next-binding
|
||||
|
||||
@ -115,10 +119,9 @@ scopeParam d = ("scope", ) . encodeUtf8 . T.intercalate d
|
||||
-- May set the following keys:
|
||||
--
|
||||
-- - @refreshToken@: if the provider supports refreshing the @accessToken@
|
||||
--
|
||||
setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)]
|
||||
setExtra :: TokenResponse -> BL.ByteString -> [(Text, Text)]
|
||||
setExtra token userResponse =
|
||||
[ ("accessToken", atoken $ accessToken token)
|
||||
, ("userResponse", decodeUtf8 $ BL.toStrict userResponse)
|
||||
]
|
||||
<> maybe [] (pure . ("refreshToken", ) . rtoken) (refreshToken token)
|
||||
[ ("accessToken", atoken $ accessToken token)
|
||||
, ("userResponse", decodeUtf8 $ BL.toStrict userResponse)
|
||||
]
|
||||
<> maybe [] (pure . ("refreshToken",) . rtoken) (refreshToken token)
|
||||
|
||||
@ -5,7 +5,7 @@ module Yesod.Auth.OAuth2.Random
|
||||
) where
|
||||
|
||||
import Crypto.Random (MonadRandom, getRandomBytes)
|
||||
import Data.ByteArray.Encoding (Base(Base64), convertToBase)
|
||||
import Data.ByteArray.Encoding (Base (Base64), convertToBase)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
@ -13,7 +13,7 @@ import Data.Text.Encoding (decodeUtf8)
|
||||
randomText
|
||||
:: MonadRandom m
|
||||
=> Int
|
||||
-- ^ Size in Bytes (note necessarily characters)
|
||||
-- ^ Size in Bytes (not necessarily characters)
|
||||
-> m Text
|
||||
randomText size =
|
||||
decodeUtf8 . convertToBase @ByteString Base64 <$> getRandomBytes size
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://login.salesforce.com
|
||||
--
|
||||
-- * Authenticates against Salesforce (or sandbox)
|
||||
-- * Uses Salesforce user id as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Salesforce
|
||||
( oauth2Salesforce
|
||||
, oauth2SalesforceScoped
|
||||
@ -30,47 +30,54 @@ oauth2Salesforce :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2Salesforce = oauth2SalesforceScoped defaultScopes
|
||||
|
||||
oauth2SalesforceScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2SalesforceScoped = salesforceHelper
|
||||
pluginName
|
||||
"https://login.salesforce.com/services/oauth2/userinfo"
|
||||
"https://login.salesforce.com/services/oauth2/authorize"
|
||||
"https://login.salesforce.com/services/oauth2/token"
|
||||
oauth2SalesforceScoped =
|
||||
salesforceHelper
|
||||
pluginName
|
||||
"https://login.salesforce.com/services/oauth2/userinfo"
|
||||
"https://login.salesforce.com/services/oauth2/authorize"
|
||||
"https://login.salesforce.com/services/oauth2/token"
|
||||
|
||||
oauth2SalesforceSandbox :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped defaultScopes
|
||||
|
||||
oauth2SalesforceSandboxScoped
|
||||
:: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2SalesforceSandboxScoped = salesforceHelper
|
||||
(pluginName <> "-sandbox")
|
||||
"https://test.salesforce.com/services/oauth2/userinfo"
|
||||
"https://test.salesforce.com/services/oauth2/authorize"
|
||||
"https://test.salesforce.com/services/oauth2/token"
|
||||
oauth2SalesforceSandboxScoped =
|
||||
salesforceHelper
|
||||
(pluginName <> "-sandbox")
|
||||
"https://test.salesforce.com/services/oauth2/userinfo"
|
||||
"https://test.salesforce.com/services/oauth2/authorize"
|
||||
"https://test.salesforce.com/services/oauth2/token"
|
||||
|
||||
salesforceHelper
|
||||
:: YesodAuth m
|
||||
=> Text
|
||||
-> URI -- ^ User profile
|
||||
-> URI -- ^ Authorize
|
||||
-> URI -- ^ Token
|
||||
-> URI
|
||||
-- ^ User profile
|
||||
-> URI
|
||||
-- ^ Authorize
|
||||
-> URI
|
||||
-- ^ Token
|
||||
-> [Text]
|
||||
-> Text
|
||||
-> Text
|
||||
-> AuthPlugin m
|
||||
salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret
|
||||
= authOAuth2 name oauth2 $ \manager token -> do
|
||||
salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret =
|
||||
authOAuth2 name oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile name manager token profileUri
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = tokenUri
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = tokenUri
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
-- OAuth2 plugin for https://slack.com/
|
||||
--
|
||||
-- * Authenticates against slack
|
||||
-- * Uses slack user id as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Slack
|
||||
( SlackScope(..)
|
||||
( SlackScope (..)
|
||||
, oauth2Slack
|
||||
, oauth2SlackScoped
|
||||
) where
|
||||
@ -14,14 +14,18 @@ module Yesod.Auth.OAuth2.Slack
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import Network.HTTP.Client
|
||||
(httpLbs, parseUrlThrow, responseBody, setQueryString)
|
||||
( httpLbs
|
||||
, parseUrlThrow
|
||||
, responseBody
|
||||
, setQueryString
|
||||
)
|
||||
import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
|
||||
|
||||
data SlackScope
|
||||
= SlackBasicScope
|
||||
| SlackEmailScope
|
||||
| SlackTeamScope
|
||||
| SlackAvatarScope
|
||||
= SlackBasicScope
|
||||
| SlackEmailScope
|
||||
| SlackTeamScope
|
||||
| SlackAvatarScope
|
||||
|
||||
scopeText :: SlackScope -> Text
|
||||
scopeText SlackBasicScope = "identity.basic"
|
||||
@ -50,26 +54,30 @@ oauth2SlackScoped
|
||||
oauth2SlackScoped scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
let param = encodeUtf8 $ atoken $ accessToken token
|
||||
req <- setQueryString [("token", Just param)]
|
||||
<$> parseUrlThrow "https://slack.com/api/users.identity"
|
||||
req <-
|
||||
setQueryString [("token", Just param)]
|
||||
<$> parseUrlThrow "https://slack.com/api/users.identity"
|
||||
userResponse <- responseBody <$> httpLbs req manager
|
||||
|
||||
either
|
||||
(throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
|
||||
(\(User userId) -> pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
)
|
||||
(throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
|
||||
( \(User userId) ->
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
)
|
||||
$ eitherDecode userResponse
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://slack.com/oauth/authorize"
|
||||
`withQuery` [scopeParam "," $ map scopeText scopes]
|
||||
, oauth2TokenEndpoint = "https://slack.com/api/oauth.access"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://slack.com/oauth/authorize"
|
||||
`withQuery` [scopeParam "," $ map scopeText scopes]
|
||||
, oauth2TokenEndpoint = "https://slack.com/api/oauth.access"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://spotify.com
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Spotify
|
||||
( oauth2Spotify
|
||||
) where
|
||||
@ -20,24 +20,27 @@ pluginName = "spotify"
|
||||
oauth2Spotify :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2Spotify scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://api.spotify.com/v1/me"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://api.spotify.com/v1/me"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://accounts.spotify.com/authorize"
|
||||
`withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://accounts.spotify.com/api/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://accounts.spotify.com/authorize"
|
||||
`withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://accounts.spotify.com/api/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://twitch.tv
|
||||
--
|
||||
-- * Authenticates against twitch
|
||||
-- * Uses twitch user id as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Twitch
|
||||
( oauth2Twitch
|
||||
, oauth2TwitchScoped
|
||||
@ -32,28 +32,31 @@ oauth2Twitch = oauth2TwitchScoped defaultScopes
|
||||
oauth2TwitchScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2TwitchScoped scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://id.twitch.tv/oauth2/validate"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://id.twitch.tv/oauth2/validate"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://id.twitch.tv/oauth2/authorize"
|
||||
`withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint =
|
||||
"https://id.twitch.tv/oauth2/token"
|
||||
`withQuery` [ ("client_id", T.encodeUtf8 clientId)
|
||||
, ("client_secret", T.encodeUtf8 clientSecret)
|
||||
]
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://id.twitch.tv/oauth2/authorize"
|
||||
`withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint =
|
||||
"https://id.twitch.tv/oauth2/token"
|
||||
`withQuery` [ ("client_id", T.encodeUtf8 clientId)
|
||||
, ("client_secret", T.encodeUtf8 clientSecret)
|
||||
]
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://upcase.com
|
||||
--
|
||||
-- * Authenticates against upcase
|
||||
-- * Uses upcase user id as credentials identifier
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Upcase
|
||||
( oauth2Upcase
|
||||
) where
|
||||
@ -27,22 +27,25 @@ pluginName = "upcase"
|
||||
oauth2Upcase :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2Upcase clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(User userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"http://upcase.com/api/v1/me.json"
|
||||
(User userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"http://upcase.com/api/v1/me.json"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize"
|
||||
, oauth2TokenEndpoint = "http://upcase.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize"
|
||||
, oauth2TokenEndpoint = "http://upcase.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -16,31 +16,35 @@ instance FromJSON WpUser where
|
||||
parseJSON = withObject "WpUser" $ \o -> WpUser <$> o .: "ID"
|
||||
|
||||
oauth2WordPressDotCom
|
||||
:: (YesodAuth m)
|
||||
=> Text -- ^ Client Id
|
||||
-> Text -- ^ Client Secret
|
||||
:: YesodAuth m
|
||||
=> Text
|
||||
-- ^ Client Id
|
||||
-> Text
|
||||
-- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2WordPressDotCom clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(WpUser userId, userResponse) <- authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://public-api.wordpress.com/rest/v1/me/"
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
(WpUser userId, userResponse) <-
|
||||
authGetProfile
|
||||
pluginName
|
||||
manager
|
||||
token
|
||||
"https://public-api.wordpress.com/rest/v1/me/"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://public-api.wordpress.com/oauth2/authorize"
|
||||
`withQuery` [scopeParam "," ["auth"]]
|
||||
, oauth2TokenEndpoint = "https://public-api.wordpress.com/oauth2/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://public-api.wordpress.com/oauth2/authorize"
|
||||
`withQuery` [scopeParam "," ["auth"]]
|
||||
, oauth2TokenEndpoint = "https://public-api.wordpress.com/oauth2/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
|
||||
@ -1,3 +0,0 @@
|
||||
resolver: lts-18.23
|
||||
extra-deps:
|
||||
- hoauth2-2.0.0@sha256:4686d776272d4c57d3c8dbeb9e58b04afe4d2b410382011bd78a3d2bfb08a3fe,5662
|
||||
@ -1,19 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: hoauth2-2.0.0@sha256:4686d776272d4c57d3c8dbeb9e58b04afe4d2b410382011bd78a3d2bfb08a3fe,5662
|
||||
pantry-tree:
|
||||
size: 2171
|
||||
sha256: 291b3dd90854ef44f270519ec17e34b6778f8430f6d6517bd67b0128bd549553
|
||||
original:
|
||||
hackage: hoauth2-2.0.0@sha256:4686d776272d4c57d3c8dbeb9e58b04afe4d2b410382011bd78a3d2bfb08a3fe,5662
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 587819
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/23.yaml
|
||||
sha256: 7f69bb29a57495586e7e3ed31ecc59c0d2c959cb23bd52b71ca676f254c9beb1
|
||||
original: lts-18.23
|
||||
@ -1,3 +0,0 @@
|
||||
resolver: nightly-2022-02-25
|
||||
extra-deps:
|
||||
- hoauth2-2.2.0@sha256:83a96156717d9e2c93394b35bef4151f82b90dc88b83d0e35c0bf1158bd41c6c,2801
|
||||
@ -1,19 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: hoauth2-2.2.0@sha256:83a96156717d9e2c93394b35bef4151f82b90dc88b83d0e35c0bf1158bd41c6c,2801
|
||||
pantry-tree:
|
||||
size: 593
|
||||
sha256: d6e2d12e0e66eb9392301ec97d50677afb71608568f3664eb466a4451c66ba59
|
||||
original:
|
||||
hackage: hoauth2-2.2.0@sha256:83a96156717d9e2c93394b35bef4151f82b90dc88b83d0e35c0bf1158bd41c6c,2801
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 611886
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/2/25.yaml
|
||||
sha256: b18614ab8986a4ba6d469921a2c18decab244af78309effa3d2dab85dbdfef80
|
||||
original: nightly-2022-02-25
|
||||
@ -1,3 +0,0 @@
|
||||
resolver: nightly-2022-02-25
|
||||
extra-deps:
|
||||
- hoauth2-2.3.0@sha256:213744356007a4686ff3bb72105843d478bc0ba6229659429cbe241a99f55095,2816
|
||||
@ -1,19 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: hoauth2-2.3.0@sha256:213744356007a4686ff3bb72105843d478bc0ba6229659429cbe241a99f55095,2816
|
||||
pantry-tree:
|
||||
size: 594
|
||||
sha256: e559c811165a2e75cfe649b68396466b3bd0b6a5353a9d6476605e6a40e0eb37
|
||||
original:
|
||||
hackage: hoauth2-2.3.0@sha256:213744356007a4686ff3bb72105843d478bc0ba6229659429cbe241a99f55095,2816
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 611886
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/2/25.yaml
|
||||
sha256: b18614ab8986a4ba6d469921a2c18decab244af78309effa3d2dab85dbdfef80
|
||||
original: nightly-2022-02-25
|
||||
@ -1,11 +0,0 @@
|
||||
resolver: nightly-2022-12-09
|
||||
|
||||
extra-deps:
|
||||
- hoauth2-2.6.0
|
||||
|
||||
# hoauth2 needs upper-bounds relaxed for
|
||||
#
|
||||
# - memory-0.18.0
|
||||
# - text-2.0.1
|
||||
#
|
||||
allow-newer: true
|
||||
@ -1,19 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: hoauth2-2.6.0@sha256:168321df73bf75dc7cdda8e72725e9f3f624a9776b1fe59ae46c29c45029dc5d,2262
|
||||
pantry-tree:
|
||||
sha256: 5d39759b171cfaaf5842069a5548c2c1a41c0978645d018da7df713a186192b5
|
||||
size: 859
|
||||
original:
|
||||
hackage: hoauth2-2.6.0
|
||||
snapshots:
|
||||
- completed:
|
||||
sha256: b77e2c2b7988ed34cd317c01eb1958a8b8c234c3cc17e44077616c212959bed0
|
||||
size: 558756
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/12/9.yaml
|
||||
original: nightly-2022-12-09
|
||||
@ -1,11 +0,0 @@
|
||||
---
|
||||
resolver: lts-13.2
|
||||
|
||||
extra-deps:
|
||||
- hoauth2-1.14.0@sha256:fcb4284fc78950c91d5b548317c51bd99a5ced84f4bb9e6153624b5783e4215f,5628
|
||||
|
||||
# Fix for weeder with stack-2
|
||||
ghc-options:
|
||||
"$locals":
|
||||
-ddump-to-file
|
||||
-ddump-hi
|
||||
@ -1,19 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: hoauth2-1.14.0@sha256:fcb4284fc78950c91d5b548317c51bd99a5ced84f4bb9e6153624b5783e4215f,5628
|
||||
pantry-tree:
|
||||
size: 2046
|
||||
sha256: f25e2c2c101312196159dad5a3e2a4c8f549ed2d036d9566b66786d758db7dba
|
||||
original:
|
||||
hackage: hoauth2-1.14.0@sha256:fcb4284fc78950c91d5b548317c51bd99a5ced84f4bb9e6153624b5783e4215f,5628
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 492864
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/2.yaml
|
||||
sha256: 586534518d3e7be8617d97ea296f05f497c0b4bb006f100367d66f5c45ae6268
|
||||
original: lts-13.2
|
||||
@ -1,8 +0,0 @@
|
||||
---
|
||||
resolver: lts-16.10
|
||||
|
||||
# Fix for weeder with stack-2
|
||||
ghc-options:
|
||||
"$locals":
|
||||
-ddump-to-file
|
||||
-ddump-hi
|
||||
@ -1,12 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 532383
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/10.yaml
|
||||
sha256: 469d781ab6d2a4eceed6b31b6e4ec842dcd3cd1d11577972e86902603dce24df
|
||||
original: lts-16.10
|
||||
@ -1 +0,0 @@
|
||||
resolver: lts-17.4
|
||||
@ -1,12 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 563103
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/4.yaml
|
||||
sha256: f11e2153044f5f71ea7b1c9398f4721f517c9bd37642ed769647b896564021f3
|
||||
original: lts-17.4
|
||||
1
stack-lts21.yaml
Normal file
1
stack-lts21.yaml
Normal file
@ -0,0 +1 @@
|
||||
resolver: lts-21.25
|
||||
1
stack-lts22.yaml
Normal file
1
stack-lts22.yaml
Normal file
@ -0,0 +1 @@
|
||||
resolver: lts-22.44
|
||||
1
stack-lts23.yaml
Normal file
1
stack-lts23.yaml
Normal file
@ -0,0 +1 @@
|
||||
resolver: lts-23.28
|
||||
1
stack-lts24.yaml
Normal file
1
stack-lts24.yaml
Normal file
@ -0,0 +1 @@
|
||||
resolver: lts-24.26
|
||||
@ -1,11 +1,4 @@
|
||||
resolver: nightly-2023-04-04
|
||||
|
||||
resolver: nightly-2026-01-05
|
||||
extra-deps:
|
||||
- hoauth2-2.7.0
|
||||
|
||||
allow-newer: true
|
||||
allow-newer-deps:
|
||||
- hoauth2
|
||||
# hoauth2 needs upper-bounds relaxed for
|
||||
- memory
|
||||
- text
|
||||
- cryptonite-0.30
|
||||
- yesod-auth-1.6.11.3
|
||||
|
||||
@ -1,19 +0,0 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: hoauth2-2.7.0@sha256:34c5b82d49a814cfa214b65f5422fda876e38c1275504b574355cf5413e37138,2833
|
||||
pantry-tree:
|
||||
sha256: f575d77978c823bedba13c67f7e31195da6c5543fbd9b35b9def225a8ace6833
|
||||
size: 996
|
||||
original:
|
||||
hackage: hoauth2-2.7.0
|
||||
snapshots:
|
||||
- completed:
|
||||
sha256: eaacd008a9ade10f0a8ff460afdd6564469e70b8e1663c0404d95651788dc7a5
|
||||
size: 600986
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2023/4/4.yaml
|
||||
original: nightly-2023-04-04
|
||||
@ -1 +0,0 @@
|
||||
resolver: lts-18.26
|
||||
1
stack.yaml
Symbolic link
1
stack.yaml
Symbolic link
@ -0,0 +1 @@
|
||||
stack-lts24.yaml
|
||||
@ -1,12 +1,12 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
# https://docs.haskellstack.org/en/stable/topics/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 590102
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/26.yaml
|
||||
sha256: e76d109964d9335abb412e22139c5bce3078be290ac6d90b8ecea6cc009bb198
|
||||
original: lts-18.26
|
||||
sha256: d90eb1418667a225998b173817300e5ae2e1500ed03c0a9457cc2a0e78a0122a
|
||||
size: 726337
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/26.yaml
|
||||
original: lts-24.26
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module URI.ByteString.ExtensionSpec
|
||||
( spec
|
||||
) where
|
||||
@ -61,9 +62,8 @@ spec = do
|
||||
uriWithQuery `shouldBe` [uri|http://example.com?foo=bar|]
|
||||
|
||||
it "handles a URI with an existing query" $ do
|
||||
let
|
||||
uriWithQuery =
|
||||
[uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")]
|
||||
let uriWithQuery =
|
||||
[uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")]
|
||||
|
||||
uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|]
|
||||
|
||||
@ -71,9 +71,8 @@ spec = do
|
||||
-- it's worthwhile to show that you don't (and can't) pre-sanitize when
|
||||
-- using this function.
|
||||
it "handles santization of the query" $ do
|
||||
let
|
||||
uriWithQuery =
|
||||
[uri|http://example.com|] `withQuery` [("foo", "bar baz")]
|
||||
let uriWithQuery =
|
||||
[uri|http://example.com|] `withQuery` [("foo", "bar baz")]
|
||||
|
||||
toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz"
|
||||
|
||||
|
||||
@ -1,13 +1,13 @@
|
||||
cabal-version: 1.18
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.35.1.
|
||||
-- This file has been generated from package.yaml by hpack version 0.38.1.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 459969143a3074aa93f897f0a1b95c6c7a4b41f87e1f5167e9998f9ab53fdbff
|
||||
-- hash: d595b9569ed34feddc8c41cf6f1f8cabbd8a37fa14b6afeeb24ad651ca689011
|
||||
|
||||
name: yesod-auth-oauth2
|
||||
version: 0.7.1.0
|
||||
version: 0.8.0.0
|
||||
synopsis: OAuth 2.0 authentication plugins
|
||||
description: Library to authenticate with OAuth 2.0 for Yesod web applications.
|
||||
category: Web
|
||||
@ -54,6 +54,7 @@ library
|
||||
Yesod.Auth.OAuth2.GitLab
|
||||
Yesod.Auth.OAuth2.Google
|
||||
Yesod.Auth.OAuth2.Nylas
|
||||
Yesod.Auth.OAuth2.ORCID
|
||||
Yesod.Auth.OAuth2.Prelude
|
||||
Yesod.Auth.OAuth2.Random
|
||||
Yesod.Auth.OAuth2.Salesforce
|
||||
@ -71,9 +72,9 @@ library
|
||||
aeson >=0.6
|
||||
, base >=4.9.0.0 && <5
|
||||
, bytestring >=0.9.1.4
|
||||
, cryptonite >=0.25
|
||||
, crypton
|
||||
, errors
|
||||
, hoauth2 >=1.11.0
|
||||
, hoauth2 >=2.8.0
|
||||
, http-client >=0.4.0
|
||||
, http-conduit >=2.0
|
||||
, http-types >=0.8
|
||||
|
||||
Loading…
Reference in New Issue
Block a user