Update to hauth2 0.4.*

This commit is contained in:
Calen Pennington 2014-07-28 06:35:00 -04:00
parent a306f80da8
commit 342cabd95b
3 changed files with 14 additions and 7 deletions

View File

@ -22,6 +22,8 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
import Data.Typeable import Data.Typeable
import Network.OAuth.OAuth2 import Network.OAuth.OAuth2
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Yesod.Auth import Yesod.Auth
import Yesod.Core import Yesod.Core
import Yesod.Form import Yesod.Form
@ -62,14 +64,15 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
lift $ redirect authUrl lift $ redirect authUrl
dispatch "GET" ["callback"] = do dispatch "GET" ["callback"] = do
manager <- liftIO $ newManager tlsManagerSettings
code <- lift $ runInputGet $ ireq textField "code" code <- lift $ runInputGet $ ireq textField "code"
oauth' <- withCallback oauth' <- withCallback
result <- liftIO $ fetchAccessToken oauth' (encodeUtf8 code) result <- liftIO $ fetchAccessToken manager 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 token creds <- liftIO $ getCreds token
lift $ setCreds True creds lift $ setCredsRedirect creds
dispatch _ _ = notFound dispatch _ _ = notFound

View File

@ -20,6 +20,8 @@ import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.OAuth2 import Yesod.Auth.OAuth2
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import qualified Data.Text as T import qualified Data.Text as T
data LearnUser = LearnUser data LearnUser = LearnUser
@ -62,7 +64,8 @@ oauth2Learn clientId clientSecret = authOAuth2 "learn"
fetchLearnProfile :: AccessToken -> IO (Creds m) fetchLearnProfile :: AccessToken -> IO (Creds m)
fetchLearnProfile token = do fetchLearnProfile token = do
result <- authGetJSON token "http://learn.thoughtbot.com/api/v1/me.json" manager <- newManager tlsManagerSettings
result <- authGetJSON manager token "http://learn.thoughtbot.com/api/v1/me.json"
case result of case result of
Right (LearnResponse user) -> return $ toCreds user Right (LearnResponse user) -> return $ toCreds user

View File

@ -26,13 +26,14 @@ library
, http-types >= 0.8 && < 0.9 , http-types >= 0.8 && < 0.9
, aeson >= 0.6 && < 0.8 , aeson >= 0.6 && < 0.8
, yesod-core >= 1.2 && < 1.3 , yesod-core >= 1.2 && < 1.3
, yesod-auth >= 1.2 && < 1.3 , yesod-auth >= 1.3 && < 1.4
, text >= 0.7 && < 2.0 , text >= 0.7 && < 2.0
, yesod-form >= 1.3 && < 1.4 , yesod-form >= 1.3 && < 1.4
, transformers >= 0.2.2 && < 0.4 , transformers >= 0.4 && < 0.5
, hoauth2 >= 0.3.6 && < 0.4 , hoauth2 >= 0.4 && < 0.5
, lifted-base >= 0.2 && < 0.4 , lifted-base >= 0.2 && < 0.4
, http-client >= 0.3 && < 0.4
, http-client-tls >= 0.2 && < 0.3
exposed-modules: Yesod.Auth.OAuth2 exposed-modules: Yesod.Auth.OAuth2
Yesod.Auth.OAuth2.Google Yesod.Auth.OAuth2.Google
Yesod.Auth.OAuth2.Learn Yesod.Auth.OAuth2.Learn