haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-09-10 19:34:56 +02:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

removed dead code, use monoid instead of append, use <$> instead of fmap

Browse Source
This commit is contained in:
jprider63 2015-03-23 11:24:44 -04:00
parent 1aa1bb9090
commit f923406f0e
2 changed files with 9 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Yesod/Auth/OAuth2.hs
View File

@ -14,11 +14,12 @@ module Yesod.Auth.OAuth2
, module Network.OAuth.OAuth2
) where
import Control.Applicative ((<$>))
import Control.Exception.Lifted
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Text (Text, append, pack)
import Data.Monoid ((<>))
import Data.Text (Text, pack)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Typeable
@ -57,7 +58,7 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
withCallback csrfToken = do
tm <- getRouteToParent
render <- lift $ getUrlRender
let newEndpoint = oauthOAuthorizeEndpoint oauth `BS.append` "&state=" `BS.append` encodeUtf8 csrfToken
let newEndpoint = oauthOAuthorizeEndpoint oauth <> "&state=" <> encodeUtf8 csrfToken
return $ oauth {
oauthCallback = Just $ encodeUtf8 $ render $ tm url,
oauthOAuthorizeEndpoint = newEndpoint
@ -66,7 +67,7 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
dispatch "GET" ["forward"] = do
csrfToken <- liftIO $ generateToken
setSession tokenSessionKey csrfToken
authUrl <- fmap (bsToText . authorizationUrl) $ withCallback csrfToken
authUrl <- (bsToText . authorizationUrl) <$> withCallback csrfToken
lift $ redirect authUrl
dispatch "GET" ["callback"] = do
@ -89,10 +90,10 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
dispatch _ _ = notFound
generateToken = fmap (pack . take 30 . randomRs ('a','z')) newStdGen
generateToken = (pack . take 30 . randomRs ('a','z')) <$> newStdGen
tokenSessionKey :: Text
tokenSessionKey = "_yesod_oauth2_" `append` name
tokenSessionKey = "_yesod_oauth2_" <> name
login tm = do
render <- getUrlRender

9
Yesod/Auth/OAuth2/Github.hs
View File

@ -18,16 +18,11 @@ import Control.Exception.Lifted
import Control.Monad (mzero)
import Data.Aeson
import Data.Text (Text)
-- import Data.Monoid (mappend)
import Data.Monoid ((<>))
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Yesod.Auth
import Yesod.Auth.OAuth2
-- import Yesod.Core
-- import Yesod.Form
import Network.HTTP.Conduit(Manager)
-- import Data.UUID (toString)
-- import Data.UUID.V4 (nextRandom)
-- import qualified Data.ByteString as BS
import qualified Data.Text as T
data GithubUser = GithubUser
@ -72,7 +67,7 @@ oauth2GithubScoped clientId clientSecret scopes = authOAuth2 "github" oauth fetc
oauth = OAuth2
{ oauthClientId = encodeUtf8 clientId
, oauthClientSecret = encodeUtf8 clientSecret
, oauthOAuthorizeEndpoint = encodeUtf8 $ "https://github.com/login/oauth/authorize?scope=" `T.append` T.intercalate "," scopes
, oauthOAuthorizeEndpoint = encodeUtf8 $ "https://github.com/login/oauth/authorize?scope=" <> T.intercalate "," scopes
, oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token"
, oauthCallback = Nothing
}