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

View File

@ -20,6 +20,8 @@ import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Yesod.Auth
import Yesod.Auth.OAuth2
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import qualified Data.Text as T
data LearnUser = LearnUser
@ -62,7 +64,8 @@ oauth2Learn clientId clientSecret = authOAuth2 "learn"
fetchLearnProfile :: AccessToken -> IO (Creds m)
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
Right (LearnResponse user) -> return $ toCreds user

View File

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