diff --git a/Source/Dropbox.hs b/Source/Dropbox.hs --- a/Source/Dropbox.hs +++ b/Source/Dropbox.hs @@ -12,7 +12,7 @@ Locale, localeEn, localeEs, localeFr, localeDe, localeJp, AccessType(..), - -- * Manager + -- * HTTP connection manager Manager, withManager, -- * OAuth @@ -23,23 +23,22 @@ Session(..), -- * Get user account info getAccountInfo, AccountInfo(..), - -- * Basic file access API - -- ** Get metadata + -- * Get file/folder metadata getMetadata, getMetadataWithChildren, getMetadataWithChildrenIfChanged, Meta(..), MetaBase(..), MetaExtra(..), FolderContents(..), FileExtra(..), FolderHash(..), FileRevision(..), - -- ** Uploading files + -- * Get files + getFile, getFileBs, + -- * Upload files addFile, forceFile, updateFile, -- * Common data types fileRevisionToString, folderHashToString, ErrorMessage, URL, Path, - RequestBody, bsRequestBody + RequestBody(..), bsRequestBody, bsSink, ) where {- TODO: -- The JSON we get from the server sometimes has numbers encoded as strings - Make sure we handle that case. - Proper return values for 404, 406, oauth unlinked, etc. -} @@ -54,23 +53,24 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Char8 as BS8 +import Data.CaseInsensitive (CI) import Data.Word (Word64) import Data.Int (Int64) -import Data.List (isPrefixOf) import Data.Time.Clock (UTCTime(utctDay), getCurrentTime) import Data.Time.Format (parseTime, formatTime) import System.Locale (defaultTimeLocale) import Control.Monad (liftM) -import qualified Data.Enumerator as E -import qualified Data.Enumerator.List as EL -import qualified Network.HTTP.Enumerator as HE +import qualified Control.Monad.Trans.Class as MT +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL +import qualified Network.HTTP.Conduit as HC import qualified Network.HTTP.Types as HT import qualified Network.TLS as TLS import qualified Network.TLS.Extra as TLSExtra import Data.Certificate.X509 (X509) import qualified Data.Certificate.X509 as X509 import Data.Certificate.PEM as PEM -import Data.Enumerator (Iteratee, Enumerator) +import Data.Conduit (Sink, Source, Resource) import qualified Blaze.ByteString.Builder.ByteString as BlazeBS import System.IO as IO import qualified Paths_dropbox_sdk as Paths @@ -86,10 +86,10 @@ -- |The type of folder access your Dropbox application uses (). data AccessType = AccessTypeDropbox -- ^Full access to the user's entire Dropbox - | AccessTypeAppFolder -- ^Access to an application-specific "app folder" within the user's Dropbox + | AccessTypeAppFolder -- ^Access to an application-specific \"app folder\" within the user's Dropbox deriving (Show, Eq) --- |Your application's Dropbox "app key" and "app secret". +-- |Your application's Dropbox \"app key\" and \"app secret\". data AppId = AppId String String deriving (Show, Eq) -- |An OAuth request token (returned by 'authStart') @@ -124,27 +124,27 @@ -- |Specifies a locale (the string is a two-letter locale code) newtype Locale = Locale String deriving (Show, Eq) --- |The English (American) locale ("en"). +-- |English (American) (\"en\"). localeEn :: Locale localeEn = Locale "en" --- |The Spanish locale (@'Locale' "es"@). +-- |Spanish (\"es\"). localeEs :: Locale localeEs = Locale "es" --- |The French locale (Locale "fr"). +-- |French (\"fr\"). localeFr :: Locale localeFr = Locale "fr" --- |The German locale (Locale "de"). +-- |German (\"de\"). localeDe :: Locale localeDe = Locale "de" --- |The Japanese locale (Locale "jp"). +-- |Japanese (\"jp\"). localeJp :: Locale localeJp = Locale "jp" --- |The configuration used to make authentication calls and API calls. You typically create +-- |The configuration used to make API calls. You typically create -- one of these via the 'config' helper function. data Config = Config { configHosts :: Hosts -- ^The hosts to connect to (just use 'hostsDefault'). @@ -168,7 +168,8 @@ instance Show CertVerifier where show (CertVerifier name _) = "CertVerifier " ++ show name --- |A convenience function that constructs a 'Config' +-- |A convenience function that constructs a 'Config'. It's in the 'IO' monad because we read from +-- a file to get the list of trusted SSL certificates, which is used to verify the server over SSL. mkConfig :: Locale -> String -- ^Your Dropbox app key @@ -231,10 +232,11 @@ TLS.CertificateUsageAccept -> certAll rest reject -> return $ reject --- |Given a set of root certificates, yields a certificate validation function. +-- |A certificate validation routine. It's in 'IO' to match what 'HTTP.Enumerator' +-- expects, but we don't actually do any I/O. certVerifierFromRootCerts :: [X509] -- ^The set of trusted root certificates. - -> HT.Ascii -- ^The remove server's domain name. + -> HT.Ascii -- ^The remote server's domain name. -> [X509] -- ^The certificate chain provided by the remote server. -> IO TLS.TLSCertificateUsage -- TODO: Rewrite this crappy code. SSL cert checking needs to be more correct than this. @@ -479,16 +481,16 @@ -- |Metadata common to both files and folders. data MetaBase = MetaBase { metaRoot :: AccessType -- ^Matches the 'AccessType' of the app that retrieved the metadata. - , metaPath :: String -- ^The full path (starting with a "/") of the file or folder, relative to 'metaRoot' + , metaPath :: String -- ^The full path (starting with a \"/\") of the file or folder, relative to 'metaRoot' , metaIsDeleted :: Bool -- ^Whether this metadata entry refers to a file that had been deleted when the entry was retrieved. , metaThumbnail :: Bool -- ^Will be @True@ if this file might have a thumbnail, and @False@ if it definitely doesn't. , metaIcon :: String -- ^The name of the icon used to illustrate this file type in Dropbox's icon library (). } deriving (Eq, Show) --- |Metadata that's specific to either files or folders. +-- |Extra metadata (in addition to the stuff that's common to files and folders). data MetaExtra = File FileExtra -- ^Files have additional metadata - | Folder -- ^Folders do not + | Folder -- ^Folders do not have any additional metadata deriving (Eq, Show) -- |Represents a file's revision ('fileRevision'). @@ -503,15 +505,15 @@ , fileModified :: UTCTime -- ^When this file was added or last updated } deriving (Eq, Show) --- |Represents an identifier for a folder's metadata and contents. Can be used with --- 'getMetadataWithChildrenIfChanged' to avoid downloading a folder's metadata and contents +-- |Represents an identifier for a folder's metadata and children's metadata. Can be used with +-- 'getMetadataWithChildrenIfChanged' to avoid downloading a folder's metadata and children's metadata -- if it hasn't changed. newtype FolderHash = FolderHash String deriving (Eq, Show) folderHashToString (FolderHash s) = s --- |The single-level contents of a folder. +-- |The metadata for the immediate children of a folder. data FolderContents = FolderContents - { folderHash :: FolderHash -- ^An identifier for the folder's metadata and contents. + { folderHash :: FolderHash -- ^An identifier for the folder's metadata and children's metadata. , folderChildren :: [Meta] -- ^The metadata for the immediate children of a folder. } deriving (Eq, Show) @@ -597,18 +599,19 @@ ---------------------------------------------------------------------- -- GetMetadata +checkPath :: Path -> IO (Either ErrorMessage a) -> IO (Either ErrorMessage a) +checkPath ('/':_) action = action +checkPath _ _ = return $ Left $ "path must start with \"/\"" + -- |Get the metadata for the file or folder at the given path. getMetadata :: Manager -- ^The HTTP connection manager to use. -> Session -> Path -- ^The full path (relative to your 'DbAccessType' root) -> IO (Either ErrorMessage Meta) -getMetadata mgr session path = do - if "/" `isPrefixOf` path - then do - result <- doGet mgr session hostsApi url params (mkHandler handler) - return $ mergeLefts result - else return $ Left $ "path must start with \"/\"" +getMetadata mgr session path = checkPath path $ do + result <- doGet mgr session hostsApi url params (mkHandler handler) + return $ mergeLefts result where at = accessTypePath $ configAccessType (sessionConfig session) url = "metadata/" ++ at ++ path @@ -617,7 +620,7 @@ handler code reason body = Left $ "non-200 response from Dropbox (" ++ (show code) ++ ":" ++ reason ++ ": " ++ (show body) ++ ")" -- |Get the metadata for the file or folder at the given path. If it's a folder, --- return the first-level folder contents' metadata entries as well. +-- return the metadata for the folder's immediate children as well. getMetadataWithChildren :: Manager -- ^The HTTP connection manager to use. -> Session @@ -628,12 +631,9 @@ -- 'getMetadataWithChildren' call will fail with an HTTP 406 error code. If unspecified, or -- if set to zero, the server will set this to 10,000. -> IO (Either ErrorMessage (Meta, Maybe FolderContents)) -getMetadataWithChildren mgr session path childLimit = do - if "/" `isPrefixOf` path - then do - result <- doGet mgr session hostsApi url params (mkHandler handler) - return $ mergeLefts result - else return $ Left $ "'path' must start with \"/\"" +getMetadataWithChildren mgr session path childLimit = checkPath path $ do + result <- doGet mgr session hostsApi url params (mkHandler handler) + return $ mergeLefts result where at = accessTypePath $ configAccessType (sessionConfig session) url = "metadata/" ++ at ++ path @@ -656,12 +656,9 @@ -- for the specified path hasn't change, this call will return @Nothing@, which -- indicates that the previously-retrieved metadata is still the latest. -> IO (Either ErrorMessage (Maybe (Meta, Maybe FolderContents))) -getMetadataWithChildrenIfChanged mgr session path childLimit (FolderHash hash) = do - if "/" `isPrefixOf` path - then do - result <- doGet mgr session hostsApi url params (mkHandler handler) - return $ mergeLefts result - else return $ Left $ "'path' must start with \"/\"" +getMetadataWithChildrenIfChanged mgr session path childLimit (FolderHash hash) = checkPath path $ do + result <- doGet mgr session hostsApi url params (mkHandler handler) + return $ mergeLefts result where at = accessTypePath $ configAccessType (sessionConfig session) url = "metadata/" ++ at ++ path @@ -673,6 +670,48 @@ handler code reason body = Left $ "non-200 response from Dropbox (" ++ (show code) ++ ":" ++ reason ++ ": " ++ (show body) ++ ")" ---------------------------------------------------------------------- +-- GetFile + +-- |Gets a file's contents and metadata. If you just want the entire contents of +-- a file as a single 'ByteString', use 'getFileBs'. +getFile :: + Manager -- ^The HTTP connection manager to use. + -> Session + -> Path -- ^The full path (relative to your 'DbAccessType' root) + -> Maybe FileRevision -- ^The revision of the file to retrieve. + -> (Meta -> Sink ByteString IO r) + -- ^Given the file metadata, yield a 'Sink' to process the response body + -> IO (Either ErrorMessage (Meta, r)) + -- ^This function returns whatever your 'Sink' returns, paired up with the file metadata. +getFile mgr session path mrev sink = checkPath path $ do + result <- doGet mgr session hostsApiContent url params handler + return $ mergeLefts result + where + at = accessTypePath $ configAccessType (sessionConfig session) + url = "files/" ++ at ++ path + params = maybe [] (\(FileRevision rev) -> [("rev", rev)]) mrev + handler (HT.Status 200 _) headers = case getHeaders "X-Dropbox-Metadata" headers of + [metaJson] -> case handleJsonBody metaJson of + Left err -> C.Sink $ return $ C.SinkNoData (Left err) + Right meta -> do + r <- sink meta + return $ Right (meta, r) + l -> return $ Left $ "expecting response to have exactly one \"X-Dropbox-Metadata\" header, found " ++ show (length l) + handler (HT.Status code reason) _ = do + body <- bsSink + return $ Left $ "non-200 response from Dropbox (" ++ (show code) ++ ":" ++ (BS8.unpack reason) ++ ": " ++ (show body) ++ ")" + +-- |A variant of 'getFile' that just returns a strict 'ByteString' (instead of having +-- you pass in a 'Sink' to process the body. +getFileBs :: + Manager -- ^The HTTP connection manager to use. + -> Session + -> Path -- ^The full path (relative to your 'DbAccessType' root) + -> Maybe FileRevision -- ^The revision of the file to retrieve. + -> IO (Either ErrorMessage (Meta, ByteString)) +getFileBs mgr session path mrev = getFile mgr session path mrev (\_ -> bsSink) + +---------------------------------------------------------------------- -- AddFile/ForceFile/UpdateFile -- |Add a new file. If a file or folder already exists at the given path, your @@ -686,12 +725,10 @@ -> IO (Either ErrorMessage Meta) addFile mgr session path contents = putFile mgr session path contents [("overwrite", "false")] --- |Overwrite a file, assuming it is the version you expect. Specify the version --- you expect with the 'FileRevision'. If the file on Dropbox matches the given --- revision, the file will be replaced with the contents you specify. If the file --- on Dropbox doesn't have the specified revision, it will be left alone and your --- file will be automatically renamed. If successful, you'll get back the metadata --- for your newly-uploaded file. +-- |Overwrite a file with new data if the version on Dropbox matches the version +-- you specify. If the version doesn't match, create a new file with a unique +-- name. Either way, you will be returned the metdata for whichever file was +-- written. updateFile :: Manager -- ^The HTTP connection manager to use. -> Session @@ -706,7 +743,7 @@ -- be overwritten. If successful, you'll get back the metadata for your -- newly-uploaded file. forceFile :: - HE.Manager -- ^The 'Network.HTTP.Enumerator.Manager' to use. + Manager -- ^The HTTP connection manager to use. -> Session -> Path -- ^The full path (relative to your 'DbAccessType' root) -> RequestBody -- ^The file contents. @@ -717,18 +754,15 @@ -- The underlying "put_file" call. putFile :: - HE.Manager + HC.Manager -> Session -> Path -> RequestBody -> [(String,String)] -> IO (Either ErrorMessage Meta) -putFile mgr session path contents params = - if "/" `isPrefixOf` path - then do - result <- doPut mgr session hostsApiContent url params contents (mkHandler handler) - return $ mergeLefts result - else return $ Left $ "path must start with \"/\"" +putFile mgr session path contents params = checkPath path $ do + result <- doPut mgr session hostsApiContent url params contents (mkHandler handler) + return $ mergeLefts result where at = accessTypePath $ configAccessType (sessionConfig session) url = "files_put/" ++ at ++ path @@ -780,31 +814,38 @@ ---------------------------------------------------------------------- -type Manager = HE.Manager +-- |The HTTP connection manager. Using the same 'Manager' instance across +-- multiple API calls +type Manager = HC.Manager +-- |A bracket around an HTTP connection manager. withManager :: (Manager -> IO r) -> IO r -withManager = HE.withManager +withManager inner = HC.withManager $ \manager -> + MT.lift $ inner manager ---------------------------------------------------------------------- type SimpleHandler r = Int -> String -> ByteString -> r --- |HTTP response-handling function. -type Handler r = HT.Status -> HT.ResponseHeaders -> (Iteratee ByteString IO r) +-- HTTP response-handling function. +type Handler r = HT.Status -> HT.ResponseHeaders -> (Sink ByteString IO r) --- |An HTTP request body: an 'Int64' for the length and an 'Enumerator' +-- |An HTTP request body: an 'Int64' for the length and a 'Source' -- that yields the actual data. -data RequestBody = RequestBody Int64 (forall r. Enumerator ByteString IO r) +data RequestBody = RequestBody Int64 (Source IO ByteString) -- |Create a 'RequestBody' from a single 'ByteString' bsRequestBody :: ByteString -> RequestBody -bsRequestBody bs = RequestBody length (E.enumLists [[bs]]) +bsRequestBody bs = RequestBody length (CL.sourceList [bs]) where length = fromInteger $ toInteger $ BS.length bs +getHeaders :: CI HT.Ascii -> [HT.Header] -> [HT.Ascii] +getHeaders name headers = [ val | (key, val) <- headers, key == name ] + mkHandler :: SimpleHandler r -> Handler r mkHandler sh (HT.Status code reason) _headers = do - bs <- bsIteratee + bs <- bsSink return $ sh code (BS8.unpack reason) bs mergeLefts :: Either a (Either a b) -> Either a b @@ -812,10 +853,10 @@ Left a -> Left a Right r -> r --- |An 'Iteratee' that reads in 'ByteString' chunks and constructs one concatenated 'ByteString' -bsIteratee :: Monad m => Iteratee ByteString m ByteString -bsIteratee = do - chunks <- EL.consume +-- |A 'Sink' that reads in 'ByteString' chunks and constructs one concatenated 'ByteString' +bsSink :: Resource m => Sink ByteString m ByteString +bsSink = do + chunks <- CL.consume return $ BS.concat chunks httpClientDo :: @@ -827,22 +868,24 @@ -> String -> Handler r -> IO (Either String r) -httpClientDo mgr method (RequestBody len bsEnum) vf url oauthHeader handler = - case HE.parseUrl url of +httpClientDo mgr method (RequestBody len bsSource) vf url oauthHeader handler = + case HC.parseUrl url of Just baseReq -> do let req = baseReq { - HE.secure = True, - HE.method = method, - HE.requestHeaders = headers, - HE.requestBody = HE.RequestBodyEnum len builderEnum, - HE.checkCerts = vf } - resp <- E.run_ $ HE.http req handler mgr - return $ Right resp + HC.secure = True, + HC.method = method, + HC.requestHeaders = headers, + HC.requestBody = HC.RequestBodySource len builderSource, + HC.checkCerts = vf, + HC.checkStatus = \_ _ -> Nothing } + HC.Response code headers body <- C.runResourceT $ HC.http req mgr + result <- C.runResourceT (body C.$$ handler code headers) + return $ Right result Nothing -> do return $ Left $ "bad URL: " ++ show url where headers = [("Authorization", UTF8.fromString oauthHeader)] - builderEnum = E.joinE bsEnum (EL.map BlazeBS.fromByteString) + builderSource = bsSource C.$= (CL.map BlazeBS.fromByteString) httpClientGet :: Manager -> CertVerifierFunc -> URL -> String -> Handler r -> IO (Either String r) httpClientGet mgr vf url oauthHeader handler = httpClientDo mgr "GET" (bsRequestBody BS.empty) vf url oauthHeader handler diff --git a/dropbox-sdk.cabal b/dropbox-sdk.cabal --- a/dropbox-sdk.cabal +++ b/dropbox-sdk.cabal @@ -1,9 +1,9 @@ Name: dropbox-sdk -Version: 0.1.1 -Synopsis: A (very preliminary) library to access the Dropbox HTTP API. +Version: 0.2.0 +Synopsis: A library to access the Dropbox HTTP API. Description: - The Dropbox HTTP API provides ways for applications to access - users' Dropbox accounts programmatically. + A (very preliminary) library to access the Dropbox HTTP API: + License: MIT License-File: License.txt Author: Kannan Goundan @@ -22,13 +22,15 @@ utf8-string == 0.3.*, urlencoded == 0.3.*, json >= 0.4 && < 0.6, + transformers == 0.2.*, time == 1.4.*, old-locale == 1.0.*, network == 2.3.*, - enumerator >= 0.4.16 && < 0.5, + conduit == 0.0.*, + case-insensitive >= 0.2 && < 0.5, http-types >= 0.6.5 && < 0.7, - http-enumerator >= 0.7.2.1 && < 0.8, - blaze-builder == 0.3.*, + http-conduit == 1.1.*, + blaze-builder == 0.3.*, tls == 0.8.*, tls-extra == 0.4.*, certificate == 1.*