haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-09-10 11:34:55 +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

31
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,22 +98,23 @@ 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) case result of
case result of Left _ -> permissionDenied "Unable to retreive OAuth2 token"
Left _ -> permissionDenied "Unable to retreive OAuth2 token" 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
_ -> requireGetParam key = do
permissionDenied "Invalid OAuth2 state token" 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