#lang racket
(require net/url
net/uri-codec json
)
(provide set!-APP-KEY
set!-APP-SECRET
set!-ACCESS-TYPE
get-authorization-url
obtain-access-token
get-account-info
get-metadata
upload-file
download-file
get-delta
get-revisions
restore-file
search
get-share-url
get-media-url
get-copy-ref
get-image-thumbnail
copy
create-folder
delete
move
exists?
)
(define APP-KEY "3ysfqt0flcbex2t")
(define APP-SECRET "hia6gkco347zczj")
(define ACCESS-TYPE "app_folder")
(define (set!-APP-KEY akey) (set! APP-KEY akey))
(define (set!-APP-SECRET asec) (set! APP-SECRET asec))
(define (set!-ACCESS-TYPE atype) (set! ACCESS-TYPE atype))
(define (mk-api-url api-call [params #f])
(string->url
(string-append "https://api.dropbox.com/1/" api-call
(if params
(string-append "?" params)
""))))
(define (mk-api-content-url api-call [params #f])
(string->url
(string-append "https://api-content.dropbox.com/1/" api-call
(if params
(string-append "?" params)
""))))
(define (get-root)
(if (string=? ACCESS-TYPE "dropbox")
"dropbox"
"sandbox"))
(define (format-params . args)
(cond [(null? args) ""]
[(null? (cddr args)) (string-append (car args) "=" (cadr args))]
[else (string-append (car args) "=" (cadr args) "&"
(apply format-params (cddr args)))]))
(define DEFAULT-LOCALE "en")
(define AUTH-URL-BASE "https://www.dropbox.com/1/oauth/authorize")
(define OAUTH-REQUEST-TOKEN "uk264rf6wc0lyte")
(define OAUTH-REQUEST-SECRET "8vfhlfahxd8xfxp")
(define OAUTH-ACCESS-TOKEN "ws51ylwe4geys4c")
(define OAUTH-ACCESS-SECRET "in75kn1ci9fskt4")
(define AUTHORIZATION-HEADER
(list (string-append "Authorization: OAuth oauth_version=\"1.0\","
"oauth_signature_method=\"PLAINTEXT\","
"oauth_consumer_key=\"" APP-KEY "\","
"oauth_token=\"" OAUTH-ACCESS-TOKEN "\","
"oauth_signature=\"" APP-SECRET "&"
OAUTH-ACCESS-SECRET"\"")))
(define (obtain-request-token)
(define p
(post-pure-port
(mk-api-url "oauth/request_token")
(bytes)
(list (string-append "Authorization: OAuth oauth_version=\"1.0\","
"oauth_signature_method=\"PLAINTEXT\","
"oauth_consumer_key=\"" APP-KEY "\","
"oauth_signature=\"" APP-SECRET "&\""))))
(define response-alist (form-urlencoded->alist (port->string p)))
(close-input-port p)
(set! OAUTH-REQUEST-SECRET (cdr (assq 'oauth_token_secret response-alist)))
(set! OAUTH-REQUEST-TOKEN (cdr (assq 'oauth_token response-alist)))
(values OAUTH-REQUEST-TOKEN OAUTH-REQUEST-SECRET))
(define (get-authorization-url #:locale [locale DEFAULT-LOCALE]
#:callback [callback-url AUTH-URL-BASE])
(obtain-request-token)
(define params (format-params "oauth_token" OAUTH-REQUEST-TOKEN
"oauth_callback" callback-url
"locale" locale))
(string-append AUTH-URL-BASE "?" params))
(define (obtain-access-token)
(define p
(post-pure-port
(mk-api-url "oauth/access_token")
(bytes)
(list (string-append "Authorization: OAuth oauth_version=\"1.0\","
"oauth_signature_method=\"PLAINTEXT\","
"oauth_consumer_key=\"" APP-KEY "\","
"oauth_token=\"" OAUTH-REQUEST-TOKEN "\","
"oauth_signature=\"" APP-SECRET "&"
OAUTH-REQUEST-SECRET"\""))))
(define response-alist (form-urlencoded->alist (port->string p)))
(close-input-port p)
(set! OAUTH-ACCESS-SECRET (cdr (assq 'oauth_token_secret response-alist)))
(set! OAUTH-ACCESS-TOKEN (cdr (assq 'oauth_token response-alist)))
(set! AUTHORIZATION-HEADER
(list (string-append "Authorization: OAuth oauth_version=\"1.0\","
"oauth_signature_method=\"PLAINTEXT\","
"oauth_consumer_key=\"" APP-KEY "\","
"oauth_token=\"" OAUTH-ACCESS-TOKEN "\","
"oauth_signature=\"" APP-SECRET "&"
OAUTH-ACCESS-SECRET"\"")))
(values OAUTH-ACCESS-SECRET OAUTH-ACCESS-TOKEN))
(define (get-account-info #:locale [locale DEFAULT-LOCALE])
(define params (format-params "locale" locale))
(define p (get-pure-port
(mk-api-url "account/info" params)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (get-metadata path
#:file-limit [file-limit 10000]
#:hash [hash ""]
#:list [lst "true"]
#:inc-del [inc-del "false"]
#:rev [rev ""]
#:locale [locale DEFAULT-LOCALE])
(define params (format-params "file_limit" (number->string file-limit)
"hash" hash
"list" lst
"include_deleted" inc-del
"rev" rev
"locale" locale))
(define p
(get-pure-port
(mk-api-url (string-append "metadata/" (get-root) "/" path)
params)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (upload-file local-filepath remote-filepath
#:locale [locale DEFAULT-LOCALE]
#:overwrite? [overwrite? "true"]
#:parent-rev [parent-rev ""])
(define params (format-params "locale" locale
"overwrite" overwrite?
"parent_rev" parent-rev))
(define p
(put-pure-port
(mk-api-content-url
(string-append "files_put/" (get-root) "/" remote-filepath)
params)
(file->bytes local-filepath)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (upload-file-post local-filepath remote-filepath
#:locale [locale DEFAULT-LOCALE]
#:overwrite? [overwrite? "true"]
#:parent-rev [parent-rev ""])
(define params (format-params
"locale" locale
"overwrite" overwrite?
))
(define p
(post-pure-port
(mk-api-content-url
(string-append "files/" (get-root) "/" remote-filepath)
params)
(file->bytes local-filepath)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (download-file remote-filepath
local-filepath
#:rev [rev ""]
#:exists [exists 'error])
(define params (format-params "rev" rev))
(define p
(get-pure-port
(mk-api-content-url
(string-append "files/" (get-root) "/" remote-filepath)
params)
AUTHORIZATION-HEADER))
(define out (open-output-file local-filepath
#:mode 'binary
#:exists exists))
(write-bytes (port->bytes p) out)
(close-output-port out)
(close-input-port p))
(define (get-delta #:cursor [cursor ""]
#:locale [locale DEFAULT-LOCALE])
(define params (format-params "locale" locale "cursor" cursor))
(define p
(post-pure-port
(mk-api-url "delta" params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (get-revisions filepath #:rev-limit [rev-limit 10]
#:locale [locale DEFAULT-LOCALE])
(define params (format-params "rev_limit" (number->string rev-limit)
"locale" locale))
(define p
(get-pure-port
(mk-api-url (string-append "revisions/" (get-root) "/" filepath)
params)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (restore-file filepath rev #:locale [locale DEFAULT-LOCALE])
(define params (format-params "rev" rev
"locale" locale))
(define p
(post-pure-port
(mk-api-url (string-append "restore/" (get-root) "/" filepath)
params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (search remote-dir query
#:file-limit [file-limit 1000]
#:inc-del [inc-del "false"]
#:locale [locale DEFAULT-LOCALE])
(define params (format-params "query" query
"file_limit" (number->string file-limit)
"include_deleted" inc-del
"locale" locale))
(define p
(get-pure-port
(mk-api-url (string-append "search/" (get-root) "/" remote-dir)
params)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (get-share-url remote-path
#:locale [locale DEFAULT-LOCALE]
#:short-url [short-url "true"])
(define params (format-params "locale" locale
"short_url" short-url))
(define p
(post-pure-port
(mk-api-url (string-append "shares/" (get-root) "/" remote-path)
params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (get-media-url remote-file
#:locale [locale DEFAULT-LOCALE])
(define params (format-params "locale" locale))
(define p
(post-pure-port
(mk-api-url (string-append "media/" (get-root) "/" remote-file)
params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (get-copy-ref remote-file)
(define p
(get-pure-port
(mk-api-url (string-append "copy_ref/" (get-root) "/" remote-file))
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (get-image-thumbnail remote-file local-file
#:format [format "jpeg"]
#:size [size "s"]
#:exists [exists 'error])
(define params (format-params "format" format
"size" size))
(define p
(get-pure-port
(mk-api-content-url
(string-append "thumbnails/" (get-root) "/" remote-file)
params)
AUTHORIZATION-HEADER))
(define out (open-output-file local-file
#:mode 'binary
#:exists exists))
(write-bytes (port->bytes p) out)
(close-output-port out)
(close-input-port p))
(define (upload-file local-filepath remote-filepath
#:locale [locale DEFAULT-LOCALE]
#:overwrite? [overwrite? "true"]
#:parent-rev [parent-rev ""]
#:chunk-size [chunk-size 4194304]
#:verbose? [verbose? #f]
#:return-resume-info-on-error?
[return-resume-info-on-error? #f]
#:resume? [resume? #f]
#:resume-id [resume-id ""]
#:resume-offset [resume-offset 0])
(define upload-id #f)
(define offset 0)
(define in (open-input-file local-filepath))
(when resume?
(when verbose?
(printf "Resuming chunk upload, id = ~a\n" resume-id))
(set! upload-id resume-id)
(set! offset resume-offset)
(read-bytes offset in)) (let LOOP ([chunk (read-bytes chunk-size in)]) (with-handlers
([exn:fail:network:errno?
(λ _
(when verbose?
(printf "Network connection lost. Returning resume thunk.\n"))
(if return-resume-info-on-error?
(list upload-id offset)
(thunk
(upload-file local-filepath remote-filepath
#:locale locale
#:overwrite? overwrite?
#:parent-rev parent-rev
#:chunk-size chunk-size
#:verbose? verbose?
#:return-resume-info-on-error?
return-resume-info-on-error?
#:resume? #t
#:resume-id upload-id
#:resume-offset offset))))])
(if (eof-object? chunk)
(let ([params (format-params "locale" locale
"overwrite" overwrite?
"parent_rev" parent-rev
"upload_id" upload-id)])
(close-input-port in)
(define p
(post-pure-port
(mk-api-content-url
(string-append "commit_chunked_upload/" (get-root) "/"
remote-filepath)
params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(when verbose?
(printf "Chunk upload completed, id = ~a\n" upload-id))
(close-input-port p)
jsexp)
(let ([params (if upload-id
(format-params "upload_id" upload-id
"offset" (number->string offset))
(format-params "offset" "0"))])
(define p
(put-pure-port
(mk-api-content-url "chunked_upload" params)
chunk
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
(unless upload-id
(when verbose?
(printf "Chunk upload started, id = ~a\n"
(hash-ref jsexp 'upload_id))))
(set! upload-id (hash-ref jsexp 'upload_id))
(when verbose?
(printf "Chunk uploaded: bytes ~a to ~a\n"
offset (hash-ref jsexp 'offset)))
(set! offset (hash-ref jsexp 'offset))
(LOOP (read-bytes chunk-size in)))))) )
(define (filter-search-by-exact-match filename search-res)
(filter (λ (m) (string=? (hash-ref m 'path)
(string-append "/" filename)))
search-res))
(define (exists? dirname filename)
(define filepath
(if (string=? dirname "")
filename
(string-append dirname "/" filename)))
(not
(null? (filter-search-by-exact-match filepath (search dirname filename)))))
(define (copy from to
#:locale [locale DEFAULT-LOCALE]
#:copy-ref [copy-ref #f])
(define params
(if copy-ref
(format-params "root" (get-root)
"from_path" ""
"to_path" to
"locale" locale
"from_copy_ref" copy-ref)
(format-params "root" (get-root)
"from_path" from
"to_path" to
"locale" locale)))
(define p
(post-pure-port
(mk-api-url "fileops/copy" params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (create-folder path #:locale [locale DEFAULT-LOCALE])
(define params (format-params "root" (get-root)
"path" path
"locale" locale))
(define p
(post-pure-port
(mk-api-url "fileops/create_folder" params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (delete path #:locale [locale DEFAULT-LOCALE])
(define params (format-params "root" (get-root)
"path" path
"locale" locale))
(define p
(post-pure-port
(mk-api-url "fileops/delete" params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)
(define (move from to #:locale [locale DEFAULT-LOCALE])
(define params (format-params "root" (get-root)
"from_path" from
"to_path" to
"locale" locale))
(define p
(post-pure-port
(mk-api-url "fileops/move" params)
(bytes)
AUTHORIZATION-HEADER))
(define jsexp (read-json p))
(close-input-port p)
jsexp)