diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,18 @@ -The following license covers this documentation, and the source code, except -where otherwise indicated. - -Copyright 2008, Michael Snoyman. All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +Copyright 2018 Patrick Brisbin -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO -EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, -OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/example/Main.hs b/example/Main.hs new file mode 100644 --- /dev/null +++ b/example/Main.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- +-- This single-file Yesod app uses all plugins defined within this site, as a +-- means of manual verification that they work. When adding a new plugin, add +-- usage of it here and verify locally that it works. +-- +-- To do so, see @.env.example@, then: +-- +-- > stack build --flag yesod-auth-oauth2:example +-- > stack exec yesod-auth-oauth2-example +-- > +-- > $BROWSER http://localhost:3000 +-- +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.Monoid ((<>)) +import Data.Text (Text) +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.BattleNet +import Yesod.Auth.OAuth2.Bitbucket +import Yesod.Auth.OAuth2.EveOnline +import Yesod.Auth.OAuth2.Github +import Yesod.Auth.OAuth2.Google +import Yesod.Auth.OAuth2.Nylas +import Yesod.Auth.OAuth2.Salesforce +import Yesod.Auth.OAuth2.Slack +import Yesod.Auth.OAuth2.Spotify +import Yesod.Auth.OAuth2.Upcase + +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" + + authHttpManager = appHttpManager + authPlugins = appAuthPlugins + +instance RenderMessage App FormMessage where + renderMessage _ _ = defaultFormMessage + +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| +

Yesod Auth OAuth2 Example +

+ Log in + +

Credentials + +

Plugin / Ident +

#{show mCredsPlugin} / #{show mCredsIdent} + +

Access Token +

#{show mAccessToken} + +

User Response + 
+            $maybe userResponse <- mUserResponse
+                #{userResponse}
+    |]
+
+mkFoundation :: IO App
+mkFoundation = do
+    loadEnv
+
+    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 (oauth2BattleNet [whamlet|TODO|] "en") "BATTLE_NET"
+        , loadPlugin oauth2Bitbucket "BITBUCKET"
+        , loadPlugin (oauth2Eve Plain) "EVE_ONLINE"
+        , loadPlugin oauth2Github "GITHUB"
+        , loadPlugin oauth2Google "GOOGLE"
+        , loadPlugin oauth2Nylas "NYLAS"
+        , loadPlugin oauth2Salesforce "SALES_FORCE"
+        , loadPlugin oauth2Slack "SLACK"
+        , loadPlugin (oauth2Spotify []) "SPOTIFY"
+        , 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
diff --git a/example/main.hs b/example/main.hs
deleted file mode 100644
--- a/example/main.hs
+++ /dev/null
@@ -1,119 +0,0 @@
--- |
---
--- This is a single-file example of using yesod-auth-oauth2.
---
--- It can be run with:
---
--- > stack build --flag yesod-auth-oauth2:example
--- > stack exec yesod-auth-oauth2-example
--- > $BROWSER http://localhost:3000
---
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Main where
-
-import Data.Monoid ((<>))
-import Data.Text (Text)
-import LoadEnv
-import Network.HTTP.Conduit
-import Network.Wai.Handler.Warp (runEnv)
-import System.Environment (getEnv)
-import Yesod
-import Yesod.Auth
-import Yesod.Auth.OAuth2.Github
-
-import qualified Data.Text as T
-
-data OAuthKeys = OAuthKeys
-    { oauthKeysClientId :: Text
-    , oauthKeysClientSecret :: Text
-    }
-
-loadOAuthKeysEnv :: String -> IO OAuthKeys
-loadOAuthKeysEnv prefix = OAuthKeys
-    <$> (getEnvT $ prefix <> "_CLIENT_ID")
-    <*> (getEnvT $ prefix <> "_CLIENT_SECRET")
-
-  where
-    getEnvT = fmap T.pack . getEnv
-
-data App = App
-    { appHttpManager :: Manager
-    , appGithubKeys :: OAuthKeys
-    -- , appGoogleKeys :: OAuthKeys
-    -- , etc...
-    }
-
-mkYesod "App" [parseRoutes|
-    / RootR GET
-    /auth AuthR Auth getAuth
-|]
-
-instance Yesod App where
-    -- redirect_uri must be absolute to avoid callback mismatch error
-    approot = ApprootStatic "http://localhost:3000"
-
-instance YesodAuth App where
-    type AuthId App = Text
-    loginDest _ = RootR
-    logoutDest _ = RootR
-
-    -- Disable any attempt to read persisted authenticated state
-    maybeAuthId = return Nothing
-
-    -- Copy the Creds response into the session for viewing after
-    authenticate c = do
-        mapM_ (uncurry setSession) $
-            [ ("credsIdent", credsIdent c)
-            , ("credsPlugin", credsPlugin c)
-            ] ++ credsExtra c
-
-        return $ Authenticated "1"
-
-    authHttpManager = appHttpManager
-
-    authPlugins m =
-        [ oauth2Github
-            (oauthKeysClientId $ appGithubKeys m)
-            (oauthKeysClientSecret $ appGithubKeys m)
-        -- , oauth2Google
-        --     (oauthKeysClientId $ appGoogleKeys m)
-        --     (oauthKeysClientSecret $ appGoogleKeys m)
-        -- , etc...
-        ]
-
-instance RenderMessage App FormMessage where
-    renderMessage _ _ = defaultFormMessage
-
-getRootR :: Handler Html
-getRootR = do
-    sess <- getSession
-
-    defaultLayout [whamlet|
-        
Yesod Auth OAuth2 Example
-        

-            Log in
-        
Session Information
-        
-            #{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
diff --git a/src/Yesod/Auth/OAuth2.hs b/src/Yesod/Auth/OAuth2.hs
--- a/src/Yesod/Auth/OAuth2.hs
+++ b/src/Yesod/Auth/OAuth2.hs
@@ -1,85 +1,48 @@
-{-# 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
-    ( authOAuth2
-    , authOAuth2Widget
+    ( OAuth2(..)
+    , FetchCreds
+    , Manager
+    , OAuth2Token(..)
+    , Creds(..)
     , oauth2Url
-    , fromProfileURL
-    , YesodOAuth2Exception(..)
-    , invalidProfileResponse
-    , scopeParam
-    , maybeExtra
-    , module Network.OAuth.OAuth2
-    , module URI.ByteString
-    , module URI.ByteString.Extension
-    ) where
+    , authOAuth2
+    , authOAuth2Widget
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>))
-#endif
+    -- * Reading our @'credsExtra'@ keys
+    , getAccessToken
+    , getUserResponse
+    , getUserResponseJSON
+    ) where
 
-import Control.Exception.Lifted
-import Control.Monad.IO.Class
-import Control.Monad (unless)
-import Data.Aeson (Value(..), encode)
-import Data.Monoid ((<>))
-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 hiding (error)
-import System.Random
-import URI.ByteString
-import URI.ByteString.Extension
+import Network.OAuth.OAuth2
 import Yesod.Auth
-import Yesod.Core
-
-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
+import Yesod.Auth.OAuth2.Dispatch
+import Yesod.Core.Widget
 
 oauth2Url :: Text -> AuthRoute
 oauth2Url name = PluginR name ["forward"]
 
 -- | Create an @'AuthPlugin'@ for the given OAuth2 provider
 --
--- Presents a generic @"Login via name"@ link
+-- Presents a generic @"Login via #{name}"@ link
 --
-authOAuth2 :: YesodAuth m
-           => Text   -- ^ Service 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 :: YesodAuth m => Text -> OAuth2 -> FetchCreds m -> AuthPlugin m
 authOAuth2 name = authOAuth2Widget [whamlet|Login via #{name}|] name
 
 -- | Create an @'AuthPlugin'@ for the given OAuth2 provider
@@ -87,81 +50,33 @@
 -- Allows passing a custom widget for the login link. See @'oauth2Eve'@ for an
 -- example.
 --
-authOAuth2Widget :: YesodAuth m
-                 => WidgetT m IO ()
-                 -> Text
-                 -> OAuth2
-                 -> (Manager -> OAuth2Token -> IO (Creds m))
-                 -> AuthPlugin m
-authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login
-
+authOAuth2Widget
+    :: YesodAuth m
+    => WidgetT m IO ()
+    -> Text
+    -> OAuth2
+    -> FetchCreds m
+    -> AuthPlugin m
+authOAuth2Widget widget name oauth getCreds =
+    AuthPlugin name (dispatchAuthRequest name oauth getCreds) login
   where
-    url = PluginR name ["callback"]
-
-    withCallback csrfToken = do
-        tm <- getRouteToParent
-        render <- lift getUrlRender
-        return oauth
-            { oauthCallback = Just $ unsafeFromText $ render $ tm url
-            , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth
-                `withQuery` [("state", encodeUtf8 csrfToken)]
-            }
-
-    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
+    login tm = [whamlet|^{widget}|]
 
-    tokenSessionKey :: Text
-    tokenSessionKey = "_yesod_oauth2_" <> name
+-- | Read from the values set via @'setExtra'@
+getAccessToken :: Creds m -> Maybe AccessToken
+getAccessToken =
+    (AccessToken <$>) . lookup "accessToken" . credsExtra
 
-    login tm = [whamlet|^{widget}|]
+-- | Read from the values set via @'setExtra'@
+getUserResponse :: Creds m -> Maybe ByteString
+getUserResponse =
+    (fromStrict . encodeUtf8 <$>) . lookup "userResponse" . credsExtra
 
--- | Handle the common case of fetching Profile information from a JSON endpoint
+-- | Read from the values set via @'setExtra'@, decode as JSON
 --
--- Throws @'InvalidProfileResponse'@ if JSON parsing fails
+-- This is unsafe if the key is missing, but safe with respect to parsing
+-- errors.
 --
-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
-
-    case result of
-        Right profile -> return $ toCreds profile
-        Left err -> throwIO $ invalidProfileResponse name err
-
--- | A tuple of @scope@ and the given scopes separated by a delimiter
-scopeParam :: Text -> [Text] -> (ByteString, ByteString)
-scopeParam d = ("scope",) . encodeUtf8 . T.intercalate d
-
--- | A helper for providing an optional value to credsExtra
-maybeExtra :: Text -> Maybe Text -> [(Text, Text)]
-maybeExtra k (Just v) = [(k, v)]
-maybeExtra _ Nothing  = []
+getUserResponseJSON :: FromJSON a => Creds m -> Either String a
+getUserResponseJSON =
+    eitherDecode <=< note "userResponse key not present" . getUserResponse
diff --git a/src/Yesod/Auth/OAuth2/BattleNet.hs b/src/Yesod/Auth/OAuth2/BattleNet.hs
--- a/src/Yesod/Auth/OAuth2/BattleNet.hs
+++ b/src/Yesod/Auth/OAuth2/BattleNet.hs
@@ -1,83 +1,69 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE OverloadedStrings #-}
-
--- |
---
--- OAuth2 plugin for Battle.Net
---
--- * Authenticates against battle.net.
--- * Uses user's id as credentials identifier.
--- * Returns user's battletag in extras.
---
-
-module Yesod.Auth.OAuth2.BattleNet
-  ( oAuth2BattleNet )
-  where
-
-#if __GLASGOW_HASKELL__ < 710
-import           Control.Applicative  ((<$>), (<*>))
-#endif
-
-import           Control.Exception    (throwIO)
-import           Control.Monad        (mzero)
-
-import           Yesod.Auth
-import           Yesod.Auth.OAuth2
-
-import           Data.Monoid          ((<>))
-import           Network.HTTP.Conduit (Manager)
-
-import           Data.Aeson
-import           Data.Text            (Text)
-import qualified Data.Text            as T (pack, toLower)
-import qualified Data.Text.Encoding   as E (encodeUtf8)
-import           Prelude
-import           Yesod.Core.Widget
-
-data BattleNetUser = BattleNetUser
-              { userId    :: Int
-              , battleTag :: Text
-              }
-
-instance FromJSON BattleNetUser where
-  parseJSON (Object o) = BattleNetUser
-                           <$> o .: "id"
-                           <*> o .: "battletag"
-  parseJSON _ = mzero
-
-oAuth2BattleNet :: YesodAuth m
-                => Text -- ^ Client ID
-                -> Text -- ^ Client Secret
-                -> Text -- ^ User region (e.g. "eu", "cn", "us")
-                -> WidgetT m IO () -- ^ Login widget
-                -> AuthPlugin m
-oAuth2BattleNet clientId clientSecret region widget = authOAuth2Widget widget "battle.net" oAuthData $ makeCredentials region
-  where oAuthData = OAuth2 { oauthClientId            = clientId
-                           , oauthClientSecret        = clientSecret
-                           , oauthOAuthorizeEndpoint  = fromRelative "https" host "/oauth/authorize"
-                           , oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token"
-                           , oauthCallback            = Nothing
-                           }
-
-        host = wwwHost $ T.toLower region
-
-makeCredentials :: Text -> Manager -> OAuth2Token -> IO (Creds m)
-makeCredentials region manager token = do
-    userResult <- authGetJSON manager (accessToken token)
-        $ fromRelative "https" (apiHost $ T.toLower region) "/account/user"
-
-    case userResult of
-         Left err -> throwIO $ invalidProfileResponse "battle.net" err
-         Right user -> return Creds
-           { credsPlugin = "battle.net"
-           , credsIdent  = T.pack $ show $ userId user
-           , credsExtra  = [("battletag", battleTag user)]
-           }
-
-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"
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+--
+-- OAuth2 plugin for Battle.Net
+--
+-- * Authenticates against battle.net.
+-- * Uses user's id as credentials identifier.
+-- * Returns user's battletag in extras.
+--
+module Yesod.Auth.OAuth2.BattleNet
+    ( oauth2BattleNet
+    , oAuth2BattleNet
+    ) where
+
+import Yesod.Auth.OAuth2.Prelude
+
+import qualified Data.Text as T (pack, toLower)
+import Yesod.Core.Widget
+
+newtype User = User Int
+
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
+        <$> o .: "id"
+
+pluginName :: Text
+pluginName = "battle.net"
+
+oauth2BattleNet
+    :: YesodAuth m
+    => WidgetT m IO () -- ^ Login widget
+    -> Text -- ^ User region (e.g. "eu", "cn", "us")
+    -> Text -- ^ Client ID
+    -> Text -- ^ Client Secret
+    -> AuthPlugin m
+oauth2BattleNet widget region clientId clientSecret =
+    authOAuth2Widget widget pluginName oauth2 $ \manager token -> do
+        (User userId, userResponse) <-
+            authGetProfile pluginName manager token
+                $ fromRelative "https" (apiHost $ T.toLower region) "/account/user"
+
+        pure Creds
+            { credsPlugin = pluginName
+            , credsIdent = T.pack $ show userId
+            , credsExtra = setExtra token userResponse
+            }
+  where
+    host = wwwHost $ T.toLower region
+    oauth2 = OAuth2
+        { oauthClientId = clientId
+        , oauthClientSecret = clientSecret
+        , oauthOAuthorizeEndpoint = fromRelative "https" host "/oauth/authorize"
+        , oauthAccessTokenEndpoint = fromRelative "https" host "/oauth/token"
+        , oauthCallback = Nothing
+        }
+
+
+apiHost :: Text -> Host
+apiHost "cn" = "api.battlenet.com.cn"
+apiHost region = Host $ encodeUtf8 $ region <> ".api.battle.net"
+
+wwwHost :: Text -> Host
+wwwHost "cn" = "www.battlenet.com.cn"
+wwwHost region = Host $ encodeUtf8 $ region <> ".battle.net"
+
+oAuth2BattleNet :: YesodAuth m => Text -> Text -> Text -> WidgetT m IO () -> AuthPlugin m
+oAuth2BattleNet i s r w = oauth2BattleNet w r i s
+{-# DEPRECATED oAuth2BattleNet "Use oauth2BattleNet" #-}
diff --git a/src/Yesod/Auth/OAuth2/Bitbucket.hs b/src/Yesod/Auth/OAuth2/Bitbucket.hs
--- a/src/Yesod/Auth/OAuth2/Bitbucket.hs
+++ b/src/Yesod/Auth/OAuth2/Bitbucket.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- |
 --
@@ -6,104 +5,50 @@
 --
 -- * Authenticates against bitbucket
 -- * Uses bitbucket uuid as credentials identifier
--- * Returns email, username, full name, location and avatar as extras
 --
 module Yesod.Auth.OAuth2.Bitbucket
     ( oauth2Bitbucket
     , oauth2BitbucketScoped
-    , module Yesod.Auth.OAuth2
     ) where
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Exception.Lifted (throwIO)
-import Control.Monad (mzero)
-import Data.Aeson (FromJSON, Value(Object), parseJSON, (.:), (.:?))
-import Data.Maybe (fromMaybe)
-import Data.List (find)
-import Data.Text (Text)
-import Network.HTTP.Conduit (Manager)
-import Yesod.Auth (YesodAuth, Creds(..), AuthPlugin)
-import Yesod.Auth.OAuth2
+import Yesod.Auth.OAuth2.Prelude
 
 import qualified Data.Text as T
 
-data BitbucketUser = BitbucketUser
-    { bitbucketUserId :: Text
-    , bitbucketUserName :: Maybe Text
-    , bitbucketUserLogin :: Text
-    , bitbucketUserLocation :: Maybe Text
-    , bitbucketUserLinks :: BitbucketUserLinks
-    }
+newtype User = User Text
 
-instance FromJSON BitbucketUser where
-    parseJSON (Object o) = BitbucketUser
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
         <$> o .: "uuid"
-        <*> o .:? "display_name"
-        <*> o .: "username"
-        <*> o .:? "location"
-        <*> o .: "links"
 
-    parseJSON _ = mzero
-
-newtype BitbucketUserLinks = BitbucketUserLinks
-    { bitbucketAvatarLink :: BitbucketLink
-    }
-
-instance FromJSON BitbucketUserLinks where
-    parseJSON (Object o) = BitbucketUserLinks
-        <$> o .: "avatar"
-
-    parseJSON _ = mzero
-
-newtype BitbucketLink = BitbucketLink
-    { bitbucketLinkHref :: Text
-    }
-
-instance FromJSON BitbucketLink where
-    parseJSON (Object o) = BitbucketLink
-        <$> o .: "href"
-
-    parseJSON _ = mzero
-
-newtype BitbucketEmailSearchResults = BitbucketEmailSearchResults
-    { bitbucketEmails :: [BitbucketUserEmail]
-    }
-
-instance FromJSON BitbucketEmailSearchResults where
-    parseJSON (Object o) = BitbucketEmailSearchResults
-        <$> o .: "values"
-
-    parseJSON _ = mzero
-
-data BitbucketUserEmail = BitbucketUserEmail
-    { bitbucketUserEmailAddress :: Text
-    , bitbucketUserEmailPrimary :: Bool
-    }
+pluginName :: Text
+pluginName = "bitbucket"
 
-instance FromJSON BitbucketUserEmail where
-    parseJSON (Object o) = BitbucketUserEmail
-        <$> o .: "email"
-        <*> o .: "is_primary"
+defaultScopes :: [Text]
+defaultScopes = ["account"]
 
-    parseJSON _ = mzero
+oauth2Bitbucket :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Bitbucket = oauth2BitbucketScoped defaultScopes
 
-oauth2Bitbucket :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> AuthPlugin m
-oauth2Bitbucket clientId clientSecret = oauth2BitbucketScoped clientId clientSecret ["account"]
+oauth2BitbucketScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+oauth2BitbucketScoped scopes clientId clientSecret =
+    authOAuth2 pluginName oauth2 $ \manager token -> do
+        (User userId, userResponse) <-
+            authGetProfile pluginName manager token "https://api.bitbucket.com/2.0/user"
 
-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
+        pure Creds
+            { credsPlugin = pluginName
+            -- FIXME: Preserved bug. This should just be userId (it's already
+            -- a Text), but because this code was shipped, folks likely have
+            -- Idents in their database like @"\"...\""@, and if we fixed this
+            -- they would need migrating. We're keeping it for now as it's a
+            -- minor wart. Breaking typed APIs is one thing, causing data to go
+            -- invalid is another.
+            , credsIdent = T.pack $ show userId
+            , credsExtra = setExtra token userResponse
+            }
   where
-    oauth = OAuth2
+    oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "https://bitbucket.com/site/oauth2/authorize" `withQuery`
@@ -112,30 +57,3 @@
         , oauthAccessTokenEndpoint = "https://bitbucket.com/site/oauth2/access_token"
         , oauthCallback = Nothing
         }
-
-fetchBitbucketProfile :: Manager -> OAuth2Token -> IO (Creds m)
-fetchBitbucketProfile manager token = do
-    userResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user"
-    mailResult <- authGetJSON manager (accessToken token) "https://api.bitbucket.com/2.0/user/emails"
-
-    case (userResult, mailResult) of
-        (Right user, Right mails) -> return $ toCreds user (bitbucketEmails mails) token
-        (Left err, _) -> throwIO $ invalidProfileResponse "bitbucket" err
-        (_, Left err) -> throwIO $ invalidProfileResponse "bitbucket" err
-
-toCreds :: BitbucketUser -> [BitbucketUserEmail] -> 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
diff --git a/src/Yesod/Auth/OAuth2/Dispatch.hs b/src/Yesod/Auth/OAuth2/Dispatch.hs
new file mode 100644
--- /dev/null
+++ b/src/Yesod/Auth/OAuth2/Dispatch.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Yesod.Auth.OAuth2.Dispatch
+    ( FetchCreds
+    , dispatchAuthRequest
+    ) where
+
+import Control.Exception.Safe (throwString, tryIO)
+import Control.Monad (unless)
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Network.HTTP.Conduit (Manager)
+import Network.OAuth.OAuth2
+import System.Random (newStdGen, randomRs)
+import URI.ByteString.Extension
+import Yesod.Auth
+import Yesod.Core
+
+-- | How to take an @'OAuth2Token'@ and retrieve user credentials
+type FetchCreds m = Manager -> OAuth2Token -> IO (Creds m)
+
+-- | Dispatch the various OAuth2 handshake routes
+dispatchAuthRequest
+    :: Text             -- ^ Name
+    -> OAuth2           -- ^ Service details
+    -> FetchCreds m     -- ^ How to get credentials
+    -> Text             -- ^ Method
+    -> [Text]           -- ^ Path pieces
+    -> AuthHandler m TypedContent
+dispatchAuthRequest name oauth2 _ "GET" ["forward"] = dispatchForward name oauth2
+dispatchAuthRequest name oauth2 getCreds "GET" ["callback"] = dispatchCallback name oauth2 getCreds
+dispatchAuthRequest _ _ _ _ _ = notFound
+
+-- | Handle @GET \/forward@
+--
+-- 1. Set a random CSRF token in our session
+-- 2. Redirect to the Provider's authorization URL
+--
+dispatchForward :: Text -> OAuth2 -> AuthHandler m TypedContent
+dispatchForward name oauth2 = do
+    csrf <- setSessionCSRF $ tokenSessionKey name
+    oauth2' <- withCallbackAndState name oauth2 csrf
+    lift $ 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 :: Text -> OAuth2 -> FetchCreds m -> AuthHandler m TypedContent
+dispatchCallback name oauth2 getCreds = do
+    csrf <- verifySessionCSRF $ tokenSessionKey name
+    code <- requireGetParam "code"
+    manager <- lift $ getsYesod authHttpManager
+    oauth2' <- withCallbackAndState name oauth2 csrf
+    token <- denyLeft $ fetchAccessToken manager oauth2' $ ExchangeToken code
+    creds <- denyLeft $ tryIO $ getCreds manager token
+    lift $ setCredsRedirect creds
+  where
+    -- On a Left result, log it and return an opaque permission-denied
+    denyLeft :: (MonadHandler m, MonadLogger m, Show e) => IO (Either e a) -> m a
+    denyLeft act = do
+        result <- liftIO act
+        either
+            (\err -> do
+                $(logError) $ T.pack $ "OAuth2 error: " <> show err
+                permissionDenied "Invalid OAuth2 authentication attempt"
+            )
+            return
+            result
+
+withCallbackAndState :: Text -> OAuth2 -> Text -> AuthHandler m OAuth2
+withCallbackAndState name oauth2 csrf = do
+    let url = PluginR name ["callback"]
+    render <- getParentUrlRender
+    let callbackText = render url
+
+    callback <- maybe
+        (throwString
+            $ "Invalid callback URI: "
+            <> T.unpack callbackText
+            <> ". Not using an absolute Approot?"
+        ) pure $ fromText callbackText
+
+    pure oauth2
+        { oauthCallback = Just callback
+        , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth2
+            `withQuery` [("state", encodeUtf8 csrf)]
+        }
+
+getParentUrlRender :: HandlerT child (HandlerT parent IO) (Route child -> Text)
+getParentUrlRender = (.)
+    <$> lift getUrlRender
+    <*> getRouteToParent
+
+-- | Set a random, 30-character value in the session
+setSessionCSRF :: MonadHandler m => Text -> m Text
+setSessionCSRF sessionKey = do
+    csrfToken <- liftIO randomToken
+    csrfToken <$ setSession sessionKey csrfToken
+  where
+    randomToken = T.pack . take 30 . randomRs ('a', 'z') <$> newStdGen
+
+-- | Verify the callback provided the same CSRF token as in our session
+verifySessionCSRF :: MonadHandler m => Text -> m Text
+verifySessionCSRF sessionKey = do
+    token <- requireGetParam "state"
+    sessionToken <- lookupSession sessionKey
+    deleteSession sessionKey
+
+    unless (sessionToken == Just token)
+        $ permissionDenied "Invalid OAuth2 state token"
+
+    return token
+
+requireGetParam :: MonadHandler m => Text -> m Text
+requireGetParam key = do
+    m <- lookupGetParam key
+    maybe errInvalidArgs return m
+  where
+    errInvalidArgs = invalidArgs ["The '" <> key <> "' parameter is required"]
+
+tokenSessionKey :: Text -> Text
+tokenSessionKey name = "_yesod_oauth2_" <> name
diff --git a/src/Yesod/Auth/OAuth2/EveOnline.hs b/src/Yesod/Auth/OAuth2/EveOnline.hs
--- a/src/Yesod/Auth/OAuth2/EveOnline.hs
+++ b/src/Yesod/Auth/OAuth2/EveOnline.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 -- |
@@ -7,30 +6,24 @@
 --
 -- * Authenticates against eveonline
 -- * Uses EVEs unique account-user-char-hash as credentials identifier
--- * Returns charName, charId, tokenType, accessToken and expires as extras
 --
 module Yesod.Auth.OAuth2.EveOnline
     ( oauth2Eve
     , oauth2EveScoped
     , WidgetType(..)
-    , module Yesod.Auth.OAuth2
     ) where
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
+import Yesod.Auth.OAuth2.Prelude
 
-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
 import Yesod.Core.Widget
 
-import qualified Data.Text as T
+newtype User = User Text
 
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
+        <$> o .: "CharacterOwnerHash"
+
 data WidgetType m
     = Plain -- ^ Simple "Login via eveonline" text
     | BigWhite
@@ -39,51 +32,37 @@
     | SmallBlack
     | Custom (WidgetT m IO ())
 
-data EveUser = EveUser
-    { eveUserName :: Text
-    , eveUserExpire :: Text
-    , eveTokenType :: Text
-    , eveCharOwnerHash :: Text
-    , eveCharId :: Integer
-    }
-
-instance FromJSON EveUser where
-    parseJSON (Object o) = EveUser
-        <$> o .: "CharacterName"
-        <*> o .: "ExpiresOn"
-        <*> o .: "TokenType"
-        <*> o .: "CharacterOwnerHash"
-        <*> o .: "CharacterID"
+asWidget :: YesodAuth m => WidgetType m -> WidgetT m IO ()
+asWidget Plain = [whamlet|Login via eveonline|]
+asWidget BigWhite = [whamlet||]
+asWidget BigBlack = [whamlet||]
+asWidget SmallWhite = [whamlet||]
+asWidget SmallBlack = [whamlet||]
+asWidget (Custom a) = a
 
-    parseJSON _ = mzero
+pluginName :: Text
+pluginName = "eveonline"
 
-oauth2Eve :: YesodAuth m
-          => Text -- ^ Client ID
-          -> Text -- ^ Client Secret
-          -> WidgetType m
-          -> AuthPlugin m
-oauth2Eve clientId clientSecret = oauth2EveScoped clientId clientSecret ["publicData"] . asWidget
+defaultScopes :: [Text]
+defaultScopes = ["publicData"]
 
-  where
-    asWidget :: YesodAuth m => WidgetType m -> WidgetT m IO ()
-    asWidget Plain = [whamlet|Login via eveonline|]
-    asWidget BigWhite = [whamlet||]
-    asWidget BigBlack = [whamlet||]
-    asWidget SmallWhite = [whamlet||]
-    asWidget SmallBlack = [whamlet||]
-    asWidget (Custom a) = a
+oauth2Eve :: YesodAuth m => WidgetType m -> Text -> Text -> AuthPlugin m
+oauth2Eve = oauth2EveScoped defaultScopes
 
-oauth2EveScoped :: YesodAuth m
-                => Text -- ^ Client ID
-                -> Text -- ^ Client Secret
-                -> [Text] -- ^ List of scopes to request
-                -> WidgetT m IO () -- ^ Login widget
-                -> AuthPlugin m
-oauth2EveScoped clientId clientSecret scopes widget =
-    authOAuth2Widget widget "eveonline" oauth fetchEveProfile
+oauth2EveScoped :: YesodAuth m => [Text] -> WidgetType m -> Text -> Text -> AuthPlugin m
+oauth2EveScoped scopes widgetType clientId clientSecret =
+    authOAuth2Widget (asWidget widgetType) pluginName oauth2 $ \manager token -> do
+        (User userId, userResponse) <-
+            authGetProfile pluginName manager token "https://login.eveonline.com/oauth/verify"
 
+        pure Creds
+            { credsPlugin = "eveonline"
+            -- FIXME: Preserved bug. See similar comment in Bitbucket provider.
+            , credsIdent = T.pack $ show userId
+            , credsExtra = setExtra token userResponse
+            }
   where
-    oauth = OAuth2
+    oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "https://login.eveonline.com/oauth/authorize" `withQuery`
@@ -93,24 +72,3 @@
         , 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)
-        ]
-    }
diff --git a/src/Yesod/Auth/OAuth2/Github.hs b/src/Yesod/Auth/OAuth2/Github.hs
--- a/src/Yesod/Auth/OAuth2/Github.hs
+++ b/src/Yesod/Auth/OAuth2/Github.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- |
 --
@@ -6,76 +5,44 @@
 --
 -- * 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 Yesod.Auth.OAuth2.Prelude
 
 import qualified Data.Text as T
 
-data GithubUser = GithubUser
-    { githubUserId :: Int
-    , githubUserName :: Maybe Text
-    , githubUserLogin :: Text
-    , githubUserAvatarUrl :: Text
-    , githubUserLocation :: Maybe Text
-    , githubUserPublicEmail :: Maybe Text
-    }
+newtype User = User Int
 
-instance FromJSON GithubUser where
-    parseJSON (Object o) = GithubUser
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
         <$> o .: "id"
-        <*> o .:? "name"
-        <*> o .: "login"
-        <*> o .: "avatar_url"
-        <*> o .:? "location"
-        <*> o .:? "email"
 
-    parseJSON _ = mzero
-
-data GithubUserEmail = GithubUserEmail
-    { githubUserEmailAddress :: Text
-    , githubUserEmailPrimary :: Bool
-    }
+pluginName :: Text
+pluginName = "github"
 
-instance FromJSON GithubUserEmail where
-    parseJSON (Object o) = GithubUserEmail
-        <$> o .: "email"
-        <*> o .: "primary"
+defaultScopes :: [Text]
+defaultScopes = ["user:email"]
 
-    parseJSON _ = mzero
+oauth2Github :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Github = oauth2GithubScoped defaultScopes
 
-oauth2Github :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> AuthPlugin m
-oauth2Github clientId clientSecret = oauth2GithubScoped clientId clientSecret ["user:email"]
+oauth2GithubScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+oauth2GithubScoped scopes clientId clientSecret =
+    authOAuth2 pluginName oauth2 $ \manager token -> do
+        (User userId, userResponse) <-
+            authGetProfile pluginName manager token "https://api.github.com/user"
 
-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
+        pure Creds
+            { credsPlugin = pluginName
+            , credsIdent = T.pack $ show userId
+            , credsExtra = setExtra token userResponse
+            }
   where
-    oauth = OAuth2
+    oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" `withQuery`
@@ -84,32 +51,3 @@
         , 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
diff --git a/src/Yesod/Auth/OAuth2/Google.hs b/src/Yesod/Auth/OAuth2/Google.hs
--- a/src/Yesod/Auth/OAuth2/Google.hs
+++ b/src/Yesod/Auth/OAuth2/Google.hs
@@ -1,137 +1,69 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- |
 --
 -- OAuth2 plugin for http://www.google.com
 --
 -- * Authenticates against Google
--- * Uses Google user id or email as credentials identifier
--- * Returns given_name, family_name, email, and avatar_url as extras
+-- * Uses Google user id as credentials identifier
 --
--- Note: This may eventually replace Yesod.Auth.GoogleEmail2. Currently it
--- provides the same functionality except that GoogleEmail2 returns more profile
--- information.
+-- If you were previously relying on email as the creds identifier, you can
+-- still do that (and more) by overriding it in the creds returned by the plugin
+-- with any value read out of the new @userResponse@ key in @'credsExtra'@.
 --
+-- For example:
+--
+-- > data User = User { userEmail :: Text }
+-- >
+-- > instance FromJSON User where -- you know...
+-- >
+-- > authenticate creds = do
+-- >     -- 'getUserResponseJSON' provided by "Yesod.Auth.OAuth" module
+-- >     let Right email = userEmail <$> getUserResponseJSON creds
+-- >         updatedCreds = creds { credsIdent = email }
+-- >
+-- >     -- continue normally with updatedCreds
+--
 module Yesod.Auth.OAuth2.Google
     ( oauth2Google
     , oauth2GoogleScoped
-    , oauth2GoogleScopedWithCustomId
-    , googleUid
-    , emailUid
-    , module Yesod.Auth.OAuth2
     ) where
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
+import Yesod.Auth.OAuth2.Prelude
 
-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
+newtype User = User Text
 
--- | Auth with Google
---
--- Requests @openid@ and @email@ scopes and uses email as the @'Creds'@
--- identifier.
---
-oauth2Google :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> AuthPlugin m
-oauth2Google = oauth2GoogleScoped ["openid", "email"]
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
+        -- Required for data backwards-compatibility
+        <$> (("google-uid:" <>) <$> o .: "sub")
 
--- | Auth with Google
---
--- Requests custom scopes and uses email as the @'Creds'@ identifier.
---
-oauth2GoogleScoped :: YesodAuth m
-                   => [Text] -- ^ List of scopes to request
-                   -> Text -- ^ Client ID
-                   -> Text -- ^ Client Secret
-                   -> AuthPlugin m
-oauth2GoogleScoped = oauth2GoogleScopedWithCustomId emailUid
+pluginName :: Text
+pluginName = "google"
 
--- | Auth with Google
---
--- Requests custom scopes and uses the given function to create credentials
--- which allows for using any attribute as the identifier.
---
--- See @'emailUid'@ and @'googleUid'@.
---
-oauth2GoogleScopedWithCustomId :: YesodAuth m
-                               => (GoogleUser -> 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
+defaultScopes :: [Text]
+defaultScopes = ["openid", "email"]
 
+oauth2Google :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Google = oauth2GoogleScoped defaultScopes
+
+oauth2GoogleScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+oauth2GoogleScoped scopes clientId clientSecret =
+    authOAuth2 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
-    oauth = OAuth2
+    oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth" `withQuery`
-            [ scopeParam "+" scopes
+            [ scopeParam " " scopes
             ]
         , oauthAccessTokenEndpoint = "https://www.googleapis.com/oauth2/v3/token"
         , oauthCallback = Nothing
         }
-
-fetchGoogleProfile :: (GoogleUser -> OAuth2Token -> Creds m) -> Manager -> OAuth2Token -> IO (Creds m)
-fetchGoogleProfile toCreds manager token = do
-    userInfo <- authGetJSON manager (accessToken token) "https://www.googleapis.com/oauth2/v3/userinfo"
-    case userInfo of
-      Right user -> return $ toCreds user token
-      Left err -> throwIO $ invalidProfileResponse "google" err
-
-data GoogleUser = GoogleUser
-    { googleUserId :: Text
-    , googleUserName :: Text
-    , googleUserEmail :: Text
-    , googleUserPicture :: Text
-    , googleUserGivenName :: Text
-    , googleUserFamilyName :: Text
-    , googleUserHostedDomain :: Maybe Text
-    }
-
-instance FromJSON GoogleUser where
-    parseJSON (Object o) = GoogleUser
-        <$> o .: "sub"
-        <*> o .: "name"
-        <*> o .: "email"
-        <*> o .: "picture"
-        <*> o .: "given_name"
-        <*> o .: "family_name"
-        <*> o .:? "hd"
-
-    parseJSON _ = mzero
-
--- | Build a @'Creds'@ using the user's google-uid as the identifier
-googleUid :: GoogleUser -> 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)
-    }
diff --git a/src/Yesod/Auth/OAuth2/Nylas.hs b/src/Yesod/Auth/OAuth2/Nylas.hs
--- a/src/Yesod/Auth/OAuth2/Nylas.hs
+++ b/src/Yesod/Auth/OAuth2/Nylas.hs
@@ -1,86 +1,64 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Yesod.Auth.OAuth2.Nylas
     ( oauth2Nylas
-    , module Yesod.Auth.OAuth2
     ) where
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
-
-import Control.Monad (mzero)
-import Control.Exception.Lifted (throwIO)
-import Data.Aeson (FromJSON, Value(..), parseJSON, decode, (.:))
-import Data.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 Yesod.Auth.OAuth2.Prelude
 
+import Control.Monad (unless)
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import Network.HTTP.Client
 import qualified Network.HTTP.Types as HT
 
-data NylasAccount = NylasAccount
-    { nylasAccountId :: Text
-    , nylasAccountEmailAddress :: Text
-    , nylasAccountName :: Text
-    , nylasAccountProvider :: Text
-    , nylasAccountOrganizationUnit :: Text
-    }
+newtype User = User Text
 
-instance FromJSON NylasAccount where
-    parseJSON (Object o) = NylasAccount
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
         <$> o .: "id"
-        <*> o .: "email_address"
-        <*> o .: "name"
-        <*> o .: "provider"
-        <*> o .: "organization_unit"
-    parseJSON _ = mzero
 
-oauth2Nylas :: YesodAuth m
-            => Text -- ^ Client ID
-            -> Text -- ^ Client Secret
-            -> AuthPlugin m
-oauth2Nylas clientId clientSecret = authOAuth2 "nylas" oauth fetchCreds
+pluginName :: Text
+pluginName = "nylas"
+
+defaultScopes :: [Text]
+defaultScopes = ["email"]
+
+oauth2Nylas :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Nylas clientId clientSecret =
+    authOAuth2 pluginName oauth $ \manager token -> do
+        req <- applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) ""
+            <$> parseRequest "https://api.nylas.com/account"
+        resp <- httpLbs req manager
+        let userResponse = responseBody resp
+
+        -- FIXME: was this working? I'm 95% sure that the client will throw its
+        -- own exception on unsuccessful status codes.
+        unless (HT.statusIsSuccessful $ responseStatus resp)
+            $ throwIO $ InvalidProfileResponse pluginName
+            $ "Unsuccessful HTTP response: " <> userResponse
+
+
+        either
+            (throwIO . InvalidProfileResponse pluginName . BL8.pack)
+            (\(User userId) -> pure Creds
+                { credsPlugin = pluginName
+                , credsIdent = userId
+                , credsExtra = setExtra token userResponse
+                }
+            )
+            $ eitherDecode userResponse
   where
     oauth = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" `withQuery`
             [ ("response_type", "code")
-            , ("scope", "email")
             , ("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
             ]
         , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token"
         , oauthCallback = Nothing
         }
-
-fetchCreds :: Manager -> OAuth2Token -> IO (Creds a)
-fetchCreds manager token = do
-    req <- authorize <$> parseRequest "https://api.nylas.com/account"
-    resp <- httpLbs req manager
-    if HT.statusIsSuccessful (responseStatus resp)
-        then case decode (responseBody resp) of
-            Just ns -> return $ toCreds ns token
-            Nothing -> throwIO parseFailure
-        else throwIO requestFailure
-  where
-    authorize = applyBasicAuth (encodeUtf8 $ atoken $ accessToken token) ""
-    parseFailure = InvalidProfileResponse "nylas" "failed to parse account"
-    requestFailure = InvalidProfileResponse "nylas" "failed to get account"
-
-toCreds :: NylasAccount -> OAuth2Token -> Creds a
-toCreds ns token = Creds
-    { credsPlugin = "nylas"
-    , credsIdent = nylasAccountId ns
-    , credsExtra =
-        [ ("email_address", nylasAccountEmailAddress ns)
-        , ("name", nylasAccountName ns)
-        , ("provider", nylasAccountProvider ns)
-        , ("organization_unit", nylasAccountOrganizationUnit ns)
-        , ("access_token", atoken $ accessToken token)
-        ]
-    }
diff --git a/src/Yesod/Auth/OAuth2/Prelude.hs b/src/Yesod/Auth/OAuth2/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/src/Yesod/Auth/OAuth2/Prelude.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# 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
+    ( YesodOAuth2Exception(..)
+
+    -- * Provider helpers
+    , authGetProfile
+    , scopeParam
+    , setExtra
+
+    -- * Text
+    , Text
+    , decodeUtf8
+    , encodeUtf8
+
+    -- * JSON
+    , (.:)
+    , (.:?)
+    , (.=)
+    , (<>)
+    , FromJSON(..)
+    , ToJSON(..)
+    , eitherDecode
+    , withObject
+
+    -- * Exceptions
+    , throwIO
+
+    -- * OAuth2
+    , OAuth2(..)
+    , OAuth2Token(..)
+    , 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 qualified Data.ByteString.Lazy.Char8 as BL8
+import Data.Semigroup ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding
+import Network.HTTP.Conduit
+import Network.OAuth.OAuth2
+import URI.ByteString
+import URI.ByteString.Extension
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+
+-- | Provider name and error
+--
+-- The error is a lazy bytestring because it's most often encoded JSON.
+--
+-- Deprecated. Eventually, we'll return @Either@s all the way up.
+--
+data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
+    deriving (Show, Typeable)
+instance Exception 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 -> OAuth2Token -> 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 @'InvalidProfileResponse'@
+fromAuthGet :: Text -> Either (OAuth2Error Value) BL.ByteString -> IO BL.ByteString
+fromAuthGet _ (Right bs) = pure bs -- nice
+fromAuthGet name (Left err) = throwIO $ InvalidProfileResponse name $ encode err
+
+-- | Throws a decoding error as an @'InvalidProfileResponse'@
+fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
+fromAuthJSON name =
+    -- FIXME: unique exception constructors
+    either (throwIO . InvalidProfileResponse name . BL8.pack) 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
+
+-- | Construct part of @'credsExtra'@
+--
+-- Sets the following keys:
+--
+-- - @accessToken@: to support follow-up requests
+-- - @userResponse@: to support getting additional information
+--
+setExtra :: OAuth2Token -> BL.ByteString -> [(Text, Text)]
+setExtra token userResponse =
+    [ ("accessToken", atoken $ accessToken token)
+    , ("userResponse", decodeUtf8 $ BL.toStrict userResponse)
+    ]
diff --git a/src/Yesod/Auth/OAuth2/Salesforce.hs b/src/Yesod/Auth/OAuth2/Salesforce.hs
--- a/src/Yesod/Auth/OAuth2/Salesforce.hs
+++ b/src/Yesod/Auth/OAuth2/Salesforce.hs
@@ -1,154 +1,74 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 -- |
 --
 -- OAuth2 plugin for http://login.salesforce.com
 --
--- * Authenticates against Salesforce
+-- * Authenticates against Salesforce (or sandbox)
 -- * Uses Salesforce user id as credentials identifier
--- * Returns given_name, family_name, email and avatar_url as extras
 --
 module Yesod.Auth.OAuth2.Salesforce
     ( oauth2Salesforce
     , oauth2SalesforceScoped
     , oauth2SalesforceSandbox
     , oauth2SalesforceSandboxScoped
-    , module Yesod.Auth.OAuth2
     ) where
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
+import Yesod.Auth.OAuth2.Prelude
 
-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
+newtype User = User Text
 
-import qualified Data.Text as T
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
+        <$> o .: "user_id"
 
-oauth2Salesforce :: YesodAuth m
-                 => Text -- ^ Client ID
-                 -> Text -- ^ Client Secret
-                 -> AuthPlugin m
-oauth2Salesforce = oauth2SalesforceScoped ["openid", "email", "api"]
+pluginName :: Text
+pluginName = "salesforce"
 
-svcName :: Text
-svcName = "salesforce"
+defaultScopes :: [Text]
+defaultScopes = ["openid", "email", "api"]
 
-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
-        }
+oauth2Salesforce :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Salesforce = oauth2SalesforceScoped defaultScopes
 
-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
+oauth2SalesforceScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+oauth2SalesforceScoped = salesforceHelper pluginName
+    "https://login.salesforce.com/services/oauth2/userinfo"
+    "https://login.salesforce.com/services/oauth2/authorize"
+    "https://login.salesforce.com/services/oauth2/token"
 
-svcNameSb :: Text
-svcNameSb = "salesforce-sandbox"
+oauth2SalesforceSandbox :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped defaultScopes
 
-oauth2SalesforceSandbox :: YesodAuth m
-                        => Text -- ^ Client ID
-                        -> Text -- ^ Client Secret
-                        -> AuthPlugin m
-oauth2SalesforceSandbox = oauth2SalesforceSandboxScoped ["openid", "email"]
+oauth2SalesforceSandboxScoped :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+oauth2SalesforceSandboxScoped = salesforceHelper (pluginName <> "-sandbox")
+    "https://test.salesforce.com/services/oauth2/userinfo"
+    "https://test.salesforce.com/services/oauth2/authorize"
+    "https://test.salesforce.com/services/oauth2/token"
 
+salesforceHelper
+    :: YesodAuth m
+    => Text
+    -> URI -- ^ User profile
+    -> URI -- ^ Authorize
+    -> URI -- ^ Token
+    -> [Text]
+    -> Text
+    -> Text
+    -> AuthPlugin m
+salesforceHelper name profileUri authorizeUri tokenUri scopes clientId clientSecret =
+    authOAuth2 name oauth2 $ \manager token -> do
+        (User userId, userResponse) <- authGetProfile name manager token profileUri
 
-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
+        pure Creds
+            { credsPlugin = pluginName
+            , credsIdent = userId
+            , credsExtra = setExtra token userResponse
+            }
   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
+    oauth2 = OAuth2
+        { oauthClientId = clientId
+        , oauthClientSecret = clientSecret
+        , oauthOAuthorizeEndpoint = authorizeUri `withQuery` [scopeParam " " scopes]
+        , oauthAccessTokenEndpoint = tokenUri
+        , 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 (Object o) = do
-        userId          <- o .: "user_id"
-        userOrg         <- o .: "organization_id"
-        userNickname    <- o .: "nickname"
-        userName        <- o .: "name"
-        userGivenName   <- o .: "given_name"
-        userFamilyName  <- o .: "family_name"
-        userTimeZone    <- o .: "zoneinfo"
-        userEmail       <- o .: "email"
-        userPicture     <- o .: "picture"
-        userPhone       <- o .:? "phone_number"
-        urls            <- o .: "urls"
-        userRestUrl     <- urls .: "rest"
-        return User{..}
-
-    parseJSON _ = mzero
-
-toCreds :: Text -> User -> OAuth2Token -> Creds m
-toCreds name user token = Creds
-    { credsPlugin = name
-    , credsIdent = userId user
-    , credsExtra =
-        [ ("email", userEmail user)
-        , ("org", userOrg user)
-        , ("nickname", userName user)
-        , ("name", userName user)
-        , ("given_name", userGivenName user)
-        , ("family_name", userFamilyName user)
-        , ("time_zone", userTimeZone user)
-        , ("avatar_url", userPicture user)
-        , ("rest_url", userRestUrl user)
-        , ("access_token", atoken $ accessToken token)
-        ]
-        ++ maybeExtra "refresh_token" (rtoken <$> refreshToken token)
-        ++ maybeExtra "expires_in" ((T.pack . show) <$> expiresIn token)
-        ++ maybeExtra "phone_number" (userPhone user)
-    }
diff --git a/src/Yesod/Auth/OAuth2/Slack.hs b/src/Yesod/Auth/OAuth2/Slack.hs
--- a/src/Yesod/Auth/OAuth2/Slack.hs
+++ b/src/Yesod/Auth/OAuth2/Slack.hs
@@ -4,7 +4,6 @@
 --
 -- * 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(..)
@@ -12,112 +11,63 @@
     , oauth2SlackScoped
     ) where
 
-import Data.Aeson
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-
-import Control.Exception.Lifted (throwIO)
-import Data.Maybe (catMaybes)
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import Network.HTTP.Conduit (Manager)
+import Yesod.Auth.OAuth2.Prelude
 
-import qualified Network.HTTP.Conduit as HTTP
+import Network.HTTP.Client
+    (httpLbs, parseUrlThrow, responseBody, setQueryString)
 
 data SlackScope
-    = SlackEmailScope
+    = SlackBasicScope
+    | SlackEmailScope
     | SlackTeamScope
     | SlackAvatarScope
 
-data SlackUser = SlackUser
-    { slackUserId :: Text
-    , slackUserName :: Text
-    , slackUserEmail :: Maybe Text
-    , slackUserAvatarUrl :: Maybe Text
-    , slackUserTeam :: Maybe SlackTeam
-    }
+scopeText :: SlackScope -> Text
+scopeText SlackBasicScope = "identity.basic"
+scopeText SlackEmailScope = "identity.email"
+scopeText SlackTeamScope = "identity.team"
+scopeText SlackAvatarScope = "identity.avatar"
 
-data SlackTeam = SlackTeam
-    { slackTeamId :: Text
-    , slackTeamName :: Text
-    }
+newtype User = User Text
 
-instance FromJSON SlackUser where
-    parseJSON = withObject "root" $ \root -> do
-        user <- root .: "user"
+instance FromJSON User where
+    parseJSON = withObject "User" $ \root -> do
+        o <- root .: "user"
+        User <$> o .: "id"
 
-        SlackUser
-            <$> user .: "id"
-            <*> user .: "name"
-            <*> user .:? "email"
-            <*> user .:? "image_512"
-            <*> root .:? "team"
+pluginName :: Text
+pluginName = "slack"
 
-instance FromJSON SlackTeam where
-    parseJSON = withObject "team" $ \team ->
-        SlackTeam
-            <$> team .: "id"
-            <*> team .: "name"
+defaultScopes :: [SlackScope]
+defaultScopes = [SlackBasicScope]
 
--- | 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 []
+oauth2Slack :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Slack = oauth2SlackScoped defaultScopes
 
--- | 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
+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
+            (const $ throwIO $ InvalidProfileResponse pluginName userResponse)
+            (\(User userId) -> pure Creds
+                { credsPlugin = pluginName
+                , credsIdent = userId
+                , credsExtra = setExtra token userResponse
+                }
+            )
+            $ eitherDecode userResponse
   where
-    oauth = OAuth2
+    oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery`
-            [ scopeParam "," $ "identity.basic" : map scopeText scopes
+            [ scopeParam "," $ map scopeText scopes
             ]
         , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
         , oauthCallback = Nothing
         }
-
-scopeText :: SlackScope -> Text
-scopeText SlackEmailScope = "identity.email"
-scopeText SlackTeamScope = "identity.team"
-scopeText SlackAvatarScope = "identity.avatar"
-
-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
-
-toCreds :: SlackUser -> OAuth2Token -> Creds m
-toCreds user token = Creds
-    { credsPlugin = "slack"
-    , credsIdent = slackUserId user
-    , credsExtra = catMaybes
-        [ Just ("name", slackUserName user)
-        , Just ("access_token", atoken $ accessToken token)
-        , (,) <$> pure "email" <*> slackUserEmail user
-        , (,) <$> pure "avatar" <*> slackUserAvatarUrl user
-        , (,) <$> pure "team_name" <*> (slackTeamName <$> slackUserTeam user)
-        , (,) <$> pure "team_id" <*> (slackTeamId <$> slackUserTeam user)
-        ]
-    }
diff --git a/src/Yesod/Auth/OAuth2/Spotify.hs b/src/Yesod/Auth/OAuth2/Spotify.hs
--- a/src/Yesod/Auth/OAuth2/Spotify.hs
+++ b/src/Yesod/Auth/OAuth2/Spotify.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- |
 --
@@ -6,102 +5,37 @@
 --
 module Yesod.Auth.OAuth2.Spotify
     ( oauth2Spotify
-    , module Yesod.Auth.OAuth2
     ) where
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>), pure)
-#endif
-
-import Control.Monad (mzero)
-import Data.Aeson
-import Data.Maybe
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-
-import qualified Data.Text as T
-
-data SpotifyUserImage = SpotifyUserImage
-    { spotifyUserImageHeight :: Maybe Int
-    , spotifyUserImageWidth :: Maybe Int
-    , spotifyUserImageUrl :: Text
-    }
-
-instance FromJSON SpotifyUserImage where
-    parseJSON (Object v) = SpotifyUserImage
-        <$> v .:? "height"
-        <*> v .:? "width"
-        <*> v .: "url"
+import Yesod.Auth.OAuth2.Prelude
 
-    parseJSON _ = mzero
+newtype User = User Text
 
-data SpotifyUser = SpotifyUser
-    { spotifyUserId :: Text
-    , spotifyUserHref :: Text
-    , spotifyUserUri :: Text
-    , spotifyUserDisplayName :: Maybe Text
-    , spotifyUserProduct :: Maybe Text
-    , spotifyUserCountry :: Maybe Text
-    , spotifyUserEmail :: Maybe Text
-    , spotifyUserImages :: Maybe [SpotifyUserImage]
-    }
+instance FromJSON User where
+    parseJSON = withObject "User" $ \o -> User
+        <$> o .: "id"
 
-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"
+pluginName :: Text
+pluginName = "spotify"
 
-    parseJSON _ = mzero
+oauth2Spotify :: YesodAuth m => [Text] -> Text -> Text -> AuthPlugin m
+oauth2Spotify scopes clientId clientSecret =
+    authOAuth2 pluginName oauth2 $ \manager token -> do
+        (User userId, userResponse) <-
+            authGetProfile pluginName manager token "https://api.spotify.com/v1/me"
 
-oauth2Spotify :: YesodAuth m
-              => Text -- ^ Client ID
-              -> Text -- ^ Client Secret
-              -> [Text] -- ^ Scopes
-              -> AuthPlugin m
-oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
-    OAuth2
+        pure Creds
+            { credsPlugin = pluginName
+            , credsIdent = userId
+            , credsExtra = setExtra token userResponse
+            }
+  where
+    oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "https://accounts.spotify.com/authorize" `withQuery`
-            [ ("scope", encodeUtf8 $ T.intercalate " " scope)
+            [ scopeParam " " scopes
             ]
         , oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
         , oauthCallback = Nothing
         }
-    $ fromProfileURL "spotify" "https://api.spotify.com/v1/me" toCreds
-
-toCreds :: SpotifyUser -> Creds m
-toCreds user = Creds
-    { credsPlugin = "spotify"
-    , credsIdent = spotifyUserId user
-    , credsExtra = mapMaybe getExtra extrasTemplate
-    }
-
-  where
-    userImage :: Maybe SpotifyUserImage
-    userImage = spotifyUserImages user >>= listToMaybe
-
-    userImagePart :: (SpotifyUserImage -> Maybe a) -> Maybe a
-    userImagePart getter = userImage >>= getter
-
-    extrasTemplate = [ ("href", Just $ spotifyUserHref user)
-                     , ("uri", Just $ spotifyUserUri user)
-                     , ("display_name", spotifyUserDisplayName user)
-                     , ("product", spotifyUserProduct user)
-                     , ("country", spotifyUserCountry user)
-                     , ("email", spotifyUserEmail user)
-                     , ("image_url", spotifyUserImageUrl <$> userImage)
-                     , ("image_height", T.pack . show <$> userImagePart spotifyUserImageHeight)
-                     , ("image_width", T.pack . show <$> userImagePart spotifyUserImageWidth)
-                     ]
-
-    getExtra :: (Text, Maybe Text) -> Maybe (Text, Text)
-    getExtra (key, val) = fmap ((,) key) val
diff --git a/src/Yesod/Auth/OAuth2/Upcase.hs b/src/Yesod/Auth/OAuth2/Upcase.hs
--- a/src/Yesod/Auth/OAuth2/Upcase.hs
+++ b/src/Yesod/Auth/OAuth2/Upcase.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- |
 --
@@ -6,67 +5,41 @@
 --
 -- * Authenticates against upcase
 -- * Uses upcase user id as credentials identifier
--- * Returns first_name, last_name, and email as extras
 --
 module Yesod.Auth.OAuth2.Upcase
     ( oauth2Upcase
-    , module Yesod.Auth.OAuth2
     ) where
 
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative ((<$>), (<*>))
-#endif
+import Yesod.Auth.OAuth2.Prelude
 
-import Control.Monad (mzero)
-import Data.Aeson
-import Data.Text (Text)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
 import qualified Data.Text as T
 
-data UpcaseUser = UpcaseUser
-    { upcaseUserId :: Int
-    , upcaseUserFirstName :: Text
-    , upcaseUserLastName :: Text
-    , upcaseUserEmail :: Text
-    }
-
-instance FromJSON UpcaseUser where
-    parseJSON (Object o) = UpcaseUser
-        <$> o .: "id"
-        <*> o .: "first_name"
-        <*> o .: "last_name"
-        <*> o .: "email"
-
-    parseJSON _ = mzero
+newtype User = User Int
 
-newtype UpcaseResponse = UpcaseResponse UpcaseUser
+instance FromJSON User where
+    parseJSON = withObject "User" $ \root -> do
+        o <- root .: "user"
+        User <$> o .: "id"
 
-instance FromJSON UpcaseResponse where
-    parseJSON (Object o) = UpcaseResponse
-        <$> o .: "user"
+pluginName :: Text
+pluginName = "upcase"
 
-    parseJSON _ = mzero
+oauth2Upcase :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Upcase clientId clientSecret =
+    authOAuth2 pluginName oauth2 $ \manager token -> do
+        (User userId, userResponse) <-
+            authGetProfile pluginName manager token "http://upcase.com/api/v1/me.json"
 
-oauth2Upcase :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> AuthPlugin m
-oauth2Upcase clientId clientSecret = authOAuth2 "upcase"
-    OAuth2
+        pure Creds
+            { credsPlugin = pluginName
+            , credsIdent = T.pack $ show userId
+            , credsExtra = setExtra token userResponse
+            }
+  where
+    oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
         , oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize"
         , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token"
         , oauthCallback = Nothing
-        }
-    $ fromProfileURL "upcase" "http://upcase.com/api/v1/me.json"
-    $ \user -> Creds
-        { credsPlugin = "upcase"
-        , credsIdent = T.pack $ show $ upcaseUserId user
-        , credsExtra =
-            [ ("first_name", upcaseUserFirstName user)
-            , ("last_name", upcaseUserLastName user)
-            , ("email", upcaseUserEmail user)
-            ]
         }
diff --git a/test/URI/ByteString/ExtensionSpec.hs b/test/URI/ByteString/ExtensionSpec.hs
--- a/test/URI/ByteString/ExtensionSpec.hs
+++ b/test/URI/ByteString/ExtensionSpec.hs
@@ -1,8 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module URI.ByteString.ExtensionSpec
-    ( main
-    , spec
+    ( spec
     ) where
 
 import Test.Hspec
@@ -12,9 +11,6 @@
 import URI.ByteString
 import URI.ByteString.Extension
 import URI.ByteString.QQ
-
-main :: IO ()
-main = hspec spec
 
 spec :: Spec
 spec = do
diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal
--- a/yesod-auth-oauth2.cabal
+++ b/yesod-auth-oauth2.cabal
@@ -2,18 +2,18 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 86087f5e361d8686832a02a805ac3132bb640ed555912b2f45d98e978edd6677
+-- hash: adce3f04c3cdf1be9321b5402956fabab0b850d7b2033fbb2e9921b1d6756b3e
 
 name:           yesod-auth-oauth2
-version:        0.3.1
+version:        0.4.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/thoughtbot/yesod-auth-oauth2
 bug-reports:    https://github.com/thoughtbot/yesod-auth-oauth2.git/issues
 author:         Tom Streller
-maintainer:     Pat Brisbin 
-license:        BSD3
+maintainer:     Pat Brisbin 
+license:        MIT
 license-file:   LICENSE
 build-type:     Simple
 cabal-version:  >= 1.10
@@ -30,35 +30,35 @@
 library
   hs-source-dirs:
       src
+  ghc-options: -Wall
   build-depends:
-      aeson >=0.6 && <1.3
-    , authenticate >=1.3.2.7 && <1.4
-    , base >=4.5 && <5
+      aeson >=0.6 && <1.4
+    , base >=4.9.0.0 && <5
     , bytestring >=0.9.1.4
+    , errors
     , hoauth2 >=1.3.0 && <1.6
     , http-client >=0.4.0 && <0.6
     , http-conduit >=2.0 && <3.0
     , http-types >=0.8 && <0.10
-    , lifted-base >=0.2 && <0.4
     , microlens
-    , network-uri >=2.6
     , random
+    , safe-exceptions
     , text >=0.7 && <2.0
     , transformers >=0.2.2 && <0.6
     , uri-bytestring
-    , vector >=0.10 && <0.13
     , yesod-auth >=1.3 && <1.5
     , yesod-core >=1.2 && <1.5
-    , yesod-form >=1.3 && <1.5
   exposed-modules:
       URI.ByteString.Extension
       Yesod.Auth.OAuth2
       Yesod.Auth.OAuth2.BattleNet
       Yesod.Auth.OAuth2.Bitbucket
+      Yesod.Auth.OAuth2.Dispatch
       Yesod.Auth.OAuth2.EveOnline
       Yesod.Auth.OAuth2.Github
       Yesod.Auth.OAuth2.Google
       Yesod.Auth.OAuth2.Nylas
+      Yesod.Auth.OAuth2.Prelude
       Yesod.Auth.OAuth2.Salesforce
       Yesod.Auth.OAuth2.Slack
       Yesod.Auth.OAuth2.Spotify
@@ -68,12 +68,15 @@
   default-language: Haskell2010
 
 executable yesod-auth-oauth2-example
-  main-is: main.hs
+  main-is: Main.hs
   hs-source-dirs:
       example
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.5 && <5
+      aeson
+    , aeson-pretty
+    , base >=4.9.0.0 && <5
+    , bytestring
     , containers
     , http-conduit
     , load-env
@@ -93,8 +96,9 @@
   main-is: Spec.hs
   hs-source-dirs:
       test
+  ghc-options: -Wall
   build-depends:
-      base >=4.5 && <5
+      base >=4.9.0.0 && <5
     , hspec
     , uri-bytestring
     , yesod-auth-oauth2