haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

caught up with yesod 1.2

Browse Source
This commit is contained in:
notogawa 2013-05-18 23:01:15 +09:00
parent 464c78c9b0
commit a897502679
2 changed files with 17 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
yesod-auth-oauth/Yesod/Auth/OAuth.hs
View File

@ -4,8 +4,8 @@ module Yesod.Auth.OAuth
, oauthUrl , oauthUrl
, authTwitter , authTwitter
, twitterUrl , twitterUrl
, authTumblr , authTumblr
, tumblrUrl , tumblrUrl
, module Web.Authenticate.OAuth , module Web.Authenticate.OAuth
) where ) where
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
@ -22,8 +22,7 @@ import Data.Typeable
import Web.Authenticate.OAuth import Web.Authenticate.OAuth
import Yesod.Auth import Yesod.Auth
import Yesod.Form import Yesod.Form
import Yesod.Handler import Yesod.Core
import Yesod.Widget
data YesodOAuthException = CredentialError String Credential data YesodOAuthException = CredentialError String Credential
| SessionError String | SessionError String
@ -40,26 +39,25 @@ authOAuth :: YesodAuth m
-> AuthPlugin m -> AuthPlugin m
authOAuth oauth mkCreds = AuthPlugin name dispatch login authOAuth oauth mkCreds = AuthPlugin name dispatch login
where where
getOAuthSession = maybe (throwIO $ SessionError "") return =<< lookupSession oauthSessionName
name = T.pack $ oauthServerName oauth name = T.pack $ oauthServerName oauth
url = PluginR name [] url = PluginR name []
lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential
oauthSessionName = "__oauth_token_secret" oauthSessionName = "__oauth_token_secret"
dispatch "GET" ["forward"] = do dispatch "GET" ["forward"] = do
render <- getUrlRender render <- lift getUrlRender
tm <- getRouteToMaster tm <- getRouteToParent
let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url } let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
master <- getYesod master <- lift getYesod
tok <- lift $ getTemporaryCredential oauth' (authHttpManager master) tok <- lift $ getTemporaryCredential oauth' (authHttpManager master)
setSession oauthSessionName $ lookupTokenSecret tok setSession oauthSessionName $ lookupTokenSecret tok
redirect $ authorizeUrl oauth' tok redirect $ authorizeUrl oauth' tok
dispatch "GET" [] = do dispatch "GET" [] = lift $ do
Just tokSec <- lookupSession oauthSessionName
deleteSession oauthSessionName
reqTok <- reqTok <-
if oauthVersion oauth == OAuth10 if oauthVersion oauth == OAuth10
then do then do
oaTok <- runInputGet $ ireq textField "oauth_token" oaTok <- runInputGet $ ireq textField "oauth_token"
tokSec <- getOAuthSession
deleteSession oauthSessionName
return $ Credential [ ("oauth_token", encodeUtf8 oaTok) return $ Credential [ ("oauth_token", encodeUtf8 oaTok)
, ("oauth_token_secret", encodeUtf8 tokSec) , ("oauth_token_secret", encodeUtf8 tokSec)
] ]
@ -67,19 +65,17 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
(verifier, oaTok) <- (verifier, oaTok) <-
runInputGet $ (,) <$> ireq textField "oauth_verifier" runInputGet $ (,) <$> ireq textField "oauth_verifier"
<*> ireq textField "oauth_token" <*> ireq textField "oauth_token"
tokSec <- getOAuthSession
deleteSession oauthSessionName
return $ Credential [ ("oauth_verifier", encodeUtf8 verifier) return $ Credential [ ("oauth_verifier", encodeUtf8 verifier)
, ("oauth_token", encodeUtf8 oaTok) , ("oauth_token", encodeUtf8 oaTok)
, ("oauth_token_secret", encodeUtf8 tokSec) , ("oauth_token_secret", encodeUtf8 tokSec)
] ]
master <- getYesod master <- getYesod
accTok <- lift $ getAccessToken oauth reqTok (authHttpManager master) accTok <- getAccessToken oauth reqTok (authHttpManager master)
creds <- liftIO $ mkCreds accTok creds <- liftIO $ mkCreds accTok
setCreds True creds setCreds True creds
dispatch _ _ = notFound dispatch _ _ = notFound
login tm = do login tm = do
render <- lift getUrlRender render <- getUrlRender
let oaUrl = render $ tm $ oauthUrl name let oaUrl = render $ tm $ oauthUrl name
[whamlet| <a href=#{oaUrl}>Login via #{name} |] [whamlet| <a href=#{oaUrl}>Login via #{name} |]
@ -96,9 +92,9 @@ authTwitter :: YesodAuth m
-> AuthPlugin m -> AuthPlugin m
authTwitter key secret = authOAuth authTwitter key secret = authOAuth
(newOAuth { oauthServerName = "twitter" (newOAuth { oauthServerName = "twitter"
, oauthRequestUri = "http://twitter.com/oauth/request_token" , oauthRequestUri = "https://api.twitter.com/oauth/request_token"
, oauthAccessTokenUri = "http://api.twitter.com/oauth/access_token" , oauthAccessTokenUri = "https://api.twitter.com/oauth/access_token"
, oauthAuthorizeUri = "http://api.twitter.com/oauth/authorize" , oauthAuthorizeUri = "https://api.twitter.com/oauth/authorize"
, oauthSignatureMethod = HMACSHA1 , oauthSignatureMethod = HMACSHA1
, oauthConsumerKey = key , oauthConsumerKey = key
, oauthConsumerSecret = secret , oauthConsumerSecret = secret

6
yesod-auth-oauth/yesod-auth-oauth.cabal
View File

@ -22,10 +22,10 @@ library
build-depends: base >= 4 && < 4.3 build-depends: base >= 4 && < 4.3
build-depends: authenticate-oauth >= 1.4 && < 1.5 build-depends: authenticate-oauth >= 1.4 && < 1.5
, bytestring >= 0.9.1.4 , bytestring >= 0.9.1.4
, yesod-core >= 1.1 && < 1.2 , yesod-core >= 1.2 && < 1.3
, yesod-auth >= 1.1 && < 1.2 , yesod-auth >= 1.2 && < 1.3
, text >= 0.7 && < 0.12 , text >= 0.7 && < 0.12
, yesod-form >= 1.1 && < 1.3 , yesod-form >= 1.3 && < 1.4
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.2.2 && < 0.4
, lifted-base >= 0.2 && < 0.3 , lifted-base >= 0.2 && < 0.3
exposed-modules: Yesod.Auth.OAuth exposed-modules: Yesod.Auth.OAuth