handa-gdata 0.6.9.1 → 0.7
raw patch · 10 files changed
+168/−41 lines, 10 filesdep +data-defaultdep ~http-conduitdep ~networkdep ~resourcet
Dependencies added: data-default
Dependency ranges changed: http-conduit, network, resourcet
Files
- handa-gdata.cabal +15/−8
- src/Network/Google.hs +14/−13
- src/Network/Google/Bookmarks.hs +3/−2
- src/Network/Google/Books.hs +1/−1
- src/Network/Google/Contacts.hs +3/−2
- src/Network/Google/FusionTables.hs +115/−1
- src/Network/Google/OAuth2.hs +4/−2
- src/Network/Google/Picasa.hs +1/−1
- src/Network/Google/Storage.hs +9/−9
- src/Network/Google/Storage/Sync.hs +3/−2
handa-gdata.cabal view
@@ -1,11 +1,14 @@ name: handa-gdata-version: 0.6.9.1+version: 0.7 cabal-version: >=1.6 -- CHANGELOG: -- 0.6.2: Improve getCachedTokens -- 0.6.8: Add FusionTables.bulkImportRows -- 0.6.9: Add FusionTables.createColumn+-- 0.6.9.2: Add FusionTables.tableSelect+-- 0.6.9.3: tableSQLQuery+-- 0.7: change the API for http-conduit 2.0+ support build-type: Simple license: MIT@@ -77,8 +80,10 @@ data-dir: "" source-repository head- type: mercurial- location: https://code.google.com/p/hgdata/+-- type: mercurial+-- location: https://code.google.com/p/hgdata/+ type: git+ location: https://github.com/rrnewton/hgdata library build-depends: base >= 4 && < 5@@ -86,11 +91,13 @@ , binary >= 0.5.1.1 , bytestring >= 0.10.0.2 , case-insensitive >= 0.2+ , data-default -any , directory -any , filepath -any , GenericPretty >= 1.0.0 , HTTP >= 4000.2.5- , http-conduit >= 1.9.0 && < 2.0+ , http-conduit >= 2+ , network == 2.5.0.0 , json >= 0.5 , old-locale -any , pretty -any@@ -98,7 +105,7 @@ , pureMD5 >= 2.1.2.1 , random -any , regex-posix >= 0.95.2- , resourcet >= 0.3+ , resourcet >= 1.1.3 , split >= 0.2.0.0 , time -any , unix-compat -any@@ -131,16 +138,16 @@ , cmdargs >= 0.9.4 , GenericPretty >= 1.0.0 , HTTP >= 4000.2.5- , http-conduit >= 1.9.0 && < 2.0+ , http-conduit >= 2 , json >= 0.5- , network -any+ , network == 2.5.0.0 , 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+ , resourcet >= 1.1.3 , split >= 0.2.0.0 , time -any , unix-compat -any
src/Network/Google.hs view
@@ -38,6 +38,7 @@ import qualified Control.Exception as E import Control.Concurrent (threadDelay) import Control.Monad.Trans.Resource (ResourceT, runResourceT)+import Data.Default import Data.List (intercalate) import Data.Maybe (fromJust) import Data.ByteString as BS (ByteString)@@ -46,8 +47,8 @@ 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, ManagerSettings, mkManagerSettings, Request(..), RequestBody(..), Response(..), HttpException, + closeManager, httpLbs, newManager, responseBody) import Text.JSON (JSValue, Result(Ok), decode) import Text.XML.Light (Element, parseXMLDoc) @@ -72,7 +73,7 @@ -> (String, String) -- ^ The Google API name and version. -> String -- ^ The HTTP method. -> (String, String) -- ^ The host and path for the request.- -> Request m -- ^ The HTTP request.+ -> Request -- ^ The HTTP request. makeRequest accessToken (apiName, apiVersion) method (host, path) = -- TODO: In principle, we should UTF-8 encode the bytestrings packed below. def {@@ -95,7 +96,7 @@ -> (String, String) -- ^ The Google API name and version. -> String -- ^ The HTTP method. -> (String, String) -- ^ The host and path for the request.- -> Request m -- ^ The HTTP request.+ -> Request -- ^ The HTTP request. makeProjectRequest projectId accessToken api method hostPath = appendHeaders [@@ -108,17 +109,17 @@ class DoRequest a where -- | Perform a request. doRequest ::- Request (ResourceT IO) -- ^ The request.+ Request -- ^ The request. -> IO a -- ^ The action returning the result of performing the request. doRequest request = do- manager <- newManager def+ manager <- newManager (mkManagerSettings def Nothing) E.finally (doManagedRequest manager request) (closeManager manager) doManagedRequest :: Manager -- ^ The conduit HTTP manager.- -> Request (ResourceT IO) -- ^ The request.+ -> Request -- ^ The request. -> IO a -- ^ The action returning the result of performing the request. @@ -193,8 +194,8 @@ -- | Append headers to a request. appendHeaders :: [(String, String)] -- ^ The (name\/key, value) pairs for the headers.- -> Request m -- ^ The request.- -> Request m -- ^ The request with the additional headers.+ -> Request -- ^ The request.+ -> Request -- ^ The request with the additional headers. appendHeaders headers request = let headerize :: (String, String) -> (CI.CI BS8.ByteString, BS8.ByteString)@@ -208,8 +209,8 @@ -- | Append a body to a request. appendBody :: LBS8.ByteString -- ^ The data for the body.- -> Request m -- ^ The request.- -> Request m -- ^ The request with the body appended.+ -> Request -- ^ The request.+ -> Request -- ^ The request with the body appended. appendBody bytes request = request { requestBody = RequestBodyLBS bytes@@ -219,8 +220,8 @@ -- | Append a query to a request. appendQuery :: [(String, String)] -- ^ The query keys and values.- -> Request m -- ^ The request.- -> Request m -- ^ The request with the query appended.+ -> Request -- ^ The request.+ -> Request -- ^ The request with the query appended. appendQuery query request = let makeParameter :: (String, String) -> String
src/Network/Google/Bookmarks.hs view
@@ -27,10 +27,11 @@ import Data.ByteString.Char8 as BS8 (ByteString, pack, unpack) import Data.ByteString.Lazy.Char8 as LBS8 (ByteString, pack, unpack) import Data.ByteString.Lazy.UTF8 (fromString, toString)+import Data.Default (def) import Data.Maybe (fromJust) import Data.Time.Clock (getCurrentTime) import Network.Google (appendHeaders)-import Network.HTTP.Conduit (CookieJar, Request(..), RequestBody(..), Response(..), def, httpLbs, parseUrl, withManager)+import Network.HTTP.Conduit (CookieJar, Request(..), RequestBody(..), Response(..), httpLbs, parseUrl, withManager) import Text.XML.Light (Element(..), QName(..), blank_name, filterElement, findAttr, parseXMLDoc) @@ -112,7 +113,7 @@ return $ responseXml responsePost3 -accountsPostRequest :: String -> Request m+accountsPostRequest :: String -> Request accountsPostRequest path = appendHeaders [("Content-Type", "application/x-www-form-urlencoded")] $ def {
src/Network/Google/Books.hs view
@@ -156,7 +156,7 @@ AccessToken -- ^ The OAuth 2.0 access token. -> Maybe ShelfId -- ^ The bookshelf ID. -> Int -- ^ The starting index- -> Request m -- ^ The request.+ -> Request -- ^ The request. booksRequest accessToken shelf startIndex = appendQuery [
src/Network/Google/Contacts.hs view
@@ -22,10 +22,11 @@ import Control.Monad ((<=<), (>>), liftM) import Crypto.GnuPG (Recipient, decrypt, encrypt)+import Data.Default (def) import Data.List (stripPrefix) import Data.Maybe (fromJust, fromMaybe, mapMaybe) import Network.Google (AccessToken, doRequest, makeRequest, makeRequestValue)-import Network.HTTP.Conduit (Request(..), def, httpLbs, responseBody, withManager)+import Network.HTTP.Conduit (Request(..), httpLbs, responseBody, withManager) import Text.XML.Light (Element, elChildren, filterChildName, parseXMLDoc, qName, strContent) @@ -53,7 +54,7 @@ -- | Make an HTTP request to list the contacts. listContactsRequest :: AccessToken -- ^ The OAuth 2.0 access token.- -> Request m -- ^ The request.+ -> Request -- ^ The request. listContactsRequest accessToken = (makeRequest accessToken contactsApi "GET" (contactsHost, "/m8/feeds/contacts/default/full/")) {
src/Network/Google/FusionTables.hs view
@@ -30,6 +30,11 @@ , insertRows -- , filterRows , bulkImportRows+ + -- js experimentation+ , getData, ColData(..), FTValue(..), tableSelect+ , tableSQLQuery+ ) where import Control.Monad (liftM, unless)@@ -45,7 +50,7 @@ -- TODO: Ideally this dependency wouldn't exist here and the user could select their -- own JSON parsing lib (e.g. Aeson). import Text.JSON (JSObject(..), JSValue(..), Result(Ok,Error),- decode, valFromObj, toJSObject, toJSString, fromJSString)+ decode, valFromObj, toJSObject, toJSString, fromJSString,readJSON) import Text.JSON.Pretty (pp_value) -- For easy pretty printing:@@ -286,3 +291,112 @@ -- TODO: provide some basic select functionality filterRows = error "implement filterRows"++--getData :: AccessToken+-- -> String+-- -> String+-- -> Request m++getData :: AccessToken + -> String -- ^ Table ID+ -> String -- ^ The SQL expression following "SELECT"+ -> Maybe String -- ^ Optional expression to follow "WHERE"+ -> IO ColData+getData = tableSelect++-- tableSelect token table_id str cond+-- = let req = (makeRequest token fusiontableApi "GET"+-- (fusiontableHost, "/fusiontables/v1/query"))+-- { +-- queryString = B.pack$ H.urlEncodeVars [("sql",query)] +-- } +-- query = case cond of+-- Nothing -> "SELECT " ++ str ++ " FROM " ++ table_id +-- Just c -> "SELECT " ++ str ++ " FROM " ++ table_id ++ " WHERE " ++ c+-- in do resp <- doRequest req+-- case parseResponse resp of+-- Ok x -> return x+-- Error err -> error$ "getData: failed to parse JSON response:\n"++err+-- where+-- parseResponse :: JSValue -> Result ColData+-- parseResponse (JSArray as) = Error "GOT ARRAY EARLY" +-- parseResponse (JSObject ob) = do+-- -- get array of column names (headings) +-- (JSArray cols) <- valFromObj "columns" ob+-- let colNom = map (\(JSString s) -> fromJSString s) cols +-- -- Get array of array of data values +-- (JSArray rows) <- valFromObj "rows" ob+-- rows' <- mapM parseVal' rows +-- return $ ColData colNom rows'+-- parseVal' (JSArray ar) = mapM parseVal ar +-- parseVal :: JSValue -> Result FTValue+-- parseVal r@(JSRational _ _) = do+-- d <- readJSON r+-- return $ DoubleValue d+-- parseVal (JSString s) = return $ StringValue $ fromJSString s + +-- parseVal _ = Error "I imagined there'd be Rationals here" ++-- Leave this here for backwards compat+tableSelect :: AccessToken + -> String -- ^ Table ID+ -> String -- ^ The SQL expression following "SELECT"+ -> Maybe String -- ^ Optional expression to follow "WHERE"+ -> IO ColData+tableSelect token table_id str cond =+ tableSQLQuery token table_id query+ where+ query =+ case cond of+ Nothing -> "SELECT " ++ str ++ " FROM " ++ table_id + Just c -> "SELECT " ++ str ++ " FROM " ++ table_id ++ " WHERE " ++ c++-- | Run a supported SQL query to retrieve data from a fusion table.+tableSQLQuery :: AccessToken + -> String -- ^ Table ID+ -> String -- ^ Complete SQL expression.+ -> IO ColData+tableSQLQuery token table_id query+ = let req = (makeRequest token fusiontableApi "GET"+ (fusiontableHost, "/fusiontables/v1/query"))+ { + queryString = B.pack$ H.urlEncodeVars [("sql",query)] + } + -- query = case cond of+ -- Nothing -> "SELECT " ++ str ++ " FROM " ++ table_id + -- Just c -> "SELECT " ++ str ++ " FROM " ++ table_id ++ " WHERE " ++ c+ in do resp <- doRequest req+ case parseResponse resp of+ Ok x -> return x+ Error err -> error$ "getData: failed to parse JSON response:\n"++err+ where+ parseResponse :: JSValue -> Result ColData+ parseResponse (JSArray as) = Error "GOT ARRAY EARLY" + parseResponse (JSObject ob) = do+ -- get array of column names (headings) + (JSArray cols) <- valFromObj "columns" ob+ let colNom = map (\(JSString s) -> fromJSString s) cols + -- Get array of array of data values + (JSArray rows) <- valFromObj "rows" ob+ rows' <- mapM parseVal' rows + return $ ColData colNom rows'+ parseVal' (JSArray ar) = mapM parseVal ar + parseVal :: JSValue -> Result FTValue+ parseVal r@(JSRational _ _) = do+ d <- readJSON r+ return $ DoubleValue d+ parseVal (JSString s) = return $ StringValue $ fromJSString s + + parseVal _ = Error "I imagined there'd be Rationals here" +++data FTValue = StringValue FTString + | DoubleValue Double+ deriving (Eq, Show )+ +++data ColData = ColData {colName :: [FTString],+ values :: [[FTValue]]}+ deriving (Eq, Show)+
src/Network/Google/OAuth2.hs view
@@ -84,13 +84,14 @@ import Control.Monad (unless) import Data.ByteString.Char8 as BS8 (ByteString, pack) import Data.ByteString.Lazy.UTF8 (toString)+import Data.Default (def) 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)-import Network.HTTP.Conduit (Request(..), RequestBody(..), Response(..), def, httpLbs, responseBody, withManager)+import Network.HTTP.Conduit (Request(..), RequestBody(..), Response(..), httpLbs, responseBody, withManager) import Text.JSON (JSObject, JSValue(JSRational), Result(Ok), decode, valFromObj) import System.Info (os) import System.Process (rawSystem)@@ -355,7 +356,8 @@ -- This is the part where we require user interaction: askUser = do putStrLn$ " [getCachedTokens] Load this URL: "++show permissionUrl- runBrowser + -- BJS: This crash on my machine. + -- runBrowser putStrLn " [getCachedTokens] Then please paste the verification code and press enter:\n$ " authcode <- getLine tokens <- exchangeCode client authcode
src/Network/Google/Picasa.hs view
@@ -111,7 +111,7 @@ AccessToken -- ^ The OAuth 2.0 access token. -> UserId -- ^ The user ID for the photos. -> Maybe AlbumId -- ^ The album ID for the photos.- -> Request m -- ^ The request.+ -> Request -- ^ The request. picasaFeedRequest accessToken userId albumId = makeRequest accessToken picasaApi "GET" (
src/Network/Google/Storage.hs view
@@ -141,7 +141,7 @@ -- | 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>. getServiceImpl ::- (Request (ResourceT IO) -> IO Element) -- ^ The function for performing the request.+ (Request -> IO Element) -- ^ The function for performing the request. -> ProjectId -- ^ The project ID. -> AccessToken -- ^ The OAuth 2.0 access token. -> IO Element -- ^ The action returning the XML with the metadata for the buckets.@@ -175,7 +175,7 @@ -- | Creates a bucket in a specified project. This performs the \"PUT Bucket\" request, see <https://developers.google.com/storage/docs/reference-methods#putbucket>. putBucketImpl ::- (Request (ResourceT IO) -> IO [(String, String)]) -- ^ The function for performing the request.+ (Request -> IO [(String, String)]) -- ^ The function for performing the request. -> ProjectId -- ^ The project ID. -> StorageAcl -- ^ The pre-defined access control. -> BucketName -- ^ The bucket.@@ -213,7 +213,7 @@ -- | Lists the objects that are in a bucket. This performs the \"GET Bucket\" request, see <https://developers.google.com/storage/docs/reference-methods#getbucket>. getBucketImpl ::- (Request (ResourceT IO) -> IO Element) -- ^ The function for performing the request.+ (Request -> IO Element) -- ^ The function for performing the request. -> ProjectId -- ^ The project ID. -> BucketName -- ^ The bucket. -> AccessToken -- ^ The OAuth 2.0 access token.@@ -228,7 +228,7 @@ -- | Lists the objects that are in a bucket. This performs the \"GET Bucket\" request, see <https://developers.google.com/storage/docs/reference-methods#getbucket>. getBucketImpl' ::- (Request (ResourceT IO) -> IO Element) -- ^ The function for performing the request.+ (Request -> IO Element) -- ^ The function for performing the request. -> Maybe KeyName -- ^ The key to start listing at. -> ProjectId -- ^ The project ID. -> BucketName -- ^ The bucket.@@ -274,7 +274,7 @@ -- | Deletes an empty bucket. This performs the \"DELETE Bucket\" request, see <https://developers.google.com/storage/docs/reference-methods#deletebucket>. deleteBucketImpl ::- (Request (ResourceT IO) -> IO [(String, String)]) -- ^ The function for performing the request.+ (Request -> IO [(String, String)]) -- ^ The function for performing the request. -> ProjectId -- ^ The project ID. -> BucketName -- ^ The bucket. -> AccessToken -- ^ The OAuth 2.0 access token.@@ -309,7 +309,7 @@ -- | Downloads an object. This performs the \"GET Object\" request, see <https://developers.google.com/storage/docs/reference-methods#getobject>. getObjectImpl ::- (Request (ResourceT IO) -> IO ByteString) -- ^ The function performing the action.+ (Request -> IO ByteString) -- ^ The function performing the action. -> ProjectId -- ^ The project ID. -> BucketName -- ^ The bucket. -> KeyName -- ^ The object's key.@@ -357,7 +357,7 @@ -- | Uploads an object. This performs the \"PUT Object\" request, see <https://developers.google.com/storage/docs/reference-methods#putobject>. putObjectImpl ::- (Request (ResourceT IO) -> IO [(String, String)]) -- ^ The function for performing the request.+ (Request -> IO [(String, String)]) -- ^ The function for performing the request. -> ProjectId -- ^ The project ID. -> StorageAcl -- ^ The pre-defined access control. -> BucketName -- ^ The bucket.@@ -407,7 +407,7 @@ -- | Lists metadata for an object. This performs the \"HEAD Object\" request, see <https://developers.google.com/storage/docs/reference-methods#headobject>. headObjectImpl ::- (Request (ResourceT IO) -> IO [(String, String)]) -- ^ The function for performing the request.+ (Request -> IO [(String, String)]) -- ^ The function for performing the request. -> ProjectId -- ^ The project ID. -> BucketName -- ^ The bucket. -> KeyName -- ^ The object's key.@@ -443,7 +443,7 @@ -- | Deletes an object. This performs the \"DELETE Object\" request, see <https://developers.google.com/storage/docs/reference-methods#deleteobject>. deleteObjectImpl ::- (Request (ResourceT IO) -> IO [(String, String)]) -- ^ The function for performing the request.+ (Request -> IO [(String, String)]) -- ^ The function for performing the request. -> ProjectId -- ^ The project ID. -> BucketName -- ^ The bucket. -> KeyName -- ^ The object's key.
src/Network/Google/Storage/Sync.hs view
@@ -27,6 +27,7 @@ import Crypto.GnuPG (Recipient) import Crypto.MD5 (MD5Info, md5Base64, md5Empty) import qualified Data.ByteString.Lazy as LBS (ByteString, readFile)+import Data.Default (def) import qualified Data.Digest.Pure.MD5 as MD5 (md5) import Data.List ((\\), sort) import Data.Maybe (catMaybes, fromJust, fromMaybe, mapMaybe)@@ -37,7 +38,7 @@ import Network.Google.OAuth2 (OAuth2Client(..), OAuth2Tokens(..), refreshTokens, validateTokens) import Network.Google.Storage (BucketName, KeyName, MIMEType, StorageAcl, deleteObjectUsingManager, getBucketUsingManager, putObjectUsingManager) import Network.Google.Storage.Encrypted (putEncryptedObject, putEncryptedObjectUsingManager)-import Network.HTTP.Conduit (closeManager, def, newManager)+import Network.HTTP.Conduit (mkManagerSettings, closeManager, newManager) import System.Directory (doesDirectoryExist, getDirectoryContents) import System.FilePath (combine, splitDirectories) import System.FilePath.Posix (joinPath)@@ -82,7 +83,7 @@ let local' = filter (makeExcluder exclusions) local print $ length local - length local'- manager <- newManager def+ manager <- newManager (mkManagerSettings def Nothing) finally ( sync'