Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 22 additions & 4 deletions src/docker_clojure/config.clj
Original file line number Diff line number Diff line change
Expand Up @@ -6,10 +6,20 @@
[docker-clojure.core :as-alias core]))

(s/def ::non-blank-string
(s/and string? #(not (str/blank? %))))
(s/with-gen
(s/and string? #(not (str/blank? %)))
;; Generate non-blank by construction (the default string generator yields
;; "" at size 0, which the not-blank such-that can't satisfy), and with
;; enough length/entropy that `:distinct true` collections of these (e.g.
;; ::architectures) don't collide and starve their distinctness such-that.
#(gen'/string-from-regex #"[A-Za-z0-9]{8,32}")))

(s/def ::jdk-version
(s/and pos-int? #(<= 8 %)))
(s/with-gen
(s/and pos-int? #(<= 8 %))
;; Generate in-range by construction; the default pos-int generator yields
;; values < 8 the >= 8 such-that can't satisfy at small sizes (flaky gen).
#(gen/choose 8 30)))
(s/def ::jdk-versions (s/coll-of ::jdk-version :distinct true :into #{}))

(s/def ::base-image ::non-blank-string)
Expand Down Expand Up @@ -48,7 +58,8 @@

(s/def ::distros (s/coll-of ::distro :distinct true :into #{}))

(s/def ::specific-build-tool #{"lein" "tools-deps"})
(def specific-build-tools #{"lein" "tools-deps"})
(s/def ::specific-build-tool specific-build-tools)
(s/def ::build-tool (s/or ::specific-tool ::specific-build-tool
::all-tools #{::core/all}))
(s/def ::specific-build-tool-version
Expand All @@ -62,7 +73,14 @@
(s/nilable ::specific-build-tool-version))

(s/def ::build-tool-versions
(s/map-of ::specific-build-tool ::specific-build-tool-version))
(s/with-gen
(s/map-of ::specific-build-tool ::specific-build-tool-version)
;; Build the map by construction rather than via gen/map over the tiny
;; #{"lein" "tools-deps"} key domain, which occasionally targets >2 distinct
;; keys and starves its such-that.
#(gen/fmap (fn [versions] (zipmap specific-build-tools versions))
(gen/vector (s/gen ::specific-build-tool-version)
(count specific-build-tools)))))

(s/def ::maintainers
(s/coll-of ::non-blank-string :distinct true :into #{}))
Expand Down
44 changes: 26 additions & 18 deletions src/docker_clojure/variant.clj
Original file line number Diff line number Diff line change
Expand Up @@ -20,14 +20,17 @@
::variant-base
#(gen/fmap (fn [[v btv]]
(if (= ::core/all (:build-tool v))
(-> v ; ::core/all implies docker tag "latest"
(assoc :build-tool-version nil
:build-tool-versions btv)
(dissoc :distro :docker-tag :base-image-tag :base-image))
;; The ::core/all ("latest") variant carries every build
;; tool's version instead of a single :build-tool-version.
;; (Don't dissoc the required keys — real ::all variants from
;; ->map keep them, and dropping them makes the generated
;; value violate ::variant-base, which starves spec's gensub
;; such-that filter.)
(assoc v :build-tool-version nil
:build-tool-versions btv)
v))
(gen/tuple (s/gen ::variant-base)
(gen/map (s/gen ::cfg/specific-build-tool)
(s/gen ::cfg/specific-build-tool-version))))))
(s/gen ::cfg/build-tool-versions)))))

(s/def ::variants (s/coll-of ::variant))

Expand Down Expand Up @@ -179,17 +182,22 @@
(assoc variant :architecture arch))
cfg/architectures))
variants))
(s/gen (s/coll-of ::variant)))))
;; A handful of base variants is plenty to exercise the
;; merge, and keeping the collection small avoids amplifying
;; the rare per-variant generator starvation across a large
;; collection.
(gen/vector (s/gen ::variant) 0 5))))
:ret (s/coll-of ::manifest-variant)
:fn #(let [ret-count (-> % :ret count)
arg-variants (-> % :args :variants)
;; Examine the return value to see how many unique variants we have
;; after merging all architectures
variant-keys (-> arg-variants first keys set
(disj :architecture))
unique-variants (->> arg-variants
(map (fn [v] (select-keys v variant-keys)))
set count)]
;; We expect to have one merged variant for each unique combination of keys
;; other than architecture
:fn #(let [ret-count (-> % :ret count)
arg-variants (-> % :args :variants)
;; Count the variants that are unique once architecture is
;; ignored. This mirrors `equal-except-architecture?`, which

Copy link
Copy Markdown
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hardening 👌

Just thinking out loud, non-blocking on this PR. This comment got me to checking out equal-except-architecture?, unique-variants, and the old variant-keys.

the domain concept here is "two builds are the same image except for CPU architecture." This equivalence relation is what merge-architectures builds on. But we seem to apply this concept ad hoc, and in two different ways:

  1. production: equal-except-architecture? -> some
  2. test logic: previously with select-keys and now with dissoc

They give the same count but they're not the same definition. Saying they 'mirror' each other isn't quite true.

Might be worth a follow up... a single source of truth for "same image except arch".

;; merges on the whole variant minus :architecture. (Deriving the
;; key set from the first variant breaks for heterogeneous
;; variants, e.g. when an ::all/latest variant — which carries
;; :build-tool-versions — is mixed in with specific ones.)
unique-variants (->> arg-variants
(map (fn [v] (dissoc v :architecture)))
set count)]
;; We expect one merged variant per unique non-architecture variant.
(= ret-count unique-variants)))
Loading