Update dependencies, make it work, address -Wall

Housekeeping:

* Use newer http-conduit (Request m becomes Request)
* Increase upper bound on aeson
* Fix whitespace, remove unfinished function
* Add type signatures and some comments
* Remove unused imports

Fixes:

* ByteString needs an orphan JSON instance so AccessToken can have one.
  I'm not sure if there's a way around this.
* redirect takes a Text, not a ByteString
* dispatch for "callback" should handle setting the credentials

Additions

* oauth2Learn for authenticating against learn.thoughtbot.com

Yesod/Auth/OAuth2.hs

@@ -1,13 +1,15 @@
 {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, QuasiQuotes #-}
-module Yesod.Auth.OAuth2 where
+module Yesod.Auth.OAuth2
+    ( authOAuth2
+    , oauth2Google
+    , oauth2Learn
+    ) where
 
 import Control.Monad.IO.Class
 import Data.ByteString          (ByteString)
 import Data.Text                (Text)
 import Data.Text.Encoding       (decodeUtf8With, encodeUtf8)
 import Data.Text.Encoding.Error (lenientDecode)
-import Data.Maybe
-import Network.HTTP.Conduit as C
 import Yesod.Auth
 import Yesod.Form
 import Yesod.Core
@@ -16,7 +18,18 @@ import Yesod.Auth.OAuth2.Internal
 oauth2Url :: Text -> AuthRoute
 oauth2Url name = PluginR name ["forward"]
 
-authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
+authOAuth2 :: YesodAuth m
+           => Text   -- ^ Service name
+           -> OAuth2 -- ^ Service details
+
+           -- | This function defines how to take an @'AccessToken'@ and
+           --   retrive additional information about the user, to be set
+           --   in the session as @'Creds'@. Usually this means a second
+           --   authorized request to @api/me.json@.
+           -> (AccessToken -> IO (Creds m))
+           -> AuthPlugin m
+authOAuth2 name oauth mkCreds = AuthPlugin name dispatch login
+
     where
         url = PluginR name ["callback"]
         dispatch "GET" ["forward"] = do
@@ -24,32 +37,37 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
             lift $ do
                 render <- getUrlRender
                 let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
-                redirect $ authorizationUrl oauth'
+                redirect $ bsToText $ authorizationUrl oauth'
         dispatch "GET" ["callback"] = do
+            tm <- getRouteToParent
+            render <- lift $ getUrlRender
             code <- lift $ runInputGet $ ireq textField "code"
-            mtoken <- liftIO $ postAccessToken oauth (encodeUtf8 code) (Just "authorization_code")
+            let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
+            mtoken <- liftIO $ postAccessToken oauth' (encodeUtf8 code) (Just "authorization_code")
             case mtoken of
                 Nothing -> permissionDenied "Couldn't get token"
-                Just token -> getCreds token
+                Just token -> do
-        disptach _ _ = notFound
+                    creds <- liftIO $ mkCreds token
+                    lift $ setCreds True creds
+        dispatch _ _ = notFound
         login tm = do
             render <- getUrlRender
             let oaUrl = render $ tm $ oauth2Url name
             [whamlet| <a href=#{oaUrl}>Login via #{name} |]
 
+oauth2Google :: Text -> Text -> OAuth2
 oauth2Google clientId clientSecret = newOAuth2 { oauthClientId = encodeUtf8 clientId
                                                , oauthClientSecret = encodeUtf8 clientSecret
                                                , oauthOAuthorizeEndpoint = "https://accounts.google.com/o/oauth2/auth"
                                                , oauthAccessTokenEndpoint = "https://accounts.google.com/o/oauth2/token" }
 
-cloudsdaleAuth clientId clientSecret = authOAuth2 "cloudsdale" oauth2 $ \token -> do
+oauth2Learn :: Text -> Text -> OAuth2
-    rsp <- request $ authorizeRequest token $ fromJust $ parseUrl "http://api.cloudsdale.org/v2/me.json"
+oauth2Learn clientId clientSecret = newOAuth2
-    undefined
+    { oauthClientId            = encodeUtf8 clientId
-    where
+    , oauthClientSecret        = encodeUtf8 clientSecret
-        oauth2 = newOAuth2 { oauthClientId = encodeUtf8 clientId
+    , oauthOAuthorizeEndpoint  = "http://learn.thoughtbot.com/oauth/authorize"
-                           , oauthClientSecret = encodeUtf8 clientSecret
+    , oauthAccessTokenEndpoint = "http://learn.thoughtbot.com/oauth/token"
-                           , oauthOAuthorizeEndpoint = "http://www.cloudsdale.org/oauth/authorize"
+    }
-                           , oauthAccessTokenEndpoint = "http://www.cloudsdale.org/oauth/token" }
 
 bsToText :: ByteString -> Text
 bsToText = decodeUtf8With lenientDecode

Yesod/Auth/OAuth2/Internal.hs

@@ -1,13 +1,13 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 module Yesod.Auth.OAuth2.Internal where
 
 {- see https://gist.github.com/qzchenwl/2351071 -}
- 
+
 import Data.Aeson
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as BSL
-import Data.ByteString.Lazy (toChunks)
 import Data.List
 import Data.Maybe
 import Data.Typeable (Typeable)
@@ -15,9 +15,14 @@ import Network.HTTP.Types (renderSimpleQuery, parseSimpleQuery)
 import qualified Network.HTTP.Types as HT
 import Network.HTTP.Conduit as C
 import Control.Exception
-import Control.Applicative ((<$>))
+import Control.Applicative ((<$>), pure)
 import Control.Monad (mzero)
- 
+import Data.Text.Encoding (encodeUtf8)
+
+instance FromJSON BS.ByteString where
+    parseJSON (String t) = pure $ encodeUtf8 t
+    parseJSON _          = mzero
+
 data OAuth2 = OAuth2 { oauthClientId :: BS.ByteString
                      , oauthClientSecret :: BS.ByteString
                      , oauthOAuthorizeEndpoint :: BS.ByteString
@@ -25,12 +30,12 @@ data OAuth2 = OAuth2 { oauthClientId :: BS.ByteString
                      , oauthCallback :: Maybe BS.ByteString
                      , oauthAccessToken :: Maybe BS.ByteString
                      } deriving (Show, Eq)
- 
+
 data OAuthException = OAuthException String
                       deriving (Show, Eq, Typeable)
- 
+
 instance Exception OAuthException
- 
+
 newOAuth2 :: OAuth2
 newOAuth2 = OAuth2 { oauthClientId = error "You must specify client id."
                    , oauthClientSecret = error "You must specify client secret."
@@ -39,32 +44,17 @@ newOAuth2 = OAuth2 { oauthClientId = error "You must specify client id."
                    , oauthCallback = Nothing
                    , oauthAccessToken = Nothing
                    }
- 
+
 authorizationUrl :: OAuth2 -> BS.ByteString
-authorizationUrl oa = oauthOAuthorizeEndpoint oa `BS.append` queryString
+authorizationUrl oa = oauthOAuthorizeEndpoint oa `BS.append` queryString'
-  where queryString = renderSimpleQuery True query
+  where queryString' = renderSimpleQuery True query
         query = foldr step [] [ ("client_id", Just $ oauthClientId oa)
                               , ("response_type", Just "code")
                               , ("redirect_uri", oauthCallback oa)]
- 
+
+request :: Request -> IO (Response BSL.ByteString)
 request req = (withManager . httpLbs) (req { checkStatus = \_ _ _ -> Nothing })
- 
+
-getAccessToken' :: OAuth2 -> BS.ByteString -> Maybe BS.ByteString -> IO BSL.ByteString
-getAccessToken' oa code grant_type = do
-    rsp <- request req
-    if (HT.statusCode . responseStatus) rsp == 200
-        then return $ responseBody rsp
-        else throwIO . OAuthException $ "Gaining access_token failed: " ++ BSL.unpack (responseBody rsp)
-  where
-    req = fromJust $ parseUrl url
-    url = BS.unpack $ oauthAccessTokenEndpoint oa `BS.append` queryString
-    queryString = renderSimpleQuery True query
-    query = foldr step [] [ ("client_id", Just $ oauthClientId oa)
-                          , ("client_secret", Just $ oauthClientSecret oa)
-                          , ("code", Just code)
-                          , ("redirect_uri", oauthCallback oa)
-                          , ("grant_type", grant_type) ]
- 
 postAccessToken' :: OAuth2 -> BS.ByteString -> Maybe BS.ByteString -> IO BSL.ByteString
 postAccessToken' oa code grant_type = do
     rsp <- request req
@@ -80,23 +70,20 @@ postAccessToken' oa code grant_type = do
                           , ("code", Just code)
                           , ("redirect_uri", oauthCallback oa)
                           , ("grant_type", grant_type) ]
- 
+
 step :: (a, Maybe b) -> [(a, b)] -> [(a, b)]
 step (a, Just b) xs = (a, b):xs
 step _           xs = xs
- 
+
-getAccessToken :: OAuth2 -> BS.ByteString -> Maybe BS.ByteString -> IO (Maybe AccessToken)
-getAccessToken oa code grant_type = decode <$> getAccessToken' oa code grant_type
- 
 postAccessToken :: OAuth2 -> BS.ByteString -> Maybe BS.ByteString -> IO (Maybe AccessToken)
 postAccessToken oa code grant_type = decode <$> postAccessToken' oa code grant_type
- 
+
 data AccessToken = AccessToken { accessToken :: BS.ByteString } deriving (Show)
 instance FromJSON AccessToken where
     parseJSON (Object o) = AccessToken <$> o .: "access_token"
     parseJSON _          = mzero
- 
+
-signRequest :: OAuth2 -> Request m -> Request m
+signRequest :: OAuth2 -> Request -> Request
 signRequest oa req = req { queryString = (renderSimpleQuery False newQuery) }
   where
     newQuery = case oauthAccessToken oa of
@@ -104,7 +91,7 @@ signRequest oa req = req { queryString = (renderSimpleQuery False newQuery) }
                     _       -> insert ("client_id", oauthClientId oa) . insert ("client_secret", oauthClientSecret oa) $ oldQuery
     oldQuery = parseSimpleQuery (queryString req)
 
-authorizeRequest :: AccessToken -> Request m -> Request m
+authorizeRequest :: AccessToken -> Request -> Request
 authorizeRequest (AccessToken token) req = req { requestHeaders = auth : requestHeaders req }
     where
         auth = ("Authorization", BS.concat ["Bearer ", token])

yesod-auth-oauth2.cabal

@@ -21,9 +21,9 @@ library
     else
         build-depends:   base                >= 4         && < 4.3
     build-depends:   bytestring              >= 0.9.1.4
-                   , http-conduit            >= 1.9       && < 2
+                   , http-conduit            >= 2.0       && < 3.0
                    , http-types              >= 0.8       && < 0.9
-                   , aeson                   >= 0.6       && < 0.7
+                   , aeson                   >= 0.6       && < 0.8
                    , yesod-core              >= 1.2       && < 1.3
                    , yesod-auth              >= 1.2       && < 1.3
                    , text                    >= 0.7       && < 0.12