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

Merge ad6785a3da into bdc81341e5

Browse Source
This commit is contained in:
Noon van der Silk 2015-12-05 06:04:41 +00:00
commit abf69ae08f
2 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Yesod/Auth/OAuth2.hs
View File

@ -24,6 +24,7 @@ import Control.Applicative ((<$>))
import Control.Exception.Lifted import Control.Exception.Lifted
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad (unless)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text (Text, pack) import Data.Text (Text, pack)
@ -35,7 +36,6 @@ import Network.OAuth.OAuth2
import System.Random import System.Random
import Yesod.Auth import Yesod.Auth
import Yesod.Core import Yesod.Core
import Yesod.Form
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Char8 as C8
@ -98,12 +98,11 @@ authOAuth2Widget widget name oauth getCreds = AuthPlugin name dispatch login
lift $ redirect authUrl lift $ redirect authUrl
dispatch "GET" ["callback"] = do dispatch "GET" ["callback"] = do
newToken <- lookupGetParam "state" csrfToken <- requireGetParam "state"
oldToken <- lookupSession tokenSessionKey oldToken <- lookupSession tokenSessionKey
deleteSession tokenSessionKey deleteSession tokenSessionKey
case newToken of unless (oldToken == (Just csrfToken)) $ permissionDenied "Invalid OAuth2 state token"
Just csrfToken | newToken == oldToken -> do code <- requireGetParam "code"
code <- lift $ runInputGet $ ireq textField "code"
oauth' <- withCallback csrfToken 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)
@ -112,8 +111,10 @@ authOAuth2Widget widget 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
_ -> where
permissionDenied "Invalid OAuth2 state token" requireGetParam key = do
m <- lookupGetParam key
maybe (permissionDenied $ "'" <> key <> "' parameter not provided") return m
dispatch _ _ = notFound dispatch _ _ = notFound

2
yesod-auth-oauth2.cabal
View File

@ -52,4 +52,4 @@ library
source-repository head source-repository head
type: git type: git
location: https://github.com/thoughtbot/authenticate-oauth2.git location: https://github.com/thoughtbot/yesod-auth-oauth2.git