mirror of
https://github.com/freckle/yesod-auth-oauth2.git
synced 2026-01-11 19:58:28 +01:00
Compare commits
322 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 | ||
|
|
3a333df1ce | ||
|
|
fb1b506606 | ||
|
|
1e68d6b02c | ||
|
|
ac1e48db97 | ||
|
|
8b46e82981 | ||
|
|
15a75ff6f9 | ||
|
|
d34ed2d4b9 | ||
|
|
714467b4d1 | ||
|
|
514a59e00b | ||
|
|
33aa6f4c7b | ||
|
|
8eeca895be | ||
|
|
d34efc18ca | ||
|
|
e3730ab99c | ||
|
|
3c15ecd871 | ||
|
|
36805f0580 | ||
|
|
ab73e2fe20 | ||
|
|
6e2ad16663 | ||
|
|
d49329d6b9 | ||
|
|
e7fa28cefa | ||
|
|
dd4903242a | ||
|
|
1842441647 | ||
|
|
fa25c8ad56 | ||
|
|
d256b221c3 | ||
|
|
fc49d8aea6 | ||
|
|
46606c12a0 | ||
|
|
e725cecf45 | ||
|
|
bd5df8e8a5 | ||
|
|
e7a9149210 | ||
|
|
e334033e44 | ||
|
|
219b5a939f | ||
|
|
77a66fa6e8 | ||
|
|
01ae7319f5 | ||
|
|
f5263b01dd | ||
|
|
1a59cfd010 | ||
|
|
91840cb329 | ||
|
|
4e6665b072 | ||
|
|
206ab951f2 | ||
|
|
8976e193e9 | ||
|
|
9ff675bb32 | ||
|
|
8e434df38a | ||
|
|
b7063dc230 | ||
|
|
342dac80e4 | ||
|
|
c0dbe8366e | ||
|
|
4bc54619e9 | ||
|
|
cc136ec4cd | ||
|
|
10215d4c14 | ||
|
|
3026e1e70d | ||
|
|
f892fa472d | ||
|
|
7ec5c15e94 | ||
|
|
192c7c9b4a | ||
|
|
e71027270f | ||
|
|
a57718e9b8 | ||
|
|
b002c74da2 | ||
|
|
3bd05fa714 | ||
|
|
9f0fad7c5b | ||
|
|
d8011561b8 | ||
|
|
e4c2ea72d2 | ||
|
|
709805e8ee | ||
|
|
c4d6a5d28d | ||
|
|
c3337b39ab | ||
|
|
e0bcb43207 | ||
|
|
62dff1dd18 | ||
|
|
9dafb18923 | ||
|
|
80552b399c | ||
|
|
0f09dd1d05 | ||
|
|
65694e10d7 | ||
|
|
b71ae8f60d | ||
|
|
ab17f214eb | ||
|
|
16aad54338 | ||
|
|
0ab9dc507f | ||
|
|
62550b4ff3 | ||
|
|
6f05c042b2 | ||
|
|
cdb8432248 | ||
|
|
ffd7f85587 | ||
|
|
766cb40d41 | ||
|
|
cfcd8c5210 | ||
|
|
2f71fc497e | ||
|
|
10867e4819 | ||
|
|
c245341c9f | ||
|
|
a09528a07f | ||
|
|
20ff7feaac | ||
|
|
2b88d736f1 | ||
|
|
7c8d3eac49 | ||
|
|
2bf1bf7f21 | ||
|
|
8b0ad2c222 | ||
|
|
92bd62e051 | ||
|
|
3cf4a3e87b | ||
|
|
bbda0d2f47 | ||
|
|
1f6d08dc8b | ||
|
|
5d78b889b0 | ||
|
|
bfc4c7d469 | ||
|
|
c607417c99 | ||
|
|
537c03796d | ||
|
|
ebc12e49ff | ||
|
|
cbe4aed1c8 | ||
|
|
845d8e654e | ||
|
|
b95eddf84c | ||
|
|
28d2113674 | ||
|
|
2e3529cfdb | ||
|
|
c939633a96 | ||
|
|
236d0f4b10 | ||
|
|
27cad251ab | ||
|
|
3cac6e2c34 | ||
|
|
ce2a31e529 | ||
|
|
46c5faf808 | ||
|
|
cd3875b797 | ||
|
|
e46da4cafb | ||
|
|
60c0f68d5a | ||
|
|
40119bd1f3 | ||
|
|
cc961a0288 | ||
|
|
13b84a8724 | ||
|
|
e483abcbc0 | ||
|
|
a635a51e8c | ||
|
|
0c53b2fcb8 | ||
|
|
e57f90bc2c | ||
|
|
79c2ab3e93 | ||
|
|
b1e31e9623 | ||
|
|
96492707b9 | ||
|
|
1576af3fa5 | ||
|
|
0036d5f4e0 | ||
|
|
b49ccb13aa | ||
|
|
f6b9a28c29 | ||
|
|
036458c7a8 | ||
|
|
b998e03067 | ||
|
|
48277d9b8e | ||
|
|
5528bb9d07 | ||
|
|
8436c8ff27 | ||
|
|
9c6ac9b59d | ||
|
|
6fa9748de8 | ||
|
|
4f1de3eb85 | ||
|
|
208f497a5a | ||
|
|
276407071e | ||
|
|
653e1f4db6 | ||
|
|
2110b29669 | ||
|
|
b775a9c18b | ||
|
|
965d35793d | ||
|
|
c25fea0e6f | ||
|
|
b8befc4811 | ||
|
|
b1caafbe24 | ||
|
|
644f02d027 | ||
|
|
7445bccb8a | ||
|
|
57c767d04e | ||
|
|
77eaa8eb96 | ||
|
|
e20891c072 | ||
|
|
d93594bf97 | ||
|
|
c0a6f11a87 | ||
|
|
569a85429a | ||
|
|
46dfc1232a | ||
|
|
1411bb5858 | ||
|
|
e3c61789ba | ||
|
|
dc033e1331 | ||
|
|
37343fa533 | ||
|
|
92beb4b4b4 | ||
|
|
4fd868e3ae | ||
|
|
f1cf1d82ab | ||
|
|
2f0c6ed4dd | ||
|
|
17cbf543ae | ||
|
|
f46d3bc956 | ||
|
|
a8687be4f0 | ||
|
|
fbbf455678 | ||
|
|
6d0077a534 | ||
|
|
c86fa6de13 | ||
|
|
44c05d7a2d | ||
|
|
d9eeb787d6 | ||
|
|
dacc71f008 | ||
|
|
9142acd1ab | ||
|
|
555b91f953 | ||
|
|
262267dcba | ||
|
|
a83bd6a2d5 | ||
|
|
cd0ea5d855 | ||
|
|
aeaf7f7eac | ||
|
|
408aa7eb02 | ||
|
|
04fad28c20 | ||
|
|
6f55384a29 | ||
|
|
c454dfbd24 | ||
|
|
dabed9cf71 | ||
|
|
d65d0b7386 | ||
|
|
4849477e99 | ||
|
|
573b7b01a3 | ||
|
|
e7b270110c | ||
|
|
4817021631 | ||
|
|
9c8dd98b3d | ||
|
|
98ef5f9aae | ||
|
|
59c6aec74b | ||
|
|
66b9b6410e | ||
|
|
b8a6336e55 | ||
|
|
dddfbd9f3c | ||
|
|
aa9736b80e | ||
|
|
07c757aaa5 | ||
|
|
d931243bd1 | ||
|
|
53d57b988b | ||
|
|
164974525e | ||
|
|
8cf5fd1761 | ||
|
|
f595aed116 | ||
|
|
4b64eb168b | ||
|
|
62eeaa8af1 | ||
|
|
ada3fba748 | ||
|
|
dd73fed361 | ||
|
|
a91f85ff38 | ||
|
|
34d4d76220 | ||
|
|
5096ca04aa | ||
|
|
a7bc7c51e3 | ||
|
|
72c64102b0 | ||
|
|
434263fef3 | ||
|
|
7fe409baa8 | ||
|
|
ef38c5c49d | ||
|
|
93258d4468 | ||
|
|
a2a49a2c57 | ||
|
|
fccd7a1d66 | ||
|
|
41eda086a1 | ||
|
|
794fbbf7e8 | ||
|
|
32740037e3 | ||
|
|
c586c72df7 | ||
|
|
6b3c6af895 | ||
|
|
e8dc2ec0ec | ||
|
|
09e7c4c786 | ||
|
|
8cc250523b | ||
|
|
79cd0161d3 | ||
|
|
38c2362a98 | ||
|
|
0dd6d6bc3e | ||
|
|
98b9f1108d | ||
|
|
391ef62813 | ||
|
|
734c9f464a | ||
|
|
3d4ff8da39 | ||
|
|
49542cbca1 | ||
|
|
82585f9b32 | ||
|
|
257a25e901 | ||
|
|
79be858f44 | ||
|
|
8283d21997 | ||
|
|
5d59c4e385 | ||
|
|
1c7b377b72 | ||
|
|
3d6c07221c | ||
|
|
041a9a318b | ||
|
|
606c3d834b | ||
|
|
e8f413ebab | ||
|
|
52c726b598 | ||
|
|
8efe95773b | ||
|
|
ed58922727 | ||
|
|
400111f9a0 | ||
|
|
c93b4081b8 | ||
|
|
79ef8aded9 | ||
|
|
30851ae5fb | ||
|
|
b25ddab6f6 | ||
|
|
9e0a27feab | ||
|
|
1c24a6a1e5 | ||
|
|
c36089b0a1 | ||
|
|
1d36cb346e | ||
|
|
34ae029705 | ||
|
|
7ef60e6089 | ||
|
|
6f6dbcc74d | ||
|
|
097fb17ee9 | ||
|
|
1c42edce7e | ||
|
|
afbc113cd8 | ||
|
|
7c228694ce | ||
|
|
174952fd4f | ||
|
|
bf05c8a13c | ||
|
|
e9b7f78f78 | ||
|
|
937ad572a3 | ||
|
|
aeeddcf1c2 | ||
|
|
20dcb234dc | ||
|
|
25e63cdcc2 | ||
|
|
dc70ce8048 | ||
|
|
de589f8cb6 | ||
|
|
e756d88e1b | ||
|
|
a942f40eb5 | ||
|
|
c416ab90d2 | ||
|
|
bed6d04384 | ||
|
|
d9ce2d334c | ||
|
|
ae7b625c0b | ||
|
|
1dcbb2dbc1 | ||
|
|
210264f3e2 | ||
|
|
e3b94912f1 | ||
|
|
491fc566ef | ||
|
|
327a85fd95 | ||
|
|
c514df2c39 | ||
|
|
535a4a75d7 | ||
|
|
aad8bd88ea | ||
|
|
e6888e210e | ||
|
|
64b65ca4c6 |
61
.env.example
Normal file
61
.env.example
Normal file
@ -0,0 +1,61 @@
|
||||
# shellcheck disable=SC2034
|
||||
#
|
||||
# Copy this file to .env and update the credentials for the providers you are
|
||||
# trying to test. These variables must all have non-empty values for the
|
||||
# application to boot, but you only need to set real values for those Providers
|
||||
# you plan to try.
|
||||
#
|
||||
###
|
||||
|
||||
AUTH0_HOST=x
|
||||
AUTH0_CLIENT_ID=x
|
||||
AUTH0_CLIENT_SECRET=x
|
||||
|
||||
AZURE_AD_CLIENT_ID=x
|
||||
AZURE_AD_CLIENT_SECRET=x
|
||||
|
||||
AZURE_ADV2_TENANT_ID=x
|
||||
AZURE_ADV2_CLIENT_ID=x
|
||||
AZURE_ADV2_CLIENT_SECRET=x
|
||||
|
||||
BATTLE_NET_CLIENT_ID=x
|
||||
BATTLE_NET_CLIENT_SECRET=x
|
||||
|
||||
BITBUCKET_CLIENT_ID=x
|
||||
BITBUCKET_CLIENT_SECRET=x
|
||||
|
||||
CLASSLINK_CLIENT_ID=x
|
||||
CLASSLINK_CLIENT_SECRET=x
|
||||
|
||||
EVE_ONLINE_CLIENT_ID=x
|
||||
EVE_ONLINE_CLIENT_SECRET=x
|
||||
|
||||
GITHUB_CLIENT_ID=x
|
||||
GITHUB_CLIENT_SECRET=x
|
||||
|
||||
GITLAB_CLIENT_ID=x
|
||||
GITLAB_CLIENT_SECRET=x
|
||||
|
||||
GOOGLE_CLIENT_ID=x
|
||||
GOOGLE_CLIENT_SECRET=x
|
||||
|
||||
NYLAS_CLIENT_ID=x
|
||||
NYLAS_CLIENT_SECRET=x
|
||||
|
||||
SALES_FORCE_CLIENT_ID=x
|
||||
SALES_FORCE_CLIENT_SECRET=x
|
||||
|
||||
SLACK_CLIENT_ID=x
|
||||
SLACK_CLIENT_SECRET=x
|
||||
|
||||
SPOTIFY_CLIENT_ID=x
|
||||
SPOTIFY_CLIENT_SECRET=x
|
||||
|
||||
TWITCH_CLIENT_ID=x
|
||||
TWITCH_CLIENT_SECRET=x
|
||||
|
||||
UPCASE_CLIENT_ID=x
|
||||
UPCASE_CLIENT_SECRET=x
|
||||
|
||||
WORDPRESS_DOT_COM_CLIENT_ID=x
|
||||
WORDPRESS_DOT_COM_CLIENT_SECRET=x
|
||||
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 }}"
|
||||
49
.github/workflows/ci.yml
vendored
Normal file
49
.github/workflows/ci.yml
vendored
Normal file
@ -0,0 +1,49 @@
|
||||
name: CI
|
||||
|
||||
on:
|
||||
pull_request:
|
||||
push:
|
||||
branches: main
|
||||
|
||||
concurrency:
|
||||
group: ${{ github.workflow }}-${{ github.ref }}
|
||||
cancel-in-progress: true
|
||||
|
||||
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: ${{ fromJSON(needs.generate.outputs.stack-yamls) }}
|
||||
fail-fast: false
|
||||
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v5
|
||||
- uses: freckle/stack-action@v5
|
||||
with:
|
||||
stack-build-arguments: --flag yesod-auth-oauth2:example
|
||||
env:
|
||||
STACK_YAML: ${{ matrix.stack-yaml }}
|
||||
|
||||
lint:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v5
|
||||
- uses: haskell-actions/hlint-setup@v2
|
||||
- uses: haskell-actions/hlint-run@v2
|
||||
with:
|
||||
fail-on: warning
|
||||
22
.github/workflows/release.yml
vendored
Normal file
22
.github/workflows/release.yml
vendored
Normal file
@ -0,0 +1,22 @@
|
||||
name: Release
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: main
|
||||
|
||||
jobs:
|
||||
release:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v5
|
||||
|
||||
- id: tag
|
||||
uses: freckle/haskell-tag-action@v1
|
||||
|
||||
- if: steps.tag.outputs.tag
|
||||
run: stack upload --pvp-bounds lower .
|
||||
env:
|
||||
HACKAGE_KEY: ${{ secrets.HACKAGE_UPLOAD_API_KEY }}
|
||||
|
||||
# Use minimum LTS to set lowest lower bounds
|
||||
STACK_YAML: stack-lts21.yaml
|
||||
18
.gitignore
vendored
18
.gitignore
vendored
@ -1,8 +1,12 @@
|
||||
*.swp
|
||||
.cabal-sandbox
|
||||
.env*
|
||||
.stack-work
|
||||
cabal-dev/
|
||||
cabal.sandbox.config
|
||||
dist/
|
||||
tags
|
||||
TAGS
|
||||
|
||||
# OAuth keys configuration for the example
|
||||
.env*
|
||||
!.env.example
|
||||
|
||||
# Created when running the example
|
||||
client_session_key.aes
|
||||
|
||||
# Used by stack test --rerun
|
||||
TESTREPORT
|
||||
|
||||
8
.hlint.yaml
Normal file
8
.hlint.yaml
Normal file
@ -0,0 +1,8 @@
|
||||
---
|
||||
- ignore:
|
||||
# https://github.com/ndmitchell/hlint/issues/427
|
||||
name: Eta reduce
|
||||
within: authOAuth2
|
||||
- ignore:
|
||||
name: Redundant do
|
||||
within: spec
|
||||
4
.restyled.yaml
Normal file
4
.restyled.yaml
Normal file
@ -0,0 +1,4 @@
|
||||
restylers:
|
||||
- fourmolu
|
||||
- "!stylish-haskell"
|
||||
- "*"
|
||||
2
.stack-all
Normal file
2
.stack-all
Normal file
@ -0,0 +1,2 @@
|
||||
[versions]
|
||||
oldest = lts-21
|
||||
352
CHANGELOG.md
Normal file
352
CHANGELOG.md
Normal file
@ -0,0 +1,352 @@
|
||||
## [_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)
|
||||
|
||||
- Add `AzureADv2` provider
|
||||
|
||||
## [v0.7.0.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.0.2...v0.7.0.3)
|
||||
|
||||
- Support `hoauth-2.7`. This change is only breaking in the unlikely case of users
|
||||
using something other than `fetchAccessToken` or `fetchAccessToken2`
|
||||
|
||||
## [v0.7.0.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.0.1...v0.7.0.2)
|
||||
|
||||
- Add Auth0 provider ([@hw202207](https://github.com/freckle/yesod-auth-oauth2/pull/162))
|
||||
|
||||
## [v0.7.0.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.7.0.0...v0.7.0.1)
|
||||
|
||||
- Support `hoauth-2.2` and `2.3`
|
||||
|
||||
## [v0.7.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.3.4...v0.7.0.0)
|
||||
|
||||
- Support `hoauth2-2.0`
|
||||
|
||||
The `OAuth2` type's fields have changed. If you are not defining your own
|
||||
Local Providers (i.e. you're not constructing any `OAuth2` values) you should
|
||||
not be affected by this change. If you are, you should update to the [new
|
||||
field names][oauth2].
|
||||
|
||||
[oauth2]: https://hackage.haskell.org/package/hoauth2-2.0.0/docs/Network-OAuth-OAuth2-Internal.html#t:OAuth2
|
||||
|
||||
## [v0.6.3.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.3.1...v0.6.3.4)
|
||||
|
||||
- Remove dependencies upper bounds
|
||||
|
||||
## [v0.6.3.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.3.0...v0.6.3.1)
|
||||
|
||||
- Relax dependencies bounds
|
||||
|
||||
## [v0.6.3.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.2.3...v0.6.3.0)
|
||||
|
||||
- Expose `onDispatchError` and generic `OtherDispatchError` for passthrough log
|
||||
- Don't throw exceptions; handle all errors through the set-message-redirect
|
||||
path
|
||||
- Respect `onErrorHtml` for said error-handling
|
||||
- Support custom widget in Google plugin
|
||||
[@jmorag](https://github.com/freckle/yesod-auth-oauth2/pull/149)
|
||||
|
||||
## [v0.6.2.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.2.2...v0.6.2.3)
|
||||
|
||||
- Allow bytestring-0.11 and cryptonite 0.28
|
||||
- Test with GHC 8.10 on CI
|
||||
|
||||
## [v0.6.2.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.2.1...v0.6.2.2)
|
||||
|
||||
- Consistent dependencies bounds in all targets
|
||||
|
||||
## [v0.6.2.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.2.0...v0.6.2.1)
|
||||
|
||||
- Adjust lower bounds on cryptonite
|
||||
|
||||
## [v0.6.2.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.7...v0.6.2.0)
|
||||
|
||||
- Filter `+` from `state` tokens
|
||||
|
||||
This decreases entropy in the token slightly, but ensures that providers
|
||||
performing unexpected +/space/%20 encoding (e.g. ClassLink) still function.
|
||||
|
||||
See [#140](https://github.com/thoughtbot/yesod-auth-oauth2/pull/140).
|
||||
|
||||
- Add ClassLink provider
|
||||
|
||||
## [v0.6.1.7](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.6...v0.6.1.7)
|
||||
|
||||
- Relax upper bounds on `hoauth2` and `http-client`
|
||||
|
||||
## [v0.6.1.6](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.5...v0.6.1.6)
|
||||
|
||||
- Revert back to Authorization-header-only `fetchAccessToken` function
|
||||
- Add `authOAuth2'` and `authOAuth2Widget'`, which use `fetchAccessToken2`
|
||||
|
||||
## [v0.6.1.5](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.4...v0.6.1.5)
|
||||
|
||||
- Update to GHC-8.8, and hoauth2-1.14
|
||||
- Drop CI-backed support for GHC-8.4
|
||||
|
||||
## [v0.6.1.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.3...v0.6.1.4)
|
||||
|
||||
- Tighten upper bound on hoauth2
|
||||
|
||||
## [v0.6.1.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.2...v0.6.1.3)
|
||||
|
||||
- Replace `System.Random` state token generation with `cryptonite`
|
||||
- Allow aeson-1.5 and hoauth2-1.14
|
||||
- Add WordPress.com provider
|
||||
[@nbloomf](https://github.com/thoughtbot/yesod-auth-oauth2/pull/130)
|
||||
|
||||
## [v0.6.1.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.1...v0.6.1.2)
|
||||
|
||||
- Don't report our own errors like OAuth2 ErrorResponses
|
||||
|
||||
## [v0.6.1.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.1.0...v0.6.1.1)
|
||||
|
||||
- Added AzureAD provider
|
||||
- COMPATIBILITY: Use `hoauth2-1.8.1`
|
||||
- COMPATIBILITY: Test with GHC 8.6.3, and not 8.2
|
||||
|
||||
## [v0.6.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.6.0.0...v0.6.1.0)
|
||||
|
||||
- Allow http-client-0.6
|
||||
|
||||
## [v0.6.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.3.0...v0.6.0.0)
|
||||
|
||||
- Remove deprecated Github module
|
||||
|
||||
## [v0.5.3.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.2.0...v0.5.3.0)
|
||||
|
||||
- Allow aeson-1.4 and hoauth2-1.8
|
||||
|
||||
## [v0.5.2.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.1.0...v0.5.2.0)
|
||||
|
||||
- `InvalidProfileResponse` was replaced with different, situation-specific
|
||||
constructors; the exception type is considered internal API, but end-users may
|
||||
see them in logs, or if they (unexpectedly) escape our error-handling
|
||||
- Errors during log-in no longer result in 4XX or 5XX responses; they now
|
||||
redirect to `LoginR` with the exception details logged and something
|
||||
user-appropriate displayed via `setMessage`
|
||||
|
||||
## [v0.5.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.5.0.0...v0.5.1.0)
|
||||
|
||||
- Added GitLab provider
|
||||
- Added properly-named `GitHub` module, deprecated `Github`
|
||||
- Store `refreshToken` in `credsExtra`
|
||||
|
||||
## [v0.5.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.4.1.0...v0.5.0.0)
|
||||
|
||||
- COMPATIBILITY: Allow and require yesod-1.6
|
||||
- COMPATIBILITY: Stop testing GHC 8.0 on CI
|
||||
|
||||
## [v0.4.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.4.0.1...v0.4.1.0)
|
||||
|
||||
- Check for `error`s in callback query params, as described in the
|
||||
[spec](https://tools.ietf.org/html/rfc6749#section-4.1.2.1)
|
||||
|
||||
## [v0.4.0.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.4.0.0...v0.4.0.1)
|
||||
|
||||
- COMPATIBILITY: Allow `http-types-0.12`
|
||||
|
||||
## [v0.4.0.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.3.1...v0.4.0.0)
|
||||
|
||||
- COMPATIBILITY: Allow `aeson-1.3`
|
||||
- COMPATIBILITY: Dropped a lot of information from `credsExtra`:
|
||||
|
||||
**TL;DR**: you'll no longer find things like `username` or `email` as keys in
|
||||
the `credsExtra` map. Instead, you'll find the encoded profile response we
|
||||
received and the OAuth access token. You can/should do your own decoding or
|
||||
make your own follow-up requests to get extra data about your users.
|
||||
|
||||
This reduced a lot of complexity, likely duplication between our decoding and
|
||||
yours, and (I think) makes the library easier to use.
|
||||
|
||||
- [Issue](https://github.com/thoughtbot/yesod-auth-oauth2/issues/71)
|
||||
- [PR](https://github.com/thoughtbot/yesod-auth-oauth2/pull/100)
|
||||
|
||||
- COMPATIBILITY: Support GHC-8.2
|
||||
- COMPATIBILITY: Drop (claimed, but never tested) support for GHC-7.8 & 7.10
|
||||
- LICENSE: fixed vague licensing (MIT now)
|
||||
|
||||
## [v0.3.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.3.0...v0.3.1)
|
||||
|
||||
- Internal project cleanup
|
||||
|
||||
## [v0.3.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.2.4...v0.3.0)
|
||||
|
||||
- COMPATIBILITY: Use `hoauth2-1.3`
|
||||
|
||||
## [v0.2.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.2.1...v0.2.4)
|
||||
|
||||
- FIX: Update Nylas provider
|
||||
- NEW: Battle.Net provider
|
||||
- NEW: Bitbucket provider
|
||||
- NEW: Salesforce provider
|
||||
|
||||
## [v0.2.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.2.0...v0.2.1)
|
||||
|
||||
- FIX: Fix collision in GitHub `email` / `public_email` extras value
|
||||
|
||||
## [v0.2.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.10...v0.2.0)
|
||||
|
||||
- NEW: Slack provider
|
||||
([@jsteiner](https://github.com/thoughtbot/yesod-auth-oauth2/commit/aad8bd88eabf9fcf368d044e7003e5d323985837))
|
||||
|
||||
## [v0.1.10](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.9...v0.1.10)
|
||||
|
||||
- FIX: `location` is optional in GitHub response
|
||||
|
||||
## [v0.1.9](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.8...v0.1.9)
|
||||
|
||||
- COMPATIBILITY: Allow `transformers-0.5`
|
||||
([@paul-rouse](https://github.com/thoughtbot/yesod-auth-oauth2/commit/120104b5348808f72877962c329a998434addace))
|
||||
|
||||
## [v0.1.8](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.7...v0.1.8)
|
||||
|
||||
- COMPATIBILITY: Allow `aeson-0.11`
|
||||
([@k-bx](https://github.com/thoughtbot/yesod-auth-oauth2/commit/6e940b19e2d56080c7a749aeb29e143a17dad65c))
|
||||
|
||||
## [v0.1.7](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.6...v0.1.7)
|
||||
|
||||
- NEW: Prefer primary email in GitHub provider
|
||||
- NEW: Include `public_email` in GitHub extras response
|
||||
- REMOVED: Remove Twitter provider
|
||||
|
||||
## [v0.1.6](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.5...v0.1.6)
|
||||
|
||||
- NEW: Nicer error message on invalid `code`
|
||||
([@silky](https://github.com/thoughtbot/yesod-auth-oauth2/commit/7354c36e1326d298e543fa65cf226153ed4a8a0b))
|
||||
|
||||
## [v0.1.5](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.4...v0.1.5)
|
||||
|
||||
- FIX: Incorrect `state` parameter handling
|
||||
|
||||
## [v0.1.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.3...v0.1.4)
|
||||
|
||||
- FIX: Use newer Nylas endpoint
|
||||
|
||||
## [v0.1.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.2...v0.1.3)
|
||||
|
||||
- NEW: EveOnline provider
|
||||
([@Drezil](https://github.com/thoughtbot/yesod-auth-oauth2/pull/33))
|
||||
- NEW: Nylas provider
|
||||
([@bts](https://github.com/thoughtbot/yesod-auth-oauth2/commit/815d44346403af0052a48aa844f506211bdc2863))
|
||||
|
||||
## [v0.1.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.1...v0.1.2)
|
||||
|
||||
- NEW: A more different Google provider
|
||||
([@ssaavedra](https://github.com/thoughtbot/yesod-auth-oauth2/pull/32))
|
||||
|
||||
## [v0.1.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.1.0...v0.1.1)
|
||||
|
||||
- NEW: Twitter provider
|
||||
|
||||
## [v0.1.0](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.12...v0.1.0)
|
||||
|
||||
- REMOVED: Google provider, use `Yesod.Auth.GoogleEmail2`
|
||||
- CHANGED: Learn was renamed to Upcase
|
||||
- COMPATIBILITY: Drop support for GHC-6
|
||||
- COMPATIBILITY: Support GHC-7.10
|
||||
|
||||
## [v0.0.12](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.11...v0.0.12)
|
||||
|
||||
- COMPATIBILITY: Allow `transformers-0.4`
|
||||
([@snoyberg](https://github.com/thoughtbot/yesod-auth-oauth2/pull/21))
|
||||
|
||||
## [v0.0.11](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.10...v0.0.11)
|
||||
|
||||
- COMPATIBILITY: Allow `aeson-0.8`
|
||||
([@gfontenot](https://github.com/thoughtbot/yesod-auth-oauth2/pull/15))
|
||||
|
||||
## [v0.0.10](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.9...v0.0.10)
|
||||
|
||||
- COMPATIBILITY: Allow Yesod 1.4
|
||||
([@gregwebs](https://github.com/thoughtbot/yesod-auth-oauth2/pull/14))
|
||||
|
||||
## [v0.0.9](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.8...v0.0.9)
|
||||
|
||||
- NEW: Spotify
|
||||
([@benekastah](https://github.com/thoughtbot/yesod-auth-oauth2/pull/13))
|
||||
|
||||
## [v0.0.8](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.7...v0.0.8)
|
||||
|
||||
- FIX: Username may be missing in GitHub responses
|
||||
([@skade](https://github.com/thoughtbot/yesod-auth-oauth2/pull/12))
|
||||
|
||||
## [v0.0.7](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.6...v0.0.7)
|
||||
|
||||
- NEW: Scope support in GitHub provider
|
||||
([@skade](https://github.com/thoughtbot/yesod-auth-oauth2/pull/11))
|
||||
|
||||
## [v0.0.6](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.5.1...v0.0.6)
|
||||
|
||||
- NEW: GitHub provider
|
||||
([@freiric](https://github.com/thoughtbot/yesod-auth-oauth2/pull/10))
|
||||
- COMPATIBILITY: flag-driven `network`/`network-uri` dependency
|
||||
|
||||
## [v0.0.5.1](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.5...v0.0.5.1)
|
||||
|
||||
- DOCUMENTATION: fix data declaration, allows Haddocks to build
|
||||
|
||||
## [v0.0.5](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.4...v0.0.5)
|
||||
|
||||
- COMPATIBILITY: Allow `yesod-core-1.3` and target `yesod-auth-1.3`
|
||||
([@maxcan](https://github.com/thoughtbot/yesod-auth-oauth2/pull/7))
|
||||
- COMPATIBILITY: Target `haouth2-0.4`
|
||||
([@katyo](https://github.com/thoughtbot/yesod-auth-oauth2/pull/9))
|
||||
|
||||
## [v0.0.4](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.3...v0.0.4)
|
||||
|
||||
- COMPATIBILITY: Allow `text-1.*`
|
||||
- COMPATIBILITY: Allow `lifted-base-0.2.*`
|
||||
|
||||
## [v0.0.3](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.2...v0.0.3)
|
||||
|
||||
- FIX: replace `error` crash with `throwIO` exception
|
||||
|
||||
## [v0.0.2](https://github.com/thoughtbot/yesod-auth-oauth2/compare/v0.0.1...v0.0.2)
|
||||
|
||||
- Various documentation fixes.
|
||||
|
||||
## [v0.0.1](https://github.com/thoughtbot/yesod-auth-oauth2/tree/v0.0.1)
|
||||
|
||||
Initial version. Maintainer-ship taken over by
|
||||
[@pbrisbin](https://github.com/thoughtbot/yesod-auth-oauth2/pull/1).
|
||||
38
LICENSE
38
LICENSE
@ -1,25 +1,21 @@
|
||||
The following license covers this documentation, and the source code, except
|
||||
where otherwise indicated.
|
||||
The MIT License (MIT)
|
||||
|
||||
Copyright 2008, Michael Snoyman. All rights reserved.
|
||||
Copyright (c) 2021 Renaissance Learning Inc
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
|
||||
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
|
||||
EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
|
||||
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
|
||||
OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
|
||||
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
|
||||
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
|
||||
60
Makefile
Normal file
60
Makefile
Normal file
@ -0,0 +1,60 @@
|
||||
all: setup setup.lint dependencies build test lint
|
||||
|
||||
.PHONY: setup
|
||||
setup:
|
||||
stack setup
|
||||
|
||||
.PHONY: setup.lint
|
||||
setup.lint:
|
||||
stack install --copy-compiler-tool hlint
|
||||
|
||||
.PHONY: setup.tools
|
||||
setup.tools:
|
||||
stack install --copy-compiler-tool brittany stylish-haskell fast-tags
|
||||
|
||||
.PHONY: dependencies
|
||||
dependencies:
|
||||
stack build \
|
||||
--flag yesod-auth-oauth2:example \
|
||||
--dependencies-only --test --no-run-tests
|
||||
|
||||
.PHONY: build
|
||||
build:
|
||||
stack build \
|
||||
--flag yesod-auth-oauth2:example \
|
||||
--fast --pedantic --test --no-run-tests
|
||||
|
||||
.PHONY: test
|
||||
test:
|
||||
stack build \
|
||||
--flag yesod-auth-oauth2:example \
|
||||
--fast --pedantic --test
|
||||
|
||||
.PHONY: watch
|
||||
watch:
|
||||
stack build \
|
||||
--flag yesod-auth-oauth2:example \
|
||||
--fast --pedantic --test --file-watch
|
||||
|
||||
|
||||
.PHONY: lint
|
||||
lint:
|
||||
stack exec hlint src test
|
||||
|
||||
.PHONY: nightly
|
||||
nightly:
|
||||
stack setup --resolver nightly
|
||||
stack build --resolver nightly \
|
||||
--test --no-run-tests --bench --no-run-benchmarks \
|
||||
--dependencies-only
|
||||
stack build --resolver nightly \
|
||||
--test --no-run-tests --bench --no-run-benchmarks \
|
||||
--fast --pedantic
|
||||
|
||||
.PHONY: example
|
||||
example: build
|
||||
stack exec yesod-auth-oauth2-example
|
||||
|
||||
.PHONY: clean
|
||||
clean:
|
||||
stack clean
|
||||
155
README.md
155
README.md
@ -1,19 +1,22 @@
|
||||
# Yesod.Auth.OAuth2
|
||||
|
||||
[](https://hackage.haskell.org/package/yesod-auth-oauth2)
|
||||
[](http://stackage.org/nightly/package/yesod-auth-oauth2)
|
||||
[](http://stackage.org/lts/package/yesod-auth-oauth2)
|
||||
[](https://github.com/pbrisbin/freckle/yesod-auth-oauth2/workflows/ci.yml)
|
||||
|
||||
OAuth2 `AuthPlugin`s for Yesod.
|
||||
|
||||
## Basic Usage
|
||||
## Usage
|
||||
|
||||
To use one of the supported providers:
|
||||
|
||||
```haskell
|
||||
```hs
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2.Github
|
||||
import Yesod.Auth.OAuth2.GitHub
|
||||
|
||||
instance YesodAuth App where
|
||||
-- ...
|
||||
|
||||
authPlugins _ = [oauth2Github clientId clientSecret]
|
||||
authPlugins _ = [oauth2GitHub clientId clientSecret]
|
||||
|
||||
clientId :: Text
|
||||
clientId = "..."
|
||||
@ -22,34 +25,118 @@ clientSecret :: Text
|
||||
clientSecret = "..."
|
||||
```
|
||||
|
||||
## Advanced Usage
|
||||
Some plugins, such as GitHub and Slack, have scoped functions for requesting
|
||||
additional information:
|
||||
|
||||
To use any other provider:
|
||||
|
||||
```haskell
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
|
||||
instance YesodAuth App where
|
||||
-- ...
|
||||
|
||||
authPlugins _ = [myPlugin]
|
||||
|
||||
myPlugin :: AuthPlugin m
|
||||
myPlugin = authOAuth2 "mysite"
|
||||
(OAuth2
|
||||
{ oauthClientId = "..."
|
||||
, oauthClientSecret = "..."
|
||||
, oauthOAuthorizeEndpoint = "https://mysite.com/oauth/authorize"
|
||||
, oauthAccessTokenEndpoint = "https://mysite.com/oauth/token"
|
||||
, oauthCallback = Nothing
|
||||
})
|
||||
makeCredentials
|
||||
|
||||
makeCredentials :: Manager -> AccessToken -> IO (Creds m)
|
||||
makeCredentials manager token = do
|
||||
result <- authGetJSON manager token "https://mysite.com/api/me.json"
|
||||
return $ -- Parse the JSON into (Creds m)
|
||||
```hs
|
||||
oauth2SlackScoped [SlackBasicScope, SlackEmailScope] clientId clientSecret
|
||||
```
|
||||
|
||||
*If you write one of these, please consider opening a Pull Request*
|
||||
## Working with Extra Data
|
||||
|
||||
We put the minimal amount of user data possible in `credsExtra` -- just enough
|
||||
to support you parsing or fetching additional data yourself.
|
||||
|
||||
For example, if you work with GitHub and GitHub user profiles, you likely
|
||||
already have a model and a way to parse the `/user` response. Rather than
|
||||
duplicate all that in our library, we try to make it easy for you to re-use that
|
||||
code yourself:
|
||||
|
||||
```hs
|
||||
authenticate creds = do
|
||||
let
|
||||
-- You can run your own FromJSON parser on the response we already have
|
||||
eGitHubUser :: Either String GitHubUser
|
||||
eGitHubUser = getUserResponseJSON creds
|
||||
|
||||
-- Avert your eyes, simplified example
|
||||
Just accessToken = getAccessToken creds
|
||||
Right githubUser = eGitHubUser
|
||||
|
||||
-- Or make followup requests using our access token
|
||||
runGitHub accessToken $ userRepositories githubUser
|
||||
|
||||
-- Or store it for later
|
||||
insert User
|
||||
{ userIdent = credsIdent creds
|
||||
, userAccessToken = accessToken
|
||||
}
|
||||
```
|
||||
|
||||
**NOTE**: Avoid looking up values in `credsExtra` yourself; prefer the provided
|
||||
`get` functions. The data representation itself is no longer considered public
|
||||
API.
|
||||
|
||||
## Local Providers
|
||||
|
||||
If we don't supply a "Provider" (e.g. GitHub, Google, etc) you need, you can
|
||||
write your own using our provided `Prelude`:
|
||||
|
||||
```haskell
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "mysite"
|
||||
|
||||
oauth2MySite :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2MySite clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
-- Fetch a profile using the manager and token, leave it a ByteString
|
||||
userResponse <- -- ...
|
||||
|
||||
-- Parse it to your preferred identifier, e.g. with Data.Aeson
|
||||
userId <- -- ...
|
||||
|
||||
-- See authGetProfile for the typical case
|
||||
|
||||
pure Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 = OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = Just clientSecret
|
||||
, oauth2AuthorizeEndpoint = "https://mysite.com/oauth/authorize"
|
||||
, oauth2TokenEndpoint = "https://mysite.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
```
|
||||
|
||||
The `Prelude` module is considered public API, though we may build something
|
||||
higher-level that is more convenient for this use-case in the future.
|
||||
|
||||
## Development & Tests
|
||||
|
||||
```console
|
||||
stack setup
|
||||
stack build --dependencies-only
|
||||
stack build --pedantic --test
|
||||
```
|
||||
|
||||
Please also run HLint and Weeder before submitting PRs.
|
||||
|
||||
## Example
|
||||
|
||||
This project includes an executable that runs a server with (almost) all
|
||||
supported providers present.
|
||||
|
||||
To use:
|
||||
|
||||
1. `cp .env.example .env` and edit in secrets for providers you wish to test
|
||||
|
||||
Be sure to include `http://localhost:3000/auth/page/{plugin}/callback` as a
|
||||
valid Redirect URI when configuring the OAuth application.
|
||||
|
||||
2. Build with the example: `stack build ... --flag yesod-auth-oauth2:example`
|
||||
3. Run the example `stack exec yesod-auth-oauth2-example`
|
||||
4. Visit the example: `$BROWSER http://localhost:3000`
|
||||
5. Click the log-in link for the provider you configured
|
||||
|
||||
If successful, you will be presented with a page that shows the credential and
|
||||
User response value.
|
||||
|
||||
---
|
||||
|
||||
[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
|
||||
|
||||
@ -1,151 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
-- |
|
||||
--
|
||||
-- Generic OAuth2 plugin for Yesod
|
||||
--
|
||||
-- * See Yesod.Auth.OAuth2.GitHub for example usage.
|
||||
--
|
||||
module Yesod.Auth.OAuth2
|
||||
( authOAuth2
|
||||
, authOAuth2Widget
|
||||
, oauth2Url
|
||||
, fromProfileURL
|
||||
, YesodOAuth2Exception(..)
|
||||
, module Network.OAuth.OAuth2
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
|
||||
import Control.Exception.Lifted
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad (unless)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import Data.Typeable
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Network.OAuth.OAuth2
|
||||
import System.Random
|
||||
import Yesod.Auth
|
||||
import Yesod.Core
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.ByteString.Char8 as C8
|
||||
|
||||
-- | Provider name and Aeson parse error
|
||||
data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance Exception YesodOAuth2Exception
|
||||
|
||||
oauth2Url :: Text -> AuthRoute
|
||||
oauth2Url name = PluginR name ["forward"]
|
||||
|
||||
-- | Create an @'AuthPlugin'@ for the given OAuth2 provider
|
||||
--
|
||||
-- Presents a generic @"Login via name"@ link
|
||||
--
|
||||
authOAuth2 :: YesodAuth m
|
||||
=> Text -- ^ Service name
|
||||
-> OAuth2 -- ^ Service details
|
||||
-> (Manager -> AccessToken -> IO (Creds m))
|
||||
-- ^ This function defines how to take an @'AccessToken'@ and
|
||||
-- retrieve additional information about the user, to be
|
||||
-- set in the session as @'Creds'@. Usually this means a
|
||||
-- second authorized request to @api/me.json@.
|
||||
--
|
||||
-- See @'fromProfileURL'@ for an example.
|
||||
-> AuthPlugin m
|
||||
authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name
|
||||
|
||||
-- | Create an @'AuthPlugin'@ for the given OAuth2 provider
|
||||
--
|
||||
-- Allows passing a custom widget for the login link. See @'oauth2Eve'@ for an
|
||||
-- example.
|
||||
--
|
||||
authOAuth2Widget :: YesodAuth m
|
||||
=> WidgetT m IO ()
|
||||
-> Text
|
||||
-> OAuth2
|
||||
-> (Manager -> AccessToken -> IO (Creds m))
|
||||
-> AuthPlugin m
|
||||
authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login
|
||||
|
||||
where
|
||||
url = PluginR name ["callback"]
|
||||
|
||||
withCallback csrfToken = do
|
||||
tm <- getRouteToParent
|
||||
render <- lift getUrlRender
|
||||
return oauth
|
||||
{ oauthCallback = Just $ encodeUtf8 $ render $ tm url
|
||||
, oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth
|
||||
`appendQuery` "state=" <> encodeUtf8 csrfToken
|
||||
}
|
||||
|
||||
dispatch "GET" ["forward"] = do
|
||||
csrfToken <- liftIO generateToken
|
||||
setSession tokenSessionKey csrfToken
|
||||
authUrl <- bsToText . authorizationUrl <$> withCallback csrfToken
|
||||
lift $ redirect authUrl
|
||||
|
||||
dispatch "GET" ["callback"] = do
|
||||
csrfToken <- requireGetParam "state"
|
||||
oldToken <- lookupSession tokenSessionKey
|
||||
deleteSession tokenSessionKey
|
||||
unless (oldToken == Just csrfToken) $ permissionDenied "Invalid OAuth2 state token"
|
||||
code <- requireGetParam "code"
|
||||
oauth' <- withCallback csrfToken
|
||||
master <- lift getYesod
|
||||
result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code)
|
||||
case result of
|
||||
Left _ -> permissionDenied "Unable to retreive OAuth2 token"
|
||||
Right token -> do
|
||||
creds <- liftIO $ getCreds (authHttpManager master) token
|
||||
lift $ setCredsRedirect creds
|
||||
where
|
||||
requireGetParam key = do
|
||||
m <- lookupGetParam key
|
||||
maybe (permissionDenied $ "'" <> key <> "' parameter not provided") return m
|
||||
|
||||
dispatch _ _ = notFound
|
||||
|
||||
generateToken = pack . take 30 . randomRs ('a', 'z') <$> newStdGen
|
||||
|
||||
tokenSessionKey :: Text
|
||||
tokenSessionKey = "_yesod_oauth2_" <> name
|
||||
|
||||
login tm = [whamlet|<a href=@{tm $ oauth2Url name}>^{widget}|]
|
||||
|
||||
-- | Handle the common case of fetching Profile information from a JSON endpoint
|
||||
--
|
||||
-- Throws @'InvalidProfileResponse'@ if JSON parsing fails
|
||||
--
|
||||
fromProfileURL :: FromJSON a
|
||||
=> Text -- ^ Plugin name
|
||||
-> URI -- ^ Profile URI
|
||||
-> (a -> Creds m) -- ^ Conversion to Creds
|
||||
-> Manager -> AccessToken -> IO (Creds m)
|
||||
fromProfileURL name url toCreds manager token = do
|
||||
result <- authGetJSON manager token url
|
||||
|
||||
case result of
|
||||
Right profile -> return $ toCreds profile
|
||||
Left err -> throwIO $ InvalidProfileResponse name err
|
||||
|
||||
bsToText :: ByteString -> Text
|
||||
bsToText = decodeUtf8With lenientDecode
|
||||
|
||||
appendQuery :: ByteString -> ByteString -> ByteString
|
||||
appendQuery url query =
|
||||
if '?' `C8.elem` url
|
||||
then url <> "&" <> query
|
||||
else url <> "?" <> query
|
||||
@ -1,115 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://eveonline.com
|
||||
--
|
||||
-- * Authenticates against eveonline
|
||||
-- * Uses EVEs unique account-user-char-hash as credentials identifier
|
||||
-- * Returns charName, charId, tokenType, accessToken and expires as extras
|
||||
--
|
||||
module Yesod.Auth.OAuth2.EveOnline
|
||||
( oauth2Eve
|
||||
, oauth2EveScoped
|
||||
, WidgetType(..)
|
||||
, module Yesod.Auth.OAuth2
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
#endif
|
||||
|
||||
import Control.Exception.Lifted
|
||||
import Control.Monad (mzero)
|
||||
import Data.Aeson
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
import Yesod.Core.Widget
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
data WidgetType m
|
||||
= Plain -- ^ Simple "Login via eveonline" text
|
||||
| BigWhite
|
||||
| SmallWhite
|
||||
| BigBlack
|
||||
| SmallBlack
|
||||
| Custom (WidgetT m IO ())
|
||||
|
||||
data EveUser = EveUser
|
||||
{ eveUserName :: Text
|
||||
, eveUserExpire :: Text
|
||||
, eveTokenType :: Text
|
||||
, eveCharOwnerHash :: Text
|
||||
, eveCharId :: Integer
|
||||
}
|
||||
|
||||
instance FromJSON EveUser where
|
||||
parseJSON (Object o) = EveUser
|
||||
<$> o .: "CharacterName"
|
||||
<*> o .: "ExpiresOn"
|
||||
<*> o .: "TokenType"
|
||||
<*> o .: "CharacterOwnerHash"
|
||||
<*> o .: "CharacterID"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
oauth2Eve :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> WidgetType m
|
||||
-> AuthPlugin m
|
||||
oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] . asWidget
|
||||
|
||||
where
|
||||
asWidget :: YesodAuth m => WidgetType m -> WidgetT m IO ()
|
||||
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 (Custom a) = a
|
||||
|
||||
oauth2EveScoped :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> [Text] -- ^ List of scopes to request
|
||||
-> WidgetT m IO () -- ^ Login widget
|
||||
-> AuthPlugin m
|
||||
oauth2EveScoped clientId clientSecret scopes widget =
|
||||
authOAuth2Widget widget "eveonline" oauth fetchEveProfile
|
||||
|
||||
where
|
||||
oauth = OAuth2
|
||||
{ oauthClientId = encodeUtf8 clientId
|
||||
, oauthClientSecret = encodeUtf8 clientSecret
|
||||
, oauthOAuthorizeEndpoint = encodeUtf8 $ "https://login.eveonline.com/oauth/authorize?response_type=code&scope=" <> T.intercalate " " scopes
|
||||
, oauthAccessTokenEndpoint = "https://login.eveonline.com/oauth/token"
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
|
||||
fetchEveProfile :: Manager -> AccessToken -> IO (Creds m)
|
||||
fetchEveProfile manager token = do
|
||||
userResult <- authGetJSON manager token "https://login.eveonline.com/oauth/verify"
|
||||
|
||||
case userResult of
|
||||
Right user -> return $ toCreds user token
|
||||
Left err-> throwIO $ InvalidProfileResponse "eveonline" err
|
||||
|
||||
toCreds :: EveUser -> AccessToken -> Creds m
|
||||
toCreds user token = Creds
|
||||
{ credsPlugin = "eveonline"
|
||||
, credsIdent = T.pack $ show $ eveCharOwnerHash user
|
||||
, credsExtra =
|
||||
[ ("charName", eveUserName user)
|
||||
, ("charId", T.pack . show . eveCharId $ user)
|
||||
, ("tokenType", eveTokenType user)
|
||||
, ("expires", eveUserExpire user)
|
||||
, ("accessToken", decodeUtf8 . accessToken $ token)
|
||||
]
|
||||
}
|
||||
@ -1,121 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://github.com
|
||||
--
|
||||
-- * Authenticates against github
|
||||
-- * Uses github user id as credentials identifier
|
||||
-- * Returns first_name, last_name, and email as extras
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Github
|
||||
( oauth2Github
|
||||
, oauth2GithubScoped
|
||||
, module Yesod.Auth.OAuth2
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
#endif
|
||||
|
||||
import Control.Exception.Lifted
|
||||
import Control.Monad (mzero)
|
||||
import Data.Aeson
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.List (find)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
data GithubUser = GithubUser
|
||||
{ githubUserId :: Int
|
||||
, githubUserName :: Maybe Text
|
||||
, githubUserLogin :: Text
|
||||
, githubUserAvatarUrl :: Text
|
||||
, githubUserLocation :: Text
|
||||
, githubUserPublicEmail :: Maybe Text
|
||||
}
|
||||
|
||||
instance FromJSON GithubUser where
|
||||
parseJSON (Object o) = GithubUser
|
||||
<$> o .: "id"
|
||||
<*> o .:? "name"
|
||||
<*> o .: "login"
|
||||
<*> o .: "avatar_url"
|
||||
<*> o .: "location"
|
||||
<*> o .: "email"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
data GithubUserEmail = GithubUserEmail
|
||||
{ githubUserEmailAddress :: Text
|
||||
, githubUserEmailPrimary :: Bool
|
||||
}
|
||||
|
||||
instance FromJSON GithubUserEmail where
|
||||
parseJSON (Object o) = GithubUserEmail
|
||||
<$> o .: "email"
|
||||
<*> o .: "primary"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
oauth2Github :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2Github clientId clientSecret = oauth2GithubScoped clientId clientSecret ["user:email"]
|
||||
|
||||
oauth2GithubScoped :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> [Text] -- ^ List of scopes to request
|
||||
-> AuthPlugin m
|
||||
oauth2GithubScoped clientId clientSecret scopes = authOAuth2 "github" oauth fetchGithubProfile
|
||||
where
|
||||
oauth = OAuth2
|
||||
{ oauthClientId = encodeUtf8 clientId
|
||||
, oauthClientSecret = encodeUtf8 clientSecret
|
||||
, oauthOAuthorizeEndpoint = encodeUtf8 $ "https://github.com/login/oauth/authorize?scope=" <> T.intercalate "," scopes
|
||||
, oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token"
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
|
||||
fetchGithubProfile :: Manager -> AccessToken -> IO (Creds m)
|
||||
fetchGithubProfile manager token = do
|
||||
userResult <- authGetJSON manager token "https://api.github.com/user"
|
||||
mailResult <- authGetJSON manager token "https://api.github.com/user/emails"
|
||||
|
||||
case (userResult, mailResult) of
|
||||
(Right _, Right []) -> throwIO $ InvalidProfileResponse "github" "no mail address for user"
|
||||
(Right user, Right mails) -> return $ toCreds user mails token
|
||||
(Left err, _) -> throwIO $ InvalidProfileResponse "github" err
|
||||
(_, Left err) -> throwIO $ InvalidProfileResponse "github" err
|
||||
|
||||
toCreds :: GithubUser -> [GithubUserEmail] -> AccessToken -> Creds m
|
||||
toCreds user userMails token = Creds
|
||||
{ credsPlugin = "github"
|
||||
, credsIdent = T.pack $ show $ githubUserId user
|
||||
, credsExtra =
|
||||
[ ("email", githubUserEmailAddress email)
|
||||
, ("login", githubUserLogin user)
|
||||
, ("avatar_url", githubUserAvatarUrl user)
|
||||
, ("location", githubUserLocation user)
|
||||
, ("access_token", decodeUtf8 $ accessToken token)
|
||||
]
|
||||
++ maybeName (githubUserName user)
|
||||
++ maybePublicEmail (githubUserPublicEmail user)
|
||||
}
|
||||
|
||||
where
|
||||
email = fromMaybe (head userMails) $ find githubUserEmailPrimary userMails
|
||||
|
||||
maybeName Nothing = []
|
||||
maybeName (Just name) = [("name", name)]
|
||||
|
||||
maybePublicEmail Nothing = []
|
||||
maybePublicEmail (Just e) = [("public_email", e)]
|
||||
@ -1,142 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://www.google.com
|
||||
--
|
||||
-- * Authenticates against Google
|
||||
-- * Uses Google user id or email as credentials identifier
|
||||
-- * Returns given_name, family_name, email, and avatar_url as extras
|
||||
--
|
||||
-- Note: This may eventually replace Yesod.Auth.GoogleEmail2. Currently it
|
||||
-- provides the same functionality except that GoogleEmail2 returns more profile
|
||||
-- information.
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Google
|
||||
( oauth2Google
|
||||
, oauth2GoogleScoped
|
||||
, oauth2GoogleScopedWithCustomId
|
||||
, googleUid
|
||||
, emailUid
|
||||
, module Yesod.Auth.OAuth2
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
#endif
|
||||
|
||||
import Control.Exception.Lifted
|
||||
import Control.Monad (mzero)
|
||||
import Data.Aeson
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- | Auth with Google
|
||||
--
|
||||
-- Requests @openid@ and @email@ scopes and uses email as the @'Creds'@
|
||||
-- identifier.
|
||||
--
|
||||
oauth2Google :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2Google = oauth2GoogleScoped ["openid", "email"]
|
||||
|
||||
-- | Auth with Google
|
||||
--
|
||||
-- Requests custom scopes and uses email as the @'Creds'@ identifier.
|
||||
--
|
||||
oauth2GoogleScoped :: YesodAuth m
|
||||
=> [Text] -- ^ List of scopes to request
|
||||
-> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2GoogleScoped = oauth2GoogleScopedWithCustomId emailUid
|
||||
|
||||
-- | Auth with Google
|
||||
--
|
||||
-- Requests custom scopes and uses the given function to create credentials
|
||||
-- which allows for using any attribute as the identifier.
|
||||
--
|
||||
-- See @'emailUid'@ and @'googleUid'@.
|
||||
--
|
||||
oauth2GoogleScopedWithCustomId :: YesodAuth m
|
||||
=> (GoogleUser -> AccessToken -> Creds m)
|
||||
-- ^ A function to generate the credentials
|
||||
-> [Text] -- ^ List of scopes to request
|
||||
-> Text -- ^ Client ID
|
||||
-> Text -- ^ Client secret
|
||||
-> AuthPlugin m
|
||||
oauth2GoogleScopedWithCustomId toCreds scopes clientId clientSecret =
|
||||
authOAuth2 "google" oauth $ fetchGoogleProfile toCreds
|
||||
|
||||
where
|
||||
oauth = OAuth2
|
||||
{ oauthClientId = encodeUtf8 clientId
|
||||
, oauthClientSecret = encodeUtf8 clientSecret
|
||||
, oauthOAuthorizeEndpoint = encodeUtf8
|
||||
$ "https://accounts.google.com/o/oauth2/auth?scope=" <> T.intercalate "+" scopes
|
||||
, oauthAccessTokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
|
||||
fetchGoogleProfile :: (GoogleUser -> AccessToken -> Creds m) -> Manager -> AccessToken -> IO (Creds m)
|
||||
fetchGoogleProfile toCreds manager token = do
|
||||
userInfo <- authGetJSON manager token "https://www.googleapis.com/oauth2/v3/userinfo"
|
||||
case userInfo of
|
||||
Right user -> return $ toCreds user token
|
||||
Left err -> throwIO $ InvalidProfileResponse "google" err
|
||||
|
||||
data GoogleUser = GoogleUser
|
||||
{ googleUserId :: Text
|
||||
, googleUserName :: Text
|
||||
, googleUserEmail :: Text
|
||||
, googleUserPicture :: Text
|
||||
, googleUserGivenName :: Text
|
||||
, googleUserFamilyName :: Text
|
||||
, googleUserHostedDomain :: Maybe Text
|
||||
}
|
||||
|
||||
instance FromJSON GoogleUser where
|
||||
parseJSON (Object o) = GoogleUser
|
||||
<$> o .: "sub"
|
||||
<*> o .: "name"
|
||||
<*> o .: "email"
|
||||
<*> o .: "picture"
|
||||
<*> o .: "given_name"
|
||||
<*> o .: "family_name"
|
||||
<*> o .:? "hd"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
-- | Build a @'Creds'@ using the user's google-uid as the identifier
|
||||
googleUid :: GoogleUser -> AccessToken -> Creds m
|
||||
googleUid = uidBuilder $ ("google-uid:" <>) . googleUserId
|
||||
|
||||
-- | Build a @'Creds'@ using the user's email as the identifier
|
||||
emailUid :: GoogleUser -> AccessToken -> Creds m
|
||||
emailUid = uidBuilder googleUserEmail
|
||||
|
||||
uidBuilder :: (GoogleUser -> Text) -> GoogleUser -> AccessToken -> Creds m
|
||||
uidBuilder f user token = Creds
|
||||
{ credsPlugin = "google"
|
||||
, credsIdent = f user
|
||||
, credsExtra =
|
||||
[ ("email", googleUserEmail user)
|
||||
, ("name", googleUserName user)
|
||||
, ("given_name", googleUserGivenName user)
|
||||
, ("family_name", googleUserFamilyName user)
|
||||
, ("avatar_url", googleUserPicture user)
|
||||
, ("access_token", decodeUtf8 $ accessToken token)
|
||||
] ++ maybeHostedDomain
|
||||
}
|
||||
|
||||
where
|
||||
maybeHostedDomain = maybeToList $ (,) "hosted_domain" <$> googleUserHostedDomain user
|
||||
@ -1,98 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.Nylas
|
||||
( oauth2Nylas
|
||||
, module Yesod.Auth.OAuth2
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
#endif
|
||||
|
||||
import Control.Monad (mzero)
|
||||
import Control.Exception.Lifted (throwIO)
|
||||
import Data.Aeson (FromJSON, Value(..), parseJSON, decode, (.:))
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Network.HTTP.Client (applyBasicAuth, parseUrl, httpLbs, responseStatus
|
||||
, responseBody)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Yesod.Auth (Creds(..), YesodAuth, AuthPlugin)
|
||||
import Yesod.Auth.OAuth2 (OAuth2(..), AccessToken(..)
|
||||
, YesodOAuth2Exception(InvalidProfileResponse)
|
||||
, authOAuth2)
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.HTTP.Types as HT
|
||||
|
||||
data NylasAccount = NylasAccount
|
||||
{ nylasAccountId :: Text
|
||||
, nylasAccountEmailAddress :: Text
|
||||
, nylasAccountName :: Text
|
||||
, nylasAccountProvider :: Text
|
||||
, nylasAccountOrganizationUnit :: Text
|
||||
}
|
||||
|
||||
instance FromJSON NylasAccount where
|
||||
parseJSON (Object o) = NylasAccount
|
||||
<$> o .: "id"
|
||||
<*> o .: "email_address"
|
||||
<*> o .: "name"
|
||||
<*> o .: "provider"
|
||||
<*> o .: "organization_unit"
|
||||
parseJSON _ = mzero
|
||||
|
||||
oauth2Nylas :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2Nylas = oauth2NylasScoped ["email"]
|
||||
|
||||
oauth2NylasScoped :: YesodAuth m
|
||||
=> [Text] -- ^ Scopes
|
||||
-> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2NylasScoped scopes clientId clientSecret =
|
||||
authOAuth2 "nylas" oauth fetchCreds
|
||||
where
|
||||
authorizeUrl = encodeUtf8
|
||||
$ "https://api.nylas.com/oauth/authorize?scope="
|
||||
<> T.intercalate "," scopes
|
||||
tokenUrl = "https://api.nylas.com/oauth/token"
|
||||
oauth = OAuth2
|
||||
{ oauthClientId = encodeUtf8 clientId
|
||||
, oauthClientSecret = encodeUtf8 clientSecret
|
||||
, oauthOAuthorizeEndpoint = authorizeUrl
|
||||
, oauthAccessTokenEndpoint = tokenUrl
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
|
||||
fetchCreds :: Manager -> AccessToken -> IO (Creds a)
|
||||
fetchCreds manager token = do
|
||||
req <- authorize <$> parseUrl "https://api.nylas.com/account"
|
||||
resp <- httpLbs req manager
|
||||
if HT.statusIsSuccessful (responseStatus resp)
|
||||
then case decode (responseBody resp) of
|
||||
Just ns -> return $ toCreds ns token
|
||||
Nothing -> throwIO parseFailure
|
||||
else throwIO requestFailure
|
||||
where
|
||||
authorize = applyBasicAuth (accessToken token) ""
|
||||
parseFailure = InvalidProfileResponse "nylas" "failed to parse account"
|
||||
requestFailure = InvalidProfileResponse "nylas" "failed to get account"
|
||||
|
||||
toCreds :: NylasAccount -> AccessToken -> Creds a
|
||||
toCreds ns token = Creds
|
||||
{ credsPlugin = "nylas"
|
||||
, credsIdent = nylasAccountId ns
|
||||
, credsExtra =
|
||||
[ ("email_address", nylasAccountEmailAddress ns)
|
||||
, ("name", nylasAccountName ns)
|
||||
, ("provider", nylasAccountProvider ns)
|
||||
, ("organization_unit", nylasAccountOrganizationUnit ns)
|
||||
, ("access_token", decodeUtf8 $ accessToken token)
|
||||
]
|
||||
}
|
||||
@ -1,107 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://spotify.com
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Spotify
|
||||
( oauth2Spotify
|
||||
, module Yesod.Auth.OAuth2
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>), (<*>), pure)
|
||||
#endif
|
||||
|
||||
import Control.Monad (mzero)
|
||||
import Data.Aeson
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.Text as T
|
||||
|
||||
data SpotifyUserImage = SpotifyUserImage
|
||||
{ spotifyUserImageHeight :: Maybe Int
|
||||
, spotifyUserImageWidth :: Maybe Int
|
||||
, spotifyUserImageUrl :: Text
|
||||
}
|
||||
|
||||
instance FromJSON SpotifyUserImage where
|
||||
parseJSON (Object v) = SpotifyUserImage
|
||||
<$> v .: "height"
|
||||
<*> v .: "width"
|
||||
<*> v .: "url"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
data SpotifyUser = SpotifyUser
|
||||
{ spotifyUserId :: Text
|
||||
, spotifyUserHref :: Text
|
||||
, spotifyUserUri :: Text
|
||||
, spotifyUserDisplayName :: Maybe Text
|
||||
, spotifyUserProduct :: Maybe Text
|
||||
, spotifyUserCountry :: Maybe Text
|
||||
, spotifyUserEmail :: Maybe Text
|
||||
, spotifyUserImages :: Maybe [SpotifyUserImage]
|
||||
}
|
||||
|
||||
instance FromJSON SpotifyUser where
|
||||
parseJSON (Object v) = SpotifyUser
|
||||
<$> v .: "id"
|
||||
<*> v .: "href"
|
||||
<*> v .: "uri"
|
||||
<*> v .:? "display_name"
|
||||
<*> v .:? "product"
|
||||
<*> v .:? "country"
|
||||
<*> v .:? "email"
|
||||
<*> v .:? "images"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
oauth2Spotify :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> [ByteString] -- ^ Scopes
|
||||
-> AuthPlugin m
|
||||
oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
|
||||
OAuth2
|
||||
{ oauthClientId = encodeUtf8 clientId
|
||||
, oauthClientSecret = encodeUtf8 clientSecret
|
||||
, oauthOAuthorizeEndpoint = B.append "https://accounts.spotify.com/authorize?scope=" (B.intercalate "%20" scope)
|
||||
, oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
$ fromProfileURL "spotify" "https://api.spotify.com/v1/me" toCreds
|
||||
|
||||
toCreds :: SpotifyUser -> Creds m
|
||||
toCreds user = Creds
|
||||
{ credsPlugin = "spotify"
|
||||
, credsIdent = spotifyUserId user
|
||||
, credsExtra = mapMaybe getExtra extrasTemplate
|
||||
}
|
||||
|
||||
where
|
||||
userImage :: Maybe SpotifyUserImage
|
||||
userImage = spotifyUserImages user >>= listToMaybe
|
||||
|
||||
userImagePart :: (SpotifyUserImage -> Maybe a) -> Maybe a
|
||||
userImagePart getter = userImage >>= getter
|
||||
|
||||
extrasTemplate = [ ("href", Just $ spotifyUserHref user)
|
||||
, ("uri", Just $ spotifyUserUri user)
|
||||
, ("display_name", spotifyUserDisplayName user)
|
||||
, ("product", spotifyUserProduct user)
|
||||
, ("country", spotifyUserCountry user)
|
||||
, ("email", spotifyUserEmail user)
|
||||
, ("image_url", spotifyUserImageUrl <$> userImage)
|
||||
, ("image_height", T.pack . show <$> userImagePart spotifyUserImageHeight)
|
||||
, ("image_width", T.pack . show <$> userImagePart spotifyUserImageWidth)
|
||||
]
|
||||
|
||||
getExtra :: (Text, Maybe Text) -> Maybe (Text, Text)
|
||||
getExtra (key, val) = fmap ((,) key) val
|
||||
@ -1,73 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://upcase.com
|
||||
--
|
||||
-- * Authenticates against upcase
|
||||
-- * Uses upcase user id as credentials identifier
|
||||
-- * Returns first_name, last_name, and email as extras
|
||||
--
|
||||
module Yesod.Auth.OAuth2.Upcase
|
||||
( oauth2Upcase
|
||||
, module Yesod.Auth.OAuth2
|
||||
) where
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 710
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
#endif
|
||||
|
||||
import Control.Monad (mzero)
|
||||
import Data.Aeson
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
import qualified Data.Text as T
|
||||
|
||||
data UpcaseUser = UpcaseUser
|
||||
{ upcaseUserId :: Int
|
||||
, upcaseUserFirstName :: Text
|
||||
, upcaseUserLastName :: Text
|
||||
, upcaseUserEmail :: Text
|
||||
}
|
||||
|
||||
instance FromJSON UpcaseUser where
|
||||
parseJSON (Object o) = UpcaseUser
|
||||
<$> o .: "id"
|
||||
<*> o .: "first_name"
|
||||
<*> o .: "last_name"
|
||||
<*> o .: "email"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
data UpcaseResponse = UpcaseResponse UpcaseUser
|
||||
|
||||
instance FromJSON UpcaseResponse where
|
||||
parseJSON (Object o) = UpcaseResponse
|
||||
<$> o .: "user"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
oauth2Upcase :: YesodAuth m
|
||||
=> Text -- ^ Client ID
|
||||
-> Text -- ^ Client Secret
|
||||
-> AuthPlugin m
|
||||
oauth2Upcase clientId clientSecret = authOAuth2 "upcase"
|
||||
OAuth2
|
||||
{ oauthClientId = encodeUtf8 clientId
|
||||
, oauthClientSecret = encodeUtf8 clientSecret
|
||||
, oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize"
|
||||
, oauthAccessTokenEndpoint = "http://upcase.com/oauth/token"
|
||||
, oauthCallback = Nothing
|
||||
}
|
||||
$ fromProfileURL "upcase" "http://upcase.com/api/v1/me.json"
|
||||
$ \user -> Creds
|
||||
{ credsPlugin = "upcase"
|
||||
, credsIdent = T.pack $ show $ upcaseUserId user
|
||||
, credsExtra =
|
||||
[ ("first_name", upcaseUserFirstName user)
|
||||
, ("last_name", upcaseUserLastName user)
|
||||
, ("email", upcaseUserEmail user)
|
||||
]
|
||||
}
|
||||
14
circle.yml
14
circle.yml
@ -1,14 +0,0 @@
|
||||
dependencies:
|
||||
cache_directories:
|
||||
- "~/.stack"
|
||||
pre:
|
||||
- wget https://github.com/commercialhaskell/stack/releases/download/v0.1.6.0/stack-0.1.6.0-linux-x86_64.tar.gz -O /tmp/stack.tar.gz
|
||||
- tar xvzOf /tmp/stack.tar.gz stack-0.1.6.0-linux-x86_64/stack > /tmp/stack
|
||||
- chmod +x /tmp/stack && sudo mv /tmp/stack /usr/bin/stack
|
||||
override:
|
||||
- stack setup
|
||||
- stack build --flag yesod-auth-oauth2:example
|
||||
|
||||
test:
|
||||
override:
|
||||
- stack test
|
||||
165
example/Main.hs
Normal file
165
example/Main.hs
Normal file
@ -0,0 +1,165 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Data.Aeson
|
||||
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.Text (Text, pack)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
import LoadEnv
|
||||
import Network.HTTP.Conduit
|
||||
import Network.Wai.Handler.Warp (runEnv)
|
||||
import System.Environment (getEnv)
|
||||
import Yesod
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2.Auth0
|
||||
import Yesod.Auth.OAuth2.AzureAD
|
||||
import Yesod.Auth.OAuth2.AzureADv2
|
||||
import Yesod.Auth.OAuth2.BattleNet
|
||||
import Yesod.Auth.OAuth2.Bitbucket
|
||||
import Yesod.Auth.OAuth2.ClassLink
|
||||
import Yesod.Auth.OAuth2.EveOnline
|
||||
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
|
||||
import Yesod.Auth.OAuth2.Twitch
|
||||
import Yesod.Auth.OAuth2.Upcase
|
||||
import Yesod.Auth.OAuth2.WordPressDotCom
|
||||
|
||||
data App = App
|
||||
{ appHttpManager :: Manager
|
||||
, appAuthPlugins :: [AuthPlugin App]
|
||||
}
|
||||
|
||||
mkYesod
|
||||
"App"
|
||||
[parseRoutes|
|
||||
/ RootR GET
|
||||
/auth AuthR Auth getAuth
|
||||
|]
|
||||
|
||||
instance Yesod App where
|
||||
-- see https://github.com/thoughtbot/yesod-auth-oauth2/issues/87
|
||||
approot = ApprootStatic "http://localhost:3000"
|
||||
|
||||
instance YesodAuth App where
|
||||
type AuthId App = Text
|
||||
loginDest _ = RootR
|
||||
logoutDest _ = RootR
|
||||
|
||||
-- Disable any attempt to read persisted authenticated state
|
||||
maybeAuthId = return Nothing
|
||||
|
||||
-- Copy the Creds response into the session for viewing after
|
||||
authenticate c = do
|
||||
mapM_ (uncurry setSession) $
|
||||
[("credsIdent", credsIdent c), ("credsPlugin", credsPlugin c)]
|
||||
++ credsExtra c
|
||||
|
||||
return $ Authenticated "1"
|
||||
|
||||
authPlugins = appAuthPlugins
|
||||
|
||||
instance RenderMessage App FormMessage where
|
||||
renderMessage _ _ = defaultFormMessage
|
||||
|
||||
-- brittany-disable-next-binding
|
||||
|
||||
getRootR :: Handler Html
|
||||
getRootR = do
|
||||
sess <- getSession
|
||||
|
||||
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
|
||||
|
||||
defaultLayout
|
||||
[whamlet|
|
||||
<h1>Yesod Auth OAuth2 Example
|
||||
<h2>
|
||||
<a href=@{AuthR LoginR}>Log in
|
||||
|
||||
<h2>Credentials
|
||||
|
||||
<h3>Plugin / Ident
|
||||
<p>#{show mCredsPlugin} / #{show mCredsIdent}
|
||||
|
||||
<h3>Access Token
|
||||
<p>#{show mAccessToken}
|
||||
|
||||
<h3>User Response
|
||||
<pre>
|
||||
$maybe userResponse <- mUserResponse
|
||||
#{userResponse}
|
||||
|]
|
||||
|
||||
mkFoundation :: IO App
|
||||
mkFoundation = do
|
||||
loadEnv
|
||||
|
||||
auth0Host <- getEnv "AUTH0_HOST"
|
||||
azureTenant <- getEnv "AZURE_ADV2_TENANT_ID"
|
||||
|
||||
appHttpManager <- newManager tlsManagerSettings
|
||||
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 oauth2ORCID "ORCID"
|
||||
, loadPlugin oauth2Upcase "UPCASE"
|
||||
]
|
||||
|
||||
return App {..}
|
||||
where
|
||||
loadPlugin f prefix = do
|
||||
clientId <- getEnv $ prefix <> "_CLIENT_ID"
|
||||
clientSecret <- getEnv $ prefix <> "_CLIENT_SECRET"
|
||||
pure $ f (T.pack clientId) (T.pack clientSecret)
|
||||
|
||||
main :: IO ()
|
||||
main = runEnv 3000 =<< toWaiApp =<< mkFoundation
|
||||
119
example/main.hs
119
example/main.hs
@ -1,119 +0,0 @@
|
||||
-- |
|
||||
--
|
||||
-- This is a single-file example of using yesod-auth-oauth2.
|
||||
--
|
||||
-- It can be run with:
|
||||
--
|
||||
-- > stack build --flag yesod-auth-oauth2:example
|
||||
-- > stack exec yesod-auth-oauth2-example
|
||||
-- > $BROWSER http://localhost:3000
|
||||
--
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
import LoadEnv
|
||||
import Network.HTTP.Conduit
|
||||
import Network.Wai.Handler.Warp (runEnv)
|
||||
import System.Environment (getEnv)
|
||||
import Yesod
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2.Github
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
data OAuthKeys = OAuthKeys
|
||||
{ oauthKeysClientId :: Text
|
||||
, oauthKeysClientSecret :: Text
|
||||
}
|
||||
|
||||
loadOAuthKeysEnv :: String -> IO OAuthKeys
|
||||
loadOAuthKeysEnv prefix = OAuthKeys
|
||||
<$> (getEnvT $ prefix <> "_CLIENT_ID")
|
||||
<*> (getEnvT $ prefix <> "_CLIENT_SECRET")
|
||||
|
||||
where
|
||||
getEnvT = fmap T.pack . getEnv
|
||||
|
||||
data App = App
|
||||
{ appHttpManager :: Manager
|
||||
, appGithubKeys :: OAuthKeys
|
||||
-- , appGoogleKeys :: OAuthKeys
|
||||
-- , etc...
|
||||
}
|
||||
|
||||
mkYesod "App" [parseRoutes|
|
||||
/ RootR GET
|
||||
/auth AuthR Auth getAuth
|
||||
|]
|
||||
|
||||
instance Yesod App where
|
||||
-- redirect_uri must be absolute to avoid callback mismatch error
|
||||
approot = ApprootStatic "http://localhost:3000"
|
||||
|
||||
instance YesodAuth App where
|
||||
type AuthId App = Text
|
||||
loginDest _ = RootR
|
||||
logoutDest _ = RootR
|
||||
|
||||
-- Disable any attempt to read persisted authenticated state
|
||||
maybeAuthId = return Nothing
|
||||
|
||||
-- Copy the Creds response into the session for viewing after
|
||||
authenticate c = do
|
||||
mapM_ (uncurry setSession) $
|
||||
[ ("credsIdent", credsIdent c)
|
||||
, ("credsPlugin", credsPlugin c)
|
||||
] ++ credsExtra c
|
||||
|
||||
return $ Authenticated "1"
|
||||
|
||||
authHttpManager = appHttpManager
|
||||
|
||||
authPlugins m =
|
||||
[ oauth2Github
|
||||
(oauthKeysClientId $ appGithubKeys m)
|
||||
(oauthKeysClientSecret $ appGithubKeys m)
|
||||
-- , oauth2Google
|
||||
-- (oauthKeysClientId $ appGoogleKeys m)
|
||||
-- (oauthKeysClientSecret $ appGoogleKeys m)
|
||||
-- , etc...
|
||||
]
|
||||
|
||||
instance RenderMessage App FormMessage where
|
||||
renderMessage _ _ = defaultFormMessage
|
||||
|
||||
getRootR :: Handler Html
|
||||
getRootR = do
|
||||
sess <- getSession
|
||||
|
||||
defaultLayout [whamlet|
|
||||
<h1>Yesod Auth OAuth2 Example
|
||||
<h2>
|
||||
<a href=@{AuthR LoginR}>Log in
|
||||
<h2>Session Information
|
||||
<pre style="word-wrap: break-word;">
|
||||
#{show sess}
|
||||
|]
|
||||
|
||||
mkFoundation :: IO App
|
||||
mkFoundation = do
|
||||
loadEnv
|
||||
|
||||
appHttpManager <- newManager tlsManagerSettings
|
||||
appGithubKeys <- loadOAuthKeysEnv "GITHUB"
|
||||
-- appGoogleKeys <- loadOAuthKeysEnv "GOOGLE"
|
||||
-- etc...
|
||||
|
||||
return App{..}
|
||||
|
||||
main :: IO ()
|
||||
main = runEnv 3000 =<< toWaiApp =<< mkFoundation
|
||||
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
|
||||
84
package.yaml
Normal file
84
package.yaml
Normal file
@ -0,0 +1,84 @@
|
||||
---
|
||||
name: yesod-auth-oauth2
|
||||
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
|
||||
author:
|
||||
- Tom Streller
|
||||
- Patrick Brisbin
|
||||
- Freckle Engineering
|
||||
license: MIT
|
||||
maintainer: engineering@freckle.com
|
||||
github: freckle/yesod-auth-oauth2
|
||||
homepage: http://github.com/freckle/yesod-auth-oauth2
|
||||
|
||||
extra-doc-files:
|
||||
- README.md
|
||||
- CHANGELOG.md
|
||||
|
||||
ghc-options: -Wall
|
||||
|
||||
dependencies:
|
||||
- base >=4.9.0.0 && <5
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
dependencies:
|
||||
- aeson >=0.6
|
||||
- bytestring >=0.9.1.4
|
||||
- crypton
|
||||
- errors
|
||||
- hoauth2 >=2.8.0 # TokenRequestError
|
||||
- http-client >=0.4.0
|
||||
- http-conduit >=2.0
|
||||
- http-types >=0.8
|
||||
- memory
|
||||
- microlens
|
||||
- mtl
|
||||
- safe-exceptions
|
||||
- text >=0.7
|
||||
- transformers
|
||||
- uri-bytestring
|
||||
- yesod-auth >=1.6.0
|
||||
- yesod-core >=1.6.0
|
||||
- unliftio
|
||||
|
||||
executables:
|
||||
yesod-auth-oauth2-example:
|
||||
main: Main.hs
|
||||
source-dirs: example
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- yesod-auth-oauth2
|
||||
- aeson >=0.6
|
||||
- aeson-pretty
|
||||
- bytestring >=0.9.1.4
|
||||
- containers >=0.6.0.1
|
||||
- http-conduit >=2.0
|
||||
- load-env
|
||||
- text >=0.7
|
||||
- warp
|
||||
- yesod
|
||||
- yesod-auth >=1.6.0
|
||||
when:
|
||||
- condition: ! "!(flag(example))"
|
||||
buildable: false
|
||||
|
||||
tests:
|
||||
test:
|
||||
main: Spec.hs
|
||||
source-dirs: test
|
||||
dependencies:
|
||||
- yesod-auth-oauth2
|
||||
- hspec
|
||||
- uri-bytestring
|
||||
|
||||
flags:
|
||||
example:
|
||||
description: Build the example application
|
||||
manual: false
|
||||
default: false
|
||||
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"
|
||||
}
|
||||
118
src/Network/OAuth/OAuth2/Compat.hs
Normal file
118
src/Network/OAuth/OAuth2/Compat.hs
Normal file
@ -0,0 +1,118 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Network.OAuth.OAuth2.Compat
|
||||
( OAuth2 (..)
|
||||
, authorizationUrl
|
||||
, fetchAccessTokenBasic
|
||||
, fetchAccessTokenPost
|
||||
, authGetBS
|
||||
|
||||
-- * Re-exports
|
||||
, 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 URI.ByteString
|
||||
|
||||
#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 :: Text
|
||||
, oauth2AuthorizeEndpoint :: URIRef Absolute
|
||||
, oauth2TokenEndpoint :: URIRef Absolute
|
||||
, oauth2RedirectUri :: Maybe (URIRef Absolute)
|
||||
}
|
||||
|
||||
authorizationUrl :: OAuth2 -> URI
|
||||
authorizationUrl = OAuth2.authorizationUrl . getOAuth2
|
||||
|
||||
fetchAccessTokenBasic
|
||||
:: Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (Either TokenResponseError TokenResponse)
|
||||
fetchAccessTokenBasic =
|
||||
runFetchAccessToken OAuth2.ClientSecretBasic
|
||||
|
||||
fetchAccessTokenPost
|
||||
:: 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
|
||||
56
src/URI/ByteString/Extension.hs
Normal file
56
src/URI/ByteString/Extension.hs
Normal file
@ -0,0 +1,56 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module URI.ByteString.Extension where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.String (IsString (..))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
|
||||
import Lens.Micro
|
||||
|
||||
import qualified Data.ByteString.Char8 as C8
|
||||
|
||||
import URI.ByteString
|
||||
|
||||
instance IsString Scheme where
|
||||
fromString = Scheme . fromString
|
||||
|
||||
instance IsString Host where
|
||||
fromString = Host . fromString
|
||||
|
||||
instance IsString (URIRef Absolute) where
|
||||
fromString =
|
||||
either (error . show) id . parseURI strictURIParserOptions . C8.pack
|
||||
|
||||
instance IsString (URIRef Relative) where
|
||||
fromString =
|
||||
either (error . show) id . parseRelativeRef strictURIParserOptions . C8.pack
|
||||
|
||||
fromText :: Text -> Maybe URI
|
||||
fromText =
|
||||
either (const Nothing) Just . parseURI strictURIParserOptions . encodeUtf8
|
||||
|
||||
unsafeFromText :: Text -> URI
|
||||
unsafeFromText =
|
||||
either (error . show) id . parseURI strictURIParserOptions . encodeUtf8
|
||||
|
||||
toText :: URI -> Text
|
||||
toText = decodeUtf8 . serializeURIRef'
|
||||
|
||||
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)
|
||||
|
||||
withPath :: URIRef a -> ByteString -> URIRef a
|
||||
withPath u p = u & pathL .~ p
|
||||
|
||||
withQuery :: URIRef a -> [(ByteString, ByteString)] -> URIRef a
|
||||
withQuery u q = u & (queryL . queryPairsL) %~ (++ q)
|
||||
12
src/UnliftIO/Except.hs
Normal file
12
src/UnliftIO/Except.hs
Normal file
@ -0,0 +1,12 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module UnliftIO.Except () where
|
||||
|
||||
import Control.Monad ((<=<))
|
||||
import Control.Monad.Except (ExceptT (..), runExceptT)
|
||||
import UnliftIO
|
||||
|
||||
instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
|
||||
withRunInIO exceptToIO = ExceptT $ try $ do
|
||||
withRunInIO $ \runInIO ->
|
||||
exceptToIO (runInIO . (either throwIO pure <=< runExceptT))
|
||||
117
src/Yesod/Auth/OAuth2.hs
Normal file
117
src/Yesod/Auth/OAuth2.hs
Normal file
@ -0,0 +1,117 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- Generic OAuth2 plugin for Yesod
|
||||
--
|
||||
-- See @"Yesod.Auth.OAuth2.GitHub"@ for example usage.
|
||||
module Yesod.Auth.OAuth2
|
||||
( OAuth2 (..)
|
||||
, FetchCreds
|
||||
, Manager
|
||||
, TokenResponse
|
||||
, Creds (..)
|
||||
, oauth2Url
|
||||
, authOAuth2
|
||||
, authOAuth2Widget
|
||||
|
||||
-- * Alternatives that use 'fetchAccessTokenPost'
|
||||
, authOAuth2'
|
||||
, authOAuth2Widget'
|
||||
|
||||
-- * Reading our @'credsExtra'@ keys
|
||||
, getAccessToken
|
||||
, getRefreshToken
|
||||
, getUserResponse
|
||||
, getUserResponseJSON
|
||||
) where
|
||||
|
||||
import Control.Error.Util (note)
|
||||
import Control.Monad ((<=<))
|
||||
import Data.Aeson (FromJSON, eitherDecode)
|
||||
import Data.ByteString.Lazy (ByteString, fromStrict)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Network.HTTP.Conduit (Manager)
|
||||
import Network.OAuth.OAuth2.Compat
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2.Dispatch
|
||||
import Yesod.Core.Widget
|
||||
|
||||
oauth2Url :: Text -> AuthRoute
|
||||
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 '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
|
||||
|
||||
-- | Create an @'AuthPlugin'@ for the given OAuth2 provider
|
||||
--
|
||||
-- Allows passing a custom widget for the login link. See @'oauth2Eve'@ for an
|
||||
-- example.
|
||||
authOAuth2Widget
|
||||
:: YesodAuth m
|
||||
=> WidgetFor m ()
|
||||
-> Text
|
||||
-> OAuth2
|
||||
-> FetchCreds m
|
||||
-> AuthPlugin m
|
||||
authOAuth2Widget = buildPlugin fetchAccessTokenBasic
|
||||
|
||||
-- | A version of 'authOAuth2Widget' that uses 'fetchAccessTokenPost'
|
||||
--
|
||||
-- See <https://github.com/thoughtbot/yesod-auth-oauth2/pull/129>
|
||||
authOAuth2Widget'
|
||||
:: YesodAuth m
|
||||
=> WidgetFor m ()
|
||||
-> Text
|
||||
-> OAuth2
|
||||
-> FetchCreds m
|
||||
-> AuthPlugin m
|
||||
authOAuth2Widget' = buildPlugin fetchAccessTokenPost
|
||||
|
||||
buildPlugin
|
||||
:: YesodAuth m
|
||||
=> FetchToken
|
||||
-> WidgetFor m ()
|
||||
-> Text
|
||||
-> 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}|]
|
||||
|
||||
-- | Read the @'AccessToken'@ from the values set via @'setExtra'@
|
||||
getAccessToken :: Creds m -> Maybe AccessToken
|
||||
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
|
||||
|
||||
-- | Read the original profile response from the values set via @'setExtra'@
|
||||
getUserResponse :: Creds m -> Maybe ByteString
|
||||
getUserResponse =
|
||||
(fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra
|
||||
|
||||
-- | @'getUserResponse'@, and decode as JSON
|
||||
getUserResponseJSON :: FromJSON a => Creds m -> Either String a
|
||||
getUserResponseJSON =
|
||||
eitherDecode <=< note "userResponse key not present" . getUserResponse
|
||||
60
src/Yesod/Auth/OAuth2/Auth0.hs
Normal file
60
src/Yesod/Auth/OAuth2/Auth0.hs
Normal file
@ -0,0 +1,60 @@
|
||||
{-# 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
|
||||
, defaultAuth0Scopes
|
||||
) where
|
||||
|
||||
import Data.Aeson as Aeson
|
||||
import qualified Data.Text as T
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
import Prelude
|
||||
|
||||
-- | https://auth0.com/docs/api/authentication#get-user-info
|
||||
newtype User = User T.Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "sub"
|
||||
|
||||
-- | https://auth0.com/docs/get-started/apis/scopes/openid-connect-scopes#standard-claims
|
||||
defaultAuth0Scopes :: [Text]
|
||||
defaultAuth0Scopes = ["openid"]
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "auth0"
|
||||
|
||||
oauth2Auth0Host :: YesodAuth m => URI -> Text -> Text -> AuthPlugin m
|
||||
oauth2Auth0Host host = oauth2Auth0HostScopes host defaultAuth0Scopes
|
||||
|
||||
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
|
||||
}
|
||||
where
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
host `withPath` "/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = host `withPath` "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
59
src/Yesod/Auth/OAuth2/AzureAD.hs
Normal file
59
src/Yesod/Auth/OAuth2/AzureAD.hs
Normal file
@ -0,0 +1,59 @@
|
||||
{-# 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 Yesod.Auth.OAuth2.Prelude
|
||||
import Prelude
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "mail"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "azuread"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["openid", "profile"]
|
||||
|
||||
oauth2AzureAD :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
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"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
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
|
||||
}
|
||||
104
src/Yesod/Auth/OAuth2/AzureADv2.hs
Normal file
104
src/Yesod/Auth/OAuth2/AzureADv2.hs
Normal file
@ -0,0 +1,104 @@
|
||||
{-# 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 Yesod.Auth.OAuth2.Prelude
|
||||
import Yesod.Core (WidgetFor, whamlet)
|
||||
import Prelude
|
||||
|
||||
import Data.String
|
||||
import Data.Text (unpack)
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "mail"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "azureadv2"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["openid", "profile"]
|
||||
|
||||
oauth2AzureADv2
|
||||
:: YesodAuth m
|
||||
=> Text
|
||||
-- ^ Tenant Id
|
||||
--
|
||||
-- If using a multi-tenant App, @common@ can be given here.
|
||||
-> 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
|
||||
=> 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
|
||||
-> AuthPlugin m
|
||||
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
|
||||
}
|
||||
where
|
||||
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
|
||||
73
src/Yesod/Auth/OAuth2/BattleNet.hs
Normal file
73
src/Yesod/Auth/OAuth2/BattleNet.hs
Normal file
@ -0,0 +1,73 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for Battle.Net
|
||||
--
|
||||
-- * Authenticates against battle.net.
|
||||
-- * Uses user's id as credentials identifier.
|
||||
-- * Returns user's battletag in extras.
|
||||
module Yesod.Auth.OAuth2.BattleNet
|
||||
( oauth2BattleNet
|
||||
, oAuth2BattleNet
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T (pack, toLower)
|
||||
import Yesod.Core.Widget
|
||||
|
||||
newtype User = User Int
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "id"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "battle.net"
|
||||
|
||||
oauth2BattleNet
|
||||
:: YesodAuth m
|
||||
=> 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"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
host = wwwHost $ T.toLower region
|
||||
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"
|
||||
apiHost region = Host $ encodeUtf8 $ region <> ".api.battle.net"
|
||||
|
||||
wwwHost :: Text -> Host
|
||||
wwwHost "cn" = "www.battlenet.com.cn"
|
||||
wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net"
|
||||
|
||||
oAuth2BattleNet
|
||||
:: YesodAuth m => Text -> Text -> Text -> WidgetFor m () -> AuthPlugin m
|
||||
oAuth2BattleNet i s r w = oauth2BattleNet w r i s
|
||||
{-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-}
|
||||
64
src/Yesod/Auth/OAuth2/Bitbucket.hs
Normal file
64
src/Yesod/Auth/OAuth2/Bitbucket.hs
Normal file
@ -0,0 +1,64 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://bitbucket.com
|
||||
--
|
||||
-- * Authenticates against bitbucket
|
||||
-- * Uses bitbucket uuid as credentials identifier
|
||||
module Yesod.Auth.OAuth2.Bitbucket
|
||||
( oauth2Bitbucket
|
||||
, oauth2BitbucketScoped
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "uuid"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "bitbucket"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["account"]
|
||||
|
||||
oauth2Bitbucket :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
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"
|
||||
|
||||
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 = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://bitbucket.com/site/oauth2/authorize"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
52
src/Yesod/Auth/OAuth2/ClassLink.hs
Normal file
52
src/Yesod/Auth/OAuth2/ClassLink.hs
Normal file
@ -0,0 +1,52 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.ClassLink
|
||||
( oauth2ClassLink
|
||||
, oauth2ClassLinkScoped
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
newtype User = User Int
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "UserId"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "classlink"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["profile", "oneroster"]
|
||||
|
||||
oauth2ClassLink :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
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"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
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
|
||||
}
|
||||
159
src/Yesod/Auth/OAuth2/Dispatch.hs
Normal file
159
src/Yesod/Auth/OAuth2/Dispatch.hs
Normal file
@ -0,0 +1,159 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.Dispatch
|
||||
( FetchToken
|
||||
, fetchAccessTokenBasic
|
||||
, fetchAccessTokenPost
|
||||
, FetchCreds
|
||||
, dispatchAuthRequest
|
||||
) where
|
||||
|
||||
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 URI.ByteString.Extension
|
||||
import UnliftIO.Exception
|
||||
import Yesod.Auth hiding (ServerError)
|
||||
import Yesod.Auth.OAuth2.DispatchError
|
||||
import Yesod.Auth.OAuth2.ErrorResponse
|
||||
import Yesod.Auth.OAuth2.Random
|
||||
import Yesod.Core hiding (ErrorResponse)
|
||||
|
||||
-- | How to fetch an @'OAuth2Token'@
|
||||
--
|
||||
-- This will be 'fetchAccessToken' or 'fetchAccessToken2'
|
||||
type FetchToken =
|
||||
Manager
|
||||
-> OAuth2
|
||||
-> ExchangeToken
|
||||
-> IO (Either TokenResponseError TokenResponse)
|
||||
|
||||
-- | How to take an @'OAuth2Token'@ and retrieve user credentials
|
||||
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
|
||||
-> AuthHandler m TypedContent
|
||||
dispatchAuthRequest name oauth2 _ _ "GET" ["forward"] =
|
||||
handleDispatchError $ dispatchForward name oauth2
|
||||
dispatchAuthRequest name oauth2 getToken getCreds "GET" ["callback"] =
|
||||
handleDispatchError $ dispatchCallback name oauth2 getToken getCreds
|
||||
dispatchAuthRequest _ _ _ _ _ _ = notFound
|
||||
|
||||
-- | Handle @GET \/forward@
|
||||
--
|
||||
-- 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
|
||||
-> OAuth2
|
||||
-> m TypedContent
|
||||
dispatchForward name oauth2 = do
|
||||
csrf <- setSessionCSRF $ tokenSessionKey name
|
||||
oauth2' <- withCallbackAndState name oauth2 csrf
|
||||
redirect $ toText $ authorizationUrl oauth2'
|
||||
|
||||
-- | Handle @GET \/callback@
|
||||
--
|
||||
-- 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
|
||||
-> OAuth2
|
||||
-> FetchToken
|
||||
-> FetchCreds site
|
||||
-> m TypedContent
|
||||
dispatchCallback name oauth2 getToken getCreds = do
|
||||
onErrorResponse $ throwError . OAuth2HandshakeError
|
||||
csrf <- verifySessionCSRF $ tokenSessionKey name
|
||||
code <- requireGetParam "code"
|
||||
manager <- authHttpManager
|
||||
oauth2' <- withCallbackAndState name oauth2 csrf
|
||||
token <-
|
||||
either (throwError . OAuth2ResultError) pure
|
||||
=<< liftIO (getToken manager oauth2' $ ExchangeToken code)
|
||||
creds <-
|
||||
liftIO (getCreds manager token)
|
||||
`catch` (throwError . FetchCredsIOException)
|
||||
`catch` (throwError . FetchCredsYesodOAuth2Exception)
|
||||
setCredsRedirect creds
|
||||
|
||||
withCallbackAndState
|
||||
:: (MonadError DispatchError m, MonadAuthHandler site m)
|
||||
=> Text
|
||||
-> OAuth2
|
||||
-> Text
|
||||
-> m OAuth2
|
||||
withCallbackAndState name oauth2 csrf = do
|
||||
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, ~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 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
|
||||
|
||||
-- | Verify the callback provided the same CSRF token as in our session
|
||||
verifySessionCSRF
|
||||
:: (MonadError DispatchError m, MonadHandler m) => Text -> m Text
|
||||
verifySessionCSRF sessionKey = do
|
||||
token <- requireGetParam "state"
|
||||
sessionToken <- lookupSession sessionKey
|
||||
deleteSession sessionKey
|
||||
token
|
||||
<$ unless
|
||||
(sessionToken == Just token)
|
||||
(throwError $ InvalidStateToken sessionToken token)
|
||||
|
||||
requireGetParam
|
||||
:: (MonadError DispatchError m, MonadHandler m) => Text -> m Text
|
||||
requireGetParam key =
|
||||
maybe (throwError $ MissingParameter key) pure =<< lookupGetParam key
|
||||
|
||||
tokenSessionKey :: Text -> Text
|
||||
tokenSessionKey name = "_yesod_oauth2_" <> name
|
||||
80
src/Yesod/Auth/OAuth2/DispatchError.hs
Normal file
80
src/Yesod/Auth/OAuth2/DispatchError.hs
Normal file
@ -0,0 +1,80 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.DispatchError
|
||||
( DispatchError (..)
|
||||
, handleDispatchError
|
||||
, onDispatchError
|
||||
) where
|
||||
|
||||
import Control.Monad.Except
|
||||
import Data.Text (Text, pack)
|
||||
import Network.OAuth.OAuth2.Compat (TokenResponseError)
|
||||
import UnliftIO.Except ()
|
||||
import UnliftIO.Exception
|
||||
import Yesod.Auth hiding (ServerError)
|
||||
import Yesod.Auth.OAuth2.ErrorResponse
|
||||
import Yesod.Auth.OAuth2.Exception
|
||||
import Yesod.Auth.OAuth2.Random
|
||||
import Yesod.Core hiding (ErrorResponse)
|
||||
|
||||
data DispatchError
|
||||
= 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 {} ->
|
||||
"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"
|
||||
|
||||
handleDispatchError
|
||||
:: MonadAuthHandler site m
|
||||
=> ExceptT DispatchError m TypedContent
|
||||
-> m TypedContent
|
||||
handleDispatchError f = do
|
||||
result <- runExceptT f
|
||||
either onDispatchError pure result
|
||||
|
||||
onDispatchError :: MonadAuthHandler site m => DispatchError -> m TypedContent
|
||||
onDispatchError err = do
|
||||
errorId <- liftIO $ randomText 16
|
||||
let suffix = " [errorId=" <> errorId <> "]"
|
||||
$(logError) $ pack (displayException err) <> suffix
|
||||
|
||||
let
|
||||
message = dispatchErrorMessage err <> suffix
|
||||
messageValue =
|
||||
object ["error" .= object ["id" .= errorId, "message" .= message]]
|
||||
|
||||
loginR <- ($ LoginR) <$> getRouteToParent
|
||||
|
||||
selectRep $ do
|
||||
provideRep @_ @Html $ onErrorHtml loginR message
|
||||
provideRep @_ @Value $ pure messageValue
|
||||
77
src/Yesod/Auth/OAuth2/ErrorResponse.hs
Normal file
77
src/Yesod/Auth/OAuth2/ErrorResponse.hs
Normal file
@ -0,0 +1,77 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | OAuth callback error response
|
||||
--
|
||||
-- <https://tools.ietf.org/html/rfc6749#section-4.1.2.1>
|
||||
module Yesod.Auth.OAuth2.ErrorResponse
|
||||
( ErrorResponse (..)
|
||||
, erUserMessage
|
||||
, ErrorName (..)
|
||||
, onErrorResponse
|
||||
, unknownError
|
||||
) where
|
||||
|
||||
import Data.Foldable (traverse_)
|
||||
import Data.Text (Text)
|
||||
import Data.Traversable (for)
|
||||
import Yesod.Core (MonadHandler, lookupGetParam)
|
||||
|
||||
data ErrorName
|
||||
= InvalidRequest
|
||||
| UnauthorizedClient
|
||||
| AccessDenied
|
||||
| UnsupportedResponseType
|
||||
| InvalidScope
|
||||
| ServerError
|
||||
| TemporarilyUnavailable
|
||||
| Unknown Text
|
||||
deriving (Show)
|
||||
|
||||
data ErrorResponse = ErrorResponse
|
||||
{ erName :: ErrorName
|
||||
, erDescription :: Maybe Text
|
||||
, erURI :: Maybe Text
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
-- | Textual value suitable for display to a User
|
||||
erUserMessage :: ErrorResponse -> Text
|
||||
erUserMessage err = case erName err of
|
||||
InvalidRequest -> "Invalid request"
|
||||
UnauthorizedClient -> "Unauthorized client"
|
||||
AccessDenied -> "Access denied"
|
||||
UnsupportedResponseType -> "Unsupported response type"
|
||||
InvalidScope -> "Invalid scope"
|
||||
ServerError -> "Server error"
|
||||
TemporarilyUnavailable -> "Temporarily unavailable"
|
||||
Unknown _ -> "Unknown error"
|
||||
|
||||
unknownError :: Text -> ErrorResponse
|
||||
unknownError x =
|
||||
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
|
||||
|
||||
checkErrorResponse :: MonadHandler m => m (Maybe ErrorResponse)
|
||||
checkErrorResponse = do
|
||||
merror <- lookupGetParam "error"
|
||||
|
||||
for merror $ \err ->
|
||||
ErrorResponse (readErrorName err)
|
||||
<$> lookupGetParam "error_description"
|
||||
<*> lookupGetParam "error_uri"
|
||||
|
||||
readErrorName :: Text -> ErrorName
|
||||
readErrorName "invalid_request" = InvalidRequest
|
||||
readErrorName "unauthorized_client" = UnauthorizedClient
|
||||
readErrorName "access_denied" = AccessDenied
|
||||
readErrorName "unsupported_response_type" = UnsupportedResponseType
|
||||
readErrorName "invalid_scope" = InvalidScope
|
||||
readErrorName "server_error" = ServerError
|
||||
readErrorName "temporarily_unavailable" = TemporarilyUnavailable
|
||||
readErrorName x = Unknown x
|
||||
85
src/Yesod/Auth/OAuth2/EveOnline.hs
Normal file
85
src/Yesod/Auth/OAuth2/EveOnline.hs
Normal file
@ -0,0 +1,85 @@
|
||||
{-# 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 (..)
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Yesod.Core.Widget
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "CharacterOwnerHash"
|
||||
|
||||
data WidgetType 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 (Custom a) = a
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "eveonline"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["publicData"]
|
||||
|
||||
oauth2Eve :: YesodAuth m => WidgetType m -> Text -> Text -> AuthPlugin m
|
||||
oauth2Eve = oauth2EveScoped defaultScopes
|
||||
|
||||
oauth2EveScoped
|
||||
:: YesodAuth m => [Text] -> WidgetType m -> Text -> Text -> AuthPlugin m
|
||||
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"
|
||||
|
||||
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 = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://login.eveonline.com/oauth/authorize"
|
||||
`withQuery` [("response_type", "code"), scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
24
src/Yesod/Auth/OAuth2/Exception.hs
Normal file
24
src/Yesod/Auth/OAuth2/Exception.hs
Normal file
@ -0,0 +1,24 @@
|
||||
module Yesod.Auth.OAuth2.Exception
|
||||
( YesodOAuth2Exception (..)
|
||||
) where
|
||||
|
||||
import Control.Exception.Safe
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Text (Text)
|
||||
|
||||
data YesodOAuth2Exception
|
||||
= -- | HTTP error during OAuth2 handshake
|
||||
--
|
||||
-- Plugin name and JSON-encoded @OAuth2Error@ from @hoauth2@.
|
||||
OAuth2Error Text ByteString
|
||||
| -- | User profile was not as expected
|
||||
--
|
||||
-- Plugin name and Aeson parse error message.
|
||||
JSONDecodingError Text String
|
||||
| -- | Other error conditions
|
||||
--
|
||||
-- Plugin name and error message.
|
||||
GenericError Text String
|
||||
deriving (Show)
|
||||
|
||||
instance Exception YesodOAuth2Exception
|
||||
70
src/Yesod/Auth/OAuth2/GitHub.hs
Normal file
70
src/Yesod/Auth/OAuth2/GitHub.hs
Normal file
@ -0,0 +1,70 @@
|
||||
{-# 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 qualified Data.Text as T
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
import Yesod.Core (WidgetFor, whamlet)
|
||||
|
||||
newtype User = User Int
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "id"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "github"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["user:email"]
|
||||
|
||||
oauth2GitHub :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2GitHub = oauth2GitHubScoped defaultScopes
|
||||
|
||||
oauth2GitHubWidget
|
||||
:: YesodAuth m => WidgetFor m () -> Text -> Text -> AuthPlugin m
|
||||
oauth2GitHubWidget widget = oauth2GitHubScopedWidget widget defaultScopes
|
||||
|
||||
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 = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://github.com/login/oauth/authorize"
|
||||
`withQuery` [scopeParam "," scopes]
|
||||
, oauth2TokenEndpoint = "https://github.com/login/oauth/access_token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
61
src/Yesod/Auth/OAuth2/GitLab.hs
Normal file
61
src/Yesod/Auth/OAuth2/GitLab.hs
Normal file
@ -0,0 +1,61 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.GitLab
|
||||
( oauth2GitLab
|
||||
, oauth2GitLabHostScopes
|
||||
, defaultHost
|
||||
, defaultScopes
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
newtype User = User Int
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "id"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "gitlab"
|
||||
|
||||
defaultHost :: URI
|
||||
defaultHost = "https://gitlab.com"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["read_user"]
|
||||
|
||||
-- | Authorize with @gitlab.com@ and @[\"read_user\"]@
|
||||
--
|
||||
-- To customize either of these values, use @'oauth2GitLabHostScopes'@ and pass
|
||||
-- the default for the argument not being customized. Note that we require at
|
||||
-- least @read_user@, so we can request the credentials identifier.
|
||||
--
|
||||
-- > oauth2GitLabHostScopes defaultHost ["api", "read_user"]
|
||||
-- > oauth2GitLabHostScopes "https://gitlab.example.com" defaultScopes
|
||||
oauth2GitLab :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2GitLab = oauth2GitLabHostScopes defaultHost defaultScopes
|
||||
|
||||
oauth2GitLabHostScopes
|
||||
:: YesodAuth m => URI -> [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2GitLabHostScopes host scopes clientId clientSecret =
|
||||
authOAuth2 pluginName oauth2 $ \manager token -> do
|
||||
(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
|
||||
}
|
||||
where
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
host `withPath` "/oauth/authorize" `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = host `withPath` "/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
89
src/Yesod/Auth/OAuth2/Google.hs
Normal file
89
src/Yesod/Auth/OAuth2/Google.hs
Normal file
@ -0,0 +1,89 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://www.google.com
|
||||
--
|
||||
-- * Authenticates against Google
|
||||
-- * Uses Google user id as credentials identifier
|
||||
--
|
||||
-- If you were previously relying on email as the creds identifier, you can
|
||||
-- still do that (and more) by overriding it in the creds returned by the plugin
|
||||
-- with any value read out of the new @userResponse@ key in @'credsExtra'@.
|
||||
--
|
||||
-- For example:
|
||||
--
|
||||
-- > data User = User { userEmail :: Text }
|
||||
-- >
|
||||
-- > instance FromJSON User where -- you know...
|
||||
-- >
|
||||
-- > authenticate creds = do
|
||||
-- > -- 'getUserResponseJSON' provided by "Yesod.Auth.OAuth" module
|
||||
-- > let Right email = userEmail <$> getUserResponseJSON creds
|
||||
-- > updatedCreds = creds { credsIdent = email }
|
||||
-- >
|
||||
-- > -- continue normally with updatedCreds
|
||||
module Yesod.Auth.OAuth2.Google
|
||||
( oauth2Google
|
||||
, oauth2GoogleWidget
|
||||
, oauth2GoogleScoped
|
||||
, oauth2GoogleScopedWidget
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
import Yesod.Core (WidgetFor, whamlet)
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON =
|
||||
withObject "User" $ \o ->
|
||||
-- Required for data backwards-compatibility
|
||||
User . ("google-uid:" <>) <$> o .: "sub"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "google"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["openid", "email"]
|
||||
|
||||
oauth2Google :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2Google = oauth2GoogleScoped defaultScopes
|
||||
|
||||
oauth2GoogleWidget
|
||||
:: YesodAuth m => WidgetFor m () -> Text -> Text -> AuthPlugin m
|
||||
oauth2GoogleWidget widget = oauth2GoogleScopedWidget widget defaultScopes
|
||||
|
||||
oauth2GoogleScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
|
||||
oauth2GoogleScoped =
|
||||
oauth2GoogleScopedWidget [whamlet|Login via #{pluginName}|]
|
||||
|
||||
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"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
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
|
||||
}
|
||||
70
src/Yesod/Auth/OAuth2/Nylas.hs
Normal file
70
src/Yesod/Auth/OAuth2/Nylas.hs
Normal file
@ -0,0 +1,70 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.Nylas
|
||||
( oauth2Nylas
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import Control.Monad (unless)
|
||||
import qualified Data.ByteString.Lazy.Char8 as BL8
|
||||
import Network.HTTP.Client
|
||||
import qualified Network.HTTP.Types as HT
|
||||
import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "id"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "nylas"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
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"
|
||||
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
|
||||
|
||||
either
|
||||
(throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
|
||||
( \(User userId) ->
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
)
|
||||
$ eitherDecode userResponse
|
||||
where
|
||||
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
|
||||
}
|
||||
127
src/Yesod/Auth/OAuth2/Prelude.hs
Normal file
127
src/Yesod/Auth/OAuth2/Prelude.hs
Normal file
@ -0,0 +1,127 @@
|
||||
{-# 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
|
||||
, setExtra
|
||||
|
||||
-- * Text
|
||||
, Text
|
||||
, decodeUtf8
|
||||
, encodeUtf8
|
||||
|
||||
-- * JSON
|
||||
, (.:)
|
||||
, (.:?)
|
||||
, (.=)
|
||||
, (<>)
|
||||
, FromJSON (..)
|
||||
, ToJSON (..)
|
||||
, eitherDecode
|
||||
, withObject
|
||||
|
||||
-- * Exceptions
|
||||
, throwIO
|
||||
|
||||
-- * OAuth2
|
||||
, OAuth2 (..)
|
||||
, TokenResponse
|
||||
, accessToken
|
||||
, refreshToken
|
||||
, expiresIn
|
||||
, tokenType
|
||||
, idToken
|
||||
, AccessToken (..)
|
||||
, RefreshToken (..)
|
||||
|
||||
-- * HTTP
|
||||
, Manager
|
||||
|
||||
-- * Yesod
|
||||
, YesodAuth (..)
|
||||
, AuthPlugin (..)
|
||||
, Creds (..)
|
||||
|
||||
-- * Bytestring URI types
|
||||
, URI
|
||||
, Host (..)
|
||||
|
||||
-- * Bytestring URI extensions
|
||||
, module URI.ByteString.Extension
|
||||
|
||||
-- * Temporary, until I finish re-structuring modules
|
||||
, authOAuth2
|
||||
, authOAuth2Widget
|
||||
) where
|
||||
|
||||
import Control.Exception.Safe
|
||||
import Data.Aeson
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding
|
||||
import Network.HTTP.Conduit
|
||||
import Network.OAuth.OAuth2.Compat
|
||||
import URI.ByteString
|
||||
import URI.ByteString.Extension
|
||||
import Yesod.Auth
|
||||
import Yesod.Auth.OAuth2
|
||||
import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
|
||||
|
||||
-- | Retrieve a user's profile as JSON
|
||||
--
|
||||
-- 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
|
||||
-> TokenResponse
|
||||
-> URI
|
||||
-> IO (a, BL.ByteString)
|
||||
authGetProfile name manager token url = do
|
||||
resp <- fromAuthGet name =<< authGetBS manager (accessToken token) url
|
||||
decoded <- fromAuthJSON name resp
|
||||
pure (decoded, resp)
|
||||
|
||||
-- | Throws a @Left@ result as an @'YesodOAuth2Exception'@
|
||||
fromAuthGet :: Text -> Either BL.ByteString BL.ByteString -> IO BL.ByteString
|
||||
fromAuthGet _ (Right bs) = pure bs -- nice
|
||||
fromAuthGet name (Left err) =
|
||||
throwIO $ YesodOAuth2Exception.OAuth2Error name err
|
||||
|
||||
-- | Throws a decoding error as an @'YesodOAuth2Exception'@
|
||||
fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
|
||||
fromAuthJSON name =
|
||||
either (throwIO . YesodOAuth2Exception.JSONDecodingError name) pure
|
||||
. eitherDecode
|
||||
|
||||
-- | A tuple of @\"scope\"@ and the given scopes separated by a delimiter
|
||||
scopeParam :: Text -> [Text] -> (ByteString, ByteString)
|
||||
scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d
|
||||
|
||||
-- brittany-disable-next-binding
|
||||
|
||||
-- | Construct part of @'credsExtra'@
|
||||
--
|
||||
-- Always the following keys:
|
||||
--
|
||||
-- - @accessToken@: to support follow-up requests
|
||||
-- - @userResponse@: to support getting additional information
|
||||
--
|
||||
-- May set the following keys:
|
||||
--
|
||||
-- - @refreshToken@: if the provider supports refreshing the @accessToken@
|
||||
setExtra :: TokenResponse -> BL.ByteString -> [(Text, Text)]
|
||||
setExtra token userResponse =
|
||||
[ ("accessToken", atoken $ accessToken token)
|
||||
, ("userResponse", decodeUtf8 $ BL.toStrict userResponse)
|
||||
]
|
||||
<> maybe [] (pure . ("refreshToken",) . rtoken) (refreshToken token)
|
||||
19
src/Yesod/Auth/OAuth2/Random.hs
Normal file
19
src/Yesod/Auth/OAuth2/Random.hs
Normal file
@ -0,0 +1,19 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.Random
|
||||
( randomText
|
||||
) where
|
||||
|
||||
import Crypto.Random (MonadRandom, getRandomBytes)
|
||||
import Data.ByteArray.Encoding (Base (Base64), convertToBase)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
|
||||
randomText
|
||||
:: MonadRandom m
|
||||
=> Int
|
||||
-- ^ Size in Bytes (not necessarily characters)
|
||||
-> m Text
|
||||
randomText size =
|
||||
decodeUtf8 . convertToBase @ByteString Base64 <$> getRandomBytes size
|
||||
83
src/Yesod/Auth/OAuth2/Salesforce.hs
Normal file
83
src/Yesod/Auth/OAuth2/Salesforce.hs
Normal file
@ -0,0 +1,83 @@
|
||||
{-# 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
|
||||
, oauth2SalesforceSandbox
|
||||
, oauth2SalesforceSandboxScoped
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "user_id"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "salesforce"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["openid", "email", "api"]
|
||||
|
||||
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"
|
||||
|
||||
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"
|
||||
|
||||
salesforceHelper
|
||||
:: YesodAuth m
|
||||
=> Text
|
||||
-> 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
|
||||
(User userId, userResponse) <- authGetProfile name manager token profileUri
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = tokenUri
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
83
src/Yesod/Auth/OAuth2/Slack.hs
Normal file
83
src/Yesod/Auth/OAuth2/Slack.hs
Normal file
@ -0,0 +1,83 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
-- OAuth2 plugin for https://slack.com/
|
||||
--
|
||||
-- * Authenticates against slack
|
||||
-- * Uses slack user id as credentials identifier
|
||||
module Yesod.Auth.OAuth2.Slack
|
||||
( SlackScope (..)
|
||||
, oauth2Slack
|
||||
, oauth2SlackScoped
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import Network.HTTP.Client
|
||||
( httpLbs
|
||||
, parseUrlThrow
|
||||
, responseBody
|
||||
, setQueryString
|
||||
)
|
||||
import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
|
||||
|
||||
data SlackScope
|
||||
= SlackBasicScope
|
||||
| SlackEmailScope
|
||||
| SlackTeamScope
|
||||
| SlackAvatarScope
|
||||
|
||||
scopeText :: SlackScope -> Text
|
||||
scopeText SlackBasicScope = "identity.basic"
|
||||
scopeText SlackEmailScope = "identity.email"
|
||||
scopeText SlackTeamScope = "identity.team"
|
||||
scopeText SlackAvatarScope = "identity.avatar"
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \root -> do
|
||||
o <- root .: "user"
|
||||
User <$> o .: "id"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "slack"
|
||||
|
||||
defaultScopes :: [SlackScope]
|
||||
defaultScopes = [SlackBasicScope]
|
||||
|
||||
oauth2Slack :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
oauth2Slack = oauth2SlackScoped defaultScopes
|
||||
|
||||
oauth2SlackScoped
|
||||
:: YesodAuth m => [SlackScope] -> Text -> Text -> AuthPlugin m
|
||||
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"
|
||||
userResponse <- responseBody <$> httpLbs req manager
|
||||
|
||||
either
|
||||
(throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
|
||||
( \(User userId) ->
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
)
|
||||
$ eitherDecode userResponse
|
||||
where
|
||||
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
|
||||
}
|
||||
46
src/Yesod/Auth/OAuth2/Spotify.hs
Normal file
46
src/Yesod/Auth/OAuth2/Spotify.hs
Normal file
@ -0,0 +1,46 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- |
|
||||
--
|
||||
-- OAuth2 plugin for http://spotify.com
|
||||
module Yesod.Auth.OAuth2.Spotify
|
||||
( oauth2Spotify
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "id"
|
||||
|
||||
pluginName :: Text
|
||||
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"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint =
|
||||
"https://accounts.spotify.com/authorize"
|
||||
`withQuery` [scopeParam " " scopes]
|
||||
, oauth2TokenEndpoint = "https://accounts.spotify.com/api/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
62
src/Yesod/Auth/OAuth2/Twitch.hs
Normal file
62
src/Yesod/Auth/OAuth2/Twitch.hs
Normal file
@ -0,0 +1,62 @@
|
||||
{-# 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
|
||||
) where
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text.Encoding as T
|
||||
|
||||
newtype User = User Text
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \o -> User <$> o .: "user_id"
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "twitch"
|
||||
|
||||
defaultScopes :: [Text]
|
||||
defaultScopes = ["user:read:email"]
|
||||
|
||||
oauth2Twitch :: YesodAuth m => Text -> Text -> AuthPlugin m
|
||||
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"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
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
|
||||
}
|
||||
51
src/Yesod/Auth/OAuth2/Upcase.hs
Normal file
51
src/Yesod/Auth/OAuth2/Upcase.hs
Normal file
@ -0,0 +1,51 @@
|
||||
{-# 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
|
||||
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
newtype User = User Int
|
||||
|
||||
instance FromJSON User where
|
||||
parseJSON = withObject "User" $ \root -> do
|
||||
o <- root .: "user"
|
||||
User <$> o .: "id"
|
||||
|
||||
pluginName :: Text
|
||||
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"
|
||||
|
||||
pure
|
||||
Creds
|
||||
{ credsPlugin = pluginName
|
||||
, credsIdent = T.pack $ show userId
|
||||
, credsExtra = setExtra token userResponse
|
||||
}
|
||||
where
|
||||
oauth2 =
|
||||
OAuth2
|
||||
{ oauth2ClientId = clientId
|
||||
, oauth2ClientSecret = clientSecret
|
||||
, oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize"
|
||||
, oauth2TokenEndpoint = "http://upcase.com/oauth/token"
|
||||
, oauth2RedirectUri = Nothing
|
||||
}
|
||||
50
src/Yesod/Auth/OAuth2/WordPressDotCom.hs
Normal file
50
src/Yesod/Auth/OAuth2/WordPressDotCom.hs
Normal file
@ -0,0 +1,50 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Yesod.Auth.OAuth2.WordPressDotCom
|
||||
( oauth2WordPressDotCom
|
||||
) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Yesod.Auth.OAuth2.Prelude
|
||||
|
||||
pluginName :: Text
|
||||
pluginName = "WordPress.com"
|
||||
|
||||
newtype WpUser = WpUser Int
|
||||
|
||||
instance FromJSON WpUser where
|
||||
parseJSON = withObject "WpUser" $ \o -> WpUser <$> o .: "ID"
|
||||
|
||||
oauth2WordPressDotCom
|
||||
:: 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
|
||||
}
|
||||
where
|
||||
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
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
|
||||
4
stack-nightly.yaml
Normal file
4
stack-nightly.yaml
Normal file
@ -0,0 +1,4 @@
|
||||
resolver: nightly-2026-01-05
|
||||
extra-deps:
|
||||
- cryptonite-0.30
|
||||
- yesod-auth-1.6.11.3
|
||||
@ -1,8 +0,0 @@
|
||||
flags:
|
||||
yesod-auth-oauth2:
|
||||
network-uri: true
|
||||
packages:
|
||||
- '.'
|
||||
resolver: lts-3.5
|
||||
extra-deps:
|
||||
- load-env-0.1.1
|
||||
1
stack.yaml
Symbolic link
1
stack.yaml
Symbolic link
@ -0,0 +1 @@
|
||||
stack-lts24.yaml
|
||||
12
stack.yaml.lock
Normal file
12
stack.yaml.lock
Normal file
@ -0,0 +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/topics/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
sha256: d90eb1418667a225998b173817300e5ae2e1500ed03c0a9457cc2a0e78a0122a
|
||||
size: 726337
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/26.yaml
|
||||
original: lts-24.26
|
||||
80
test/URI/ByteString/ExtensionSpec.hs
Normal file
80
test/URI/ByteString/ExtensionSpec.hs
Normal file
@ -0,0 +1,80 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module URI.ByteString.ExtensionSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
import Control.Exception (ErrorCall, evaluate)
|
||||
import Data.List (isInfixOf)
|
||||
import URI.ByteString
|
||||
import URI.ByteString.Extension
|
||||
import URI.ByteString.QQ
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "IsString Scheme" $ it "works" $ do
|
||||
"https" `shouldBe` Scheme "https"
|
||||
|
||||
describe "IsString Host" $ it "works" $ do
|
||||
"example.com" `shouldBe` Host "example.com"
|
||||
|
||||
describe "IsString URIRef Relative" $ it "works" $ do
|
||||
"example.com/foo?bar=baz" `shouldBe` [relativeRef|example.com/foo?bar=baz|]
|
||||
|
||||
describe "IsString URIRef Absolute" $ it "works" $ do
|
||||
"https://example.com/foo?bar=baz"
|
||||
`shouldBe` [uri|https://example.com/foo?bar=baz|]
|
||||
|
||||
describe "fromText" $ do
|
||||
it "returns Just a URI for valid values, as the quasi-quoter would" $ do
|
||||
fromText "http://example.com/foo?bar=baz"
|
||||
`shouldBe` Just [uri|http://example.com/foo?bar=baz|]
|
||||
|
||||
it "returns Nothing for invalid values" $ do
|
||||
fromText "Oh my, what did I do?" `shouldBe` Nothing
|
||||
|
||||
describe "unsafeFromText" $ do
|
||||
it "returns a URI for valid values, as the quasi-quoter would" $ do
|
||||
unsafeFromText "http://example.com/foo?bar=baz"
|
||||
`shouldBe` [uri|http://example.com/foo?bar=baz|]
|
||||
|
||||
it "raises for invalid values" $ do
|
||||
evaluate (unsafeFromText "Oh my, what did I do?")
|
||||
`shouldThrow` errorContaining "MissingColon"
|
||||
|
||||
describe "toText" $ do
|
||||
it "serializes the URI to text" $ do
|
||||
toText [uri|https://example.com/foo?bar=baz|]
|
||||
`shouldBe` "https://example.com/foo?bar=baz"
|
||||
|
||||
describe "fromRelative" $ do
|
||||
it "makes a URI absolute with a given host" $ do
|
||||
fromRelative "ftp" "foo.com" [relativeRef|/bar?baz=bat|]
|
||||
`shouldBe` [uri|ftp://foo.com/bar?baz=bat|]
|
||||
|
||||
describe "withQuery" $ do
|
||||
it "appends a query to a URI" $ do
|
||||
let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar")]
|
||||
|
||||
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")]
|
||||
|
||||
uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|]
|
||||
|
||||
-- This is arguably testing the internals of another package, but IMO
|
||||
-- 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")]
|
||||
|
||||
toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz"
|
||||
|
||||
errorContaining :: String -> Selector ErrorCall
|
||||
errorContaining msg = (msg `isInfixOf`) . show
|
||||
@ -1,15 +0,0 @@
|
||||
module Yesod.Auth.OAuth2Spec
|
||||
( main
|
||||
, spec
|
||||
) where
|
||||
|
||||
import Test.Hspec
|
||||
import Yesod.Auth.OAuth2
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "authOAuth2" $
|
||||
it "works" $
|
||||
True `shouldBe` True
|
||||
@ -1,86 +1,131 @@
|
||||
name: yesod-auth-oauth2
|
||||
version: 0.1.9
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Tom Streller
|
||||
maintainer: Pat Brisbin <pat@thoughtbot.com>
|
||||
synopsis: OAuth 2.0 authentication plugins
|
||||
description: Library to authenticate with OAuth 2.0 for Yesod web applications.
|
||||
category: Web
|
||||
stability: Experimental
|
||||
cabal-version: >= 1.8
|
||||
build-type: Simple
|
||||
homepage: http://github.com/thoughtbot/yesod-auth-oauth2
|
||||
cabal-version: 1.18
|
||||
|
||||
flag network-uri
|
||||
description: Get Network.URI from the network-uri package
|
||||
default: True
|
||||
-- This file has been generated from package.yaml by hpack version 0.38.1.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: d595b9569ed34feddc8c41cf6f1f8cabbd8a37fa14b6afeeb24ad651ca689011
|
||||
|
||||
name: yesod-auth-oauth2
|
||||
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
|
||||
homepage: http://github.com/freckle/yesod-auth-oauth2
|
||||
bug-reports: https://github.com/freckle/yesod-auth-oauth2/issues
|
||||
author: Tom Streller,
|
||||
Patrick Brisbin,
|
||||
Freckle Engineering
|
||||
maintainer: engineering@freckle.com
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
extra-doc-files:
|
||||
README.md
|
||||
CHANGELOG.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/freckle/yesod-auth-oauth2
|
||||
|
||||
flag example
|
||||
description: Build the example application
|
||||
manual: False
|
||||
default: False
|
||||
|
||||
library
|
||||
if flag(network-uri)
|
||||
build-depends: network-uri >= 2.6
|
||||
else
|
||||
build-depends: network < 2.6
|
||||
|
||||
build-depends: base >= 4.5 && < 5
|
||||
, bytestring >= 0.9.1.4
|
||||
, http-client >= 0.4.0 && < 0.5
|
||||
, http-conduit >= 2.0 && < 3.0
|
||||
, http-types >= 0.8 && < 0.10
|
||||
, aeson >= 0.6 && < 0.12
|
||||
, yesod-core >= 1.2 && < 1.5
|
||||
, authenticate >= 1.3.2.7 && < 1.4
|
||||
, random
|
||||
, yesod-auth >= 1.3 && < 1.5
|
||||
, text >= 0.7 && < 2.0
|
||||
, yesod-form >= 1.3 && < 1.5
|
||||
, transformers >= 0.2.2 && < 0.6
|
||||
, hoauth2 >= 0.4.7 && < 0.6
|
||||
, lifted-base >= 0.2 && < 0.4
|
||||
, vector >= 0.10 && < 0.12
|
||||
|
||||
exposed-modules: Yesod.Auth.OAuth2
|
||||
Yesod.Auth.OAuth2.Github
|
||||
Yesod.Auth.OAuth2.Google
|
||||
Yesod.Auth.OAuth2.Spotify
|
||||
Yesod.Auth.OAuth2.Upcase
|
||||
Yesod.Auth.OAuth2.EveOnline
|
||||
Yesod.Auth.OAuth2.Nylas
|
||||
|
||||
ghc-options: -Wall
|
||||
exposed-modules:
|
||||
Network.OAuth.OAuth2.Compat
|
||||
UnliftIO.Except
|
||||
URI.ByteString.Extension
|
||||
Yesod.Auth.OAuth2
|
||||
Yesod.Auth.OAuth2.Auth0
|
||||
Yesod.Auth.OAuth2.AzureAD
|
||||
Yesod.Auth.OAuth2.AzureADv2
|
||||
Yesod.Auth.OAuth2.BattleNet
|
||||
Yesod.Auth.OAuth2.Bitbucket
|
||||
Yesod.Auth.OAuth2.ClassLink
|
||||
Yesod.Auth.OAuth2.Dispatch
|
||||
Yesod.Auth.OAuth2.DispatchError
|
||||
Yesod.Auth.OAuth2.ErrorResponse
|
||||
Yesod.Auth.OAuth2.EveOnline
|
||||
Yesod.Auth.OAuth2.Exception
|
||||
Yesod.Auth.OAuth2.GitHub
|
||||
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
|
||||
Yesod.Auth.OAuth2.Slack
|
||||
Yesod.Auth.OAuth2.Spotify
|
||||
Yesod.Auth.OAuth2.Twitch
|
||||
Yesod.Auth.OAuth2.Upcase
|
||||
Yesod.Auth.OAuth2.WordPressDotCom
|
||||
other-modules:
|
||||
Paths_yesod_auth_oauth2
|
||||
hs-source-dirs:
|
||||
src
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
aeson >=0.6
|
||||
, base >=4.9.0.0 && <5
|
||||
, bytestring >=0.9.1.4
|
||||
, crypton
|
||||
, errors
|
||||
, hoauth2 >=2.8.0
|
||||
, http-client >=0.4.0
|
||||
, http-conduit >=2.0
|
||||
, http-types >=0.8
|
||||
, memory
|
||||
, microlens
|
||||
, mtl
|
||||
, safe-exceptions
|
||||
, text >=0.7
|
||||
, transformers
|
||||
, unliftio
|
||||
, uri-bytestring
|
||||
, yesod-auth >=1.6.0
|
||||
, yesod-core >=1.6.0
|
||||
default-language: Haskell2010
|
||||
|
||||
executable yesod-auth-oauth2-example
|
||||
if flag(example)
|
||||
buildable: True
|
||||
else
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Paths_yesod_auth_oauth2
|
||||
hs-source-dirs:
|
||||
example
|
||||
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
aeson >=0.6
|
||||
, aeson-pretty
|
||||
, base >=4.9.0.0 && <5
|
||||
, bytestring >=0.9.1.4
|
||||
, containers >=0.6.0.1
|
||||
, http-conduit >=2.0
|
||||
, load-env
|
||||
, text >=0.7
|
||||
, warp
|
||||
, yesod
|
||||
, yesod-auth >=1.6.0
|
||||
, yesod-auth-oauth2
|
||||
default-language: Haskell2010
|
||||
if !(flag(example))
|
||||
buildable: False
|
||||
|
||||
hs-source-dirs: example
|
||||
main-is: main.hs
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends: base
|
||||
, containers
|
||||
, http-conduit
|
||||
, load-env
|
||||
, text
|
||||
, warp
|
||||
, yesod
|
||||
, yesod-auth
|
||||
, yesod-auth-oauth2
|
||||
|
||||
test-suite test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
hs-source-dirs: test
|
||||
ghc-options: -Wall
|
||||
build-depends: base
|
||||
, yesod-auth-oauth2
|
||||
, hspec
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/thoughtbot/yesod-auth-oauth2.git
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
URI.ByteString.ExtensionSpec
|
||||
Paths_yesod_auth_oauth2
|
||||
hs-source-dirs:
|
||||
test
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
base >=4.9.0.0 && <5
|
||||
, hspec
|
||||
, uri-bytestring
|
||||
, yesod-auth-oauth2
|
||||
default-language: Haskell2010
|
||||
|
||||
Loading…
Reference in New Issue
Block a user