Refactor to separate modules, document things

* oauth2 functions now handle the getCreds argument themselves
* Learn is updated to do the Right Thing
* Google is unfinished

Yesod/Auth/OAuth2.hs

@@ -1,21 +1,25 @@
 {-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
+-- |
+--
+-- Generic OAuth2 plugin for Yesod
+--
+-- * See Yesod.Auth.OAuth2.Learn for example usage.
+--
 module Yesod.Auth.OAuth2
     ( authOAuth2
     , oauth2Url
-    , oauth2Google
-    , oauth2Learn
     , module Network.OAuth.OAuth2
     ) where
 
 import Control.Monad.IO.Class
-import Data.ByteString          (ByteString)
+import Data.ByteString (ByteString)
-import Data.Text                (Text)
+import Data.Text (Text)
-import Data.Text.Encoding       (decodeUtf8With, encodeUtf8)
+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
 import Data.Text.Encoding.Error (lenientDecode)
-import Yesod.Auth
-import Yesod.Form
-import Yesod.Core
 import Network.OAuth.OAuth2
+import Yesod.Auth
+import Yesod.Core
+import Yesod.Form
 
 oauth2Url :: Text -> AuthRoute
 oauth2Url name = PluginR name ["forward"]
@@ -30,7 +34,7 @@ authOAuth2 :: YesodAuth m
            --   authorized request to @api/me.json@.
            -> (AccessToken -> IO (Creds m))
            -> AuthPlugin m
-authOAuth2 name oauth mkCreds = AuthPlugin name dispatch login
+authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
 
     where
         url = PluginR name ["callback"]
@@ -51,7 +55,7 @@ authOAuth2 name oauth mkCreds = AuthPlugin name dispatch login
             case result of
                 Left _ -> permissionDenied "Unable to retreive OAuth2 token"
                 Right token -> do
-                    creds <- liftIO $ mkCreds token
+                    creds <- liftIO $ getCreds token
                     lift $ setCreds True creds
 
         dispatch _ _ = notFound
@@ -61,23 +65,5 @@ authOAuth2 name oauth mkCreds = AuthPlugin name dispatch login
             let oaUrl = render $ tm $ oauth2Url name
             [whamlet| <a href=#{oaUrl}>Login via #{name} |]
 
-oauth2Google :: Text -> Text -> OAuth2
-oauth2Google clientId clientSecret = OAuth2
-    { oauthClientId            = encodeUtf8 clientId
-    , oauthClientSecret        = encodeUtf8 clientSecret
-    , oauthOAuthorizeEndpoint  = "https://accounts.google.com/o/oauth2/auth"
-    , oauthAccessTokenEndpoint = "https://accounts.google.com/o/oauth2/token"
-    , oauthCallback            = Nothing
-    }
-
-oauth2Learn :: Text -> Text -> OAuth2
-oauth2Learn clientId clientSecret = OAuth2
-    { oauthClientId            = encodeUtf8 clientId
-    , oauthClientSecret        = encodeUtf8 clientSecret
-    , oauthOAuthorizeEndpoint  = "http://learn.thoughtbot.com/oauth/authorize"
-    , oauthAccessTokenEndpoint = "http://learn.thoughtbot.com/oauth/token"
-    , oauthCallback            = Nothing
-    }
-
 bsToText :: ByteString -> Text
 bsToText = decodeUtf8With lenientDecode

Yesod/Auth/OAuth2/Google.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+--
+-- OAuth2 plugin for http://google.com
+--
+-- * Note: this module is unfinished, do not use.
+--
+module Yesod.Auth.OAuth2.Google
+    ( oauth2Google
+    , module Yesod.Auth.OAuth2
+    ) where
+
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+
+oauth2Google :: YesodAuth m
+             => Text -- ^ Client ID
+             -> Text -- ^ Client Secret
+             -> AuthPlugin m
+oauth2Google clientId clientSecret = authOAuth2 "google"
+    (OAuth2
+        { oauthClientId            = encodeUtf8 clientId
+        , oauthClientSecret        = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint  = "https://accounts.google.com/o/oauth2/auth"
+        , oauthAccessTokenEndpoint = "https://accounts.google.com/o/oauth2/token"
+        , oauthCallback            = Nothing
+        })
+    undefined -- TODO

Yesod/Auth/OAuth2/Learn.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+--
+-- OAuth2 plugin for http://learn.thoughbot.com
+--
+-- * Authenticates against learn
+-- * Uses learn user id as credentials identifier
+-- * Returns first_name, last_name, and email as extras
+--
+module Yesod.Auth.OAuth2.Learn
+    ( oauth2Learn
+    , module Yesod.Auth.OAuth2
+    ) where
+
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+import qualified Data.Text as T
+
+data LearnUser = LearnUser
+    { learnUserId        :: Int
+    , learnUserFirstName :: Text
+    , learnUserLastName  :: Text
+    , learnUserEmail     :: Text
+    }
+
+instance FromJSON LearnUser where
+    parseJSON (Object o) =
+        LearnUser <$> o .: "id"
+                  <*> o .: "first_name"
+                  <*> o .: "last_name"
+                  <*> o .: "email"
+
+    parseJSON _ = mzero
+
+data LearnResponse = LearnResponse LearnUser
+
+instance FromJSON LearnResponse where
+    parseJSON (Object o) =
+        LearnResponse <$> o .: "user"
+
+    parseJSON _ = mzero
+
+oauth2Learn :: YesodAuth m
+            => Text -- ^ Client ID
+            -> Text -- ^ Client Secret
+            -> AuthPlugin m
+oauth2Learn clientId clientSecret = authOAuth2 "learn"
+    (OAuth2
+        { oauthClientId            = encodeUtf8 clientId
+        , oauthClientSecret        = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint  = "http://learn.thoughtbot.com/oauth/authorize"
+        , oauthAccessTokenEndpoint = "http://learn.thoughtbot.com/oauth/token"
+        , oauthCallback            = Nothing
+        })
+    fetchLearnProfile
+
+fetchLearnProfile :: AccessToken -> IO (Creds m)
+fetchLearnProfile token = do
+    result <- authGetJSON token "http://learn.thoughtbot.com/api/v1/me.json"
+
+    case result of
+        Right (LearnResponse user) -> return $ toCreds user
+        _ -> error "Invalid response for learn profile data"
+
+toCreds :: LearnUser -> Creds m
+toCreds user = Creds "learn"
+    (T.pack $ show $ learnUserId user)
+    [ ("first_name", learnUserFirstName user)
+    , ("last_name" , learnUserLastName user)
+    , ("email"     , learnUserEmail user)
+    ]

yesod-auth-oauth2.cabal

@@ -33,6 +33,8 @@ library
                    , hoauth2                 >= 0.3.6     && < 0.4
 
     exposed-modules: Yesod.Auth.OAuth2
+                     Yesod.Auth.OAuth2.Google
+                     Yesod.Auth.OAuth2.Learn
 
     ghc-options:     -Wall