haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-09-07 02:13:50 +02:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Nicer error message when 'code' field missing

Browse Source 
Fixes #42
This commit is contained in:
silky 2015-10-14 10:26:36 +11:00 committed by patrick brisbin
parent 6c16a7458d
commit 7354c36e13
No known key found for this signature in database
GPG Key ID: ADB6812F871D4478
1 changed files with 16 additions and 15 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