google-drive 0.2.0 → 0.3.0

raw patch · 6 files changed

+306/−187 lines, 6 filesdep ~conduit-extraPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: conduit-extra

API changes (from Hackage documentation)

Files

• google-drive.cabal +6/−24
• src/Network/Google/Api.hs +10/−0
• src/Network/Google/Drive.hs +2/−0
• src/Network/Google/Drive/File.hs +94/−147
• src/Network/Google/Drive/Search.hs +171/−0
• src/Network/Google/Drive/Upload.hs +23/−16

@@ -1,5 +1,5 @@ Name:                   google-drive-Version:                0.2.0+Version:                0.3.0 Author:                 Pat Brisbin <pbrisbin@gmail.com> Maintainer:             Pat Brisbin <pbrisbin@gmail.com> License:                MIT@@ -8,29 +8,7 @@ Description:   Interacting with the Google Drive API   .-  Example usage:-  .-  > import Control.Monad (void)-  > import Data.Conduit (($$+-))-  >-  > import Network.Google.Drive-  >-  > main :: IO ()-  > main = void $ runApi token $ do-  >     root <- getFile "root"-  >     items <- listFiles $ ParentEq (fileId root) `And` Untrashed-  >-  >     mapM_ download items-  >-  >   where-  >     download :: File -> Api ()-  >     download file = do-  >         let fd = fileData file-  >-  >         case fileDownloadUrl $ fd of-  >             Nothing -> return ()-  >             Just url -> getSource (T.unpack url) [] $ \source ->-  >                 source $$+- sinkFile (fileTitle fd)+  See https://github.com/pbrisbin/google-drive for usage and details.   .  Cabal-Version:          >= 1.10@@ -43,6 +21,7 @@   Exposed-Modules:      Network.Google.Api                       , Network.Google.Drive                       , Network.Google.Drive.File+                      , Network.Google.Drive.Search                       , Network.Google.Drive.Upload   Build-Depends:        base            >= 4            && < 5                       , aeson           >= 0.8          && < 1.0@@ -69,10 +48,13 @@                       , hspec                       , google-drive                       , google-oauth2+                      , bytestring                       , conduit+                      , conduit-extra                       , directory                       , load-env                       , text+                      , time  Source-Repository head   Type:                 git

@@ -25,6 +25,7 @@     , getJSON     , getSource     , postJSON+    , putJSON      -- * Lower-level requests     , requestJSON@@ -151,6 +152,15 @@     requestJSON url $         addHeader (hContentType, "application/json") .         setMethod "POST" .+        setQueryString params .+        setBody (encode body)++-- | Make an authorized PUT request for JSON+putJSON :: (ToJSON a, FromJSON b) => URL -> Params -> a -> Api b+putJSON url params body =+    requestJSON url $+        addHeader (hContentType, "application/json") .+        setMethod "PUT" .         setQueryString params .         setBody (encode body) 

@@ -11,7 +11,9 @@  import Network.Google.Api as X import Network.Google.Drive.File as X+import Network.Google.Drive.Search as X import Network.Google.Drive.Upload as X +-- | OAuth2 scopes to use for access to the Drive API driveScopes :: [String] driveScopes = ["https://www.googleapis.com/auth/drive"]

@@ -6,7 +6,8 @@ -- -- https://developers.google.com/drive/v2/reference/files ----- See @"Network.Google.Drive.Upload"@ for uploading files.+-- This module is mostly concerned with creating and updating metadata. See+-- @"Network.Google.Drive.Upload"@ for uploading content. -- module Network.Google.Drive.File     (@@ -14,49 +15,48 @@       File(..)     , FileId     , FileData(..)-    , fileId-    , fileData-    , isFolder-    , localPath-    , uploadMethod-    , uploadPath-    , uploadData+    , FileTitle -    -- * Search-    , Query(..)-    , Items(..)-    , listFiles+    -- * Building @File@s+    , newFile+    , newFolder+    , setParent+    , setMimeType      -- * Actions     , getFile+    , createFile+    , updateFile     , deleteFile+    , downloadFile      -- * Utilities-    , newFile-    , createFolder+    , isFolder+    , isDownloadable+    , localPath     ) where +import Network.Google.Api+ import Control.Applicative ((<$>), (<*>)) import Control.Monad (mzero, void) import Data.Aeson-import Data.ByteString (ByteString)+import Data.Maybe (isJust) import Data.Monoid ((<>)) import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)-import Data.Time (UTCTime, getCurrentTime)-import Network.HTTP.Types (Method)-import System.Directory (getModificationTime)-import System.FilePath (takeFileName)+import Data.Time (UTCTime)+import Network.HTTP.Conduit (HttpException(..))+import Network.HTTP.Types (status404) +import qualified Data.Traversable as F import qualified Data.Text as T -import Network.Google.Api- type FileId = Text+type FileTitle = Text  -- | Metadata about Files on your Drive data FileData = FileData-    { fileTitle :: !Text+    { fileTitle :: !FileTitle     , fileModified :: !UTCTime     , fileParents :: ![FileId]     , fileTrashed :: !Bool@@ -65,52 +65,17 @@     , fileMimeType :: !Text     } -data File-    = File FileId FileData -- ^ A File that exists-    | New FileData         -- ^ A File you intend to create+-- | An existing file+data File = File+    { fileId :: FileId+    , fileData :: FileData+    }  instance Eq File where-    File a _ == File b _ = a == b-    _ == _ = False+    a == b = fileId a == fileId b  instance Show File where-    show (File fi fd) = T.unpack $ fileTitle fd <> " (" <> fi <> ")"-    show (New fd) = show $ File "new" fd---- | N.B. it is an error to ask for the @fileId@ of a new file-fileId :: File -> FileId-fileId (File x _) = x-fileId _ = error "Cannot get fileId for new File"--fileData :: File -> FileData-fileData (File _ x) = x-fileData (New x) = x---- | HTTP Method to use for uploading content for this file-uploadMethod :: File -> Method-uploadMethod (File _ _) = "PUT"-uploadMethod (New _) = "POST"---- | Path to use for uploading content for this file-uploadPath :: File -> Path-uploadPath (File fid _) = "/files/" <> T.unpack fid-uploadPath (New _) = "/files"---- | HTTP Body to send when uploading content for this file------ Currently a synonym for @fileData@.----uploadData :: File -> FileData-uploadData = fileData---- | What to name this file if downloaded------ Currently just the @fileTitle@----localPath :: File -> FilePath-localPath = T.unpack . fileTitle . fileData--newtype Items = Items [File]+    show f = localPath f <> " (" <> T.unpack (fileId f) <> ")"  instance FromJSON FileData where     parseJSON (Object o) = FileData@@ -124,13 +89,6 @@      parseJSON _ = mzero -instance FromJSON File where-    parseJSON v@(Object o) = File-        <$> o .: "id"-        <*> parseJSON v--    parseJSON _ = mzero- instance ToJSON FileData where     toJSON FileData{..} = object         [ "title" .= fileTitle@@ -140,100 +98,89 @@         , "mimeType" .= fileMimeType         ] -instance FromJSON Items where-    parseJSON (Object o) = Items <$> (mapM parseJSON =<< o .: "items")+instance FromJSON File where+    parseJSON v@(Object o) = File+        <$> o .: "id"+        <*> parseJSON v     parseJSON _ = mzero -isFolder :: File -> Bool-isFolder = (== folderMimeType) . fileMimeType . fileData---- | Search query parameter+-- | Get a @File@ data by @FileId@ ----- Currently only a small subset of queries are supported+-- @\"root\"@ can be used to get information on the Drive itself ---data Query-    = TitleEq Text-    | ParentEq FileId-    | Untrashed-    | Query `And` Query-    | Query `Or` Query+-- If the API returns 404, this returns @Nothing@+--+getFile :: FileId -> Api (Maybe File)+getFile fid = (Just <$> getJSON (fileUrl fid) [])+    `catchError` handleNotFound -baseUrl :: URL-baseUrl = "https://www.googleapis.com/drive/v2"+  where+    handleNotFound (HttpError (StatusCodeException s _ _))+        | s == status404 = return Nothing+    handleNotFound e = throwError e --- | Get @File@ data by @FileId@------ @\"root\"@ can be used to get information on the Drive itself----getFile :: FileId -> Api File-getFile fid = getJSON (baseUrl <> "/files/" <> T.unpack fid) []+-- | Create a @File@ from @FileData@+createFile :: FileData -> Api File+createFile fd =+    postJSON (baseUrl <> "/files") [("setModifiedDate", Just "true")] fd +-- | Update a @File@+updateFile :: FileId -> FileData -> Api File+updateFile fid fd =+    putJSON (fileUrl $ fid) [("setModifiedDate", Just "true")] fd+ -- | Delete a @File@ deleteFile :: File -> Api ()-deleteFile (New _) = return ()-deleteFile (File fid _) = void $ requestLbs-    (baseUrl <> "/files/" <> T.unpack fid) $ setMethod "DELETE"+deleteFile f = void $ requestLbs (fileUrl $ fileId f) $ setMethod "DELETE" --- | Perform a search as specified by the @Query@-listFiles :: Query -> Api [File]-listFiles query = do-    Items items <- getJSON (baseUrl <> "/files")-        [ ("q", Just $ toParam query)-        , ("maxResults", Just "1000")-        ]+-- | Download a @File@+--+-- Returns @Nothing@ if the file is not downloadable+--+downloadFile :: File -> DownloadSink a -> Api (Maybe a)+downloadFile f sink = F.forM (fileDownloadUrl $ fileData f) $ \url ->+    getSource (T.unpack url) [] sink -    return items+newFile :: FileTitle -> UTCTime -> FileData+newFile title modified = FileData+    { fileTitle = title+    , fileModified = modified+    , fileParents = []+    , fileTrashed = False+    , fileSize = Nothing+    , fileDownloadUrl = Nothing+    , fileMimeType = ""+    } -  where-    toParam :: Query -> ByteString-    toParam (TitleEq title) = "title = " <> quote title-    toParam (ParentEq fid) = quote fid <> " in parents"-    toParam Untrashed = "trashed = false"-    toParam (p `And` q) = "(" <> toParam p <> ") and (" <> toParam q <> ")"-    toParam (p `Or` q) = "(" <> toParam p <> ") or (" <> toParam q <> ")"+newFolder :: FileTitle -> UTCTime -> FileData+newFolder title = setMimeType folderMimeType . newFile title -    quote :: Text -> ByteString-    quote = ("'" <>) . (<> "'") . encodeUtf8+setParent :: File -> FileData -> FileData+setParent p f = f { fileParents = [fileId p] } --- | Build a new @File@------ N.B. This does not create the file.+setMimeType :: Text -> FileData -> FileData+setMimeType m f = f { fileMimeType = m }++-- | What to name this file if downloaded ----- The file is defined as within the given parent, and has some information--- (currently title and modified) taken from the local file+-- Currently just the @fileTitle@ ---newFile :: FileId   -- ^ Parent-        -> FilePath-        -> Api File-newFile parent filePath = do-    modified <- liftIO $ getModificationTime filePath+localPath :: File -> FilePath+localPath = T.unpack . fileTitle . fileData -    return $ New FileData-        { fileTitle = T.pack $ takeFileName filePath-        , fileModified = modified-        , fileParents = [parent]-        , fileTrashed = False-        , fileSize = Nothing-        , fileDownloadUrl = Nothing-        , fileMimeType = ""-        }+-- | Check if a @File@ is a folder by inspecting its mime-type+isFolder :: File -> Bool+isFolder = (== folderMimeType) . fileMimeType . fileData --- | Create a new remote folder-createFolder :: FileId -- ^ Parent-             -> Text   -- ^ Title to give the folder-             -> Api File-createFolder parent title = do-    modified <- liftIO getCurrentTime+-- | Check if a @File@ has content stored in drive+isDownloadable :: File -> Bool+isDownloadable = isJust . fileDownloadUrl . fileData -    postJSON (baseUrl <> "/files") [] FileData-        { fileTitle = title-        , fileModified = modified-        , fileParents = [parent]-        , fileTrashed = False-        , fileSize = Nothing-        , fileDownloadUrl = Nothing-        , fileMimeType = folderMimeType-        }+baseUrl :: URL+baseUrl = "https://www.googleapis.com/drive/v2"++fileUrl :: FileId -> URL+fileUrl fid = baseUrl <> "/files/" <> T.unpack fid  folderMimeType :: Text folderMimeType = "application/vnd.google-apps.folder"

@@ -0,0 +1,171 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+--+-- Searching for files on your drive.+--+-- https://developers.google.com/drive/web/search-parameters+--+module Network.Google.Drive.Search+    ( listFiles+    , listVisibleContents++    -- * Building Queries+    , Query+    , Field(..)+    , QueryValue(..)+    , (?=)+    , (?!=)+    , (?<)+    , (?<=)+    , (?>)+    , (?>=)+    , qIn+    , qHas+    , qContains+    , qAnd+    , qOr+    , qNot+    ) where++import Network.Google.Api+import Network.Google.Drive.File++import Control.Applicative ((<$>), (<$>))+import Control.Monad (mzero)+import Data.Aeson+import Data.Char (toLower)+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)++import qualified Data.Text as T++type Query = Text++-- | Queriable fields+data Field+    = Title+    | FullText+    | MimeType+    | ModifiedDate+    | LastViewedByMeDate+    | Trashed+    | Starred+    | Parents+    | Owners+    | Writers+    | Readers+    | SharedWithMe+    | Properties+    deriving Show++-- | Type class for values which can be used in queries+class QueryValue a where+    escapeValue :: a -> Text++instance QueryValue Text where+    escapeValue t = "'" <> t <> "'"++instance QueryValue Bool where+    escapeValue True = "true"+    escapeValue False = "false"++-- TODO+-- instance QueryValue UTCTime where+-- RFC 3339 format, default timezone is UTC, e.g., 2012-06-04T12:00:00-08:00.++newtype Items = Items [File]++instance FromJSON Items where+    parseJSON (Object o) = Items <$> (mapM parseJSON =<< o .: "items")+    parseJSON _ = mzero++-- | Perform a search as specified by the @Query@+listFiles :: Query -> Api [File]+listFiles query = do+    Items items <- getJSON (baseUrl <> "/files")+        [ ("q", Just $ encodeUtf8 query)+        , ("maxResults", Just "1000")+        ]++    return items++-- | List all not-trashed files within the given folder+listVisibleContents :: File -> Api [File]+listVisibleContents folder =+    listFiles $ (fileId folder) `qIn` Parents `qAnd` Trashed ?= False++-- | The content of a string or boolean is equal to the other+(?=) :: QueryValue a => Field -> a -> Query+(?=) = qOp "="++-- | The content of a string or boolean is not equal to the other+(?!=) :: QueryValue a => Field -> a -> Query+(?!=) = qOp "!="++-- | A date is earlier than another+(?<) :: QueryValue a => Field -> a -> Query+(?<) = qOp "<"++-- | A date is earlier than or equal to another+(?<=) :: QueryValue a => Field -> a -> Query+(?<=) = qOp "<="++-- | A date is later than another+(?>) :: QueryValue a => Field -> a -> Query+(?>) = qOp ">"++-- | A date is later than or equal to another+(?>=) :: QueryValue a => Field -> a -> Query+(?>=) = qOp ">="++-- | An element is contained within a collection+--+-- Used for @Parents@, @Owners@, @Writers@, and @Readers@.+--+-- Note the reversed arguments such that infix usage makes sense.+--+qIn :: QueryValue a => a -> Field -> Query+qIn v f = T.intercalate " " [escapeValue v, "in", escapeField f]++-- | A collection contains an element matching the parameters.+--+-- Used for @Properties@.+--+qHas :: QueryValue a => Field -> a -> Query+qHas = qOp "has"++-- | The content of one string is present in the other+--+-- Used for @Title@, @FullText@, and @MimeType@.+--+qContains :: QueryValue a => Field -> a -> Query+qContains = qOp "contains"++infixr 3 `qAnd`++-- | Return files that match both clauses+qAnd :: Query -> Query -> Query+q `qAnd` p = "(" <> p <> ") and (" <> q <> ")"++infixr 2 `qOr`++-- | Return files that match either clause+qOr :: Query -> Query -> Query+q `qOr` p = "(" <> p <> ") or (" <> q <> ")"++-- | Negates a search clause+qNot :: Query -> Query+qNot q = "not " <> "(" <> q <> ")"++qOp :: QueryValue a => Text -> Field -> a -> Query+qOp x f v = T.intercalate " " [escapeField f, x, escapeValue v]++escapeField :: Field -> Text+escapeField = T.pack . lowerCase . show+  where+    lowerCase [] = []+    lowerCase (x:xs) = toLower x : xs++baseUrl :: URL+baseUrl = "https://www.googleapis.com/drive/v2"

@@ -10,7 +10,8 @@ module Network.Google.Drive.Upload     ( UploadSource     , uploadSourceFile-    , uploadFile+    , createFileWithContent+    , updateFileWithContent     ) where  import Control.Concurrent (threadDelay)@@ -24,7 +25,8 @@ import Data.Monoid ((<>)) import Network.HTTP.Conduit import Network.HTTP.Types-    ( Status+    ( Method+    , Status     , hContentLength     , hContentType     , hLocation@@ -35,6 +37,7 @@ import System.Random (randomRIO)  import qualified Data.ByteString.Char8 as C8+import qualified Data.Text as T  import Network.Google.Api import Network.Google.Drive.File@@ -51,25 +54,26 @@ uploadSourceFile fp 0 = sourceFile fp uploadSourceFile fp c = sourceFileRange fp (Just $ fromIntegral $ c + 1) Nothing -baseUrl :: URL-baseUrl = "https://www.googleapis.com/upload/drive/v2"+createFileWithContent :: FileData -> Int -> UploadSource -> Api File+createFileWithContent = uploadContent "POST" "/files" -uploadFile :: File -- ^ New or existing @File@-           -> Int  -- ^ Length of source-           -> UploadSource-           -> Api File-uploadFile file fileLength mkSource =-    withSessionUrl file $ \url ->+updateFileWithContent :: FileId -> FileData -> Int -> UploadSource -> Api File+updateFileWithContent fid fd =+    uploadContent "PUT" ("/files/" <> T.unpack fid) $ fd++uploadContent :: Method -> Path -> FileData -> Int -> UploadSource -> Api File+uploadContent m p fd fl mkSource =+    withSessionUrl m p fd $ \url ->         retryWithBackoff 1 $ do             completed <- getUploadedBytes url-            resumeUpload url completed fileLength mkSource+            resumeUpload url completed fl mkSource -withSessionUrl :: File -> (URL -> Api b) -> Api b-withSessionUrl file action  = do-    response <- requestLbs (baseUrl <> uploadPath file) $-        setMethod (uploadMethod file) .+withSessionUrl :: Method -> Path -> FileData -> (URL -> Api a) -> Api a+withSessionUrl m p fd action  = do+    response <- requestLbs (baseUrl <> p) $+        setMethod m .         setQueryString uploadQuery .-        setBody (encode $ uploadData file) .+        setBody (encode fd) .         addHeader (hContentType, "application/json")      case lookup hLocation $ responseHeaders response of@@ -129,6 +133,9 @@     delay = liftIO $ do         ms <- randomRIO (0, 999)         threadDelay $ (seconds * 1000 + ms) * 1000++baseUrl :: URL+baseUrl = "https://www.googleapis.com/upload/drive/v2"  status308 :: Status status308 = mkStatus 308 "Resume Incomplete"