core.clj

(ns docker-clojure.core
  (:require
   [clojure.java.io :as io]
   [clojure.java.shell :refer [sh with-sh-dir]]
   [clojure.math.combinatorics :as combo]
   [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.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)))

(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))

(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-info]]]
  (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 (:version build-tool-info)
                      :maintainer         (str/join " & " cfg/maintainers)}]
    (cond-> base
      true         (assoc :docker-tag (default-docker-tag base))
      variant-arch (assoc :architectures variant-arch))))

(defn pull-image [image]
  (sh "docker" "pull" image))

(defn generate-dockerfile! [variant]
  (let [build-dir (df/build-dir variant)
        filename  "Dockerfile"]
    (log "Generating" (str build-dir "/" filename))
    (df/write-file build-dir filename variant)
    (assoc variant
           :build-dir build-dir
           :dockerfile filename)))

(defn build-image [{: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! 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
  "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]
  (mapcat
   (fn [jdk-version]
     (let [jdk-base-images (get-or-default base-images jdk-version)]
       (mapcat #(combo/cartesian-product #{%}
                                         #{jdk-version}
                                         (get-or-default distros %)
                                         build-tools)
               jdk-base-images)))
   jdk-versions))

(defn image-variants
  [base-images jdk-versions distros build-tools]
  (into []
        (comp
         (map variant-map)
         (remove #(= ::s/invalid (s/conform ::variant %))))
        (image-variant-combinations base-images jdk-versions distros
                                    build-tools)))

(defn rand-delay
  "Runs argument f w/ any supplied args after a random delay of 100-1000 ms"
  [f & args]
  (let [rand-time (+ 100 (rand-int 900))]
    (Thread/sleep rand-time)
    (apply f args)))

(defn build-images
  [parallelization variants]
  (log "Building images" parallelization "at a time")
  (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))
                                     variants-ch))
    (while (<!! builds-ch))))

(defn generate-dockerfiles! [variants]
  (log "Generated" (count variants) "variants")
  (doseq [variant variants]
    (generate-dockerfile! variant)))

(defn valid-variants []
  (remove (partial exclude? cfg/exclusions)
          (image-variants cfg/base-images cfg/jdk-versions cfg/distros
                          cfg/*build-tools*)))

(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
                                        :git-repo      cfg/git-repo}
                                       git-head variants)]
    (log "Writing manifest of" (count variants) "variants to" target-file "...")
    (let [output-writer (if (= :stdout target-file)
                          *out*
                          (io/writer target-file))]
      (.write output-writer manifest)
      (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]
  (let [key-vals       (->> args
                            (map #(if (str/starts-with? % ":")
                                    (edn/read-string %)
                                    %)) ; TODO: Maybe replace this with bb/cli
                            (partition 2))
        variant-filter #(or
                         (empty? key-vals)
                         (every? (fn [[k v]]
                                   (= (get % k) v))
                                 key-vals))]
    (filter variant-filter (valid-variants))))

(defn run
  "Entrypoint for exec-fn."
  [{:keys [cmd args parallelization]}]
  (logger/start)
  (let [variants (generate-variants args)]
    (case cmd
      :clean (df/clean-all)
      :dockerfiles (generate-dockerfiles! variants)
      :manifest (-> variants sort-variants (generate-manifest! args))
      :build-images (build-images parallelization variants)))
  (logger/stop))

(defn -main
  [& cmd-args]
  (let [[cmd & args] cmd-args]
    (run {:cmd             (if cmd (keyword cmd) :build-images)
          :args            args
          :parallelization 4})))