Skip to content

Commit 6fa856d

Browse files
cap10morgancap10morgan
committed
Add more specs & generative tests
1 parent 1886f94 commit 6fa856d

File tree

6 files changed

+154
-32
lines changed

6 files changed

+154
-32
lines changed

‎deps.edn‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
11
{:deps
22
{org.clojure/clojure {:mvn/version "1.12.0"}
33
org.clojure/math.combinatorics {:mvn/version "0.3.0"}
4-
org.clojure/core.async {:mvn/version "1.6.681"}}
4+
org.clojure/core.async {:mvn/version "1.8.741"}
5+
com.gfredericks/test.chuck {:git/url "https://github.com/gfredericks/test.chuck"
6+
:git/sha "3e129a11ce9cc1a57584fa022b9b05ab7546a609"}}
57

68
:paths ["src" "resources"]
79

@@ -11,8 +13,8 @@
1113
:parallelization 2}}
1214

1315
:test {:extra-paths ["test"]
14-
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}
15-
orchestra/orchestra {:mvn/version "2021.01.01-1"}
16+
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}
17+
orchestra/orchestra {:mvn/version "2021.01.01-1"}
1618
org.clojure/test.check {:mvn/version "1.1.1"}}
1719
:exec-fn docker-clojure.fix-kaocha/run-tests
1820
:exec-args {}}}}

‎src/docker_clojure/config.clj‎

Lines changed: 50 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
(ns docker-clojure.config
22
(:require [clojure.spec.alpha :as s]
3+
[clojure.spec.gen.alpha :as gen]
34
[clojure.string :as str]
5+
[com.gfredericks.test.chuck.generators :as gen']
46
[docker-clojure.core :as-alias core]))
57

68
(s/def ::non-blank-string
@@ -13,25 +15,60 @@
1315
(s/def ::base-image ::non-blank-string)
1416
(s/def ::base-images (s/coll-of ::base-image :distinct true :into #{}))
1517

16-
(s/def ::docker-image-name (s/and ::non-blank-string
17-
#(re-matches #"[-\w]+(?::[-\w.]+)?" %)))
18-
(s/def ::docker-tag (s/and ::non-blank-string
19-
#(re-matches #"[-\w.]+" %)))
18+
(def docker-image-name-re (re-pattern "[-\\w]+(?::[-\\w.]+)?"))
19+
20+
(s/def ::docker-image-name
21+
(s/with-gen
22+
(s/and ::non-blank-string
23+
#(re-matches docker-image-name-re %))
24+
#(gen'/string-from-regex docker-image-name-re)))
25+
26+
(def docker-tag-re (re-pattern "[-\\w.]+"))
27+
28+
(s/def ::docker-tag
29+
(s/with-gen
30+
(s/and ::non-blank-string
31+
#(re-matches docker-tag-re %))
32+
#(gen'/string-from-regex docker-tag-re)))
33+
2034
(s/def ::base-image-tag ::docker-image-name)
2135

22-
(s/def ::distro qualified-keyword?)
36+
(def distro-component-re (re-pattern "[-_A-Za-z][-\\w.]+"))
37+
38+
(s/def ::distro
39+
(s/with-gen
40+
(s/and qualified-keyword?
41+
#(->> %
42+
((juxt namespace name))
43+
((fn [elements]
44+
(every? (fn [e] (re-matches distro-component-re e))
45+
elements)))))
46+
#(gen/fmap (fn [[namespace local]] (keyword namespace local))
47+
(gen/vector (gen'/string-from-regex distro-component-re) 2))))
48+
2349
(s/def ::distros (s/coll-of ::distro :distinct true :into #{}))
2450

25-
(s/def ::build-tool (s/or ::specific-tool ::non-blank-string
26-
::all-tools #(= ::core/all %)))
51+
(s/def ::specific-build-tool #{"lein" "tools-deps"})
52+
(s/def ::build-tool (s/or ::specific-tool ::specific-build-tool
53+
::all-tools #{::core/all}))
54+
(s/def ::specific-build-tool-version
55+
(s/with-gen
56+
(s/and ::non-blank-string
57+
#(re-matches #"(?:\d+\.)+\d+" %))
58+
#(gen/fmap (fn [nums] (str/join "." nums))
59+
(gen/vector (gen/int) 2 4))))
60+
2761
(s/def ::build-tool-version
28-
(s/nilable (s/and ::non-blank-string #(re-matches #"[\d\.]+" %))))
29-
(s/def ::build-tools (s/map-of ::build-tool ::build-tool-version))
62+
(s/nilable ::specific-build-tool-version))
63+
64+
(s/def ::build-tool-versions
65+
(s/map-of ::specific-build-tool ::specific-build-tool-version))
3066

3167
(s/def ::maintainers
3268
(s/coll-of ::non-blank-string :distinct true :into #{}))
69+
(s/def ::maintainer ::non-blank-string)
3370

34-
(s/def ::architecture ::non-blank-string)
71+
(s/def ::architecture #{"amd64" "arm64v8"})
3572
(s/def ::architectures (s/coll-of ::architecture :distinct true :into #{}))
3673

3774
(def git-repo "https://github.com/Quantisan/docker-clojure.git")
@@ -83,9 +120,9 @@
83120
{:jdk-version #(>= % 23)
84121
:distro :ubuntu/jammy}
85122
;; No upstream ARM alpine images available before JDK 21
86-
{:jdk-version #(< % 21)
87-
:architecture "arm64v8"
88-
:distro :alpine/alpine}})
123+
{:jdk-version #(< % 21)
124+
:architecture "arm64v8"
125+
:distro :alpine/alpine}})
89126

90127
(def maintainers
91128
["Paul Lam <[email protected]> (@Quantisan)"

‎src/docker_clojure/core.clj‎

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -20,12 +20,6 @@
2020
[exclusions variant]
2121
(some (partial variant/exclude? variant) exclusions))
2222

23-
(s/def ::variant
24-
(s/keys :req-un [::cfg/jdk-version ::cfg/base-image ::cfg/base-image-tag
25-
::cfg/distro ::cfg/build-tool ::cfg/build-tool-version
26-
::cfg/maintainer ::cfg/docker-tag]
27-
:opt-un [::cfg/build-tool-versions ::cfg/architecture]))
28-
2923
(def latest-variants
3024
"The latest variant is special because we include all 3 build tools via the
3125
[::all] value on the end."
@@ -36,12 +30,20 @@
3630
[::all]
3731
arch)))
3832

33+
(defn- invalid-variant?
34+
[variant]
35+
(let [status (s/conform ::variant/variant variant)
36+
invalid? (= ::s/invalid status)]
37+
(when invalid?
38+
(println "invalid variant:" (pr-str variant))
39+
true)))
40+
3941
(defn image-variants
4042
[base-images jdk-versions distros build-tools architectures]
4143
(into #{}
4244
(comp
4345
(map variant/->map)
44-
(remove #(= ::s/invalid (s/conform ::variant %))))
46+
(remove invalid-variant?))
4547
(concat
4648
(variant/combinations base-images jdk-versions distros build-tools
4749
architectures)

‎src/docker_clojure/manifest.clj‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@
2323
"Generates Docker manifest file for a given git commit and returns it as a
2424
string."
2525
[{:keys [maintainers architectures git-repo]} git-commit variants]
26-
(let [merged-arch-variants (variant/merge-architectures variants
27-
architectures)
26+
(let [merged-arch-variants (variant/merge-architectures architectures variants)
2827
maintainers-label "Maintainers:"
2928
maintainers-sep (apply str ",\n" (repeat (inc (count maintainers-label))
3029
" "))]

‎src/docker_clojure/util.clj‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,5 @@
11
(ns docker-clojure.util
2-
(:require [docker-clojure.config :as cfg]
3-
[docker-clojure.core :as-alias core]
4-
[clojure.string :as str]))
2+
(:require [docker-clojure.core :as-alias core]))
53

64
(defn get-or-default
75
"Returns the value in map m for key k or else the value for key :default."

‎src/docker_clojure/variant.clj‎

Lines changed: 88 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,42 @@
11
(ns docker-clojure.variant
22
(:refer-clojure :exclude [compare sort])
33
(:require [clojure.math.combinatorics :as combo]
4+
[clojure.spec.alpha :as s]
5+
[clojure.spec.gen.alpha :as gen]
46
[clojure.string :as str]
57
[docker-clojure.config :as cfg]
8+
[docker-clojure.core :as-alias core]
69
[docker-clojure.docker :as docker]
710
[docker-clojure.util :refer [get-or-default]]))
811

12+
(s/def ::variant-base
13+
(s/keys :req-un [::cfg/jdk-version ::cfg/base-image ::cfg/base-image-tag
14+
::cfg/distro ::cfg/build-tool ::cfg/build-tool-version
15+
::cfg/maintainer ::cfg/docker-tag ::cfg/architecture]
16+
:opt-un [::cfg/build-tool-versions]))
17+
18+
(s/def ::variant
19+
(s/with-gen
20+
::variant-base
21+
#(gen/fmap (fn [[v btv]]
22+
(if (= ::core/all (:build-tool v))
23+
(-> v ; ::core/all implies docker tag "latest"
24+
(assoc :build-tool-version nil
25+
:build-tool-versions btv)
26+
(dissoc :distro :docker-tag :base-image-tag :base-image))
27+
v))
28+
(gen/tuple (s/gen ::variant-base)
29+
(gen/map (s/gen ::cfg/specific-build-tool)
30+
(s/gen ::cfg/specific-build-tool-version))))))
31+
32+
(s/def ::variants (s/coll-of ::variant))
33+
34+
(s/def ::manifest-variant
35+
(s/keys :req-un [::cfg/jdk-version ::cfg/base-image ::cfg/base-image-tag
36+
::cfg/distro ::cfg/build-tool ::cfg/build-tool-version
37+
::cfg/maintainer ::cfg/docker-tag]
38+
:opt-un [::cfg/build-tool-versions ::cfg/architectures]))
39+
940
(defn assoc-if
1041
[m pred k v]
1142
(if (pred)
@@ -28,6 +59,28 @@
2859
(assoc-if #(nil? (:build-tool-version base)) :build-tool-versions
2960
cfg/build-tools))))
3061

62+
(s/def ::variant-tuple
63+
(s/tuple ::cfg/base-image ::cfg/jdk-version ::cfg/distro
64+
(s/tuple ::cfg/specific-build-tool ::cfg/specific-build-tool-version)
65+
::cfg/architecture))
66+
67+
(s/fdef ->map
68+
:args (s/cat :variant-tuple ::variant-tuple)
69+
:ret ::variant
70+
:fn #(let [[base-image jdk-version distro
71+
[specific-build-tool specific-build-tool-version]
72+
architecture] (-> % :args :variant-tuple)]
73+
(println "arg:" (-> % :args :variant-tuple pr-str))
74+
(println "ret:" (-> % :ret pr-str))
75+
(and (= (-> % :ret :base-image) base-image)
76+
(= (-> % :ret :jdk-version) jdk-version)
77+
(= (-> % :ret :distro) distro)
78+
(= (-> % :ret :base-image-tag)
79+
(docker/base-image-tag base-image jdk-version distro))
80+
(= (-> % :ret :build-tool last) specific-build-tool)
81+
(= (-> % :ret :build-tool-version) specific-build-tool-version)
82+
(= (-> % :ret :architecture) architecture))))
83+
3184
(defn exclude?
3285
"Returns true if the map `variant` contains every key-value pair in the map
3386
`exclusion`. `variant` may contain additional keys that are not in
@@ -68,8 +121,9 @@
68121
(= 0 (compare v1 v2)))
69122

70123
(defn equal-except-architecture?
71-
[v1 v2]
72-
(= 0 (compare (dissoc v1 :architecture) (dissoc v2 :architecture))))
124+
[{arch1 :architecture :as v1} {arch2 :architecture :as v2}]
125+
(and (not= arch1 arch2)
126+
(equal? (dissoc v1 :architecture) (dissoc v2 :architecture))))
73127

74128
(defn combinations
75129
[base-images jdk-versions distros build-tools architectures]
@@ -91,7 +145,7 @@
91145
#{} jdk-versions))
92146

93147
(defn merge-architectures
94-
[variants default-architectures]
148+
[default-architectures variants]
95149
(->> variants
96150
(map #(assoc % :architectures #{(:architecture %)}))
97151
(reduce
@@ -104,10 +158,40 @@
104158
(-> mav
105159
(->> (remove #(= % matching)))
106160
(conj (update matching :architectures conj
107-
(:architecture v))))
161+
(:architecture v))))
108162
(conj mav v)))
109163
[])
110164
(map #(if (= (:architectures %) default-architectures)
111165
(dissoc % :architectures :architecture)
112166
(dissoc % :architecture)))
113167
sort))
168+
169+
(s/fdef merge-architectures
170+
:args (s/cat :default-architectures ::cfg/architectures
171+
:variants
172+
(s/with-gen
173+
::variants
174+
#(gen/fmap
175+
(fn [variants]
176+
;; duplicate variants for each architecture
177+
(mapcat (fn [variant]
178+
(map (fn [arch]
179+
(assoc variant :architecture arch))
180+
cfg/architectures))
181+
variants))
182+
(s/gen (s/coll-of ::variant)))))
183+
:ret (s/coll-of ::manifest-variant)
184+
:fn #(let [ret-count (-> % :ret count)
185+
arg-variants (-> % :args :variants)
186+
should-merge? (fn [v]
187+
(some (partial equal-except-architecture? v)
188+
arg-variants))
189+
one-per-arch (fn [c] (if (> c 0)
190+
(/ c (count cfg/architectures))
191+
c))
192+
num-should-merge (->> arg-variants
193+
(filter should-merge?)
194+
count
195+
one-per-arch)
196+
arg-count (- (count arg-variants) num-should-merge)]
197+
(= ret-count arg-count)))

0 commit comments

Comments
 (0)