-
Notifications
You must be signed in to change notification settings - Fork 0
/
runtime.clj
153 lines (133 loc) · 4.61 KB
/
runtime.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
(ns monkey.ci.runtime
"The runtime can be considered the 'live configuration'. It is created
from the configuration, and is passed on to the application modules. The
runtime provides the information (often in the form of functions) needed
by the modules to perform work. This allows us to change application
behaviour depending on configuration, but also when testing.
Thie namespace also provides some utility functions for working with the
context. This is more stable than reading properties from the runtime
directly."
(:require [clojure.spec.alpha :as spec]
[clojure.tools.logging :as log]
[com.stuartsierra.component :as co]
[manifold.deferred :as md]
[medley.core :as mc]
[monkey.ci
[protocols :as p]
[spec :as s]
[utils :as u]]))
(defmulti setup-runtime (fn [_ k] k))
(defmethod setup-runtime :default [_ k]
{})
(defn config->runtime
"Creates the runtime from the normalized config map"
[conf]
;; TODO Re-enable this but allow for more flexible checks
#_{:pre [(spec/valid? ::s/app-config conf)]
:post [(spec/valid? ::s/runtime %)]}
;; Apply each of the discovered runtime setup implementations
(let [m (-> (methods setup-runtime)
(dissoc :default)
(keys))]
(-> (reduce (fn [r k]
(assoc r k (setup-runtime conf k)))
{}
m)
(assoc :config conf))))
(defn start
"Starts the runtime by starting all parts as a component tree. Returns a
component system that can be passed to `stop`."
[rt]
(log/info "Starting runtime system")
(->> rt
(mc/filter-vals some?)
;; TODO Check if we should create a separate system from the runtime instead of this
(co/map->SystemMap)
(co/start-system)))
(defn stop
"Stops a previously started runtime"
[rt]
(log/info "Stopping runtime system")
(co/stop-system rt))
;;; Accessors and utilities
(def config :config)
(defn from-config [k]
(comp k config))
(def app-mode (from-config :app-mode))
(def cli-mode? (comp (partial = :cli) app-mode))
(def server-mode? (comp (partial = :server) app-mode))
(def account (from-config :account))
(def args (from-config :args))
(def reporter :reporter)
(def api-url (comp :url account))
(def log-maker (comp :maker :logging))
(def log-retriever (comp :retriever :logging))
(def work-dir (from-config :work-dir))
(def dev-mode? (from-config :dev-mode))
(def ssh-keys-dir (from-config :ssh-keys-dir))
(def runner :runner)
(def build "Gets build info from runtime" :build)
(defn events-receiver [{:keys [events]}]
(if (satisfies? p/EventReceiver events)
events
;; Backwards compatibility, mostly in tests
(:receiver events)))
(defn get-arg [rt k]
(k (args rt)))
(defn report
"Reports `obj` to the user with the reporter from the runtime."
[rt obj]
(when-let [r (reporter rt)]
(r obj)))
(defn with-runtime-fn
"Creates a runtime for the given mode (server, cli, script) from the specified
configuration and passes it to `f`."
[conf mode f]
(let [rt (-> conf
(assoc :app-mode mode)
(config->runtime)
(start))]
(try
(let [v (f rt)]
(cond-> v
(md/deferred? v) deref))
(finally (stop rt)))))
(defmacro with-runtime
"Convenience macro that wraps `with-runtime-fn` by binding runtime to `r` and
invoking the body."
[conf mode r & body]
`(with-runtime-fn ~conf ~mode
(fn [~r]
~@body)))
(defn- prepare-events [evt]
(letfn [(add-time [evt]
(update evt :time #(or % (u/now))))]
(->> (u/->seq evt)
(map add-time))))
(defn post-events
"Posts one or more events using the event poster in the runtime"
[{:keys [events]} evt]
(let [evt (prepare-events evt)]
(cond
(satisfies? p/EventPoster events)
(p/post-events events evt)
;; For backwards compatibility, in tests
(fn? (:poster events))
((:poster events) evt)
:else
(log/warn "No event poster configured"))))
(defn rt->env
"Returns a map that can be serialized back into env vars. This is used
to pass application configuration to child processes or containers."
[rt]
;; Return the original, non-normalized configuration
(-> rt
:config
(merge (select-keys rt [:build]))
(mc/update-existing-in [:build :sid] u/serialize-sid)
;; Child processes never start an event server
(mc/update-existing :events dissoc :server)))
(defn update-build
"Updates the build in the runtime by applying `f` with given args."
[rt f & args]
(apply update rt :build f args))