arthur/frontend/test/arthur/domain/zip_test.cljs

(ns arthur.domain.zip-test
  "The container, asserted field by field against the format.

  Same reasoning as `png-test`: the only reader that matters is someone else's,
  so an assertion that the writer agrees with itself is worth nothing. Every
  expectation here is a number the ZIP specification fixes — the four signatures,
  method 0, the offsets in the central directory, the MS-DOS date encoding — and
  the test parses the archive back out of the bytes rather than being handed the
  intermediate values.

  `archive` takes its timestamp as an argument precisely so this file can exist:
  with the clock pinned, the same entries produce the same bytes, and the whole
  archive is comparable."
  (:require [cljs.test :refer [deftest is testing]]
            [arthur.domain.crc32 :as crc32]
            [arthur.domain.zip :as zip]))

(defn- bytes-of [^String s]
  (let [out (js/Uint8Array. (.-length s))]
    (dotimes [i (.-length s)] (aset out i (.charCodeAt s i)))
    out))

(defn- flatten-parts
  "The vector of parts `archive` returns, as one buffer — which is what a `Blob`
  of them would be on disk, and therefore what a reader sees."
  [parts]
  (let [n   (reduce + (map #(.-length ^js %) parts))
        out (js/Uint8Array. n)]
    (reduce (fn [at ^js p] (.set out p at) (+ at (.-length p))) 0 parts)
    out))

(defn- u16 [^js b at]
  (+ (aget b at) (bit-shift-left (aget b (+ at 1)) 8)))

(defn- u32 [^js b at]
  (-> (+ (aget b at)
         (bit-shift-left (aget b (+ at 1)) 8)
         (bit-shift-left (aget b (+ at 2)) 16)
         (* 0x1000000 (aget b (+ at 3))))
      (js/Math.round)))

(defn- ascii-at [^js b at n]
  (apply str (map #(char (aget b (+ at %))) (range n))))

(def ^:private at (js/Date. 2026 8 28 14 30 20))   ; 2026-09-28 14:30:20

(def ^:private entries
  [{:name "take/0001.png" :data (bytes-of "first-frame-bytes")}
   {:name "take/0002.png" :data (bytes-of "second")}
   {:name "take/audio.wav" :data (bytes-of "RIFF....WAVEfmt ")}])

(def ^:private built (delay (flatten-parts (zip/archive entries at))))

(defn- locals
  "Every local file header in the archive, parsed, in the order they appear."
  [^js b]
  (loop [at 0 acc []]
    (if (or (>= (+ at 4) (.-length b)) (not= 0x04034b50 (u32 b at)))
      acc
      (let [n    (u16 b 26)
            nlen (u16 b (+ at 26))
            elen (u16 b (+ at 28))
            size (u32 b (+ at 18))]
        (recur (+ at 30 nlen elen size)
               (conj acc {:offset at
                          :method (u16 b (+ at 8))
                          :time   (u16 b (+ at 10))
                          :date   (u16 b (+ at 12))
                          :crc    (u32 b (+ at 14))
                          :csize  (u32 b (+ at 18))
                          :usize  (u32 b (+ at 22))
                          :name   (ascii-at b (+ at 30) nlen)
                          :data   (.subarray b (+ at 30 nlen elen)
                                             (+ at 30 nlen elen size))})))))
  )

(defn- eocd
  "The end-of-central-directory record, which is the last 22 bytes when there is
  no archive comment."
  [^js b]
  (let [at (- (.-length b) 22)]
    {:signature (u32 b at)
     :entries   (u16 b (+ at 8))
     :dir-size  (u32 b (+ at 12))
     :dir-at    (u32 b (+ at 16))}))

(deftest the-archive-is-readable-as-a-zip
  (let [b (deref built)
        e (eocd b)]
    (testing "end of central directory"
      (is (= 0x06054b50 (:signature e)))
      (is (= 3 (:entries e)) "one record per entry"))
    (testing "the central directory is where the record says it is"
      (is (= 0x02014b50 (u32 b (:dir-at e))))
      (is (= (- (.-length b) 22) (+ (:dir-at e) (:dir-size e)))
          "directory ends exactly where the EOCD begins"))))

(deftest every-entry-is-stored-verbatim
  ;; Method 0, and the two size fields equal — the namespace's whole premise is
  ;; that the payloads are already compressed and must not be touched. A stray
  ;; deflate here would show up as csize != usize.
  (let [ls (locals (deref built))]
    (is (= 3 (count ls)))
    (doseq [[l entry] (map vector ls entries)]
      (is (= 0 (:method l)) (str (:name l) " is stored"))
      (is (= (:name entry) (:name l)))
      (is (= (.-length (:data entry)) (:usize l)) "uncompressed size")
      (is (= (:usize l) (:csize l)) "stored, so the two sizes agree")
      (testing "the bytes come back identical"
        (is (= (vec (array-seq (:data entry))) (vec (array-seq (:data l)))))))))

(deftest every-crc-is-the-crc-of-the-payload
  ;; Written into the local header AND the central directory, and an unzip checks
  ;; both. They have to agree with each other and with the data.
  (let [b  (deref built)
        ls (locals b)
        dir-at (:dir-at (eocd b))]
    (loop [i 0 at dir-at]
      (when (< i (count ls))
        (let [nlen (u16 b (+ at 28))
              l    (nth ls i)]
          (is (= (crc32/of (:data (nth entries i))) (:crc l))
              (str (:name l) " local CRC"))
          (is (= (:crc l) (u32 b (+ at 16)))
              (str (:name l) " central CRC matches local"))
          (testing "and the directory points at the local header"
            (is (= (:offset l) (u32 b (+ at 42)))))
          (recur (inc i) (+ at 46 nlen (u16 b (+ at 30)) (u16 b (+ at 32)))))))))

(deftest the-same-entries-and-clock-give-the-same-bytes
  ;; What makes an export assertable at all, and what `at` is a parameter for.
  (is (= (vec (array-seq (flatten-parts (zip/archive entries at))))
         (vec (array-seq (flatten-parts (zip/archive entries at)))))))

(deftest the-clock-is-the-only-thing-that-moves
  (let [other (js/Date. 2026 8 28 14 30 40)]
    (is (not= (vec (array-seq (flatten-parts (zip/archive entries other))))
              (vec (array-seq (deref built))))
        "a different timestamp must reach the headers")))

(deftest dos-time-is-the-format-s-encoding
  ;; Year offset from 1980, and seconds in 5 bits so they land on even values.
  (let [[date time] (zip/dos-time (js/Date. 2026 8 28 14 30 21))]
    (is (= 2026 (+ 1980 (bit-shift-right date 9))) "year")
    (is (= 9 (bit-and (bit-shift-right date 5) 0xf)) "month is one-based")
    (is (= 28 (bit-and date 0x1f)) "day")
    (is (= 14 (bit-shift-right time 11)) "hour")
    (is (= 30 (bit-and (bit-shift-right time 5) 0x3f)) "minute")
    (is (= 20 (* 2 (bit-and time 0x1f))) "seconds round down to even"))
  (testing "a date before 1980 clamps rather than wrapping into a plausible year"
    (let [[date _] (zip/dos-time (js/Date. 1970 0 1))]
      (is (= 1980 (+ 1980 (bit-shift-right date 9)))))))

(deftest a-non-ascii-name-is-refused
  ;; Rather than written without the UTF-8 flag and arriving mojibake'd.
  (is (thrown? js/Error
               (zip/archive [{:name "také/0001.png" :data (bytes-of "x")}] at))))

(deftest an-empty-archive-is-still-a-valid-zip
  (let [b (flatten-parts (zip/archive [] at))
        e (eocd b)]
    (is (= 22 (.-length b)) "just the EOCD")
    (is (= 0x06054b50 (:signature e)))
    (is (= 0 (:entries e)))))