hoauth2 1.6.2 → 1.6.3
raw patch · 2 files changed
+121/−11 lines, 2 filesdep ~basedep ~http-typesnew-component:exe:demo-serverPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, http-types
API changes (from Hackage documentation)
Files
- example/demo-server.hs +81/−0
- hoauth2.cabal +40/−11
+ example/demo-server.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Monad (mzero)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Char (chr)+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Network.HTTP.Conduit hiding (Request, queryString)+import Network.HTTP.Types (Query, status200)+import Network.Wai+import Network.Wai.Handler.Warp (run)+import URI.ByteString (serializeURIRef')+import URI.ByteString.QQ++import Keys (fitbitKey)+import Network.OAuth.OAuth2++import Data.Aeson+import Data.Aeson.Types+import GHC.Generics++------------------------------------------------------------------------------++main :: IO ()+main = do+ print $ serializeURIRef' $ appendQueryParams [("state", state), ("scope", "profile")] $ authorizationUrl fitbitKey+ putStrLn "visit the url to continue"+ run 9988 application++application :: Application+application request respond = do+ response <- handleRequest requestPath request+ respond $ responseLBS status200 [("Content-Type", "text/plain")] response+ where+ requestPath = T.intercalate "/" $ pathInfo request++handleRequest :: Text -> Request -> IO BL.ByteString+handleRequest "favicon.ico" _ = return ""+handleRequest _ request = do+ mgr <- newManager tlsManagerSettings+ token <- getApiToken mgr $ getApiCode request+ print token+ user <- getApiUser mgr (accessToken token)+ print user+ return $ encode user++getApiCode :: Request -> ExchangeToken+getApiCode request =+ case M.lookup "code" queryMap of+ Just code -> ExchangeToken $ T.decodeUtf8 code+ Nothing -> Prelude.error "request doesn't include code"+ where+ queryMap = convertQueryToMap $ queryString request++getApiToken :: Manager -> ExchangeToken -> IO OAuth2Token+getApiToken mgr code = do+ result <- doJSONPostRequest mgr fitbitKey url $ body ++ [("state", state)]+ case result of+ Right token -> return token+ Left (e :: OAuth2Error Errors) -> Prelude.error $ show e+ where+ (url, body) = accessTokenUrl fitbitKey code++convertQueryToMap :: Query -> M.Map B.ByteString B.ByteString+convertQueryToMap query =+ M.fromList $ map normalize query+ where+ normalize (k, Just v) = (k, v)+ normalize (k, Nothing) = (k, B.empty)++lazyBSToString :: BL.ByteString -> String+lazyBSToString s = map (chr . fromIntegral) (BL.unpack s)
hoauth2.cabal view
@@ -1,6 +1,6 @@ Name: hoauth2 -- http://wiki.haskell.org/Package_versioning_policy-Version: 1.6.2+Version: 1.6.3 Synopsis: Haskell OAuth2 authentication client @@ -65,7 +65,7 @@ text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, http-conduit >= 2.1 && < 2.4,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, aeson >= 0.11 && < 1.3, unordered-containers >= 0.2.5, uri-bytestring >= 0.2.3.1 && < 0.4,@@ -90,7 +90,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -116,7 +116,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -142,7 +142,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -167,7 +167,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -192,7 +192,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -221,7 +221,7 @@ bytestring >= 0.9 && < 0.11, uri-bytestring >= 0.2.3.1 && < 0.4, http-conduit >= 2.1 && < 2.4,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, wai >= 3.2 && < 3.3, warp >= 3.2 && < 3.3, containers >= 0.4 && < 0.6,@@ -246,7 +246,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -271,7 +271,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -296,7 +296,7 @@ hs-source-dirs: example default-language: Haskell2010 build-depends: base >= 4.5 && < 5,- http-types >= 0.11 && < 0.12,+ http-types >= 0.11 && < 0.13, http-conduit >= 2.1 && < 2.4, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11,@@ -307,5 +307,34 @@ 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++Executable demo-server+ if flag(test)+ Buildable: True+ else+ Buildable: False++ main-is: demo-server.hs+ other-modules: Keys+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >= 4.5 && < 5,+ text >= 0.11 && < 1.3,+ bytestring >= 0.9 && < 0.11,+ uri-bytestring >= 0.2.3.1 && < 0.4,+ http-conduit >= 2.1 && < 2.4,+ http-types >= 0.11 && < 0.13,+ wai >= 3.2 && < 3.3,+ warp >= 3.2 && < 3.3,+ containers >= 0.4 && < 0.6,+ aeson >= 0.11 && < 1.3,+ hoauth2+++ if impl(ghc >= 6.12.0)+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields+ -fno-warn-unused-do-bind -fno-warn-orphans else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields