* Catch up with new version of authenticate-oauth.
* Changed Interface of authOAuth. * Chagned urls about authTwitter.
This commit is contained in:
parent
d602606bb6
commit
a569c7f960
@ -5,6 +5,7 @@ module Yesod.Auth.OAuth
|
|||||||
, oauthUrl
|
, oauthUrl
|
||||||
, authTwitter
|
, authTwitter
|
||||||
, twitterUrl
|
, twitterUrl
|
||||||
|
, module Web.Authenticate.OAuth
|
||||||
) where
|
) where
|
||||||
|
|
||||||
#include "qq.h"
|
#include "qq.h"
|
||||||
@ -16,71 +17,75 @@ import Yesod.Widget
|
|||||||
import Text.Hamlet (shamlet)
|
import Text.Hamlet (shamlet)
|
||||||
import Web.Authenticate.OAuth
|
import Web.Authenticate.OAuth
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String
|
|
||||||
import Data.ByteString.Char8 (pack)
|
|
||||||
import Control.Arrow ((***))
|
import Control.Arrow ((***))
|
||||||
import Data.Text (Text, unpack)
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
|
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Control.Applicative ((<$>), (<*>))
|
import Control.Applicative ((<$>), (<*>))
|
||||||
|
import Data.Conduit
|
||||||
|
|
||||||
oauthUrl :: Text -> AuthRoute
|
oauthUrl :: Text -> AuthRoute
|
||||||
oauthUrl name = PluginR name ["forward"]
|
oauthUrl name = PluginR name ["forward"]
|
||||||
|
|
||||||
authOAuth :: YesodAuth m =>
|
authOAuth :: YesodAuth m
|
||||||
Text -- ^ Service Name
|
=> OAuth -- ^ 'OAuth' data-type for signing.
|
||||||
-> String -- ^ OAuth Parameter Name to use for identify
|
-> (Credential -> IO (Creds m)) -- ^ How to extract ident.
|
||||||
-> String -- ^ Request URL
|
|
||||||
-> String -- ^ Access Token URL
|
|
||||||
-> String -- ^ Authorize URL
|
|
||||||
-> String -- ^ Consumer Key
|
|
||||||
-> String -- ^ Consumer Secret
|
|
||||||
-> AuthPlugin m
|
-> AuthPlugin m
|
||||||
authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch login
|
authOAuth oauth mkCreds = AuthPlugin name dispatch login
|
||||||
where
|
where
|
||||||
|
name = T.pack $ oauthServerName oauth
|
||||||
url = PluginR name []
|
url = PluginR name []
|
||||||
oauth = OAuth { oauthServerName = unpack name, oauthRequestUri = reqUrl
|
lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential
|
||||||
, oauthAccessTokenUri = accUrl, oauthAuthorizeUri = authUrl
|
oauthSessionName = "__oauth_token_secret"
|
||||||
, oauthSignatureMethod = HMACSHA1
|
|
||||||
, oauthConsumerKey = fromString key, oauthConsumerSecret = fromString sec
|
|
||||||
, oauthCallback = Nothing
|
|
||||||
, oauthRealm = Nothing
|
|
||||||
}
|
|
||||||
dispatch "GET" ["forward"] = do
|
dispatch "GET" ["forward"] = do
|
||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
tm <- getRouteToMaster
|
tm <- getRouteToMaster
|
||||||
let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
|
let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
|
||||||
master <- getYesod
|
master <- getYesod
|
||||||
tok <- lift $ getTemporaryCredential oauth' (authHttpManager master)
|
tok <- lift $ getTemporaryCredential oauth' (authHttpManager master)
|
||||||
|
setSession oauthSessionName $ lookupTokenSecret tok
|
||||||
redirect $ authorizeUrl oauth' tok
|
redirect $ authorizeUrl oauth' tok
|
||||||
dispatch "GET" [] = do
|
dispatch "GET" [] = do
|
||||||
(verifier, oaTok) <- runInputGet $ (,)
|
(verifier, oaTok) <- runInputGet $ (,)
|
||||||
<$> ireq textField "oauth_verifier"
|
<$> ireq textField "oauth_verifier"
|
||||||
<*> ireq textField "oauth_token"
|
<*> ireq textField "oauth_token"
|
||||||
let reqTok = Credential [ ("oauth_verifier", encodeUtf8 verifier), ("oauth_token", encodeUtf8 oaTok)
|
tokSec <- fromJust <$> lookupSession oauthSessionName
|
||||||
|
deleteSession oauthSessionName
|
||||||
|
let reqTok = Credential [ ("oauth_verifier", encodeUtf8 verifier)
|
||||||
|
, ("oauth_token", encodeUtf8 oaTok)
|
||||||
|
, ("oauth_token_secret", encodeUtf8 tokSec)
|
||||||
]
|
]
|
||||||
master <- getYesod
|
master <- getYesod
|
||||||
accTok <- lift $ getAccessToken oauth reqTok (authHttpManager master)
|
accTok <- lift $ getAccessToken oauth reqTok (authHttpManager master)
|
||||||
let crId = decodeUtf8With lenientDecode $ fromJust $ lookup (pack ident) $ unCredential accTok
|
creds <- resourceLiftBase $ mkCreds accTok
|
||||||
creds = Creds name crId $ map (bsToText *** bsToText ) $ unCredential accTok
|
|
||||||
setCreds True creds
|
setCreds True creds
|
||||||
dispatch _ _ = notFound
|
dispatch _ _ = notFound
|
||||||
login tm = do
|
login tm = do
|
||||||
render <- lift getUrlRender
|
render <- lift getUrlRender
|
||||||
let oaUrl = render $ tm $ oauthUrl name
|
let oaUrl = render $ tm $ oauthUrl name
|
||||||
addHtml
|
addHtml
|
||||||
[QQ(shamlet)| <a href=#{oaUrl}>Login with #{name} |]
|
[QQ(shamlet)| <a href=#{oaUrl}>Login via #{name} |]
|
||||||
|
|
||||||
authTwitter :: YesodAuth m =>
|
authTwitter :: YesodAuth m
|
||||||
String -- ^ Consumer Key
|
=> ByteString -- ^ Consumer Key
|
||||||
-> String -- ^ Consumer Secret
|
-> ByteString -- ^ Consumer Secret
|
||||||
-> AuthPlugin m
|
-> AuthPlugin m
|
||||||
authTwitter = authOAuth "twitter"
|
authTwitter key secret = authOAuth
|
||||||
"screen_name"
|
(newOAuth { oauthServerName = "twitter"
|
||||||
"http://twitter.com/oauth/request_token"
|
, oauthRequestUri = "https://api.twitter.com/oauth/request_token"
|
||||||
"http://twitter.com/oauth/access_token"
|
, oauthAccessTokenUri = "https://api.twitter.com/oauth/access_token"
|
||||||
"http://twitter.com/oauth/authorize"
|
, oauthAuthorizeUri = "https://api.twitter.com/oauth/authorize"
|
||||||
|
, oauthSignatureMethod = HMACSHA1
|
||||||
|
, oauthConsumerKey = key
|
||||||
|
, oauthConsumerSecret = secret
|
||||||
|
})
|
||||||
|
extractCreds
|
||||||
|
where
|
||||||
|
extractCreds (Credential dic) = do
|
||||||
|
let crId = decodeUtf8With lenientDecode $ fromJust $ lookup "screen_name" dic
|
||||||
|
return $ Creds "twitter" crId $ map (bsToText *** bsToText ) dic
|
||||||
|
|
||||||
twitterUrl :: AuthRoute
|
twitterUrl :: AuthRoute
|
||||||
twitterUrl = oauthUrl "twitter"
|
twitterUrl = oauthUrl "twitter"
|
||||||
|
|||||||
@ -27,6 +27,7 @@ library
|
|||||||
, yesod-auth >= 0.8 && < 0.9
|
, yesod-auth >= 0.8 && < 0.9
|
||||||
, text >= 0.7 && < 0.12
|
, text >= 0.7 && < 0.12
|
||||||
, hamlet >= 0.10 && < 0.11
|
, hamlet >= 0.10 && < 0.11
|
||||||
|
, conduit >= 0.2 && < 0.3
|
||||||
, yesod-form >= 0.4 && < 0.5
|
, yesod-form >= 0.4 && < 0.5
|
||||||
|
|
||||||
exposed-modules: Yesod.Auth.OAuth
|
exposed-modules: Yesod.Auth.OAuth
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user