diff --git a/Yesod/Auth/OAuth2.hs b/Yesod/Auth/OAuth2.hs index 4653aa6..0598e14 100644 --- a/Yesod/Auth/OAuth2.hs +++ b/Yesod/Auth/OAuth2.hs @@ -17,12 +17,14 @@ module Yesod.Auth.OAuth2 import Control.Exception.Lifted import Control.Monad.IO.Class 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.Error (lenientDecode) import Data.Typeable import Network.OAuth.OAuth2 import Network.HTTP.Conduit(Manager) +import System.Random import Yesod.Auth import Yesod.Core import Yesod.Form @@ -52,28 +54,46 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login where url = PluginR name ["callback"] - withCallback = do + withCallback csrfToken = do tm <- getRouteToParent 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 - authUrl <- fmap (bsToText . authorizationUrl) withCallback + csrfToken <- liftIO $ generateToken + setSession tokenSessionKey csrfToken + authUrl <- fmap (bsToText . authorizationUrl) $ withCallback csrfToken lift $ redirect authUrl dispatch "GET" ["callback"] = do - code <- lift $ runInputGet $ ireq textField "code" - oauth' <- withCallback - master <- lift getYesod - 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 + newToken <- lookupGetParam "state" + oldToken <- lookupSession tokenSessionKey + deleteSession tokenSessionKey + case newToken of + Just csrfToken | newToken == oldToken -> do + code <- lift $ runInputGet $ ireq textField "code" + oauth' <- withCallback csrfToken + master <- lift getYesod + 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 + generateToken = fmap (pack . take 30 . randomRs ('a','z')) newStdGen + + tokenSessionKey :: Text + tokenSessionKey = "_yesod_oauth2_" `append` name + login tm = do render <- getUrlRender let oaUrl = render $ tm $ oauth2Url name diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal index 7d44989..6df5414 100644 --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -36,6 +36,7 @@ library , aeson >= 0.6 && < 0.9 , yesod-core >= 1.2 && < 1.5 , authenticate >= 1.3.2.7 && < 1.4 + , random , yesod-auth >= 1.3 && < 1.5 , text >= 0.7 && < 2.0 , yesod-form >= 1.3 && < 1.5