Serve the document from a Django backend, split into three tiers

Step 9. The tier split was the work; Django was the easy half.

Tier 1 — the authored scene — is the document, and it is addressed as
independently versioned leaves rather than saved whole, so one vertex drag
cannot clobber a collaborator's keying. `domain/leaf` is the document as
path -> value; `domain/wire` puts it on the wire as transit, because JSON
has neither integer map keys nor keywords and a save would quietly turn
`{0 v}` into `{"0" v}`.

Tier 2 — the dense channel blocks — is content-addressed by a hash over
every input, with the detector version inside every key through the
analysis the block descriptor names. `flow/address`'s `block-knobs` is the
invalidation table, and `address-test` does not trust it: it re-freezes the
take once per knob and asserts the biconditional, that a block's bytes
changed if and only if its key changed. That found `brow-pos` not depending
on `contour-avg` — the brow ring is smoothed, the raise is not.

Tier 3 — frames and audio — is served by the hash of its bytes out of the
same store. A manifest now names frames and carries a URL for each, so the
frame layout stopped being a shared secret between a shell script and a
ClojureScript namespace, and the `?v=` cache-buster went with it: a blob's
name is the hash of its contents, so a stale copy is not a thing that can
happen. The synthetic take's `audio.wav` moved to `static/arthur/` — an
asset the project owns, not an extraction that churns.

The server verifies rather than trusting a name it was handed: it
recomputes every key from the descriptor stored beside it, refuses an
analysis that declares no detector version, and refuses a document naming
blocks it does not hold. It hashes the descriptor TEXT, because JS prints
an integral double as `1` and Python as `1.0`, and a scheme where both ends
re-render the numbers disagrees on the first parameter that happens to be
whole.

Two loose ends from step 8 closed on the way. `pack` no longer takes a
`(track, frame)` predicate whose call sites each re-derived a feature from
an index — every track names the feature it follows, which deleted five
hand-maintained mappings. And `:dev-http` is gone: Django serves the page,
shadow-cljs only builds into the staticfiles tree.

227 CLJS tests, 31 Django tests, green.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Olive Vaughn 2026-09-28 01:11:41 -04:00
parent b6517f837a
commit 9cd5243983
61 changed files with 4694 additions and 269 deletions

View file

@ -4,8 +4,9 @@
port-plan step 3: the hand-written scene plays at 30fps against audio, scrubs,
and runs at ½× and ¼×."
(:require [arthur.db :as db]
[arthur.events.footage]
[arthur.events.footage :as footage]
[arthur.events.playback]
[arthur.events.project]
[arthur.subs.playback]
[arthur.subs.render]
[arthur.ui.player :as player]
@ -26,6 +27,10 @@
(defn init []
(rf/dispatch-sync [::init])
;; What the server already holds, asked for once. The list is small — a row per
;; ingested take — and having it before the first click is what lets the footage
;; picker be a picker rather than a path to type.
(rf/dispatch [::footage/refresh])
(reset! root (rdc/create-root (js/document.getElementById "app")))
(mount)
(player/start!))

View file

@ -22,8 +22,14 @@
frame space, not a rate and not a size — and they sit on the scene map only
because there is one clip per scene today. Copying them by hand into this table
is how one of them comes to disagree with the scene it describes."
[label scene store]
(merge {:label label :scene scene :store store :audio "/audio.wav"
[label-key label scene store]
(merge {:label label :scene scene :store store
;; A static asset since step 9, and not the repo root's `audio.wav`.
;; That file is `extract.sh`'s output — tier 3, which the backend now
;; serves by hash — and the synthetic take needs a sound of its own so
;; that the clock has something to run against with no footage ingested.
:audio "/static/arthur/audio.wav"
:cid (name label-key)
:display-fps (:fps scene)}
(select-keys scene [:fps :frames :width :height])))
@ -35,10 +41,10 @@
`:head` written as a dense track in one and as framed identity in the other, so
the button that switches between them switches a document field and nothing
else."
{:demo (clip "demo" demo/scene nil)
:swarm (clip "swarm" @swarm/scene @swarm/store)
:take (clip "take" @take/scene @take/store)
:take-locked (clip "locked" @take/locked @take/store)})
{:demo (clip :demo "demo" demo/scene nil)
:swarm (clip :swarm "swarm" @swarm/scene @swarm/store)
:take (clip :take "take" @take/scene @take/store)
:take-locked (clip :take-locked "locked" @take/locked @take/store)})
(def default
{;; --- the document ---
@ -53,8 +59,16 @@
;; size — and it is why ui/player no longer hardcodes 320x200.
:clip (select-keys (:take scenes) [:fps :frames :width :height :audio :display-fps])
;; Which ingested footage to detect, and what the last load said. The list
;; comes from the server — tier 3 is the backend's since step 9 — so there is
;; no path to type any more.
:footage {:id nil :label nil :loading? false :status nil
:manifest-path "/manifest.json"}
:available [] :chosen nil}
;; The document's own identity on the server. `:seq` is the monotonic project
;; version: a client that sees a delta with `seq > local + 1` refetches, which
;; is what will make staleness self-healing once there is a broadcast to miss.
:project {:id nil :cid nil :name nil :seq nil :busy? false :status nil}
;; --- transport ---
;;

View file

@ -26,7 +26,8 @@
written two ways. That is the claim \"stabilisation is a channel, not a mode\"
made checkable by eye: switching between them is a document edit, tier 1, and
not one byte of tier 2 differs."
(:require [arthur.flow.freeze :as freeze]
(:require [arthur.flow.address :as address]
[arthur.flow.freeze :as freeze]
[arthur.flow.take :as take]
[arthur.synth :as synth]))
@ -74,9 +75,16 @@
;; The head as filmed. `:take-locked` is the same freeze with this one
;; field changed, which is the point.
:head :as-filmed
;; Provenance. A content hash once the analysis is an artifact the
;; backend stores; until then, honest about what it actually is.
:analysis "synth:mulberry32/seed-1"}))
;; Provenance, and now a content address. There is no detector here, so
;; the generator IS the detector and its seed is the source: two synth
;; takes at different seeds are different analyses, which is the same
;; statement content addressing makes about two model versions.
:analysis (address/analysis {:detector "synth"
:version "mulberry32"
:seed 1
:frames frames
:fps fps
:aspect aspect})}))
(def frozen
(delay (freeze/clip params @measured)))

View file

@ -0,0 +1,77 @@
(ns arthur.domain.canon
"One canonical text for a map, so that hashing it means something.
A content address is a hash of a DESCRIPTION of every input, and a description
only addresses anything if the same inputs always write the same bytes. A CLJS
map has no key order, `pr-str` will happily print `{:a 1 :b 2}` in either order
between runs, and JSON has no canonical form of its own. So this is the one
place that decides.
The text is VALID JSON, deliberately. The server stores it beside the key and
verifies `sha256(descriptor) == key` (clips/views.py), and it also has to read
two fields out of it to enforce that a detector version was declared at all.
Hashing the text the client sent, rather than recomputing it from parsed
values, is what keeps that check free of a cross-language float-formatting
agreement nobody could hold: Python writes `1.0` where JS writes `1`, and a
scheme where both sides re-render the numbers would break on the first integral
double. The bytes are the contract; the schema on top of them is a convention.
It is also meant to be READ. A stale bake presents as a picture that will not
update, and the descriptor is the only thing that can say which input moved, so
it is short, flat where it can be, and never has a 229-frame mask inlined —
see `arthur.flow.address`, which digests masks before they reach here.
Three refusals, all of them cases where a canonical text is not possible or
the key would be ambiguous:
A KEYWORD VALUE. Keys are keywords and become their names, because a key is
a name and nothing else. A keyword VALUE is refused instead of being named,
because then `:mouth` and \"mouth\" would hash alike, and the server would be
reading a field whose type depended on the caller's mood. Callers convert at
the boundary, which is also what makes the stored JSON clean.
A SET. Unordered, so there is no one text for it. Sort it into a vector at
the call site, where it is obvious which order was meant.
NaN OR INFINITY. Neither is JSON, and both mean a measurement went wrong
upstream of here — silently addressing it would cache the mistake."
(:require [clojure.string :as str]))
(defn- number->text [x]
(when-not (js/Number.isFinite x)
(throw (ex-info "a descriptor cannot hold NaN or infinity" {:value x})))
;; `(str 1.0)` is "1" and `(str 0.12)` is "0.12": JS prints the shortest decimal
;; that round-trips, so this is stable without a format string.
(str x))
(defn- key->text [k]
(cond
(keyword? k) (subs (str k) 1) ; :a -> "a", :roto/b -> "roto/b"
(string? k) k
:else (throw (ex-info "a descriptor key is a keyword or a string"
{:key k :type (type k)}))))
(declare write)
(defn- write-map [m]
(str "{"
(str/join "," (map (fn [[k v]] (str (js/JSON.stringify (key->text k)) ":" (write v)))
(sort-by (comp key->text key) (seq m))))
"}"))
(defn write
"The canonical JSON text of a descriptor value."
[v]
(cond
(nil? v) "null"
(true? v) "true"
(false? v) "false"
(number? v) (number->text v)
(string? v) (js/JSON.stringify v)
(map? v) (write-map v)
(set? v) (throw (ex-info "a descriptor cannot hold a set: sort it into a vector where the order is visible"
{:value v}))
(keyword? v) (throw (ex-info "a descriptor cannot hold a keyword VALUE: name it at the call site, so \"mouth\" and :mouth cannot address the same block"
{:value v}))
(sequential? v) (str "[" (str/join "," (map write v)) "]")
:else (throw (ex-info "not a descriptor value" {:value v :type (type v)}))))

View file

@ -0,0 +1,183 @@
(ns arthur.domain.leaf
"Leaf addressing for tier 1: the document as a map of PATH -> value.
This is the shape docs/architecture.md's sync design needs, built now so that
there is nothing to retrofit later. Multiplayer is out of this step's scope and
the addressing is not, because the addressing is the part that cannot be added
afterwards: it decides what a write is, and therefore what two people can do at
once.
clip/<cid>/name a label
clip/<cid>/timing fps, frames
clip/<cid>/stage width, height
clip/<cid>/source the analysis record this came out of
clip/<cid>/subject/<sid> a tracked subject and its params
clip/<cid>/feature/<fid> one feature: area, nodes, params
clip/<cid>/group/<gid> an eye pair and its shared params
clip/<cid>/node/<nid> one node: kind, parent, stencil, z, time
clip/<cid>/channel/<nid>/<prop> one channel
clip/<cid>/measured/<nid> the measured channels a re-freeze owns
WHY THESE BOUNDARIES. Last-writer-wins only clobbers when its unit is too big,
so the cut is chosen so that the things people do simultaneously land on
different leaves. Every node has its own leaf, because two people adding nodes
would otherwise collide always. Every channel has its own, because keying the
mouth and keying a brow are the same size of edit as each other and nothing
like the same edit. With fractional `:z` there is no separate draw-order leaf to
contend on, which is the second thing fractional indices buy.
WHY PARAMS ARE NOT SPLIT BY AREA. docs/architecture.md's list has
`clip/:cid/params/:area`, from a draft where params were one blob per clip and
two people tuning teeth and eyes collided on every slider move. Step 8 moved
settings onto the subject, the feature and the group, and a FEATURE HAS EXACTLY
ONE AREA — so the feature leaf already is the area-scoped leaf, and splitting it
again would only separate a feature's params from the feature's identity.
WHY `measured` IS ONE LEAF AND CHANNELS ARE NOT. `:head`'s measured channels are
not authored: they are written together by a freeze and replaced together by a
re-freeze, and `head-mode` reads them to write `:channels`. A leaf per measured
channel would offer a write nobody can make. The authored channels beside them
are one leaf each, because a hand writes one at a time.
A LEAF PATH IS \"/\"-DELIMITED and an id is one segment of it, so a namespaced id
— docs/architecture.md draws one as `:eye-r/iris` — is written `eye-r~iris`.
`~` is then refused inside a name, which is the whole of the escaping and is why
it is one character rather than a scheme."
(:require [arthur.domain.sha256 :as sha]
[clojure.string :as str]))
;; ---------------------------------------------------------------------------
;; ids and paths
(defn segment
"An id -> one path segment."
[id]
(let [s (if (keyword? id) (subs (str id) 1) (str id))]
(when (str/includes? s "~")
(throw (ex-info "an id cannot contain ~: it is the namespace separator inside a leaf path"
{:id id})))
(str/replace s "/" "~")))
(defn unsegment
"One path segment -> the id it names."
[s]
(keyword (str/replace s "~" "/")))
(defn- prop->path
"A channel's property vector -> one path segment. `[:geom :pts]` is \"geom.pts\"
and `[:vis]` is \"vis\"."
[prop]
(let [parts (map #(subs (str %) 1) prop)]
(doseq [p parts]
(when (or (str/includes? p ".") (str/includes? p "/"))
(throw (ex-info "a channel property cannot contain . or /: both are path punctuation"
{:prop prop}))))
(str/join "." parts)))
(defn- path->prop [s]
(mapv keyword (str/split s #"\.")))
;; ---------------------------------------------------------------------------
;; the split
(def scene-keys
"Every top-level field of a scene, and the reason `leaves` refuses one it does
not know: a field added to the scene without a leaf is a field that saves
silently and comes back missing. The failure is a document that loses something
on every round trip, which is the one bug a persistence layer must not be able
to have. Add the field here and to `leaves` and `scene` in the same commit."
#{:name :frames :fps :analysis :subjects :features :groups :width :height :nodes})
(def ^:private node-channel-keys #{:channels :measured})
(defn leaves
"One clip's scene -> path -> value.
A leaf whose value would be empty is OMITTED rather than written as `{}`, and
that is what makes the round trip exact: the demo scene has no `:fps` and the
root node has no `:channels`, and a codec that invented them would hand back a
scene that is not `=` to the one it was given."
[cid scene]
(let [unknown (remove scene-keys (keys scene))]
(when (seq unknown)
(throw (ex-info "the scene has a field with no leaf to save it in; see arthur.domain.leaf/scene-keys"
{:unknown (vec (sort-by str unknown))}))))
(let [at (fn [& parts] (str/join "/" (into ["clip" (segment cid)] parts)))
some-leaf (fn [path v] (when (seq v) {path v}))]
(apply merge
(some-leaf (at "name") (select-keys scene [:name]))
(some-leaf (at "timing") (select-keys scene [:fps :frames]))
(some-leaf (at "stage") (select-keys scene [:width :height]))
(some-leaf (at "source") (:analysis scene))
(concat
(for [[id v] (:subjects scene)] {(at "subject" (segment id)) v})
(for [[id v] (:features scene)] {(at "feature" (segment id)) v})
(for [[id v] (:groups scene)] {(at "group" (segment id)) v})
(for [[id n] (:nodes scene)] {(at "node" (segment id))
(apply dissoc n node-channel-keys)})
(for [[id n] (:nodes scene)
:when (seq (:measured n))] {(at "measured" (segment id)) (:measured n)})
(for [[id n] (:nodes scene)
[prop ch] (:channels n)]
{(at "channel" (segment id) (prop->path prop)) ch})))))
(defn scene
"The inverse of `leaves`, for one clip. Paths belonging to another clip are
ignored, so a project's whole leaf map can be handed straight in."
[cid leaves]
(let [want (segment cid)]
(reduce
(fn [acc [path v]]
(let [[kind a b] (drop 2 (str/split path #"/"))]
(if-not (= want (second (str/split path #"/")))
acc
(case kind
"name" (merge acc v)
"timing" (merge acc v)
"stage" (merge acc v)
"source" (assoc acc :analysis v)
"subject" (assoc-in acc [:subjects (unsegment a)] v)
"feature" (assoc-in acc [:features (unsegment a)] v)
"group" (assoc-in acc [:groups (unsegment a)] v)
"node" (update-in acc [:nodes (unsegment a)] merge v)
"measured" (assoc-in acc [:nodes (unsegment a) :measured] v)
"channel" (assoc-in acc [:nodes (unsegment a) :channels (path->prop b)] v)
(throw (ex-info "not a leaf path" {:path path}))))))
{}
;; Sorted, so `node` lands before `channel` and `measured` under one id and
;; the node map is merged INTO rather than over. `update-in ... merge` makes
;; the order not matter; sorting makes it not matter for a reason.
(sort-by key leaves))))
;; ---------------------------------------------------------------------------
(defn problems
"Human-readable reasons this leaf map is not a document. Empty means it is one.
The dense check is the tier discipline, stated where a save can enforce it: a
document that named `\"take/geom\"` would be a document that only means anything
on the machine that produced it, and the whole point of tier 2 being
content-addressed is that it does not have to travel with tier 1 to be found."
[leaves]
(let [nodes (into #{} (keep (fn [path]
(let [[_ cid kind id] (str/split path #"/")]
(when (= "node" kind) [cid id]))))
(keys leaves))]
(vec
(concat
(for [[path v] (sort-by key leaves)
:let [[root cid kind id prop] (str/split path #"/")]
:when (or (not= "clip" root) (nil? cid)
(not (#{"name" "timing" "stage" "source" "subject" "feature"
"group" "node" "channel" "measured"} kind)))]
(str (pr-str path) " is not a leaf path"))
(for [[path _] (sort-by key leaves)
:let [[_ cid kind id] (str/split path #"/")]
:when (and (#{"channel" "measured"} kind) (not (contains? nodes [cid id])))]
(str (pr-str path) " addresses a node with no node leaf"))
(for [[path v] (sort-by key leaves)
:let [[_ _ kind] (str/split path #"/")]
:when (and (= "channel" kind) (:dense v)
(not (sha/key? (:store (:dense v)))))]
(str (pr-str path) " names tier 2 as " (pr-str (:store (:dense v)))
" — a dense channel in a saved document names a content address"))))))

View file

@ -0,0 +1,100 @@
(ns arthur.domain.project
"A clip <-> the document that travels. The tier split, as a pair of functions.
`save` takes what `flow/freeze` produced — `{:scene ... :store ...}` — and
returns two things that are allowed on the wire for different reasons:
:leaves TIER 1. The document. Nodes, channels, subjects, features, groups,
time maps, the analysis record. Kilobytes, and every byte of it
authored or authorable.
:blocks TIER 2. The dense blocks the document NAMES, each with the
descriptor its key is the hash of. Megabytes, content-addressed,
and not part of the document — a bake inside the shared document is
a system that puts 48KB on the wire per vertex drag.
ONLY WHAT THE DOCUMENT NAMES TRAVELS. The blocks are selected by walking the
leaves for dense store keys, not by taking the store wholesale, so a store that
has accumulated a block nothing points at does not upload it. That is also the
check that the split is honest: if a channel named a block the store did not
have, `save` would say so here rather than producing a document that loads into
a blank stage somewhere else.
THE BYTES ARE NOT IN THE DOCUMENT AND THE TYPE IS NOT IN THE BYTES. A block's
element type comes out of its own descriptor, which is the only place it is
written down: an Int16Array and a Float32Array over the same bytes are both
valid readings of them, and only one is the block. That makes the descriptor
load-bearing rather than documentation, which is the right way round for the
thing a key is the hash of."
(:require [arthur.domain.leaf :as leaf]
[arthur.domain.wire :as wire]))
(defn block-keys
"Every tier-2 key a leaf map names, in a stable order."
[leaves]
(->> (vals leaves)
(keep (comp :store :dense))
distinct
sort
vec))
(defn- block-type
"A block's element type, out of its descriptor."
[descriptor]
(or (get-in (js->clj (js/JSON.parse descriptor)) ["layout" "type"])
(throw (ex-info "a block's descriptor does not say what its elements are"
{:descriptor descriptor}))))
(defn save
"One clip -> the JS object a save PUTs, ready for `JSON.stringify`.
A JS object rather than CLJS data, and `load` takes one back, because this is
the wire boundary and both ends of it should speak the wire: a test can then
round-trip a clip through `JSON.parse(JSON.stringify(...))` and be running the
same conversion the network runs, rather than a CLJS-shaped rehearsal of it. The
one thing a keywordising `js->clj` would quietly break is the leaf paths —
`:clip/c1/node/mouth` is a keyword whose `name` is \"c1/node/mouth\", so the
\"clip/\" would be lost on the way back in.
Refuses a document `domain/leaf` calls unaddressable, which is where a hand-made
scene with placeholder store keys — `demo/swarm`'s \"swarm/pos\" — stops rather
than being uploaded as a project that means something only on the machine that
made it."
[cid {:keys [scene store]}]
(let [leaves (leaf/leaves cid scene)
ps (leaf/problems leaves)]
(when (seq ps)
(throw (ex-info (str "this clip cannot be saved: " (first ps))
{:problems ps})))
(let [out (js-obj)]
(doseq [[path v] leaves]
(aset out path (wire/encode-json v)))
#js {:leaves out
:blocks (into-array
(map (fn [k]
(let [{:keys [data state descriptor]}
(or (get store k)
(throw (ex-info "the document names a block the store does not have"
{:key k})))]
#js {:key k
:descriptor descriptor
:data (wire/base64 data)
:state (when state (wire/base64 state))}))
(block-keys leaves)))})))
(defn load
"The parsed response -> `{:scene :store}`, which is what `flow/freeze` returns
and therefore what the player already knows how to play."
[cid ^js doc]
(let [leaves (.-leaves doc)
tier1 (into {} (map (fn [path] [path (wire/decode-json (aget leaves path))]))
(js-keys leaves))]
{:scene (leaf/scene cid tier1)
:store (into {}
(map (fn [^js b]
[(.-key b)
(cond-> {:descriptor (.-descriptor b)
:data (wire/typed (block-type (.-descriptor b))
(.-data b))}
(.-state b) (assoc :state (wire/bytes-of (.-state b))))]))
(array-seq (or (.-blocks doc) #js [])))}))

View file

@ -0,0 +1,148 @@
(ns arthur.domain.sha256
"SHA-256, synchronous, in pure ClojureScript.
WHY NOT `crypto.subtle`. It is async, and every caller here is a pure function
in the `(f params inputs) -> output` shape: a content address is computed in the
middle of `flow/freeze`, inside a `let`, and a promise there would turn the
whole stage inside out. `crypto.createHash` exists in node and not in the
browser, which is worse — the tests would be hashing with a different
implementation from the app.
WHY NOT A DEPENDENCY. It is sixty lines, it never changes, and the thing it has
to agree with is not another JS library: it is Python's `hashlib`. The server
recomputes the key of every block and every analysis it is handed and refuses a
mismatch (see clips/views.py), so a disagreement between the two languages is
not a hash that looks different — it is an upload that 409s with nothing wrong.
`sha256-test` therefore pins the digests that `hashlib` produced, including the
55/56/63/64 and 119/120-byte cases either side of both padding boundaries,
which is where a hand-written implementation is wrong if it is wrong at all.
SIGN. JS bitwise operators work on 32-bit SIGNED integers, so `bit-xor` and
`bit-shift-left` hand back negative numbers, and a negative number entering an
addition mod 2^32 is off by 2^32. Every intermediate that feeds an addition is
therefore normalised through `u32`. That is the bug this implementation would
have, and it is invisible on short inputs — `\"abc\"` passes with the sign bug in
place on some rounds — which is the other reason the vectors above are pinned."
(:require [clojure.string :as str]))
(def ^:private round-k
(js/Uint32Array.
#js [0x428a2f98 0x71374491 0xb5c0fbcf 0xe9b5dba5 0x3956c25b 0x59f111f1
0x923f82a4 0xab1c5ed5 0xd807aa98 0x12835b01 0x243185be 0x550c7dc3
0x72be5d74 0x80deb1fe 0x9bdc06a7 0xc19bf174 0xe49b69c1 0xefbe4786
0x0fc19dc6 0x240ca1cc 0x2de92c6f 0x4a7484aa 0x5cb0a9dc 0x76f988da
0x983e5152 0xa831c66d 0xb00327c8 0xbf597fc7 0xc6e00bf3 0xd5a79147
0x06ca6351 0x14292967 0x27b70a85 0x2e1b2138 0x4d2c6dfc 0x53380d13
0x650a7354 0x766a0abb 0x81c2c92e 0x92722c85 0xa2bfe8a1 0xa81a664b
0xc24b8b70 0xc76c51a3 0xd192e819 0xd6990624 0xf40e3585 0x106aa070
0x19a4c116 0x1e376c08 0x2748774c 0x34b0bcb5 0x391c0cb3 0x4ed8aa4a
0x5b9cca4f 0x682e6ff3 0x748f82ee 0x78a5636f 0x84c87814 0x8cc70208
0x90befffa 0xa4506ceb 0xbef9a3f7 0xc67178f2]))
(defn- u32 [x] (unsigned-bit-shift-right x 0))
(defn- rotr [x n]
(u32 (bit-or (unsigned-bit-shift-right x n) (bit-shift-left x (- 32 n)))))
(defn- pad
"The message, padded: a 0x80 byte, zeros, and the bit length as a big-endian
64-bit integer. The length is written as two 32-bit halves because a JS number
cannot hold a 64-bit integer and nothing here will ever hash 512MB."
[^js bytes]
(let [n (.-length bytes)
total (* 64 (js/Math.ceil (/ (+ n 9) 64)))
out (js/Uint8Array. total)
bits (* 8 n)]
(.set out bytes)
(aset out n 0x80)
;; The high half is the bit count above 2^32; exact for any input JS can hold.
(let [hi (js/Math.floor (/ bits 4294967296))
lo (u32 bits)]
(dotimes [i 4]
(aset out (+ total -8 i) (bit-and 0xff (unsigned-bit-shift-right hi (* 8 (- 3 i)))))
(aset out (+ total -4 i) (bit-and 0xff (unsigned-bit-shift-right lo (* 8 (- 3 i)))))))
out))
(defn digest
"SHA-256 of a Uint8Array, as a Uint8Array of 32 bytes."
[^js bytes]
(let [msg (pad bytes)
h (js/Uint32Array. #js [0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a
0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19])
w (js/Uint32Array. 64)
v (js/Uint32Array. 8)]
(dotimes [block (quot (.-length msg) 64)]
(let [base (* 64 block)]
(dotimes [i 16]
(let [o (+ base (* 4 i))]
(aset w i (u32 (bit-or (bit-shift-left (aget msg o) 24)
(bit-shift-left (aget msg (+ o 1)) 16)
(bit-shift-left (aget msg (+ o 2)) 8)
(aget msg (+ o 3)))))))
(dotimes [j 48]
(let [i (+ j 16)
x (aget w (- i 15))
y (aget w (- i 2))
s0 (u32 (bit-xor (rotr x 7) (rotr x 18) (unsigned-bit-shift-right x 3)))
s1 (u32 (bit-xor (rotr y 17) (rotr y 19) (unsigned-bit-shift-right y 10)))]
(aset w i (+ (aget w (- i 16)) s0 (aget w (- i 7)) s1))))
(.set v h)
(dotimes [i 64]
(let [a (aget v 0) b (aget v 1) c (aget v 2) d (aget v 3)
e (aget v 4) f (aget v 5) g (aget v 6) hh (aget v 7)
s1 (u32 (bit-xor (rotr e 6) (rotr e 11) (rotr e 25)))
choice (u32 (bit-xor (bit-and e f) (bit-and (bit-not e) g)))
t1 (+ hh s1 choice (aget round-k i) (aget w i))
s0 (u32 (bit-xor (rotr a 2) (rotr a 13) (rotr a 22)))
maj (u32 (bit-xor (bit-and a b) (bit-and a c) (bit-and b c)))
t2 (+ s0 maj)]
(aset v 7 g) (aset v 6 f) (aset v 5 e)
(aset v 4 (+ d t1))
(aset v 3 c) (aset v 2 b) (aset v 1 a)
(aset v 0 (+ t1 t2))))
(dotimes [i 8]
(aset h i (+ (aget h i) (aget v i))))))
(let [out (js/Uint8Array. 32)]
(dotimes [i 8]
(dotimes [b 4]
(aset out (+ (* 4 i) b)
(bit-and 0xff (unsigned-bit-shift-right (aget h i) (* 8 (- 3 b)))))))
out)))
(defn hex
"Lowercase hex of a byte array, which is the form `hashlib.hexdigest()` gives
and therefore the form a key is written in."
[^js bytes]
(str/join (map (fn [i] (.padStart (.toString (aget bytes i) 16) 2 "0"))
(range (.-length bytes)))))
(defn of-bytes [^js bytes] (hex (digest bytes)))
(def ^:private utf8 (js/TextEncoder.))
(defn of-string
"UTF-8 first, and that is not a detail: a descriptor holds source filenames, so
a clip called \"café.mov\" hashes to what Python's `hashlib` gives for the same
bytes only if the encoding is agreed. `TextEncoder` is UTF-8 by definition."
[s]
(of-bytes (.encode utf8 s)))
(defn key-of
"The form a tier-2 key is written in everywhere: \"sha256:<64 hex>\".
PREFIXED, because a bare hex string in a document says nothing about what
produced it, and the first time this changes algorithm every stored key has to
be readable as the old one. It is also what makes a descriptive placeholder
key — the `\"take/geom\"` these replaced — impossible to confuse with an address."
[s]
(str "sha256:" (of-string s)))
(defn key?
"Does this string name a content address?
A string test and not a lookup, on purpose: tier 1 must be checkable without
tier 2 in hand, which is the whole point of the split. It is what `domain/leaf`
uses to refuse a document carrying a placeholder key like the \"take/geom\" that
content addressing replaced."
[s]
(boolean (and (string? s) (re-matches #"sha256:[0-9a-f]{64}" s))))

View file

@ -0,0 +1,102 @@
(ns arthur.domain.wire
"The document's wire format, and the bytes' one.
TRANSIT, not JSON, and the reason is the two things docs/animation-model.md is
most specific about. A channel's keys are a map BY FRAME NUMBER, and JSON has
only string keys, so a save through `JSON.stringify` turns `{0 v, 4 v}` into
`{\"0\" v, \"4\" v}` and every id in the scene from `:mouth` into `\"mouth\"` — a
document that reloads as a subtly different type and fails somewhere downstream
of where it broke. Transit carries integers, keywords and vector keys as
themselves, and its output is still JSON, so the server stores a leaf in a
JSONField and the admin can read it.
TRANSIT LOSES SORTEDNESS, which is why `domain/channel` says keys are a PLAIN
map and builds the sorted index at read time. Nothing here re-sorts anything:
a codec that returned a sorted map would work locally and stop working after one
round trip, which is the failure the plain-map rule already prevents.
The bytes are separate and base64, because tier 2 is typed arrays and transit
has nothing to say about them. `channel/dense-at` reads a block as
`{:data <typed array> :state <Uint8Array>}` and both sides of the wire must hold
byte-for-byte the same array — a handle that names a sha256 has to name the
bytes you actually hold."
(:require [cognitect.transit :as t]))
(def ^:private writer (t/writer :json))
(def ^:private reader (t/reader :json))
(defn encode
"A tier-1 value -> the transit-JSON text that goes in a leaf."
[v]
(t/write writer v))
(defn decode
"The inverse. Whatever comes back is ordinary CLJS data."
[s]
(t/read reader s))
(defn encode-json
"A tier-1 value -> transit as a PARSED JSON value, ready to go in a request body.
Transit's output is a JSON string, so a leaf could travel as a string and the
server could store it as one. It travels parsed instead, so that the column
holding it is a JSONField holding JSON rather than a JSONField holding a string
that happens to contain JSON. Two things need that: the admin, where a leaf is
either readable or it is a blob, and the field-wise merge of a channel leaf that
docs/architecture.md describes as fifteen lines of Python — which is fifteen
lines over transit's own `[\"^ \", \"~:keys\", ...]` and impossible over an
opaque string."
[v]
(js/JSON.parse (encode v)))
(defn decode-json
"The inverse of `encode-json`."
[json]
(decode (js/JSON.stringify json)))
;; ---------------------------------------------------------------------------
;; the bytes
(def ^:private chunk-size
"Not `chunk`, which is `cljs.core/chunk`. 8192 characters per `apply`."
8192)
(defn base64
"A typed array -> base64 of its bytes.
Chunked through `String.fromCharCode`: `apply` with a few hundred thousand
arguments overflows the stack, and a 600-frame geometry block is exactly that
size. The failure is a RangeError from inside a save, which points nowhere near
the array that caused it."
[^js block]
(let [bytes (js/Uint8Array. (.-buffer block) (.-byteOffset block) (.-byteLength block))
parts (js/Array.)]
(loop [i 0]
(when (< i (.-length bytes))
(.push parts (.apply js/String.fromCharCode nil (.subarray bytes i (+ i chunk-size))))
(recur (+ i chunk-size))))
(js/btoa (.join parts ""))))
(defn bytes-of
"base64 -> a Uint8Array."
[s]
(let [binary (js/atob s)
out (js/Uint8Array. (.-length binary))]
(dotimes [i (.-length binary)]
(aset out i (.charCodeAt binary i)))
out))
(defn typed
"base64 -> the typed array a block of this element type is read through.
The type is a FIELD the block carries rather than something inferred from its
length, because an Int16Array and a Float32Array over the same bytes are both
valid readings and only one of them is the block."
[type s]
(let [u8 (bytes-of s)]
(case type
"int16" (js/Int16Array. (.-buffer u8))
"float32" (js/Float32Array. (.-buffer u8))
"uint8" u8
(throw (ex-info "a block's element type is \"int16\", \"float32\" or \"uint8\""
{:type type})))))

View file

@ -1,5 +1,9 @@
(ns arthur.events.footage
"Load and freeze extracted footage once, outside the playback loop."
"Load and freeze ingested footage once, outside the playback loop.
The frames come from the server by URL since step 9 — see `flow/ingest` — and the
detector's identity comes from the server too, because it goes into the content
address of every block this produces."
(:require [arthur.events.playback :as pb]
[arthur.flow.detect :as detect]
[arthur.flow.ingest :as ingest]
@ -15,8 +19,7 @@
raw (atom [])
interiors (atom [])
dims (atom nil)
total (:frames manifest)
load-id (.now js/Date)]
total (:frames manifest)]
(js/Promise.
(fn [resolve reject]
(letfn [(next-frame [i]
@ -25,7 +28,7 @@
(resolve (assoc (detect/fill-gaps @raw)
:dimensions @dims :interior @interiors))
(catch :default error (reject error)))
(-> (ingest/image! (ingest/frame-url manifest i load-id))
(-> (ingest/image! (ingest/frame-url manifest i))
(.then
(fn [image]
(let [wh [(.-naturalWidth image) (.-naturalHeight image)]]
@ -55,19 +58,24 @@
(.catch reject))))]
(next-frame 0))))))
(defn- build-clip [manifest {:keys [dense detected dimensions interior missing first-real]}]
(defn- build-clip [manifest detector
{:keys [dense detected dimensions interior missing first-real]}]
(let [[w h] dimensions
frozen (take/footage manifest {:dense dense :detected detected
:dimensions dimensions :interior interior
:presence (:presence manifest)})
:presence (:presence manifest)
:detector detector})
scene (:scene frozen)]
(assoc (select-keys scene [:fps :frames :width :height])
:display-fps (:fps scene)
:scene scene :store (:store frozen)
;; Re-extraction often overwrites audio.wav under the same name. A new
;; URL makes the element fetch the new sound when this clip is loaded.
:audio (str (ingest/audio-url manifest) "?v=" (.now js/Date))
:label (or (:source manifest) "footage")
;; No cache-buster. The audio is a blob named by the hash of its own
;; bytes, so re-extracting gives it a different URL rather than
;; overwriting this one — which is what the `?v=` here used to work
;; around.
:audio (ingest/audio-url manifest)
:label (or (:label manifest) (:source manifest) "footage")
:cid (or (:id manifest) "footage")
:summary (str (:frames manifest) " frames · " w "×" h " · "
(:fps manifest) " fps"
(when (pos? missing)
@ -77,35 +85,61 @@
(rf/reg-fx
::begin!
(fn [path]
(-> (ingest/manifest! path)
(.then (fn [manifest]
(fn [footage-id]
(-> (js/Promise.all #js [(ingest/manifest! footage-id) (ingest/detector!)])
(.then (fn [[manifest detector]]
(rf/dispatch [::progress "loading MediaPipe…"])
(-> (detect/landmarker!)
(.then (fn [model]
(rf/dispatch [::progress "loading frames…"])
(-> (detect-frames! manifest model)
(.then (fn [track] (build-clip manifest track)))))))))
(.then (fn [track]
(build-clip manifest detector track)))))))))
(.then (fn [entry]
(let [id (store/install! entry)]
(rf/dispatch [::loaded id (:summary entry)]))))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (.-message error) (str error))]))))))
(rf/dispatch [::failed (or (ex-message error) (.-message error) (str error))]))))))
(rf/reg-fx
::list!
(fn [_]
(-> (ingest/available!)
(.then (fn [footage] (rf/dispatch [::listed footage])))
(.catch (fn [error]
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
(rf/reg-event-fx
::refresh
(fn [_ _] {::list! nil}))
(rf/reg-event-db
::listed
(fn [db [_ footage]]
(update db :footage merge
{:available (vec footage)
:chosen (or (:chosen (:footage db)) (:id (first footage)))
:status (when (empty? footage)
"no footage ingested — ./extract.sh, then manage.py ingest_bundle")})))
(rf/reg-event-db
::choose
(fn [db [_ id]] (assoc-in db [:footage :chosen] id)))
(rf/reg-event-fx
::load
(fn [{:keys [db]} _]
(if (get-in db [:footage :loading?])
{}
{:db (assoc db :footage (assoc (:footage db) :loading? true
:status "reading manifest.json…"))
::pb/pause! nil
::begin! (get-in db [:footage :manifest-path])})))
(rf/reg-event-db
::set-manifest-path
(fn [db [_ path]] (assoc-in db [:footage :manifest-path] path)))
(let [chosen (get-in db [:footage :chosen])]
(cond
(get-in db [:footage :loading?]) {}
(nil? chosen)
{:db (assoc-in db [:footage :status]
"no footage ingested — ./extract.sh, then manage.py ingest_bundle")}
:else
{:db (update db :footage merge {:loading? true :status "reading the manifest…"})
::pb/pause! nil
::begin! chosen}))))
(rf/reg-event-db
::progress

View file

@ -0,0 +1,195 @@
(ns arthur.events.project
"Save and open: the document over HTTP.
THE ORDER OF A SAVE IS THE TIER SPLIT, and it is not an arrangement of
convenience — each step is the precondition for the next one to be checkable:
1. the ANALYSIS record, so that every block stored afterwards can name the
detector version that produced it. The server refuses a block whose
analysis it does not know, for exactly that reason.
2. ask which BLOCKS are missing, and upload only those. A re-save after a
document edit moves kilobytes, which is the whole return on content
addressing.
3. the DOCUMENT. The server refuses a clip that names blocks it does not hold,
so a saved document cannot load into a blank stage somewhere else.
Open is the same order backwards: the document, then the blocks it names. It
needs no analysis step, because the document carries the analysis record — a
content address alone would make a take unreadable the first time a detector
upgrade orphaned one, and \"sha256:7f2…\" is not an answer to \"which model
produced this\".
Nothing here touches app-db except through events. The promise chain lives in an
fx, which is the only thing in this namespace that is not pure."
(:require [arthur.domain.project :as project]
[arthur.events.playback :as pb]
[arthur.footage.store :as store]
[arthur.flow.address :as address]
[arthur.fx.http :as http]
[re-frame.core :as rf]))
(defn- analysis-payload [analysis]
#js {:key (:id analysis)
:descriptor (address/analysis-descriptor analysis)
:footage (:footage analysis)})
(defn- block-keys [^js doc]
(into-array (map #(.-key %) (array-seq (.-blocks doc)))))
(defn- upload-missing!
"POST the blocks the server said it does not have, and nothing else.
ONE AT A TIME. `Promise.all` over eleven uploads is the obvious way to write
this and it made sqlite answer \"database is locked\" on a save — which reaches
the page as a 500 with nothing wrong with the request. The backend was fixed too
(WAL, and a busy timeout, in server/settings.py), and this stays sequential
anyway: the uploads are a few kilobytes each, nothing is waiting on them, and a
burst of parallel writes to buy nothing is how the same bug comes back the first
time a take has sixty blocks instead of eleven."
[^js doc]
(-> (http/POST "/api/blocks/missing" #js {:keys (block-keys doc)})
(.then (fn [^js answer]
(let [missing (set (array-seq (.-missing answer)))
todo (filterv #(contains? missing (.-key ^js %))
(array-seq (.-blocks doc)))]
(-> (reduce (fn [chain block]
(.then chain (fn [_] (http/POST "/api/blocks" block))))
(js/Promise.resolve nil)
todo)
(.then (fn [_] (count todo)))))))))
(defn- ensure-project! [id name]
(if id
(js/Promise.resolve id)
(-> (http/POST "/api/projects" #js {:name name})
(.then (fn [^js created] (.-id created))))))
(rf/reg-fx
::save!
(fn [{:keys [id cid label clip]}]
(let [analysis (:analysis (:scene clip))
doc (project/save cid clip)]
(-> (ensure-project! id label)
(.then (fn [pid]
(-> (if analysis
(http/POST "/api/analyses" (analysis-payload analysis))
(js/Promise.resolve nil))
(.then (fn [_] (upload-missing! doc)))
(.then (fn [uploaded]
(-> (http/PUT (str "/api/projects/" pid)
#js {:name label
:clips #js [#js {:cid cid
:name label
:analysis (:id analysis)
:leaves (.-leaves doc)
:blocks (block-keys doc)}]})
(.then (fn [^js saved]
(rf/dispatch [::saved pid cid label
(.-seq saved)
(count (array-seq (.-written saved)))
uploaded])))))))))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))])))))))
(rf/reg-fx
::open!
(fn [id]
(-> (if id
(js/Promise.resolve #js {:id id})
;; No id: the most recently updated project, which is what "open" means
;; when there is no project browser yet.
(-> (http/GET "/api/projects")
(.then (fn [^js listed]
(or (first (array-seq (.-projects listed)))
(throw (ex-info "there is no saved project to open" {})))))))
(.then (fn [^js row] (http/GET (str "/api/projects/" (.-id row)))))
(.then (fn [^js loaded]
(let [^js clip-json (first (array-seq (.-clips loaded)))]
(when-not clip-json
(throw (ex-info "that project has no clips" {})))
(-> (js/Promise.all
(into-array (map #(http/GET (str "/api/blocks/" %))
(array-seq (.-blocks clip-json)))))
(.then (fn [blocks]
(let [doc #js {:leaves (.-leaves clip-json) :blocks blocks}
cid (.-cid clip-json)
clip (project/load cid doc)
scene (:scene clip)
entry (merge
(select-keys scene [:fps :frames :width :height])
{:label (str (or (.-name clip-json) cid) " (saved)")
:cid cid
:display-fps (:fps scene)
:scene scene
:store (:store clip)
;; The audio is the clip's, and a
;; document does not carry it: tier 3
;; is by hash and the scene names the
;; analysis, not the sound. Until the
;; footage id is in the document, the
;; synthetic take's is the one that
;; keeps the clock running.
:audio "/static/arthur/audio.wav"})]
(rf/dispatch [::opened
(store/install! entry "project")
(.-id loaded)
(.-name loaded)
(.-seq loaded)]))))))))
(.catch (fn [error]
(js/console.error error)
(rf/dispatch [::failed (or (ex-message error) (str error))]))))))
;; ---------------------------------------------------------------------------
;; events
(rf/reg-event-fx
::save
(fn [{:keys [db]} _]
(let [id (:scene/current db)
clip (store/entry id)]
(if (or (:busy? (:project db)) (nil? clip))
{}
{:db (update db :project merge {:busy? true :status "saving…"})
::save! {:id (:id (:project db))
:cid (or (:cid clip) (name id))
:label (or (:label clip) (name id))
:clip clip}}))))
(rf/reg-event-fx
::open
(fn [{:keys [db]} _]
(if (:busy? (:project db))
{}
{:db (update db :project merge {:busy? true :status "opening…"})
::pb/pause! nil
::open! (:id (:project db))})))
(rf/reg-event-db
::saved
(fn [db [_ id cid label seq written uploaded]]
(update db :project merge
{:id id :cid cid :name label :seq seq :busy? false
:status (str "saved r" seq " · " written
(if (= 1 written) " leaf" " leaves")
" · " uploaded (if (= 1 uploaded) " block" " blocks"))})))
(rf/reg-event-fx
::opened
(fn [{:keys [db]} [_ clip-id project-id name seq]]
(let [clip (store/entry clip-id)]
{:db (-> db
(assoc :scene/current clip-id
:clip (select-keys clip [:fps :frames :width :height :audio :display-fps]))
(update :project merge
{:id project-id :name name :seq seq :cid (:cid clip)
:busy? false
:status (str "opened " name " r" seq)})
(assoc-in [:playback :frame] 0)
(assoc-in [:playback :playing?] false))
::pb/pause! nil})))
(rf/reg-event-db
::failed
(fn [db [_ message]]
(update db :project merge {:busy? false :status (str "failed: " message)})))

View file

@ -0,0 +1,185 @@
(ns arthur.flow.address
"Tier 2 keys: what a dense block is NAMED, and what that name is made of.
Until step 9 a block's key was a descriptive string — \"take/geom\",
\"footage/iris-pos\" — and `flow/freeze` said of them: \"they become the blocks'
sha256 when the backend arrives and nothing above here changes, which is the
point of a handle.\" This is that, and nothing above it did change.
A KEY IS A HASH OVER INPUTS, NOT OVER BYTES. Both are content addressing and
they answer different questions. Hashing the bytes tells you whether two blocks
are identical; hashing the inputs tells you, BEFORE computing anything, which
block the current settings want — which is the question a cache is asked. It is
also what makes a stale bake unreachable rather than wrong: change a knob and
the scene names a key that no longer exists, so the worst case is a re-freeze.
Nothing in the system can serve old landmarks under new settings.
THE DETECTOR VERSION IS IN IT, and docs/architecture.md is explicit about why:
a model upgrade that silently reuses old landmarks presents as \"the tool got
worse\", with no event to attach it to. It enters through the ANALYSIS id, which
every block descriptor names, so it cannot be in one block's key and missing
from another's.
WHICH KNOBS. `block-knobs` below is the invalidation table: for each block, the
settings its BYTES depend on. Getting it wrong in either direction is a bug with
a different symptom — too few and a knob silently does nothing until a reload,
too many and every unrelated tweak throws away a good bake — so it is not
trusted. `address-test` re-freezes the take once per knob and asserts the
biconditional: a block's bytes changed if and only if its key changed. That is
what keeps this table honest, because reading it will not.
Not a namespace with state, and not a registry: every function here is
`(f inputs) -> string`."
(:require [arthur.domain.canon :as canon]
[arthur.domain.sha256 :as sha]))
(def ^:const scheme
"The addressing scheme's own version, inside every key.
If the shape of a descriptor changes — a field added, a field's meaning
revised — then keys computed the old way name bytes produced by code that no
longer exists. Bumping this makes every one of them unreachable in one edit,
which is the cheap version of a migration."
1)
;; ---------------------------------------------------------------------------
;; the analysis artifact
(defn analysis-descriptor
"The canonical text naming one analysis artifact: which detector, at which
version, over which source.
`:fps` and `:aspect` are in here rather than in the block descriptors, and that
is not an arrangement of convenience. Both are properties of the FOOTAGE — the
source cadence and the pixel aspect of the frames it was decoded from — and both
reach tier 2 bytes: aspect through every landmark that is de-anisotropised
before a fit, and fps through every dwell that is specified in seconds
(`condition/quantize-snap`'s gaze and brow cells, `resolve-blink`'s hold). A
block inherits them by naming the analysis, so they cannot be in one block's key
and missing from another's.
`:source` is in it and `:name` is NOT. A clip's name is a label a human types;
two clips of the same footage under different names are the same analysis and
must share it, which is the whole return on addressing."
[{:keys [detector version source footage frames fps aspect seed]}]
(when-not (and (string? detector) (seq detector) (string? version) (seq version))
(throw (ex-info "an analysis names its detector and the detector's VERSION: an upgrade that silently reuses old landmarks is the failure content addressing exists to prevent"
{:detector detector :version version})))
(canon/write (cond-> {:scheme scheme
:detector detector
:version version
:frames frames
:fps fps
:aspect aspect}
source (assoc :source source)
footage (assoc :footage footage)
seed (assoc :seed seed))))
(defn analysis
"An analysis record with its `:id` filled in. The record is tier 1 — it says
what produced the clip's channels — and the id is what `:generated :analysis`
carries on every generated channel."
[record]
(assoc record :id (sha/key-of (analysis-descriptor record))))
;; ---------------------------------------------------------------------------
;; the observation masks
(defn- feature-name
"A feature id as a descriptor string. `canon` refuses a keyword value on
purpose — so that \"mouth\" and :mouth cannot address the same block — and this
is the naming it insists happens at the call site. `nil` is the whole face,
which is what a track with no feature follows."
[id]
(if id (subs (str id) 1) "face"))
(defn observation
"A digest of exactly the absence data one block reads.
Digested rather than inlined, for two reasons. A descriptor is meant to be READ
— a stale bake presents as a picture that will not update, and the descriptor is
the only thing that can say which input moved — and a 229-frame boolean mask
inlined in it would bury the knobs it sits beside. And it is per-block: the eye
block reads `:eye-r` and `:eye-l`'s presence and no other feature's, so a gap in
one brow does not rewrite the mouth's address for nothing.
`nil` features mean the track follows the whole face's detection rather than a
feature's presence, which is what the head's three blocks do."
[features {:keys [detected presence]}]
(let [wanted (sort-by str (distinct (keep identity features)))
masks (into {} (map (fn [id] [id (mapv boolean (get presence id))]))
(filter #(contains? presence %) wanted))]
(when (or detected (seq masks))
(sha/key-of (canon/write {:scheme scheme
:detected (when detected (mapv boolean detected))
:presence (into {} (map (fn [[id m]] [(feature-name id) m]))
(sort-by (comp str key) masks))})))))
;; ---------------------------------------------------------------------------
;; the blocks
(def block-knobs
"Per block, the settings its BYTES depend on. The invalidation table, and the
thing `address-test` refuses to take on trust.
Two entries worth reading twice, because both are asymmetries a reasonable
person would call a mistake:
The EYE block does not depend on `blink-cut`. A blink is a `[:vis]` key on the
eye's interior — tier 1, editable, a handful of transitions — and the lid
geometry underneath it is the same either way. `iris-size` and `pupil-size` are
missing for the same reason: both land on framed channels, not in a block.
The TEETH block depends on `aperture-cut`, which nothing else in the table does.
`condition/interior` will not smooth a contour on a frame the teeth are not
shown on, and whether they are shown starts with the mouth being open — so the
mouth's threshold reaches the pixel geometry, while the mouth's own vertex
budget does not reach the teeth at all (the crop is taken from raw landmarks).
It reads like a mistake in both directions and is neither."
{"geom" [:anchor-avg :contour-avg :verts]
"head-pos" [:anchor-avg]
"head-rot" [:anchor-avg]
"head-scale" [:anchor-avg]
"eyes" [:anchor-avg :contour-avg :eye-verts :lash-weight]
"iris-pos" [:anchor-avg :contour-avg :gaze-gain :gaze-step]
"brows" [:anchor-avg :contour-avg :brow-verts :brow-gain :brow-step :brow-weight]
;; `brow-pos` and not `contour-avg`: the ring is smoothed and the RAISE is not.
;; `condition/brows` takes the end heights straight from measure, medians them
;; for a rest position and snaps them onto a grid, and never passes them
;; through `condition/contours`. Asserted, not assumed — the biconditional in
;; address-test is what found it here.
"brow-pos" [:anchor-avg :brow-gain :brow-step]
"teeth" [:anchor-avg :aperture-cut :blob-grow :cavity-erode :min-area
:teeth-on :teeth-smooth :teeth-verts :tongue-reject :top-bias]})
(defn block-descriptor
"The canonical text naming one dense block.
`:tracks` is in it and so is `:layout`: two blocks over the same inputs that
pack a different number of tracks, or the same tracks in another order, are
different bytes at the same offsets, and a reader that trusted the key would
hand the left eye's geometry to the right one."
[{:keys [role analysis params features tracks layout observation]}]
(let [knobs (or (get block-knobs role)
(throw (ex-info "no invalidation table for this block role: add it to block-knobs in the same commit as the block, or its key cannot change when its bytes do"
{:role role :roles (sort (keys block-knobs))})))
missing (remove #(contains? params %) knobs)]
(when (seq missing)
(throw (ex-info "a knob this block's bytes depend on was not passed to the freeze"
{:role role :missing (vec missing)})))
(canon/write {:scheme scheme
:role role
:analysis analysis
:params (select-keys params knobs)
:features (mapv feature-name features)
:tracks (vec tracks)
:layout layout
:observation observation})))
(defn block
"`{:key :descriptor}` for one dense block. The descriptor travels with the bytes
— see `arthur.domain.leaf` and clips/views.py — because the server verifies
`sha256(descriptor) == key` on upload rather than trusting a name it was handed."
[spec]
(let [text (block-descriptor spec)]
{:key (sha/key-of text) :descriptor text}))

View file

@ -6,7 +6,13 @@
(defn landmarker!
"Initialize once, using the vendored wasm and the local model. CPU also works
in browsers where a GPU delegate initializes but fails on its first frame."
in browsers where a GPU delegate initializes but fails on its first frame.
Under `/static/` since step 9: the assets still live in `frontend/public/mediapipe`
— 26MB of wasm and model that has no business being copied into a second place in
the tree — and Django's staticfiles serves that directory under the `mediapipe/`
prefix. Still no CDN, which is the property that matters: the only thing in this
tool that would silently require a network is the one thing that must not."
[]
(if-let [model @instance]
(js/Promise.resolve model)
@ -14,12 +20,12 @@
(if-let [vision (aget js/window "Vision")]
(let [resolver (aget vision "FilesetResolver")
landmarker (aget vision "FaceLandmarker")
ready (-> (.call (aget resolver "forVisionTasks") resolver "/mediapipe/wasm")
ready (-> (.call (aget resolver "forVisionTasks") resolver "/static/mediapipe/wasm")
(.then (fn [fileset]
(.call (aget landmarker "createFromOptions")
landmarker fileset
#js {:baseOptions
#js {:modelAssetPath "/mediapipe/face_landmarker.task"
#js {:modelAssetPath "/static/mediapipe/face_landmarker.task"
:delegate "CPU"}
:runningMode "IMAGE"
:numFaces 1})))

View file

@ -34,7 +34,8 @@
decisions about the mouth cavity, blink and teeth without thinning geometry."
(:require [arthur.domain.channel :as ch]
[arthur.domain.geom :as geom]
[arthur.domain.ring :as ring]))
[arthur.domain.ring :as ring]
[arthur.flow.address :as address]))
;; ---------------------------------------------------------------------------
;; fixed point
@ -74,22 +75,49 @@
a performance asset rather than a cost. `demo/swarm` holds the same layout and
is the load test for it.
`:ctor` makes the array — a function and not a type, because `new` is not
something a value can carry — `:scale` is the fixed-point scale or nil, and
`:absent` an optional (track, frame) predicate. The state is per track, so one
occluded eye can be absent while its partner still has a value. A full-face
miss marks every track absent.
`:type` names the array — \"int16\" or \"float32\" — rather than handing over a
constructor, because the type is also a field in the block's descriptor and the
two must not be able to disagree. `:scale` is the fixed-point scale or nil.
ABSENCE IS PER TRACK, and `:features` is what says whose. Each track names the
feature it follows, so one occluded eye can be absent while its partner still
has a value; `nil` means the track follows the whole face's detection and no
feature, which is what the head's blocks do. `absent?` is then asked
`(absent? feature f)` and never about a track index.
An earlier shape passed a `(track, frame)` predicate instead, and each call site
derived a feature from an index — `(if (< i 2) :eye-r :eye-l)` — so the
predicate and the vector of tracks beside it had to agree BY HAND, in five
places, with a left/right swap for a failure mode. docs/port-plan.md warns about
that swap twice: every part is still roughly where it belongs, so it survives
inspection. Naming the feature per track deletes the derivation, and it hands
`flow/address` the same list for the block's observation digest, so the key and
the mask cannot disagree either.
`:missing` is an additional per-track predicate for absence that is not a
feature's: the teeth have no contour on a frame no contour could be extracted
from, which is a different fact from the teeth being occluded.
Written with `dotimes` and `aset` rather than as a fold, and that is the
exception rather than the rule in this codebase: the destination is a typed
array, so there is nothing to accumulate into and a collection idiom here would
allocate a seq per frame to throw away."
[{:keys [ctor scale absent]} tracks]
[{:keys [type scale features absent? missing]} tracks]
(when-not (= (count tracks) (count features))
(throw (ex-info "every track of a block names the feature it follows"
{:tracks (count tracks) :features (count features)})))
(let [n (count tracks)
nf (count (first tracks))
stride (count (first (first tracks)))
ctor (case type
"int16" #(js/Int16Array. %)
"float32" #(js/Float32Array. %)
(throw (ex-info "a block's element type is \"int16\" or \"float32\""
{:type type})))
data (ctor (* n nf stride))
state (when absent (js/Uint8Array. (* n nf)))]
gone? (fn [i f] (or (and absent? (absent? (nth features i) f))
(and missing (missing i f))))
state (when (or absent? missing) (js/Uint8Array. (* n nf)))]
(dotimes [i n]
(let [track (vec (nth tracks i))
base (* i nf stride)]
@ -109,16 +137,55 @@
:track i :frame f :component k})))
q)
v))))
(when (and state (absent i f))
(when (and state (gone? i f))
(aset state (+ (* i nf) f) ch/absent-bit))))))
{:data data :state state :stride stride :frames nf :scale scale
{:data data :state state :stride stride :frames nf :scale scale :type type
:features features
:offsets (mapv #(* % nf stride) (range n))}))
(defn- block
"Pack the tracks and NAME the result: `pack`'s block plus the `:key` it is
stored under and the `:descriptor` that key is the hash of.
Addressing happens HERE, beside the packing, rather than at the call sites,
because a block referenced under one key and stored under another is a handle
into somebody else's array — the failure the key exists to make impossible.
`spec` is the block's identity for `flow/address`: its role, the tracks by name,
and the analysis and settings its bytes came out of. `obs` is the absence data,
which the descriptor digests down to one line."
[{:keys [role analysis params tracks] :as spec} opts obs values]
(let [features (:features opts)
blk (pack opts values)
named (address/block
{:role role :analysis analysis :params params :tracks tracks
:features features
:observation (address/observation features obs)
:layout {:type (:type blk) :scale (:scale blk)
:stride (:stride blk) :frames (:frames blk)
:tracks (count tracks)}})]
(merge blk named)))
(defn- stored
"Blocks -> the tier-2 store they go in: key -> what is kept under it.
THE DESCRIPTOR TRAVELS WITH THE BYTES. It is not in the document — tier 1 stays
the authored layer and a descriptor is derived — and it is not thrown away
either, because the server verifies `sha256(descriptor) == key` on upload and
will not take a name on trust. So it rides in tier 2, where a cache entry
knowing what produced it is the ordinary arrangement. `channel/dense-at` reads
`:data` and `:state` and ignores the rest."
[& blocks]
(into {} (map (juxt :key #(select-keys % [:data :state :descriptor]))) blocks))
(defn- dense
"Track i of a packed block, as a DENSE channel definition."
[store-key blk i generated]
"Track i of a packed block, as a DENSE channel definition.
The block names its own key, so a channel cannot be pointed at one block and
stored under another's address."
[blk i generated]
{:animated? true :interp :hold
:dense (cond-> {:store store-key
:dense (cond-> {:store (:key blk)
:offset (nth (:offsets blk) i)
:stride (:stride blk)
:frames (:frames blk)}
@ -361,43 +428,44 @@
"Freeze eyes and brows into their own dense blocks and scene nodes. This owns
only representation: the landmark correspondence, blink and pose choices have
already been settled by measure and condition."
[name absent {:keys [eye-verts brow-verts analysis contour-avg anchor-avg]}
[absent? obs {:keys [eye-verts brow-verts analysis contour-avg anchor-avg] :as params}
{:keys [eyes brows]}]
(let [eye-k (str name "/eyes")
iris-k (str name "/iris-pos")
brow-k (str name "/brows")
brow-pos-k (str name "/brow-pos")
provenance (fn [by extra]
{:by by :analysis analysis
(let [provenance (fn [by extra]
{:by by :analysis (:id analysis)
:params (merge {:anchor-avg anchor-avg :contour-avg contour-avg}
extra)})
eye-block (pack {:ctor #(js/Int16Array. %) :scale geom-scale
:absent (when absent (fn [i f]
(absent (if (< i 2) :eye-r :eye-l) f)))}
(mapv #(rings->flat % eye-verts)
[(:lash-r eyes) (:lid-r eyes)
(:lash-l eyes) (:lid-l eyes)]))
iris-block (pack {:ctor #(js/Float32Array. %)
:absent (when absent (fn [i f]
(absent (if (zero? i) :eye-r :eye-l) f)))}
[(:iris-r eyes) (:iris-l eyes)])
brow-block (pack {:ctor #(js/Int16Array. %) :scale geom-scale
:absent (when absent (fn [i f]
(absent (if (zero? i) :brow-r :brow-l) f)))}
(mapv #(rings->flat % brow-verts)
[(:ring-r brows) (:ring-l brows)]))
brow-pos-block (pack {:ctor #(js/Float32Array. %)
:absent (when absent (fn [i f]
(absent (if (zero? i) :brow-r :brow-l) f)))}
named (fn [role tracks features type values]
(block {:role role :analysis (:id analysis) :params params
:tracks tracks}
{:type type :features features :absent? absent?
:scale (when (= "int16" type) geom-scale)}
obs values))
;; Each block's tracks, named, in the order they are packed — and the
;; feature each one follows, in the same order. The two vectors are read
;; together on purpose: this is the mapping `pack` cannot check for itself,
;; and `each-dense-track-follows-its-own-features-presence` is what pins it.
eye-block (named "eyes"
["lash-r" "lid-r" "lash-l" "lid-l"]
[:eye-r :eye-r :eye-l :eye-l]
"int16"
(mapv #(rings->flat % eye-verts)
[(:lash-r eyes) (:lid-r eyes)
(:lash-l eyes) (:lid-l eyes)]))
iris-block (named "iris-pos" ["iris-r" "iris-l"] [:eye-r :eye-l] "float32"
[(:iris-r eyes) (:iris-l eyes)])
brow-block (named "brows" ["ring-r" "ring-l"] [:brow-r :brow-l] "int16"
(mapv #(rings->flat % brow-verts)
[(:ring-r brows) (:ring-l brows)]))
brow-pos-block (named "brow-pos" ["pos-r" "pos-l"] [:brow-r :brow-l] "float32"
[(:pos-r brows) (:pos-l brows)])
eye-node (fn [id z track]
{:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
:channels {[:geom :pts] (dense eye-k eye-block track
:channels {[:geom :pts] (dense eye-block track
(provenance :roto/eyelid {:verts eye-verts}))
[:style :color] (ch/framed :skin-dark)}})
inner-node (fn [id parent z track shut]
{:id id :name (clojure.core/name id) :kind :poly :parent parent :z z
:channels {[:geom :pts] (dense eye-k eye-block track
:channels {[:geom :pts] (dense eye-block track
(provenance :roto/eye-opening
{:verts eye-verts}))
[:style :color] (ch/framed :eye-white)
@ -406,7 +474,7 @@
iris-node (fn [id parent track radius]
{:id id :name (clojure.core/name id) :kind :disc :parent parent :z "a1"
:stencil parent
:channels {[:xform :pos] (dense iris-k iris-block track
:channels {[:xform :pos] (dense iris-block track
(provenance :roto/gaze nil))
[:geom :radius] (ch/framed radius)
[:style :color] (ch/framed :iris)}})
@ -417,9 +485,9 @@
[:style :color] (ch/framed :pupil)}})
brow-node (fn [id z track]
{:id id :name (clojure.core/name id) :kind :poly :parent :head :z z
:channels {[:geom :pts] (dense brow-k brow-block track
:channels {[:geom :pts] (dense brow-block track
(provenance :roto/brow {:verts brow-verts}))
[:xform :pos] (dense brow-pos-k brow-pos-block track
[:xform :pos] (dense brow-pos-block track
(provenance :roto/brow-raise nil))
[:style :color] (ch/framed :brow)}})]
{:nodes {:eye-r (eye-node :eye-r "a2" 0)
@ -432,28 +500,29 @@
:pupil-l (pupil-node :pupil-l :iris-l)
:brow-r (brow-node :brow-r "a4" 0)
:brow-l (brow-node :brow-l "a5" 1)}
:store {eye-k (select-keys eye-block [:data :state])
iris-k (select-keys iris-block [:data :state])
brow-k (select-keys brow-block [:data :state])
brow-pos-k (select-keys brow-pos-block [:data :state])}}))
:store (stored eye-block iris-block brow-block brow-pos-block)}))
(defn- interior-part
"Freeze the pixel-derived radial contour under the mouth cavity. Missing
contours use the dense block's absence bit; contrast decides editable :vis."
[name {:keys [analysis teeth-verts cavity-erode tongue-reject blob-grow
top-bias teeth-on teeth-smooth]} absent-feature
[{:keys [analysis teeth-verts cavity-erode tongue-reject blob-grow
top-bias teeth-on teeth-smooth] :as params} absent? obs
{:keys [contours shown]}]
(let [key (str name "/teeth")
absent (fn [_ f] (or (nil? (nth contours f))
(and absent-feature (absent-feature :teeth f))))
empty-points (vec (repeat (* 2 teeth-verts) 0))
(let [empty-points (vec (repeat (* 2 teeth-verts) 0))
values (mapv (fn [ring]
(if ring
(into [] (mapcat (juxt :x :y)) ring)
empty-points)) contours)
block (pack {:ctor #(js/Int16Array. %) :scale geom-scale :absent absent}
[values])
generated {:by :pixels/teeth :analysis analysis
blk (block {:role "teeth" :analysis (:id analysis) :params params
:tracks ["contour"]}
{:type "int16" :scale geom-scale
:features [:teeth] :absent? absent?
;; Not the feature's absence: a frame no contour could be
;; extracted from has no teeth to draw whether or not the
;; teeth were occluded, and the two reasons are different facts.
:missing (fn [_ f] (nil? (nth contours f)))}
obs [values])
generated {:by :pixels/teeth :analysis (:id analysis)
:params {:cavity-erode cavity-erode
:tongue-reject tongue-reject :blob-grow blob-grow
:top-bias top-bias :teeth-verts teeth-verts
@ -461,10 +530,10 @@
{:nodes {:teeth
{:id :teeth :name "teeth" :kind :poly :parent :mouth-in :z "a1"
:stencil :mouth-in
:channels {[:geom :pts] (dense key block 0 generated)
:channels {[:geom :pts] (dense blk 0 generated)
[:style :color] (ch/framed :teeth)
[:vis] (keyed-visibility shown generated)}}}
:store {key (select-keys block [:data :state])}}))
:store (stored blk)}))
;; ---------------------------------------------------------------------------
;; the clip
@ -474,7 +543,9 @@
blocks they read. `(f params inputs)`, no state.
params
:name names the clip and its store keys
:name labels the clip. It is NOT in any key: two clips of the same
footage under different names are the same analysis and the
same blocks, and sharing them is the return on addressing.
:fps the clip's rate. FRAMES is not a parameter — it is
`(count outer)`, because a freeze that could disagree with its
own input about the length of the take would.
@ -489,7 +560,11 @@
interior is not present
:head :locked | :as-filmed | :per-plate
:kept frames, for :per-plate only
:analysis which analysis artifact these measurements came from
:analysis the analysis record these measurements came from — detector,
VERSION, source, source cadence and pixel aspect. Its `:id` is
a content address over all of that, every block's key is a hash
over that id, and `flow/address` says why the version being in
there is the one field that must not be forgotten.
:anchor-avg
:contour-avg the stage-4 knobs. Freeze does not use them; it RECORDS them,
because `:generated` is what lets the UI offer a re-freeze at
@ -537,29 +612,39 @@
(when (not= nf (count track))
(throw (ex-info "feature presence track must match the clip"
{:feature id :frames nf :actual (count track)}))))
absent (when (or detected presence)
;; Asked `(absent? feature f)`, where a nil feature is the whole face. A
;; feature with no presence track is present whenever a face was found.
absent? (when (or detected presence)
(fn [id f]
(or (and detected (not (nth detected f true)))
(and (contains? presence id)
(not (nth (get presence id) f))))))
head-absent (when detected (fn [_ f] (not (nth detected f true))))
geom-k (str name "/geom")
head-k #(str name "/head-" %)
obs {:detected detected :presence presence}
prov (fn [by extra]
{:by by :analysis analysis
{:by by :analysis (:id analysis)
:params (merge {:anchor-avg anchor-avg} extra)})
rings (pack {:ctor #(js/Int16Array. %) :scale geom-scale
:absent (when absent (fn [_ f] (absent :mouth f)))}
[(rings->flat outer verts) (rings->flat inner verts)])
rings (block {:role "geom" :analysis (:id analysis) :params params
:tracks ["outer" "inner"]}
{:type "int16" :scale geom-scale
:features [:mouth :mouth] :absent? absent?}
obs
[(rings->flat outer verts) (rings->flat inner verts)])
;; The anchor, inverted and split into its three components. Three blocks
;; and not one: they are three channels, they have three strides, and a
;; single block would need a per-component offset table to say so.
inv (mapv invert transforms)
xf (fn [f] (pack {:ctor #(js/Float32Array. %) :absent head-absent}
[(mapv f inv)]))
pos (xf (fn [t] [(:tx t) (:ty t)]))
rot (xf (fn [t] [(:theta t)]))
scale (xf (fn [t] [(:s t) (:s t)]))
xf (fn [role f]
;; The head follows DETECTION and no feature's presence: an
;; occluded eye does not mean the head was not there. That is
;; what the nil feature says.
(block {:role role :analysis (:id analysis) :params params
:tracks [role]}
{:type "float32" :features [nil] :absent? absent?}
{:detected detected}
[(mapv f inv)]))
pos (xf "head-pos" (fn [t] [(:tx t) (:ty t)]))
rot (xf "head-rot" (fn [t] [(:theta t)]))
scale (xf "head-scale" (fn [t] [(:s t) (:s t)]))
;; Which knobs each channel records is not decoration, it is the
;; invalidation table written down where a re-freeze can read it. The
;; anchor depends on `anchor avg` alone. The rings depend on it and on
@ -568,11 +653,16 @@
;; measure reports the inner ring's own height and nothing smooths it.
anchor-prov (prov :anchor/similarity nil)
roto (fn [by] (prov by {:verts verts :contour-avg contour-avg}))
features (when (and eyes brows) (feature-parts name absent params inputs))
interior (when teeth (interior-part name params absent teeth))
features (when (and eyes brows) (feature-parts absent? obs params inputs))
interior (when teeth (interior-part params absent? obs teeth))
scene {:name name
:frames nf
:fps fps
;; Tier 1 says which analysis its channels came out of, in full.
;; The id alone would make the document unreadable the first time
;; a detector upgrade orphaned a block: "sha256:7f2…" is not an
;; answer to "which model produced this take".
:analysis analysis
;; A gap changes channel state, never these IDs or pair links.
:subjects {:face-1 {:id :face-1 :params {}}}
:features (merge
@ -610,9 +700,9 @@
:head
{:id :head :name "head" :kind :group :parent :face :z "a1"
:measured {[:xform :pos] (dense (head-k "pos") pos 0 anchor-prov)
[:xform :rot] (dense (head-k "rot") rot 0 anchor-prov)
[:xform :scale] (dense (head-k "scale") scale 0 anchor-prov)}}
:measured {[:xform :pos] (dense pos 0 anchor-prov)
[:xform :rot] (dense rot 0 anchor-prov)
[:xform :scale] (dense scale 0 anchor-prov)}}
;; The outer lip ring is the dark band OUTSIDE the interior, and
;; that three-layer structure — dark ring, pale interior, teeth
@ -620,28 +710,27 @@
;; as a blob. So it keeps every frame and is never hidden.
:mouth
{:id :mouth :name "mouth" :kind :poly :parent :head :z "a1"
:channels {[:geom :pts] (dense geom-k rings 0 (roto :roto/lips-outer))
:channels {[:geom :pts] (dense rings 0 (roto :roto/lips-outer))
[:style :color] (ch/framed :skin-dark)}}
:mouth-in
{:id :mouth-in :name "mouth interior" :kind :poly
:parent :mouth :z "a2"
:channels {[:geom :pts] (dense geom-k rings 1 (roto :roto/lips-inner))
:channels {[:geom :pts] (dense rings 1 (roto :roto/lips-inner))
[:style :color] (ch/framed :mouth-dark)
[:vis] (visibility params inputs
(prov :roto/mouth-aperture
{:aperture-cut aperture-cut}))}}}
(:nodes features) (:nodes interior))}
presence-check (doseq [id (keys presence)]
(when-not (contains? (:features scene) id)
(throw (ex-info "presence track names no feature in this scene"
{:feature id :features (keys (:features scene))}))))
;; Tier 2, behind a handle. The keys are descriptive because there is no
;; hashing yet; they become the blocks' sha256 when the backend arrives
;; and nothing above here changes, which is the point of a handle.
store (merge (into {} (map (fn [[k blk]] [k (select-keys blk [:data :state])]))
{geom-k rings
(head-k "pos") pos, (head-k "rot") rot, (head-k "scale") scale})
;; Tier 2, behind a handle, and now behind a content address: every key is
;; a sha256 over the analysis, the settings and the absence data that
;; produced the bytes under it. Nothing above this line changed when they
;; stopped being "take/geom", which is the point of a handle.
store (merge (stored rings pos rot scale)
(:store features) (:store interior))]
(doseq [id (keys presence)]
(when-not (contains? (:features scene) id)
(throw (ex-info "presence track names no feature in this scene"
{:feature id :features (keys (:features scene))}))))
{:store store
:scene (head-mode {:mode head :kept kept} {:scene scene :store store})}))

View file

@ -1,6 +1,25 @@
(ns arthur.flow.ingest
"Read a pre-extracted take. The manifest owns timing and the exact frame count."
(:require [clojure.string :as str]))
"Read an ingested take. The manifest owns timing, the exact frame count, and —
since step 9 — the URL of every frame.
WHAT CHANGED, AND WHY IT IS NOT A DETAIL. This used to fetch `/manifest.json` off
the filesystem and then build `frames/0001.png` itself, with shadow-cljs serving
the repo root. So the frame layout was a shared secret between a shell script and
this namespace, and \"where are the frames\" was answered by a directory listing
that nothing could version.
Now the server names every frame and this asks it. The manifest carries a URL per
frame, so the frames can live in a content-addressed blob store — or, when the
in-browser wasm-ffmpeg extraction docs/architecture.md describes arrives, be
uploaded into the same store by the app itself — and nothing in here learns
anything new. That is the whole point of tier 3 being addressed rather than
located.
The cache-busting `?v=` that used to hang off every frame URL went with it. It
was there because re-extracting overwrote `frames/0001.png` under the same name;
a blob's name IS the hash of its bytes, so a stale copy is not a thing that can
happen."
(:require [arthur.fx.http :as http]))
(defn feature-presence
"Expand one-based, inclusive absence intervals from a manifest into boolean
@ -30,36 +49,53 @@
(defn- valid-manifest [m]
(let [fps (js/Number (:fps m))
frames (js/Number (:frames m))]
frames (js/Number (:frames m))
urls (:urls m)]
(when-not (and (js/Number.isFinite fps) (pos? fps)
(js/Number.isInteger frames) (<= 1 frames 900)
(string? (:dir m)) (seq (:dir m))
(string? (:audio m)) (seq (:audio m)))
(throw (ex-info "manifest.json needs fps, frames (1–900), dir and audio" {:manifest m})))
(assoc m :fps fps :frames frames
(string? (:audio m)) (seq (:audio m))
(sequential? urls) (every? string? urls))
(throw (ex-info "a footage manifest needs fps, frames (1–900), audio and a url per frame"
{:manifest (dissoc m :urls)})))
(when-not (= frames (count urls))
;; The count is the manifest's and the URLs are the manifest's, so a
;; disagreement between them is the server contradicting itself — and it
;; would present as a take that is silently short.
(throw (ex-info "the manifest's frame count and its list of frames disagree"
{:frames frames :urls (count urls)})))
(assoc m :fps fps :frames frames :urls (vec urls)
:presence (feature-presence frames (:feature-absence m)))))
(defn available!
"Every ingested take the server holds. `manage.py ingest_bundle` is what puts one
there."
[]
(-> (http/GET "/api/footage")
(.then (fn [json] (:footage (js->clj json :keywordize-keys true))))))
(defn manifest!
[path]
(-> (js/fetch (str "/" (str/replace path #"^/+" "")) #js {:cache "no-store"})
(.then (fn [response]
(when-not (.-ok response)
(throw (ex-info "manifest.json was not found; run extract.sh first"
{:status (.-status response)})))
(.json response)))
"One take's manifest, including a URL per frame."
[id]
(-> (http/GET (str "/api/footage/" id))
(.then (fn [json] (valid-manifest (js->clj json :keywordize-keys true))))))
(defn- asset-url [path]
;; Manifest paths are relative to the extraction root, served at / in dev.
(str "/" (str/replace path #"^/+" "")))
(defn detector!
"Who is about to do the detecting, as the server understands it: the MediaPipe
package version and the hash of the model asset it serves.
ASKED RATHER THAN ASSUMED, because this string ends up inside every block's
content address, and a version constant in the client is one somebody has to
remember to bump. The server serves the model, so it can hash it — and then the
version is a fact about the bytes that produced the landmarks."
[]
(-> (http/GET "/api/detector")
(.then (fn [json] (js->clj json :keywordize-keys true)))))
(defn audio-url [manifest]
(asset-url (:audio manifest)))
(:audio manifest))
(defn frame-url [manifest i load-id]
(str (asset-url (str (str/replace (:dir manifest) #"/+$" "")
"/" (.padStart (str (inc i)) 4 "0") ".png"))
"?v=" load-id))
(defn frame-url [manifest i]
(nth (:urls manifest) i))
(defn image! [src]
(js/Promise.

View file

@ -1,6 +1,7 @@
(ns arthur.flow.take
"The shared landmark-to-channel path for synthetic and detected takes."
(:require [arthur.flow.condition :as condition]
(:require [arthur.flow.address :as address]
[arthur.flow.condition :as condition]
[arthur.flow.condition.brows :as condition-brows]
[arthur.flow.condition.eyes :as condition-eyes]
[arthur.flow.condition.interior :as condition-interior]
@ -53,12 +54,25 @@
"A real manifest and its detected landmarks through the same measurement and
freeze path as the synthetic take. The source cadence stays in :fps; picture
sampling is a root time map applied only after this artifact exists."
[manifest {:keys [dense detected dimensions interior presence]}]
[manifest {:keys [dense detected dimensions interior presence detector]}]
(let [[w h] dimensions
params (merge knobs
{:name "footage" :fps (:fps manifest) :aspect (/ w h)
{:name (or (:source manifest) "footage")
:fps (:fps manifest) :aspect (/ w h)
:stage [320 200] :fit-motion? true
:expose 1 :head :as-filmed
:analysis (str "mediapipe:1.0.1/" (:source manifest))})]
;; The detector's identity comes from the server, which
;; hashes the model asset it serves rather than trusting a
;; version string somebody has to remember to bump. See
;; `flow/address`: a model upgrade that silently reused
;; these landmarks is the failure this prevents.
:analysis (address/analysis
(merge {:detector "mediapipe" :version "unknown"}
detector
{:source (:source manifest)
:footage (:footage manifest)
:frames (:frames manifest)
:fps (:fps manifest)
:aspect (/ w h)}))})]
(build params {:dense dense :detected detected :interior interior
:presence presence})))

View file

@ -1,14 +1,28 @@
(ns arthur.footage.store
"Loaded clip artifacts live outside app-db. The db keeps only their id."
"Clips loaded at RUNTIME live outside app-db. The db keeps only their id.
Two things arrive this way and they are the same kind of thing: footage that has
been detected and frozen, and a project opened from the server. Both are
`{:scene ... :store ...}` — which is what `flow/freeze` returns — plus the clip
facts the transport needs, and both hold typed arrays that have no business being
in a map every mounted subscription compares."
(:require [arthur.db :as db]))
(defonce ^:private loaded (atom nil))
(defonce ^:private serial (atom 0))
(defn install! [entry]
(let [id (keyword "footage" (str (swap! serial inc)))]
(reset! loaded (assoc entry :id id))
id))
(defn install!
"Hold one loaded clip, and hand back the id app-db will refer to it by.
ONE AT A TIME, on purpose: a second loaded clip is a second megabyte-scale store
with nothing to evict it, and the timeline that would want several is out of
scope. `kind` only names the id — `:footage/3`, `:project/4` — so that a clip's
origin is legible in the db without a lookup."
([entry] (install! entry "footage"))
([entry kind]
(let [id (keyword kind (str (swap! serial inc)))]
(reset! loaded (assoc entry :id id))
id)))
(defn entry [id]
(if (= id (:id @loaded))

View file

@ -0,0 +1,55 @@
(ns arthur.fx.http
"The one place that talks to the server.
Everything here returns a promise of a PARSED JS VALUE, not of CLJS data, and
that is deliberate: a leaf is transit, and `domain/project` reads it straight out
of the response object. A keywordising `js->clj` on the way past would turn the
leaf path \"clip/c1/node/mouth\" into a keyword whose name is \"c1/node/mouth\",
losing the prefix — a corruption that only shows up on the way back in.
CSRF IS NOT EXEMPTED. The page renders `{% csrf_token %}`, so Django sets its
cookie, and every unsafe request carries it back in the header Django looks for.
Nine lines against `@csrf_exempt` on an API that writes the document."
(:require [clojure.string :as str]))
(defn csrf-token []
(some (fn [pair]
(let [[k v] (str/split pair #"=" 2)]
(when (= "csrftoken" (str/trim (or k ""))) v)))
(str/split (or (.-cookie js/document) "") #";")))
(defn- fail
"Turn a non-2xx into an ex-info carrying what the server said.
The server's message is the useful one — \"this clip names tier-2 blocks the
server does not have\" — and a status code alone would put the interesting half
of it in a console nobody is watching."
[response body]
(throw (ex-info (or (some-> body .-error)
(str "the server answered " (.-status response)))
{:status (.-status response)
:body (when body (js->clj body :keywordize-keys true))})))
(defn request!
([method url] (request! method url nil))
([method url body]
(-> (js/fetch url
(clj->js (cond-> {:method method
:cache "no-store"
:headers (cond-> {"Accept" "application/json"}
body (assoc "Content-Type" "application/json")
(not= "GET" method)
(assoc "X-CSRFToken" (or (csrf-token) "")))}
body (assoc :body (js/JSON.stringify body)))))
(.then (fn [response]
(-> (.text response)
(.then (fn [text]
(let [parsed (when (seq text)
(try (js/JSON.parse text) (catch :default _ nil)))]
(if (.-ok response)
parsed
(fail response parsed)))))))))))
(defn GET [url] (request! "GET" url))
(defn POST [url body] (request! "POST" url body))
(defn PUT [url body] (request! "PUT" url body))

View file

@ -19,3 +19,6 @@
(rf/reg-sub ::height (fn [db _] (get-in db [:clip :height])))
(rf/reg-sub ::audio (fn [db _] (get-in db [:clip :audio])))
(rf/reg-sub ::footage (fn [db _] (:footage db)))
;; The document's identity on the server. Not derived and not large — an id, a
;; name, the project version and the last thing a save or an open said.
(rf/reg-sub ::project (fn [db _] (:project db)))

View file

@ -9,6 +9,7 @@
[arthur.db :as db]
[arthur.events.footage :as footage]
[arthur.events.playback :as pb]
[arthur.events.project :as project]
[arthur.subs.playback :as sub]
[arthur.subs.render :as render]
[arthur.ui.player :as player]
@ -38,7 +39,9 @@
picture-fps @(rf/subscribe [::sub/display-fps])
current @(rf/subscribe [::render/scene-id])
expose @(rf/subscribe [::render/exposure])
{:keys [id label loading? status manifest-path]} @(rf/subscribe [::sub/footage])]
{:keys [id label loading? status available chosen]} @(rf/subscribe [::sub/footage])
{project-name :name :keys [busy?] project-status :status
project-seq :seq} @(rf/subscribe [::sub/project])]
[:div.transport
[:div.row
[:button {:on-click #(rf/dispatch [::pb/toggle])}
@ -61,10 +64,15 @@
[:button {:class (when (= id @(rf/subscribe [::render/scene-id])) "on")
:on-click #(rf/dispatch [::pb/select-scene id])}
(or label "footage")])
[:button {:disabled loading?
[:button {:disabled (or loading? (nil? chosen))
:on-click #(rf/dispatch [::footage/load])}
(if loading? "loading…" "load frames")]
[:span.gap]
;; The document, over HTTP. Two buttons, because the round trip is the proof
;; the model serialises and a proof nobody can run is not one.
[:button {:disabled busy? :on-click #(rf/dispatch [::project/save])} "save"]
[:button {:disabled busy? :on-click #(rf/dispatch [::project/open])} "open"]
[:span.gap]
(doall
(for [r db/rates]
^{:key r}
@ -100,11 +108,26 @@
[:button {:class (when (= r picture-fps) "on")
:on-click #(rf/dispatch [::pb/set-picture-fps r])}
(if (= r fps) "source" (str r))]))])
[:label.source-path "source manifest "
[:input {:type "text" :value manifest-path :disabled loading?
:on-change #(rf/dispatch [::footage/set-manifest-path
(.. % -target -value)])}]]
(when status [:div.load-status status])]))
;; The takes the SERVER holds, since step 9. There is no path to type any
;; more: `./extract.sh` decodes a clip and `manage.py ingest_bundle` registers
;; it, and from then on the frames are addressed rather than located.
[:label.source-path "footage "
[:select {:value (or chosen "") :disabled loading?
:on-change #(rf/dispatch [::footage/choose (.. % -target -value)])}
(if (seq available)
(doall (for [{:keys [id label frames fps]} available]
^{:key id}
[:option {:value id}
(str label " · " frames "f @" fps)]))
[:option {:value ""} "nothing ingested"])]
[:button {:disabled loading?
:on-click #(rf/dispatch [::footage/refresh])} "refresh"]]
(when status [:div.load-status status])
(when (or project-name project-status)
[:div.load-status
(when project-name (str "project " project-name
(when project-seq (str " r" project-seq)) " · "))
project-status])]))
(defn- stage []
;; The canvas is the STAGE's size, and the stage is the clip's — not a constant