Refactor / reorganize & fix architecture exclusion

Author: cap10morgan

src/docker_clojure/config.clj

@@ -55,14 +55,9 @@
    "debian" #{:debian-slim/bookworm-slim :debian/bookworm
               :debian-slim/bullseye-slim :debian/bullseye}})
 
-(def default-architectures
+(def architectures
   #{"amd64" "arm64v8"})
 
-(def distro-architectures
-  "Map of distro types to architectures it supports if different from
-  default-architectures."
-  {:alpine #{"amd64"}})
-
 (def default-distros
   "The default distro to use for tags that don't specify one, keyed by jdk-version.
   :default is a fallback for jdk versions not o/w specified."
@@ -84,12 +79,13 @@
                  "1.12.0.1530" "2a113e3a4f1005e05f4d6a6dee24ca317b0115cdd7e6ca6155a76f5ffa5ba35b"}})
 
 (def exclusions ; don't build these for whatever reason(s)
-  #{; no more jammy builds for JDK 23+
+  #{;; No more jammy builds for JDK 23+
     {:jdk-version #(>= % 23)
      :distro      :ubuntu/jammy}
-    ;; commented out example
-    #_{:jdk-version 8
-       :distro      :alpine/alpine}})
+    ;; No upstream ARM alpine images available before JDK 21
+    {:jdk-version   #(< % 21)
+     :architecture  "arm64v8"
+     :distro        :alpine/alpine}})
 
 (def maintainers
   ["Paul Lam <[email protected]> (@Quantisan)"

src/docker_clojure/core.clj

@@ -1,158 +1,51 @@
 (ns docker-clojure.core
   (:require
+   [clojure.core.async :refer [<!! chan pipeline-blocking to-chan!] :as async]
+   [clojure.edn :as edn]
    [clojure.java.io :as io]
-   [clojure.java.shell :refer [sh with-sh-dir]]
-   [clojure.math.combinatorics :as combo]
+   [clojure.java.shell :refer [sh]]
    [clojure.spec.alpha :as s]
    [clojure.string :as str]
-   [clojure.core.async :refer [<!! chan to-chan! pipeline-blocking] :as async]
    [docker-clojure.config :as cfg]
+   [docker-clojure.docker :as docker]
    [docker-clojure.dockerfile :as df]
-   [docker-clojure.manifest :as manifest]
-   [docker-clojure.util :refer [get-or-default default-docker-tag
-                                full-docker-tag]]
    [docker-clojure.log :refer [log] :as logger]
-   [clojure.edn :as edn]))
-
-(defn exclude-variant?
-  "Returns true if the map `variant` contains every key-value pair in the map
-  `exclusion`. `variant` may contain additional keys that are not in
-  `exclusion`. Some values of `exclusion` can also be a predicate of one
-  argument which is then tested against the respective value from `variant`.
-  Returns false if any of the keys in `exclusions` are missing from `variant` or
-  have different values, or the predicate value returned false."
-  [variant exclusion]
-  (every? (fn [[k v]]
-            (if (fn? v)
-              (v (get variant k))
-              (= v (get variant k))))
-          exclusion))
-
-(defn base-image-tag
-  [base-image jdk-version distro]
-  (str base-image ":"
-       (case base-image
-         "eclipse-temurin" (str jdk-version "-jdk-")
-         "debian" ""
-         "-")
-       (name distro)))
+   [docker-clojure.manifest :as manifest]
+   [docker-clojure.util :refer [get-or-default]]
+   [docker-clojure.variant :as variant]))
 
 (defn exclude?
   "Returns true if `variant` matches one of `exclusions` elements (meaning
   `(contains-every-key-value? variant exclusion)` returns true)."
   [exclusions variant]
-  (some (partial exclude-variant? variant) exclusions))
+  (some (partial variant/exclude? variant) exclusions))
 
 (s/def ::variant
   (s/keys :req-un [::cfg/jdk-version ::cfg/base-image ::cfg/base-image-tag
                    ::cfg/distro ::cfg/build-tool ::cfg/build-tool-version
                    ::cfg/maintainer ::cfg/docker-tag]
-          :opt-un [::cfg/build-tool-versions ::cfg/architectures]))
-
-(defn assoc-if
-  [m pred k v]
-  (if (pred)
-    (assoc m k v)
-    m))
-
-(defn variant-map [[base-image jdk-version distro
-                    [build-tool build-tool-version]]]
-  (let [variant-arch (get cfg/distro-architectures
-                          (-> distro namespace keyword))
-        base         {:jdk-version        jdk-version
-                      :base-image         base-image
-                      :base-image-tag     (base-image-tag base-image
-                                                          jdk-version distro)
-                      :distro             distro
-                      :build-tool         build-tool
-                      :build-tool-version build-tool-version
-                      :maintainer         (str/join " & " cfg/maintainers)}]
-    (-> base
-        (assoc :docker-tag (default-docker-tag base))
-        (assoc-if #(nil? (:build-tool-version base)) :build-tool-versions
-                  cfg/build-tools)
-        (assoc-if #(seq variant-arch) :architectures variant-arch))))
-
-(defn pull-image [image]
-  (sh "docker" "pull" image))
+          :opt-un [::cfg/build-tool-versions ::cfg/architecture]))
 
-(defn generate-dockerfile! [installer-hashes variant]
-  (let [build-dir (df/build-dir variant)
-        filename  "Dockerfile"]
-    (log "Generating" (str build-dir "/" filename))
-    (df/write-file build-dir filename installer-hashes variant)
-    (assoc variant
-      :build-dir build-dir
-      :dockerfile filename)))
-
-(defn build-image
-  [installer-hashes {:keys [docker-tag base-image architectures] :as variant}]
-  (let [image-tag     (str "clojure:" docker-tag)
-        _             (log "Pulling base image" base-image)
-        _             (pull-image base-image)
-
-        {:keys [dockerfile build-dir]}
-        (generate-dockerfile! installer-hashes variant)
-
-        host-arch     (let [jvm-arch (System/getProperty "os.arch")]
-                        (if (= "aarch64" jvm-arch)
-                          "arm64v8"
-                          jvm-arch))
-        platform-flag (if (contains? (or architectures
-                                         cfg/default-architectures)
-                                     host-arch)
-                        nil
-                        (str "--platform=linux/" (first architectures)))
-
-        build-cmd     (remove nil? ["docker" "buildx" "build" "--no-cache"
-                                    "-t" image-tag platform-flag "--load"
-                                    "-f" dockerfile "."])]
-    (apply log "Running" build-cmd)
-    (let [{:keys [out err exit]}
-          (with-sh-dir build-dir (apply sh build-cmd))]
-      (if (zero? exit)
-        (log "Succeeded building" (str "clojure:" docker-tag))
-        (log "ERROR building" (str "clojure:" docker-tag ":") err out))))
-  (log)
-  [::done variant])
-
-(def latest-variant
+(def latest-variants
   "The latest variant is special because we include all 3 build tools via the
   [::all] value on the end."
-  (list (-> cfg/base-images :default first)
-        cfg/default-jdk-version
-        (get-or-default cfg/default-distros cfg/default-jdk-version)
-        [::all]))
-
-(defn image-variant-combinations
-  [base-images jdk-versions distros build-tools]
-  (reduce
-   (fn [variants jdk-version]
-     (concat
-      variants
-      (let [jdk-base-images (get-or-default base-images jdk-version)]
-        (loop [[bi & r] jdk-base-images
-               acc #{}]
-          (let [vs   (combo/cartesian-product #{bi}
-                                              #{jdk-version}
-                                              (get-or-default distros bi)
-                                              build-tools)
-                acc' (concat acc vs)]
-            (if (seq r)
-              (recur r acc')
-              acc'))))))
-   #{} jdk-versions))
+  (for [arch cfg/architectures]
+    (list (-> cfg/base-images :default first)
+          cfg/default-jdk-version
+          (get-or-default cfg/default-distros cfg/default-jdk-version)
+          [::all]
+          arch)))
 
 (defn image-variants
-  [base-images jdk-versions distros build-tools]
+  [base-images jdk-versions distros build-tools architectures]
   (into #{}
         (comp
-         (map variant-map)
+         (map variant/->map)
          (remove #(= ::s/invalid (s/conform ::variant %))))
-        (conj
-         (image-variant-combinations base-images jdk-versions distros
-                                     build-tools)
-         latest-variant)))
+        (concat
+         (variant/combinations base-images jdk-versions distros build-tools
+                               architectures)
+         latest-variants)))
 
 (defn rand-delay
   "Runs argument f w/ any supplied args after a random delay of 100-1000 ms"
@@ -164,31 +57,31 @@
 (defn build-images
   [parallelization installer-hashes variants]
   (log "Building images" parallelization "at a time")
-  (let [variants-ch   (to-chan! variants)
-        builds-ch     (chan parallelization)]
+  (let [variants-ch (to-chan! variants)
+        builds-ch   (chan parallelization)]
     ;; Kick off builds with a random delay so we don't have Docker race
     ;; conditions (e.g. build container name collisions)
     (async/thread (pipeline-blocking parallelization builds-ch
-                                     (map (partial rand-delay build-image
+                                     (map (partial rand-delay docker/build-image
                                                    installer-hashes))
                                      variants-ch))
     (while (<!! builds-ch))))
 
 (defn generate-dockerfiles! [installer-hashes variants]
   (log "Generated" (count variants) "variants")
   (doseq [variant variants]
-    (generate-dockerfile! installer-hashes variant)))
+    (df/generate! installer-hashes variant)))
 
 (defn valid-variants []
   (remove (partial exclude? cfg/exclusions)
           (image-variants cfg/base-images cfg/jdk-versions cfg/distros
-                          cfg/build-tools)))
+                          cfg/build-tools cfg/architectures)))
 
 (defn generate-manifest! [variants args]
   (let [git-head    (->> ["git" "rev-parse" "HEAD"] (apply sh) :out)
         target-file (or (first args) :stdout)
         manifest    (manifest/generate {:maintainers   cfg/maintainers
-                                        :architectures cfg/default-architectures
+                                        :architectures cfg/architectures
                                         :git-repo      cfg/git-repo}
                                        git-head variants)]
     (log "Writing manifest of" (count variants) "variants to" target-file "...")
@@ -199,24 +92,6 @@
       (when (not= :stdout target-file)
         (.close output-writer)))))
 
-(defn sort-variants
-  [variants]
-  (sort
-   (fn [v1 v2]
-     (cond
-       (= "latest" (:docker-tag v1)) -1
-       (= "latest" (:docker-tag v2)) 1
-       :else (let [c (compare (:jdk-version v1) (:jdk-version v2))]
-               (if (not= c 0)
-                 c
-                 (let [c (compare (full-docker-tag v1) (full-docker-tag v2))]
-                   (if (not= c 0)
-                     c
-                     (throw
-                      (ex-info "No two variants should have the same full Docker tag"
-                               {:v1 v1, :v2 v2}))))))))
-   variants))
-
 (defn generate-variants
   [args]
   ; TODO: Maybe replace this with bb/cli
@@ -247,7 +122,7 @@
     (case cmd
       :clean (df/clean-all)
       :dockerfiles (generate-dockerfiles! cfg/installer-hashes variants)
-      :manifest (-> variants sort-variants (generate-manifest! args))
+      :manifest (generate-manifest! variants args)
       :build-images (build-images parallelization cfg/installer-hashes variants)))
   (logger/stop))