Projects live at URLs, have owners, and are edited together live

A project is only ever at /p/<id>/<slug>; / is the index of the projects
you own or edit. Every project has an owner, who can name editors;
anyone with the link can view. Every edit saves itself, one request in
flight at a time, as a patch of the leaves that changed, and a websocket
(channels + daphne) carries presence and each committed write to
everyone else in the project. The first write to a leaf wins, and the
loser is told.

Undo is per person: a step undoes only if the leaves it touched still
hold what it left, so it never takes a collaborator's work with it.
Named snapshots replace saving, and restore as an ordinary write.

An empty symbol now survives the leaf round trip with `:nodes {}`.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

Dockerfile

@@ -40,4 +40,4 @@ RUN python manage.py collectstatic --noinput \
 
 USER app
 EXPOSE 8000
-CMD ["sh", "-c", "python manage.py migrate --noinput && exec gunicorn server.wsgi:application --bind 0.0.0.0:8000 --workers 1 --threads 4 --timeout 120"]
+CMD ["sh", "-c", "python manage.py migrate --noinput && exec daphne --bind 0.0.0.0 --port 8000 server.asgi:application"]

clips/consumers.py

@@ -0,0 +1,87 @@
+"""One socket per open project, and it is tl's, nearly line for line.
+
+Two things ride it. DELTAS, which the server sends after a write commits — the
+socket is read-only for the document, and a dropped socket cannot lose a write.
+PRESENCE, which peers gossip between themselves: all the server does is hand out
+a connection id and stamp the sender's identity onto every message, so nobody can
+post as somebody else.
+"""
+import json
+import uuid
+
+from asgiref.sync import async_to_sync
+from channels.generic.websocket import AsyncWebsocketConsumer
+from channels.layers import get_channel_layer
+
+# Who is connected, per project: {group: {cid: presence}}. A cache of what has
+# already been relayed, so a joiner gets the room in one message. Process-local,
+# like the in-memory channel layer this runs on.
+ROOMS = {}
+
+
+def group(project_id):
+    return f"project_{project_id}"
+
+
+def broadcast(project_id, delta, kind="delta"):
+    """Send a committed write to everyone in the project's room. `access` says
+    only that who may write has changed, and each client asks for itself."""
+    async_to_sync(get_channel_layer().group_send)(
+        group(project_id), {"type": "project.delta", "delta": {"kind": kind, **delta}},
+    )
+
+
+class ProjectConsumer(AsyncWebsocketConsumer):
+    RELAYED = ("state",)
+
+    @property
+    def room(self):
+        return ROOMS.setdefault(self.group, {})
+
+    async def connect(self):
+        self.group = group(self.scope["url_route"]["kwargs"]["project_id"])
+        self.cid = uuid.uuid4().hex[:12]
+        user = self.scope.get("user")
+        self.username = user.get_username() if user and user.is_authenticated else None
+        await self.channel_layer.group_add(self.group, self.channel_name)
+        await self.accept()
+
+        me = {"cid": self.cid, "user": self.username}
+        others = list(self.room.values())
+        self.room[self.cid] = me
+        await self.send(text_data=json.dumps({"kind": "welcome", **me}))
+        await self.send(text_data=json.dumps({"kind": "roster", "peers": others}))
+        await self._relay({"kind": "join"})
+
+    async def disconnect(self, code):
+        if hasattr(self, "cid"):
+            self.room.pop(self.cid, None)
+            if not self.room:
+                ROOMS.pop(self.group, None)
+            await self._relay({"kind": "leave"})
+            await self.channel_layer.group_discard(self.group, self.channel_name)
+
+    async def receive(self, text_data=None, bytes_data=None):
+        try:
+            msg = json.loads(text_data or "{}")
+        except ValueError:
+            return
+        if not isinstance(msg, dict) or msg.get("kind") not in self.RELAYED:
+            return
+        if self.cid in self.room:
+            self.room[self.cid].update(
+                {k: v for k, v in msg.items() if k not in ("kind", "cid", "user")}
+            )
+        await self._relay(msg)
+
+    async def _relay(self, msg):
+        await self.channel_layer.group_send(
+            self.group,
+            {"type": "peer.msg", "msg": {**msg, "cid": self.cid, "user": self.username}},
+        )
+
+    async def peer_msg(self, event):
+        await self.send(text_data=json.dumps(event["msg"]))
+
+    async def project_delta(self, event):
+        await self.send(text_data=json.dumps(event["delta"]))

clips/migrations/0008_owners_editors_leaf_seq.py

@@ -0,0 +1,39 @@
+from django.conf import settings
+from django.db import migrations, models
+import django.db.models.deletion
+
+
+def orphans(apps, schema_editor):
+    # Every project has an owner, and none of the ones saved before owners did.
+    apps.get_model("clips", "Project").objects.all().delete()
+
+
+class Migration(migrations.Migration):
+
+    dependencies = [
+        ("clips", "0007_symbols_not_timelines"),
+        migrations.swappable_dependency(settings.AUTH_USER_MODEL),
+    ]
+
+    operations = [
+        migrations.RunPython(orphans, migrations.RunPython.noop),
+        migrations.AddField(
+            model_name="leaf",
+            name="seq",
+            field=models.PositiveBigIntegerField(
+                default=0, help_text="the project seq of the write that last changed it"),
+        ),
+        migrations.AddField(
+            model_name="project",
+            name="editors",
+            field=models.ManyToManyField(blank=True, related_name="shared_projects",
+                                         to=settings.AUTH_USER_MODEL),
+        ),
+        migrations.AddField(
+            model_name="project",
+            name="owner",
+            field=models.ForeignKey(on_delete=django.db.models.deletion.CASCADE,
+                                    related_name="projects", to=settings.AUTH_USER_MODEL),
+            preserve_default=False,
+        ),
+    ]

clips/migrations/0009_revision_blocks.py

@@ -0,0 +1,18 @@
+# Generated by Django 5.2.17 on 2026-09-30 01:54
+
+from django.db import migrations, models
+
+
+class Migration(migrations.Migration):
+
+    dependencies = [
+        ('clips', '0008_owners_editors_leaf_seq'),
+    ]
+
+    operations = [
+        migrations.AddField(
+            model_name='revision',
+            name='blocks',
+            field=models.JSONField(default=dict, help_text="each clip's tier-2 block keys, by cid, so a restore can name them"),
+        ),
+    ]

clips/models.py

@@ -24,7 +24,9 @@ without parsing its leaves: which footage, which analysis, which blocks.
 """
 import uuid
 
+from django.conf import settings
 from django.db import models
+from django.utils import timezone
 
 
 class Blob(models.Model):
@@ -201,10 +203,19 @@ class Project(models.Model):
 
     `schema_version` identifies the stored document format. `seq` counts writes
     to this particular project; it is not a format version. Every write bumps
-    `seq`, and a client that sees `seq > local + 1` refetches once broadcasts exist.
+    `seq`, and a client that sees `seq > local + 1` refetches.
+
+    ANYONE WITH THE LINK CAN VIEW; the owner and the editors can write. Every
+    project has an owner.
     """
 
     id = models.UUIDField(primary_key=True, default=uuid.uuid4, editable=False)
+    owner = models.ForeignKey(
+        settings.AUTH_USER_MODEL, on_delete=models.CASCADE, related_name="projects",
+    )
+    editors = models.ManyToManyField(
+        settings.AUTH_USER_MODEL, blank=True, related_name="shared_projects",
+    )
     name = models.CharField(max_length=200, default="untitled")
     schema_version = models.PositiveIntegerField(default=2)
     seq = models.PositiveBigIntegerField(default=0)
@@ -219,10 +230,19 @@ class Project(models.Model):
         return f"{self.name} ({self.id})"
 
     def bump(self):
-        self.seq += 1
+        """The next seq, taken with an UPDATE so that inside a transaction it is
-        self.save(update_fields=["seq", "updated"])
+        also the write lock: two concurrent saves cannot both get the same one."""
+        Project.objects.filter(id=self.id).update(
+            seq=models.F("seq") + 1, updated=timezone.now()
+        )
+        self.refresh_from_db(fields=["seq", "updated"])
         return self.seq
 
+    def can_edit(self, user):
+        return user.is_authenticated and (
+            user.id == self.owner_id or self.editors.filter(id=user.id).exists()
+        )
+
 
 class Clip(models.Model):
     """Tier 1: the unit of work, and the thing leaf paths are scoped by.
@@ -271,6 +291,9 @@ class Leaf(models.Model):
     path = models.CharField(max_length=300)
     value = models.JSONField()
     version = models.PositiveBigIntegerField(default=1)
+    seq = models.PositiveBigIntegerField(
+        default=0, help_text="the project seq of the write that last changed it",
+    )
     updated = models.DateTimeField(auto_now=True)
 
     class Meta:
@@ -288,7 +311,9 @@ class Leaf(models.Model):
 
 
 class Revision(models.Model):
-    """Tier 1: a snapshot of the authored layer, with a user and a summary.
+    """Tier 1: a snapshot of the authored layer, with a user and a summary — a
+    named snapshot, which is how a person marks a version now that every edit
+    saves itself.
 
     ON AN EXPLICIT TRIGGER, not on every save. tl snapshots a small annotation
     layer; arthur's tier 1 will contain cel polygons, so a snapshot per save bloats
@@ -302,6 +327,9 @@ class Revision(models.Model):
     author = models.CharField(max_length=200, blank=True)
     summary = models.CharField(max_length=500, blank=True)
     document = models.JSONField(help_text="every leaf of the project, by path")
+    blocks = models.JSONField(
+        default=dict, help_text="each clip's tier-2 block keys, by cid, so a restore can name them",
+    )
     created = models.DateTimeField(auto_now_add=True)
 
     class Meta:

clips/routing.py

@@ -0,0 +1,7 @@
+from django.urls import path
+
+from .consumers import ProjectConsumer
+
+websocket_urlpatterns = [
+    path("ws/projects/<uuid:project_id>", ProjectConsumer.as_asgi()),
+]

clips/tests/test_api.py

@@ -361,7 +361,10 @@ class DocumentTests(TestCase):
     """Tier 1: load, save, and the conditional write."""
 
     def setUp(self):
-        self.project = Project.objects.create(name="a project")
+        from django.contrib.auth import get_user_model
+        owner = get_user_model().objects.create_user("owner", password="password1")
+        self.client.force_login(owner)
+        self.project = Project.objects.create(name="a project", owner=owner)
         descriptor = analysis_descriptor()
         self.analysis = key_for(descriptor)
         self.client.post("/api/analyses", data=json.dumps(
@@ -523,6 +526,61 @@ class DocumentTests(TestCase):
 
     # --- revisions ---------------------------------------------------------
 
+    def patch(self, base, leaves, removed=()):
+        return self.put(f"/api/projects/{self.project.id}", {
+            "base": base,
+            "clips": [{"cid": "c1", "analysis": self.analysis, "leaves": leaves,
+                       "removed": list(removed), "blocks": [self.block]}],
+        })
+
+    def test_a_patch_leaves_what_it_does_not_name_alone(self):
+        seq = self.save().json()["seq"]
+        response = self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 24]},
+                              removed=["clip/c1/symbol/main/node/mouth"])
+        self.assertEqual(200, response.status_code, response.content)
+        self.assertEqual(["clip/c1/timing"], response.json()["written"])
+        self.assertEqual(4, Leaf.objects.count())
+
+    def test_two_people_on_different_leaves_both_land(self):
+        seq = self.save().json()["seq"]
+        self.assertEqual(200, self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 24]}).status_code)
+        # The second saver has not caught up, and touched a different leaf.
+        response = self.patch(seq, {"clip/c1/symbol/main": ["^ ", "~:frames", 12]})
+        self.assertEqual(200, response.status_code, response.content)
+        leaves = self.client.get(f"/api/projects/{self.project.id}").json()["clips"][0]["leaves"]
+        self.assertEqual(["^ ", "~:fps", 24], leaves["clip/c1/timing"])
+        self.assertEqual(["^ ", "~:frames", 12], leaves["clip/c1/symbol/main"])
+
+    def test_two_people_on_one_leaf_is_a_conflict_that_writes_nothing(self):
+        seq = self.save().json()["seq"]
+        self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 24]})
+        response = self.patch(seq, {"clip/c1/timing": ["^ ", "~:fps", 12],
+                                    "clip/c1/symbol/main": ["^ ", "~:frames", 12]})
+        self.assertEqual(409, response.status_code)
+        self.assertEqual({"clip/c1/timing": ["^ ", "~:fps", 24]}, response.json()["conflicts"])
+        self.assertEqual(seq + 1, Project.objects.get(id=self.project.id).seq)
+        self.assertEqual(["^ ", "~:frames", 48],
+                         Leaf.objects.get(path="clip/c1/symbol/main").value)
+        # Caught up to their seq, the same write is ordinary.
+        self.assertEqual(200, self.patch(seq + 1, {"clip/c1/timing": ["^ ", "~:fps", 12]}).status_code)
+
+    def test_a_named_snapshot_restores_as_an_ordinary_write(self):
+        self.save()
+        snap = self.client.post(f"/api/projects/{self.project.id}/revisions",
+                                data=json.dumps({"summary": "before the big change"}),
+                                content_type="application/json").json()
+        moved = self.leaves()
+        moved["clip/c1/timing"] = ["^ ", "~:fps", 12]
+        del moved["clip/c1/symbol/main/node/mouth"]
+        self.save(moved)
+        listed = self.client.get(f"/api/projects/{self.project.id}/revisions").json()["revisions"]
+        self.assertEqual(["before the big change"], [r["summary"] for r in listed])
+        restored = self.client.post(
+            f"/api/projects/{self.project.id}/revisions/{snap['id']}/restore").json()
+        self.assertEqual(2, restored["changed"])
+        leaves = self.client.get(f"/api/projects/{self.project.id}").json()["clips"][0]["leaves"]
+        self.assertEqual(self.leaves(), leaves)
+
     def test_a_revision_snapshots_the_authored_layer(self):
         self.save()
         response = self.client.post(
@@ -826,3 +884,99 @@ class UploadTests(TestCase):
             digest="e" * 64, fps=12, frames=3, width=8, height=6, audio=blob)
         manifest = self.client.get(f"/api/footage/{footage.id}").json()
         self.assertIsNone(manifest["video"])
+
+
+@override_settings(BLOB_ROOT=BLOB_DIR)
+class OwnershipTests(TestCase):
+    """Anyone with the link reads; the owner and the editors write."""
+
+    def setUp(self):
+        from django.contrib.auth import get_user_model
+        User = get_user_model()
+        self.ann = User.objects.create_user("ann", password="password1")
+        self.bob = User.objects.create_user("bob", password="password1")
+        self.project = Project.objects.create(name="ann's", owner=self.ann)
+
+    def write(self):
+        return self.client.put(f"/api/projects/{self.project.id}",
+                               data=json.dumps({"name": "renamed", "clips": []}),
+                               content_type="application/json")
+
+    def test_anyone_with_the_link_can_read_and_nobody_else_can_write(self):
+        loaded = self.client.get(f"/api/projects/{self.project.id}").json()
+        self.assertEqual(("ann", False), (loaded["owner"], loaded["can_edit"]))
+        self.assertEqual(403, self.write().status_code)
+        self.client.login(username="bob", password="password1")
+        self.assertEqual(403, self.write().status_code)
+
+    def test_the_owner_names_an_editor_who_can_then_write(self):
+        self.client.login(username="bob", password="password1")
+        self.assertEqual(403, self.client.post(
+            f"/api/projects/{self.project.id}/editors", data=json.dumps({"username": "bob"}),
+            content_type="application/json").status_code)
+        self.client.login(username="ann", password="password1")
+        self.assertEqual(200, self.write().status_code)
+        self.assertEqual(["bob"], self.client.post(
+            f"/api/projects/{self.project.id}/editors", data=json.dumps({"username": "bob"}),
+            content_type="application/json").json()["editors"])
+        self.client.login(username="bob", password="password1")
+        self.assertTrue(self.client.get(f"/api/projects/{self.project.id}").json()["can_edit"])
+        self.assertEqual(200, self.write().status_code)
+        self.client.login(username="ann", password="password1")
+        self.client.delete(f"/api/projects/{self.project.id}/editors/bob")
+        self.client.login(username="bob", password="password1")
+        self.assertEqual(403, self.write().status_code)
+
+    def test_a_project_is_made_by_somebody_signed_in_and_is_theirs(self):
+        self.assertEqual(403, self.client.post("/api/projects", data=json.dumps({"name": "x"}),
+                                               content_type="application/json").status_code)
+        self.client.post("/api/signup", data=json.dumps(
+            {"username": "cat", "password": "password1"}), content_type="application/json")
+        self.assertEqual("cat", self.client.get("/api/me").json()["username"])
+        mine = self.client.post("/api/projects", data=json.dumps({"name": "y"}),
+                                content_type="application/json").json()
+        self.assertEqual(("cat", True), (mine["owner"], mine["can_edit"]))
+        listed = {p["name"] for p in self.client.get("/api/projects").json()["projects"]}
+        self.assertEqual({"y"}, listed)
+        self.client.logout()
+        self.assertEqual([], self.client.get("/api/projects").json()["projects"])
+
+    def test_a_project_has_an_address(self):
+        response = self.client.get(f"/p/{self.project.id}")
+        self.assertEqual(200, response.status_code)
+        # The slug is the name, for people; the id is what finds it.
+        self.assertEqual(200, self.client.get(f"/p/{self.project.id}/anything-at-all").status_code)
+        self.assertContains(response, 'id="app"')
+
+
+class SocketTests(TestCase):
+    """A committed write reaches everyone in the room; presence is stamped."""
+
+    def test_a_save_is_broadcast_to_the_room(self):
+        from asgiref.sync import async_to_sync, sync_to_async
+        from channels.testing import WebsocketCommunicator
+        from clips.consumers import broadcast
+        from server.asgi import application
+
+        from django.contrib.auth import get_user_model
+        project = Project.objects.create(
+            name="shared", owner=get_user_model().objects.create_user("host"))
+
+        async def scenario():
+            peer = WebsocketCommunicator(application, f"/ws/projects/{project.id}",
+                                         headers=[(b"origin", b"http://localhost")])
+            connected, _ = await peer.connect()
+            self.assertTrue(connected)
+            self.assertEqual("welcome", (await peer.receive_json_from())["kind"])
+            self.assertEqual([], (await peer.receive_json_from())["peers"])
+            self.assertEqual("join", (await peer.receive_json_from())["kind"])
+            # The server stamps who sent it; a claimed name is overwritten.
+            await peer.send_json_to({"kind": "state", "frame": 12, "user": "forged"})
+            state = await peer.receive_json_from()
+            self.assertEqual((12, None), (state["frame"], state["user"]))
+            await sync_to_async(broadcast)(project.id, {"seq": 1, "clips": []})
+            delta = await peer.receive_json_from()
+            self.assertEqual(("delta", 1), (delta["kind"], delta["seq"]))
+            await peer.disconnect()
+
+        async_to_sync(scenario)()

clips/urls.py

@@ -16,6 +16,10 @@ from django.urls import path
 from . import views
 
 urlpatterns = [
+    path("me", views.me),
+    path("login", views.login),
+    path("signup", views.signup),
+    path("logout", views.logout),
     path("detector", views.detector),
     path("sources", views.sources),
     path("extractions", views.extractions),
@@ -27,6 +31,9 @@ urlpatterns = [
     path("projects/<uuid:project_id>", views.project_detail),
     path("projects/<uuid:project_id>/leaves/<path:leaf_path>", views.leaf_detail),
     path("projects/<uuid:project_id>/revisions", views.revisions),
+    path("projects/<uuid:project_id>/revisions/<int:revision_id>/restore", views.restore),
+    path("projects/<uuid:project_id>/editors", views.editors),
+    path("projects/<uuid:project_id>/editors/<str:username>", views.editors),
     path("analyses", views.analyses),
     path("analyses/<str:key>", views.analysis_detail),
     path("blocks", views.blocks),

clips/views.py

@@ -32,13 +32,17 @@ from pathlib import Path
 from uuid import UUID
 
 from django.conf import settings
+from django.contrib.auth import authenticate, get_user_model
+from django.contrib.auth import login as auth_login, logout as auth_logout
 from django.core.exceptions import ValidationError
 from django.db import transaction
+from django.db.models import Q
 from django.http import FileResponse, HttpResponse, JsonResponse
 from django.shortcuts import render
 from django.views.decorators.http import require_http_methods
 
 from . import blobs, extraction
+from .consumers import broadcast
 from .models import Analysis, Block, Blob, Clip, Extraction, Footage, Leaf, Project, Revision, Source
 
 KEY_LENGTH = 71  # "sha256:" + 64 hex
@@ -133,7 +137,7 @@ def _asset_version(relative):
     return "0"
 
 
-def page(request):
+def page(request, project_id=None, slug=None):
     """The host page. This replaced `frontend/public/index.html` at step 9, and
     `:dev-http` in shadow-cljs.edn went away with it."""
     return render(request, "clips/index.html", {
@@ -619,7 +623,11 @@ def block_detail(request, key):
 # tier 1: projects, clips, leaves
 
 
-def _project_json(project: Project):
+def _who(user):
+    return {"username": user.get_username() if user.is_authenticated else None}
+
+
+def _project_json(project: Project, user):
     leaves = list(project.leaves.all())
     clips = []
     for clip in project.clips.all():
@@ -640,27 +648,103 @@ def _project_json(project: Project):
         "schema_version": project.schema_version,
         "seq": project.seq,
         "palette": project.palette,
+        "owner": project.owner.get_username(),
+        "editors": sorted(project.editors.values_list("username", flat=True)),
+        "can_edit": project.can_edit(user),
         "clips": clips,
     }
 
 
+def _project(project_id):
+    try:
+        return Project.objects.select_related("owner").get(id=project_id)
+    except Project.DoesNotExist:
+        raise Bad("no such project", status=404)
+
+
+def _writable(request, project_id):
+    project = _project(project_id)
+    if not project.can_edit(request.user):
+        raise Bad("only the owner and the editors can change this project; "
+                  "save a copy instead", status=403)
+    return project
+
+
+# ---------------------------------------------------------------------------
+# who you are
+#
+# Django's session cookie, and the page's CSRF cookie on every write. Nothing
+# here that a signed-in admin does not already have; the API gains a way in that
+# is not the admin's login page.
+
+
+@require_http_methods(["GET"])
+def me(request):
+    return JsonResponse(_who(request.user))
+
+
+@require_http_methods(["POST"])
+def login(request):
+    data = json.loads(request.body or b"{}")
+    user = authenticate(request, username=data.get("username"), password=data.get("password"))
+    if user is None:
+        return JsonResponse({"error": "wrong username or password"}, status=400)
+    auth_login(request, user)
+    return JsonResponse(_who(user))
+
+
+@require_http_methods(["POST"])
+def signup(request):
+    data = json.loads(request.body or b"{}")
+    username = (data.get("username") or "").strip()
+    password = data.get("password") or ""
+    if not username or len(password) < 8:
+        return JsonResponse({"error": "a username, and a password of 8 or more"}, status=400)
+    User = get_user_model()
+    if User.objects.filter(username__iexact=username).exists():
+        return JsonResponse({"error": "that username is taken"}, status=409)
+    user = User.objects.create_user(username=username, password=password)
+    auth_login(request, user)
+    return JsonResponse(_who(user), status=201)
+
+
+@require_http_methods(["POST"])
+def logout(request):
+    auth_logout(request)
+    return JsonResponse(_who(request.user))
+
+
+# ---------------------------------------------------------------------------
+# tier 1: projects, clips, leaves
+
+
 @require_http_methods(["GET", "POST"])
 def projects(request):
+    """GET lists what you own and are an editor of — nothing, signed out; POST
+    makes one, owned by you. Every project has an owner, so making one needs you
+    signed in."""
     if request.method == "GET":
+        if not request.user.is_authenticated:
+            return JsonResponse({"projects": []})
+        visible = Q(owner=request.user) | Q(editors=request.user)
         return JsonResponse(
             {
                 "projects": [
                     {"id": str(p.id), "name": p.name,
                      "schema_version": p.schema_version, "seq": p.seq,
+                     "owner": p.owner.get_username(),
                      "updated": p.updated.isoformat()}
-                    for p in Project.objects.all()[:100]
+                    for p in Project.objects.filter(visible).distinct()
+                                            .select_related("owner")[:100]
                 ]
             }
         )
+    if not request.user.is_authenticated:
+        return JsonResponse({"error": "sign in to make a project"}, status=403)
     try:
         data = _body(request)
-        project = Project.objects.create(name=data.get("name") or "untitled")
+        project = Project.objects.create(name=data.get("name") or "untitled", owner=request.user)
-        return JsonResponse(_project_json(project), status=201)
+        return JsonResponse(_project_json(project, request.user), status=201)
     except Bad as exc:
         return _error(exc)
 
@@ -668,43 +752,74 @@ def projects(request):
 @require_http_methods(["GET", "PUT"])
 def project_detail(request, project_id):
     try:
-        project = Project.objects.get(id=project_id)
+        if request.method == "GET":
-    except Project.DoesNotExist:
+            return JsonResponse(_project_json(_project(project_id), request.user))
-        return JsonResponse({"error": "no such project"}, status=404)
+        project = _writable(request, project_id)
-    if request.method == "GET":
+        return _save(project, _body(request), request.user)
-        return JsonResponse(_project_json(project))
+    except Bad as exc:
+        return _error(exc)
+
+
+@require_http_methods(["POST", "DELETE"])
+def editors(request, project_id, username=None):
+    """The owner names who else can write. POST {username} adds; DELETE
+    `editors/<username>` removes."""
     try:
-        return _save(project, _body(request))
+        project = _project(project_id)
+        if not (request.user.is_authenticated and request.user.id == project.owner_id):
+            raise Bad("only the owner can change who edits", status=403)
+        if request.method == "POST":
+            username = _body(request).get("username")
+        user = get_user_model().objects.filter(username__iexact=username or "").first()
+        if user is None:
+            raise Bad(f"nobody is called {username!r}", status=404)
+        if request.method == "POST":
+            project.editors.add(user)
+        else:
+            project.editors.remove(user)
+        broadcast(project.id, {}, kind="access")
+        return JsonResponse({"editors": sorted(project.editors.values_list("username", flat=True))})
     except Bad as exc:
         return _error(exc)
 
 
 @transaction.atomic
-def _save(project: Project, data):
+def _save(project: Project, data, user):
-    """A whole-document save: one clip's leaves replace that clip's leaves.
+    """A save: one clip's leaves, written.
 
     SCOPED BY CLIP, not by project. A payload that carries clip `a` does not
-    disturb clip `b`'s leaves, because a save is not the only way the document
+    disturb clip `b`'s leaves.
-    changes — a single-leaf conditional write is — and a save that cleared
+
-    everything it did not mention would be a save that undoes a collaborator.
+    Two shapes. Without `base`, a clip's leaves REPLACE that clip's leaves — the
+    whole-document save. With `base`, the seq the client last caught up to, the
+    save is a PATCH: `leaves` are the ones it changed, `removed` the ones it
+    deleted, and nothing it did not mention is touched. A leaf it names that
+    somebody else changed after `base`, to something else, is a conflict, and the
+    whole save answers 409 with their values — last-writer-wins per leaf, with the
+    loser told rather than silently clobbered. docs/architecture.md, "Make the
+    merge unit small instead of clever".
 
     A leaf whose value is unchanged keeps its VERSION. That is what makes the
     entity tag mean something: a save of a document where one channel moved
     invalidates one leaf's etag, not all four hundred.
     """
+    base = data.get("base")
+    seq = project.bump()
     if data.get("name"):
         project.name = data["name"]
     if data.get("palette"):
         project.palette = data["palette"]
+    project.save(update_fields=["name", "palette"])
 
-    written, removed, unchanged = [], [], []
+    written, removed, unchanged, conflicts, deltas = [], [], [], {}, []
     for spec in data.get("clips") or []:
         cid = spec.get("cid")
         if not cid:
             raise Bad("every clip in a save names its cid")
         leaves = spec.get("leaves") or {}
+        gone = spec.get("removed") or [] if base is not None else []
         prefix = f"clip/{cid}/"
-        for path in leaves:
+        for path in [*leaves, *gone]:
             if not path.startswith(prefix):
                 raise Bad(
                     f"leaf {path!r} is not addressed to clip {cid!r}",
@@ -723,6 +838,16 @@ def _save(project: Project, data):
                 status=409, missing=missing,
             )
 
+        existing = {leaf.path: leaf for leaf in project.leaves.filter(path__startswith=prefix)}
+        if base is not None:
+            for path in [*leaves, *gone]:
+                theirs = existing.get(path)
+                if theirs and theirs.seq > base and (
+                        path not in leaves or theirs.value != leaves[path]):
+                    conflicts[path] = theirs.value
+            if conflicts:
+                continue
+
         analysis = Analysis.objects.filter(key=spec.get("analysis")).first()
         footage = None
         if spec.get("footage"):
@@ -732,29 +857,41 @@ def _save(project: Project, data):
             cid=cid,
             defaults={"name": spec.get("name") or "", "analysis": analysis, "footage": footage},
         )
-        clip.blocks.set(Block.objects.filter(key__in=keys))
+        blocks = Block.objects.filter(key__in=keys)
+        if base is None:
+            clip.blocks.set(blocks)
+            gone = [path for path in existing if path not in leaves]
+        else:
+            clip.blocks.add(*blocks)
 
-        existing = {leaf.path: leaf for leaf in project.leaves.filter(path__startswith=prefix)}
+        changed = {}
         for path, value in leaves.items():
             leaf = existing.get(path)
             if leaf is None:
-                Leaf.objects.create(project=project, path=path, value=value)
+                Leaf.objects.create(project=project, path=path, value=value, seq=seq)
-                written.append(path)
             elif leaf.value != value:
-                leaf.value = value
+                leaf.value, leaf.seq = value, seq
                 leaf.version += 1
-                leaf.save(update_fields=["value", "version", "updated"])
+                leaf.save(update_fields=["value", "version", "seq", "updated"])
-                written.append(path)
             else:
                 unchanged.append(path)
-        for path, leaf in existing.items():
+                continue
-            if path not in leaves:
+            changed[path] = value
-                leaf.delete()
+        dropped = [path for path in gone if path in existing]
-                removed.append(path)
+        project.leaves.filter(path__in=dropped).delete()
+        written += changed
+        removed += dropped
+        deltas.append({"cid": cid, "leaves": changed, "removed": dropped, "blocks": keys})
 
-    seq = project.seq + 1
+    if conflicts:
-    project.seq = seq
+        raise Bad(
-    project.save()
+            "somebody else changed these since you last caught up",
+            status=409, seq=seq - 1, conflicts=conflicts,
+        )
+    by = user.get_username() if user.is_authenticated else None
+    transaction.on_commit(lambda: broadcast(project.id, {
+        "seq": seq, "by": by, "name": project.name, "clips": deltas,
+    }))
     return JsonResponse(
         {
             "id": str(project.id),
@@ -777,9 +914,9 @@ def leaf_detail(request, project_id, leaf_path):
     for a painted cel that is the class of bug that ends trust in a tool.
     """
     try:
-        project = Project.objects.get(id=project_id)
+        project = _project(project_id) if request.method == "GET" else _writable(request, project_id)
-    except Project.DoesNotExist:
+    except Bad as exc:
-        return JsonResponse({"error": "no such project"}, status=404)
+        return _error(exc)
 
     leaf = project.leaves.filter(path=leaf_path).first()
     if request.method == "GET":
@@ -797,35 +934,45 @@ def leaf_detail(request, project_id, leaf_path):
         return _error(Bad("a leaf write carries a value"))
 
     match = request.headers.get("If-Match")
-    if leaf is None:
+    with transaction.atomic():
-        # ANY `If-Match` on a leaf that does not exist is a failed precondition,
+        seq = project.bump()
-        # `*` included: RFC 7232 gives `*` the meaning "the resource must already
+        leaf = project.leaves.filter(path=leaf_path).first()
-        # exist", which is exactly the write a client makes when it believes it is
+        if leaf is None:
-        # editing something. Creating it instead would turn "somebody deleted this
+            # ANY `If-Match` on a leaf that does not exist is a failed precondition,
-        # node" into a silent resurrection.
+            # `*` included: RFC 7232 gives `*` the meaning "the resource must already
-        if match:
+            # exist", which is exactly the write a client makes when it believes it
-            return JsonResponse(
+            # is editing something. Creating it instead would turn "somebody deleted
-                {"error": "no such leaf", "path": leaf_path}, status=409
+            # this node" into a silent resurrection.
-            )
+            if match:
-        leaf = Leaf.objects.create(project=project, path=leaf_path, value=data["value"])
+                transaction.set_rollback(True)
-    else:
+                return JsonResponse(
-        if match and match not in ("*", leaf.etag):
+                    {"error": "no such leaf", "path": leaf_path}, status=409
-            response = JsonResponse(
+                )
-                {
+            leaf = Leaf.objects.create(project=project, path=leaf_path, value=data["value"], seq=seq)
-                    "error": "stale write",
+        else:
-                    "path": leaf.path,
+            if match and match not in ("*", leaf.etag):
-                    "version": leaf.version,
+                transaction.set_rollback(True)
-                    "value": leaf.value,
+                response = JsonResponse(
-                },
+                    {
-                status=409,
+                        "error": "stale write",
-            )
+                        "path": leaf.path,
-            response["ETag"] = leaf.etag
+                        "version": leaf.version,
-            return response
+                        "value": leaf.value,
-        leaf.value = data["value"]
+                    },
-        leaf.version += 1
+                    status=409,
-        leaf.save(update_fields=["value", "version", "updated"])
+                )
+                response["ETag"] = leaf.etag
+                return response
+            leaf.value, leaf.seq = data["value"], seq
+            leaf.version += 1
+            leaf.save(update_fields=["value", "version", "seq", "updated"])
+        cid = leaf_path.split("/")[1] if leaf_path.startswith("clip/") else None
+        by = request.user.get_username() if request.user.is_authenticated else None
+        transaction.on_commit(lambda: broadcast(project.id, {
+            "seq": seq, "by": by, "name": project.name,
+            "clips": [{"cid": cid, "leaves": {leaf.path: leaf.value}, "removed": [], "blocks": []}],
+        }))
 
-    seq = project.bump()
     response = JsonResponse({"path": leaf.path, "version": leaf.version, "seq": seq})
     response["ETag"] = leaf.etag
     return response
@@ -833,16 +980,17 @@ def leaf_detail(request, project_id, leaf_path):
 
 @require_http_methods(["GET", "POST"])
 def revisions(request, project_id):
-    """Mark a version: one snapshot of the authored layer, with a summary."""
+    """Named snapshots: GET lists them, POST {summary} takes one of the document
+    as it is now."""
     try:
-        project = Project.objects.get(id=project_id)
+        project = _project(project_id) if request.method == "GET" else _writable(request, project_id)
-    except Project.DoesNotExist:
+    except Bad as exc:
-        return JsonResponse({"error": "no such project"}, status=404)
+        return _error(exc)
     if request.method == "GET":
         return JsonResponse(
             {
                 "revisions": [
-                    {"seq": r.seq, "author": r.author, "summary": r.summary,
+                    {"id": r.id, "seq": r.seq, "author": r.author, "summary": r.summary,
                      "created": r.created.isoformat(), "leaves": len(r.document)}
                     for r in project.revisions.all()[:100]
                 ]
@@ -852,8 +1000,57 @@ def revisions(request, project_id):
     revision = Revision.objects.create(
         project=project,
         seq=project.seq,
-        author=data.get("author") or "",
+        author=request.user.get_username(),
-        summary=data.get("summary") or "",
+        summary=(data.get("summary") or "").strip()[:500],
         document={leaf.path: leaf.value for leaf in project.leaves.all()},
+        blocks={clip.cid: sorted(clip.blocks.values_list("key", flat=True))
+                for clip in project.clips.all()},
     )
-    return JsonResponse({"seq": revision.seq, "leaves": len(revision.document)}, status=201)
+    return JsonResponse({"id": revision.id, "seq": revision.seq,
+                         "leaves": len(revision.document)}, status=201)
+
+
+@require_http_methods(["POST"])
+def restore(request, project_id, revision_id):
+    """Put a snapshot back: an ordinary write of every leaf that differs, so
+    everybody in the room receives it the way they receive any other."""
+    try:
+        project = _writable(request, project_id)
+        revision = project.revisions.filter(id=revision_id).first()
+        if revision is None:
+            raise Bad("no such snapshot", status=404)
+    except Bad as exc:
+        return _error(exc)
+    with transaction.atomic():
+        seq = project.bump()
+        existing = {leaf.path: leaf for leaf in project.leaves.all()}
+        deltas = {}
+        def delta(path):
+            cid = path.split("/")[1]
+            return deltas.setdefault(cid, {"cid": cid, "leaves": {}, "removed": [],
+                                           "blocks": revision.blocks.get(cid, [])})
+        for path, value in revision.document.items():
+            leaf = existing.get(path)
+            if leaf is None:
+                Leaf.objects.create(project=project, path=path, value=value, seq=seq)
+            elif leaf.value != value:
+                leaf.value, leaf.seq = value, seq
+                leaf.version += 1
+                leaf.save(update_fields=["value", "version", "seq", "updated"])
+            else:
+                continue
+            delta(path)["leaves"][path] = value
+        gone = [path for path in existing if path not in revision.document]
+        project.leaves.filter(path__in=gone).delete()
+        for path in gone:
+            delta(path)["removed"].append(path)
+        for cid, keys in revision.blocks.items():
+            clip = project.clips.filter(cid=cid).first()
+            if clip:
+                clip.blocks.add(*Block.objects.filter(key__in=keys))
+        by = request.user.get_username()
+        transaction.on_commit(lambda: broadcast(project.id, {
+            "seq": seq, "by": by, "name": project.name, "clips": list(deltas.values()),
+        }))
+    return JsonResponse({"seq": seq, "changed": sum(len(d["leaves"]) + len(d["removed"])
+                                                    for d in deltas.values())})

docs/architecture.md

@@ -675,6 +675,45 @@ and `~` is then refused inside a name. That is the whole of the escaping.
 That maps onto the tiers exactly — the server stores tier 1 and snapshots tier 1,
 with tiers 2 and 3 as content-addressed blobs beside it.
 
+### As built
+
+- **Addresses.** `/` is the index of the projects you own or edit. A project
+  is only ever at `/p/<uuid>/<slug>`: the id finds it, the slug is its name and
+  follows a rename without a history entry. "new" makes the project on the
+  server first and opens it; a built-in example opened in the editor is saved
+  at once as a project of its own. There is no bare project. The address, the
+  title and the socket follow `[:project :id]` through one global interceptor
+  (`events/collab`).
+- **Ownership.** Every project has an owner (`Project.owner`, not nullable) and
+  `editors`. Anyone with the link reads; the owner and editors write. Making a
+  project needs you signed in. A reader can make a copy of their own.
+  `/api/{me,login,signup,logout}`, `/api/projects/<id>/editors[/<username>]`.
+- **Every edit saves.** No save button. The same interceptor sees
+  `:paint/revision` move and saves; one request is in flight at a time, and an
+  edit made meanwhile goes when it lands — so a drag reaches the room as fast
+  as the round trip allows. A save sends only the leaves that differ from what
+  was last synced, and a clean document sends nothing. Analyses and blocks
+  already put on the server are not asked about again.
+- **Saves are patches.** With `base` (the seq last caught up to) a save names
+  only its changed and removed leaves. A named leaf somebody else changed after
+  `base`, to something else, fails the whole save with 409.
+- **The first write wins.** A remote write to a leaf with a local change not
+  yet sent waits in the entry's `:behind`; the next save, or a 409, puts theirs
+  on screen over ours and says so. Ours stays in the undo list.
+- **The socket** (`/ws/projects/<uuid>`, channels + daphne) carries presence,
+  the delta each committed write broadcasts, and `access` when the editor list
+  changes. A gap in `seq`, a welcome, or a 409 refetches the document.
+- **Undo** is per person, recorded in `events/edit` as leaf befores and afters
+  (`domain/history`), and applied as an ordinary edit. A step undoes only if
+  every leaf it touched still holds what it left there: somebody else's edit
+  since refuses it rather than being undone with it. Edits to the same leaves
+  within a second, each starting where the last left off, are one step.
+- **Snapshots** are named revisions (`/api/projects/<id>/revisions`), with each
+  clip's block keys. Restoring one is an ordinary write, broadcast like any.
+
+Not yet: follow mode, frame/selection in presence, the advisory `:editing`
+lease, the durable outbox.
+
 ### Why this model, and not a CRDT
 
 The usual reason to reach for Yjs or Automerge is automatic convergence without

frontend/src/arthur/core.cljs

@@ -4,7 +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.collab :as collab]
             [arthur.events.footage :as footage]
+            [arthur.events.history :as history]
             [arthur.events.playback]
             [arthur.events.paint]
             [arthur.events.project :as project]
@@ -12,6 +14,7 @@
             [arthur.subs.playback]
             [arthur.subs.render]
             [arthur.subs.ui]
+            [arthur.ui.index :as index]
             [arthur.ui.player :as player]
             [arthur.ui.shell :as shell]
             [re-frame.core :as rf]
@@ -26,7 +29,7 @@
   ;; the loop would otherwise sit on an unchanged frame number and never redraw.
   (rf/clear-subscription-cache!)
   (player/refresh-subs!)
-  (rdc/render @root [shell/view]))
+  (rdc/render @root [:<> [shell/view] [index/view]]))
 
 (defn init []
   (rf/dispatch-sync [::init])
@@ -39,6 +42,10 @@
   ;; picker be a picker rather than a path to type.
   (rf/dispatch [::footage/refresh])
   (rf/dispatch [::project/list-symbols])
+  ;; After the blank document, so an address that names a project opens it over
+  ;; the blank one, and the blank one is what a bad address leaves on screen.
+  (collab/start!)
+  (history/install-keys!)
   (reset! root (rdc/create-root (js/document.getElementById "app")))
   (mount)
   (player/start!))

frontend/src/arthur/domain/history.cljs

@@ -0,0 +1,113 @@
+(ns arthur.domain.history
+  "Undo, per person, as leaf writes. docs/architecture.md, \"Undo is per-user\".
+
+  A step is the leaves one edit changed: what they held before, and what they
+  held after. Undoing writes the befores back as an ordinary edit, which the
+  next save sends like any other — so undo needs nothing from the server, and
+  nothing about it is shared.
+
+  ONLY YOUR OWN CHANGES. A step undoes only if every leaf it touched still holds
+  what the step left there. Somebody else's write to one of them since — their
+  edit to the shape you made — refuses the step rather than taking their work
+  with it; it is dropped, and the next undo is the step before. With nobody else
+  in the document the values always match, and this is ordinary undo.
+
+  A nil value is an absent leaf: a step that made a node has nil befores for its
+  leaves, so undoing it removes them."
+  (:require [clojure.string :as str]))
+
+(def gap-ms
+  "Edits to the same leaves closer together than this are one step: a drag
+  writes a vertex per pointermove, and is one thing to undo. Only when each
+  starts where the last left off — anything landing between them, a
+  collaborator's write included, makes the next edit a step of its own."
+  1000)
+
+(def depth 200)
+
+(defn- changes
+  "`[before after]`, restricted to the paths that differ."
+  [before after]
+  (reduce (fn [[b a :as acc] path]
+            (let [x (get before path)
+                  y (get after path)]
+              (if (= x y) acc [(assoc b path x) (assoc a path y)])))
+          [{} {}]
+          (distinct (concat (keys before) (keys after)))))
+
+(defn- node-name [leaves path]
+  (let [[_ _ _ sid _ nid] (str/split path #"/")
+        node (get leaves (str/join "/" ["clip" "u" "symbol" sid "node" nid]))]
+    (or (:name node) (str/replace nid "~" "/"))))
+
+(defn- said
+  "What one changed leaf was, in words, and how much it outranks the others:
+  making or deleting a thing names the step before editing it does."
+  [before after path]
+  (let [[_ _ kind a b] (str/split path #"/")
+        leaves (merge before after)]
+    (case [kind b]
+      ["symbol" nil]  [1 (str "symbol " (or (:name (get leaves path)) (str/replace a "~" "/")))]
+      ["symbol" "node"]
+      (cond (nil? (get before path)) [0 (str "add " (node-name leaves path))]
+            (nil? (get after path))  [0 (str "delete " (node-name leaves path))]
+            :else                    [1 (str "edit " (node-name leaves path))])
+      (if (#{"channel" "measured"} b)
+        [1 (str "edit " (node-name leaves path))]
+        [2 (case kind
+             ("timing" "stage" "name") "project settings"
+             ("subject" "feature" "group") "tracking settings"
+             kind)]))))
+
+(defn label
+  "A step in words: \"add shape 3\", \"edit mouth, brow-l\"."
+  [before after paths]
+  (let [said (->> paths (map #(said before after %)) distinct sort)
+        top  (first (first said))
+        words (distinct (map second (filter #(= top (first %)) said)))]
+    (str (str/join ", " (take 2 words)) (when (< 2 (count words)) " …"))))
+
+(defn record
+  "History `h` with an edit from leaves `before` to `after` at time `now`."
+  [{:keys [done] :as h} before after now]
+  (let [[b a] (changes before after)
+        top   (peek done)]
+    (cond
+      (empty? a) h
+      (and top (< (- now (:at top)) gap-ms) (= b (:after top)))
+      {:done (conj (pop done) (assoc top :after a :at now)) :undone []}
+      :else
+      {:done (conj (vec (take-last (dec depth) done))
+                   {:before b :after a :at now :label (label before after (keys a))})
+       :undone []})))
+
+(defn steps
+  "The labels, newest first: `:done` is what undo would take off, `:undone`
+  what redo would put back."
+  [h]
+  {:done   (mapv :label (rseq (or (:done h) [])))
+   :undone (mapv :label (rseq (or (:undone h) [])))})
+
+(defn- holds? [leaves m]
+  (every? (fn [[path v]] (= v (get leaves path))) m))
+
+(defn- put-all [leaves m]
+  (reduce-kv (fn [ls path v] (if (nil? v) (dissoc ls path) (assoc ls path v))) leaves m))
+
+(defn- move
+  "One step from `from` to `to`, if `leaves` still hold what it expects."
+  [h leaves from to expect write]
+  (when-let [step (peek (get h from))]
+    (let [h (update h from pop)]
+      (if (holds? leaves (expect step))
+        {:leaves (put-all leaves (write step)) :history (update h to (fnil conj []) step)}
+        {:blocked step :history h}))))
+
+(defn undo
+  "`{:leaves :history}`, `{:blocked :history}` when somebody else has since
+  changed what the step touched, or nil with nothing to undo."
+  [h leaves]
+  (move h leaves :done :undone :after :before))
+
+(defn redo [h leaves]
+  (move h leaves :undone :done :before :after))

frontend/src/arthur/domain/leaf.cljs

@@ -177,7 +177,9 @@
              (let [sid (unsegment a)
                    acc (assoc-in acc [:symbols sid :id] sid)]
                (case b
-                 nil        (update-in acc [:symbols sid] merge v)
+                 ;; `:nodes` is there before any node leaf is: an empty
+                 ;; symbol has none, and is still a symbol.
+                 nil        (update-in acc [:symbols sid] #(merge {:nodes {}} % v))
                  "node"     (update-in acc [:symbols sid :nodes (unsegment c)] merge v)
                  "measured" (assoc-in acc [:symbols sid :nodes (unsegment c) :measured] v)
                  "channel"  (assoc-in acc [:symbols sid :nodes (unsegment c)

frontend/src/arthur/domain/project.cljs

@@ -89,19 +89,27 @@
                                   :state (when state (wire/base64 state))}))
                          (block-keys leaves)))})))
 
+(defn tier1
+  "A response's leaves object -> `{path value}`, the shape `leaf/leaves` returns."
+  [^js leaves]
+  (into {} (map (fn [path] [path (wire/decode-json (aget leaves path))]))
+        (js-keys leaves)))
+
+(defn store
+  "Fetched blocks -> the store `save` reads them back out of."
+  [blocks]
+  (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 #js []))))
+
 (defn load
   "The parsed response -> `{:clip :store}`, which is what `flow/freeze` returns
   and therefore what the player already knows how to play."
   [cid ^js doc]
-  (let [leaves (.-leaves doc)
+  {:clip (leaf/clip cid (tier1 (.-leaves doc)))
-        tier1  (into {} (map (fn [path] [path (wire/decode-json (aget leaves path))]))
+   :store (store (.-blocks doc))})
-                     (js-keys leaves))]
-    {:clip (leaf/clip 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 [])))}))

frontend/src/arthur/events/collab.cljs

@@ -0,0 +1,438 @@
+(ns arthur.events.collab
+  "Everything that makes a document somewhere other people are: its address, who
+  you are, who else is in it, and their writes arriving while you work.
+
+  docs/architecture.md, Collaboration, and tl's model with the four additions it
+  asks for. Writes stay on HTTP; the socket carries presence and the deltas the
+  server broadcasts after a write commits.
+
+  ONE RULE FOR THE ADDRESS AND THE ROOM. They follow `[:project :id]`, whatever
+  event changed it — open, save, new, a copy — through one interceptor, so no
+  event that loads a document has to remember to join its room.
+
+  THE OUTBOX RULE, without an outbox. A remote leaf lands unless we have a change
+  to that leaf the server has not seen — a leaf whose local value differs from the
+  last value we synced. Otherwise their write would snap our unsaved edit back.
+  The next save sends ours, and if theirs moved since, it answers 409 and we catch
+  up, and the save after that is ours."
+  (:require [arthur.domain.leaf :as leaf]
+            [arthur.domain.project :as project]
+            [arthur.events.edit :as edit]
+            [arthur.events.playback :as pb]
+            [arthur.events.project :as events.project]
+            [arthur.footage.store :as store]
+            [arthur.fx.http :as http]
+            [clojure.string :as str]
+            [re-frame.core :as rf]))
+
+;; ---------------------------------------------------------------------------
+;; the address
+
+(defn- path-id
+  "The project a path names: `/p/<uuid>/<slug>`. The slug is for people; the
+  id is what finds it."
+  [path]
+  (second (re-matches #"/p/([0-9a-fA-F-]{36})(?:/.*)?" path)))
+
+(defn slug [name]
+  (or (not-empty (-> (str/lower-case (or name ""))
+                     (str/replace #"[^a-z0-9]+" "-")
+                     (str/replace #"^-+|-+$" "")))
+      "untitled"))
+
+(defn project-path [id name] (str "/p/" id "/" (slug name)))
+
+(defn- route! []
+  (rf/dispatch [::routed (path-id (.. js/window -location -pathname))]))
+
+(defn navigate! [path]
+  (.pushState js/history nil "" path)
+  (route!))
+
+(rf/reg-event-fx
+ ::routed
+ ;; `/` is the index of your projects; a project is only ever at its address.
+ (fn [{:keys [db]} [_ id]]
+   (cond
+     (nil? id) {:db (assoc db :route :index)
+                :dispatch [::events.project/list]}
+     (= id (get-in db [:project :id])) {:db (assoc db :route [:project id])}
+     :else {:db (assoc db :route [:project id])
+            :dispatch [::events.project/open id]})))
+
+(rf/reg-sub ::route (fn [db _] (:route db)))
+
+(rf/reg-fx
+ ::create!
+ (fn [name]
+   (-> (http/POST "/api/projects" #js {:name name})
+       (.then (fn [^js made] (navigate! (project-path (.-id made) (.-name made)))))
+       (.catch #(rf/dispatch [::refused (ex-message %)])))))
+
+(rf/reg-event-fx ::create (fn [_ [_ name]] {::create! (or name "untitled")}))
+
+;; ---------------------------------------------------------------------------
+;; the socket
+
+(defonce ^:private socket (atom nil))
+(defonce ^:private conn (atom {:id nil :tries 0 :timer nil}))
+
+(defn- ws-url [id]
+  (str (if (= "https:" (.. js/window -location -protocol)) "wss://" "ws://")
+       (.. js/window -location -host) "/ws/projects/" id))
+
+(declare open!)
+
+(defn- retry-later! [id]
+  (let [tries (:tries @conn)
+        delay (min 30000 (* 500 (js/Math.pow 2 tries)))]
+    (swap! conn assoc :tries (inc tries)
+           :timer (js/setTimeout #(when (= id (:id @conn)) (open! id)) delay))))
+
+(defn- open! [id]
+  (let [s (js/WebSocket. (ws-url id))]
+    (reset! socket s)
+    (set! (.-onopen s) (fn [_] (swap! conn assoc :tries 0)))
+    (set! (.-onmessage s) (fn [e] (rf/dispatch [::message (js/JSON.parse (.-data e))])))
+    ;; Only the CURRENT socket clears the roster and retries: closing the last
+    ;; project's on a switch must not wipe the new one's.
+    (set! (.-onclose s) (fn [_]
+                          (when (identical? s @socket)
+                            (reset! socket nil)
+                            (rf/dispatch [::peers-reset])
+                            (retry-later! id))))))
+
+(defn- connect! [id]
+  (some-> (:timer @conn) js/clearTimeout)
+  (when-let [s @socket] (set! (.-onclose s) nil) (.close s))
+  (reset! socket nil)
+  (reset! conn {:id id :tries 0 :timer nil})
+  (rf/dispatch [::peers-reset])
+  (when id (open! id)))
+
+(rf/reg-fx
+ ::follow!
+ (fn [{:keys [id name]}]
+   (when id
+     (let [here (.. js/window -location -pathname)
+           path (project-path id name)]
+       (cond
+         (= path here) nil
+         ;; Renamed: the same page, a new slug, and no new history entry.
+         (= id (path-id here)) (.replaceState js/history nil "" path)
+         :else (.pushState js/history nil "" path))))
+   (set! (.-title js/document) (if name (str name " — arthur") "arthur"))
+   (when (not= id (:id @conn))
+     (connect! id))))
+
+(rf/reg-fx ::reconnect! (fn [_] (connect! (:id @conn))))
+
+(def autosave?
+  "Every edit saves. Off only for tests that need an edit held unsaved."
+  true)
+
+(def ^:private follow
+  "The address, the title and the room follow the open project, and the
+  document saves itself on every edit — `:paint/revision` is what moves when
+  the document does. A save with nothing to send sends nothing, and one made
+  while another is in flight goes when it lands.
+
+  THERE IS NO BARE PROJECT. A document with no id on screen at a project's
+  address — a built-in example, opened from the menu — is saved at once, and
+  becomes a project with an address of its own."
+  (rf/->interceptor
+   :id ::follow
+   :after (fn [ctx]
+            (let [db     (get-in ctx [:effects :db] (get-in ctx [:coeffects :db]))
+                  before (get-in ctx [:coeffects :db :project])
+                  after  (:project db)]
+              (cond-> ctx
+                (not= (select-keys before [:id :name]) (select-keys after [:id :name]))
+                (update-in [:effects :fx] (fnil conj [])
+                           [::follow! (select-keys after [:id :name])])
+
+                (and autosave? (:id after) (vector? (:route db))
+                     (not= (:paint/revision db) (get-in ctx [:coeffects :db :paint/revision])))
+                (update-in [:effects :fx] (fnil conj [])
+                           [:dispatch [::events.project/save {:auto? true}]])
+
+                (and (nil? (:id after)) (vector? (:route db))
+                     (or (:id before) (not= (:cid before) (:cid after))))
+                (update-in [:effects :fx] (fnil conj [])
+                           [:dispatch [::events.project/save]]))))))
+
+;; ---------------------------------------------------------------------------
+;; presence
+
+(rf/reg-event-db ::peers-reset (fn [db _] (assoc db :peers {})))
+
+(defn- peer [^js m] {:cid (.-cid m) :user (.-user m)})
+
+(rf/reg-event-fx
+ ::message
+ (fn [{:keys [db]} [_ ^js m]]
+   (case (.-kind m)
+     "welcome" {:db (assoc db :peers {} :peer-cid (.-cid m))
+                ;; Anything written between our GET and our joining the room
+                ;; was broadcast to a room we were not in yet.
+                :dispatch [::catch-up]}
+     "roster"  {:db (update db :peers into (map (fn [^js p] [(.-cid p) (peer p)]))
+                            (array-seq (.-peers m)))}
+     ("join" "state") {:db (assoc-in db [:peers (.-cid m)] (peer m))}
+     "leave"   {:db (update db :peers dissoc (.-cid m))}
+     "delta"   {:dispatch [::delta m]}
+     "access"  {:dispatch [::catch-up]}
+     {})))
+
+(rf/reg-sub
+ ::peers
+ (fn [db _]
+   (->> (vals (:peers db))
+        (remove #(= (:cid %) (:peer-cid db)))
+        (sort-by (juxt (comp nil? :user) :user)))))
+
+;; ---------------------------------------------------------------------------
+;; their writes
+
+(defn- put [m path v] (if (nil? v) (dissoc m path) (assoc m path v)))
+
+(defn- landed
+  "Their change laid over ours, as `[local synced behind]`; a nil value is a
+  removal.
+
+  A leaf we have changed and not saved keeps our value, and theirs waits in
+  `behind` rather than in `synced`: `synced` is what we have SEEN, and putting
+  theirs there would let our next save overwrite it without a word. `take?` is
+  the first write winning — theirs was, so it goes on screen over ours."
+  [local synced behind theirs take?]
+  (let [pending? #(not= (get local %) (get synced %))]
+    (reduce-kv (fn [[now seen behind] path v]
+                 (cond
+                   (not (pending? path)) [(put now path v) (put seen path v) behind]
+                   take?                 [(put now path v) (put seen path v) (dissoc behind path)]
+                   :else                 [now seen (assoc behind path v)]))
+               [local synced behind] theirs)))
+
+(rf/reg-fx
+ ::fetch-blocks!
+ (fn [{:keys [keys then]}]
+   (-> (js/Promise.all (into-array (map #(http/GET (str "/api/blocks/" %)) keys)))
+       (.then #(rf/dispatch (conj then (project/store %))))
+       (.catch #(rf/dispatch [::events.project/failed (ex-message %)])))))
+
+(rf/reg-event-fx
+ ::remote
+ ;; `written` and `removed` against what we last synced; `blocks` is the store
+ ;; of any the new leaves name that we do not hold, once fetched.
+ (fn [{:keys [db]} [_ {:keys [by written removed take?] at :seq :as change} blocks]]
+   (let [cid    (get-in db [:project :cid])
+         entry  (store/entry (:clip/current db))
+         local  (leaf/leaves cid (:clip entry))
+         theirs (merge written (zipmap removed (repeat nil)))
+         lost   (if take?
+                  (count (filter #(not= (get local %) (get (:synced entry) %)) (keys theirs)))
+                  0)
+         [now synced behind] (landed local (:synced entry) (:behind entry) theirs take?)
+         have   (merge (:store entry) blocks)
+         lack   (remove #(contains? have %) (project/block-keys now))
+         status (fn [now synced]
+                  (if (pos? lost)
+                    (str lost (if (= 1 lost) " change" " changes")
+                         " of yours lost to someone else's at the same moment — in your undo list")
+                    (str (or by "someone") " saved r" at
+                         (when (not= now synced) " · yours unsaved"))))]
+     (cond
+       (seq lack)
+       {::fetch-blocks! {:keys lack :then [::remote change]}}
+
+       (= now local)
+       {:db (-> db
+                (update :clip/current
+                        #(or (store/edit-entry! % (fn [e] (assoc e :synced synced
+                                                                 :behind behind)))
+                             %))
+                (assoc-in [:project :seq] at)
+                ;; Our own write, back from the room, changes nothing to say.
+                (cond-> (or take? (not= by (get-in db [:me :username])))
+                  (assoc-in [:project :status] (status now synced))))}
+
+       :else
+       (let [clip (leaf/clip cid now)
+             ;; Theirs, so not a step of ours to undo.
+             db'  (-> (edit/replace-entry db #(-> %
+                                                  (assoc :clip clip :synced synced
+                                                         :behind behind)
+                                                  (update :store merge blocks)))
+                      (edit/transport clip)
+                      (update :project merge
+                              {:seq at :status (status now synced)}))]
+         (cond-> {:db db'}
+           (not= (:fps clip) (get-in db [:clip :fps]))
+           (assoc ::pb/seek! [(:fps clip) (pb/frames db') (get-in db [:playback :frame])])))))))
+
+(defn- ours
+  "The clip in a delta or a document that is the one open here."
+  [db clips]
+  (let [cid (get-in db [:project :cid])]
+    (first (filter #(= cid (.-cid ^js %)) (array-seq clips)))))
+
+(rf/reg-event-fx
+ ::delta
+ (fn [{:keys [db]} [_ ^js m]]
+   (let [local (get-in db [:project :seq])
+         seq   (.-seq m)]
+     (cond
+       (or (nil? local) (<= seq local)) {}
+       ;; A missed delta is a stale document forever, unless it is noticed.
+       (> seq (inc local)) {:dispatch [::catch-up]}
+       :else
+       (let [^js c (ours db (.-clips m))]
+         (cond-> {:db (cond-> (assoc-in db [:project :seq] seq)
+                        (.-name m) (assoc-in [:project :name] (.-name m)))}
+           c (assoc :dispatch [::remote {:seq seq :by (.-by m)
+                                         :written (project/tier1 (.-leaves c))
+                                         :removed (vec (.-removed c))}])))))))
+
+(rf/reg-fx
+ ::catch-up!
+ (fn [[id take?]]
+   (-> (http/GET (str "/api/projects/" id))
+       (.then #(rf/dispatch [::caught-up % take?]))
+       (.catch #(js/console.warn "catching up failed" %)))))
+
+(rf/reg-event-fx
+ ::catch-up
+ (fn [{:keys [db]} [_ take?]]
+   (if-let [id (get-in db [:project :id])]
+     {::catch-up! [id take?]}
+     {})))
+
+(rf/reg-event-fx
+ ::caught-up
+ ;; The whole document, diffed against what we last synced: which leaves they
+ ;; wrote, and which they deleted.
+ (fn [{:keys [db]} [_ ^js loaded take?]]
+   (let [^js c   (ours db (.-clips loaded))
+         synced  (:synced (store/entry (:clip/current db)))
+         theirs  (when c (project/tier1 (.-leaves c)))
+         access  {:owner (.-owner loaded) :editors (vec (.-editors loaded))
+                  :can-edit? (.-can_edit loaded)}]
+     (cond-> {:db (update db :project merge access)}
+       (and c (or take? (not= (.-seq loaded) (get-in db [:project :seq]))))
+       (assoc :dispatch [::remote {:seq (.-seq loaded) :by nil :take? take?
+                                   :written (into {} (remove (fn [[p v]] (= v (get synced p))))
+                                                  theirs)
+                                   :removed (remove #(contains? theirs %) (keys synced))}])))))
+
+;; ---------------------------------------------------------------------------
+;; who you are, and who else may write
+
+(rf/reg-fx
+ ::request!
+ (fn [{:keys [method url body then]}]
+   (-> (http/request! method url body)
+       (.then #(rf/dispatch (conj then %)))
+       (.catch #(rf/dispatch [::refused (ex-message %)])))))
+
+(rf/reg-event-fx ::who (fn [_ _] {::request! {:method "GET" :url "/api/me" :then [::signed]}}))
+
+(rf/reg-event-fx
+ ::sign-in
+ (fn [_ [_ mode username password]]
+   {::request! {:method "POST" :url (str "/api/" (name mode))
+                :body #js {:username username :password password}
+                :then [::signed]}}))
+
+(rf/reg-event-fx
+ ::sign-out
+ (fn [_ _] {::request! {:method "POST" :url "/api/logout" :then [::signed]}}))
+
+(rf/reg-event-fx
+ ::signed
+ ;; Who you are changes what you may write and what the room calls you.
+ (fn [{:keys [db]} [_ ^js who]]
+   (let [username (.-username who)
+         changed? (not= username (get-in db [:me :username]))]
+     (cond-> {:db (assoc db :me {:username username})}
+       (and changed? (contains? db :me)) (assoc ::reconnect! nil
+                                                :fx [[:dispatch [::catch-up]]
+                                                     [:dispatch [::events.project/list]]])))))
+
+(rf/reg-event-db ::refused (fn [db [_ message]] (assoc-in db [:me :error] message)))
+
+(rf/reg-sub ::me (fn [db _] (:me db)))
+
+(rf/reg-event-fx
+ ::add-editor
+ (fn [{:keys [db]} [_ username]]
+   {::request! {:method "POST" :url (str "/api/projects/" (get-in db [:project :id]) "/editors")
+                :body #js {:username username} :then [::editors]}}))
+
+(rf/reg-event-fx
+ ::remove-editor
+ (fn [{:keys [db]} [_ username]]
+   {::request! {:method "DELETE"
+                :url (str "/api/projects/" (get-in db [:project :id]) "/editors/"
+                          (js/encodeURIComponent username))
+                :then [::editors]}}))
+
+(rf/reg-event-db
+ ::editors
+ (fn [db [_ ^js answer]]
+   (-> (assoc-in db [:project :editors] (vec (.-editors answer)))
+       (update :me dissoc :error))))
+
+;; ---------------------------------------------------------------------------
+;; snapshots: named versions, now that every edit saves itself
+
+(defn- snapshots-url [db] (str "/api/projects/" (get-in db [:project :id]) "/revisions"))
+
+(rf/reg-event-fx
+ ::snapshots
+ (fn [{:keys [db]} _]
+   {::request! {:method "GET" :url (snapshots-url db) :then [::snapshots-listed]}}))
+
+(rf/reg-event-db
+ ::snapshots-listed
+ (fn [db [_ ^js answer]]
+   (assoc db :snapshots
+          (mapv (fn [^js r] {:id (.-id r) :name (.-summary r) :author (.-author r)
+                             :seq (.-seq r) :created (.-created r)})
+                (array-seq (.-revisions answer))))))
+
+(rf/reg-sub ::snapshot-list (fn [db _] (:snapshots db)))
+
+(rf/reg-event-fx
+ ::snapshot
+ (fn [{:keys [db]} [_ name]]
+   {::request! {:method "POST" :url (snapshots-url db) :body #js {:summary name}
+                :then [::snapshotted name]}}))
+
+(rf/reg-event-fx
+ ::snapshotted
+ (fn [{:keys [db]} [_ name _]]
+   {:db (assoc-in db [:project :status] (str "snapshot \"" name "\" taken"))
+    :dispatch [::snapshots]}))
+
+(rf/reg-event-fx
+ ::restore
+ ;; An ordinary write on the server, which comes back to every open tab —
+ ;; this one included — as a delta.
+ (fn [{:keys [db]} [_ {:keys [id name]}]]
+   {::request! {:method "POST" :url (str (snapshots-url db) "/" id "/restore")
+                :then [::restored name]}}))
+
+(rf/reg-event-db
+ ::restored
+ (fn [db [_ name _]] (assoc-in db [:project :status] (str "restored \"" name "\""))))
+
+;; ---------------------------------------------------------------------------
+
+(defn start!
+  "Follow the open project from now on, show what the address names — the
+  index, or a project — and answer the back button."
+  []
+  (rf/reg-global-interceptor follow)
+  (rf/dispatch [::who])
+  (route!)
+  (.addEventListener js/window "popstate" route!))

frontend/src/arthur/events/edit.cljs

@@ -11,13 +11,32 @@
   the edit.
 
   It started life private inside `events/paint`, which was right while polygons
-  were the only thing anyone could edit. They are not."
+  were the only thing anyone could edit. They are not.
-  (:require [arthur.footage.store :as store]))
 
-(defn edit-entry
+  It is also where UNDO is recorded, for the same reason: being the one way a
-  "Apply `f` to the loaded ENTRY — the document and the blocks, footage and
+  person changes the document, it is the one place that sees every change they
-  source tracks beside it — and return the new db. For an edit that brings tier-2
+  make — and nothing else. A collaborator's write and an undo itself go through
-  data in with it, which a document edit alone cannot."
+  `replace-entry`, which is this without the recording."
+  (:require [arthur.domain.history :as history]
+            [arthur.domain.leaf :as leaf]
+            [arthur.footage.store :as store]))
+
+(defn leaves
+  "The clip as leaves, which is what a history step is made of; nil for a clip
+  that has no leaf form."
+  [clip]
+  (try (leaf/leaves "u" clip) (catch :default _ nil)))
+
+(defn- recorded [f]
+  (fn [entry]
+    (let [after (f entry)
+          b     (when-not (identical? (:clip entry) (:clip after)) (leaves (:clip entry)))
+          a     (when b (leaves (:clip after)))]
+      (cond-> after
+        a (assoc :history (history/record (:history entry) b a (js/Date.now)))))))
+
+(defn replace-entry
+  "Apply `f` to the loaded entry without recording it as a step of yours."
   [db f]
   (let [id (store/edit-entry! (:clip/current db) f)]
     (if id
@@ -27,6 +46,21 @@
           (update :project merge {:status "edited · unsaved"}))
       db)))
 
+(defn edit-entry
+  "Apply `f` to the loaded ENTRY — the document and the blocks, footage and
+  source tracks beside it — and return the new db. For an edit that brings tier-2
+  data in with it, which a document edit alone cannot."
+  [db f]
+  (replace-entry db (recorded f)))
+
+(defn transport
+  "App-db's copy of what the transport reads off the clip, after the clip was
+  replaced under it — as `::events.project/project-setting` writes it."
+  [db clip]
+  (cond-> (update db :clip merge (select-keys clip [:width :height]))
+    (not= (:fps clip) (get-in db [:clip :fps]))
+    (update :clip merge {:fps (:fps clip) :display-fps (:fps clip)})))
+
 (defn edit
   "Apply `f` to the loaded clip and return the new db."
   [db f]

frontend/src/arthur/events/history.cljs

@@ -0,0 +1,81 @@
+(ns arthur.events.history
+  "Undo and redo: `domain/history` against the open document, and the keys.
+
+  An undone step is an ordinary unsaved edit afterwards, and the next save sends
+  it — so undo reaches a collaborator the way any change of yours does."
+  (:require [arthur.domain.history :as history]
+            [arthur.domain.leaf :as leaf]
+            [arthur.events.edit :as edit]
+            [arthur.events.playback :as pb]
+            [arthur.footage.store :as store]
+            [re-frame.core :as rf]))
+
+(defn- step
+  "One step of `move` on `db`: `{:db :fps :ok?}`, `:ok?` false when there was
+  nothing to do or the step was refused."
+  [db move done]
+  (let [entry  (store/entry (:clip/current db))
+        leaves (edit/leaves (:clip entry))
+        r      (when leaves (move (:history entry) leaves))]
+    (cond
+      (nil? r)
+      {:db (assoc-in db [:project :status] (str "nothing to " (subs done 0 4))) :ok? false}
+
+      (:blocked r)
+      {:db (-> (edit/replace-entry db #(assoc % :history (:history r)))
+               (assoc-in [:project :status]
+                         (str "not " done ": " (:label (:blocked r))
+                              " — someone else has changed it since")))
+       :ok? false}
+
+      :else
+      (let [clip (leaf/clip "u" (:leaves r))
+            [kind host node] (get-in db [:ui :selection])
+            label (:label (peek (get (:history r) (if (= done "undone") :undone :done))))]
+        {:ok? true
+         :db  (-> (edit/replace-entry db #(assoc % :clip clip :history (:history r)))
+                  (edit/transport clip)
+                  ;; A selection of what the step removed selects nothing.
+                  (cond-> (and (= :node kind) (nil? (get-in clip [:symbols host :nodes node])))
+                    (update :ui dissoc :selection))
+                  (assoc-in [:project :status] (str done " " label " · unsaved")))}))))
+
+(defn- steps
+  "`n` steps, stopping at the first that cannot be taken."
+  [db move done n]
+  (let [fps (get-in db [:clip :fps])
+        db  (loop [db db n n]
+              (let [r (step db move done)]
+                (if (and (:ok? r) (< 1 n)) (recur (:db r) (dec n)) (:db r))))]
+    (cond-> {:db db}
+      (not= fps (get-in db [:clip :fps]))
+      (assoc ::pb/seek! [(get-in db [:clip :fps]) (pb/frames db) (get-in db [:playback :frame])]))))
+
+(rf/reg-event-fx ::undo (fn [{:keys [db]} [_ n]] (steps db history/undo "undone" (or n 1))))
+(rf/reg-event-fx ::redo (fn [{:keys [db]} [_ n]] (steps db history/redo "redone" (or n 1))))
+
+(rf/reg-sub
+ ::steps
+ ;; The history is on the entry, outside app-db; the revision is what moves
+ ;; when the entry does, undo and redo included.
+ (fn [db _]
+   (:paint/revision db)
+   (history/steps (:history (store/entry (:clip/current db))))))
+
+(defn- typing? [^js target]
+  (or (#{"INPUT" "TEXTAREA" "SELECT"} (.-tagName target)) (.-isContentEditable target)))
+
+(defn install-keys!
+  "⌘Z / Ctrl+Z undoes, with Shift redoes, and Ctrl+Y redoes. Not while typing
+  in a field, where the browser's own undo is the one wanted."
+  []
+  (.addEventListener
+   js/window "keydown"
+   (fn [^js e]
+     (when (and (or (.-metaKey e) (.-ctrlKey e)) (not (typing? (.-target e))))
+       (let [k (.toLowerCase (.-key e))]
+         (when-let [ev (cond (and (= k "z") (.-shiftKey e)) ::redo
+                             (= k "z") ::undo
+                             (= k "y") ::redo)]
+           (.preventDefault e)
+           (rf/dispatch [ev])))))))

frontend/src/arthur/events/project.cljs

@@ -113,6 +113,11 @@
                    (let [entry (merge (select-keys built [:fps :width :height])
                                       {:label (str (or (.-name clip-json) cid) " (saved)")
                                        :cid cid
+                                       ;; What the server holds, as of the seq
+                                       ;; this was opened at: a save sends what
+                                       ;; differs from it, and a collaborator's
+                                       ;; write lands on what does not.
+                                       :synced (project/tier1 (.-leaves clip-json))
                                        :display-fps (:fps built)
                                        :clip built :store (:store loaded)
                                        :footage-id footage-id
@@ -168,19 +173,48 @@
               (update :project merge {:status (str "brought in " label)}))
       :dispatch [::pb/refresh-clock]})))
 
+(defn- clip-payload
+  "One clip of a save. With `base` — the seq the open document last caught up
+  to — only the leaves that differ from what the server held then, and the ones
+  since deleted: a collaborator's leaves are not ours to write back. Without it,
+  the whole clip."
+  [^js doc base local synced]
+  (if base
+    (let [all (.-leaves doc)
+          out (js-obj)]
+      (doseq [[path v] local :when (not= v (get synced path))]
+        (aset out path (aget all path)))
+      #js {:leaves out
+           :removed (into-array (remove #(contains? local %) (keys synced)))})
+    #js {:leaves (.-leaves doc)}))
+
+(defonce ^:private on-server
+  ;; Analyses and block keys this page has already put on the server. Content
+  ;; addressed, so once there they are there: a save of a moved vertex asks for
+  ;; none of it again, and is one request.
+  (atom #{}))
+
+(defn- upload-new! [^js doc]
+  (let [keys (array-seq (block-keys doc))]
+    (if (every? @on-server keys)
+      (js/Promise.resolve 0)
+      (.then (upload-missing! doc) (fn [n] (swap! on-server into keys) n)))))
+
 (rf/reg-fx
  ::save!
- (fn [{:keys [id cid label clip]}]
+ (fn [{:keys [id cid label clip base]}]
    (let [analysis (:analysis (:clip clip))
          doc      (project/save cid clip)
+         local    (leaf/leaves cid (:clip clip))
+         base     (when (and id (:synced clip)) base)
          source-blocks (:source-blocks clip)]
      (-> (ensure-project! id label)
          (.then (fn [pid]
-                  (-> (if analysis
+                  (-> (if (and analysis (not (@on-server (:id analysis))))
                         (http/POST "/api/analyses" (analysis-payload analysis))
                         (js/Promise.resolve nil))
                       (.then (fn [_]
-                               (when (seq source-blocks)
+                               (when (and (seq source-blocks) (not (@on-server (:id analysis))))
                                  (-> (upload-missing!
                                       #js {:blocks (source/upload-blocks source-blocks)})
                                      (.then (fn [_]
@@ -192,24 +226,32 @@
                                                #js {:source_blocks
                                                     (into-array
                                                      (source/block-keys source-blocks))})))))))
-                      (.then (fn [_] (upload-missing! doc)))
+                      (.then (fn [_]
+                               (when analysis (swap! on-server conj (:id analysis)))
+                               (upload-new! doc)))
                       (.then (fn [uploaded]
                                (-> (http/PUT (str "/api/projects/" pid)
                                              #js {:name label
-                                                  :clips #js [#js {:cid cid
+                                                  :base base
-                                                                   :name label
+                                                  :clips #js [(js/Object.assign
-                                                                   :analysis (:id analysis)
+                                                               #js {:cid cid
-                                                                   :footage (:footage-id clip)
+                                                                    :name label
-                                                                   :leaves (.-leaves doc)
+                                                                    :analysis (:id analysis)
-                                                                   :blocks (block-keys doc)}]})
+                                                                    :footage (:footage-id clip)
+                                                                    :blocks (block-keys doc)}
+                                                               (clip-payload doc base local
+                                                                             (:synced clip)))]})
                                    (.then (fn [^js saved]
                                             (rf/dispatch [::saved pid cid label
                                                           (.-seq saved)
                                                           (count (array-seq (.-written saved)))
-                                                          uploaded])))))))))
+                                                          uploaded
+                                                          {:synced local :base base}])))))))))
          (.catch (fn [error]
                    (js/console.error error)
-                   (rf/dispatch [::failed (or (ex-message error) (str error))])))))))
+                   (if-let [conflicts (get-in (ex-data error) [:body :conflicts])]
+                     (rf/dispatch [::conflicted (count conflicts)])
+                     (rf/dispatch [::failed (or (ex-message error) (str error))]))))))))
 
 (rf/reg-fx
  ::list!
@@ -219,6 +261,7 @@
                 (rf/dispatch [::listed
                               (mapv (fn [^js row]
                                       {:id (.-id row) :name (.-name row)
+                                       :owner (.-owner row)
                                        :seq (.-seq row) :updated (.-updated row)})
                                     (array-seq (.-projects listed)))])))
        (.catch (fn [error]
@@ -250,6 +293,8 @@
 
 (rf/reg-sub ::assets (fn [db _] (:assets db)))
 
+(declare blank-entry)
+
 (rf/reg-fx
  ::open!
  (fn [id]
@@ -269,15 +314,21 @@
                                          (.-schema_version loaded) " and this client reads "
                                          project/schema-version)
                                     {})))
-                  (when-not clip-json
+                  ;; A project made from the index has nothing in it yet: it
-                    (throw (ex-info "that project has no clips" {})))
+                  ;; opens on a blank document, of which the server has seen
-                  (-> (opened-entry! clip-json)
+                  ;; nothing, so the first save sends all of it.
+                  (-> (if clip-json
+                        (opened-entry! clip-json)
+                        (js/Promise.resolve (assoc (blank-entry) :synced {})))
                       (.then (fn [entry]
                                (rf/dispatch [::opened
                                              (store/install! entry "project")
                                              (.-id loaded)
                                              (.-name loaded)
-                                             (.-seq loaded)])))))))
+                                             (.-seq loaded)
+                                             {:owner (.-owner loaded)
+                                              :editors (vec (.-editors loaded))
+                                              :can-edit? (.-can_edit loaded)}])))))))
        (.catch (fn [error]
                  (js/console.error error)
                  (rf/dispatch [::failed (or (ex-message error) (str error))]))))))
@@ -481,14 +532,50 @@
 
 (rf/reg-event-fx
  ::save
- (fn [{:keys [db]} _]
+ ;; `auto?` is the save an edit schedules (see `arthur.events.collab`): it does
+ ;; not lock the controls the way a save you asked for does, and it never saves
+ ;; somebody else's project as a copy. Either kind waits its turn behind one in
+ ;; flight, and writes nothing when nothing changed. `force?` saves what is not a leaf —
+ ;; the name.
+ (fn [{:keys [db]} [_ {:keys [auto? force?] :as how}]]
    (let [id   (:clip/current db)
-         clip (store/entry id)]
+         clip (store/entry id)
-     (if (or (:busy? (:project db)) (nil? clip))
+         {pid :id :keys [busy? saving? can-edit?]} (:project db)
+         cid  (or (:cid clip) (name id))]
+     (cond
+       (nil? clip)
        {}
-       {:db (update db :project merge {:busy? true :status "saving…"})
+
-        ::save! {:id    (:id (:project db))
+       ;; Behind the one in flight, never instead of it: an edit made while a
-                 :cid   (or (:cid clip) (name id))
+       ;; save is on the wire is not in that save. One request at a time, and
+       ;; the next carries everything that changed meanwhile — so a drag goes
+       ;; out as fast as the round trip allows, and no faster.
+       (or busy? saving?)
+       {:db (assoc-in db [:project :again] (or how {}))}
+
+       (and auto? (false? can-edit?))
+       {}
+
+       (and pid (:synced clip) (not force?) (empty? (:behind clip))
+            (= (:synced clip) (try (leaf/leaves cid (:clip clip)) (catch :default _ nil))))
+       {}
+
+       ;; Somebody else wrote leaves we had changed too, first. The first
+       ;; write wins: theirs goes on screen over ours, which stays in our undo
+       ;; list. See `arthur.events.collab/landed`.
+       (seq (:behind clip))
+       {:dispatch [:arthur.events.collab/remote
+                   {:seq (get-in db [:project :seq]) :take? true
+                    :written (into {} (remove (comp nil? val)) (:behind clip))
+                    :removed (keep (fn [[p v]] (when (nil? v) p)) (:behind clip))}]}
+
+       :else
+       ;; Somebody else's project, which we may look at and not write, saves as
+       ;; a copy of our own.
+       {:db (update db :project merge {(if auto? :saving? :busy?) true :status "saving…"})
+        ::save! {:id    (when-not (false? can-edit?) pid)
+                 :base  (get-in db [:project :seq])
+                 :cid   cid
                  :label (or (:label clip) (name id))
                  :clip  clip}}))))
 
@@ -534,20 +621,46 @@
 
 (rf/reg-event-fx
  ::saved
- (fn [{:keys [db]} [_ id cid label seq written uploaded]]
+ (fn [{:keys [db]} [_ id cid label seq written uploaded {:keys [synced base]}]]
-   {:db (update db :project merge
+   (let [fresh? (not= id (get-in db [:project :id]))]
-                {:id id :cid cid :name label :seq seq :busy? false
+     {:db (-> db
-                 :status (str "saved r" seq " · " written
+              (update :clip/current #(or (store/edit-entry! % (fn [e] (-> (assoc e :synced synced)
-                              (if (= 1 written) " leaf" " leaves")
+                                                                            (dissoc :behind))))
-                              " · " uploaded (if (= 1 uploaded) " block" " blocks"))})
+                                         %))
-    ;; The all-assets folder lists saved symbols, so a save can add rows to it.
+              (update :project dissoc :again)
-    :dispatch [::list-symbols]}))
+              (update :project merge
+                      {:id id :cid cid :name label :seq seq :busy? false :saving? false
+                       :status (str "saved r" seq " · " written
+                                    (if (= 1 written) " leaf" " leaves")
+                                    " · " uploaded (if (= 1 uploaded) " block" " blocks"))}
+                      (when fresh?
+                        {:owner (get-in db [:me :username]) :editors [] :can-edit? true})))
+      :fx [;; The all-assets folder lists saved symbols, so a save can add rows to it.
+           [:dispatch [::list-symbols]]
+           ;; Somebody wrote between what we last saw and this save. Their
+           ;; deltas may still be on the wire, and a seq we have jumped past
+           ;; would drop them, so ask for the document instead.
+           (when (and base (not= seq (inc base)))
+             [:dispatch [:arthur.events.collab/catch-up]])
+           (when-let [how (get-in db [:project :again])]
+             [:dispatch [::save how]])]})))
+
+(rf/reg-event-fx
+ ::conflicted
+ ;; Nothing was written: somebody else's write to the same leaves got there
+ ;; first. Catching up TAKES theirs, over ours — then the rest of ours saves.
+ (fn [{:keys [db]} [_ n]]
+   {:db (-> db
+            (update :project dissoc :again)
+            (update :project merge {:busy? false :saving? false}))
+    :fx [[:dispatch [:arthur.events.collab/catch-up true]]
+         [:dispatch [::save {:auto? true}]]]}))
 
 (rf/reg-event-fx
  ::opened
- (fn [{:keys [db]} [_ clip-id project-id name seq]]
+ (fn [{:keys [db]} [_ clip-id project-id name seq access]]
    {:db (-> (pb/show db clip-id)
-            (update :project merge
+            (update :project merge access
                     {:id project-id :name name :seq seq
                      :cid (:cid (store/entry clip-id))
                      :busy? false
@@ -556,7 +669,11 @@
     ::pb/seek! (let [{c :clip fps :fps} (store/entry clip-id)]
                  [fps (clip/frames c (clip/opens-on c)) 0])}))
 
-(rf/reg-event-db
+(rf/reg-event-fx
  ::failed
- (fn [db [_ message]]
+ (fn [{:keys [db]} [_ message]]
-   (update db :project merge {:busy? false :status (str "failed: " message)})))
+   (cond-> {:db (-> db
+                    (update :project dissoc :again)
+                    (update :project merge {:busy? false :saving? false
+                                            :status (str "failed: " message)}))}
+     (get-in db [:project :again]) (assoc :dispatch [::save (get-in db [:project :again])]))))

frontend/src/arthur/ui/index.cljs

@@ -0,0 +1,44 @@
+(ns arthur.ui.index
+  "`/`: the projects you own and edit, and a way to make one. A project is only
+  ever at its own address, so this is where you are when you are in none.
+
+  Over the editor rather than instead of it: the stage, the audio element and
+  the draw loop stay mounted, and opening a project is showing them again."
+  (:require [arthur.events.collab :as collab]
+            [arthur.events.project :as project]
+            [arthur.ui.share :as share]
+            [re-frame.core :as rf]))
+
+(defn view []
+  (when (= :index @(rf/subscribe [::collab/route]))
+    (let [{:keys [username error]} @(rf/subscribe [::collab/me])
+          {:keys [items loading?]} @(rf/subscribe [::project/listing])]
+      [:div.index
+       [:header.top
+        [:span.brand "arthur"]
+        [:span.status]
+        [share/account]]
+       [:main.index-body
+        (if-not username
+          [:<>
+           [:h1 "arthur"]
+           [:p.dim "Sign in, or create an account, to see your projects and make new ones."]]
+          [:<>
+           [:div.index-head
+            [:h1 "projects"]
+            [:button {:on-click #(rf/dispatch [::collab/create])} "new project"]]
+           (when error [:p.warn error])
+           (cond
+             loading?       [:p.dim "…"]
+             (empty? items) [:p.dim "Nothing yet. A new project starts empty."]
+             :else
+             [:ul.index-list
+              (doall
+               (for [{:keys [id name owner seq updated]} items
+                     :let [path (collab/project-path id name)]]
+                 ^{:key id}
+                 [:li
+                  [:a {:href path :on-click (fn [e] (.preventDefault e) (collab/navigate! path))}
+                   (or name "untitled")]
+                  [:span.dim (str (when (not= owner username) (str owner " · "))
+                                  "r" seq " · " (subs (str updated) 0 10))]]))])])]])))

frontend/src/arthur/ui/share.cljs

@@ -0,0 +1,99 @@
+(ns arthur.ui.share
+  "Who is here, who may write, and who you are: the top bar's right-hand end.
+
+  The same drop-down as `openmenu` — a button, a scrim, a panel — because these
+  are the same kind of thing: a few rows about the document, gone on the next
+  click."
+  (:require [arthur.events.collab :as collab]
+            [arthur.events.project :as project]
+            [arthur.subs.playback :as playback]
+            [clojure.string :as str]
+            [re-frame.core :as rf]
+            [reagent.core :as r]))
+
+(defn- menu
+  ([label open? body] (menu label open? nil body))
+  ([label open? class body]
+   [:div.menu-wrap
+    [:button {:class [class (when @open? "on")] :on-click #(swap! open? not)} label]
+   (when @open?
+     [:<> [:div.menu-scrim {:on-click #(reset! open? false)}]
+      (into [:div.menu] body)])]))
+
+(defn- initial [user] (str/upper-case (subs (or user "?") 0 1)))
+
+(defn- roster []
+  (let [peers @(rf/subscribe [::collab/peers])]
+    (when (seq peers)
+      [:span.roster {:title (str/join ", " (map #(or (:user %) "guest") peers))}
+       (doall (for [{:keys [cid user]} (take 5 peers)]
+                ^{:key cid} [:span.peer {:class (when-not user "guest")} (initial user)]))
+       (when (< 5 (count peers)) [:span.dim (str "+" (- (count peers) 5))])])))
+
+(defn- sharing []
+  (r/with-let [open? (r/atom false)
+               draft (r/atom "")]
+    (let [{:keys [id name owner editors can-edit?]} @(rf/subscribe [::playback/project])
+          {:keys [username error]} @(rf/subscribe [::collab/me])
+          owner? (and owner (= owner username))
+          link (str (.. js/window -location -origin) (collab/project-path id name))]
+      (when id
+        [menu (if (false? can-edit?) "view only ▾" "Share") open? "share-button"
+         [[:h2 "link"]
+          [:div.row
+           [:input.share-link {:read-only true :value link :on-focus #(.select (.-target %))}]
+           [:button {:on-click #(.writeText (.-clipboard js/navigator) link)} "copy"]]
+          (if (false? can-edit?)
+            [:<>
+             [:p.dim "you can view this; to change it, make a copy of your own"]
+             (when username
+               [:button {:on-click (fn [] (reset! open? false)
+                                     (rf/dispatch [::project/save]))}
+                "make a copy"])]
+            [:p.dim "anyone with the link can view"])
+          (when owner
+            [:<>
+             [:h2 "can edit"]
+             [:div.menu-item.static owner [:span.sub "owner"]]
+             (doall (for [e editors]
+                      ^{:key e}
+                      [:div.menu-item.static e
+                       (when owner?
+                         [:button.link {:on-click #(rf/dispatch [::collab/remove-editor e])}
+                          "remove"])]))
+             (when owner?
+               [:form.row {:on-submit (fn [ev]
+                                        (.preventDefault ev)
+                                        (when (seq (str/trim @draft))
+                                          (rf/dispatch [::collab/add-editor (str/trim @draft)])
+                                          (reset! draft "")))}
+                [:input {:placeholder "username" :value @draft
+                         :on-change #(reset! draft (.. % -target -value))}]
+                [:button {:type "submit"} "add"]])
+             (when error [:p.warn error])])]]))))
+
+(defn account []
+  (r/with-let [open? (r/atom false)
+               username (r/atom "")
+               password (r/atom "")]
+    (let [{signed-in :username :keys [error]} @(rf/subscribe [::collab/me])
+          go! (fn [mode] (rf/dispatch [::collab/sign-in mode @username @password])
+                (reset! password ""))]
+      (if signed-in
+        [menu (str signed-in " ▾") open?
+         [[:button.menu-item {:on-click (fn [] (reset! open? false)
+                                          (rf/dispatch [::collab/sign-out]))}
+           "sign out"]]]
+        [menu "sign in ▾" open?
+         [[:form.account {:on-submit (fn [e] (.preventDefault e) (go! :login))}
+           [:input {:placeholder "username" :auto-complete "username" :value @username
+                    :on-change #(reset! username (.. % -target -value))}]
+           [:input {:type "password" :placeholder "password" :auto-complete "current-password"
+                    :value @password :on-change #(reset! password (.. % -target -value))}]
+           [:div.row
+            [:button {:type "submit"} "sign in"]
+            [:button {:type "button" :on-click #(go! :signup)} "create account"]]
+           (when error [:p.warn error])]]]))))
+
+(defn view []
+  [:<> [roster] [sharing] [account]])

frontend/src/arthur/ui/snapshots.cljs

@@ -0,0 +1,44 @@
+(ns arthur.ui.snapshots
+  "Named versions. Every edit saves itself, so there is nothing to save — only
+  moments worth a name, to go back to."
+  (:require [arthur.events.collab :as collab]
+            [arthur.subs.playback :as playback]
+            [clojure.string :as str]
+            [re-frame.core :as rf]
+            [reagent.core :as r]))
+
+(defn view []
+  (r/with-let [open? (r/atom false)
+               draft (r/atom "")]
+    (let [{:keys [can-edit?]} @(rf/subscribe [::playback/project])
+          rows @(rf/subscribe [::collab/snapshot-list])
+          editable? (not (false? can-edit?))]
+      [:div.menu-wrap
+       [:button {:class (when @open? "on")
+                 :on-click (fn [] (when-not @open? (rf/dispatch [::collab/snapshots]))
+                             (swap! open? not))}
+        "snapshots ▾"]
+       (when @open?
+         [:<> [:div.menu-scrim {:on-click #(reset! open? false)}]
+          [:div.menu.menu-left
+           (when editable?
+             [:form.row {:on-submit (fn [e]
+                                      (.preventDefault e)
+                                      (rf/dispatch [::collab/snapshot
+                                                    (or (not-empty (str/trim @draft)) "snapshot")])
+                                      (reset! draft ""))}
+              [:input {:placeholder "name this version" :value @draft :auto-focus true
+                       :on-change #(reset! draft (.. % -target -value))}]
+              [:button {:type "submit"} "take snapshot"]])
+           [:h2 "snapshots"]
+           (if (empty? rows)
+             [:div.dim "none yet"]
+             (doall
+              (for [{:keys [id name author created] :as row} rows]
+                ^{:key id}
+                [:div.menu-item.static
+                 [:span name [:span.sub (str author " · " (subs (str created) 0 16))]]
+                 (when editable?
+                   [:button.link {:on-click (fn [] (reset! open? false)
+                                              (rf/dispatch [::collab/restore row]))}
+                    "restore"])])))]])])))

frontend/src/arthur/ui/topbar.cljs

@@ -5,10 +5,14 @@
   Save, open and export are here rather than in a pane because none of them is a
   property of a selection — they act on the document, and the document is the
   window."
-  (:require [arthur.events.export :as export]
+  (:require [arthur.events.collab :as collab]
+            [arthur.events.export :as export]
             [arthur.events.project :as project]
             [arthur.subs.playback :as playback]
             [arthur.ui.openmenu :as openmenu]
+            [arthur.ui.share :as share]
+            [arthur.ui.snapshots :as snapshots]
+            [arthur.ui.undo :as undo]
             [re-frame.core :as rf]))
 
 (defn- exporter []
@@ -47,7 +51,8 @@
         {footage-status :status} @(rf/subscribe [::playback/footage])
         {export-status :status} @(rf/subscribe [::export/state])]
     [:header.top
-     [:span.brand "arthur"]
+     [:a.brand {:href "/" :title "your projects"
+                :on-click (fn [e] (.preventDefault e) (collab/navigate! "/"))} "arthur"]
      [:span.status
       (str (or project-name "untitled") (when seq (str " r" seq))
            ;; One line, and the most recent thing to have happened wins it. A
@@ -55,6 +60,8 @@
            (when-let [said (or export-status project-status footage-status)]
              (str " · " said)))]
      [exporter]
-     [:button {:disabled busy? :on-click #(rf/dispatch [::project/new])} "new"]
+     [:button {:disabled busy? :on-click #(rf/dispatch [::collab/create])} "new"]
      [openmenu/view]
-     [:button {:disabled busy? :on-click #(rf/dispatch [::project/save])} "save"]]))
+     [undo/view]
+     [snapshots/view]
+     [share/view]]))

frontend/src/arthur/ui/undo.cljs

@@ -0,0 +1,32 @@
+(ns arthur.ui.undo
+  "Undo, redo, and the list of what undo would take off — newest first, so
+  choosing the third row undoes three steps."
+  (:require [arthur.events.history :as history]
+            [re-frame.core :as rf]
+            [reagent.core :as r]))
+
+(defn view []
+  (r/with-let [open? (r/atom false)]
+    (let [{:keys [done undone]} @(rf/subscribe [::history/steps])]
+      [:div.menu-wrap.undo
+       [:button {:disabled (empty? done) :title (if (seq done) (str "undo " (first done) " (⌘Z)") "nothing to undo")
+                 :on-click #(rf/dispatch [::history/undo])}
+        "undo"]
+       [:button.undo-list {:disabled (empty? done) :class (when @open? "on")
+                           :title "undo history" :on-click #(swap! open? not)}
+        "▾"]
+       [:button {:disabled (empty? undone) :title (if (seq undone) (str "redo " (first undone) " (⇧⌘Z)") "nothing to redo")
+                 :on-click #(rf/dispatch [::history/redo])}
+        "redo"]
+       (when (and @open? (seq done))
+         [:<> [:div.menu-scrim {:on-click #(reset! open? false)}]
+          [:div.menu.menu-left
+           [:h2 "undo"]
+           (doall
+            (map-indexed
+             (fn [i label]
+               ^{:key i}
+               [:button.menu-item {:on-click (fn [] (reset! open? false)
+                                               (rf/dispatch [::history/undo (inc i)]))}
+                label (when (pos? i) [:span.sub (str (inc i) " steps")])])
+             (take 30 done)))]])])))

frontend/test/arthur/domain/history_test.cljs

@@ -0,0 +1,63 @@
+(ns arthur.domain.history-test
+  (:require [cljs.test :refer [deftest is testing]]
+            [arthur.domain.history :as history]))
+
+(def empty-doc {"t" 1})
+
+(deftest undo-and-redo-walk-your-own-steps
+  (let [made  (assoc empty-doc "b" :shape)
+        moved (assoc made "b" :moved)
+        h     (-> nil
+                  (history/record empty-doc made 0)
+                  (history/record made moved 5000))
+        one   (history/undo h moved)
+        two   (history/undo (:history one) (:leaves one))]
+    (is (= made (:leaves one)))
+    (is (= empty-doc (:leaves two)))
+    (is (nil? (history/undo (:history two) (:leaves two))))
+    (is (= made (:leaves (history/redo (:history two) (:leaves two)))))))
+
+(deftest a-drag-is-one-step
+  (let [h (reduce (fn [h [x t]] (history/record h {"v" (dec x)} {"v" x} t))
+                  nil [[1 0] [2 100] [3 200]])]
+    (is (= 1 (count (:done h))))
+    (is (= {"v" 0} (:leaves (history/undo h {"v" 3}))))))
+
+(deftest their-write-between-two-of-mine-keeps-them-apart
+  (let [h (-> nil
+              (history/record {"fps" 30} {"fps" 12} 0)
+              ;; theirs lands: 12 -> 9, not recorded
+              (history/record {"fps" 9} {"fps" 15} 300))]
+    (is (= 2 (count (:done h))))
+    (is (= {"fps" 9} (:leaves (history/undo h {"fps" 15}))))))
+
+(deftest undo-never-takes-somebody-elses-work
+  (testing "I make b; they edit it; I edit it; I undo twice"
+    (let [made   {"b" :shape}
+          theirs {"b" :their-edit}
+          mine   {"b" :my-edit}
+          h      (-> nil
+                     (history/record {} made 0)
+                     ;; their edit arrives as a remote write: not recorded
+                     (history/record theirs mine 5000))
+          one    (history/undo h mine)
+          two    (history/undo (:history one) (:leaves one))]
+      (is (= theirs (:leaves one)) "my edit comes off, theirs is what is left")
+      (is (:blocked two) "removing b would remove their edit, so it is refused")
+      (is (empty? (:done (:history two))) "and the refused step is dropped"))))
+
+(deftest a-new-edit-clears-redo
+  (let [h (history/record nil {} {"a" 1} 0)
+        u (history/undo h {"a" 1})
+        h (history/record (:history u) (:leaves u) {"c" 1} 9000)]
+    (is (nil? (history/redo h {"c" 1})))))
+
+(deftest a-step-says-what-it-was
+  (let [node "clip/u/symbol/main/node/b"
+        pts  "clip/u/symbol/main/channel/b/geom.pts"
+        made {node {:id :b :name "shape 3"} pts :p}]
+    (is (= "add shape 3" (history/label {} made [node pts])))
+    (is (= "edit shape 3" (history/label made (assoc made pts :q) [pts])))
+    (is (= "delete shape 3" (history/label made {} [node pts])))
+    (is (= "project settings" (history/label {} {"clip/u/timing" {:fps 9}} ["clip/u/timing"])))
+    (is (= ["add shape 3"] (:done (history/steps (history/record nil {} made 0)))))))

frontend/test/arthur/domain/leaf_test.cljs

@@ -30,6 +30,12 @@
     (testing label
       (is (= c (leaf/clip :c1 (leaf/leaves :c1 c)))))))
 
+(deftest an-empty-symbol-comes-back-a-symbol
+  ;; No node leaves, and still `:nodes {}`: nil there is what `symbol/nodes-of`
+  ;; refuses, so a saved blank document would not open.
+  (is (= (get-in (clip/blank) [:symbols :main])
+         (get-in (leaf/clip :c1 (leaf/leaves :c1 (clip/blank))) [:symbols :main]))))
+
 (deftest the-leaves-are-the-paths-the-sync-design-names
   (let [ls (leaf/leaves :c7 @take/clip)]
     (is (contains? ls "clip/c7/timing"))

frontend/test/browser/take.mjs

@@ -303,10 +303,27 @@ async function main() {
     if (!probe) throw new Error('no canvas.stage on the page — ' +
       (page.logs.slice(0, 3).join(' | ') || 'is `shadow-cljs watch app` running?'));
 
-    console.log(`\ncanvas ${probe.w}x${probe.h}, ${probe.doc}`);
+    // `/` is the index, and a project is only ever at its own address, so the
+    // suite signs up, makes one, and opens it — the page's own navigation, so
+    // this CDP session and its console stay attached.
+    const home = await page.eval(`(async () => {
+      const post = (url, body) => fetch(url, {method: 'POST', body: JSON.stringify(body),
+        headers: {'Content-Type': 'application/json',
+                  'X-CSRFToken': document.cookie.match(/csrftoken=([^;]+)/)[1]}}).then(r => r.json());
+      await post('/api/signup', {username: 'suite-' + Date.now().toString(36), password: 'password1'});
+      const made = await post('/api/projects', {name: 'untitled'});
+      arthur.events.collab.navigate_BANG_(arthur.events.collab.project_path(made.id, made.name));
+      return location.pathname; })()`);
+    for (let i = 0; i < 100; i++) {
+      probe = await page.eval(PROBE);
+      if (/opened/.test(probe.doc)) break;
+      await sleep(100);
+    }
 
-    check(probe.drawn === 0 && /new document/.test(probe.doc),
+    console.log(`\ncanvas ${probe.w}x${probe.h}, ${probe.doc} at ${home}`);
-          'the app opens on a blank document',
+
+    check(probe.drawn === 0 && /opened untitled/.test(probe.doc),
+          'a new project opens on a blank document',
           `${probe.drawn} px drawn — ${probe.doc}`);
     check(probe.w === 320 && probe.h === 200, 'the canvas is the stage size',
           `${probe.w}x${probe.h}`);
@@ -432,9 +449,10 @@ async function main() {
     await sleep(150);
     const sent = await sample(FRAMES);
 
-    check(await page.eval(CLICK('save')), 'save is clickable');
+    // There is no save: every edit saves itself, and a built-in example opened
+    // in a project becomes a project of its own at once.
     const saved = await statusMatching(/saved r\d+/);
-    check(saved !== null, 'the document saves', saved ?? (await page.eval(STATUS)));
+    check(saved !== null, 'the take becomes a saved project by itself', saved ?? (await page.eval(STATUS)));
     // Upload count may be zero when the content-addressed blocks already exist
     // on this server. The saved clip must still reference them.
     const savedBlocks = await page.eval(`(async () => {
@@ -445,14 +463,16 @@ async function main() {
     check(savedBlocks > 0, 'the saved clip references its tier 2 blocks',
           `${savedBlocks} blocks`);
 
-    // Again, unchanged. Content addressing means the second save uploads nothing
+    // Unchanged, nothing is written: the project's seq stands still. This is
-    // and rewrites nothing: this is the assertion that the keys are stable across
+    // the assertion that the keys are stable and a clean document is clean.
-    // two independent freezes of the same take, and that an unchanged leaf keeps
+    const seqOf = `(async () => {
-    // its version rather than being rewritten.
+      const id = location.pathname.split('/')[2];
-    check(await page.eval(CLICK('save')), 'save is clickable again');
+      return (await fetch('/api/projects/' + id).then(r => r.json())).seq; })()`;
-    const resaved = await statusMatching(/saved r\d+ · 0 leaves · 0 blocks/);
+    const seqBefore = await page.eval(seqOf);
-    check(resaved !== null, 'saving an unchanged document writes nothing',
+    await sleep(800);
-          resaved ?? (await page.eval(STATUS)));
+    const seqAfter = await page.eval(seqOf);
+    check(seqBefore === seqAfter, 'an unchanged document writes nothing',
+          `seq ${seqBefore} -> ${seqAfter}`);
 
     check(await fromMenu(MENU_PICK_NEWEST), 'open is clickable');
     const opened = await statusMatching(/opened /);
@@ -550,9 +570,8 @@ async function main() {
         .find(el => el.textContent.startsWith('key 8 → 16'));
       return label?.querySelector('select')?.value === 'linear';
     })()`), 'the second drawing gap can be set to tween');
-    check(await page.eval(CLICK('save')), 'the painted document can be saved');
+    check((await statusMatching(/saved r\d+/)) !== null,
-    check((await statusMatching(/saved r\d+ · \d+ leaves/)) !== null,
+          'the painted shape saves by itself', await page.eval(STATUS));
-          'the painted shape is saved', await page.eval(STATUS));
     check(await fromMenu(MENU_PICK_NEWEST), 'the painted document can be reopened');
     check((await statusMatching(/opened /)) !== null,
           'the painted shape is reopened', await page.eval(STATUS));

requirements.txt

@@ -6,7 +6,9 @@
 # arthur.domain.leaf. No Pillow either; the one thing the backend needs from a PNG
 # is its dimensions, which is a 24-byte header read in clips/blobs.py.
 #
-# Channels arrives with the websocket consumers, which are out of step 9's scope.
+# Channels for the one websocket — presence and broadcast deltas — and daphne to
+# serve it; `daphne` in INSTALLED_APPS makes `runserver` the same server.
 Django>=5.0,<6.0
-gunicorn>=23.0,<24.0
+channels>=4.2,<5.0
+daphne>=4.1,<5.0
 whitenoise>=6.9,<7.0

server/asgi.py

@@ -1,12 +1,25 @@
 """ASGI entry point.
 
-ASGI and not only WSGI because the collaboration design in docs/architecture.md
+HTTP is Django as usual. The websocket carries presence and the document deltas
-puts presence and document deltas on a websocket. Those consumers are out of step
+the server broadcasts after a write — never writes, which stay on HTTP. See
-9's scope; this is the half of their setup that costs nothing now.
+docs/architecture.md, Collaboration.
 """
 import os
 
 from django.core.asgi import get_asgi_application
 
 os.environ.setdefault("DJANGO_SETTINGS_MODULE", "server.settings")
-application = get_asgi_application()
+django_asgi_app = get_asgi_application()
+
+from channels.auth import AuthMiddlewareStack  # noqa: E402
+from channels.routing import ProtocolTypeRouter, URLRouter  # noqa: E402
+from channels.security.websocket import AllowedHostsOriginValidator  # noqa: E402
+
+from clips.routing import websocket_urlpatterns  # noqa: E402
+
+application = ProtocolTypeRouter({
+    "http": django_asgi_app,
+    "websocket": AllowedHostsOriginValidator(
+        AuthMiddlewareStack(URLRouter(websocket_urlpatterns))
+    ),
+})

server/settings.py

@@ -32,6 +32,9 @@ CSRF_TRUSTED_ORIGINS = [
 ]
 
 INSTALLED_APPS = [
+    # First, so `runserver` is daphne's and serves the websocket too.
+    "daphne",
+    "channels",
     "django.contrib.admin",
     "django.contrib.auth",
     "django.contrib.contenttypes",
@@ -51,6 +54,10 @@ MIDDLEWARE = [
     "django.contrib.messages.middleware.MessageMiddleware",
 ]
 
+# Process-local, like the consumer's ROOMS: one worker. docs/architecture.md
+# names the move — Redis — for the day there is a second.
+CHANNEL_LAYERS = {"default": {"BACKEND": "channels.layers.InMemoryChannelLayer"}}
+
 ROOT_URLCONF = "server.urls"
 WSGI_APPLICATION = "server.wsgi.application"
 ASGI_APPLICATION = "server.asgi.application"

server/urls.py

@@ -10,6 +10,10 @@ urlpatterns = [
     # ARTHUR_URL can stay pointed at the same place and only the port moves.
     path("", views.page, name="page"),
     path("index.html", views.page),
+    # A project's own address, with its name as a slug for people to read. The
+    # same page; the client reads the id out of the path and opens it.
+    path("p/<uuid:project_id>", views.page),
+    path("p/<uuid:project_id>/<slug:slug>", views.page),
     path("api/", include("clips.urls")),
     path("blob/<str:digest>", views.blob, name="blob"),
     path("admin/", admin.site.urls),

static/arthur/app.css

@@ -252,6 +252,50 @@ input[type="range"] { width: 100%; accent-color: var(--sel); }
 .menu-item.example { font-style: italic; }
 .menu-item .sub { display: block; color: var(--dim); }
 
+/* Rows about the document rather than choices in it: who can edit. */
+.menu-item.static { display: flex; align-items: center; gap: 6px; cursor: default; }
+.menu-item.static:hover { background: none; }
+.menu-item.static .sub { display: inline; margin-left: auto; }
+.menu-item.static button { margin-left: auto; }
+.menu .row { margin: 4px 0; flex-wrap: nowrap; }
+.menu .row input { flex: 1; min-width: 0; }
+.menu p { margin: 4px 0; }
+.account { display: grid; gap: 4px; }
+button.link { border: 0; background: none; padding: 0; color: var(--sel); cursor: pointer; }
+
+/* `/`: your projects, over the editor. */
+.index { position: fixed; inset: 0; z-index: 30; display: flex; flex-direction: column;
+         background: var(--pane); }
+.index-body { width: min(640px, 100%); margin: 0 auto; padding: 24px 16px; overflow: auto; }
+.index-body h1 { font: inherit; font-size: 18px; font-weight: 600; margin: 0 0 12px; }
+.index-head { display: flex; align-items: baseline; justify-content: space-between; }
+.index-list { list-style: none; margin: 0; padding: 0; border-top: 1px solid var(--hair); }
+.index-list li { display: flex; justify-content: space-between; gap: 12px;
+                 padding: 7px 2px; border-bottom: 1px solid var(--hair); }
+.index-list a { color: var(--fg); text-decoration: none; font-weight: 600; }
+.index-list a:hover { color: var(--sel); }
+a.brand { text-decoration: none; }
+
+/* Undo, its list, redo: one group. */
+.undo { display: flex; gap: 0; }
+.undo > button { border-radius: 0; }
+.undo > button:first-child { border-radius: 2px 0 0 2px; }
+.undo > .undo-list { padding: 0 4px; margin-right: 4px; border-left: 0; border-radius: 0 2px 2px 0; }
+.menu.menu-left { left: 0; right: auto; }
+
+/* The one way to hand the document to somebody else, so it looks like one. */
+button.share-button { background: var(--sel); color: #fff; border-color: var(--sel); font-weight: 600; padding: 1px 12px; }
+button.share-button:hover, button.share-button.on { filter: brightness(1.1); }
+
+/* Who else has this document open. */
+.roster { display: flex; gap: 2px; align-items: center; }
+.peer {
+  width: 18px; height: 18px; border-radius: 50%;
+  display: inline-grid; place-items: center;
+  background: var(--sel); color: #fff; font-size: 10px; font-weight: 600;
+}
+.peer.guest { background: var(--dim); }
+
 /* --------------------------------------------------------------------------
    media pool */