Learn rebranded as Upcase

Yesod/Auth/OAuth2.hs

@@ -5,7 +5,7 @@
 --
 -- Generic OAuth2 plugin for Yesod
 --
--- * See Yesod.Auth.OAuth2.Learn for example usage.
+-- * See Yesod.Auth.OAuth2.GitHub for example usage.
 --
 module Yesod.Auth.OAuth2
     ( authOAuth2

Yesod/Auth/OAuth2/Learn.hs

@@ -1,78 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
--- |
---
--- OAuth2 plugin for http://learn.thoughtbot.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.Exception.Lifted
-import Control.Monad (mzero)
-import Data.Aeson
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import Yesod.Auth
-import Yesod.Auth.OAuth2
-import Network.HTTP.Conduit(Manager)
-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 :: Manager -> AccessToken -> IO (Creds m)
-fetchLearnProfile manager token = do
-    result <- authGetJSON manager token "http://learn.thoughtbot.com/api/v1/me.json"
-
-    case result of
-        Right (LearnResponse user) -> return $ toCreds user
-        Left err -> throwIO $ InvalidProfileResponse "learn" err
-
-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/Upcase.hs

@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+--
+-- OAuth2 plugin for http://upcase.com
+--
+-- * Authenticates against upcase
+-- * Uses upcase user id as credentials identifier
+-- * Returns first_name, last_name, and email as extras
+--
+module Yesod.Auth.OAuth2.Upcase
+    ( oauth2Upcase
+    , module Yesod.Auth.OAuth2
+    ) where
+
+import Control.Applicative ((<$>), (<*>))
+import Control.Exception.Lifted
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+import Network.HTTP.Conduit(Manager)
+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
+
+data UpcaseResponse = UpcaseResponse UpcaseUser
+
+instance FromJSON UpcaseResponse where
+    parseJSON (Object o) =
+        UpcaseResponse <$> o .: "user"
+
+    parseJSON _ = mzero
+
+oauth2Upcase :: YesodAuth m
+            => Text -- ^ Client ID
+            -> Text -- ^ Client Secret
+            -> AuthPlugin m
+oauth2Upcase clientId clientSecret = authOAuth2 "upcase"
+    OAuth2
+        { oauthClientId            = encodeUtf8 clientId
+        , oauthClientSecret        = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint  = "http://upcase.com/oauth/authorize"
+        , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token"
+        , oauthCallback            = Nothing
+        }
+    fetchUpcaseProfile
+
+fetchUpcaseProfile :: Manager -> AccessToken -> IO (Creds m)
+fetchUpcaseProfile manager token = do
+    result <- authGetJSON manager token "http://upcase.com/api/v1/me.json"
+
+    case result of
+        Right (UpcaseResponse user) -> return $ toCreds user
+        Left err -> throwIO $ InvalidProfileResponse "upcase" err
+
+toCreds :: UpcaseUser -> Creds m
+toCreds user = Creds "upcase"
+    (T.pack $ show $ upcaseUserId user)
+    [ ("first_name", upcaseUserFirstName user)
+    , ("last_name" , upcaseUserLastName user)
+    , ("email"     , upcaseUserEmail user)
+    ]

yesod-auth-oauth2.cabal

@@ -45,9 +45,9 @@ library
                    , lifted-base             >= 0.2       && < 0.4
 
     exposed-modules: Yesod.Auth.OAuth2
-                     Yesod.Auth.OAuth2.Learn
                      Yesod.Auth.OAuth2.Github
                      Yesod.Auth.OAuth2.Spotify
+                     Yesod.Auth.OAuth2.Upcase
 
     ghc-options:     -Wall