handa-gdata 0.6.2 → 0.6.3
raw patch · 4 files changed
+97/−110 lines, 4 filesdep ~GenericPrettydep ~HTTPdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: GenericPretty, HTTP, base, base64-bytestring, binary, bytestring, case-insensitive, cmdargs, http-conduit, json, process, pureMD5, regex-posix, resourcet, split, xml
API changes (from Hackage documentation)
Files
- handa-gdata.cabal +71/−30
- src/Network/Google.hs +4/−28
- src/Network/Google/FusionTables.hs +1/−2
- src/Network/Google/OAuth2.hs +21/−50
handa-gdata.cabal view
@@ -1,22 +1,16 @@ name: handa-gdata-version: 0.6.2+version: 0.6.3 cabal-version: >=1.6---- CHANGELOG:--- 0.6.2: Improve getCachedTokens--- - build-type: Simple license: MIT license-file: LICENSE copyright: (c) 2012-13 Brian W Bush, Ryan Newton-maintainer: Brian W Bush <b.w.bush@acm.org>, Ryan Newton <rrnewton@indiana.edu>+maintainer: Brian W Bush <b.w.bush@acm.org> stability: Stable homepage: http://code.google.com/p/hgdata package-url: http://code.google.com/p/hgdata/downloads/list bug-reports: http://code.google.com/p/hgdata/issues/entry synopsis: Library and command-line utility for accessing Google services and APIs.- description: This project provides a Haskell library and command-line interface for Google services such as Google Storage, Contacts, Books, etc. . For OAuth 2.0, the following operations are supported:@@ -80,36 +74,83 @@ location: https://code.google.com/p/hgdata/ library- build-depends: HTTP -any, base <6, base64-bytestring -any,- binary -any, bytestring -any, case-insensitive -any, cmdargs -any,- directory -any, filepath -any, split -any, http-conduit,- json -any, old-locale -any, process -any, pureMD5 -any,- regex-posix -any, resourcet -any, time -any, unix -any,- utf8-string -any, xml -any, random -any, pretty -any, GenericPretty -any- exposed-modules: Crypto.GnuPG Crypto.MD5 Network.Google- Network.Google.Bookmarks Network.Google.Books- Network.Google.Contacts Network.Google.OAuth2 Network.Google.Picasa- Network.Google.Storage Network.Google.Storage.Encrypted- Network.Google.Storage.Sync+ build-depends: base >= 4 && < 5+ , base64-bytestring >= 0.9.1.4+ , binary >= 0.5.1.1+ , bytestring >= 0.10.0.2+ , case-insensitive >= 0.2+ , directory -any+ , filepath -any+ , GenericPretty >= 1.0.0+ , HTTP >= 4000.2.5+ , http-conduit >= 1.9.0+ , json >= 0.5+ , old-locale -any+ , pretty -any+ , process >= 1.1.0.2+ , pureMD5 >= 2.1.2.1+ , random -any+ , regex-posix >= 0.95.2+ , resourcet >= 0.3+ , split >= 0.2.0.0+ , time -any+ , unix -any+ , utf8-string -any+ , xml >= 1.2.6+ exposed-modules: Crypto.GnuPG+ Crypto.MD5+ Network.Google+ Network.Google.Bookmarks+ Network.Google.Books+ Network.Google.Contacts Network.Google.FusionTables+ Network.Google.OAuth2+ Network.Google.Picasa+ Network.Google.Storage+ Network.Google.Storage.Encrypted+ Network.Google.Storage.Sync exposed: True buildable: True hs-source-dirs: src executable hgdata- build-depends: HTTP -any, base <6, base64-bytestring -any,- binary -any, bytestring -any, case-insensitive -any, cmdargs -any,- directory -any, filepath -any, split -any, http-conduit,- json -any, old-locale -any, process -any, pureMD5 -any,- regex-posix -any, resourcet -any, time -any, unix -any,- utf8-string -any, xml -any, random -any, pretty -any, GenericPretty -any+ build-depends: base >= 4 && < 5 + , base64-bytestring >= 0.9.1.4+ , binary >= 0.5.1.1+ , bytestring >= 0.10.0.2+ , case-insensitive >= 0.2+ , directory -any+ , filepath -any+ , cmdargs >= 0.9.4+ , GenericPretty >= 1.0.0+ , HTTP >= 4000.2.5+ , http-conduit >= 1.9.0+ , json >= 0.5+ , old-locale -any+ , pretty -any+ , process >= 1.1.0.2+ , pureMD5 >= 2.1.2.1+ , random -any+ , regex-posix >= 0.95.2+ , resourcet >= 0.3+ , split >= 0.2.0.0+ , time -any+ , unix -any+ , utf8-string -any+ , xml >= 1.2.6 main-is: Main.hs buildable: True hs-source-dirs: src- other-modules: Network.Google Network.Google.Contacts- Network.Google.Storage Network.Google.OAuth2 Network.Google.Picasa- Network.Google.Bookmarks Network.Google.Books- Network.Google.Storage.Encrypted Network.Google.Storage.Sync+ other-modules: Crypto.GnuPG+ Crypto.MD5+ Network.Google+ Network.Google.Bookmarks+ Network.Google.Books+ Network.Google.Contacts Network.Google.FusionTables- Crypto.MD5 Crypto.GnuPG+ Network.Google.OAuth2+ Network.Google.Picasa+ Network.Google.Storage+ Network.Google.Storage.Encrypted+ Network.Google.Storage.Sync
src/Network/Google.hs view
@@ -13,7 +13,7 @@ ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleInstances, ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-} module Network.Google (@@ -27,7 +27,6 @@ , appendQuery , doManagedRequest , doRequest--- , retryIORequest , makeHeaderName , makeProjectRequest , makeRequest@@ -35,8 +34,7 @@ ) where -import qualified Control.Exception as E-import Control.Concurrent (threadDelay)+import Control.Exception (finally) import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Data.List (intercalate) import Data.Maybe (fromJust)@@ -46,8 +44,7 @@ import Data.ByteString.Lazy.UTF8 (toString) import Data.CaseInsensitive as CI (CI(..), mk) import Network.HTTP.Base (urlEncode)-import Network.HTTP.Conduit (Manager, Request(..), RequestBody(..), Response(..), HttpException, - closeManager, def, httpLbs, newManager, responseBody)+import Network.HTTP.Conduit (Manager, Request(..), RequestBody(..), Response(..), closeManager, def, httpLbs, newManager, responseBody) import Text.JSON (JSValue, Result(Ok), decode) import Text.XML.Light (Element, parseXMLDoc) @@ -118,7 +115,7 @@ doManagedRequest manager request --} manager <- newManager def- E.finally+ finally (doManagedRequest manager request) (closeManager manager) doManagedRequest ::@@ -238,24 +235,3 @@ -- TODO: In principle, we should UTF-8 encode the bytestrings packed below. queryString = BS8.pack $ '?' : query' }----- | Takes an idempotent IO action that includes a network request. Catches--- `HttpException`s and tries a gain a certain number of times. The second argument--- is a callback to invoke every time a retry occurs.--- --- Takes a list of *seconds* to wait between retries. A null list means no retries,--- an infinite list will retry indefinitely. The user can choose whatever temporal--- pattern they desire (e.g. exponential backoff).------ Once the retry list runs out, the last attempt may throw `HttpException`--- exceptions that escape this function.-retryIORequest :: IO a -> (HttpException -> IO ()) -> [Double] -> IO a-retryIORequest req retryHook times = loop times- where- loop [] = req- loop (delay:tl) = - E.catch req $ \ (exn::HttpException) -> do - retryHook exn- threadDelay (round$ delay * 1000 * 1000) -- Microseconds- loop tl
src/Network/Google/FusionTables.hs view
@@ -135,8 +135,7 @@ do resp <- doRequest req case parseTables resp of Ok x -> return x- Error err -> error$ "listTables: failed to parse JSON response, error was:\n "- ++err++"\nJSON response was:\n "++show resp+ Error err -> error$ "listTables: failed to parse JSON response:\n"++err where req = makeRequest accessToken fusiontableApi "GET" ( fusiontableHost, "fusiontables/v1/tables" )
src/Network/Google/OAuth2.hs view
@@ -85,8 +85,6 @@ import Data.ByteString.Char8 as BS8 (ByteString, pack) import Data.ByteString.Lazy.UTF8 (toString) import Data.List (intercalate)-import Data.Time.Clock (getCurrentTime)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Word (Word64) import Network.Google (makeHeaderName) import Network.HTTP.Base (urlEncode)@@ -95,8 +93,7 @@ import System.Info (os) import System.Process (rawSystem) import System.Exit (ExitCode(..))-import System.Directory (doesFileExist, doesDirectoryExist, getAppUserDataDirectory,- createDirectory, renameFile, removeFile)+import System.Directory (doesFileExist, doesDirectoryExist, getAppUserDataDirectory, createDirectory, renameFile) import System.FilePath ((</>),(<.>), splitExtension) import System.Random (randomIO) @@ -298,68 +295,42 @@ -- The first time it is called, this may open a web-browser, and/or request the user -- enter data on the command line. Subsequently, invocations on the same machine -- should not communicate with the user.------ If the tokens do not expire until more than 15 minutes in the future, this--- procedure will skip the refresh step. Whether or not it refreshes should be--- immaterial to the clients subsequent actions, because all clients should handle--- authentication errors (and all 5xx errors) and call `refreshToken` as necessary.+-- getCachedTokens :: OAuth2Client -- ^ The client is the \"key\" for token lookup. -> IO OAuth2Tokens getCachedTokens client = do cabalD <- getAppUserDataDirectory "cabal"- let tokenD = cabalD </> "googleAuthTokens"- tokenF = tokenD </> clientId client <.> "token"+ let tokenD = cabalD </> "googleAuthTokens" + tokenF = tokenD </> clientId client <.> "token" d1 <- doesDirectoryExist cabalD unless d1 $ createDirectory cabalD -- Race. d2 <- doesDirectoryExist tokenD unless d2 $ createDirectory tokenD -- Race. f1 <- doesFileExist tokenF- if f1 then do- str <- readFile tokenF- case reads str of- -- Here's our approach to versioning! If we can't read it, we remove it.- ((oldtime,toks),_):_ -> do- tagged <- checkExpiry tokenF (oldtime,toks)- return (snd tagged)- [] -> do- putStrLn$" [getCachedTokens] Could not read tokens from file: "++ tokenF- putStrLn$" [getCachedTokens] Removing tokens and re-authenticating..."- removeFile tokenF - getCachedTokens client+ if f1 then do + toks <- fmap read (readFile tokenF)+ -- Our policy is to *always* refresh:+ toks2 <- refreshTokens client toks+ toks3 <- timestamp toks2+ atomicWriteFile tokenF (show toks3)+ return toks3 else do toks <- askUser- fmap snd$ timeStampAndWrite tokenF toks- where - -- Tokens store a relative time, which is rather silly (relative to what?). This- -- routine tags a token with the time it was issued, so as to enable figuring out- -- the absolute expiration time. Also, as a side effect, this is where we refresh- -- the token if it is already expired or expiring soon.- checkExpiry :: FilePath -> (Rational, OAuth2Tokens) -> IO (Rational, OAuth2Tokens)- checkExpiry tokenF orig@(start1,toks1) = do- t <- getCurrentTime - let nowsecs = toRational (utcTimeToPOSIXSeconds t)- expire1 = start1 + expiresIn toks1- tolerance = 15 * 60 -- Skip refresh if token is good for at least 15 min.- if (expire1 < tolerance + nowsecs) then do- toks2 <- refreshTokens client toks1- timeStampAndWrite tokenF toks2- else return orig-- timeStampAndWrite :: FilePath -> OAuth2Tokens -> IO (Rational, OAuth2Tokens)- timeStampAndWrite tokenF toks = do - t2 <- getCurrentTime - let tagged = (toRational (utcTimeToPOSIXSeconds t2), toks)- atomicWriteFile tokenF (show tagged)- return tagged-+ atomicWriteFile tokenF (show toks)+ return toks+ where+ -- TODO: Convert relative time to absolute UTF time for the tokens:+ timestamp toks =+ return toks+ -- This is the part where we require user interaction: askUser = do - putStrLn$ " [getCachedTokens] Load this URL: "++show permissionUrl+ putStrLn$ "Load this URL: "++show permissionUrl runBrowser - putStrLn " [getCachedTokens] Then please paste the verification code and press enter:\n$ "+ putStrLn "Then please paste the verification code and press enter:\n$ " authcode <- getLine tokens <- exchangeCode client authcode- putStrLn$ " [getCachedTokens] Received access token: "++show (accessToken tokens)+ putStrLn$ "Received access token: "++show (accessToken tokens) return tokens permissionUrl = formUrl client ["https://www.googleapis.com/auth/fusiontables"]