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 state from Github (haven't tested)

Browse Source
This commit is contained in:
jprider63 2015-03-17 21:38:02 -04:00
parent d33cc46b87
commit 999864af36
1 changed files with 23 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -18,16 +18,16 @@ import Control.Exception.Lifted
import Control.Monad (mzero) import Control.Monad (mzero)
import Data.Aeson import Data.Aeson
import Data.Text (Text) import Data.Text (Text)
import Data.Monoid (mappend) -- import Data.Monoid (mappend)
import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.OAuth2 import Yesod.Auth.OAuth2
import Yesod.Core -- import Yesod.Core
import Yesod.Form -- import Yesod.Form
import Network.HTTP.Conduit(Manager) import Network.HTTP.Conduit(Manager)
import Data.UUID (toString) -- import Data.UUID (toString)
import Data.UUID.V4 (nextRandom) -- import Data.UUID.V4 (nextRandom)
import qualified Data.ByteString as BS -- import qualified Data.ByteString as BS
import qualified Data.Text as T import qualified Data.Text as T
data GithubUser = GithubUser data GithubUser = GithubUser
@ -67,7 +67,7 @@ oauth2GithubScoped :: YesodAuth m
-> Text -- ^ Client Secret -> Text -- ^ Client Secret
-> [Text] -- ^ List of scopes to request -> [Text] -- ^ List of scopes to request
-> AuthPlugin m -> AuthPlugin m
oauth2GithubScoped clientId clientSecret scopes = basicPlugin {apDispatch = dispatch} oauth2GithubScoped clientId clientSecret scopes = basicPlugin -- {apDispatch = dispatch}
where where
oauth = OAuth2 oauth = OAuth2
{ oauthClientId = encodeUtf8 clientId { oauthClientId = encodeUtf8 clientId
@ -77,27 +77,27 @@ oauth2GithubScoped clientId clientSecret scopes = basicPlugin {apDispatch = disp
, oauthCallback = Nothing , oauthCallback = Nothing
} }
withState state = authOAuth2 "github" -- withState state = authOAuth2 "github"
(oauth {oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth `BS.append` "&state=" `BS.append` encodeUtf8 state}) -- (oauth {oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth `BS.append` "&state=" `BS.append` encodeUtf8 state})
fetchGithubProfile -- fetchGithubProfile
basicPlugin = authOAuth2 "github" oauth fetchGithubProfile basicPlugin = authOAuth2 "github" oauth fetchGithubProfile
dispatch "GET" ["forward"] = do -- dispatch "GET" ["forward"] = do
state <- liftIO $ fmap (T.pack . toString) nextRandom -- state <- liftIO $ fmap (T.pack . toString) nextRandom
setSession "githubState" state -- setSession "githubState" state
apDispatch (withState state) "GET" ["forward"] -- apDispatch (withState state) "GET" ["forward"]
dispatch "GET" ["callback"] = do -- dispatch "GET" ["callback"] = do
state <- lift $ runInputGet $ ireq textField "state" -- state <- lift $ runInputGet $ ireq textField "state"
savedState <- lookupSession "githubState" -- savedState <- lookupSession "githubState"
_ <- apDispatch basicPlugin "GET" ["callback"] -- _ <- apDispatch basicPlugin "GET" ["callback"]
case savedState of -- case savedState of
Just saved | saved == state -> apDispatch basicPlugin "GET" ["callback"] -- Just saved | saved == state -> apDispatch basicPlugin "GET" ["callback"]
Just saved -> invalidArgs ["state: " `mappend` state `mappend` ", and not: " `mappend` saved] -- Just saved -> invalidArgs ["state: " `mappend` state `mappend` ", and not: " `mappend` saved]
_ -> invalidArgs ["state: " `mappend` state] -- _ -> 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 -> AccessToken -> IO (Creds m)
fetchGithubProfile manager token = do fetchGithubProfile manager token = do