-
Notifications
You must be signed in to change notification settings - Fork 2
/
maintenance.clj
226 lines (209 loc) · 8.99 KB
/
maintenance.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
(ns salutem.core.maintenance
"Provides an asynchronous maintenance pipeline for maintaining up-to-date
results for the checks in a registry."
(:require
[clojure.core.async :as async]
[cartus.core :as log]
[cartus.null :as null]
[tick.alpha.api :as t]
[salutem.core.checks :as checks]
[salutem.core.registry :as registry]))
(defn maintainer
([dependencies registry-store context interval trigger-channel]
(maintainer
dependencies registry-store context interval
trigger-channel (async/chan)))
([dependencies registry-store context interval
trigger-channel shutdown-channel]
(let [logger (:logger dependencies)
interval-millis (t/millis interval)
trigger-counter (atom 0)]
(log/info logger ::maintainer.starting {:interval interval})
(async/go-loop []
(async/alt!
(async/timeout interval-millis)
(let [trigger-id (swap! trigger-counter inc)
registry (deref registry-store)]
(log/info logger ::maintainer.triggering
{:trigger-id trigger-id})
(async/>! trigger-channel
{:trigger-id trigger-id
:registry registry
:context context})
(recur))
shutdown-channel
(let [triggers-sent (deref trigger-counter)]
(async/close! trigger-channel)
(log/info logger ::maintainer.stopped
{:triggers-sent triggers-sent}))))
shutdown-channel)))
(defn refresher
([dependencies trigger-channel]
(refresher dependencies trigger-channel (async/chan 1)))
([dependencies trigger-channel evaluation-channel]
(let [logger (:logger dependencies)]
(log/info logger ::refresher.starting)
(async/go-loop []
(let [{:keys [registry context trigger-id]
:or {context {}}
:as trigger-message} (async/<! trigger-channel)]
(if trigger-message
(do
(log/info logger ::refresher.triggered
{:trigger-id trigger-id})
(doseq [check (registry/outdated-checks registry)]
(log/info logger ::refresher.evaluating
{:trigger-id trigger-id
:check-name (:name check)})
(async/>! evaluation-channel
{:trigger-id trigger-id
:check check
:context context}))
(recur))
(do
(async/close! evaluation-channel)
(log/info logger ::refresher.stopped))))))
evaluation-channel))
(defn evaluator
([dependencies evaluation-channel]
(evaluator dependencies evaluation-channel (async/chan 1)))
([dependencies evaluation-channel result-channel]
(let [logger (:logger dependencies)]
(log/info logger ::evaluator.starting)
(async/go-loop []
(let [{:keys [check context trigger-id]
:or {context {}}
:as evaluation-message} (async/<! evaluation-channel)]
(if evaluation-message
(do
(log/info logger ::evaluator.evaluating
{:trigger-id trigger-id
:check-name (:name check)})
(checks/attempt
dependencies trigger-id check context result-channel)
(recur))
(do
(async/close! result-channel)
(log/info logger ::evaluator.stopped)))))
result-channel)))
(defn updater
[dependencies registry-store result-channel]
(let [logger (:logger dependencies)]
(log/info logger ::updater.starting)
(async/go-loop []
(let [{:keys [check result trigger-id]
:as result-message} (async/<! result-channel)]
(if result-message
(do
(log/info logger ::updater.updating
{:trigger-id trigger-id
:check-name (:name check)
:result result})
(swap! registry-store
registry/with-cached-result check result)
(recur))
(log/info logger ::updater.stopped))))))
(defn notifier
[dependencies callbacks result-channel]
(let [logger (:logger dependencies)]
(log/info logger ::notifier.starting
{:callbacks (count callbacks)})
(async/go-loop []
(let [{:keys [check result trigger-id]
:as result-message} (async/<! result-channel)]
(if result-message
(do
(doseq [[index callback] (map-indexed vector callbacks)]
(log/info logger ::notifier.notifying
{:trigger-id trigger-id
:check-name (:name check)
:result result
:callback (inc index)})
(callback check result))
(recur))
(log/info logger ::notifier.stopped))))))
(defn maintain
"Constructs and starts a maintenance pipeline to maintain up-to-date results
for the checks in the registry in the provided registry store atom.
The maintenance pipeline consists of a number of independent processes:
- a _maintainer_ which triggers an attempt to refresh the results
periodically,
- a _refresher_ which requests evaluation of each outdated check on each
refresh attempt,
- an _evaluator_ which evaluates outdated checks to obtain a fresh result,
- an _updater_ which updates the registry store atom with fresh check
results,
- a _notifier_ which calls callback functions when fresh check results are
available.
The maintenance pipeline can be configured via an optional map which
can contain the following options:
- `:context`: a map containing arbitrary context required by checks in
order to run and passed to the check functions as the first
argument; defaults to an empty map
- `:interval`: a [[duration]] describing the wait interval between
attempts to refresh the results in the registry; defaults to 200
milliseconds
- `:notification-callback-fns`: a sequence of arity-2 functions, with the
first argument being a check and the second argument being a result,
which are called whenever a new result is available for a check; empty by
default
- `:trigger-channel`: the channel on which trigger messages are sent, to
indicate that a refresh of the registry should be attempted, defaults
to a channel with a sliding buffer of length 1, i.e., in the case of a
long running attempt, all but the latest trigger message will be dropped
from the channel
- `:evaluation-channel`: the channel on which messages requesting
evaluation of checks are sent, defaults to a channel with a buffer of
size 10
- `:result-channel`: the channel on which results are placed after
evaluation, defaults to a channel with a buffer of size 10
- `:updater-result-channel`: a tap of the `result-channel` which sends
result messages on to the updater, defaults to a channel with a buffer
of size 10
- `:notifier-result-channel`: a tap of the `result-channel` which sends
result messages on to the notifier, defaults to a channel with a buffer
of size 10
If the context map contains a `:logger` key with a
[`cartus.core/Logger`](https://logicblocks.github.io/cartus/cartus.core.html#var-Logger)
value, the maintenance pipeline will emit a number of log events
throughout operation.
Returns the maintenance pipeline which can be passed to [[shutdown]] in
order to stop operation."
([registry-store]
(maintain registry-store {}))
([registry-store
{:keys [context
interval
trigger-channel
evaluation-channel
result-channel
updater-result-channel
notifier-result-channel
notification-callback-fns]
:or {context {}
interval (t/new-duration 200 :millis)
trigger-channel (async/chan (async/sliding-buffer 1))
evaluation-channel (async/chan 10)
result-channel (async/chan 10)
updater-result-channel (async/chan 10)
notifier-result-channel (async/chan 10)
notification-callback-fns []}}]
(let [logger (get context :logger (null/logger))
dependencies {:logger logger}
result-mult (async/mult result-channel)
shutdown-channel (async/chan)]
(async/go
(updater dependencies registry-store
(async/tap result-mult updater-result-channel))
(notifier dependencies notification-callback-fns
(async/tap result-mult notifier-result-channel))
(evaluator dependencies evaluation-channel result-channel)
(refresher dependencies trigger-channel evaluation-channel)
(maintainer dependencies registry-store context interval
trigger-channel shutdown-channel))
{:shutdown-channel shutdown-channel})))
(defn shutdown
"Shuts down the maintenance pipeline preventing further updates to the
registry."
[maintenance-pipeline]
(async/close! (:shutdown-channel maintenance-pipeline)))