yesod-auth-oauth 1.1.0.0 → 1.1.0.2
raw patch · 2 files changed
+45/−39 lines, 2 filesdep +lifted-basedep ~bytestringdep ~yesod-formPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: lifted-base
Dependency ranges changed: bytestring, yesod-form
API changes (from Hackage documentation)
+ Yesod.Auth.OAuth: instance Exception YesodOAuthException
+ Yesod.Auth.OAuth: instance Show YesodOAuthException
+ Yesod.Auth.OAuth: instance Typeable YesodOAuthException
Files
- Yesod/Auth/OAuth.hs +41/−36
- yesod-auth-oauth.cabal +4/−3
Yesod/Auth/OAuth.hs view
@@ -1,39 +1,46 @@-{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}-{-# OPTIONS_GHC -fwarn-unused-imports #-}+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, QuasiQuotes #-} module Yesod.Auth.OAuth ( authOAuth , oauthUrl , authTwitter , twitterUrl- , authTumblr- , tumblrUrl+ , authTumblr+ , tumblrUrl , module Web.Authenticate.OAuth ) where+import Control.Applicative ((<$>), (<*>))+import Control.Arrow ((***))+import Control.Exception.Lifted+import Control.Monad.IO.Class+import Data.ByteString (ByteString)+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Typeable+import Web.Authenticate.OAuth+import Yesod.Auth+import Yesod.Form+import Yesod.Handler+import Yesod.Widget -import Yesod.Auth-import Yesod.Form-import Yesod.Handler-import Yesod.Widget-import Web.Authenticate.OAuth-import Data.Maybe-import Control.Arrow ((***))-import Control.Monad.IO.Class-import Data.Text (Text)-import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)-import Data.ByteString (ByteString)-import Control.Applicative ((<$>), (<*>))+data YesodOAuthException = CredentialError String Credential+ | SessionError String+ deriving (Show, Typeable) +instance Exception YesodOAuthException+ oauthUrl :: Text -> AuthRoute oauthUrl name = PluginR name ["forward"] authOAuth :: YesodAuth m => OAuth -- ^ 'OAuth' data-type for signing.- -> (Credential -> IO (Creds m)) -- ^ How to extract ident. + -> (Credential -> IO (Creds m)) -- ^ How to extract ident. -> AuthPlugin m authOAuth oauth mkCreds = AuthPlugin name dispatch login where+ getOAuthSession = maybe (throwIO $ SessionError "") return =<< lookupSession oauthSessionName name = T.pack $ oauthServerName oauth url = PluginR name [] lookupTokenSecret = bsToText . fromMaybe "" . lookup "oauth_token_secret" . unCredential@@ -51,7 +58,7 @@ if oauthVersion oauth == OAuth10 then do oaTok <- runInputGet $ ireq textField "oauth_token"- tokSec <- fromJust <$> lookupSession oauthSessionName+ tokSec <- getOAuthSession deleteSession oauthSessionName return $ Credential [ ("oauth_token", encodeUtf8 oaTok) , ("oauth_token_secret", encodeUtf8 tokSec)@@ -60,7 +67,7 @@ (verifier, oaTok) <- runInputGet $ (,) <$> ireq textField "oauth_verifier" <*> ireq textField "oauth_token"- tokSec <- fromJust <$> lookupSession oauthSessionName+ tokSec <- getOAuthSession deleteSession oauthSessionName return $ Credential [ ("oauth_verifier", encodeUtf8 verifier) , ("oauth_token", encodeUtf8 oaTok)@@ -74,28 +81,30 @@ login tm = do render <- lift getUrlRender let oaUrl = render $ tm $ oauthUrl name- addWidget- [whamlet| <a href=#{oaUrl}>Login via #{name} |]+ [whamlet| <a href=#{oaUrl}>Login via #{name} |] +mkExtractCreds :: YesodAuth m => Text -> String -> Credential -> IO (Creds m)+mkExtractCreds name idName (Credential dic) = do+ let mcrId = decodeUtf8With lenientDecode <$> lookup (encodeUtf8 $ T.pack idName) dic+ case mcrId of+ Just crId -> return $ Creds name crId $ map (bsToText *** bsToText) dic+ Nothing -> throwIO $ CredentialError ("key not found: " ++ idName) (Credential dic)+ authTwitter :: YesodAuth m => ByteString -- ^ Consumer Key -> ByteString -- ^ Consumer Secret -> AuthPlugin m authTwitter key secret = authOAuth (newOAuth { oauthServerName = "twitter"- , oauthRequestUri = "https://api.twitter.com/oauth/request_token"- , oauthAccessTokenUri = "https://api.twitter.com/oauth/access_token"- , oauthAuthorizeUri = "https://api.twitter.com/oauth/authorize"+ , oauthRequestUri = "http://twitter.com/oauth/request_token"+ , oauthAccessTokenUri = "http://api.twitter.com/oauth/access_token"+ , oauthAuthorizeUri = "http://api.twitter.com/oauth/authorize" , oauthSignatureMethod = HMACSHA1 , oauthConsumerKey = key , oauthConsumerSecret = secret , oauthVersion = OAuth10a })- extractCreds- where- extractCreds (Credential dic) = do- let crId = decodeUtf8With lenientDecode $ fromJust $ lookup "screen_name" dic- return $ Creds "twitter" crId $ map (bsToText *** bsToText ) dic+ (mkExtractCreds "twitter" "screen_name") twitterUrl :: AuthRoute twitterUrl = oauthUrl "twitter"@@ -114,11 +123,7 @@ , oauthConsumerSecret = secret , oauthVersion = OAuth10a })- extractCreds- where- extractCreds (Credential dic) = do- let crId = decodeUtf8With lenientDecode $ fromJust $ lookup "name" dic- return $ Creds "tumblr" crId $ map (bsToText *** bsToText ) dic+ (mkExtractCreds "tumblr" "name") tumblrUrl :: AuthRoute tumblrUrl = oauthUrl "tumblr"
yesod-auth-oauth.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-oauth-version: 1.1.0.0+version: 1.1.0.2 license: BSD3 license-file: LICENSE author: Hiromi Ishii@@ -21,12 +21,13 @@ else build-depends: base >= 4 && < 4.3 build-depends: authenticate-oauth >= 1.4 && < 1.5- , bytestring >= 0.9.1.4 && < 0.10+ , bytestring >= 0.9.1.4 , yesod-core >= 1.1 && < 1.2 , yesod-auth >= 1.1 && < 1.2 , text >= 0.7 && < 0.12- , yesod-form >= 1.1 && < 1.2+ , yesod-form >= 1.1 && < 1.3 , transformers >= 0.2.2 && < 0.4+ , lifted-base >= 0.2 && < 0.3 exposed-modules: Yesod.Auth.OAuth ghc-options: -Wall