From a7e9695e26d081c63aaca9dc61a0dfa38f6c2151 Mon Sep 17 00:00:00 2001
From: Hiromi Ishii <konn.jinro_at_gmail.com>
Date: Mon, 7 Mar 2011 18:27:03 +0900
Subject: [PATCH] added OAuth support

---
 Yesod/Helpers/Auth/OAuth.hs | 87 +++++++++++++++++++++++++++++++++++++
 yesod-auth.cabal            | 14 +++++-
 2 files changed, 100 insertions(+), 1 deletion(-)
 create mode 100644 Yesod/Helpers/Auth/OAuth.hs

diff --git a/Yesod/Helpers/Auth/OAuth.hs b/Yesod/Helpers/Auth/OAuth.hs
new file mode 100644
index 00000000..06836f28
--- /dev/null
+++ b/Yesod/Helpers/Auth/OAuth.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE CPP, QuasiQuotes, OverloadedStrings #-}
+{-# OPTIONS_GHC -fwarn-unused-imports #-}
+module Yesod.Helpers.Auth.OAuth
+    ( authOAuth
+    , oauthUrl
+    , authTwitter
+    , twitterUrl
+    ) where
+import Yesod.Helpers.Auth
+import Yesod.Form
+import Yesod.Handler
+import Yesod.Widget
+import Text.Hamlet (hamlet)
+import Web.Authenticate.OAuth
+import Data.Maybe
+import Data.String
+import Network.HTTP.Enumerator
+import Data.ByteString.Char8 (unpack, pack)
+import Control.Arrow ((***))
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Class (lift)
+
+oauthUrl :: String -> AuthRoute
+oauthUrl name = PluginR name ["forward"]
+
+authOAuth :: YesodAuth m =>
+             String -- ^ Service Name
+          -> String -- ^ OAuth Parameter Name to use for identify
+          -> String -- ^ Request URL
+          -> String -- ^ Access Token URL
+          -> String -- ^ Authorize URL
+          -> String -- ^ Consumer Key
+          -> String -- ^ Consumer Secret
+          -> AuthPlugin m
+authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch login
+  where
+    url = PluginR name []
+    oauth = OAuth { oauthServerName = name, oauthRequestUri = reqUrl
+                  , oauthAccessTokenUri = accUrl, oauthAuthorizeUri = authUrl
+                  , oauthSignatureMethod = HMACSHA1
+                  , oauthConsumerKey = fromString key, oauthConsumerSecret = fromString sec
+                  , oauthCallback = Nothing
+                  }
+    dispatch "GET" ["forward"] = do
+        render <- getUrlRender
+        tm <- getRouteToMaster
+        let oauth' = oauth { oauthCallback = Just $ fromString $ render $ tm url }
+        tok <- liftIO $ getTemporaryCredential oauth'
+        redirectString RedirectTemporary (fromString $ authorizeUrl oauth' tok)
+    dispatch "GET" [] = do
+        render <- getUrlRender
+        tm <- getRouteToMaster
+        let callback = render $ tm url
+        verifier <- runFormGet' $ stringInput "oauth_verifier"
+        oaTok    <- runFormGet' $ stringInput "oauth_token"
+        let reqTok = Credential [ ("oauth_verifier", pack verifier), ("oauth_token", pack oaTok)
+                                ] 
+        accTok <- liftIO $ getTokenCredential oauth reqTok
+        let crId = unpack $ fromJust $ lookup (pack ident) $ unCredential accTok
+            creds = Creds name crId $ map (unpack *** unpack) $ unCredential accTok
+        setCreds True creds
+    dispatch _ _ = notFound
+    login tm = do
+        render <- lift getUrlRender
+        let oaUrl = render $ tm $ oauthUrl name
+        addHtml
+#if GHC7
+          [hamlet|
+#else
+          [$hamlet|
+#endif
+             <a href=#{oaUrl}>Login with #{name}
+          |]
+
+authTwitter :: YesodAuth m =>
+               String -- ^ Consumer Key
+            -> String -- ^ Consumer Secret
+            -> AuthPlugin m
+authTwitter = authOAuth "twitter"
+                        "screen_name"
+                        "http://twitter.com/oauth/request_token"
+                        "http://twitter.com/oauth/access_token"
+                        "http://twitter.com/oauth/authorize"
+
+twitterUrl :: AuthRoute
+twitterUrl = oauthUrl "twitter"
\ No newline at end of file
diff --git a/yesod-auth.cabal b/yesod-auth.cabal
index 3d31ed84..f7ad7833 100644
--- a/yesod-auth.cabal
+++ b/yesod-auth.cabal
@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         0.3.0.1
+version:         0.3.1
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin
@@ -13,6 +13,10 @@ homepage:        http://docs.yesodweb.com/
 
 flag ghc7
 
+flag authenticate-oauth-supported
+  Description: Whether authenticate package supports OAuth or not.
+  Default: False
+
 library
     if flag(ghc7)
         build-depends:   base                      >= 4.3      && < 5
@@ -41,11 +45,19 @@ library
                    , transformers            >= 0.2       && < 0.3
                    , persistent              >= 0.4       && < 0.5
                    , SHA                     >= 1.4.1.3   && < 1.5
+                   , http-enumerator         >= 0.3.1     && < 0.4
+
+    if flag(authenticate-oauth-supported)
+      build-depends: authenticate            >= 0.8.0.1   && < 0.9
+    else
+      build-depends: authenticate-oauth      >= 0.1       && < 0.2
+
     exposed-modules: Yesod.Helpers.Auth
                      Yesod.Helpers.Auth.Dummy
                      Yesod.Helpers.Auth.Email
                      Yesod.Helpers.Auth.Facebook
                      Yesod.Helpers.Auth.OpenId
+                     Yesod.Helpers.Auth.OAuth
                      Yesod.Helpers.Auth.Rpxnow
                      Yesod.Helpers.Auth.HashDB
     ghc-options:     -Wall