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

30
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,18 +54,29 @@ 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
newToken <- lookupGetParam "state"
oldToken <- lookupSession tokenSessionKey
deleteSession tokenSessionKey
case newToken of
Just csrfToken | newToken == oldToken -> do
code <- lift $ runInputGet $ ireq textField "code" code <- lift $ runInputGet $ ireq textField "code"
oauth' <- withCallback oauth' <- withCallback csrfToken
master <- lift getYesod master <- lift getYesod
result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code) result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code)
case result of case result of
@ -71,9 +84,16 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
Right token -> do Right token -> do
creds <- liftIO $ getCreds (authHttpManager master) token creds <- liftIO $ getCreds (authHttpManager master) token
lift $ setCredsRedirect creds 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