Hello community, here is the log from the commit of package ghc-hoauth2 for openSUSE:Factory checked in at 2017-03-24 02:14:51 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hoauth2 (Old) and /work/SRC/openSUSE:Factory/.ghc-hoauth2.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hoauth2" Fri Mar 24 02:14:51 2017 rev:2 rq:461636 version:0.5.7 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hoauth2/ghc-hoauth2.changes 2016-11-01 09:54:49.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-hoauth2.new/ghc-hoauth2.changes 2017-03-24 02:14:52.281650628 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:20:04 UTC 2017 - [email protected] + +- Update to version 0.5.7 with cabal2obs. + +------------------------------------------------------------------- Old: ---- hoauth2-0.5.4.0.tar.gz New: ---- hoauth2-0.5.7.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hoauth2.spec ++++++ --- /var/tmp/diff_new_pack.zraNNQ/_old 2017-03-24 02:14:53.865426540 +0100 +++ /var/tmp/diff_new_pack.zraNNQ/_new 2017-03-24 02:14:53.869425974 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-hoauth2 # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,25 +18,22 @@ %global pkg_name hoauth2 Name: ghc-%{pkg_name} -Version: 0.5.4.0 +Version: 0.5.7 Release: 0 Summary: Haskell OAuth2 authentication client License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-aeson-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-http-conduit-devel BuildRequires: ghc-http-types-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel +BuildRequires: ghc-unordered-containers-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps -BuildRequires: ghc-wai-devel -BuildRequires: ghc-warp-devel %description Haskell OAuth2 authentication client. Tested with the following services: @@ -67,15 +64,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ hoauth2-0.5.4.0.tar.gz -> hoauth2-0.5.7.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hoauth2-0.5.4.0/example/Dropbox/test.hs new/hoauth2-0.5.7/example/Dropbox/test.hs --- old/hoauth2-0.5.4.0/example/Dropbox/test.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hoauth2-0.5.7/example/Dropbox/test.hs 2016-12-17 00:37:45.000000000 +0100 @@ -0,0 +1,39 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Main where + +import Control.Monad (liftM) +import Data.Aeson.TH (defaultOptions, deriveJSON) +import qualified Network.HTTP.Types as HT +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as BSL +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Network.HTTP.Conduit + +import Network.OAuth.OAuth2 + +import Keys + + +main :: IO () +main = do + print $ authorizationUrl dropboxKey + putStrLn "visit the url and paste code here: " + code <- fmap BS.pack getLine + mgr <- newManager tlsManagerSettings + token <- fetchAccessToken mgr dropboxKey code + print token + case token of + Right at -> getSpaceUsage mgr at >>= print + Left _ -> putStrLn "no access token found yet" + +getSpaceUsage :: Manager -> AccessToken -> IO (OAuth2Result BSL.ByteString) +getSpaceUsage mgr token = do + req <- parseRequest $ BS.unpack "https://api.dropboxapi.com/2/users/get_space_usage"; + authRequest req upReq mgr + where upHeaders = updateRequestHeaders (Just token) . setMethod HT.POST + upBody req = req {requestBody = "null" } + upReq = upHeaders . upBody diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hoauth2-0.5.4.0/example/Keys.hs.sample new/hoauth2-0.5.7/example/Keys.hs.sample --- old/hoauth2-0.5.4.0/example/Keys.hs.sample 2016-06-14 18:28:03.000000000 +0200 +++ new/hoauth2-0.5.7/example/Keys.hs.sample 2016-12-17 00:37:45.000000000 +0100 @@ -61,3 +61,10 @@ , oauthOAuthorizeEndpoint = "https://stackexchange.com/oauth"; , oauthAccessTokenEndpoint = "https://stackexchange.com/oauth/access_token"; } +dropboxKey :: OAuth2 +dropboxKey = OAuth2 { oauthClientId = "xxx" + , oauthClientSecret = "xxx" + , oauthCallback = Just "http://localhost:9988/oauth2/callback"; + , oauthOAuthorizeEndpoint = "https://www.dropbox.com/1/oauth2/authorize"; + , oauthAccessTokenEndpoint = "https://api.dropboxapi.com/oauth2/token"; + } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hoauth2-0.5.4.0/example/StackExchange/test.hs new/hoauth2-0.5.7/example/StackExchange/test.hs --- old/hoauth2-0.5.4.0/example/StackExchange/test.hs 2016-06-14 18:28:03.000000000 +0200 +++ new/hoauth2-0.5.7/example/StackExchange/test.hs 2016-06-23 17:02:57.000000000 +0200 @@ -1,45 +1,41 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} -- | Github API: http://developer.github.com/v3/oauth/ module Main where -import Control.Applicative -import Control.Monad (mzero) -import Data.Aeson -import Data.Aeson.TH (defaultOptions, deriveJSON) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy.Char8 as BSL -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import Data.Aeson.TH (defaultOptions, deriveJSON) +import qualified Data.ByteString.Char8 as BS +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Network.HTTP.Conduit import Network.OAuth.OAuth2 import Keys -data SiteInfo = SiteInfo { items :: [SiteItem] - , has_more :: Bool - , quota_max :: Integer +data SiteInfo = SiteInfo { items :: [SiteItem] + , has_more :: Bool + , quota_max :: Integer , quota_remaining :: Integer } deriving (Show, Eq) -data SiteItem = SiteItem { new_active_users :: Integer - , total_users :: Integer - , badges_per_minute :: Double - , total_badges :: Integer - , total_votes :: Integer - , total_comments :: Integer - , answers_per_minute :: Double +data SiteItem = SiteItem { new_active_users :: Integer + , total_users :: Integer + , badges_per_minute :: Double + , total_badges :: Integer + , total_votes :: Integer + , total_comments :: Integer + , answers_per_minute :: Double , questions_per_minute :: Double - , total_answers :: Integer - , total_accepted :: Integer - , total_unanswered :: Integer - , total_questions :: Integer - , api_revision :: Text + , total_answers :: Integer + , total_accepted :: Integer + , total_unanswered :: Integer + , total_questions :: Integer + , api_revision :: Text } deriving (Show, Eq) $(deriveJSON defaultOptions ''SiteInfo) @@ -50,29 +46,14 @@ main = do print $ authorizationUrl stackexchangeKey putStrLn "visit the url and paste code here: " - code <- getLine + code <- fmap BS.pack getLine mgr <- newManager tlsManagerSettings - let (url, body) = accessTokenUrl stackexchangeKey (sToBS code) - token <- doSimplePostRequest mgr stackexchangeKey url (body) - print (token :: OAuth2Result BSL.ByteString) + token <- fetchAccessToken mgr stackexchangeKey code + print token case token of - Right at -> siteInfo mgr (getAccessToken at) >>= print + Right at -> siteInfo mgr at >>= print Left _ -> putStrLn "no access token found yet" - - --- stackexchange access token api does not respond json but an string --- https://api.stackexchange.com/docs/authentication -getAccessToken :: BSL.ByteString -> AccessToken -getAccessToken str = let xs = BSL.split '&' str - ys = BSL.split '=' (xs !! 0) - in - AccessToken { accessToken = BSL.toStrict (ys !! 1) - , refreshToken = Nothing - , expiresIn = Nothing - , tokenType = Nothing - } - -- | Test API: info siteInfo :: Manager -> AccessToken -> IO (OAuth2Result SiteInfo) siteInfo mgr token = authGetJSON mgr token "https://api.stackexchange.com/2.2/info?site=stackoverflow"; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hoauth2-0.5.4.0/hoauth2.cabal new/hoauth2-0.5.7/hoauth2.cabal --- old/hoauth2-0.5.4.0/hoauth2.cabal 2016-06-14 18:28:03.000000000 +0200 +++ new/hoauth2-0.5.7/hoauth2.cabal 2016-12-17 00:37:45.000000000 +0100 @@ -1,6 +1,6 @@ Name: hoauth2 -- http://wiki.haskell.org/Package_versioning_policy -Version: 0.5.4.0 +Version: 0.5.7 Synopsis: Haskell OAuth2 authentication client Description: @@ -58,12 +58,13 @@ Network.OAuth.OAuth2 Build-Depends: - base >= 4 && < 5, - aeson >= 0.9 && < 0.12, - text >= 0.11 && < 1.3, - bytestring >= 0.9 && < 0.11, - http-conduit >= 2.0 && < 2.2, - http-types >= 0.9 && < 0.10 + base >= 4 && < 5, + aeson >= 1.0 && < 1.1, + text >= 0.11 && < 1.3, + bytestring >= 0.9 && < 0.11, + http-conduit >= 2.2 && < 2.3, + http-types >= 0.9 && < 0.10, + unordered-containers >=0.2.5 if impl(ghc >= 6.12.0) ghc-options: -Wall -fwarn-tabs -funbox-strict-fields @@ -82,7 +83,7 @@ default-language: Haskell2010 build-depends: base >= 4.5 && < 5, http-types >= 0.9 && < 0.10, - http-conduit >= 2.0 && < 2.2, + http-conduit >= 2.2 && < 2.3, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, hoauth2 @@ -105,10 +106,10 @@ default-language: Haskell2010 build-depends: base >= 4.5 && < 5, http-types >= 0.9 && < 0.10, - http-conduit >= 2.0 && < 2.2, + http-conduit >= 2.2 && < 2.3, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, - aeson >= 0.9 && < 0.12, + aeson >= 1.0 && < 1.1, hoauth2 if impl(ghc >= 6.12.0) @@ -129,10 +130,10 @@ default-language: Haskell2010 build-depends: base >= 4.5 && < 5, http-types >= 0.9 && < 0.10, - http-conduit >= 2.0 && < 2.2, + http-conduit >= 2.2 && < 2.3, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, - aeson >= 0.9 && < 0.12, + aeson >= 1.0 && < 1.1, hoauth2 if impl(ghc >= 6.12.0) @@ -152,10 +153,10 @@ default-language: Haskell2010 build-depends: base >= 4.5 && < 5, http-types >= 0.9 && < 0.10, - http-conduit >= 2.0 && < 2.2, + http-conduit >= 2.2 && < 2.3, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, - aeson >= 0.9 && < 0.12, + aeson >= 1.0 && < 1.1, hoauth2 if impl(ghc >= 6.12.0) @@ -175,10 +176,10 @@ default-language: Haskell2010 build-depends: base >= 4.5 && < 5, http-types >= 0.9 && < 0.10, - http-conduit >= 2.0 && < 2.2, + http-conduit >= 2.2 && < 2.3, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, - aeson >= 0.9 && < 0.12, + aeson >= 1.0 && < 1.1, hoauth2 if impl(ghc >= 6.12.0) @@ -197,14 +198,14 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5, - aeson >= 0.9 && < 0.12, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, - http-conduit >= 2.0 && < 2.2, + http-conduit >= 2.2 && < 2.3, http-types >= 0.9 && < 0.10, wai >= 3.2 && < 3.3, warp >= 3.2 && < 3.3, containers >= 0.4 && < 0.6, + aeson >= 1.0 && < 1.1, hoauth2 @@ -225,10 +226,10 @@ default-language: Haskell2010 build-depends: base >= 4.5 && < 5, http-types >= 0.9 && < 0.10, - http-conduit >= 2.0 && < 2.2, + http-conduit >= 2.2 && < 2.3, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, - aeson >= 0.9 && < 0.12, + aeson >= 1.0 && < 1.1, hoauth2 if impl(ghc >= 6.12.0) @@ -236,3 +237,27 @@ -fno-warn-unused-do-bind else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields + +Executable test-dropbox + if flag(test) + Buildable: True + else + Buildable: False + + main-is: Dropbox/test.hs + hs-source-dirs: example + default-language: Haskell2010 + build-depends: base >= 4.5 && < 5, + http-types >= 0.9 && < 0.10, + http-conduit >= 2.2 && < 2.3, + text >= 0.11 && < 1.3, + bytestring >= 0.9 && < 0.11, + aeson >= 1.0 && < 1.1, + hoauth2 + + if impl(ghc >= 6.12.0) + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields + -fno-warn-unused-do-bind + else + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hoauth2-0.5.4.0/src/Network/OAuth/OAuth2/HttpClient.hs new/hoauth2-0.5.7/src/Network/OAuth/OAuth2/HttpClient.hs --- old/hoauth2-0.5.4.0/src/Network/OAuth/OAuth2/HttpClient.hs 2016-06-14 18:28:03.000000000 +0200 +++ new/hoauth2-0.5.7/src/Network/OAuth/OAuth2/HttpClient.hs 2016-12-17 00:37:45.000000000 +0100 @@ -8,6 +8,7 @@ fetchAccessToken, fetchRefreshToken, doJSONPostRequest, + doFlexiblePostRequest, doSimplePostRequest, -- * AUTH requests authGetJSON, @@ -15,10 +16,12 @@ authGetBS', authPostJSON, authPostBS, + authPostBS', authRequest, -- * Utilities handleResponse, parseResponseJSON, + parseResponseFlexible, updateRequestHeaders, setMethod ) where @@ -27,10 +30,12 @@ import Data.Aeson import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL +import qualified Data.HashMap.Strict as HM (fromList) import Data.Maybe +import qualified Data.Text.Encoding as T import Network.HTTP.Conduit hiding (withManager) import qualified Network.HTTP.Types as HT - +import Network.HTTP.Types.URI (parseQuery) import Network.OAuth.OAuth2.Internal -------------------------------------------------- @@ -42,7 +47,7 @@ -> OAuth2 -- ^ OAuth Data -> BS.ByteString -- ^ Authentication code gained after authorization -> IO (OAuth2Result AccessToken) -- ^ Access Token -fetchAccessToken manager oa code = doJSONPostRequest manager oa uri body +fetchAccessToken manager oa code = doFlexiblePostRequest manager oa uri body where (uri, body) = accessTokenUrl oa code @@ -51,7 +56,7 @@ -> OAuth2 -- ^ OAuth context -> BS.ByteString -- ^ refresh token gained after authorization -> IO (OAuth2Result AccessToken) -fetchRefreshToken manager oa rtoken = doJSONPostRequest manager oa uri body +fetchRefreshToken manager oa rtoken = doFlexiblePostRequest manager oa uri body where (uri, body) = refreshAccessTokenUrl oa rtoken @@ -64,6 +69,15 @@ -> IO (OAuth2Result a) -- ^ Response as ByteString doJSONPostRequest manager oa uri body = liftM parseResponseJSON (doSimplePostRequest manager oa uri body) +-- | Conduct post request and return response as JSON or Query String. +doFlexiblePostRequest :: FromJSON a + => Manager -- ^ HTTP connection manager. + -> OAuth2 -- ^ OAuth options + -> URI -- ^ The URL + -> PostBody -- ^ request body + -> IO (OAuth2Result a) -- ^ Response as ByteString +doFlexiblePostRequest manager oa uri body = liftM parseResponseFlexible (doSimplePostRequest manager oa uri body) + -- | Conduct post request. doSimplePostRequest :: Manager -- ^ HTTP connection manager. -> OAuth2 -- ^ OAuth options @@ -131,6 +145,19 @@ upHeaders = updateRequestHeaders (Just token) . setMethod HT.POST upReq = upHeaders . upBody +-- | Conduct POST request with access token in the request body rather header +authPostBS' :: Manager -- ^ HTTP connection manager. + -> AccessToken + -> URI -- ^ URL + -> PostBody + -> IO (OAuth2Result BSL.ByteString) -- ^ Response as ByteString +authPostBS' manager token url pb = do + req <- parseUrl $ BS.unpack url + authRequest req upReq manager + where upBody = urlEncodedBody (pb ++ accessTokenToParam token) + upHeaders = updateRequestHeaders Nothing . setMethod HT.POST + upReq = upHeaders . upBody + -- |Send an HTTP request including the Authorization header with the specified -- access token. -- @@ -149,7 +176,7 @@ handleResponse rsp = if HT.statusIsSuccessful (responseStatus rsp) then Right $ responseBody rsp - else Left $ BSL.append "hoauth2.HttpClient.parseResponseJSON/Gaining token failed: " (responseBody rsp) + else Left $ BSL.append "hoauth2.HttpClient.handleResponse/Gaining token failed: " (responseBody rsp) -- | Parses a @OAuth2Result BSL.ByteString@ into @FromJSON a => a@ parseResponseJSON :: FromJSON a @@ -160,6 +187,29 @@ Nothing -> Left ("hoauth2.HttpClient.parseResponseJSON/Could not decode JSON: " `BSL.append` b) Just x -> Right x +-- | Parses a @OAuth2Result BSL.ByteString@ that contains not JSON but a Query String +parseResponseString :: FromJSON a + => OAuth2Result BSL.ByteString + -> OAuth2Result a +parseResponseString (Left b) = Left b +parseResponseString (Right b) = case parseQuery $ BSL.toStrict b of + [] -> Left errorMessage + a -> case fromJSON $ queryToValue a of + Error _ -> Left errorMessage + Success x -> Right x + where + queryToValue = Object . HM.fromList . map paramToPair + paramToPair (k, mv) = (T.decodeUtf8 k, maybe Null (String . T.decodeUtf8) mv) + errorMessage = "hoauth2.HttpClient.parseResponseJSON/Could not decode JSON or URL: " `BSL.append` b + +-- | Try 'parseResponseJSON' and 'parseResponseString' +parseResponseFlexible :: FromJSON a + => OAuth2Result BSL.ByteString + -> OAuth2Result a +parseResponseFlexible r = case parseResponseJSON r of + Left _ -> parseResponseString r + x -> x + -- | Set several header values: -- + userAgennt : `hoauth2` -- + accept : `application/json` diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hoauth2-0.5.4.0/src/Network/OAuth/OAuth2/Internal.hs new/hoauth2-0.5.7/src/Network/OAuth/OAuth2/Internal.hs --- old/hoauth2-0.5.4.0/src/Network/OAuth/OAuth2/Internal.hs 2016-06-14 18:28:03.000000000 +0200 +++ new/hoauth2-0.5.7/src/Network/OAuth/OAuth2/Internal.hs 2016-12-17 00:37:45.000000000 +0100 @@ -96,11 +96,10 @@ -> (URI, PostBody) -- ^ access token request URL plus the request body. accessTokenUrl' oa code gt = (uri, body) where uri = oauthAccessTokenEndpoint oa - body = transform' [ ("client_id", Just $ oauthClientId oa) - , ("client_secret", Just $ oauthClientSecret oa) - , ("code", Just code) + body = transform' [ ("code", Just code) , ("redirect_uri", oauthCallback oa) - , ("grant_type", gt) ] + , ("grant_type", gt) + ] -- | Using a Refresh Token. Obtain a new access token by -- sending a refresh token to the Authorization server. @@ -109,10 +108,9 @@ -> (URI, PostBody) -- ^ refresh token request URL plus the request body. refreshAccessTokenUrl oa rtoken = (uri, body) where uri = oauthAccessTokenEndpoint oa - body = transform' [ ("client_id", Just $ oauthClientId oa) - , ("client_secret", Just $ oauthClientSecret oa) - , ("grant_type", Just "refresh_token") - , ("refresh_token", Just rtoken) ] + body = transform' [ ("grant_type", Just "refresh_token") + , ("refresh_token", Just rtoken) + ] -------------------------------------------------- -- * UTILs
