.env.example

@@ -1,61 +0,0 @@
-# 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

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

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

@@ -1,16 +0,0 @@
-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

@@ -1,49 +0,0 @@
-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

@@ -1,22 +0,0 @@
-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,12 +1,3 @@
-.stack-work
+*.cabal
-TAGS
-
-# OAuth keys configuration for the example
 .env*
-!.env.example
+.stack-work
-
-# Created when running the example
-client_session_key.aes
-
-# Used by stack test --rerun
-TESTREPORT

.hlint.yaml

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

.restyled.yaml

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

.stack-all

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

CHANGELOG.md

@@ -1,352 +0,0 @@
-## [_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,21 +1,25 @@
-The MIT License (MIT)
+The following license covers this documentation, and the source code, except
+where otherwise indicated.
 
-Copyright (c) 2021 Renaissance Learning Inc
+Copyright 2008, Michael Snoyman. All rights reserved.
 
-Permission is hereby granted, free of charge, to any person obtaining a copy
+Redistribution and use in source and binary forms, with or without
-of this software and associated documentation files (the "Software"), to deal
+modification, are permitted provided that the following conditions are met:
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
 
-The above copyright notice and this permission notice shall be included in all
+* Redistributions of source code must retain the above copyright notice, this
-copies or substantial portions of the Software.
+  list of conditions and the following disclaimer.
 
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* Redistributions in binary form must reproduce the above copyright notice,
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+  this list of conditions and the following disclaimer in the documentation
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+  and/or other materials provided with the distribution.
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-SOFTWARE.
+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.

Makefile

@@ -1,60 +0,0 @@
-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,22 +1,19 @@
 # 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.
 
-## Usage
+## Basic Usage
 
-```hs
+To use one of the supported providers:
+
+```haskell
 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 = "..."
@@ -28,115 +25,53 @@ clientSecret = "..."
 Some plugins, such as GitHub and Slack, have scoped functions for requesting
 additional information:
 
-```hs
+```haskell
-oauth2SlackScoped [SlackBasicScope, SlackEmailScope] clientId clientSecret
+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 = "..."
 ```
 
-## Working with Extra Data
+## Advanced Usage
 
-We put the minimal amount of user data possible in `credsExtra` -- just enough
+To use any other provider:
-to support you parsing or fetching additional data yourself.
-
-For example, if you work with GitHub and GitHub user profiles, you likely
-already have a model and a way to parse the `/user` response. Rather than
-duplicate all that in our library, we try to make it easy for you to re-use that
-code yourself:
-
-```hs
-authenticate creds = do
-    let
-        -- You can run your own FromJSON parser on the response we already have
-        eGitHubUser :: Either String GitHubUser
-        eGitHubUser = getUserResponseJSON creds
-
-        -- Avert your eyes, simplified example
-        Just accessToken = getAccessToken creds
-        Right githubUser = eGitHubUser
-
-    -- Or make followup requests using our access token
-    runGitHub accessToken $ userRepositories githubUser
-
-    -- Or store it for later
-    insert User
-        { userIdent = credsIdent creds
-        , userAccessToken = accessToken
-        }
-```
-
-**NOTE**: Avoid looking up values in `credsExtra` yourself; prefer the provided
-`get` functions. The data representation itself is no longer considered public
-API.
-
-## Local Providers
-
-If we don't supply a "Provider" (e.g. GitHub, Google, etc) you need, you can
-write your own using our provided `Prelude`:
 
 ```haskell
-import Yesod.Auth.OAuth2.Prelude
+import Yesod.Auth
+import Yesod.Auth.OAuth2
 
-pluginName :: Text
+instance YesodAuth App where
-pluginName = "mysite"
+    -- ...
 
-oauth2MySite :: YesodAuth m => Text -> Text -> AuthPlugin m
+    authPlugins _ = [myPlugin]
-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
+myPlugin :: AuthPlugin m
-        userId <- -- ...
+myPlugin = authOAuth2 "mysite"
+    (OAuth2
+        { oauthClientId            = "..."
+        , oauthClientSecret        = "..."
+        , oauthOAuthorizeEndpoint  = "https://mysite.com/oauth/authorize"
+        , oauthAccessTokenEndpoint = "https://mysite.com/oauth/token"
+        , oauthCallback            = Nothing
+        })
+    makeCredentials
 
-        -- See authGetProfile for the typical case
+makeCredentials :: Manager -> AccessToken -> IO (Creds m)
-
+makeCredentials manager token = do
-        pure Creds
+    result <- authGetJSON manager token "https://mysite.com/api/me.json"
-            { credsPlugin = pluginName
+    return $ -- Parse the JSON into (Creds m)
-            , 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
+*If you write one of these, please consider opening a Pull Request*
-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)

circle.yml

@@ -0,0 +1,34 @@
+---
+machine:
+  pre:
+    # https://github.com/commercialhaskell/stack/issues/1658
+    - sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-4.6 20
+    - sudo update-alternatives --install /usr/bin/g++ g++ /usr/bin/g++-4.6 20
+    - sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-4.9 10
+    - sudo update-alternatives --install /usr/bin/g++ g++ /usr/bin/g++-4.9 10
+dependencies:
+  cache_directories:
+    - "~/.stack"
+  pre:
+    - wget https://github.com/commercialhaskell/stack/releases/download/v1.6.1/stack-1.6.1-linux-x86_64.tar.gz -O /tmp/stack.tar.gz
+    - tar xvzOf /tmp/stack.tar.gz stack-1.6.1-linux-x86_64/stack > /tmp/stack
+    - chmod +x /tmp/stack && sudo mv /tmp/stack /usr/bin/stack
+  override:
+    - stack setup
+    - stack build
+      --pedantic
+      --test --no-run-tests
+      --flag yesod-auth-oauth2:example
+
+    # Check compilation with nightly. If this proves problematic, add || true
+    # after to not fail the build.
+    - stack setup --resolver nightly
+    - stack build
+      --resolver nightly
+      --pedantic
+      --test --no-run-tests
+      --flag yesod-auth-oauth2:example
+
+test:
+  override:
+    - stack test

example/Main.hs

@@ -1,165 +0,0 @@
-{-# 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

@@ -0,0 +1,119 @@
+-- |
+--
+-- 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

@@ -1,15 +0,0 @@
-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

@@ -1,52 +1,43 @@
 ---
 name: yesod-auth-oauth2
-version: 0.8.0.0
+version: '0.3.1'
 synopsis: OAuth 2.0 authentication plugins
 description: Library to authenticate with OAuth 2.0 for Yesod web applications.
 category: Web
-author:
+author: Tom Streller
-  - Tom Streller
+maintainer: Pat Brisbin <pat@thoughtbot.com>
-  - Patrick Brisbin
+license: BSD3
-  - Freckle Engineering
+github: thoughtbot/yesod-auth-oauth2.git
-license: MIT
+homepage: http://github.com/thoughtbot/yesod-auth-oauth2
-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
+  - base >=4.5 && <5
 
 library:
   source-dirs: src
   dependencies:
-    - aeson >=0.6
+    - aeson >=0.6 && <1.3
+    - authenticate >=1.3.2.7 && <1.4
     - bytestring >=0.9.1.4
-    - crypton
+    - hoauth2 >=1.3.0 && <1.6
-    - errors
+    - http-client >=0.4.0 && <0.6
-    - hoauth2 >=2.8.0 # TokenRequestError
+    - http-conduit >=2.0 && <3.0
-    - http-client >=0.4.0
+    - http-types >=0.8 && <0.10
-    - http-conduit >=2.0
+    - lifted-base >=0.2 && <0.4
-    - http-types >=0.8
-    - memory
     - microlens
-    - mtl
+    - network-uri >=2.6
-    - safe-exceptions
+    - random
-    - text >=0.7
+    - text >=0.7 && <2.0
-    - transformers
+    - transformers >=0.2.2 && <0.6
     - uri-bytestring
-    - yesod-auth >=1.6.0
+    - vector >=0.10 && <0.13
-    - yesod-core >=1.6.0
+    - yesod-auth >=1.3 && <1.5
-    - unliftio
+    - yesod-core >=1.2 && <1.5
+    - yesod-form >=1.3 && <1.5
 
 executables:
   yesod-auth-oauth2-example:
-    main: Main.hs
+    main: main.hs
     source-dirs: example
     ghc-options:
       - -threaded
@@ -54,18 +45,15 @@ executables:
       - -with-rtsopts=-N
     dependencies:
       - yesod-auth-oauth2
-      - aeson >=0.6
+      - containers
-      - aeson-pretty
+      - http-conduit
-      - bytestring >=0.9.1.4
-      - containers >=0.6.0.1
-      - http-conduit >=2.0
       - load-env
-      - text >=0.7
+      - text
       - warp
       - yesod
-      - yesod-auth >=1.6.0
+      - yesod-auth
     when:
-      - condition: ! "!(flag(example))"
+      - condition: ! '!(flag(example))'
         buildable: false
 
 tests:

renovate.json

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

src/Network/OAuth/OAuth2/Compat.hs

@@ -1,118 +0,0 @@
-{-# 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

@@ -1,10 +1,9 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-
 module URI.ByteString.Extension where
 
 import Data.ByteString (ByteString)
-import Data.String (IsString (..))
+import Data.String (IsString(..))
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Lens.Micro
@@ -14,26 +13,30 @@ import qualified Data.ByteString.Char8 as C8
 import URI.ByteString
 
 instance IsString Scheme where
-  fromString = Scheme . fromString
+    fromString = Scheme . fromString
 
 instance IsString Host where
-  fromString = Host . fromString
+    fromString = Host . fromString
 
 instance IsString (URIRef Absolute) where
-  fromString =
+    fromString = either (error . show) id
-    either (error . show) id . parseURI strictURIParserOptions . C8.pack
+        . parseURI strictURIParserOptions
+        . C8.pack
 
 instance IsString (URIRef Relative) where
-  fromString =
+    fromString = either (error . show) id
-    either (error . show) id . parseRelativeRef strictURIParserOptions . C8.pack
+        . parseRelativeRef strictURIParserOptions
+        . C8.pack
 
 fromText :: Text -> Maybe URI
-fromText =
+fromText = either (const Nothing) Just
-  either (const Nothing) Just . parseURI strictURIParserOptions . encodeUtf8
+    . parseURI strictURIParserOptions
+    . encodeUtf8
 
 unsafeFromText :: Text -> URI
-unsafeFromText =
+unsafeFromText = either (error . show) id
-  either (error . show) id . parseURI strictURIParserOptions . encodeUtf8
+    . parseURI strictURIParserOptions
+    . encodeUtf8
 
 toText :: URI -> Text
 toText = decodeUtf8 . serializeURIRef'
@@ -42,15 +45,9 @@ fromRelative :: Scheme -> Host -> RelativeRef -> URI
 fromRelative s h = flip withHost h . toAbsolute s
 
 withHost :: URIRef a -> Host -> URIRef a
-withHost u h =
+withHost u h = u & authorityL %~ maybe
-  u
+    (Just $ Authority Nothing h Nothing)
-    & authorityL
+    (\a -> Just $ a & authorityHostL .~ h)
-      %~ 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

@@ -1,12 +0,0 @@
-{-# 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

@@ -1,117 +1,167 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-
+{-# LANGUAGE TupleSections #-}
 -- |
 --
 -- Generic OAuth2 plugin for Yesod
 --
--- See @"Yesod.Auth.OAuth2.GitHub"@ for example usage.
+-- * See Yesod.Auth.OAuth2.GitHub for example usage.
+--
 module Yesod.Auth.OAuth2
-  ( OAuth2 (..)
+    ( authOAuth2
-  , FetchCreds
+    , authOAuth2Widget
-  , Manager
+    , oauth2Url
-  , TokenResponse
+    , fromProfileURL
-  , Creds (..)
+    , YesodOAuth2Exception(..)
-  , oauth2Url
+    , invalidProfileResponse
-  , authOAuth2
+    , scopeParam
-  , authOAuth2Widget
+    , maybeExtra
+    , module Network.OAuth.OAuth2
+    , module URI.ByteString
+    , module URI.ByteString.Extension
+    ) where
 
-    -- * Alternatives that use 'fetchAccessTokenPost'
+#if __GLASGOW_HASKELL__ < 710
-  , authOAuth2'
+import Control.Applicative ((<$>))
-  , authOAuth2Widget'
+#endif
 
-    -- * Reading our @'credsExtra'@ keys
+import Control.Exception.Lifted
-  , getAccessToken
+import Control.Monad.IO.Class
-  , getRefreshToken
+import Control.Monad (unless)
-  , getUserResponse
+import Data.Aeson (Value(..), encode)
-  , getUserResponseJSON
+import Data.Monoid ((<>))
-  ) where
+import Data.ByteString (ByteString)
-
+import Data.Text (Text, pack)
-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 Data.Typeable
 import Network.HTTP.Conduit (Manager)
-import Network.OAuth.OAuth2.Compat
+import Network.OAuth.OAuth2 hiding (error)
+import System.Random
+import URI.ByteString
+import URI.ByteString.Extension
 import Yesod.Auth
-import Yesod.Auth.OAuth2.Dispatch
+import Yesod.Core
-import Yesod.Core.Widget
+
+import qualified Data.Text as T
+import qualified Data.ByteString.Lazy as BL
+
+-- | Provider name and Aeson parse error
+data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
+    deriving (Show, Typeable)
+
+instance Exception YesodOAuth2Exception
+
+-- | Construct an @'InvalidProfileResponse'@ exception from an @'OAuth2Error'@
+--
+-- This forces the @e@ in @'OAuth2Error' e@ to parse as a JSON @'Value'@ which
+-- is then re-encoded for the exception message.
+--
+invalidProfileResponse :: Text -> OAuth2Error Value -> YesodOAuth2Exception
+invalidProfileResponse name = InvalidProfileResponse name . encode
 
 oauth2Url :: Text -> AuthRoute
 oauth2Url name = PluginR name ["forward"]
 
 -- | Create an @'AuthPlugin'@ for the given OAuth2 provider
 --
--- Presents a generic @"Login via #{name}"@ link
+-- 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
-authOAuth2' :: YesodAuth m => Text -> OAuth2 -> FetchCreds m -> AuthPlugin m
+           => Text   -- ^ Service name
-authOAuth2' name = authOAuth2Widget' [whamlet|Login via #{name}|] name
+           -> OAuth2 -- ^ Service details
+           -> (Manager -> OAuth2Token -> IO (Creds m))
+           -- ^ This function defines how to take an @'OAuth2Token'@ 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
-  => 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
-authOAuth2Widget'
+                 => WidgetT m IO ()
-  :: YesodAuth m
+                 -> Text
-  => WidgetFor m ()
+                 -> OAuth2
-  -> Text
+                 -> (Manager -> OAuth2Token -> IO (Creds m))
-  -> OAuth2
+                 -> AuthPlugin m
-  -> FetchCreds m
+authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login
-  -> AuthPlugin m
-authOAuth2Widget' = buildPlugin fetchAccessTokenPost
 
-buildPlugin
+  where
-  :: YesodAuth m
+    url = PluginR name ["callback"]
-  => 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'@
+    withCallback csrfToken = do
-getAccessToken :: Creds m -> Maybe AccessToken
+        tm <- getRouteToParent
-getAccessToken = (AccessToken <$>) . lookup "accessToken" . credsExtra
+        render <- lift getUrlRender
+        return oauth
+            { oauthCallback = Just $ unsafeFromText $ render $ tm url
+            , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth
+                `withQuery` [("state", encodeUtf8 csrfToken)]
+            }
 
--- | Read the @'RefreshToken'@ from the values set via @'setExtra'@
+    dispatch "GET" ["forward"] = do
+        csrfToken <- liftIO generateToken
+        setSession tokenSessionKey csrfToken
+        authUrl <- toText . 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' (ExchangeToken code)
+        case result of
+            Left _ -> permissionDenied "Unable to retrieve 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
 --
--- N.B. not all providers supply this value.
+-- Throws @'InvalidProfileResponse'@ if JSON parsing fails
-getRefreshToken :: Creds m -> Maybe RefreshToken
+--
-getRefreshToken = (RefreshToken <$>) . lookup "refreshToken" . credsExtra
+fromProfileURL :: FromJSON a
+               => Text           -- ^ Plugin name
+               -> URI            -- ^ Profile URI
+               -> (a -> Creds m) -- ^ Conversion to Creds
+               -> Manager -> OAuth2Token -> IO (Creds m)
+fromProfileURL name url toCreds manager token = do
+    result <- authGetJSON manager (accessToken token) url
 
--- | Read the original profile response from the values set via @'setExtra'@
+    case result of
-getUserResponse :: Creds m -> Maybe ByteString
+        Right profile -> return $ toCreds profile
-getUserResponse =
+        Left err -> throwIO $ invalidProfileResponse name err
-  (fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra
 
--- | @'getUserResponse'@, and decode as JSON
+-- | A tuple of @scope@ and the given scopes separated by a delimiter
-getUserResponseJSON :: FromJSON a => Creds m -> Either String a
+scopeParam :: Text -> [Text] -> (ByteString, ByteString)
-getUserResponseJSON =
+scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d
-  eitherDecode <=< note "userResponse key not present" . getUserResponse
+
+-- | A helper for providing an optional value to credsExtra
+maybeExtra :: Text -> Maybe Text -> [(Text, Text)]
+maybeExtra k (Just v) = [(k, v)]
+maybeExtra _ Nothing  = []

src/Yesod/Auth/OAuth2/Auth0.hs

@@ -1,60 +0,0 @@
-{-# 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

@@ -1,59 +0,0 @@
-{-# 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

@@ -1,104 +0,0 @@
-{-# 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

@@ -1,73 +1,83 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP               #-}
-
+{-# LANGUAGE OverloadedStrings #-}
--- |
+
---
+-- |
--- OAuth2 plugin for Battle.Net
+--
---
+-- OAuth2 plugin for Battle.Net
--- * Authenticates against battle.net.
+--
--- * Uses user's id as credentials identifier.
+-- * Authenticates against battle.net.
--- * Returns user's battletag in extras.
+-- * Uses user's id as credentials identifier.
-module Yesod.Auth.OAuth2.BattleNet
+-- * Returns user's battletag in extras.
-  ( oauth2BattleNet
+--
-  , oAuth2BattleNet
+
-  ) where
+module Yesod.Auth.OAuth2.BattleNet
-
+  ( oAuth2BattleNet )
-import Yesod.Auth.OAuth2.Prelude
+  where
-
+
-import qualified Data.Text as T (pack, toLower)
+#if __GLASGOW_HASKELL__ < 710
-import Yesod.Core.Widget
+import           Control.Applicative  ((<$>), (<*>))
-
+#endif
-newtype User = User Int
+
-
+import           Control.Exception    (throwIO)
-instance FromJSON User where
+import           Control.Monad        (mzero)
-  parseJSON = withObject "User" $ \o -> User <$> o .: "id"
+
-
+import           Yesod.Auth
-pluginName :: Text
+import           Yesod.Auth.OAuth2
-pluginName = "battle.net"
+
-
+import           Data.Monoid          ((<>))
-oauth2BattleNet
+import           Network.HTTP.Conduit (Manager)
-  :: YesodAuth m
+
-  => WidgetFor m ()
+import           Data.Aeson
-  -- ^ Login widget
+import           Data.Text            (Text)
-  -> Text
+import qualified Data.Text            as T (pack, toLower)
-  -- ^ User region (e.g. "eu", "cn", "us")
+import qualified Data.Text.Encoding   as E (encodeUtf8)
-  -> Text
+import           Prelude
-  -- ^ Client ID
+import           Yesod.Core.Widget
-  -> Text
+
-  -- ^ Client Secret
+data BattleNetUser = BattleNetUser
-  -> AuthPlugin m
+              { userId    :: Int
-oauth2BattleNet widget region clientId clientSecret =
+              , battleTag :: Text
-  authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
+              }
-    (User userId, userResponse) <-
+
-      authGetProfile pluginName manager token $
+instance FromJSON BattleNetUser where
-        fromRelative "https" (apiHost $ T.toLower region) "/account/user"
+  parseJSON (Object o) = BattleNetUser
-
+                           <$> o .: "id"
-    pure
+                           <*> o .: "battletag"
-      Creds
+  parseJSON _ = mzero
-        { credsPlugin = pluginName
+
-        , credsIdent = T.pack $ show userId
+oAuth2BattleNet :: YesodAuth m
-        , credsExtra = setExtra token userResponse
+                => Text -- ^ Client ID
-        }
+                -> Text -- ^ Client Secret
- where
+                -> Text -- ^ User region (e.g. "eu", "cn", "us")
-  host = wwwHost $ T.toLower region
+                -> WidgetT m IO () -- ^ Login widget
-  oauth2 =
+                -> AuthPlugin m
-    OAuth2
+oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData $ makeCredentials region
-      { oauth2ClientId = clientId
+  where oAuthData = OAuth2 { oauthClientId            = clientId
-      , oauth2ClientSecret = clientSecret
+                           , oauthClientSecret        = clientSecret
-      , oauth2AuthorizeEndpoint = fromRelative "https" host "/oauth/authorize"
+                           , oauthOAuthorizeEndpoint  = fromRelative "https" host "/oauth/authorize"
-      , oauth2TokenEndpoint = fromRelative "https" host "/oauth/token"
+                           , oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token"
-      , oauth2RedirectUri = Nothing
+                           , oauthCallback            = Nothing
-      }
+                           }
-
+
-apiHost :: Text -> Host
+        host = wwwHost $ T.toLower region
-apiHost "cn" = "api.battlenet.com.cn"
+
-apiHost region = Host $ encodeUtf8 $ region <> ".api.battle.net"
+makeCredentials :: Text -> Manager -> OAuth2Token -> IO (Creds m)
-
+makeCredentials region manager token = do
-wwwHost :: Text -> Host
+    userResult <- authGetJSON manager (accessToken token)
-wwwHost "cn" = "www.battlenet.com.cn"
+        $ fromRelative "https" (apiHost $ T.toLower region) "/account/user"
-wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net"
+
-
+    case userResult of
-oAuth2BattleNet
+         Left err -> throwIO $ invalidProfileResponse "battle.net" err
-  :: YesodAuth m => Text -> Text -> Text -> WidgetFor m () -> AuthPlugin m
+         Right user -> return Creds
-oAuth2BattleNet i s r w = oauth2BattleNet w r i s
+           { credsPlugin = "battle.net"
-{-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-}
+           , credsIdent  = T.pack $ show $ userId user
+           , credsExtra  = [("battletag", battleTag user)]
+           }
+
+apiHost :: Text -> Host
+apiHost "cn" = "api.battlenet.com.cn"
+apiHost region = Host $ E.encodeUtf8 $ region <> ".api.battle.net"
+
+wwwHost :: Text -> Host
+wwwHost "cn" = "www.battlenet.com.cn"
+wwwHost region = Host $ E.encodeUtf8 $ region <> ".battle.net"

src/Yesod/Auth/OAuth2/Bitbucket.hs

@@ -1,64 +1,141 @@
+{-# 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
+    ( oauth2Bitbucket
-  , oauth2BitbucketScoped
+    , oauth2BitbucketScoped
-  ) where
+    , module Yesod.Auth.OAuth2
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+#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.Text (Text)
+import Network.HTTP.Conduit (Manager)
+import Yesod.Auth (YesodAuth, Creds(..), AuthPlugin)
+import Yesod.Auth.OAuth2
 
 import qualified Data.Text as T
 
-newtype User = User Text
+data BitbucketUser = BitbucketUser
+    { bitbucketUserId :: Text
+    , bitbucketUserName :: Maybe Text
+    , bitbucketUserLogin :: Text
+    , bitbucketUserLocation :: Maybe Text
+    , bitbucketUserLinks :: BitbucketUserLinks
+    }
 
-instance FromJSON User where
+instance FromJSON BitbucketUser where
-  parseJSON = withObject "User" $ \o -> User <$> o .: "uuid"
+    parseJSON (Object o) = BitbucketUser
+        <$> o .: "uuid"
+        <*> o .:? "display_name"
+        <*> o .: "username"
+        <*> o .:? "location"
+        <*> o .: "links"
 
-pluginName :: Text
+    parseJSON _ = mzero
-pluginName = "bitbucket"
 
-defaultScopes :: [Text]
+newtype BitbucketUserLinks = BitbucketUserLinks
-defaultScopes = ["account"]
+    { bitbucketAvatarLink :: BitbucketLink
+    }
 
-oauth2Bitbucket :: YesodAuth m => Text -> Text -> AuthPlugin m
+instance FromJSON BitbucketUserLinks where
-oauth2Bitbucket = oauth2BitbucketScoped defaultScopes
+    parseJSON (Object o) = BitbucketUserLinks
+        <$> o .: "avatar"
 
-oauth2BitbucketScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+    parseJSON _ = mzero
-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
+newtype BitbucketLink = BitbucketLink
-      Creds
+    { bitbucketLinkHref :: Text
-        { credsPlugin = pluginName
+    }
-        , -- FIXME: Preserved bug. This should just be userId (it's already
+
-          -- a Text), but because this code was shipped, folks likely have
+instance FromJSON BitbucketLink where
-          -- Idents in their database like @"\"...\""@, and if we fixed this
+    parseJSON (Object o) = BitbucketLink
-          -- they would need migrating. We're keeping it for now as it's a
+        <$> o .: "href"
-          -- minor wart. Breaking typed APIs is one thing, causing data to go
+
-          -- invalid is another.
+    parseJSON _ = mzero
-          credsIdent = T.pack $ show userId
+
-        , credsExtra = setExtra token userResponse
+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 = clientId
+        , oauthClientSecret = clientSecret
+        , oauthOAuthorizeEndpoint = "https://bitbucket.com/site/oauth2/authorize" `withQuery`
+            [ scopeParam "," scopes
+            ]
+        , oauthAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
+        , oauthCallback = Nothing
         }
- where
+
-  oauth2 =
+fetchBitbucketProfile :: Manager -> OAuth2Token -> IO (Creds m)
-    OAuth2
+fetchBitbucketProfile manager token = do
-      { oauth2ClientId = clientId
+    userResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user"
-      , oauth2ClientSecret = clientSecret
+    mailResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user/emails"
-      , oauth2AuthorizeEndpoint =
+
-          "https://bitbucket.com/site/oauth2/authorize"
+    case (userResult, mailResult) of
-            `withQuery` [scopeParam "," scopes]
+        (Right user, Right mails) -> return $ toCreds user (bitbucketEmails mails) token
-      , oauth2TokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
+        (Left err, _) -> throwIO $ invalidProfileResponse "bitbucket" err
-      , oauth2RedirectUri = Nothing
+        (_, Left err) -> throwIO $ invalidProfileResponse "bitbucket" err
-      }
+
+toCreds :: BitbucketUser -> [BitbucketUserEmail] -> OAuth2Token -> 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", atoken $ accessToken token)
+        ]
+        ++ maybeExtra "name" (bitbucketUserName user)
+        ++ maybeExtra "location" (bitbucketUserLocation user)
+    }
+
+  where
+    email = fromMaybe (head userMails) $ find bitbucketUserEmailPrimary userMails

src/Yesod/Auth/OAuth2/ClassLink.hs

@@ -1,52 +0,0 @@
-{-# 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

@@ -1,159 +0,0 @@
-{-# 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

@@ -1,80 +0,0 @@
-{-# 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

@@ -1,77 +0,0 @@
-{-# 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

@@ -1,85 +1,116 @@
+{-# 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
+    ( oauth2Eve
-  , oauth2EveScoped
+    , oauth2EveScoped
-  , WidgetType (..)
+    , WidgetType(..)
-  ) where
+    , module Yesod.Auth.OAuth2
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
 
-import qualified Data.Text as T
+import Control.Exception.Lifted
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Text (Text)
+import Network.HTTP.Conduit (Manager)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
 import Yesod.Core.Widget
 
-newtype User = User Text
+import qualified Data.Text as T
-
-instance FromJSON User where
-  parseJSON = withObject "User" $ \o -> User <$> o .: "CharacterOwnerHash"
 
 data WidgetType m
-  = -- | Simple "Login via eveonline" text
+    = Plain -- ^ Simple "Login via eveonline" text
-    Plain
+    | BigWhite
-  | BigWhite
+    | SmallWhite
-  | SmallWhite
+    | BigBlack
-  | BigBlack
+    | SmallBlack
-  | SmallBlack
+    | Custom (WidgetT m IO ())
-  | Custom (WidgetFor m ())
 
-asWidget :: YesodAuth m => WidgetType m -> WidgetFor m ()
+data EveUser = EveUser
-asWidget Plain = [whamlet|Login via eveonline|]
+    { eveUserName :: Text
-asWidget BigWhite =
+    , eveUserExpire :: Text
-  [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|]
+    , eveTokenType :: Text
-asWidget BigBlack =
+    , eveCharOwnerHash :: Text
-  [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]
+    , eveCharId :: Integer
-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
+instance FromJSON EveUser where
-pluginName = "eveonline"
+    parseJSON (Object o) = EveUser
+        <$> o .: "CharacterName"
+        <*> o .: "ExpiresOn"
+        <*> o .: "TokenType"
+        <*> o .: "CharacterOwnerHash"
+        <*> o .: "CharacterID"
 
-defaultScopes :: [Text]
+    parseJSON _ = mzero
-defaultScopes = ["publicData"]
 
-oauth2Eve :: YesodAuth m => WidgetType m -> Text -> Text -> AuthPlugin m
+oauth2Eve :: YesodAuth m
-oauth2Eve = oauth2EveScoped defaultScopes
+          => Text -- ^ Client ID
+          -> Text -- ^ Client Secret
+          -> WidgetType m
+          -> AuthPlugin m
+oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] . asWidget
 
-oauth2EveScoped
+  where
-  :: YesodAuth m => [Text] -> WidgetType m -> Text -> Text -> AuthPlugin m
+    asWidget :: YesodAuth m => WidgetType m -> WidgetT m IO ()
-oauth2EveScoped scopes widgetType clientId clientSecret =
+    asWidget Plain = [whamlet|Login via eveonline|]
-  authOAuth2Widget (asWidget widgetType) pluginName oauth2 $ \manager token ->
+    asWidget BigWhite = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4PTzeiAshqiM8osU2giO0Y/5cc4cb60bac52422da2e45db87b6819c/EVE_SSO_Login_Buttons_Large_White.png?w=270&h=45">|]
-    do
+    asWidget BigBlack = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/4fSjj56uD6CYwYyus4KmES/4f6385c91e6de56274d99496e6adebab/EVE_SSO_Login_Buttons_Large_Black.png?w=270&h=45">|]
-      (User userId, userResponse) <-
+    asWidget SmallWhite = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/18BxKSXCymyqY4QKo8KwKe/c2bdded6118472dd587c8107f24104d7/EVE_SSO_Login_Buttons_Small_White.png?w=195&h=30">|]
-        authGetProfile
+    asWidget SmallBlack = [whamlet|<img src="https://images.contentful.com/idjq7aai9ylm/12vrPsIMBQi28QwCGOAqGk/33234da7672c6b0cdca394fc8e0b1c2b/EVE_SSO_Login_Buttons_Small_Black.png?w=195&h=30">|]
-          pluginName
+    asWidget (Custom a) = a
-          manager
-          token
-          "https://login.eveonline.com/oauth/verify"
 
-      pure
+oauth2EveScoped :: YesodAuth m
-        Creds
+                => Text -- ^ Client ID
-          { credsPlugin = "eveonline"
+                -> Text -- ^ Client Secret
-          , -- FIXME: Preserved bug. See similar comment in Bitbucket provider.
+                -> [Text] -- ^ List of scopes to request
-            credsIdent = T.pack $ show userId
+                -> WidgetT m IO () -- ^ Login widget
-          , credsExtra = setExtra token userResponse
+                -> AuthPlugin m
-          }
+oauth2EveScoped clientId clientSecret scopes widget =
- where
+    authOAuth2Widget widget "eveonline" oauth fetchEveProfile
-  oauth2 =
+
-    OAuth2
+  where
-      { oauth2ClientId = clientId
+    oauth = OAuth2
-      , oauth2ClientSecret = clientSecret
+        { oauthClientId = clientId
-      , oauth2AuthorizeEndpoint =
+        , oauthClientSecret = clientSecret
-          "https://login.eveonline.com/oauth/authorize"
+        , oauthOAuthorizeEndpoint = "https://login.eveonline.com/oauth/authorize" `withQuery`
-            `withQuery` [("response_type", "code"), scopeParam " " scopes]
+            [ ("response_type", "code")
-      , oauth2TokenEndpoint = "https://login.eveonline.com/oauth/token"
+            , scopeParam " " scopes
-      , oauth2RedirectUri = Nothing
+            ]
-      }
+        , oauthAccessTokenEndpoint = "https://login.eveonline.com/oauth/token"
+        , oauthCallback = Nothing
+        }
+
+fetchEveProfile :: Manager -> OAuth2Token -> IO (Creds m)
+fetchEveProfile manager token = do
+    userResult <- authGetJSON manager (accessToken token) $ "https://login.eveonline.com/oauth/verify"
+
+    case userResult of
+        Right user -> return $ toCreds user token
+        Left err-> throwIO $ invalidProfileResponse "eveonline" err
+
+toCreds :: EveUser -> OAuth2Token -> 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", atoken $ accessToken token)
+        ]
+    }

src/Yesod/Auth/OAuth2/Exception.hs

@@ -1,24 +0,0 @@
-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

@@ -1,70 +0,0 @@
-{-# 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

@@ -1,61 +0,0 @@
-{-# 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/Github.hs

@@ -0,0 +1,115 @@
+{-# 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.Text (Text)
+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 = clientId
+        , oauthClientSecret = clientSecret
+        , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" `withQuery`
+            [ scopeParam "," scopes
+            ]
+        , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token"
+        , oauthCallback = Nothing
+        }
+
+fetchGithubProfile :: Manager -> OAuth2Token -> IO (Creds m)
+fetchGithubProfile manager token = do
+    userResult <- authGetJSON manager (accessToken token) "https://api.github.com/user"
+    mailResult <- authGetJSON manager (accessToken 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] -> OAuth2Token -> 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", atoken $ accessToken token)
+        ]
+        ++ maybeExtra "name" (githubUserName user)
+        ++ maybeExtra "public_email" (githubUserPublicEmail user)
+        ++ maybeExtra "location" (githubUserLocation user)
+    }
+
+  where
+    email = fromMaybe (head userMails) $ find githubUserEmailPrimary userMails

src/Yesod/Auth/OAuth2/Google.hs

@@ -1,89 +1,137 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-
 -- |
 --
 -- OAuth2 plugin for http://www.google.com
 --
 -- * Authenticates against Google
--- * Uses Google user id as credentials identifier
+-- * Uses Google user id or email as credentials identifier
+-- * Returns given_name, family_name, email, and avatar_url as extras
 --
--- If you were previously relying on email as the creds identifier, you can
+-- Note: This may eventually replace Yesod.Auth.GoogleEmail2. Currently it
--- still do that (and more) by overriding it in the creds returned by the plugin
+-- provides the same functionality except that GoogleEmail2 returns more profile
--- with any value read out of the new @userResponse@ key in @'credsExtra'@.
+-- information.
 --
--- 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
+    ( oauth2Google
-  , oauth2GoogleWidget
+    , oauth2GoogleScoped
-  , oauth2GoogleScoped
+    , oauth2GoogleScopedWithCustomId
-  , oauth2GoogleScopedWidget
+    , googleUid
-  ) where
+    , emailUid
+    , module Yesod.Auth.OAuth2
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+#if __GLASGOW_HASKELL__ < 710
-import Yesod.Core (WidgetFor, whamlet)
+import Control.Applicative ((<$>), (<*>))
+#endif
 
-newtype User = User Text
+import Control.Exception.Lifted
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Network.HTTP.Conduit (Manager)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
 
-instance FromJSON User where
+-- | Auth with Google
-  parseJSON =
+--
-    withObject "User" $ \o ->
+-- Requests @openid@ and @email@ scopes and uses email as the @'Creds'@
-      -- Required for data backwards-compatibility
+-- identifier.
-      User . ("google-uid:" <>) <$> o .: "sub"
+--
+oauth2Google :: YesodAuth m
+             => Text -- ^ Client ID
+             -> Text -- ^ Client Secret
+             -> AuthPlugin m
+oauth2Google = oauth2GoogleScoped ["openid", "email"]
 
-pluginName :: Text
+-- | Auth with Google
-pluginName = "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
 
-defaultScopes :: [Text]
+-- | Auth with Google
-defaultScopes = ["openid", "email"]
+--
+-- 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 -> OAuth2Token -> 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
 
-oauth2Google :: YesodAuth m => Text -> Text -> AuthPlugin m
+  where
-oauth2Google = oauth2GoogleScoped defaultScopes
+    oauth = OAuth2
-
+        { oauthClientId = clientId
-oauth2GoogleWidget
+        , oauthClientSecret = clientSecret
-  :: YesodAuth m => WidgetFor m () -> Text -> Text -> AuthPlugin m
+        , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" `withQuery`
-oauth2GoogleWidget widget = oauth2GoogleScopedWidget widget defaultScopes
+            [ scopeParam "+" scopes
-
+            ]
-oauth2GoogleScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+        , oauthAccessTokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
-oauth2GoogleScoped =
+        , oauthCallback = Nothing
-  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 =
+fetchGoogleProfile :: (GoogleUser -> OAuth2Token -> Creds m) -> Manager -> OAuth2Token -> IO (Creds m)
-    OAuth2
+fetchGoogleProfile toCreds manager token = do
-      { oauth2ClientId = clientId
+    userInfo <- authGetJSON manager (accessToken token) "https://www.googleapis.com/oauth2/v3/userinfo"
-      , oauth2ClientSecret = clientSecret
+    case userInfo of
-      , oauth2AuthorizeEndpoint =
+      Right user -> return $ toCreds user token
-          "https://accounts.google.com/o/oauth2/auth"
+      Left err -> throwIO $ invalidProfileResponse "google" err
-            `withQuery` [scopeParam " " scopes]
+
-      , oauth2TokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
+data GoogleUser = GoogleUser
-      , oauth2RedirectUri = Nothing
+    { 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 -> OAuth2Token -> Creds m
+googleUid = uidBuilder $ ("google-uid:" <>) . googleUserId
+
+-- | Build a @'Creds'@ using the user's email as the identifier
+emailUid :: GoogleUser -> OAuth2Token -> Creds m
+emailUid = uidBuilder googleUserEmail
+
+uidBuilder :: (GoogleUser -> Text) -> GoogleUser -> OAuth2Token -> 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", atoken $ accessToken token)
+        ]
+        ++ maybeExtra "hosted_domain" (googleUserHostedDomain user)
+    }

src/Yesod/Auth/OAuth2/Nylas.hs

@@ -1,70 +1,86 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Yesod.Auth.OAuth2.Nylas
-  ( oauth2Nylas
+    ( oauth2Nylas
-  ) where
+    , module Yesod.Auth.OAuth2
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+#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.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Network.HTTP.Client (applyBasicAuth, httpLbs, parseRequest, responseBody,
+                            responseStatus)
+import Network.HTTP.Conduit (Manager)
+import Yesod.Auth (Creds(..), YesodAuth, AuthPlugin)
+import Yesod.Auth.OAuth2
 
-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
+data NylasAccount = NylasAccount
+    { nylasAccountId :: Text
+    , nylasAccountEmailAddress :: Text
+    , nylasAccountName :: Text
+    , nylasAccountProvider :: Text
+    , nylasAccountOrganizationUnit :: Text
+    }
 
-instance FromJSON User where
+instance FromJSON NylasAccount where
-  parseJSON = withObject "User" $ \o -> User <$> o .: "id"
+    parseJSON (Object o) = NylasAccount
+        <$> o .: "id"
+        <*> o .: "email_address"
+        <*> o .: "name"
+        <*> o .: "provider"
+        <*> o .: "organization_unit"
+    parseJSON _ = mzero
 
-pluginName :: Text
+oauth2Nylas :: YesodAuth m
-pluginName = "nylas"
+            => Text -- ^ Client ID
+            -> Text -- ^ Client Secret
+            -> AuthPlugin m
+oauth2Nylas clientId clientSecret = authOAuth2 "nylas" oauth fetchCreds
+  where
+    oauth = OAuth2
+        { oauthClientId = clientId
+        , oauthClientSecret = clientSecret
+        , oauthOAuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" `withQuery`
+            [ ("response_type", "code")
+            , ("scope", "email")
+            , ("client_id", encodeUtf8 clientId)
+            ]
+        , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token"
+        , oauthCallback = Nothing
+        }
 
-defaultScopes :: [Text]
+fetchCreds :: Manager -> OAuth2Token -> IO (Creds a)
-defaultScopes = ["email"]
+fetchCreds manager token = do
-
+    req <- authorize <$> parseRequest "https://api.nylas.com/account"
-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
+    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 (encodeUtf8 $ atoken $ accessToken token) ""
+    parseFailure = InvalidProfileResponse "nylas" "failed to parse account"
+    requestFailure = InvalidProfileResponse "nylas" "failed to get account"
 
-    -- FIXME: was this working? I'm 95% sure that the client will throw its
+toCreds :: NylasAccount -> OAuth2Token -> Creds a
-    -- own exception on unsuccessful status codes.
+toCreds ns token = Creds
-    unless (HT.statusIsSuccessful $ responseStatus resp) $
+    { credsPlugin = "nylas"
-      throwIO $
+    , credsIdent = nylasAccountId ns
-        YesodOAuth2Exception.GenericError pluginName $
+    , credsExtra =
-          "Unsuccessful HTTP response: "
+        [ ("email_address", nylasAccountEmailAddress ns)
-            <> BL8.unpack userResponse
+        , ("name", nylasAccountName ns)
-
+        , ("provider", nylasAccountProvider ns)
-    either
+        , ("organization_unit", nylasAccountOrganizationUnit ns)
-      (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
+        , ("access_token", atoken $ accessToken token)
-      ( \(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

@@ -1,50 +0,0 @@
-{-# 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

@@ -1,127 +0,0 @@
-{-# 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

@@ -1,19 +0,0 @@
-{-# 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

@@ -1,83 +1,154 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-
+{-# LANGUAGE RecordWildCards #-}
 -- |
 --
 -- OAuth2 plugin for http://login.salesforce.com
 --
--- * Authenticates against Salesforce (or sandbox)
+-- * 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
+    ( oauth2Salesforce
-  , oauth2SalesforceScoped
+    , oauth2SalesforceScoped
-  , oauth2SalesforceSandbox
+    , oauth2SalesforceSandbox
-  , oauth2SalesforceSandboxScoped
+    , oauth2SalesforceSandboxScoped
-  ) where
+    , module Yesod.Auth.OAuth2
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
 
-newtype User = User Text
+import Control.Exception.Lifted
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Text (Text)
+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            = clientId
+        , oauthClientSecret        = clientSecret
+        , oauthOAuthorizeEndpoint  = "https://login.salesforce.com/services/oauth2/authorize" `withQuery`
+            [ scopeParam " " scopes
+            ]
+        , oauthAccessTokenEndpoint = "https://login.salesforce.com/services/oauth2/token"
+        , oauthCallback            = Nothing
+        }
+
+fetchSalesforceUser :: Manager -> OAuth2Token -> IO (Creds m)
+fetchSalesforceUser manager token = do
+    result <- authGetJSON manager (accessToken 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            = clientId
+        , oauthClientSecret        = clientSecret
+        , oauthOAuthorizeEndpoint  = "https://test.salesforce.com/services/oauth2/authorize" `withQuery`
+            [ scopeParam " " scopes
+            ]
+        , oauthAccessTokenEndpoint = "https://test.salesforce.com/services/oauth2/token"
+        , oauthCallback            = Nothing
+        }
+
+fetchSalesforceSandboxUser :: Manager -> OAuth2Token -> IO (Creds m)
+fetchSalesforceSandboxUser manager token = do
+    result <- authGetJSON manager (accessToken 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 = withObject "User" $ \o -> User <$> o .: "user_id"
+    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{..}
 
-pluginName :: Text
+    parseJSON _ = mzero
-pluginName = "salesforce"
 
-defaultScopes :: [Text]
+toCreds :: Text -> User -> OAuth2Token -> Creds m
-defaultScopes = ["openid", "email", "api"]
+toCreds name user token = Creds
-
+    { credsPlugin = name
-oauth2Salesforce :: YesodAuth m => Text -> Text -> AuthPlugin m
+    , credsIdent = userId user
-oauth2Salesforce = oauth2SalesforceScoped defaultScopes
+    , credsExtra =
-
+        [ ("email", userEmail user)
-oauth2SalesforceScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+        , ("org", userOrg user)
-oauth2SalesforceScoped =
+        , ("nickname", userName user)
-  salesforceHelper
+        , ("name", userName user)
-    pluginName
+        , ("given_name", userGivenName user)
-    "https://login.salesforce.com/services/oauth2/userinfo"
+        , ("family_name", userFamilyName user)
-    "https://login.salesforce.com/services/oauth2/authorize"
+        , ("time_zone", userTimeZone user)
-    "https://login.salesforce.com/services/oauth2/token"
+        , ("avatar_url", userPicture user)
-
+        , ("rest_url", userRestUrl user)
-oauth2SalesforceSandbox :: YesodAuth m => Text -> Text -> AuthPlugin m
+        , ("access_token", atoken $ accessToken token)
-oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped defaultScopes
+        ]
-
+        ++ maybeExtra "refresh_token" (rtoken <$> refreshToken token)
-oauth2SalesforceSandboxScoped
+        ++ maybeExtra "expires_in" ((T.pack . show) <$> expiresIn token)
-  :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+        ++ maybeExtra "phone_number" (userPhone user)
-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

@@ -1,83 +1,123 @@
 {-# 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 (..)
+    ( SlackScope(..)
-  , oauth2Slack
+    , oauth2Slack
-  , oauth2SlackScoped
+    , oauth2SlackScoped
-  ) where
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+import Data.Aeson
+import Yesod.Auth
+import Yesod.Auth.OAuth2
 
-import Network.HTTP.Client
+import Control.Exception.Lifted (throwIO)
-  ( httpLbs
+import Data.Maybe (catMaybes)
-  , parseUrlThrow
+import Data.Text (Text)
-  , responseBody
+import Data.Text.Encoding (encodeUtf8)
-  , setQueryString
+import Network.HTTP.Conduit (Manager)
-  )
+
-import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
+import qualified Network.HTTP.Conduit as HTTP
 
 data SlackScope
-  = SlackBasicScope
+    = SlackEmailScope
-  | SlackEmailScope
+    | SlackTeamScope
-  | SlackTeamScope
+    | SlackAvatarScope
-  | 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 = clientId
+        , oauthClientSecret = clientSecret
+        , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery`
+            [ scopeParam "," $ "identity.basic" : map scopeText scopes
+            ]
+        , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
+        , oauthCallback = Nothing
+        }
 
 scopeText :: SlackScope -> Text
-scopeText SlackBasicScope = "identity.basic"
 scopeText SlackEmailScope = "identity.email"
 scopeText SlackTeamScope = "identity.team"
 scopeText SlackAvatarScope = "identity.avatar"
 
-newtype User = User Text
+fetchSlackProfile :: Manager -> OAuth2Token -> IO (Creds m)
+fetchSlackProfile manager token = do
+    request
+        <- HTTP.setQueryString [("token", Just $ encodeUtf8 $ atoken $ accessToken token)]
+        <$> HTTP.parseUrlThrow "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
 
-instance FromJSON User where
+toCreds :: SlackUser -> OAuth2Token -> Creds m
-  parseJSON = withObject "User" $ \root -> do
+toCreds user token = Creds
-    o <- root .: "user"
+    { credsPlugin = "slack"
-    User <$> o .: "id"
+    , credsIdent = slackUserId user
-
+    , credsExtra = catMaybes
-pluginName :: Text
+        [ Just ("name", slackUserName user)
-pluginName = "slack"
+        , Just ("access_token", atoken $ accessToken token)
-
+        , (,) <$> pure "email" <*> slackUserEmail user
-defaultScopes :: [SlackScope]
+        , (,) <$> pure "avatar" <*> slackUserAvatarUrl user
-defaultScopes = [SlackBasicScope]
+        , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user)
-
+        , (,) <$> pure "team_id" <*> (slackTeamId <$> slackUserTeam user)
-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

@@ -1,46 +1,107 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-
 -- |
 --
 -- OAuth2 plugin for http://spotify.com
+--
 module Yesod.Auth.OAuth2.Spotify
-  ( oauth2Spotify
+    ( oauth2Spotify
-  ) where
+    , module Yesod.Auth.OAuth2
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>), pure)
+#endif
 
-newtype User = User Text
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Maybe
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
 
-instance FromJSON User where
+import qualified Data.Text as T
-  parseJSON = withObject "User" $ \o -> User <$> o .: "id"
 
-pluginName :: Text
+data SpotifyUserImage = SpotifyUserImage
-pluginName = "spotify"
+    { spotifyUserImageHeight :: Maybe Int
+    , spotifyUserImageWidth :: Maybe Int
+    , spotifyUserImageUrl :: Text
+    }
 
-oauth2Spotify :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+instance FromJSON SpotifyUserImage where
-oauth2Spotify scopes clientId clientSecret =
+    parseJSON (Object v) = SpotifyUserImage
-  authOAuth2 pluginName oauth2 $ \manager token -> do
+        <$> v .:? "height"
-    (User userId, userResponse) <-
+        <*> v .:? "width"
-      authGetProfile
+        <*> v .: "url"
-        pluginName
-        manager
-        token
-        "https://api.spotify.com/v1/me"
 
-    pure
+    parseJSON _ = mzero
-      Creds
+
-        { credsPlugin = pluginName
+data SpotifyUser = SpotifyUser
-        , credsIdent = userId
+    { spotifyUserId :: Text
-        , credsExtra = setExtra token userResponse
+    , spotifyUserHref :: Text
-        }
+    , spotifyUserUri :: Text
- where
+    , spotifyUserDisplayName :: Maybe Text
-  oauth2 =
+    , 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
+              -> [Text] -- ^ Scopes
+              -> AuthPlugin m
+oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
     OAuth2
-      { oauth2ClientId = clientId
+        { oauthClientId = clientId
-      , oauth2ClientSecret = clientSecret
+        , oauthClientSecret = clientSecret
-      , oauth2AuthorizeEndpoint =
+        , oauthOAuthorizeEndpoint = "https://accounts.spotify.com/authorize" `withQuery`
-          "https://accounts.spotify.com/authorize"
+            [ ("scope", encodeUtf8 $ T.intercalate " " scope)
-            `withQuery` [scopeParam " " scopes]
+            ]
-      , oauth2TokenEndpoint = "https://accounts.spotify.com/api/token"
+        , oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
-      , oauth2RedirectUri = Nothing
+        , 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

src/Yesod/Auth/OAuth2/Twitch.hs

@@ -1,62 +0,0 @@
-{-# 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

@@ -1,51 +1,72 @@
+{-# 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
+    ( oauth2Upcase
-  ) where
+    , module Yesod.Auth.OAuth2
+    ) where
 
-import Yesod.Auth.OAuth2.Prelude
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
 
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Text (Text)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
 import qualified Data.Text as T
 
-newtype User = User Int
+data UpcaseUser = UpcaseUser
+    { upcaseUserId :: Int
+    , upcaseUserFirstName :: Text
+    , upcaseUserLastName :: Text
+    , upcaseUserEmail :: Text
+    }
 
-instance FromJSON User where
+instance FromJSON UpcaseUser where
-  parseJSON = withObject "User" $ \root -> do
+    parseJSON (Object o) = UpcaseUser
-    o <- root .: "user"
+        <$> o .: "id"
-    User <$> o .: "id"
+        <*> o .: "first_name"
+        <*> o .: "last_name"
+        <*> o .: "email"
 
-pluginName :: Text
+    parseJSON _ = mzero
-pluginName = "upcase"
 
-oauth2Upcase :: YesodAuth m => Text -> Text -> AuthPlugin m
+newtype UpcaseResponse = UpcaseResponse UpcaseUser
-oauth2Upcase clientId clientSecret =
-  authOAuth2 pluginName oauth2 $ \manager token -> do
-    (User userId, userResponse) <-
-      authGetProfile
-        pluginName
-        manager
-        token
-        "http://upcase.com/api/v1/me.json"
 
-    pure
+instance FromJSON UpcaseResponse where
-      Creds
+    parseJSON (Object o) = UpcaseResponse
-        { credsPlugin = pluginName
+        <$> o .: "user"
-        , credsIdent = T.pack $ show userId
+
-        , credsExtra = setExtra token userResponse
+    parseJSON _ = mzero
-        }
+
- where
+oauth2Upcase :: YesodAuth m
-  oauth2 =
+             => Text -- ^ Client ID
+             -> Text -- ^ Client Secret
+             -> AuthPlugin m
+oauth2Upcase clientId clientSecret = authOAuth2 "upcase"
     OAuth2
-      { oauth2ClientId = clientId
+        { oauthClientId = clientId
-      , oauth2ClientSecret = clientSecret
+        , oauthClientSecret = clientSecret
-      , oauth2AuthorizeEndpoint = "http://upcase.com/oauth/authorize"
+        , oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize"
-      , oauth2TokenEndpoint = "http://upcase.com/oauth/token"
+        , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token"
-      , oauth2RedirectUri = Nothing
+        , 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)
+            ]
+        }

src/Yesod/Auth/OAuth2/WordPressDotCom.hs

@@ -1,50 +0,0 @@
-{-# 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

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

stack-lts22.yaml

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

stack-lts23.yaml

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

stack-lts24.yaml

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

stack-nightly.yaml

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

stack.yaml

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

stack.yaml

@@ -0,0 +1,6 @@
+---
+resolver: lts-9.18
+packages:
+  - .
+extra-deps:
+  - load-env-0.1.1

stack.yaml.lock

@@ -1,12 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/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

@@ -1,9 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-
 module URI.ByteString.ExtensionSpec
-  ( spec
+    ( main
-  ) where
+    , spec
+    ) where
 
 import Test.Hspec
 
@@ -13,68 +13,70 @@ import URI.ByteString
 import URI.ByteString.Extension
 import URI.ByteString.QQ
 
+main :: IO ()
+main = hspec spec
+
 spec :: Spec
 spec = do
-  describe "IsString Scheme" $ it "works" $ do
+    describe "IsString Scheme" $ it "works" $ do
-    "https" `shouldBe` Scheme "https"
+        "https" `shouldBe` Scheme "https"
 
-  describe "IsString Host" $ it "works" $ do
+    describe "IsString Host" $ it "works" $ do
-    "example.com" `shouldBe` Host "example.com"
+        "example.com" `shouldBe` Host "example.com"
 
-  describe "IsString URIRef Relative" $ it "works" $ do
+    describe "IsString URIRef Relative" $ it "works" $ do
-    "example.com/foo?bar=baz" `shouldBe` [relativeRef|example.com/foo?bar=baz|]
+        "example.com/foo?bar=baz"
+            `shouldBe` [relativeRef|example.com/foo?bar=baz|]
 
-  describe "IsString URIRef Absolute" $ it "works" $ do
+    describe "IsString URIRef Absolute" $ it "works" $ do
-    "https://example.com/foo?bar=baz"
+        "https://example.com/foo?bar=baz"
-      `shouldBe` [uri|https://example.com/foo?bar=baz|]
+            `shouldBe` [uri|https://example.com/foo?bar=baz|]
 
-  describe "fromText" $ do
+    describe "fromText" $ do
-    it "returns Just a URI for valid values, as the quasi-quoter would" $ do
+        it "returns Just a URI for valid values, as the quasi-quoter would" $ do
-      fromText "http://example.com/foo?bar=baz"
+            fromText "http://example.com/foo?bar=baz"
-        `shouldBe` Just [uri|http://example.com/foo?bar=baz|]
+                `shouldBe` Just [uri|http://example.com/foo?bar=baz|]
 
-    it "returns Nothing for invalid values" $ do
+        it "returns Nothing for invalid values" $ do
-      fromText "Oh my, what did I do?" `shouldBe` Nothing
+            fromText "Oh my, what did I do?" `shouldBe` Nothing
 
-  describe "unsafeFromText" $ do
+    describe "unsafeFromText" $ do
-    it "returns a URI for valid values, as the quasi-quoter would" $ do
+        it "returns a URI for valid values, as the quasi-quoter would" $ do
-      unsafeFromText "http://example.com/foo?bar=baz"
+            unsafeFromText "http://example.com/foo?bar=baz"
-        `shouldBe` [uri|http://example.com/foo?bar=baz|]
+                `shouldBe` [uri|http://example.com/foo?bar=baz|]
 
-    it "raises for invalid values" $ do
+        it "raises for invalid values" $ do
-      evaluate (unsafeFromText "Oh my, what did I do?")
+            evaluate (unsafeFromText "Oh my, what did I do?")
-        `shouldThrow` errorContaining "MissingColon"
+                `shouldThrow` errorContaining "MissingColon"
 
-  describe "toText" $ do
+    describe "toText" $ do
-    it "serializes the URI to text" $ do
+        it "serializes the URI to text" $ do
-      toText [uri|https://example.com/foo?bar=baz|]
+            toText [uri|https://example.com/foo?bar=baz|]
-        `shouldBe` "https://example.com/foo?bar=baz"
+                `shouldBe` "https://example.com/foo?bar=baz"
 
-  describe "fromRelative" $ do
+    describe "fromRelative" $ do
-    it "makes a URI absolute with a given host" $ do
+        it "makes a URI absolute with a given host" $ do
-      fromRelative "ftp" "foo.com" [relativeRef|/bar?baz=bat|]
+            fromRelative "ftp" "foo.com" [relativeRef|/bar?baz=bat|]
-        `shouldBe` [uri|ftp://foo.com/bar?baz=bat|]
+                `shouldBe` [uri|ftp://foo.com/bar?baz=bat|]
 
-  describe "withQuery" $ do
+    describe "withQuery" $ do
-    it "appends a query to a URI" $ do
+        it "appends a query to a URI" $ do
-      let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar")]
+            let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar")]
 
-      uriWithQuery `shouldBe` [uri|http://example.com?foo=bar|]
+            uriWithQuery `shouldBe` [uri|http://example.com?foo=bar|]
 
-    it "handles a URI with an existing query" $ do
+        it "handles a URI with an existing query" $ do
-      let uriWithQuery =
+            let uriWithQuery = [uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")]
-            [uri|http://example.com?foo=bar|] `withQuery` [("baz", "bat")]
 
-      uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|]
+            uriWithQuery `shouldBe` [uri|http://example.com?foo=bar&baz=bat|]
 
-    -- This is arguably testing the internals of another package, but IMO
+        -- 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
+        -- it's worthwhile to show that you don't (and can't) pre-sanitize when
-    -- using this function.
+        -- using this function.
-    it "handles santization of the query" $ do
+        it "handles santization of the query" $ do
-      let uriWithQuery =
+            let uriWithQuery = [uri|http://example.com|] `withQuery` [("foo", "bar baz")]
-            [uri|http://example.com|] `withQuery` [("foo", "bar baz")]
 
-      toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz"
+            toText uriWithQuery `shouldBe` "http://example.com?foo=bar%20baz"
 
 errorContaining :: String -> Selector ErrorCall
 errorContaining msg = (msg `isInfixOf`) . show

yesod-auth-oauth2.cabal

@@ -1,131 +0,0 @@
-cabal-version: 1.18
-
--- 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
-  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
-  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
-
-test-suite test
-  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