From d33cc46b87a9efce5421cc076b1b243363fe8b72 Mon Sep 17 00:00:00 2001 From: jprider63 Date: Mon, 16 Mar 2015 14:02:09 -0400 Subject: [PATCH 1/5] added csrf state token --- Yesod/Auth/OAuth2.hs | 46 +++++++++++++++++++++++++++++------------ yesod-auth-oauth2.cabal | 1 + 2 files changed, 34 insertions(+), 13 deletions(-) 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 From 999864af3627b26c62c957cf70a96871c099a5d2 Mon Sep 17 00:00:00 2001 From: jprider63 Date: Tue, 17 Mar 2015 21:38:02 -0400 Subject: [PATCH 2/5] removed state from Github (haven't tested) --- Yesod/Auth/OAuth2/Github.hs | 46 ++++++++++++++++++------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/Yesod/Auth/OAuth2/Github.hs b/Yesod/Auth/OAuth2/Github.hs index 1433744..018a33e 100644 --- a/Yesod/Auth/OAuth2/Github.hs +++ b/Yesod/Auth/OAuth2/Github.hs @@ -18,16 +18,16 @@ import Control.Exception.Lifted import Control.Monad (mzero) import Data.Aeson import Data.Text (Text) -import Data.Monoid (mappend) +-- import Data.Monoid (mappend) import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Yesod.Auth import Yesod.Auth.OAuth2 -import Yesod.Core -import Yesod.Form +-- 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 Data.UUID (toString) +-- import Data.UUID.V4 (nextRandom) +-- import qualified Data.ByteString as BS import qualified Data.Text as T data GithubUser = GithubUser @@ -67,7 +67,7 @@ oauth2GithubScoped :: YesodAuth m -> Text -- ^ Client Secret -> [Text] -- ^ List of scopes to request -> AuthPlugin m -oauth2GithubScoped clientId clientSecret scopes = basicPlugin {apDispatch = dispatch} +oauth2GithubScoped clientId clientSecret scopes = basicPlugin -- {apDispatch = dispatch} where oauth = OAuth2 { oauthClientId = encodeUtf8 clientId @@ -77,27 +77,27 @@ oauth2GithubScoped clientId clientSecret scopes = basicPlugin {apDispatch = disp , oauthCallback = Nothing } - withState state = authOAuth2 "github" - (oauth {oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth `BS.append` "&state=" `BS.append` encodeUtf8 state}) - fetchGithubProfile + -- withState state = authOAuth2 "github" + -- (oauth {oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth `BS.append` "&state=" `BS.append` encodeUtf8 state}) + -- fetchGithubProfile basicPlugin = authOAuth2 "github" oauth fetchGithubProfile - dispatch "GET" ["forward"] = do - state <- liftIO $ fmap (T.pack . toString) nextRandom - setSession "githubState" state - apDispatch (withState state) "GET" ["forward"] + -- dispatch "GET" ["forward"] = do + -- state <- liftIO $ fmap (T.pack . toString) nextRandom + -- setSession "githubState" state + -- apDispatch (withState state) "GET" ["forward"] - dispatch "GET" ["callback"] = do - state <- lift $ runInputGet $ ireq textField "state" - savedState <- lookupSession "githubState" - _ <- apDispatch basicPlugin "GET" ["callback"] - case savedState of - Just saved | saved == state -> apDispatch basicPlugin "GET" ["callback"] - Just saved -> invalidArgs ["state: " `mappend` state `mappend` ", and not: " `mappend` saved] - _ -> invalidArgs ["state: " `mappend` state] + -- dispatch "GET" ["callback"] = do + -- state <- lift $ runInputGet $ ireq textField "state" + -- savedState <- lookupSession "githubState" + -- _ <- apDispatch basicPlugin "GET" ["callback"] + -- case savedState of + -- Just saved | saved == state -> apDispatch basicPlugin "GET" ["callback"] + -- Just saved -> invalidArgs ["state: " `mappend` state `mappend` ", and not: " `mappend` saved] + -- _ -> invalidArgs ["state: " `mappend` state] - dispatch method ps = apDispatch basicPlugin method ps + -- dispatch method ps = apDispatch basicPlugin method ps fetchGithubProfile :: Manager -> AccessToken -> IO (Creds m) fetchGithubProfile manager token = do From 5275df8195cfe1898c6feaf97a3c1c341830698e Mon Sep 17 00:00:00 2001 From: jprider63 Date: Wed, 18 Mar 2015 16:11:38 -0400 Subject: [PATCH 3/5] removed commented code and inlined `basicPlugin`. #24 --- Yesod/Auth/OAuth2/Github.hs | 24 +----------------------- 1 file changed, 1 insertion(+), 23 deletions(-) diff --git a/Yesod/Auth/OAuth2/Github.hs b/Yesod/Auth/OAuth2/Github.hs index 018a33e..7a50055 100644 --- a/Yesod/Auth/OAuth2/Github.hs +++ b/Yesod/Auth/OAuth2/Github.hs @@ -67,7 +67,7 @@ oauth2GithubScoped :: YesodAuth m -> Text -- ^ Client Secret -> [Text] -- ^ List of scopes to request -> AuthPlugin m -oauth2GithubScoped clientId clientSecret scopes = basicPlugin -- {apDispatch = dispatch} +oauth2GithubScoped clientId clientSecret scopes = authOAuth2 "github" oauth fetchGithubProfile where oauth = OAuth2 { oauthClientId = encodeUtf8 clientId @@ -77,28 +77,6 @@ oauth2GithubScoped clientId clientSecret scopes = basicPlugin -- {apDispatch = d , oauthCallback = Nothing } - -- withState state = authOAuth2 "github" - -- (oauth {oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth `BS.append` "&state=" `BS.append` encodeUtf8 state}) - -- fetchGithubProfile - - basicPlugin = authOAuth2 "github" oauth fetchGithubProfile - - -- dispatch "GET" ["forward"] = do - -- state <- liftIO $ fmap (T.pack . toString) nextRandom - -- setSession "githubState" state - -- apDispatch (withState state) "GET" ["forward"] - - -- dispatch "GET" ["callback"] = do - -- state <- lift $ runInputGet $ ireq textField "state" - -- savedState <- lookupSession "githubState" - -- _ <- apDispatch basicPlugin "GET" ["callback"] - -- case savedState of - -- Just saved | saved == state -> apDispatch basicPlugin "GET" ["callback"] - -- Just saved -> invalidArgs ["state: " `mappend` state `mappend` ", and not: " `mappend` saved] - -- _ -> invalidArgs ["state: " `mappend` state] - - -- dispatch method ps = apDispatch basicPlugin method ps - fetchGithubProfile :: Manager -> AccessToken -> IO (Creds m) fetchGithubProfile manager token = do userResult <- authGetJSON manager token "https://api.github.com/user" From 1aa1bb9090a910e7b9033f961d3fdeddd6f8a6e0 Mon Sep 17 00:00:00 2001 From: jprider63 Date: Wed, 18 Mar 2015 16:13:00 -0400 Subject: [PATCH 4/5] removed uuid dependency. #24 --- yesod-auth-oauth2.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/yesod-auth-oauth2.cabal b/yesod-auth-oauth2.cabal index 6df5414..4680ea6 100644 --- a/yesod-auth-oauth2.cabal +++ b/yesod-auth-oauth2.cabal @@ -43,7 +43,6 @@ library , transformers >= 0.2.2 && < 0.5 , hoauth2 >= 0.4.1 && < 0.5 , lifted-base >= 0.2 && < 0.4 - , uuid >= 1.3 && < 1.4 exposed-modules: Yesod.Auth.OAuth2 Yesod.Auth.OAuth2.Google From f923406f0e20bcc80259a8f80f8c8cbd18e11211 Mon Sep 17 00:00:00 2001 From: jprider63 Date: Mon, 23 Mar 2015 11:24:44 -0400 Subject: [PATCH 5/5] removed dead code, use monoid instead of append, use <$> instead of fmap --- Yesod/Auth/OAuth2.hs | 13 +++++++------ Yesod/Auth/OAuth2/Github.hs | 9 ++------- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/Yesod/Auth/OAuth2.hs b/Yesod/Auth/OAuth2.hs index 0598e14..39012b6 100644 --- a/Yesod/Auth/OAuth2.hs +++ b/Yesod/Auth/OAuth2.hs @@ -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 diff --git a/Yesod/Auth/OAuth2/Github.hs b/Yesod/Auth/OAuth2/Github.hs index 7a50055..4d759f2 100644 --- a/Yesod/Auth/OAuth2/Github.hs +++ b/Yesod/Auth/OAuth2/Github.hs @@ -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 }