Merge 7e61f24c4b into 6d547b157c

Yesod/Auth/OAuth2.hs

@@ -10,8 +10,10 @@
 -- * See Yesod.Auth.OAuth2.GitHub for example usage.
 --
 module Yesod.Auth.OAuth2
-    ( authOAuth2
+    ( OAuth2Plugin(..)
     , oauth2Url
+    , oauth2Plugin
+    , authOAuth2
     , YesodOAuth2Exception(..)
     , module Network.OAuth.OAuth2
     ) where
@@ -43,9 +45,45 @@ data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
 
 instance Exception YesodOAuth2Exception
 
+data OAuth2Plugin a = OAuth2Plugin
+    { oapName :: Text
+    , oapAuthEndpoint :: Text
+    , oapTokenEndpoint :: Text
+    , oapFetchProfile :: Manager -> AccessToken -> IO (Either BL.ByteString a)
+    , oapToCredsIdent :: a -> Text
+    , oapToCredsExtra :: a -> [(Text, Text)]
+    }
+
 oauth2Url :: Text -> AuthRoute
 oauth2Url name = PluginR name ["forward"]
 
+oauth2Plugin :: (FromJSON a, YesodAuth m)
+             => OAuth2Plugin a
+             -> Text -- ^ Client ID
+             -> Text -- ^ Client Secret
+             -> AuthPlugin m
+oauth2Plugin oap clientId clientSecret =
+    authOAuth2 (oapName oap) oapOauth $ \manager token -> do
+        result <- oapFetchProfile oap manager token
+
+        case result of
+            Left err -> throwIO $ InvalidProfileResponse (oapName oap) err
+            Right user -> return Creds
+                { credsIdent = oapToCredsIdent oap user
+                , credsPlugin = oapName oap
+                , credsExtra = oapToCredsExtra oap user
+                }
+
+  where
+    oapOauth :: OAuth2
+    oapOauth = OAuth2
+        { oauthClientId = encodeUtf8 clientId
+        , oauthClientSecret = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint = encodeUtf8 $ oapAuthEndpoint oap
+        , oauthAccessTokenEndpoint = encodeUtf8 $ oapTokenEndpoint oap
+        , oauthCallback = Nothing
+        }
+
 authOAuth2 :: YesodAuth m
            => Text   -- ^ Service name
            -> OAuth2 -- ^ Service details

Yesod/Auth/OAuth2/Twitter.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Yesod.Auth.OAuth2.Twitter
+    ( oauth2Twitter
+    , module Yesod.Auth.OAuth2
+    ) where
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
+
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Text (Text)
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+
+data TwitterUser = TwitterUser
+    { twitterUserId :: Text
+    , twitterUserName :: Text
+    , twitterScreenName :: Text
+    }
+
+instance FromJSON TwitterUser where
+    parseJSON (Object o) = TwitterUser
+        <$> o .: "id_str"
+        <*> o .: "name"
+        <*> o .: "screen_name"
+
+    parseJSON _ = mzero
+
+oauth2Twitter :: YesodAuth m => Text -> Text -> AuthPlugin m
+oauth2Twitter = oauth2Plugin OAuth2Plugin
+    { oapName = "twitter"
+    , oapAuthEndpoint = "https://api.twitter.com/oauth/authorize"
+    , oapTokenEndpoint = "https://api.twitter.com/oauth/access_token"
+    , oapFetchProfile = fetchProfile
+    , oapToCredsIdent = twitterUserId
+    , oapToCredsExtra = toCredsExtra
+    }
+
+  where
+    fetchProfile manager token = authGetJSON manager token
+        "https://api.twitter.com/1.1/account/verify_credentials.json"
+
+    toCredsExtra user =
+        [ ("name", twitterUserName user)
+        , ("screen_name", twitterScreenName user)
+        ]

yesod-auth-oauth2.cabal

@@ -40,6 +40,7 @@ library
     exposed-modules: Yesod.Auth.OAuth2
                      Yesod.Auth.OAuth2.Github
                      Yesod.Auth.OAuth2.Spotify
+                     Yesod.Auth.OAuth2.Twitter
                      Yesod.Auth.OAuth2.Upcase
 
     ghc-options:     -Wall