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

added csrf state token

Browse Source
This commit is contained in:
jprider63 2015-03-16 14:02:09 -04:00
parent d840af3501
commit d33cc46b87
2 changed files with 34 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
Yesod/Auth/OAuth2.hs
View File

@ -17,12 +17,14 @@ module Yesod.Auth.OAuth2
import Control.Exception.Lifted import Control.Exception.Lifted
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Text (Text) import qualified Data.ByteString as BS
import Data.Text (Text, append, pack)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
import Data.Typeable import Data.Typeable
import Network.OAuth.OAuth2 import Network.OAuth.OAuth2
import Network.HTTP.Conduit(Manager) import Network.HTTP.Conduit(Manager)
import System.Random
import Yesod.Auth import Yesod.Auth
import Yesod.Core import Yesod.Core
import Yesod.Form import Yesod.Form
@ -52,28 +54,46 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
where where
url = PluginR name ["callback"] url = PluginR name ["callback"]
withCallback = do withCallback csrfToken = do
tm <- getRouteToParent tm <- getRouteToParent
render <- lift $ getUrlRender render <- lift $ getUrlRender
return $ oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url } let newEndpoint = oauthOAuthorizeEndpoint oauth `BS.append` "&state=" `BS.append` encodeUtf8 csrfToken
return $ oauth {
oauthCallback = Just $ encodeUtf8 $ render $ tm url,
oauthOAuthorizeEndpoint = newEndpoint
}
dispatch "GET" ["forward"] = do dispatch "GET" ["forward"] = do
authUrl <- fmap (bsToText . authorizationUrl) withCallback csrfToken <- liftIO $ generateToken
setSession tokenSessionKey csrfToken
authUrl <- fmap (bsToText . authorizationUrl) $ withCallback csrfToken
lift $ redirect authUrl lift $ redirect authUrl
dispatch "GET" ["callback"] = do dispatch "GET" ["callback"] = do
code <- lift $ runInputGet $ ireq textField "code" newToken <- lookupGetParam "state"
oauth' <- withCallback oldToken <- lookupSession tokenSessionKey
master <- lift getYesod deleteSession tokenSessionKey
result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code) case newToken of
case result of Just csrfToken | newToken == oldToken -> do
Left _ -> permissionDenied "Unable to retreive OAuth2 token" code <- lift $ runInputGet $ ireq textField "code"
Right token -> do oauth' <- withCallback csrfToken
creds <- liftIO $ getCreds (authHttpManager master) token master <- lift getYesod
lift $ setCredsRedirect creds result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code)
case result of
Left _ -> permissionDenied "Unable to retreive OAuth2 token"
Right token -> do
creds <- liftIO $ getCreds (authHttpManager master) token
lift $ setCredsRedirect creds
_ ->
permissionDenied "Invalid OAuth2 state token"
dispatch _ _ = notFound dispatch _ _ = notFound
generateToken = fmap (pack . take 30 . randomRs ('a','z')) newStdGen
tokenSessionKey :: Text
tokenSessionKey = "_yesod_oauth2_" `append` name
login tm = do login tm = do
render <- getUrlRender render <- getUrlRender
let oaUrl = render $ tm $ oauth2Url name let oaUrl = render $ tm $ oauth2Url name

1
yesod-auth-oauth2.cabal
View File

@ -36,6 +36,7 @@ library
, aeson >= 0.6 && < 0.9 , aeson >= 0.6 && < 0.9
, yesod-core >= 1.2 && < 1.5 , yesod-core >= 1.2 && < 1.5
, authenticate >= 1.3.2.7 && < 1.4 , authenticate >= 1.3.2.7 && < 1.4
, random
, yesod-auth >= 1.3 && < 1.5 , yesod-auth >= 1.3 && < 1.5
, text >= 0.7 && < 2.0 , text >= 0.7 && < 2.0
, yesod-form >= 1.3 && < 1.5 , yesod-form >= 1.3 && < 1.5