haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-04-27 21:27:54 +02:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge pull request #9 from katyo/master

Browse Source 
Version upgrade (hoauth2 0.4.1)
This commit is contained in:
scan 2014-08-13 22:13:02 +02:00
commit 67590fc758
3 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Yesod/Auth/OAuth2.hs
View File

@ -22,6 +22,7 @@ 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.Conduit(Manager)
import Yesod.Auth import Yesod.Auth
import Yesod.Core import Yesod.Core
import Yesod.Form import Yesod.Form
@ -41,7 +42,7 @@ oauth2Url name = PluginR name ["forward"]
authOAuth2 :: YesodAuth m authOAuth2 :: YesodAuth m
=> Text -- ^ Service name => Text -- ^ Service name
-> OAuth2 -- ^ Service details -> OAuth2 -- ^ Service details
-> (AccessToken -> IO (Creds m)) -> (Manager -> AccessToken -> IO (Creds m))
-- ^ This function defines how to take an @'AccessToken'@ and -- ^ This function defines how to take an @'AccessToken'@ and
-- retrieve additional information about the user, to be -- retrieve additional information about the user, to be
-- set in the session as @'Creds'@. Usually this means a -- set in the session as @'Creds'@. Usually this means a
@ -64,11 +65,12 @@ authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
dispatch "GET" ["callback"] = do dispatch "GET" ["callback"] = do
code <- lift $ runInputGet $ ireq textField "code" code <- lift $ runInputGet $ ireq textField "code"
oauth' <- withCallback oauth' <- withCallback
result <- liftIO $ fetchAccessToken oauth' (encodeUtf8 code) master <- lift getYesod
result <- liftIO $ fetchAccessToken (authHttpManager master) 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 (authHttpManager master) token
lift $ setCredsRedirect creds lift $ setCredsRedirect creds
dispatch _ _ = notFound dispatch _ _ = notFound

9
Yesod/Auth/OAuth2/Learn.hs
View File

@ -20,6 +20,7 @@ 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.Conduit(Manager)
import qualified Data.Text as T import qualified Data.Text as T
data LearnUser = LearnUser data LearnUser = LearnUser
@ -60,10 +61,10 @@ oauth2Learn clientId clientSecret = authOAuth2 "learn"
}) })
fetchLearnProfile fetchLearnProfile
fetchLearnProfile :: AccessToken -> IO (Creds m) fetchLearnProfile :: Manager -> AccessToken -> IO (Creds m)
fetchLearnProfile token = do fetchLearnProfile manager token = do
result <- authGetJSON token "http://learn.thoughtbot.com/api/v1/me.json" 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
Left err -> throwIO $ InvalidProfileResponse "learn" err Left err -> throwIO $ InvalidProfileResponse "learn" err

2
yesod-auth-oauth2.cabal
View File

@ -30,7 +30,7 @@ library
, 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.2.2 && < 0.4
, hoauth2 >= 0.3.6 && < 0.4 , hoauth2 >= 0.4.1 && < 0.5
, lifted-base >= 0.2 && < 0.4 , lifted-base >= 0.2 && < 0.4
exposed-modules: Yesod.Auth.OAuth2 exposed-modules: Yesod.Auth.OAuth2