handa-gdata 0.6.5 → 0.6.6
raw patch · 7 files changed
+122/−53 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- handa-gdata.cabal +1/−1
- src/Main.hs +1/−1
- src/Network/Google.hs +1/−6
- src/Network/Google/Books.hs +72/−6
- src/Network/Google/OAuth2.hs +1/−1
- src/Network/Google/Storage.hs +1/−1
- src/Network/Google/Storage/Sync.hs +45/−37
handa-gdata.cabal view
@@ -1,5 +1,5 @@ name: handa-gdata-version: 0.6.5+version: 0.6.6 cabal-version: >=1.6 -- CHANGELOG:
src/Main.hs view
@@ -162,7 +162,7 @@ , gshead , gssync ]- &= summary "hgData v0.6.5, (c) 2012-13 Brian W. Bush <b.w.bush@acm.org>, MIT license."+ &= summary "hgData v0.6.6, (c) 2012-13 Brian W. Bush <b.w.bush@acm.org>, MIT license." &= program "hgdata" &= help "Command-line utility for accessing Google services and APIs. Send bug reports and feature requests to <http://code.google.com/p/hgdata/issues/entry>."
src/Network/Google.hs view
@@ -112,11 +112,6 @@ -> IO a -- ^ The action returning the result of performing the request. doRequest request = do-{--- -- TODO: The following seems cleaner, but has type/instance problems:- (_, manager) <- allocate (newManager def) closeManager- doManagedRequest manager request---} manager <- newManager def E.finally (doManagedRequest manager request)@@ -251,7 +246,7 @@ -- 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+retryIORequest req retryHook = loop where loop [] = req loop (delay:tl) =
src/Network/Google/Books.hs view
@@ -22,9 +22,11 @@ ) where -import Network.Google (AccessToken, doRequest, makeRequest)+import Control.Monad (liftM)+import Data.Maybe (fromMaybe)+import Network.Google (AccessToken, appendQuery, doRequest, makeRequest) import Network.HTTP.Conduit (Request)-import Text.JSON (JSObject, JSValue(..), Result(Ok), decode, valFromObj)+import Text.JSON (JSObject, JSValue(..), Result(Ok), decode, fromJSObject, toJSObject, valFromObj) -- | The host for API access.@@ -46,7 +48,7 @@ AccessToken -- ^ The OAuth 2.0 access token. -> IO JSValue -- ^ The action returning the bookshelves' metadata in JSON format. listBookshelves accessToken =- doRequest $ booksRequest accessToken Nothing+ doRequest $ booksRequest accessToken Nothing 0 -- | List the bookshelf IDs, see <https://developers.google.com/books/docs/v1/using#RetrievingMyBookshelves>.@@ -90,17 +92,81 @@ -> ShelfId -- ^ The bookshelf ID. -> IO JSValue -- ^ The action returning the books' metadata in JSON format. listShelfBooks accessToken shelf =- doRequest $ booksRequest accessToken (Just shelf)+ do+ x <- listShelfBooks' accessToken shelf Nothing+ let+ y :: [JSValue]+ y = concatMap items x+ JSObject o = head x+ z :: [(String, JSValue)]+ z = fromJSObject o+ u :: [(String, JSValue)]+ u = filter (\w -> fst w /= "items") z+ v :: [(String, JSValue)]+ v = ("items", JSArray y) : u+ return $ JSObject $ toJSObject v +-- | List the books in a shelf, see <https://developers.google.com/books/docs/v1/using#RetrievingMyBookshelfVolumes>.+listShelfBooks' ::+ AccessToken -- ^ The OAuth 2.0 access token.+ -> ShelfId -- ^ The bookshelf ID.+ -> Maybe Int -- ^ The start index in the list of metadata.+ -> IO [JSValue] -- ^ The action returning the books' metadata in JSON format.+listShelfBooks' accessToken shelf startIndex =+ do+ let+ startIndex' :: Int+ startIndex' = fromMaybe 0 startIndex+ books <- doRequest $ booksRequest accessToken (Just shelf) startIndex'+ let+ startIndex'' = startIndex' + length (items books)+ liftM (books :) $+ if startIndex' + 1 <= totalItems books+ then listShelfBooks' accessToken shelf $ Just startIndex''+ else return []+++-- | Find the total number of items in a shelf.+totalItems ::+ JSValue -- ^ The books' metadata.+ -> Int -- ^ The total number of books in the shelf.+totalItems (JSObject books) =+ let+ Ok count = "totalItems" `valFromObj` books+ in+ count+++-- | Find the items in a list of books' metadata.+items ::+ JSValue -- ^ The books' metadata+ -> [JSValue] -- ^ The books in the metadata.+items (JSObject books) =+ let+ list = "items" `valFromObj` books+ f (Ok x) = x+ f _ = []+ in+ f list++ -- | Make an HTTP request for Google Books. booksRequest :: AccessToken -- ^ The OAuth 2.0 access token. -> Maybe ShelfId -- ^ The bookshelf ID.+ -> Int -- ^ The starting index -> Request m -- ^ The request.-booksRequest accessToken shelf =- makeRequest accessToken booksApi "GET"+booksRequest accessToken shelf startIndex =+ appendQuery+ [+ ("maxResults", "40")+ , ("startIndex", show startIndex)+ ]+ $+ makeRequest accessToken booksApi "GET" ( booksHost , "/books/v1/mylibrary/bookshelves" ++ maybe "" (\x -> "/" ++ x ++ "/volumes") shelf+ )
src/Network/Google/OAuth2.hs view
@@ -340,7 +340,7 @@ 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+ if expire1 < tolerance + nowsecs then do toks2 <- refreshTokens client toks1 timeStampAndWrite tokenF toks2 else return orig
src/Network/Google/Storage.hs view
@@ -119,7 +119,7 @@ String -- ^ The unencoded path. -> String -- ^ The URL-encoded path. -- TODO: Review whether the sequence of UTF-8 encoding and URL encoding is correct. This works correctly with tests of exotic unicode sequences, however.-makePath = ('/' :) . intercalate "/" . map (urlEncode . unpack . fromString) . splitOn "/"+makePath = ('/' :) . intercalate "/" . map urlEncode . splitOn "/" -- | List all of the buckets in a specified project. This performs the \"GET Service\" request, see <https://developers.google.com/storage/docs/reference-methods#getservice>.
src/Network/Google/Storage/Sync.hs view
@@ -29,7 +29,7 @@ import qualified Data.ByteString.Lazy as LBS (ByteString, readFile) import qualified Data.Digest.Pure.MD5 as MD5 (md5) import Data.List ((\\), sort)-import Data.Maybe (fromJust, mapMaybe)+import Data.Maybe (catMaybes, fromJust, fromMaybe, mapMaybe) import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Format (parseTime)@@ -39,7 +39,8 @@ import Network.Google.Storage.Encrypted (putEncryptedObject, putEncryptedObjectUsingManager) import Network.HTTP.Conduit (closeManager, def, newManager) import System.Directory (doesDirectoryExist, getDirectoryContents)-import System.FilePath (pathSeparator)+import System.FilePath (combine, splitDirectories)+import System.FilePath.Posix (joinPath) import System.IO (hFlush, stdout) import System.Locale (defaultTimeLocale) import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)@@ -212,7 +213,7 @@ else return tokenClock' when md5sums $- writeFile (directory ++ "/.md5sum") $ unlines $ map (\x -> (fst . eTag) x ++ " ./" ++ key x) local+ writeFile (combine directory ".md5sum") $ unlines $ map (\x -> (fst . eTag) x ++ " ./" ++ key x) local -- | Delete the first occurrence of items in the second list from the first list, assuming both lists are sorted.@@ -250,7 +251,7 @@ do let eTag' x = if eTag x == md5Empty then Nothing else Just $ eTag x- bytes <- LBS.readFile $ directory ++ [pathSeparator] ++ key'+ bytes <- LBS.readFile $ combine directory key' putter key' Nothing bytes (eTag' x) (toAccessToken $ accessToken tokens') return () )@@ -281,8 +282,10 @@ walkDeleter client tokenClock' deleter xs --- |-handler :: SomeException -> IO ()+-- | Exception handler.+handler ::+ SomeException -- ^ The exception.+ -> IO () -- ^ An empty action. handler exception = putStrLn $ " FAIL " ++ show exception @@ -329,7 +332,7 @@ Bool -- ^ Whether to compute MD5 sums. -> FilePath -- ^ The directory to be synchronized. -> IO [ObjectMetadata] -- ^ Action returning file descriptions.-walkDirectories eTags directory = walkDirectories' eTags (directory ++ [pathSeparator]) [""]+walkDirectories eTags directory = walkDirectories' eTags directory [""] -- | Gather file metadata from the file system.@@ -340,33 +343,38 @@ -> IO [ObjectMetadata] -- ^ Action returning file descriptions. walkDirectories' _ _ [] = return [] walkDirectories' eTags directory (y : ys) =- handle- ((- \exception ->- do- putStrLn $ " LIST " ++ y- putStrLn $ " FAIL " ++ show exception- walkDirectories' eTags directory ys- ) :: SomeException -> IO [ObjectMetadata])- (- do- let- makeMetadata :: FilePath -> IO ObjectMetadata- makeMetadata file =- do- let- key = tail file- path = directory ++ key- bytes <- LBS.readFile path- status <- getFileStatus path- let- !lastTime = posixSecondsToUTCTime $ realToFrac $ modificationTime status- !size = fromIntegral $ fileSize status- !eTag = if eTags then md5Base64 bytes else md5Empty- return $ ObjectMetadata key eTag size lastTime- files <- liftM (map ((y ++ [pathSeparator]) ++) . ( \\ [".", ".."]))- $ getDirectoryContents (directory ++ y)- y' <- filterM (doesDirectoryExist . (directory ++)) files- x' <- mapM makeMetadata $ files \\ y'- liftM (x' ++) $ walkDirectories' eTags directory (y' ++ ys)- )+ do+ let+ handler :: a -> SomeException -> IO a+ handler def exception =+ do+ putStrLn $ " LIST " ++ y+ putStrLn $ " FAIL " ++ show exception+ return def+ makeMetadata :: FilePath -> IO (Maybe ObjectMetadata)+ makeMetadata file =+ handle+ (handler Nothing)+ (+ do+ let+ key = (joinPath . splitDirectories) file+ path = combine directory key+ bytes <- LBS.readFile path+ status <- getFileStatus path+ let+ !lastTime = posixSecondsToUTCTime $ realToFrac $ modificationTime status+ !size = fromIntegral $ fileSize status+ !eTag = if eTags then md5Base64 bytes else md5Empty+ return $ Just $ ObjectMetadata key eTag size lastTime+ )+ files <-+ handle+ (handler [])+ (+ liftM (map (combine y) . (\\ [".", ".."]))+ $ getDirectoryContents (combine directory y)+ )+ y' <- filterM (doesDirectoryExist . combine directory) files+ x' <- mapM makeMetadata $ files \\ y'+ liftM (catMaybes x' ++) $ walkDirectories' eTags directory (y' ++ ys)