hoauth2 0.3.5 → 0.3.6
raw patch · 7 files changed
+36/−45 lines, 7 filesdep ~aesondep ~http-conduitdep ~http-types
Dependency ranges changed: aeson, http-conduit, http-types, resourcet, text
Files
- example/Facebook/test.hs +3/−3
- example/Google/test.hs +15/−22
- example/Keys.hs.sample +3/−3
- example/run.sh +1/−1
- hoauth2.cabal +6/−6
- src/Network/OAuth/OAuth2/HttpClient.hs +4/−6
- src/Network/OAuth/OAuth2/Internal.hs +4/−4
example/Facebook/test.hs view
@@ -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"
example/Google/test.hs view
@@ -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"
example/Keys.hs.sample view
@@ -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" }
example/run.sh view
@@ -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 $*
hoauth2.cabal view
@@ -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)
src/Network/OAuth/OAuth2/HttpClient.hs view
@@ -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 }
src/Network/OAuth/OAuth2/Internal.hs view
@@ -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 --------------------------------------------------