1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196

#!/bin/sh
#_(
exec "$(dirname "$0")/bb" "$0" "$@"
)

;; Move every jolt-native pin in this tree to a release of it.
;;
;;     scripts/bump-jolt-native.bb            # the latest release
;;     scripts/bump-jolt-native.bb v0.1.3     # a named one
;;
;; A jolt-native bump is four facts in three places: the tag, the URL, the size
;; and the digest of each archive in scripts/*.dotslash, the same URL and digest
;; for the Android archives in nix/android.nix, and the release's commit in
;; deps.edn. Done by hand it is a lot of copying between a browser and a
;; sha256sum, and the failure mode is a pin that still says v0.1.2 while its
;; digest is v0.1.3's — which DotSlash catches, but only on the machine that
;; next fetches it, and which fetchurl catches at build time and no sooner.
;;
;; The two places exist because the two builds fetch differently and neither can
;; read the other's pin: `just lib` and a released-halves run resolve DotSlash
;; manifests, and the APK is a nix derivation, whose inputs have to be fetchurl.
;; The digests are the same bytes either way — DotSlash's `digest` is over the
;; archive, which is what fetchurl hashes too.
;;
;; So: ask GitLab what the release holds, fetch each archive once, weigh it,
;; write the manifests and nix/android.nix back, and put the release's commit in
;; deps.edn — which is what jolt resolves glimmer-vidya from, and so what the
;; boot image compiles against.
;;
;; Nothing here decides whether the new release is a good idea. It only makes
;; the tree say one version instead of two.
(require '[babashka.classpath :as cp])
(cp/add-classpath (str (babashka.fs/parent *file*)))
(require '[frq.paths :as paths]
         '[babashka.fs :as fs]
         '[babashka.process :as p]
         '[cheshire.core :as json]
         '[clojure.string :as str])

(def here (fs/parent (fs/canonicalize *file*)))
(def root (str (fs/parent here)))
(def project "nandithebull%2Fjolt-native")
(def repo "https://gitlab.com/nandithebull/jolt-native")

;; The release, as GitLab has it. `?per_page=1` when no tag is asked for: the
;; list is newest first, and the newest is what "latest" means here — the
;; /releases/permalink/latest endpoint sorts by release date, which is not the
;; same thing once a release is edited.
(defn release [tag]
  (let [url (if tag
              (str "https://gitlab.com/api/v4/projects/" project "/releases/" tag)
              (str "https://gitlab.com/api/v4/projects/" project "/releases?per_page=1"))
        body (json/parse-string (paths/out "curl" "-fsSL" url))]
    (if tag
      body
      (or (first body) (paths/die (str "no releases at all under " repo))))))

;; The manifests this tree pins out of jolt-native. Every DotSlash file beside
;; this script whose providers point at the repo — rather than a list written
;; here, which would be a sixth place to forget.
(defn manifests []
  (->> (fs/glob here "*.dotslash")
       sort
       (keep (fn [file]
               (let [text (slurp (str file))
                     json (json/parse-string (subs text (str/index-of text "{")))]
                 (when (->> (get json "platforms")
                            vals
                            (some #(str/starts-with? (get-in % ["providers" 0 "url"]) repo)))
                   {:file file :text text :json json}))))))

;; The archive an entry names, at the new tag. The URL a manifest carries is the
;; release permalink — /-/releases/<tag>/downloads/<asset> — so the asset's name
;; is its last segment, and the name carries the version too. Both move.
(defn retag [url old new]
  (-> url
      (str/replace (str "/releases/" old "/") (str "/releases/" new "/"))
      (str/replace (str "-" old ".") (str "-" new "."))))

(defn tag-of [url]
  (second (re-find #"/-/releases/([^/]+)/downloads/" url)))

;; Fetch once per distinct URL, then weigh it: DotSlash wants the size and the
;; sha256 of the archive as downloaded, not of anything inside it.
(def weigh
  (memoize
   (fn [dir url]
     (let [file (fs/path dir (last (str/split url #"/")))]
       (println (str "  fetching " (fs/file-name file)))
       (p/shell "curl" "-fsSL" "-o" (str file) url)
       {:size (fs/size file)
        :digest (first (str/split (paths/out "sha256sum" (str file)) #"\s+"))
        :file file}))))

;; What the shim will reach for inside the archive. A release that moved a file
;; leaves a manifest that fetches and verifies and then cannot resolve, which is
;; a worse thing to find out from than this.
(defn check-path! [{:keys [file]} path]
  (let [names (set (str/split-lines (paths/out "tar" "-tzf" (str file))))]
    (when-not (some #(= path (str/replace % #"^\./" "")) names)
      (paths/die (str "no " path " in " (fs/file-name file))
                 "The release moved it; the manifest's `path` needs a hand."))))

;; The JSON back out, in the shape it went in: two-space indentation, a value
;; after each key, and the `//` comment block above it kept — that block is why
;; anyone reading the manifest knows what the object is for.
(def pretty
  (json/create-pretty-printer
   (assoc json/default-pretty-print-options
          :indentation "  "
          :indent-arrays? true
          :object-field-value-separator ": ")))

(defn rewrite [{:keys [file text json]} tmp tag]
  (let [platforms (get json "platforms")
        updated
        (into (array-map)
              (for [[platform entry] platforms
                    :let [url (retag (get-in entry ["providers" 0 "url"]) (tag-of (get-in entry ["providers" 0 "url"])) tag)
                          {:keys [size digest] :as got} (weigh tmp url)]]
                (do
                  (check-path! got (get entry "path"))
                  [platform (-> entry
                                (assoc "size" size "digest" digest)
                                (assoc-in ["providers" 0 "url"] url))])))
        head (subs text 0 (str/index-of text "{"))
        ;; The prose above the JSON names the release too — "from jolt-native's
        ;; v0.1.3 release". Left saying the old one it would be a lie the moment
        ;; this script succeeds.
        head (reduce (fn [h old] (str/replace h old tag))
                     head
                     (distinct (keep #(tag-of (get-in % ["providers" 0 "url"])) (vals platforms))))]
    (spit (str file) (str head (json/generate-string (assoc json "platforms" updated) {:pretty pretty}) "\n"))
    (println (str "  " (fs/file-name file)))))

;; nix/android.nix fetches two of the same archives as `pkgs.fetchurl`, because
;; a derivation cannot resolve a DotSlash manifest: the fetch is the input, and
;; an input has to be a fixed-output derivation with the digest written down.
;; Rewritten as text for the same reason deps.edn is — the file is mostly the
;; comments explaining each step, and there is no round-tripping Nix as data
;; here anyway.
;;
;; Every fetchurl whose url points at the repo, whatever it is called: a third
;; archive appearing in android.nix should move with the other two rather than
;; be remembered about.
(defn bump-nix! [tmp tag]
  (let [file (fs/path root "nix" "android.nix")
        text (slurp (str file))
        ;; url and sha256 as one match, so the pair moves together. Anything
        ;; between them — a comment, another attribute — would not match, and
        ;; not matching is the safe direction: it leaves the pin alone and says
        ;; nothing was written.
        pattern (re-pattern (str "(url\\s*=\\s*\")(" (java.util.regex.Pattern/quote repo)
                                 "[^\"]*)(\";\\s*\n\\s*sha256\\s*=\\s*\")([^\"]*)(\")"))
        seen (atom [])
        updated (str/replace text pattern
                             (fn [[_ head url mid _ tail]]
                               (let [new-url (retag url (tag-of url) tag)
                                     {:keys [digest]} (weigh tmp new-url)]
                                 (swap! seen conj (last (str/split new-url #"/")))
                                 (str head new-url mid digest tail))))]
    (when (empty? @seen)
      (paths/die (str "no fetchurl in " file " points at " repo)))
    (spit (str file) updated)
    (doseq [name @seen] (println (str "  nix/android.nix " name)))))

;; deps.edn takes glimmer-vidya as a git dependency, and the boot image is
;; compiled from the source root jolt resolves that to. Replaced as text rather
;; than round-tripped as EDN: the file is mostly comments explaining why each
;; pin is where it is, and rewriting it as data would throw all of them away.
(defn bump-deps! [commit]
  (let [file (fs/path root "deps.edn")
        text (slurp (str file))
        old (paths/dep-sha root repo)]
    (cond
      (nil? old) (paths/die (str "no dependency on " repo " in deps.edn"))
      (= old commit) (println "  deps.edn already at this commit")
      :else (do (spit (str file) (str/replace text old commit))
                (println (str "  deps.edn " (subs old 0 8) " -> " (subs commit 0 8)))))))

(let [tag (first *command-line-args*)
      rel (release tag)
      tag (get rel "tag_name")
      commit (get-in rel ["commit" "id"])
      files (manifests)
      tmp (fs/create-temp-dir {:prefix "jolt-native-"})]
  (when (empty? files)
    (paths/die (str "no DotSlash manifest in " here " points at " repo)))
  (println (str "jolt-native " tag " (" (subs commit 0 8) ")"))
  (try
    (doseq [m files] (rewrite m tmp tag))
    (finally (fs/delete-tree tmp)))
  (bump-nix! tmp tag)
  (bump-deps! commit)
  (println (str "\nNow: git diff, then `just lib` and `just apk` — the pins are "
                "written, nothing is built.")))