| Take every jolt-native half from the release, and only from there a008d3b nandi 18d ago | 1 | #!/bin/sh |
| 2 | #_( |
| 3 | exec "$(dirname "$0")/bb" "$0" "$@" |
| 4 | ) |
| 5 | |
| 6 | ;; Move every jolt-native pin in this tree to a release of it. |
| 7 | ;; |
| 8 | ;; scripts/bump-jolt-native.bb # the latest release |
| 9 | ;; scripts/bump-jolt-native.bb v0.1.3 # a named one |
| 10 | ;; |
| 11 | ;; A jolt-native bump is four facts in three places: the tag, the URL, the size |
| 12 | ;; and the digest of each archive in scripts/*.dotslash, the release's commit in |
| 13 | ;; deps.edn, and the table buck reads, which is generated from the first. Done |
| 14 | ;; by hand it is a lot of copying between a browser and a sha256sum, and the |
| 15 | ;; failure mode is a manifest that still says v0.1.2 while its digest is v0.1.3's |
| 16 | ;; — which DotSlash catches, but only on the machine that next fetches it. |
| 17 | ;; |
| 18 | ;; So: ask GitLab what the release holds, fetch each archive once, weigh it, |
| 19 | ;; write the manifests back, put the release's commit in deps.edn — which is |
| 20 | ;; what jolt resolves glimmer-vidya from, and so what the boot image compiles |
| 21 | ;; against — and re-run dotslash-to-buck. |
| 22 | ;; |
| 23 | ;; Nothing here decides whether the new release is a good idea. It only makes |
| 24 | ;; the tree say one version instead of two. |
| 25 | (require '[babashka.classpath :as cp]) |
| 26 | (cp/add-classpath (str (babashka.fs/parent *file*))) |
| 27 | (require '[frq.paths :as paths] |
| 28 | '[babashka.fs :as fs] |
| 29 | '[babashka.process :as p] |
| 30 | '[cheshire.core :as json] |
| 31 | '[clojure.string :as str]) |
| 32 | |
| 33 | (def here (fs/parent (fs/canonicalize *file*))) |
| 34 | (def root (str (fs/parent here))) |
| 35 | (def project "nandithebull%2Fjolt-native") |
| 36 | (def repo "https://gitlab.com/nandithebull/jolt-native") |
| 37 | |
| 38 | ;; The release, as GitLab has it. `?per_page=1` when no tag is asked for: the |
| 39 | ;; list is newest first, and the newest is what "latest" means here — the |
| 40 | ;; /releases/permalink/latest endpoint sorts by release date, which is not the |
| 41 | ;; same thing once a release is edited. |
| 42 | (defn release [tag] |
| 43 | (let [url (if tag |
| 44 | (str "https://gitlab.com/api/v4/projects/" project "/releases/" tag) |
| 45 | (str "https://gitlab.com/api/v4/projects/" project "/releases?per_page=1")) |
| 46 | body (json/parse-string (paths/out "curl" "-fsSL" url))] |
| 47 | (if tag |
| 48 | body |
| 49 | (or (first body) (paths/die (str "no releases at all under " repo)))))) |
| 50 | |
| 51 | ;; The manifests this tree pins out of jolt-native. Every DotSlash file beside |
| 52 | ;; this script whose providers point at the repo — rather than a list written |
| 53 | ;; here, which would be a sixth place to forget. |
| 54 | (defn manifests [] |
| 55 | (->> (fs/glob here "*.dotslash") |
| 56 | sort |
| 57 | (keep (fn [file] |
| 58 | (let [text (slurp (str file)) |
| 59 | json (json/parse-string (subs text (str/index-of text "{")))] |
| 60 | (when (->> (get json "platforms") |
| 61 | vals |
| 62 | (some #(str/starts-with? (get-in % ["providers" 0 "url"]) repo))) |
| 63 | {:file file :text text :json json})))))) |
| 64 | |
| 65 | ;; The archive an entry names, at the new tag. The URL a manifest carries is the |
| 66 | ;; release permalink — /-/releases/<tag>/downloads/<asset> — so the asset's name |
| 67 | ;; is its last segment, and the name carries the version too. Both move. |
| 68 | (defn retag [url old new] |
| 69 | (-> url |
| 70 | (str/replace (str "/releases/" old "/") (str "/releases/" new "/")) |
| 71 | (str/replace (str "-" old ".") (str "-" new ".")))) |
| 72 | |
| 73 | (defn tag-of [url] |
| 74 | (second (re-find #"/-/releases/([^/]+)/downloads/" url))) |
| 75 | |
| 76 | ;; Fetch once per distinct URL, then weigh it: DotSlash wants the size and the |
| 77 | ;; sha256 of the archive as downloaded, not of anything inside it. |
| 78 | (def weigh |
| 79 | (memoize |
| 80 | (fn [dir url] |
| 81 | (let [file (fs/path dir (last (str/split url #"/")))] |
| 82 | (println (str " fetching " (fs/file-name file))) |
| 83 | (p/shell "curl" "-fsSL" "-o" (str file) url) |
| 84 | {:size (fs/size file) |
| 85 | :digest (first (str/split (paths/out "sha256sum" (str file)) #"\s+")) |
| 86 | :file file})))) |
| 87 | |
| 88 | ;; What the shim will reach for inside the archive. A release that moved a file |
| 89 | ;; leaves a manifest that fetches and verifies and then cannot resolve, which is |
| 90 | ;; a worse thing to find out from than this. |
| 91 | (defn check-path! [{:keys [file]} path] |
| 92 | (let [names (set (str/split-lines (paths/out "tar" "-tzf" (str file))))] |
| 93 | (when-not (some #(= path (str/replace % #"^\./" "")) names) |
| 94 | (paths/die (str "no " path " in " (fs/file-name file)) |
| 95 | "The release moved it; the manifest's `path` needs a hand.")))) |
| 96 | |
| 97 | ;; The JSON back out, in the shape it went in: two-space indentation, a value |
| 98 | ;; after each key, and the `//` comment block above it kept — that block is why |
| 99 | ;; anyone reading the manifest knows what the object is for. |
| 100 | (def pretty |
| 101 | (json/create-pretty-printer |
| 102 | (assoc json/default-pretty-print-options |
| 103 | :indentation " " |
| 104 | :indent-arrays? true |
| 105 | :object-field-value-separator ": "))) |
| 106 | |
| 107 | (defn rewrite [{:keys [file text json]} tmp tag] |
| 108 | (let [platforms (get json "platforms") |
| 109 | updated |
| 110 | (into (array-map) |
| 111 | (for [[platform entry] platforms |
| 112 | :let [url (retag (get-in entry ["providers" 0 "url"]) (tag-of (get-in entry ["providers" 0 "url"])) tag) |
| 113 | {:keys [size digest] :as got} (weigh tmp url)]] |
| 114 | (do |
| 115 | (check-path! got (get entry "path")) |
| 116 | [platform (-> entry |
| 117 | (assoc "size" size "digest" digest) |
| 118 | (assoc-in ["providers" 0 "url"] url))]))) |
| 119 | head (subs text 0 (str/index-of text "{")) |
| 120 | ;; The prose above the JSON names the release too — "from jolt-native's |
| 121 | ;; v0.1.3 release". Left saying the old one it would be a lie the moment |
| 122 | ;; this script succeeds. |
| 123 | head (reduce (fn [h old] (str/replace h old tag)) |
| 124 | head |
| 125 | (distinct (keep #(tag-of (get-in % ["providers" 0 "url"])) (vals platforms))))] |
| 126 | (spit (str file) (str head (json/generate-string (assoc json "platforms" updated) {:pretty pretty}) "\n")) |
| 127 | (println (str " " (fs/file-name file))))) |
| 128 | |
| 129 | ;; deps.edn takes glimmer-vidya as a git dependency, and the boot image is |
| 130 | ;; compiled from the source root jolt resolves that to. Replaced as text rather |
| 131 | ;; than round-tripped as EDN: the file is mostly comments explaining why each |
| 132 | ;; pin is where it is, and rewriting it as data would throw all of them away. |
| 133 | (defn bump-deps! [commit] |
| 134 | (let [file (fs/path root "deps.edn") |
| 135 | text (slurp (str file)) |
| 136 | old (paths/dep-sha root repo)] |
| 137 | (cond |
| 138 | (nil? old) (paths/die (str "no dependency on " repo " in deps.edn")) |
| 139 | (= old commit) (println " deps.edn already at this commit") |
| 140 | :else (do (spit (str file) (str/replace text old commit)) |
| 141 | (println (str " deps.edn " (subs old 0 8) " -> " (subs commit 0 8))))))) |
| 142 | |
| 143 | (let [tag (first *command-line-args*) |
| 144 | rel (release tag) |
| 145 | tag (get rel "tag_name") |
| 146 | commit (get-in rel ["commit" "id"]) |
| 147 | files (manifests) |
| 148 | tmp (fs/create-temp-dir {:prefix "jolt-native-"})] |
| 149 | (when (empty? files) |
| 150 | (paths/die (str "no DotSlash manifest in " here " points at " repo))) |
| 151 | (println (str "jolt-native " tag " (" (subs commit 0 8) ")")) |
| 152 | (try |
| 153 | (doseq [m files] (rewrite m tmp tag)) |
| 154 | (finally (fs/delete-tree tmp))) |
| 155 | (bump-deps! commit) |
| 156 | (p/shell (str (fs/path here "dotslash-to-buck"))) |
| 157 | (println (str "\nNow: git diff, then `just lib` and `just apk` — the pins are " |
| 158 | "written, nothing is built."))) |