now using oauth in the headers and have propert error handling

This commit is contained in:
Adam Wynne 2011-06-16 17:55:52 +01:00
parent 69767d1b18
commit 28ee2dbe10
3 changed files with 163 additions and 259 deletions

View file

@ -10,14 +10,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn make-uri
"makes a uri from a supplied protocol, site, version and resource-path"
[protocol site version resource-path]
(str protocol "://" site "/" version "/" resource-path))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro def-rest-twitter-method
[name action resource-path]
@ -28,209 +20,56 @@
(def-rest-twitter-method public-timeline :get "statuses/public_timeline.json")
(def-rest-twitter-method friends-timeline :get "statuses/friends_timeline.json")
(def-rest-twitter-method user-timeline :get "statuses/user_timeline.json")
(def-rest-twitter-method home-timeline :get "statuses/home_timeline.json")
(def-rest-twitter-method mentions :get "statuses/mentions.json")
(def-rest-twitter-method show-status :get "statuses/show.json")
(def-rest-twitter-method update-status :post "statuses/update.json")
(def-rest-twitter-method destroy-status :post "statuses/destroy.json")
(def-rest-twitter-method user-timeline
:get
"statuses/user_timeline.json"
)
(def-rest-twitter-method show-user :get "users/show.json")
(def-rest-twitter-method lookup-users :get "users/lookup.json")
(def-rest-twitter-method search-users :get "users/search.json")
(def-rest-twitter-method suggest-slugs :get "users/suggestions.json")
(def-rest-twitter-method suggest-users-for-slug :get "users/suggestions/:slug.json")
(def-rest-twitter-method home-timeline
:get
"statuses/home_timeline.json"
)
(def-rest-twitter-method direct-messages :get "direct_messages.json")
(def-rest-twitter-method sent-direct-messages :get "direct_messages/sent.json")
(def-rest-twitter-method send-direct-message :post "direct_messages/new.json")
(def-rest-twitter-method destroy-direct-message :post "direct_messages/destroy.json")
(def-rest-twitter-method mentions :get "statuses/mentions.json"
)
(def-rest-twitter-method create-friendship :post "friendships/create.json")
(def-rest-twitter-method destroy-friendship :post "friendships/destroy.json")
(def-rest-twitter-method show-friendship :get "friendships/show.json")
(def-rest-twitter-method show-status :get "statuses/show.json"
)
(def-rest-twitter-method friends-of :get "friends/ids.json")
(def-rest-twitter-method update-status
:post
"statuses/update.json"
)
(def-rest-twitter-method followers-of :get "followers/ids.json")
(def-rest-twitter-method destroy-status
:post
"statuses/destroy.json"
)
(def-rest-twitter-method verify-credentials :get "account/verify_credentials.json")
(def-rest-twitter-method rate-limit-status :get "account/rate_limit_status.json")
(def-rest-twitter-method end-session :post "account/end_session.json")
(def-rest-twitter-method update-profile :post "account/update_profile.json")
(def-rest-twitter-method update-delivery-device :post "account/update_delivery_device.json")
(def-rest-twitter-method update-profile-colors :post "account/update_profile_colors.json")
(def-rest-twitter-method update-profile-image :post "account/update_profile_image.json")
(def-rest-twitter-method update-profile-background-image :post "account/update_profile_background_image.json")
(def-rest-twitter-method show-user-by-id :get "users/show.json"
)
(def-rest-twitter-method favorites :get "favorites.json")
(def-rest-twitter-method create-favorite :post "favorites/create.json")
(def-rest-twitter-method destroy-favorite :post "favorites/destroy.json")
(def-rest-twitter-method show-user-by-name :get "users/show.json"
)
(def-rest-twitter-method notifications-follow :post "notifications/follow.json")
(def-rest-twitter-method notifications-leave :post "notifications/leave.json")
(def-rest-twitter-method lookup-users-by-id :get "users/lookup.json"
)
(def-rest-twitter-method create-block :post "blocks/create.json")
(def-rest-twitter-method destroy-block :post "blocks/destroy.json")
(def-rest-twitter-method block-exists :get "blocks/exists.json")
(def-rest-twitter-method blocking-users :get "blocks/blocking.json")
(def-rest-twitter-method blocking-user-ids :get "blocks/blocking/ids.json")
(def-rest-twitter-method lookup-users-by-name :get "users/lookup.json"
)
(def-rest-twitter-method direct-messages :get "direct_messages.json"
)
(def-rest-twitter-method sent-direct-messages :get "direct_messages/sent.json"
)
(def-rest-twitter-method send-direct-message-to-id
:post
"direct_messages/new.json"
)
(def-rest-twitter-method send-direct-message-to-name
:post
"direct_messages/new.json"
)
(def-rest-twitter-method destroy-direct-message
:post
"direct_messages/destroy.json"
)
(def-rest-twitter-method create-friendship-to-id
:post
"friendships/create.json"
)
(def-rest-twitter-method create-friendship-to-name
:post
"friendships/create.json"
)
(def-rest-twitter-method destroy-friendship-to-id
:post
"friendships/destroy.json"
)
(def-rest-twitter-method destroy-friendship-to-name
:post
"friendships/destroy.json"
)
(def-rest-twitter-method show-friendship-by-ids :get "friendships/show.json"
)
(def-rest-twitter-method show-friendship-by-names :get "friendships/show.json"
)
(def-rest-twitter-method friends-of-id :get "friends/ids.json"
)
(def-rest-twitter-method friends-of-name :get "friends/ids.json"
)
(def-rest-twitter-method followers-of-id :get "followers/ids.json"
)
(def-rest-twitter-method followers-of-name :get "followers/ids.json"
)
(def-rest-twitter-method verify-credentials :get "account/verify_credentials.json"
)
(def-rest-twitter-method rate-limit-status :get "account/rate_limit_status.json"
)
(def-rest-twitter-method end-session
:post
"account/end_session.json"
)
(def-rest-twitter-method update-delivery-device
:post
"account/update_delivery_device.json"
)
(def-rest-twitter-method update-profile-colors
:post
"account/update_profile_colors.json"
)
(comment (def-rest-twitter-method update-profile-image
:post
"account/update_profile_image.json"
))
(comment (def-rest-twitter-method update-profile-background-image
:post
"account/update_profile_background_image.json"
))
(def-rest-twitter-method update-profile
:post
"account/update_profile.json"
)
(def-rest-twitter-method favorites :get "favorites.json"
)
(def-rest-twitter-method create-favorite
:post
"favorites/create.json"
)
(def-rest-twitter-method destroy-favorite
:post
"favorites/destroy.json"
)
(def-rest-twitter-method notifications-follow-by-id
:post
"notifications/follow.json"
)
(def-rest-twitter-method notifications-follow-by-name
:post
"notifications/follow.json"
)
(def-rest-twitter-method notifications-leave-by-id
:post
"notifications/leave.json"
)
(def-rest-twitter-method notifications-leave-by-name
:post
"notifications/leave.json"
)
(def-rest-twitter-method create-block
:post
"blocks/create.json"
)
(def-rest-twitter-method destroy-block
:post
"blocks/destroy.json"
)
(def-rest-twitter-method block-exists-for-id :get "blocks/exists.json"
)
(def-rest-twitter-method block-exists-for-name :get "blocks/exists.json"
)
(def-rest-twitter-method blocking-users :get "blocks/blocking.json"
)
(def-rest-twitter-method blocking-user-ids :get "blocks/blocking/ids.json"
)
(def-rest-twitter-method saved-searches :get "saved_searches.json"
)
(def-rest-twitter-method show-saved-search :get "saved_searches/show.json"
)
(def-rest-twitter-method create-saved-search
:post
"saved_searches/create.json"
)
(def-rest-twitter-method destroy-saved-search
:post
"saved_searches/destroy.json"
)
(def-rest-twitter-method saved-searches :get "saved_searches.json")
(def-rest-twitter-method show-saved-search :get "saved_searches/show.json")
(def-rest-twitter-method create-saved-search :post "saved_searches/create.json")
(def-rest-twitter-method destroy-saved-search :post "saved_searches/destroy.json")

View file

@ -2,6 +2,7 @@
(:use
[clojure.test])
(:require
[twitter.handlers :as hl]
[clojure.contrib.json :as json]
[oauth.client :as oa]
[oauth.signature :as oas]
@ -28,22 +29,22 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn sign-query-params
"takes oauth credentials and signs the query parameters, merging the new oauth params into the returned map"
"takes oauth credentials and signs the query parameters"
[oauth-creds action uri & {:keys [query]}]
(merge query
(oa/credentials (:consumer oauth-creds)
(:access-token oauth-creds)
(:access-token-secret oauth-creds)
action
uri
query)))
(oa/credentials (:consumer oauth-creds)
(:access-token oauth-creds)
(:access-token-secret oauth-creds)
action
uri
query))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn make-test-creds
"creates a set of test credentials for the api tests"
[]
(let [app-key "4NZ24o0FnUMT4ngO6Lg1ow"
app-secret "8W5UTZIspWQ3HDhUSW8gnCNn5JHJJDrUbCtI3O0UY"
consumer (oa/make-consumer app-key
@ -73,6 +74,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftest test-fix-keyword
(is (= (fix-keyword "my-test") "my_test")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn transform-map
"transforms the k/v pairs of a map using a supplied transformation function"
[m & {:keys [key-trans val-trans] :or {key-trans (fn [x] x) val-trans (fn [x] x)}}]
@ -81,9 +87,25 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn partition-map
"partitions a map, depending on a predicate, returning a vector of maps of passes and fails"
[map-to-partition pred]
(loop [passes {}
fails {}
m map-to-partition]
(if (empty? m) [passes fails]
(let [[k v] (first m)]
(if (pred [k v])
(recur (assoc passes k v) fails (rest m))
(recur passes (assoc fails k v) (rest m)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn action-2-function
"maps the keyword of the action to the respective http verb function"
[kw]
(cond (= kw :get) ac/GET
(= kw :post) ac/POST
(= kw :delete) ac/DELETE))
@ -91,66 +113,42 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn url-encode-val
"takes a value and returns the url encoding of the string of it"
[val]
(oas/url-encode (str val)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn query-transform
"returns a function that contains the transformation of the query params required, depending on the action"
[action sign-fn url-encode-fn fix-keys-fn]
(cond (= action :get) #(sign-fn (url-encode-fn (fix-keys-fn %)))
(= action :post) #(sign-fn (fix-keys-fn %))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn return-everything
"this takes a response and returns a map of the headers and the json-parsed body"
[resp]
"takes a value and returns the url encoding of the string of it"
[val]
(hash-map :headers (ac/headers resp) :body (json/read-json (ac/string resp))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn return-body
"this takes a response and returns the json-parsed body"
[resp]
(json/read-json (ac/string resp)))
(oas/url-encode (str val)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn sync-http-request
"calls the action on the resource specified in the uri"
"calls the action on the resource specified in the uri, signing with oauth in the headers"
[action uri &
{:keys [query headers body oauth-creds return-fn]
{:keys [query headers body oauth-creds handler-fn]
:or {oauth-creds *oauth-creds*,
return-fn return-everything}}]
(let [fix-keys #(transform-map % :key-trans fix-keyword)
url-encode-vals #(transform-map % :val-trans url-encode-val)
sign #(sign-query-params oauth-creds action uri :query %)
handler-fn (hl/make-default-handler)}}]
final-query ((query-transform action sign url-encode-vals fix-keys) query)
response-from #((action-2-function action) % :query final-query :headers headers :body body)]
(return-fn (ac/await (response-from uri)))))
(let [final-query (transform-map query
:key-trans fix-keyword
:val-trans url-encode-val)
signing-params (sign-query-params oauth-creds action uri :query final-query)
final-headers (merge headers {:Authorization signing-params})]
(println "query: " final-query)
(println "headers: " final-headers)
(handler-fn
(ac/await
((action-2-function action) uri :query final-query :headers final-headers :body body)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn process-args
"takes a map of arguments, and reformats them to have stray k/v inserted in the query map"
"takes a map of arguments, and reformats them to have unknown k/v's inserted in the query map. also
removes the entries in the map that have a nil value"
[arg-map]
(let [known-arg-keys '(:query :headers :body :oauth-creds :return-fn)
known-arg-map (select-keys arg-map known-arg-keys)
remaining-arg-map (dissoc arg-map known-arg-keys)]
(remove nil?
(merge-with merge known-arg-map {:query remaining-arg-map}))))
(let [known-arg-keys #{:query :headers :body :oauth-creds :handler-fn}
[known-map unknown-map] (partition-map arg-map (fn [[k v]] (get known-arg-keys k)))]
(into {} (filter second (merge-with merge known-map {:query unknown-map})))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -167,4 +165,13 @@
~uri
(reduce concat (process-args arg-map#))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn make-uri
"makes a uri from a supplied protocol, site, version and resource-path"
([protocol site version resource-path]
(str protocol "://" site "/" version "/" resource-path))
([protocol site resource-path]
(str protocol "://" site "/" resource-path)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

58
src/twitter/handlers.clj Normal file
View file

@ -0,0 +1,58 @@
(ns twitter.handlers
(:use
[clojure.test])
(:require
[clojure.contrib.json :as json]
[http.async.client :as ac]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn return-everything
"this takes a response and returns a map of the headers and the json-parsed body"
[response]
(hash-map :headers (ac/headers response)
:status (ac/status response)
:body (json/read-json (ac/string response))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn return-body
"this takes a response and returns the json-parsed body"
[response]
(json/read-json (ac/string response)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn error-thrower
"throws the supplied error in an exception"
[response]
(let [error-code (:code (ac/status response))
error-body (json/read-json (ac/string response))
error-str (:error error-body)
error-req (:request error-body)]
(throw (Exception. (format "Twitter responded to request '%s' with error %d: %s"
error-req error-code error-str)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn make-handler
"creates a handler function that takes a response and reacts to success or error"
[on-success on-error]
(fn [response]
(if (< (:code (ac/status response)) 400)
(on-success response)
(on-error response))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn make-default-handler
"throws on error and returns the whole response to the caller"
[]
(make-handler return-everything error-thrower))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;