haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-01-30 21:00:24 +01:00
Code Issues Actions 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

31
Yesod/Auth/OAuth2.hs
View File

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