hoauth2 0.5.4.0 → 0.5.5.0

raw patch · 3 files changed

+79/−61 lines, 3 filesdep +unordered-containersdep ~http-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: unordered-containers

Dependency ranges changed: http-conduit

API changes (from Hackage documentation)

Files

• example/StackExchange/test.hs +25/−44
• hoauth2.cabal +15/−14
• src/Network/OAuth/OAuth2/HttpClient.hs +39/−3

@@ -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,28 +46,13 @@ 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)

@@ -1,6 +1,6 @@ Name:                hoauth2 -- http://wiki.haskell.org/Package_versioning_policy-Version:             0.5.4.0+Version:             0.5.5.0  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                >= 0.9   && < 0.12,+    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,7 +106,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,                        aeson             >= 0.9    && < 0.12,@@ -129,7 +130,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,                        aeson             >= 0.9    && < 0.12,@@ -152,7 +153,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,                        aeson             >= 0.9    && < 0.12,@@ -175,7 +176,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,                        aeson             >= 0.9    && < 0.12,@@ -200,7 +201,7 @@                        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,@@ -225,7 +226,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,                        aeson             >= 0.9    && < 0.12,

@@ -8,6 +8,7 @@   fetchAccessToken,   fetchRefreshToken,   doJSONPostRequest,+  doFlexiblePostRequest,   doSimplePostRequest, -- * AUTH requests   authGetJSON,@@ -19,6 +20,7 @@ -- * Utilities   handleResponse,   parseResponseJSON,+  parseResponseFlexible,   updateRequestHeaders,   setMethod ) where@@ -27,10 +29,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 +46,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 +55,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 +68,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@@ -159,6 +172,29 @@ parseResponseJSON (Right b) = case decode b of                             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`