-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.clj
288 lines (248 loc) · 12 KB
/
core.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
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
286
287
(ns sqs-utils.core
(:require [clojure.core.async
:as async
:refer [chan go-loop <! >! <!! >!! thread]]
[clojure.tools.logging :as log]
[clj-time.core :as t]
[sqs-utils.serde :as serde]
[cheshire.core :as json]
[fink-nottle.sqs :as sqs]
[fink-nottle.sqs.tagged :as sqs.tagged]
[fink-nottle.sqs.channeled :as sqs.channeled]))
;; auto ser/de transit messages
(defmethod sqs.tagged/message-in :transit [_ body]
(serde/transit-read body))
(defmethod sqs.tagged/message-out :transit [_ body]
(serde/transit-write body))
;; similarly json
(defmethod sqs.tagged/message-in :json [_ body]
(json/parse-string body true))
(defmethod sqs.tagged/message-out :json [_ body]
(json/generate-string body))
;; CRUD ;;;;;;
(defn receive-one!
[sqs-config queue-url]
(let [{:keys [body] :as message}
(<!! (sqs.channeled/receive! sqs-config queue-url {:maximum 1}))]
(<!! (sqs/processed! sqs-config queue-url message))
body))
(defn receive-loop!
"A background loop to receive SQS messages from a queue indefinitely.
Arguments:
sqs-config - A map of the following keys, used for interacting with SQS:
access-key - AWS access key ID
secret-key - AWS secret access key
endpoint - SQS queue endpoint - usually an HTTPS based URL
region - AWS region
queue-url - URL of the queue
out-chan - async channel where messages will be passed into
opts - an optional map containing the following keys:
auto-delete - boolean, if true, immediately delete the message,
if false, forward a `done` function and leave the
message intact.
visibility-timeout - how long (in seconds) a message can go unacknowledged
before delivery is retried.
restart-delay-seconds - how long (in seconds) to wait before attempting to
restart the consumer loop.
maximum-messages - the maximum number of messages to be delivered as
a result of a single poll of SQS.
auto-delete defaults to true, visibility-timeout defaults to 60 seconds.
Returns a kill function - call the function to terminate the loop."
([sqs-config queue-url out-chan]
(receive-loop! sqs-config queue-url out-chan {}))
([sqs-config queue-url out-chan
{:keys [auto-delete visibility-timeout restart-delay-seconds maximum-messages]
:or {auto-delete true
visibility-timeout 60
restart-delay-seconds 1
maximum-messages 10}
:as opts}]
(let [loop-state (atom {:messages
(sqs.channeled/receive!
sqs-config queue-url
{:visibility-timeout visibility-timeout
:maximum maximum-messages})
:running true
:stats {:count 0
:started-at (t/now)
:restart-count 0
:restarted-at nil
:queue-url queue-url}})]
(letfn [(restart-loop []
;; Make a fresh sqs.channeled/receive! call and replace the
;; existing messages channel with the new one.
(log/infof "Restarting receive-loop for %s" queue-url)
(let [messages-chan (:messages @loop-state)]
(swap! loop-state
(fn [state]
(-> state
(assoc :messages
(sqs.channeled/receive!
sqs-config queue-url
{:visibility-timeout visibility-timeout
:maximum maximum-messages}))
(update-in [:stats :restart-count] inc)
(assoc-in [:stats :restarted-at] (t/now)))))
(async/close! messages-chan)))
(stop-loop []
;; Set running to false causing the loop to exit, close the
;; channels - closing out-chan signals exit to the client code.
(when (:running @loop-state)
(log/infof "Terminating receive-loop for %s" queue-url)
(swap! loop-state assoc :running false)
(async/close! (:messages @loop-state))
(async/close! out-chan))
(:stats @loop-state))
(secs-between [d1 d2]
;; Utility for calculating an interval in seconds.
(t/in-seconds (t/interval d1 d2)))
(update-stats [state]
;; Keep track of useful information which may be useful for
;; debugging errors.
(let [{:keys [started-at]} (:stats state)
now (t/now)]
(-> state
(update-in [:stats :count] inc)
(assoc-in [:stats :this-pass-started-at] now)
(assoc-in [:stats :loop-duration]
(secs-between (-> state :stats :started-at) now)))))]
(go-loop []
;; start by updating our loop statistics
(swap! loop-state update-stats)
(try
(let [{:keys [body attrs] :as message} (<! (:messages @loop-state))]
(cond
(nil? message) ;; closed, this loop is dead
(stop-loop)
;; we have a message, is it an error?
(instance? Throwable message)
;; fink-nottle closes the messages channel on error, so we must
;; restart
(let [{:keys [this-pass-started-at] :as stats} (:stats @loop-state)]
(log/warn message "Received an error from fink-nottle"
(assoc stats :last-wait-duration (secs-between this-pass-started-at
(t/now))))
;; Adding a restart delay so that this doesn't go into an
;; abusively tight loop if the queue listener is failing to
;; start continuously.
(<! (async/timeout (int (* restart-delay-seconds 1000))))
(restart-loop))
;; it's a well formed actionable message
:else
(let [done-fn #(<!! (sqs/processed! sqs-config queue-url message))
msg (cond-> {:message body}
(not auto-delete) (assoc :done-fn done-fn))]
(if body
(>! out-chan msg)
(log/warnf "Queue %s received a nil body message: %s" queue-url message))
(when auto-delete
;; TODO handle these in a batch-delete in another thread
(done-fn)))))
(catch Exception e
;; this shouldn't happen, and it isn't from fink-nottle, so raise
;; an alarm
(log/errorf e "Failed receiving message for %s" (:stats @loop-state))))
(if (:running @loop-state)
(recur)
(log/warnf "Receive-loop terminated for %s" (:stats @loop-state))))
;; return a kill function
stop-loop))))
(defn send-message*
"Send a message to a queue."
[sqs-config queue-url payload {:keys [message-group-id
deduplication-id
format]
:or {format :transit}}]
(let [resp (<!! (sqs/send-message!
sqs-config
queue-url
(cond-> {:body payload :fink-nottle/tag format}
message-group-id (assoc :message-group-id (str message-group-id))
deduplication-id (assoc :message-deduplication-id (str deduplication-id)))))]
;; sqs/send-message! returns Exceptions into the channel
(if (instance? Exception resp)
(throw resp)
resp)))
(defn send-message
"Send a message to a standard queue, by default transit encoded. An optional map
may be passed as a 5th argument, containing a `:format` key which should be
set to either `:json` or `:transit`."
([sqs-config queue-url payload]
(send-message sqs-config queue-url payload {}))
([sqs-config queue-url payload {:keys [format] :or {format :transit}}]
;; Note that standard queues don't support message-group-id
(send-message* sqs-config queue-url payload {:format format})))
(defn send-fifo-message
"Send a message to a FIFO queue.
Arguments:
message-group-id - a tag that specifies the group that this message
belongs to. Messages belonging to the same group
are guaranteed FIFO
Options:
deduplication-id - token used for deduplication of sent messages"
[sqs-config
queue-url
payload
{message-group-id :message-group-id
deduplication-id :deduplication-id
format :format
:as options
:or {format :transit}}]
{:pre [message-group-id]}
(send-message* sqs-config queue-url payload options))
;; Controls ;;;;;;;;;;;;;;;;;
(defn handle-queue
"Set up a loop that listens to a queue and process incoming messages.
Arguments:
sqs-config - A map of the following keys, used for interacting with SQS:
access-key - AWS access key ID
secret-key - AWS secret access key
endpoint - SQS queue endpoint - usually an HTTPS based URL
region - AWS region
queue-url - URL of the queue
handler-fn - a function which will be passed the incoming message. If
auto-delete is false, a second argument will be passed a `done`
function to call when finished processing.
opts - an optional map containing the following keys:
num-handler-threads - how many threads to run (defaults: 4)
auto-delete - boolean, if true, immediately delete the message,
if false, forward a `done` function and leave the
message intact. (defaults: true)
visibility-timeout - how long (in seconds) a message can go unacknowledged
before delivery is retried. (defaults: 60)
maximum-messages - the maximum number of messages to be delivered as
a result of a single poll of SQS.
See http://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-visibility-timeout.html
for more information about visibility timeout.
Returns:
a kill function - call the function to terminate the loop."
([sqs-config queue-url handler-fn
{:keys [num-handler-threads auto-delete visibility-timeout maximum-messages]
:or {num-handler-threads 4
auto-delete true
visibility-timeout 60
maximum-messages 10}
:as opts}]
(log/infof "Starting receive loop for %s with num-handler-threads: %d, auto-delete: %s, visibility-timeout: %d"
queue-url num-handler-threads auto-delete visibility-timeout)
(let [receive-chan (chan)
stop-fn (receive-loop! sqs-config
queue-url
receive-chan
{:auto-delete auto-delete
:visibility-timeout visibility-timeout
:maximum-messages maximum-messages})]
(dotimes [_ num-handler-threads]
(thread
(loop []
(when-let [coll (<!! receive-chan)]
(try
(if auto-delete
(handler-fn (:message coll))
(handler-fn (:message coll) (:done-fn coll)))
(catch Throwable t
(log/error t "SQS handler function threw an error")))
(recur)))))
stop-fn))
([sqs-config queue-url handler-fn]
(handle-queue sqs-config queue-url handler-fn {})))