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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285 | (ns ird.transport
"HTTP transport for the ird API over Node's global fetch.
Requests use optional Bearer auth (API key or account JWT), JSON bodies and
optional query maps. Every request goes through the client's :http-fn (a
function of a request map returning a channel of {:status :body} or an
Error), so tests and instrumentation inject a transport without dynamic
vars — `binding` does not survive a parked go block.
Paths are vectors of segments, each percent-encoded as one segment
([\"domains\" \"registrations\" id]), or verbatim strings for static paths.
List helpers follow cursor pagination via `paginate` and offset pagination
via `paginate-offset`; `poll-until` backs off between polls; `upload-bytes`
sends raw bytes to an IPFS upload-grant URL."
(:require [clojure.string :as str]
[cljs.core.async :as async]
[ird.async :as a :refer [go-try <?]]
[ird.config :as config]
[ird.errors :as err]
[ird.node :as node]))
(defn encode
"Percent-encode one URL component: encodeURIComponent plus !'()*, spaces
as %20 (never +). Keywords are encoded by name."
[v]
(-> (js/encodeURIComponent (if (keyword? v) (name v) (str v)))
(str/replace #"[!'()*]" (fn [c] (str "%" (.toUpperCase (.toString (.charCodeAt c 0) 16)))))))
(defn query-string
"Build a URL query string (with leading ?) from PARAMS, skipping nil
values. Returns nil when there is nothing to encode."
[params]
(let [pairs (for [[k v] params
:when (and k (some? v))]
(str (encode (name k)) "=" (encode v)))]
(when (seq pairs)
(str "?" (str/join "&" pairs)))))
(defn- render-path
"A vector of segments becomes /seg/seg with each segment encoded; a
string is used as-is (given a leading slash)."
[path]
(if (vector? path)
(str "/" (str/join "/" (map encode path)))
(if (str/starts-with? path "/") path (str "/" path))))
(defn- error-message
"Human-readable message from an error RESPONSE. The ird API envelope is
{:error {:code :message}}; the node-hosted mailbox uses a bare
{:error \"code\"}, in which case the code doubles as the message."
[response text]
(or (get-in response [:error :message])
(let [e (:error response)] (when (string? e) e))
text
""))
(defn- error-code
"Machine-readable error code from either envelope (see `error-message`)."
[response]
(let [e (:error response)]
(if (string? e) e (:code e))))
(defn build-request
"Build the request map for an ird API call, without sending it:
{:method :url :headers :body :timeout-ms}. Pure.
The Authorization header is only added when the client has a non-blank
:api-key (several endpoints allow anonymous access); Content-Type only with
a body. The client's :headers are merged over the computed ones, so a
custom User-Agent cannot silently drop Authorization."
[client method path {:keys [query body]}]
(let [{:keys [api-key api-url headers timeout-ms]} client
base (str/replace (or (not-empty api-url) config/api-base-url) #"/+$" "")]
(cond-> {:method method
:url (str base (render-path path) (query-string query))
:headers (merge (cond-> {"Accept" "application/json"}
(not (str/blank? (str api-key)))
(assoc "Authorization" (str "Bearer " api-key))
(some? body)
(assoc "Content-Type" "application/json"))
headers)}
(some? body) (assoc :body (js/JSON.stringify (clj->js body)))
timeout-ms (assoc :timeout-ms timeout-ms))))
(defn decode-response
"Turn a raw {:status :body} response into the parsed map, or throw: an
api-error on non-2xx statuses, a transport-error on a non-JSON 2xx body.
Pure. Successful maps carry {:ird/status <n>} metadata so callers can
distinguish 202 (accepted/queued) from 200/201."
[{:keys [status body]}]
(let [ok? (<= 200 status 299)
text (str/trim (str body))]
(if (str/blank? text)
(if ok?
(with-meta {} {:ird/status status})
(throw (err/api-error "Empty error response" nil status nil)))
(let [parsed (try (js->clj (js/JSON.parse text) :keywordize-keys true)
(catch :default _
(if ok?
(throw (err/transport-error "Failed to parse JSON response" text))
::unparsed)))]
(if ok?
(if (satisfies? IWithMeta parsed)
(with-meta parsed {:ird/status status})
parsed)
(let [response (when (map? parsed) parsed)]
(throw (err/api-error (error-message response text)
(error-code response)
status
response))))))))
(defn fetch-http
"The default :http-fn, over the global fetch. Takes a request map from
`build-request` and returns a channel of {:status <int> :body <string>};
a rejected fetch (network failure, AbortSignal timeout) is delivered as
the Error itself, which `request` maps to a transport-error."
[{:keys [method url headers body timeout-ms]}]
(let [init (js-obj "method" (str/upper-case (name method))
"headers" (clj->js headers))]
(when (some? body) (aset init "body" body))
(when timeout-ms (aset init "signal" (js/AbortSignal.timeout timeout-ms)))
(when (and (exists? js/ReadableStream) (instance? js/ReadableStream body))
(aset init "duplex" "half"))
(a/promise->chan
(.then (js/fetch url init)
(fn [resp]
(.then (.text resp)
(fn [text] {:status (.-status resp) :body text})))))))
(defn- execute
"Run REQ through the client's :http-fn and decode the answer. Channel of
the parsed response, or an error value."
[{:keys [http-fn verbose]} req]
(go-try
(when verbose
(js/console.error "ird" (str/upper-case (name (:method req))) (:url req)))
(let [raw (async/<! ((or http-fn fetch-http) req))]
(cond
(err/ird-error? raw) (throw raw)
(a/error? raw) (throw (err/transport-error
(str "Request failed: " (.-message raw))
{:url (:url req) :cause raw}))
:else (decode-response raw)))))
(defn request
"Execute an ird API request.
METHOD is :get/:post/:put/:patch/:delete. PATH is a vector of path
segments ([\"domains\" \"registrations\" id]) or a static string
(\"/domains/check\"). OPTS may contain:
:query - map of query-string parameters (nil values skipped)
:body - map serialised to a JSON request body (some DELETEs carry one)
Returns a channel delivering the parsed response map (snake_case keyword
keys, {:ird/status <http-status>} metadata), or an :ird/api-error on
non-2xx responses / an :ird/transport-error on connection and parse
failures."
([client method path]
(request client method path nil))
([client method path opts]
(execute client (build-request client method path opts))))
(defn paginate
"Follow cursor pagination for a list endpoint, collecting all items under
COLLECTION-KEY (e.g. :registrations). Channel of a vector of items.
QUERY may include filters; :cursor is advanced automatically from each
response's :next_cursor until it is absent."
[client method path collection-key query]
(go-try
(loop [cursor nil
acc []]
(let [resp (<? (request client method path
{:query (if cursor (assoc query :cursor cursor) query)}))
acc (into acc (get resp collection-key))]
(if-let [next-cursor (:next_cursor resp)]
(recur next-cursor acc)
acc)))))
(defn paginate-offset
"Follow offset pagination for a list endpoint, collecting all items under
COLLECTION-KEY (e.g. :pins). Channel of a vector of items.
QUERY may include filters and a page :limit (default 100); :offset is
advanced by the number of rows each page actually returns and paging stops
on the first short or empty page. The response's :total is deliberately
ignored — it can move while the pages are being walked. Rows shifting
between requests can duplicate or skip an item, as with any offset paging."
[client method path collection-key query]
(let [limit (or (:limit query) 100)]
(go-try
(loop [offset (or (:offset query) 0)
acc []]
(let [items (get (<? (request client method path
{:query (assoc query :limit limit :offset offset)}))
collection-key)
n (count items)
acc (into acc items)]
(if (< n limit)
acc
(recur (+ offset n) acc)))))))
(defn request-url
"Execute a request against an absolute URL rather than the ird API base —
for the node-hosted endpoints the API hands out: an IPFS upload grant
(`upload-bytes`) or a p2p app's mailbox (ird.mailbox).
METHOD is :get/:post/... URL is absolute. OPTS may contain:
:token bearer token for the endpoint (from the grant or the mint)
:query map of query-string parameters (nil values skipped)
:headers extra headers, merged over the computed ones
:body raw body, already coerced (Uint8Array, Blob, string, ...)
:http-fn transport override (default fetch-http)
:timeout-ms per-request timeout
Channel of the parsed response map; errors as in `request`."
([method url] (request-url method url nil))
([method url {:keys [token query headers body http-fn timeout-ms]}]
(execute {:http-fn http-fn}
(cond-> {:method method
:url (str url (query-string query))
:headers (merge (cond-> {"Accept" "application/json"}
(not (str/blank? (str token)))
(assoc "Authorization" (str "Bearer " token)))
headers)}
(some? body) (assoc :body body)
timeout-ms (assoc :timeout-ms timeout-ms)))))
(defn poll-until
"Poll STEP (a no-arg fn returning a channel of the latest response) until
DONE? is truthy for its result, waiting between attempts with exponential
backoff (the interval doubles up to :max-interval-ms).
OPTS:
:interval-ms initial interval between polls (default 1000)
:max-interval-ms backoff cap (default 8000)
:timeout-ms overall deadline (default 120000)
:message message for the timeout error
:sleep-fn ms -> channel that closes after ms (default
cljs.core.async/timeout; callers pass the client's)
Channel of the first result for which (done? result) is truthy, an
:ird/timeout error when the deadline passes first, or the first error a
step delivers."
[step done? {:keys [interval-ms max-interval-ms timeout-ms message sleep-fn]}]
(let [interval-ms (or interval-ms 1000)
max-interval-ms (or max-interval-ms 8000)
sleep (or sleep-fn async/timeout)
deadline (+ (js/Date.now) (or timeout-ms 120000))]
(go-try
(loop [interval interval-ms]
(let [result (<? (step))]
(cond
(done? result) result
(>= (js/Date.now) deadline)
(throw (err/timeout (or message "Timed out polling") result))
:else (do (async/<! (sleep interval))
(recur (min max-interval-ms (* 2 interval))))))))))
(defn upload-bytes
"POST raw bytes to an IPFS upload-grant URL (from ird.ipfs/start-upload).
URL and TOKEN come from the grant; the token is single-use and may be nil
once consumed. SOURCE is a Uint8Array (a Buffer is one), ArrayBuffer,
Blob or ReadableStream — for a file path use ird.ipfs/add-file, which
reads it first. OPTS: :format — \"car\" appends ?format=car for a
client-packed CAR archive; :http-fn, :timeout-ms as in `request-url`.
Channel of the parsed response map; errors as in `request`."
([url token source]
(upload-bytes url token source nil))
([url token source {:keys [format http-fn timeout-ms]}]
(if-not (node/bytes? source)
(go-try (throw (err/transport-error
"Unsupported upload source; expected a Uint8Array, ArrayBuffer, Blob or ReadableStream"
{:source-type (goog/typeOf source)})))
(request-url :post url
{:token token
:query (when (= "car" format) {:format "car"})
:headers {"Content-Type" "application/octet-stream"}
:body source
:http-fn http-fn
:timeout-ms timeout-ms}))))
|