Fix STACK_YAML in release

We removed some resolvers, so we need to update the minimum that's used
here.

.env.example

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

.github/CODEOWNERS

@@ -0,0 +1 @@
+* @freckle/backenders

.github/workflows/add-asana-comment.yml.bak

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

.github/workflows/ci.yml

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

.github/workflows/release.yml

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

.gitignore

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

.hlint.yaml

@@ -0,0 +1,8 @@
+---
+- ignore:
+    # https://github.com/ndmitchell/hlint/issues/427
+    name: Eta reduce
+    within: authOAuth2
+- ignore:
+    name: Redundant do
+    within: spec

.restyled.yaml

@@ -0,0 +1,4 @@
+restylers:
+  - fourmolu
+  - "!stylish-haskell"
+  - "*"

.stack-all

@@ -0,0 +1,2 @@
+[versions]
+oldest = lts-21

CHANGELOG.md

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

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.

Makefile

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

README.md

@@ -1,19 +1,22 @@
 # Yesod.Auth.OAuth2
 
+[![Hackage](https://img.shields.io/hackage/v/yesod-auth-oauth2.svg?style=flat)](https://hackage.haskell.org/package/yesod-auth-oauth2)
+[![Stackage Nightly](http://stackage.org/package/yesod-auth-oauth2/badge/nightly)](http://stackage.org/nightly/package/yesod-auth-oauth2)
+[![Stackage LTS](http://stackage.org/package/yesod-auth-oauth2/badge/lts)](http://stackage.org/lts/package/yesod-auth-oauth2)
+[![CI](https://github.com/freckle/yesod-auth-oauth2/actions/workflows/ci.yml/badge.svg)](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 = "..."
@@ -25,53 +28,115 @@ clientSecret = "..."
 Some plugins, such as GitHub and Slack, have scoped functions for requesting
 additional information:
 
-```haskell
-import Yesod.Auth
-import Yesod.Auth.OAuth2.Slack
-
-instance YesodAuth App where
-    -- ...
-
-    authPlugins _ =
-        [oauth2SlackScoped clientId clientSecret slackScopes]
-      where
-        slackScopes = [SlackEmailScope, SlackAvatarScope, SlackTeamScope]
-
-clientId :: Text
-clientId = "..."
-
-clientSecret :: Text
-clientSecret = "..."
+```hs
+oauth2SlackScoped [SlackBasicScope, SlackEmailScope] clientId clientSecret
 ```
 
-## Advanced Usage
+## Working with Extra Data
 
-To use any other provider:
+We put the minimal amount of user data possible in `credsExtra` -- just enough
+to support you parsing or fetching additional data yourself.
 
-```haskell
-import Yesod.Auth
-import Yesod.Auth.OAuth2
+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:
 
-instance YesodAuth App where
-    -- ...
+```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
 
-    authPlugins _ = [myPlugin]
+        -- Avert your eyes, simplified example
+        Just accessToken = getAccessToken creds
+        Right githubUser = eGitHubUser
 
-myPlugin :: AuthPlugin m
-myPlugin = authOAuth2 "mysite"
-    (OAuth2
-        { oauthClientId            = "..."
-        , oauthClientSecret        = "..."
-        , oauthOAuthorizeEndpoint  = "https://mysite.com/oauth/authorize"
-        , oauthAccessTokenEndpoint = "https://mysite.com/oauth/token"
-        , oauthCallback            = Nothing
-        })
-    makeCredentials
+    -- Or make followup requests using our access token
+    runGitHub accessToken $ userRepositories githubUser
 
-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)
+    -- Or store it for later
+    insert User
+        { userIdent = credsIdent creds
+        , userAccessToken = accessToken
+        }
 ```
 
-*If you write one of these, please consider opening a Pull Request*
+**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)

Yesod/Auth/OAuth2.hs

@@ -1,158 +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(..)
-    , maybeExtra
-    , 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
-
--- | A helper for providing an optional value to credsExtra
---
-maybeExtra :: Text -> Maybe Text -> [(Text, Text)]
-maybeExtra k (Just v) = [(k, v)]
-maybeExtra _ Nothing  = []

Yesod/Auth/OAuth2/BattleNet.hs

@@ -1,80 +0,0 @@
-{-# LANGUAGE CPP               #-}
-{-# 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 )
-  where
-
-#if __GLASGOW_HASKELL__ < 710
-import           Control.Applicative  ((<$>), (<*>))
-#endif
-
-import           Control.Exception    (throwIO)
-import           Control.Monad        (mzero)
-
-import           Yesod.Auth
-import           Yesod.Auth.OAuth2
-
-import           Data.Monoid          ((<>))
-import           Network.HTTP.Conduit (Manager)
-
-import           Data.Aeson
-import           Data.Text            (Text)
-import qualified Data.Text            as T (pack, toLower)
-import qualified Data.Text.Encoding   as E (encodeUtf8)
-import           Prelude
-import           Yesod.Core.Widget
-
-data BattleNetUser = BattleNetUser
-              { userId    :: Int
-              , battleTag :: Text
-              }
-
-instance FromJSON BattleNetUser where
-  parseJSON (Object o) = BattleNetUser
-                           <$> o .: "id"
-                           <*> o .: "battletag"
-  parseJSON _ = mzero
-
-oAuth2BattleNet :: YesodAuth m
-                => Text -- ^ Client ID
-                -> Text -- ^ Client Secret
-                -> Text -- ^ User region (e.g. "eu", "cn", "us")
-                -> WidgetT m IO () -- ^ Login widget
-                -> AuthPlugin m
-oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData (makeCredentials region)
-  where oAuthData = OAuth2 { oauthClientId            = E.encodeUtf8 clientId
-                           , oauthClientSecret        = E.encodeUtf8 clientSecret
-                           , oauthOAuthorizeEndpoint  = E.encodeUtf8 ("https://" <> host <> "/oauth/authorize")
-                           , oauthAccessTokenEndpoint = E.encodeUtf8 ("https://" <> host <> "/oauth/token")
-                           , oauthCallback            = Nothing
-                           }
-        host = let r = T.toLower region in
-                 case r of
-                   "cn" -> "www.battlenet.com.cn"
-                   _    -> r <> ".battle.net"
-
-makeCredentials :: Text -> Manager -> AccessToken -> IO (Creds m)
-makeCredentials region manager token = do
-    userResult <- authGetJSON manager token ("https://" <> host <> "/account/user") :: IO (OAuth2Result BattleNetUser)
-    case userResult of
-         Left err -> throwIO $ InvalidProfileResponse "battle.net" err
-         Right user -> return Creds
-           { credsPlugin = "battle.net"
-           , credsIdent  = T.pack $ show $ userId user
-           , credsExtra  = [("battletag", battleTag user)]
-           }
-  where host :: URI
-        host = let r = T.toLower region in
-                 case r of
-                   "cn" -> "api.battlenet.com.cn"
-                   _    -> E.encodeUtf8 r <> ".api.battle.net"

Yesod/Auth/OAuth2/Bitbucket.hs

@@ -1,141 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
--- |
---
--- OAuth2 plugin for http://bitbucket.com
---
--- * Authenticates against bitbucket
--- * Uses bitbucket uuid as credentials identifier
--- * Returns email, username, full name, location and avatar as extras
---
-module Yesod.Auth.OAuth2.Bitbucket
-    ( oauth2Bitbucket
-    , oauth2BitbucketScoped
-    , module Yesod.Auth.OAuth2
-    ) where
-
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception.Lifted (throwIO)
-import Control.Monad (mzero)
-import Data.Aeson (FromJSON, Value(Object), parseJSON, (.:), (.:?))
-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 (YesodAuth, Creds(..), AuthPlugin)
-import Yesod.Auth.OAuth2 (AccessToken, YesodOAuth2Exception(InvalidProfileResponse), OAuth2(..), authOAuth2, maybeExtra, accessToken, authGetJSON)
-
-import qualified Data.Text as T
-
-data BitbucketUser = BitbucketUser
-    { bitbucketUserId :: Text
-    , bitbucketUserName :: Maybe Text
-    , bitbucketUserLogin :: Text
-    , bitbucketUserLocation :: Maybe Text
-    , bitbucketUserLinks :: BitbucketUserLinks
-    }
-
-instance FromJSON BitbucketUser where
-    parseJSON (Object o) = BitbucketUser
-        <$> o .: "uuid"
-        <*> o .:? "display_name"
-        <*> o .: "username"
-        <*> o .:? "location"
-        <*> o .: "links"
-
-    parseJSON _ = mzero
-
-newtype BitbucketUserLinks = BitbucketUserLinks
-    { bitbucketAvatarLink :: BitbucketLink
-    }
-
-instance FromJSON BitbucketUserLinks where
-    parseJSON (Object o) = BitbucketUserLinks
-        <$> o .: "avatar"
-
-    parseJSON _ = mzero
-
-newtype BitbucketLink = BitbucketLink
-    { bitbucketLinkHref :: Text
-    }
-
-instance FromJSON BitbucketLink where
-    parseJSON (Object o) = BitbucketLink
-        <$> o .: "href"
-
-    parseJSON _ = mzero
-
-newtype BitbucketEmailSearchResults = BitbucketEmailSearchResults
-    { bitbucketEmails :: [BitbucketUserEmail]
-    }
-
-instance FromJSON BitbucketEmailSearchResults where
-    parseJSON (Object o) = BitbucketEmailSearchResults
-        <$> o .: "values"
-
-    parseJSON _ = mzero
-
-data BitbucketUserEmail = BitbucketUserEmail
-    { bitbucketUserEmailAddress :: Text
-    , bitbucketUserEmailPrimary :: Bool
-    }
-
-instance FromJSON BitbucketUserEmail where
-    parseJSON (Object o) = BitbucketUserEmail
-        <$> o .: "email"
-        <*> o .: "is_primary"
-
-    parseJSON _ = mzero
-
-oauth2Bitbucket :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> AuthPlugin m
-oauth2Bitbucket clientId clientSecret = oauth2BitbucketScoped clientId clientSecret ["account"]
-
-oauth2BitbucketScoped :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> [Text] -- ^ List of scopes to request
-             -> AuthPlugin m
-oauth2BitbucketScoped clientId clientSecret scopes = authOAuth2 "bitbucket" oauth fetchBitbucketProfile
-  where
-    oauth = OAuth2
-        { oauthClientId = encodeUtf8 clientId
-        , oauthClientSecret = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://bitbucket.com/site/oauth2/authorize?scope=" <> T.intercalate "," scopes
-        , oauthAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
-        , oauthCallback = Nothing
-        }
-
-fetchBitbucketProfile :: Manager -> AccessToken -> IO (Creds m)
-fetchBitbucketProfile manager token = do
-    userResult <- authGetJSON manager token "https://api.bitbucket.com/2.0/user"
-    mailResult <- authGetJSON manager token "https://api.bitbucket.com/2.0/user/emails"
-
-    case (userResult, mailResult) of
-        (Right user, Right mails) -> return $ toCreds user (bitbucketEmails mails) token
-        (Left err, _) -> throwIO $ InvalidProfileResponse "bitbucket" err
-        (_, Left err) -> throwIO $ InvalidProfileResponse "bitbucket" err
-
-toCreds :: BitbucketUser -> [BitbucketUserEmail] -> AccessToken -> Creds m
-toCreds user userMails token = Creds
-    { credsPlugin = "bitbucket"
-    , credsIdent = T.pack $ show $ bitbucketUserId user
-    , credsExtra =
-        [ ("email", bitbucketUserEmailAddress email)
-        , ("login", bitbucketUserLogin user)
-        , ("avatar_url", bitbucketLinkHref (bitbucketAvatarLink (bitbucketUserLinks user)))
-        , ("access_token", decodeUtf8 $ accessToken token)
-        ]
-        ++ maybeExtra "name" (bitbucketUserName user)
-        ++ maybeExtra "location" (bitbucketUserLocation user)
-    }
-
-  where
-    email = fromMaybe (head userMails) $ find bitbucketUserEmailPrimary userMails

Yesod/Auth/OAuth2/EveOnline.hs

@@ -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)
-        ]
-    }

Yesod/Auth/OAuth2/Github.hs

@@ -1,115 +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 :: Maybe 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)
-        , ("access_token", decodeUtf8 $ accessToken token)
-        ]
-        ++ maybeExtra "name" (githubUserName user)
-        ++ maybeExtra "public_email" (githubUserPublicEmail user)
-        ++ maybeExtra "location" (githubUserLocation user)
-    }
-
-  where
-    email = fromMaybe (head userMails) $ find githubUserEmailPrimary userMails

Yesod/Auth/OAuth2/Google.hs

@@ -1,139 +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.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)
-        ]
-        ++ maybeExtra "hosted_domain" (googleUserHostedDomain user)
-    }

Yesod/Auth/OAuth2/Nylas.hs

@@ -1,87 +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, httpLbs, parseRequest, responseBody,
-                            responseStatus)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth (Creds(..), YesodAuth, AuthPlugin)
-import Yesod.Auth.OAuth2 (OAuth2(..), AccessToken(..),
-                          YesodOAuth2Exception(InvalidProfileResponse),
-                          authOAuth2)
-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 clientId clientSecret = authOAuth2 "nylas" oauth fetchCreds
-  where
-    authorizeUrl = encodeUtf8 $ "https://api.nylas.com/oauth/authorize" <>
-        "?response_type=code&scope=email&client_id=" <> clientId
-
-    oauth = OAuth2
-        { oauthClientId = encodeUtf8 clientId
-        , oauthClientSecret = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint = authorizeUrl
-        , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token"
-        , oauthCallback = Nothing
-        }
-
-fetchCreds :: Manager -> AccessToken -> IO (Creds a)
-fetchCreds manager token = do
-    req <- authorize <$> parseRequest "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)
-        ]
-    }

Yesod/Auth/OAuth2/Salesforce.hs

@@ -1,152 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
--- |
---
--- OAuth2 plugin for http://login.salesforce.com
---
--- * Authenticates against Salesforce
--- * Uses Salesforce user id as credentials identifier
--- * Returns given_name, family_name, email and avatar_url as extras
---
-module Yesod.Auth.OAuth2.Salesforce
-    ( oauth2Salesforce
-    , oauth2SalesforceScoped
-    , oauth2SalesforceSandbox
-    , oauth2SalesforceSandboxScoped
-    , 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 qualified Data.Text as T
-
-oauth2Salesforce :: YesodAuth m
-                 => Text -- ^ Client ID
-                 -> Text -- ^ Client Secret
-                 -> AuthPlugin m
-oauth2Salesforce = oauth2SalesforceScoped ["openid", "email", "api"]
-
-svcName :: Text
-svcName = "salesforce"
-
-oauth2SalesforceScoped :: YesodAuth m
-                       => [Text] -- ^ List of scopes to request
-                       -> Text -- ^ Client ID
-                       -> Text -- ^ Client Secret
-                       -> AuthPlugin m
-oauth2SalesforceScoped scopes clientId clientSecret =
-    authOAuth2 svcName oauth fetchSalesforceUser
-  where
-    oauth = OAuth2
-        { oauthClientId            = encodeUtf8 clientId
-        , oauthClientSecret        = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint  = encodeUtf8 $ "https://login.salesforce.com/services/oauth2/authorize?scope=" <> T.intercalate " " scopes
-        , oauthAccessTokenEndpoint = "https://login.salesforce.com/services/oauth2/token"
-        , oauthCallback            = Nothing
-        }
-
-fetchSalesforceUser :: Manager -> AccessToken -> IO (Creds m)
-fetchSalesforceUser manager token = do
-    result <- authGetJSON manager token "https://login.salesforce.com/services/oauth2/userinfo"
-    case result of
-        Right user -> return $ toCreds svcName user token
-        Left err -> throwIO $ InvalidProfileResponse svcName err
-
-svcNameSb :: Text
-svcNameSb = "salesforce-sandbox"
-
-oauth2SalesforceSandbox :: YesodAuth m
-                        => Text -- ^ Client ID
-                        -> Text -- ^ Client Secret
-                        -> AuthPlugin m
-oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped ["openid", "email"]
-
-
-oauth2SalesforceSandboxScoped :: YesodAuth m
-                              => [Text] -- ^ List of scopes to request
-                              -> Text -- ^ Client ID
-                              -> Text -- ^ Client Secret
-                              -> AuthPlugin m
-oauth2SalesforceSandboxScoped scopes clientId clientSecret =
-    authOAuth2 svcNameSb oauth fetchSalesforceSandboxUser
-  where
-    oauth = OAuth2
-        { oauthClientId            = encodeUtf8 clientId
-        , oauthClientSecret        = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint  = encodeUtf8 $ "https://test.salesforce.com/services/oauth2/authorize?scope=" <> T.intercalate " " scopes
-        , oauthAccessTokenEndpoint = "https://test.salesforce.com/services/oauth2/token"
-        , oauthCallback            = Nothing
-        }
-
-fetchSalesforceSandboxUser :: Manager -> AccessToken -> IO (Creds m)
-fetchSalesforceSandboxUser manager token = do
-    result <- authGetJSON manager token "https://test.salesforce.com/services/oauth2/userinfo"
-    case result of
-        Right user -> return $ toCreds svcNameSb user token
-        Left err -> throwIO $ InvalidProfileResponse svcNameSb err
-
-data User = User
-    { userId :: Text
-    , userOrg :: Text
-    , userNickname :: Text
-    , userName :: Text
-    , userGivenName :: Text
-    , userFamilyName :: Text
-    , userTimeZone :: Text
-    , userEmail :: Text
-    , userPicture :: Text
-    , userPhone :: Maybe Text
-    , userRestUrl :: Text
-    }
-
-instance FromJSON User where
-    parseJSON (Object o) = do
-        userId          <- o .: "user_id"
-        userOrg         <- o .: "organization_id"
-        userNickname    <- o .: "nickname"
-        userName        <- o .: "name"
-        userGivenName   <- o .: "given_name"
-        userFamilyName  <- o .: "family_name"
-        userTimeZone    <- o .: "zoneinfo"
-        userEmail       <- o .: "email"
-        userPicture     <- o .: "picture"
-        userPhone       <- o .:? "phone_number"
-        urls            <- o .: "urls"
-        userRestUrl     <- urls .: "rest"
-        return User{..}
-
-    parseJSON _ = mzero
-
-toCreds :: Text -> User -> AccessToken -> Creds m
-toCreds name user token = Creds
-    { credsPlugin = name
-    , credsIdent = userId user
-    , credsExtra =
-        [ ("email", userEmail user)
-        , ("org", userOrg user)
-        , ("nickname", userName user)
-        , ("name", userName user)
-        , ("given_name", userGivenName user)
-        , ("family_name", userFamilyName user)
-        , ("time_zone", userTimeZone user)
-        , ("avatar_url", userPicture user)
-        , ("rest_url", userRestUrl user)
-        , ("access_token", decodeUtf8 $ accessToken token)
-        ]
-        ++ maybeExtra "refresh_token" (decodeUtf8 <$> refreshToken token)
-        ++ maybeExtra "expires_in" ((T.pack . show) <$> expiresIn token)
-        ++ maybeExtra "phone_number" (userPhone user)
-    }

Yesod/Auth/OAuth2/Slack.hs

@@ -1,127 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
--- |
--- OAuth2 plugin for https://slack.com/
---
--- * Authenticates against slack
--- * Uses slack user id as credentials identifier
--- * Returns name, access_token, email, avatar, team_id, and team_name as extras
---
-module Yesod.Auth.OAuth2.Slack
-    ( SlackScope(..)
-    , oauth2Slack
-    , oauth2SlackScoped
-    ) where
-
-import Data.Aeson
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-
-import Control.Exception.Lifted (throwIO)
-import Data.Maybe (catMaybes)
-import Data.Monoid ((<>))
-import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-import Network.HTTP.Conduit (Manager)
-
-import qualified Data.Text as Text
-import qualified Network.HTTP.Conduit as HTTP
-
-data SlackScope
-    = SlackEmailScope
-    | SlackTeamScope
-    | SlackAvatarScope
-
-data SlackUser = SlackUser
-    { slackUserId :: Text
-    , slackUserName :: Text
-    , slackUserEmail :: Maybe Text
-    , slackUserAvatarUrl :: Maybe Text
-    , slackUserTeam :: Maybe SlackTeam
-    }
-
-data SlackTeam = SlackTeam
-    { slackTeamId :: Text
-    , slackTeamName :: Text
-    }
-
-instance FromJSON SlackUser where
-    parseJSON = withObject "root" $ \root -> do
-        user <- root .: "user"
-
-        SlackUser
-            <$> user .: "id"
-            <*> user .: "name"
-            <*> user .:? "email"
-            <*> user .:? "image_512"
-            <*> root .:? "team"
-
-instance FromJSON SlackTeam where
-    parseJSON = withObject "team" $ \team ->
-        SlackTeam
-            <$> team .: "id"
-            <*> team .: "name"
-
--- | Auth with Slack
---
--- Requests @identity.basic@ scopes and uses the user's Slack ID as the @'Creds'@
--- identifier.
---
-oauth2Slack :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> AuthPlugin m
-oauth2Slack clientId clientSecret = oauth2SlackScoped clientId clientSecret []
-
--- | Auth with Slack
---
--- Requests custom scopes and uses the user's Slack ID as the @'Creds'@
--- identifier.
---
-oauth2SlackScoped :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> [SlackScope]
-             -> AuthPlugin m
-oauth2SlackScoped clientId clientSecret scopes =
-    authOAuth2 "slack" oauth fetchSlackProfile
-  where
-    oauth = OAuth2
-        { oauthClientId = encodeUtf8 clientId
-        , oauthClientSecret = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint =
-            encodeUtf8
-            $ "https://slack.com/oauth/authorize?scope="
-            <> Text.intercalate "," scopeTexts
-        , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
-        , oauthCallback = Nothing
-        }
-    scopeTexts = "identity.basic":map scopeText scopes
-
-scopeText :: SlackScope -> Text
-scopeText SlackEmailScope = "identity.email"
-scopeText SlackTeamScope = "identity.team"
-scopeText SlackAvatarScope = "identity.avatar"
-
-fetchSlackProfile :: Manager -> AccessToken -> IO (Creds m)
-fetchSlackProfile manager token = do
-    request
-        <- HTTP.setQueryString [("token", Just $ accessToken token)]
-        <$> HTTP.parseUrl "https://slack.com/api/users.identity"
-    body <- HTTP.responseBody <$> HTTP.httpLbs request manager
-    case eitherDecode body of
-        Left _ -> throwIO $ InvalidProfileResponse "slack" body
-        Right u -> return $ toCreds u token
-
-toCreds :: SlackUser -> AccessToken -> Creds m
-toCreds user token = Creds
-    { credsPlugin = "slack"
-    , credsIdent = slackUserId user
-    , credsExtra = catMaybes
-        [ Just ("name", slackUserName user)
-        , Just ("access_token", decodeUtf8 $ accessToken token)
-        , (,) <$> pure "email" <*> slackUserEmail user
-        , (,) <$> pure "avatar" <*> slackUserAvatarUrl user
-        , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user)
-        , (,) <$> pure "team_id" <*> (slackTeamId <$> slackUserTeam user)
-        ]
-    }

Yesod/Auth/OAuth2/Spotify.hs

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

Yesod/Auth/OAuth2/Upcase.hs

@@ -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
-
-newtype 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)
-            ]
-        }

circle.yml

@@ -1,14 +0,0 @@
-dependencies:
-  cache_directories:
-    - "~/.stack"
-  pre:
-    - wget https://github.com/commercialhaskell/stack/releases/download/v1.4.0/stack-1.4.0-linux-x86_64.tar.gz -O /tmp/stack.tar.gz
-    - tar xvzOf /tmp/stack.tar.gz stack-1.4.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

example/Main.hs

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

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

fourmolu.yaml

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

package.yaml

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

renovate.json

@@ -0,0 +1,7 @@
+{
+  "$schema": "https://docs.renovatebot.com/renovate-schema.json",
+  "extends": [
+    "local>freckle/renovate-config"
+  ],
+  "minimumReleaseAge": "0 days"
+}

src/Network/OAuth/OAuth2/Compat.hs

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

src/URI/ByteString/Extension.hs

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

src/UnliftIO/Except.hs

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

src/Yesod/Auth/OAuth2.hs

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

src/Yesod/Auth/OAuth2/Auth0.hs

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

src/Yesod/Auth/OAuth2/AzureAD.hs

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

src/Yesod/Auth/OAuth2/AzureADv2.hs

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

src/Yesod/Auth/OAuth2/BattleNet.hs

@@ -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" #-}

src/Yesod/Auth/OAuth2/Bitbucket.hs

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

src/Yesod/Auth/OAuth2/ClassLink.hs

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

src/Yesod/Auth/OAuth2/Dispatch.hs

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

src/Yesod/Auth/OAuth2/DispatchError.hs

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

src/Yesod/Auth/OAuth2/ErrorResponse.hs

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

src/Yesod/Auth/OAuth2/EveOnline.hs

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

src/Yesod/Auth/OAuth2/Exception.hs

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

src/Yesod/Auth/OAuth2/GitHub.hs

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

src/Yesod/Auth/OAuth2/GitLab.hs

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

src/Yesod/Auth/OAuth2/Google.hs

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

src/Yesod/Auth/OAuth2/Nylas.hs

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

src/Yesod/Auth/OAuth2/ORCID.hs

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

src/Yesod/Auth/OAuth2/Prelude.hs

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

src/Yesod/Auth/OAuth2/Random.hs

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

src/Yesod/Auth/OAuth2/Salesforce.hs

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

src/Yesod/Auth/OAuth2/Slack.hs

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

src/Yesod/Auth/OAuth2/Spotify.hs

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

src/Yesod/Auth/OAuth2/Twitch.hs

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

src/Yesod/Auth/OAuth2/Upcase.hs

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

src/Yesod/Auth/OAuth2/WordPressDotCom.hs

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

stack-lts21.yaml

@@ -0,0 +1 @@
+resolver: lts-21.25

stack-lts22.yaml

@@ -0,0 +1 @@
+resolver: lts-22.44

stack-lts23.yaml

@@ -0,0 +1 @@
+resolver: lts-23.28

stack-lts24.yaml

@@ -0,0 +1 @@
+resolver: lts-24.26

stack-nightly.yaml

@@ -0,0 +1,4 @@
+resolver: nightly-2026-01-05
+extra-deps:
+  - cryptonite-0.30
+  - yesod-auth-1.6.11.3

stack.yaml

@@ -1,8 +0,0 @@
-flags:
-  yesod-auth-oauth2:
-    network-uri: true
-packages:
-- '.'
-resolver: lts-8.23
-extra-deps:
-- load-env-0.1.1

stack.yaml

@@ -0,0 +1 @@
+stack-lts24.yaml

stack.yaml.lock

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

test/URI/ByteString/ExtensionSpec.hs

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

test/Yesod/Auth/OAuth2Spec.hs

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

yesod-auth-oauth2.cabal

@@ -1,90 +1,131 @@
-name:            yesod-auth-oauth2
-version:         0.2.4
-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.6
-                   , http-conduit            >= 2.0       && < 3.0
-                   , http-types              >= 0.8       && < 0.10
-                   , aeson                   >= 0.6       && < 1.1
-                   , 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
-                     Yesod.Auth.OAuth2.Slack
-                     Yesod.Auth.OAuth2.Salesforce
-                     Yesod.Auth.OAuth2.Bitbucket
-                     Yesod.Auth.OAuth2.BattleNet
-
-    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