diff --git a/example/Facebook/test.hs b/example/Facebook/test.hs --- a/example/Facebook/test.hs +++ b/example/Facebook/test.hs @@ -14,7 +14,7 @@ import Control.Monad (mzero) import Data.Aeson (FromJSON, Value (Object), parseJSON, (.:), (.:?)) -import Data.Aeson.TH (deriveJSON) +import Data.Aeson.TH (deriveJSON, defaultOptions) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL import Data.Text (Text) @@ -29,7 +29,7 @@ , email :: Text } deriving (Show) -$(deriveJSON P.id ''User) +$(deriveJSON defaultOptions ''User) -------------------------------------------------- @@ -52,7 +52,7 @@ -- | Fetch user id and email. userinfo :: AccessToken -> IO (OAuth2Result BL.ByteString) -userinfo token = authGetJSON token "https://graph.facebook.com/me?fields=id,name,email&" +userinfo token = authGetBS token "https://graph.facebook.com/me?fields=id,name,email&" userinfo' :: FromJSON User => AccessToken -> IO (OAuth2Result User) userinfo' token = authGetJSON token "https://graph.facebook.com/me?fields=id,name,email" diff --git a/example/Google/test.hs b/example/Google/test.hs --- a/example/Google/test.hs +++ b/example/Google/test.hs @@ -21,7 +21,7 @@ import Control.Monad (mzero) import Data.Aeson (FromJSON, Value (Object), parseJSON, (.:), (.:?)) -import Data.Aeson.TH (deriveJSON) +import Data.Aeson.TH (deriveJSON, defaultOptions) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Internal as BL import Data.Text (Text) @@ -37,24 +37,13 @@ , user_id :: Maybe Text , scope :: Text , expires_in :: Integer - , email :: Maybe Text - , verified_email :: Maybe Bool + -- , email :: Maybe Text + -- , verified_email :: Maybe Bool , access_type :: Text } deriving (Show) --- ance FromJSON Token where --- parseJSON (Object o) = Token --- <$> o .: "issued_to" --- <*> o .: "audience" --- <*> o .:? "user_id" --- <*> o .: "scope" --- <*> o .: "expires_in" --- <*> o .:? "email" --- <*> o .:? "verified_email" --- <*> o .: "access_type" --- parseJSON _ = mzero -$(deriveJSON P.id ''Token) +$(deriveJSON defaultOptions ''Token) data User = User { id :: Text , name :: Text @@ -67,7 +56,7 @@ , locale :: Text } deriving (Show) -$(deriveJSON P.id ''User) +$(deriveJSON defaultOptions ''User) -------------------------------------------------- @@ -80,7 +69,7 @@ offlineCase :: IO () offlineCase = do - print $ authorizationUrl googleKey `appendQueryParam` (googleScopeEmail ++ googleAccessOffline) + BS.putStrLn $ authorizationUrl googleKey `appendQueryParam` (googleScopeEmail ++ googleAccessOffline) putStrLn "visit the url and paste code here: " code <- fmap BS.pack getLine (Right token) <- fetchAccessToken googleKey code @@ -90,9 +79,9 @@ -- Revoke Access https://www.google.com/settings/security -- case refreshToken token of - Nothing -> print "Failed to fetch refresh token" + Nothing -> putStrLn "Failed to fetch refresh token" Just tk -> do - (Right token) <- fetchAccessToken googleKey tk + (Right token) <- fetchRefreshToken googleKey tk f token --validateToken accessToken >>= print --(validateToken' accessToken :: IO (OAuth2Result Token)) >>= print @@ -103,14 +92,18 @@ normalCase :: IO () normalCase = do - print $ authorizationUrl googleKey `appendQueryParam` googleScopeUserInfo + BS.putStrLn $ authorizationUrl googleKey `appendQueryParam` googleScopeUserInfo putStrLn "visit the url and paste code here: " code <- fmap BS.pack getLine (Right token) <- fetchAccessToken googleKey code putStr "AccessToken: " >> print token + -- get response in ByteString validateToken token >>= print + -- get response in JSON (validateToken' token :: IO (OAuth2Result Token)) >>= print + -- get response in ByteString userinfo token >>= print + -- get response in JSON (userinfo' token :: IO (OAuth2Result User)) >>= print -------------------------------------------------- @@ -131,7 +124,7 @@ -- | Token Validation validateToken :: AccessToken -> IO (OAuth2Result BL.ByteString) -validateToken token = authGetJSON token "https://www.googleapis.com/oauth2/v1/tokeninfo" +validateToken token = authGetBS token "https://www.googleapis.com/oauth2/v1/tokeninfo" validateToken' :: FromJSON a => AccessToken -> IO (OAuth2Result a) validateToken' token = authGetJSON token "https://www.googleapis.com/oauth2/v1/tokeninfo" @@ -140,7 +133,7 @@ -- for more information, please check the playround site. -- userinfo :: AccessToken -> IO (OAuth2Result BL.ByteString) -userinfo token = authGetJSON token "https://www.googleapis.com/oauth2/v2/userinfo" +userinfo token = authGetBS token "https://www.googleapis.com/oauth2/v2/userinfo" userinfo' :: FromJSON a => AccessToken -> IO (OAuth2Result a) userinfo' token = authGetJSON token "https://www.googleapis.com/oauth2/v2/userinfo" diff --git a/example/Keys.hs.sample b/example/Keys.hs.sample --- a/example/Keys.hs.sample +++ b/example/Keys.hs.sample @@ -13,10 +13,10 @@ } -- | http://developer.github.com/v3/oauth/ -githubKeys :: OAuth2 -githubKeys = OAuth2 { oauthClientId = "xxxxxxxxxxxxxxx" +githubKey :: OAuth2 +githubKey = OAuth2 { oauthClientId = "xxxxxxxxxxxxxxx" , oauthClientSecret = "xxxxxxxxxxxxxxxxxxxxxx" - , oauthCallback = Just "http://127.0.0.1:9988/oauthCallback" + , oauthCallback = Just "http://127.0.0.1:9988/githubCallback" , oauthOAuthorizeEndpoint = "https://github.com/login/oauth/authorize" , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token" } diff --git a/example/run.sh b/example/run.sh --- a/example/run.sh +++ b/example/run.sh @@ -1,2 +1,2 @@ -runghc -package-conf=../cabal-dev/packages-7.4.1.conf $* +runghc -package-conf=../.cabal-sandbox/x86_64-linux-ghc-7.4.1-packages.conf.d $* diff --git a/hoauth2.cabal b/hoauth2.cabal --- a/hoauth2.cabal +++ b/hoauth2.cabal @@ -1,6 +1,6 @@ Name: hoauth2 -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) -Version: 0.3.5 +Version: 0.3.6 Synopsis: hoauth2 Description: @@ -53,18 +53,18 @@ Network.OAuth.OAuth2 Build-Depends: - aeson >= 0.6 && < 0.7, + aeson >= 0.7 && < 0.8, base >= 4 && < 5, - text >= 0.11 && < 0.12, + text >= 1.1 && < 1.2, bytestring >= 0.9 && < 0.11, bytestring-show >= 0.3.5 && < 0.4, conduit >= 1.0 && < 1.1, - http-conduit >= 1.9 && < 1.10, - http-types >= 0.7 && < 0.8, + http-conduit >= 2.0 && < 2.1, + http-types >= 0.8 && < 0.9, monad-control >= 0.3 && < 0.4, mtl >= 1 && < 2.2, transformers >= 0.2 && < 0.4, - resourcet >= 0.4.5 && < 0.4.6, + resourcet >= 0.4 && < 0.5, random if impl(ghc >= 6.12.0) diff --git a/src/Network/OAuth/OAuth2/HttpClient.hs b/src/Network/OAuth/OAuth2/HttpClient.hs --- a/src/Network/OAuth/OAuth2/HttpClient.hs +++ b/src/Network/OAuth/OAuth2/HttpClient.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,7 +6,6 @@ module Network.OAuth.OAuth2.HttpClient where import Control.Monad (liftM) -import Control.Monad.Trans.Resource (ResourceT) import Data.Aeson import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL @@ -101,7 +99,7 @@ -- authenticatedRequest :: AccessToken -- ^ Authentication token to use -> HT.StdMethod -- ^ Method to use - -> Request (ResourceT IO) -- ^ Request to perform + -> Request -- ^ Request to perform -> IO (Response BSL.ByteString) authenticatedRequest token m r = withManager $ httpLbs @@ -111,7 +109,7 @@ -- | Sets the HTTP method to use -- -setMethod :: HT.StdMethod -> Request m -> Request m +setMethod :: HT.StdMethod -> Request -> Request setMethod m req = req { method = HT.renderStdMethod m } -------------------------------------------------- @@ -141,11 +139,11 @@ -- + accept : application/json -- + authorization : Bearer xxxxx if AccessToken provided. -- -updateRequestHeaders :: Maybe AccessToken -> Request m -> Request m +updateRequestHeaders :: Maybe AccessToken -> Request -> Request updateRequestHeaders t req = let extras = [ (HT.hUserAgent, "hoauth2") , (HT.hAccept, "application/json") ] - bearer = [(HT.hAuthorization, "Bearer " `BS.append` (accessToken $ fromJust t)) | isJust t] + bearer = [(HT.hAuthorization, "Bearer " `BS.append` accessToken (fromJust t)) | isJust t] headers = bearer ++ extras ++ requestHeaders req in req { requestHeaders = headers } diff --git a/src/Network/OAuth/OAuth2/Internal.hs b/src/Network/OAuth/OAuth2/Internal.hs --- a/src/Network/OAuth/OAuth2/Internal.hs +++ b/src/Network/OAuth/OAuth2/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK -ignore-exports #-} @@ -14,6 +13,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.Maybe +import Data.Text.Encoding import Network.HTTP.Types (renderSimpleQuery) -------------------------------------------------- @@ -43,9 +43,9 @@ -- | Parse JSON data into {AccessToken} -- instance FromJSON AccessToken where - parseJSON (Object o) = AccessToken - <$> o .: "access_token" - <*> o .:? "refresh_token" + parseJSON (Object o) = AccessToken <$> at <*> rt where + at = fmap encodeUtf8 $ o .: "access_token" + rt = fmap (fmap encodeUtf8) $ o .:? "refresh_token" parseJSON _ = mzero --------------------------------------------------