hoauth2 0.5.3 → 0.5.3.1
raw patch · 4 files changed
+117/−4 lines, 4 filesdep ~basenew-component:exe:test-stackexchangePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- example/Keys.hs.sample +9/−1
- example/StackExchange/test.hs +81/−0
- hoauth2.cabal +25/−1
- src/Network/OAuth/OAuth2/HttpClient.hs +2/−2
example/Keys.hs.sample view
@@ -33,7 +33,7 @@ facebookKey :: OAuth2 facebookKey = OAuth2 { oauthClientId = "xxxxxxxxxxxxxxx" , oauthClientSecret = "xxxxxxxxxxxxxxxxxxxxxx"- , oauthCallback = Just "http://test.com/cb"+ , oauthCallback = Just "http://t.haskellcn.org/cb" , oauthOAuthorizeEndpoint = "https://www.facebook.com/dialog/oauth" , oauthAccessTokenEndpoint = "https://graph.facebook.com/v2.3/oauth/access_token" }@@ -53,3 +53,11 @@ , oauthOAuthorizeEndpoint = "https://www.fitbit.com/oauth2/authorize" , oauthAccessTokenEndpoint = "https://api.fitbit.com/oauth2/token" }++stackexchangeKey :: OAuth2+stackexchangeKey = OAuth2 { oauthClientId = "xx"+ , oauthClientSecret = "xxxxxxxxxxxxxxx"+ , oauthCallback = Just "http://c.haskellcn.org/cb"+ , oauthOAuthorizeEndpoint = "https://stackexchange.com/oauth"+ , oauthAccessTokenEndpoint = "https://stackexchange.com/oauth/access_token"+ }
+ example/StackExchange/test.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++-- | 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 Network.HTTP.Conduit++import Network.OAuth.OAuth2++import Keys++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+ , questions_per_minute :: Double+ , total_answers :: Integer+ , total_accepted :: Integer+ , total_unanswered :: Integer+ , total_questions :: Integer+ , api_revision :: Text+ } deriving (Show, Eq)++$(deriveJSON defaultOptions ''SiteInfo)+$(deriveJSON defaultOptions ''SiteItem)+++main :: IO ()+main = do+ print $ authorizationUrl stackexchangeKey+ putStrLn "visit the url and paste code here: "+ code <- getLine+ mgr <- newManager tlsManagerSettings+ let (url, body) = accessTokenUrl stackexchangeKey (sToBS code)+ token <- doSimplePostRequest mgr stackexchangeKey url (body)+ print (token :: OAuth2Result BSL.ByteString)+ case token of+ Right at -> siteInfo mgr (getAccessToken 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"++sToBS :: String -> BS.ByteString+sToBS = T.encodeUtf8 . T.pack
hoauth2.cabal view
@@ -1,6 +1,6 @@ Name: hoauth2 -- http://wiki.haskell.org/Package_versioning_policy-Version: 0.5.3+Version: 0.5.3.1 Synopsis: Haskell OAuth2 authentication client Description:@@ -213,3 +213,27 @@ -fno-warn-unused-do-bind -fno-warn-orphans else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields++Executable test-stackexchange+ if flag(test)+ Buildable: True+ else+ Buildable: False++ main-is: StackExchange/test.hs+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >= 4.5 && < 5,+ http-types >= 0.9 && < 0.10,+ http-conduit >= 2.0 && < 2.2,+ text >= 0.11 && < 1.3,+ bytestring >= 0.9 && < 0.11,+ aeson >= 0.9 && < 0.12,+ 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+
src/Network/OAuth/OAuth2/HttpClient.hs view
@@ -149,7 +149,7 @@ handleResponse rsp = if HT.statusIsSuccessful (responseStatus rsp) then Right $ responseBody rsp- else Left $ BSL.append "Gaining token failed: " (responseBody rsp)+ else Left $ BSL.append "hoauth2.HttpClient.parseResponseJSON/Gaining token failed: " (responseBody rsp) -- | Parses a @OAuth2Result BSL.ByteString@ into @FromJSON a => a@ parseResponseJSON :: FromJSON a@@ -157,7 +157,7 @@ -> OAuth2Result a parseResponseJSON (Left b) = Left b parseResponseJSON (Right b) = case decode b of- Nothing -> Left ("Could not decode JSON" `BSL.append` b)+ Nothing -> Left ("hoauth2.HttpClient.parseResponseJSON/Could not decode JSON: " `BSL.append` b) Just x -> Right x -- | Set several header values: