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

Cleanup as suggested by @pbrisbin

Browse Source
This commit is contained in:
silky 2015-10-14 10:26:36 +11:00
parent 60c91306f1
commit 3efa4175a0
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
@ -97,12 +97,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)
@ -111,8 +110,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