-
Notifications
You must be signed in to change notification settings - Fork 4
/
client.clj
144 lines (127 loc) · 4.55 KB
/
client.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(ns clostack.client
"A mostly generated wrapper to the CloudStack API."
(:require [clojure.string :as str]
[cheshire.core :as json]
[aleph.http :as http]
[manifold.deferred :as d]
[byte-streams :as bs]
[clostack.config :as config]
[clostack.payload :as payload]))
(defn http-client
"Create an HTTP client. Takes a map of two
optional keys, if no configuration is present,
it is picked up from the environment:
- :config a map of the following optional:
- :endpoint HTTP endpoint for the API
- :api-key
- :api-secret
- :request-method (:get or :post, default to :post)
- :page-size number of entities to fetch per page (500 per default)
- :opts: an opt map handed out to aleph's http client
"
([]
(http-client {}))
([{:keys [config opts] :or {opts {}}}]
{:config (or config (config/init))
:opts opts}))
(defn wrap-body
"Ensure that response is JSON-formatted, if so parse it"
[body resp handler]
(handler (assoc resp :body body)))
(defn api-name
"Given a hyphenated name, yield a camel case one"
[op]
(cond
(keyword? op)
(let [[prelude & rest] (str/split (name op) #"-")
capitalizer #(if (#{"lb" "ssh" "vpc" "vm"} %)
(str/upper-case %)
(str/capitalize %))]
(apply str prelude (map capitalizer rest)))
(string? op)
op
:else
(throw (IllegalArgumentException. "cannot coerce to opcode"))))
(defn http-get
[uri opts params]
(http/get uri (assoc opts :query-params params)))
(defn http-post
[uri opts params]
(http/post uri (assoc opts :form-params params)))
(def request-fns
{:get http-get
:post http-post})
(defn request-fn
[config]
(get request-fns
(some-> config :request-method name str/lower-case keyword)
http-post))
(defn parse-body
[response]
(let [parse-json-body #(-> % bs/to-reader (json/parse-stream true))]
(update response :body parse-json-body)))
(defn prepare-error-fn
[f]
(fn [e]
(f
(if-let [data (ex-data e)]
(-> data
(select-keys [:status :headers :body])
(parse-body)
(assoc :exception e))
e))))
(defn async-request
"Asynchronous request, will execute handler when response comes back."
([client opcode handler]
(async-request client opcode {} handler))
([{:keys [config opts]} opcode args handler]
(let [params (payload/build-payload config (api-name opcode) args)
sanitize #(select-keys % [:status :headers :body])
send-request (request-fn config)]
(-> (send-request (:endpoint config) opts params)
(d/chain sanitize parse-body handler)
(d/catch (prepare-error-fn handler))))))
(defn request
"Perform a synchronous HTTP request against the API"
([client opcode]
(request client opcode {}))
([client opcode args]
@(async-request client opcode args identity)))
(defmacro with-response
"Perform an asynchronous response, using body as the function body
to execute."
[[sym client opcode args] & body]
`(async-request
~client
~opcode
~(or args {})
(fn [~sym] ~@body)))
(defn paging-request
"Perform a paging request. Elements are fetched by chunks of 500."
([client op]
(paging-request client op {} 1 nil))
([client op args]
(paging-request client op args 1 nil))
([client op args page width]
(when (or (nil? width) (pos? width))
(let [pagesize (get-in client [:config :page-size] 500)
resp (request client op (assoc args :page page :pagesize (int pagesize)))
desc (->> resp :body (map val) (filter map?) first)
width (or width (:count desc) 0)
elems (->> desc (map val) (filter vector?) first)
pending (- width (count elems))]
(when (seq elems)
(lazy-cat elems (paging-request client op args (inc page) pending)))))))
(defn polling-request
"Perform a polling request, in a blocking fashion. Fetches are done every second."
[client jobid]
(let [resp (request client :query-async-job-result {:jobid jobid})
jobresult (get-in resp [:body :queryasyncjobresultresponse])
jobstatus (:jobstatus jobresult)
result (:jobresult jobresult)]
(case (int jobstatus)
0 (do (Thread/sleep 1000)
(polling-request client jobid))
1 jobresult
(throw (ex-info (str "job " jobid " failed")
{:jobresult jobresult})))))