Merge master into agent harness branch

.testignoreadded

@@ -0,0 +1,12 @@

+1

# Files under test/ that are NOT part of the default suite.

+2

#

+3

# `sigil test` (0.21.0+) fails when a .sgl file in a test directory registers

+4

# tests and discovery did not select it, on the reasoning that such a file has

+5

# never run and nothing said so. These are the deliberate exceptions.

+6

+7

# Live gates. Each runs only under its own script in scripts/, against a running

+8

# node or enclave, and reads required endpoints and credentials from the

+9

# environment. They error rather than skip when that environment is absent, so

+10

# they cannot join the default suite.

+11

packages/slate/test/*-live.sgl

+12

packages/slate/test/r2b-*.sgl

README.mdmodified

@@ -53,6 +53,140 @@ guix shell -m manifest.scm -- bash -c '

53

54

`slate launch` binds a loopback port (probing `32640`-`32643`), proxies the app from useslate.org onto that origin, connects with full local access (it silent-pairs on the loopback bind, no prompt), and opens Slate in a native window. It runs like a single program: **close the window and `slate` exits**; press `Ctrl-C` on `slate` and the window closes. With no `slate-shell` on `PATH`, it opens your browser in app mode instead. Proxy mode needs a network connection.

55

+56

### Persistent Android/Termux node

+57

+58

From Termux, install `termux-services` and `curl`, then install the current

+59

Android Slate binary as a supervised loopback node:

+60

+61

```sh

+62

pkg install termux-services curl

+63

slate node install --persistent

+64

```

+65

+66

The node listens only at `http://127.0.0.1:32640/`. The installer verifies

+67

`/node/health`, opens the browser after a successful interactive install, and

+68

writes a Termux:Boot entry that starts silently on boot. Install the

+69

[Termux:Boot](https://github.com/termux/termux-boot) app from the same app source

+70

as Termux, then open it once so Android enables its boot receiver.

+71

+72

Reliable automatic startup also requires the operating system to permit both

+73

**Termux** and **Termux:Boot** to run in the background. Where the device exposes

+74

such controls, enable background/autostart execution and set battery use to

+75

unrestricted (or the equivalent) for both apps. Vendor task managers differ and

+76

may otherwise suppress the boot event even when the boot script is correct; see

+77

[Don't kill my app](https://dontkillmyapp.com/) for general, vendor-organized

+78

background-process guidance. A wake lock is separate and remains opt-in.

+79

+80

```sh

+81

slate node status

+82

slate node status --json

+83

slate node logs

+84

slate node stop

+85

slate node start

+86

slate node restart

+87

slate node uninstall

+88

```

+89

+90

Choose the app only while the node is stopped. `staging` selects

+91

`https://next.useslate.org`, `production` selects `https://useslate.org`, and

+92

an explicit value must be an HTTPS URL:

+93

+94

```sh

+95

slate node stop

+96

slate node app staging

+97

slate node start

+98

```

+99

+100

Re-running `slate node install --persistent` is an idempotent upgrade. Uninstall

+101

removes Slate's service, boot entry, control command, and lifecycle records while

+102

preserving user state, logs, and installed versions under

+103

`~/.local/share/slate/node`.

+104

+105

### Persistent desktop/Guix node

+106

+107

On desktop Unix, the same command installs the current executable into Slate's

+108

versioned node directory and maintains the stable CLI at `~/.local/bin/slate`:

+109

+110

```sh

+111

slate node install --persistent --name my-node

+112

```

+113

+114

The stable launcher follows `~/.local/share/slate/node/active`, so shells and

+115

Shepherd services should invoke `~/.local/bin/slate node run` and do not need to

+116

change between releases. Desktop installation retains the normal XDG state

+117

location, preserving existing enrollment and pairings. Guix Home remains

+118

declarative: the installer does not edit or activate the user's Shepherd graph.

+119

+120

### Persistent OpenBSD node

+121

+122

Install from a non-root login account with a working `doas` policy. The same

+123

command installs the versioned binary and stable launcher, generates a native

+124

`rc.d` service, enables it, and starts or restarts it idempotently:

+125

+126

```sh

+127

slate node install --persistent --name my-node

+128

rcctl check slate_node

+129

```

+130

+131

The system service runs as the invoking user, logs through `daemon.info`, and

+132

tracks Slate's stable launcher across atomic version changes. Running the

+133

installer as root is refused because a Slate node exposes that account's file

+134

and terminal capabilities.

+135

+136

`slate node status --json` is the stable machine-readable lifecycle view. It

+137

reports installation, runit availability/state, the exact Slate child PID and

+138

liveness, loopback health, selected app URL, boot entry, last start/exit,

+139

restart count, and Slate's wake-lock choice as independent fields. Missing or

+140

corrupt lifecycle records remain visible rather than being treated as stopped.

+141

Android/OEM autostart, background, and battery-exemption settings are reported

+142

as `unknown`; when a boot entry exists the overall Android posture is only

+143

`user-managed`, never proof that Android will execute or preserve the service.

+144

+145

The same versioned, read-only status contract is available from a running local

+146

node at `GET /node/status`. Its common `platform`, `installation`, `supervision`,

+147

`process`, `listener`, `lifecycle`, and `autostart` sections apply equally to

+148

foreground or supervised desktop nodes and Android/Termux nodes. Platform-only

+149

facts live below `platform-details`; absence of a desktop service manager is a

+150

valid foreground posture, not a failed node. The endpoint is served only by the

+151

node's existing host-gated origin, accepts only GET, and is never cached.

+152

+153

Schema version 2 also identifies the runtime role as `local-node` and reports

+154

resource, session, agent, renderer, and remote-transport-manager capability

+155

posture. Capability availability describes what the node implements; it does

+156

not grant the current origin permission. Effective origin grants remain on the

+157

authenticated `sys/info` surface. Remote transport management is explicitly

+158

reported as unavailable and is not implemented by this local-node slice.

+159

+160

Schema version 3 adds read-only node-upgrade posture. It reports the running

+161

version, the same-origin release-check endpoint, and the installation strategy

+162

for the current platform. Termux uses atomic version directories; desktop

+163

installation remains package-managed. Upgrade apply and rollback are explicitly

+164

unavailable until artifact verification, staged replacement, restart, and

+165

recovery behavior are implemented.

+166

+167

Release tooling lives in `scripts/release.sgl` and uses `(sigil shell)` for

+168

checked external commands. `build-dry-run` prints the complete nine-artifact

+169

matrix without writing; `build` requires a clean tracked checkout and an exact

+170

match with the declared CLI version. Both build modes also require the published

+171

Sigil 0.20.3 and sigil-websocket 0.10.8 lock floors and reject path/raw-commit

+172

dependencies in shipping manifests; `dev-redirects.sgl` is development-only.

+173

`publish-dry-run` prints staging R2 keys,

+174

cache headers, stable-download redirects, and publication order without remote

+175

mutation. `publish` uploads only to `SLATE_RELEASE_STAGING_PREFIX` and publishes

+176

`/cli/latest.json` last. It requires `SLATE_RELEASE_BUCKET`; credentials and

+177

account-specific R2 details remain ambient to Wrangler and are never stored in

+178

this repository. CLI manifests carry namespace-bound Ed25519 signatures made by

+179

OpenSSH; signing uses `SLATE_RELEASE_SIGNING_KEY`, and validation uses the

+180

explicit `SLATE_RELEASE_ALLOWED_SIGNERS` policy.

+181

The matrix includes both conventional and fully static AMD64 Linux artifacts;

+182

the static artifact is the portable choice for Guix systems. It also includes

+183

native amd64 and arm64 OpenBSD artifacts.

+184

+185

The direct node-to-node transport baseline is documented in

+186

[`design/node-dialing-v1.md`](design/node-dialing-v1.md). The Enclave remains the

+187

authenticated discovery/bootstrap plane and relay fallback; direct listeners

+188

bind only an explicitly selected VPN address.

+189

190

Notes:

191

192

- **Native window opens in your browser instead?** Your Lantern predates the URL-app navigation fix. Run `sigil deps update` and rebuild `slate-shell`.

design/node-dialing-v1.mdadded

@@ -0,0 +1,923 @@

+1

# Node dialing v1

+2

+3

## Goal

+4

+5

Slate should use the Enclave as the authenticated discovery and bootstrap plane,

+6

then carry resource and terminal traffic directly between nodes whenever both

+7

peers can reach one another. The existing Enclave stream remains the fallback,

+8

so direct dialing improves latency without making a node unreachable.

+9

+10

The first milestone is one authenticated session between two enrolled nodes,

+11

with an observable choice of `direct` or `relay`. Filesystem and terminal

+12

operations continue to use the existing request, bulk-frame, session, credit,

+13

and grant contracts; transport selection must not create a second capability

+14

model.

+15

+16

## Network boundary

+17

+18

- A dialable listener binds to an explicitly selected WireGuard/VPN address,

+19

never `0.0.0.0` and never the public interface by implication.

+20

- The existing PWA-facing listener remains loopback-only. Direct node traffic

+21

gets a separate listener and authentication boundary.

+22

- A node advertises only an endpoint it has successfully bound. Absence of an

+23

endpoint means relay-only, not a guessed address.

+24

- The Enclave stores and distributes authenticated endpoint advertisements. It

+25

does not assert reachability; the dialing node measures that.

+26

+27

## Identity and authentication

+28

+29

- Enrollment creates the durable node identity. Display names are labels and

+30

are not transport credentials.

+31

- Endpoint advertisements are signed or MAC-bound to that enrolled identity and

+32

have a short expiry. A stale advertisement cannot authorize a connection.

+33

- The Enclave issues a single-use, short-lived rendezvous ticket naming both

+34

enrolled peers and the requested session. The accepting node verifies the

+35

ticket and that the connecting peer proves possession of its node identity.

+36

- Retired transport identities remain retired. A display name can be reused only

+37

through a fresh enrollment, as with `zerocool` and `0x11`.

+38

+39

## Authorization

+40

+41

Direct transport changes routing, not authority. After authentication, the

+42

accepting node derives the same principal and applies the same origin/node grants

+43

used by the relay path. `fs`, `proc`, `sys`, terminal session kinds, credit, and

+44

reattach semantics are identical on both transports. A direct connection that

+45

cannot reproduce that principal is refused rather than granted a local default.

+46

+47

## Selection and fallback

+48

+49

1. Ask the Enclave for the target node's current endpoint and a rendezvous

+50

ticket.

+51

2. Make one bounded direct connection attempt.

+52

3. If authenticated direct setup succeeds, open the existing session protocol on

+53

it and report transport `direct`.

+54

4. On timeout, refusal, stale advertisement, or network failure, consume a fresh

+55

relay ticket and use the existing Enclave stream. Report transport `relay`

+56

and the non-secret fallback reason.

+57

5. Never migrate an established session silently in v1. A dropped direct session

+58

may be reattached through the existing durable-session mechanism.

+59

+60

Direct failure is expected on sleeping phones and split VPN routes. It must not

+61

mark the node offline while its Enclave control connection is healthy.

+62

+63

## Observability

+64

+65

`sys/info` should advertise the selected VPN address, port, advertisement expiry,

+66

and direct-listener availability without exposing credentials. Session-open and

+67

reattach results should include `transport: "direct"|"relay"`; logs include the

+68

target node, phase, elapsed time, and a stable non-secret failure class. Status

+69

must distinguish control-plane connectivity, direct-listener health, and the

+70

transport of each live session.

+71

+72

## First implementation slice

+73

+74

1. Add a separately configured VPN listener to the node and advertise it through

+75

the Enclave.

+76

2. Add rendezvous-ticket issuance and peer authentication.

+77

3. Carry one terminal session over the direct connection using the existing wire

+78

frames and grant resolution.

+79

4. Add bounded relay fallback and expose the selected transport in status/logs.

+80

5. Test direct success, sleeping/unreachable peer fallback, invalid ticket,

+81

wrong peer identity, expired advertisement, and reattach through relay.

+82

+83

File operations need no separate transport design after this slice: they use the

+84

same authenticated request and bulk lanes already proven by remote browsing.

+85

+86

## Implementation status

+87

+88

The first transport-selection seam lives in `(slate-cli node dial)`. It accepts

+89

only broker-supplied, unexpired endpoint advertisements, makes exactly one

+90

bounded authenticated direct attempt, and obtains relay fallback through a

+91

separate callback that receives no direct credential. Results expose `direct`,

+92

`relay`, or `unavailable` plus a stable non-secret fallback class.

+93

+94

The Enclave side now keeps connection-bound endpoint advertisements in ephemeral

+95

memory and issues 15-second, peer-bound direct rendezvous material over the two

+96

authenticated node control connections. Those keys are never registered as

+97

relay bearer tickets. The companion parses the resulting `DIRECT-TICKET`

+98

message and implements the mutual proof transcript. Broker rendezvous uses the

+99

authenticated Enclave transport nick consistently for `DIRECT-OPEN`, both

+100

ticket halves, and the direct hello transcript. Friendly node labels and numeric

+101

bot ids remain distinct presentation and durable-identity fields.

+102

+103

`slate node run --direct-host <vpn-address> [--direct-port <port>]` now binds a

+104

separate `/node/direct` WebSocket listener before advertising it. Wildcard and

+105

loopback addresses are refused. The advertisement is refreshed every 30 seconds,

+106

`sys/info` reports listener health and expiry without credentials, and the

+107

acceptor consumes its ticket only after the nonce-bound mutual proof succeeds.

+108

Authenticated frames then enter the existing Resource/Session handlers with the

+109

same configured grant posture as relay.

+110

+111

The caller-side companion gateway is now wired. The browser remote provider

+112

opens a managed carrier through its authenticated loopback node connection; the

+113

companion performs brokered direct rendezvous first and uses the already-armed

+114

Enclave stream as fallback. Production Resource and Session initiation therefore

+115

share the companion selector and report the transport that actually bound.

+116

+117

The caller connector now lives in the existing `(slate-cli node direct)`

+118

submodule. It opens exactly the broker-named endpoint, completes the nonce-bound

+119

mutual proof under one deadline, returns the socket only after `direct/ok`, and

+120

closes every failed attempt before relay acquisition can begin. Socket operations

+121

are injected as a small transport record so the authentication and timeout

+122

contract is covered without a live VPN peer. The remaining gateway work is to

+123

multiplex that authenticated carrier across the browser's loopback connection;

+124

remote frames cannot be injected into the already-active local-node frame space.

+125

+126

Loopback multiplexing is defined by `(slate-cli node gateway)`. Each remote

+127

carrier receives a companion-local unsigned 32-bit id and an explicit

+128

`opening`/`ready` lifecycle. Text messages use a `remote/text` control envelope;

+129

binary messages use `[0x11][u32 carrier id][original node frame]`, keeping the

+130

inner Resource/Session bytes opaque. Carrier removal precedes socket closure so

+131

a re-entrant close callback cannot route another frame onto a dying connection.

+132

The registry records only `direct` or `relay` and the stable fallback class in

+133

its observable fields; endpoint and credential material are not part of the

+134

multiplexing protocol.

+135

+136

The loopback listener now recognizes authenticated `remote/open` and

+137

`remote/close` requests ahead of the local capability dispatcher. An open pins

+138

the carrier to that browser connection, derives a globally unique bounded

+139

`DIRECT-OPEN` correlation id from the carrier id, and permits the enrolled node

+140

control session—not the browser—to issue the broker request. A close from any

+141

other browser connection is indistinguishable from a missing carrier, and loss

+142

of the owning loopback connection removes all of its pending carriers. The

+143

same ownership check gates every text and binary carrier frame.

+144

+145

Caller `DIRECT-TICKET` completion now looks up the still-opening carrier by its

+146

`g<carrier>` request id and requires caller role plus exact peer identity. The

+147

one-time ticket is consumed before the native WebSocket handshake begins. A

+148

successful mutual proof binds the carrier as `direct` and emits a secret-free

+149

`remote/opened` event to its owning browser connection. A failed attempt moves

+150

the carrier once to `opening-relay` and sends a new `stream/open` request through

+151

Enclave using only the target identity and correlation id. Caller tickets use a

+152

daemon-wide inbox, so a node may dial directly without also advertising its own

+153

direct listener. Relay-ticket response redemption and carrier frame pumping are

+154

now wired as well: the response must match the target, request id, lifecycle,

+155

verb, and bounded ticket lifetime before the bearer is redeemed immediately.

+156

The bearer is never stored in carrier state. Ready direct carriers exchange

+157

plain WebSocket text and opaque binary node frames; ready relay carriers wrap

+158

text in the existing Enclave stream control frame and leave binary node frames

+159

opaque. A bounded nonblocking pump returns inbound frames to the owning browser

+160

under the same carrier id, and transport loss removes the carrier before

+161

emitting `remote/closed` so there is no silent mid-session migration.

+162

+163

The browser half starts at `(slate providers enclave-node carrier)`, nested

+164

under the existing remote provider rather than registered as another provider.

+165

It owns only companion carrier lifecycle and the `remote/text`/`0x11` envelope

+166

codec. `(slate providers node)` reserves those authenticated loopback envelopes

+167

for an extension callback before its ordinary local-node dispatch, so local

+168

frames and remote carrier frames cannot collide. Direct and relay remain

+169

transport choices beneath `node:` sources rather than new source providers.

+170

Carrier opens use the ordinary authenticated node request envelope, and the

+171

companion echoes its browser request id in every lifecycle event. This permits

+172

concurrent opens for different roots while same-root callers coalesce onto one

+173

opening or ready carrier.

+174

+175

Coarse remote Resource requests now use that managed carrier whenever the

+176

loopback companion is authenticated. The browser sends the existing node v2

+177

request envelope inside `remote/text`; inline `ok`/`err` replies return on the

+178

same carrier, while bulk replies retain the existing `0x10` node frame inside

+179

the gateway's `0x11` carrier frame. Both request id and carrier id must match

+180

before a callback can settle. Carrier acquisition failure temporarily retries

+181

the request through `ENCLAVE-RPC`, preserving compatibility during migration;

+182

loss of an established carrier fails only work pinned to that carrier and does

+183

not silently change transports mid-request. Browser-local Resource ids occupy

+184

the lower half of u32 and carrier-open tickets the upper half, with numeric

+185

comparison across JSON decoding at the boundary.

+186

+187

Fresh remote sessions now use the same per-root carrier. `session/open` remains

+188

an ordinary node v2 control request inside `remote/text`; PTY input, output,

+189

resize, signal, credit, error, exit, and close frames retain their existing

+190

binary format inside the gateway `0x11` envelope. The client extends its legacy

+191

stream record with transport kind and carrier id, so channel binding, queued

+192

input flushing, detach handling, and replay accounting continue through one

+193

session state machine. Closing one session retires only that session because a

+194

carrier may be shared by several sessions. Carrier loss retires and reports all

+195

sessions pinned to that carrier without disturbing sessions on another root.

+196

Initial carrier acquisition still falls back to the legacy Enclave stream.

+197

The bounded reattach ladder now treats either an authenticated companion or the

+198

Enclave account plane as an available acquisition path. A due attach obtains a

+199

fresh managed carrier and sends `session/attach` with the durable session id;

+200

only the returned channel changes. Carrier acquisition failure falls back once

+201

to the legacy `stream/open {sid}` path, and a synchronous fallback failure

+202

clears the in-flight mark immediately so the ladder cannot wedge. The existing

+203

attempt counter, backoff cap, definitive `dead`/`no-session` handling, and replay

+204

attribution remain shared by both transports.

+205

+206

Loss of the authenticated browser-to-companion loopback is also a carrier

+207

failure. `(slate providers node)` numbers transport installations and emits one

+208

generation-checked, idempotent disconnect notification; a stale close from an

+209

older socket cannot tear down replacement work. The browser carrier registry

+210

atomically clears all opening and ready entries before notifying opening

+211

waiters, allowing their compatibility fallback to create work in the new

+212

state. The remote provider then fails only established carrier-backed Resource

+213

requests and removes only carrier-backed session streams before notifying their

+214

consumers. Legacy Enclave requests and streams are not part of this teardown.

+215

Each affected live session enters the ordinary bounded reattach ladder.

+216

+217

### Local root selection

+218

+219

`sys/info` also exposes the companion's opaque enrolled transport identity. The

+220

client compares that value with each discovered root's Enclave transport nick;

+221

display labels never participate. A match marks the registered root `local?:`

+222

and routes it through the loopback `local:` provider. The `local:` root remains

+223

registered as a compatibility alias for saved sources and typed paths, but is

+224

hidden from root navigation once the canonical registered name is available.

+225

The welcome page and root picker therefore show one registered machine name with

+226

a `local` annotation, not separate local and remote-looking entries for the same

+227

machine.

+228

+229

## Verified implementation checkpoint — 2026-09-01

+230

+231

The first direct-dialing slice is complete and committed:

+232

+233

- Slate `25b14c9` (`feat/node-dial-v1`) completes the companion gateway,

+234

direct-first selection, relay fallback, canonical direct-peer grant tables,

+235

browser carrier delivery, and the native two-phase live gate.

+236

- sigil-websocket `da7eeaf` keeps native `ws-receive-nowait` from parking on an

+237

unreadable plain socket. The earlier handshake scheduler fix is `12db076`.

+238

- Sigil `055c0f17` makes scheduler-owned TCP connects asynchronous and

+239

nonblocking, with focused regression coverage.

+240

- The Enclave rendezvous and relay changes are committed in its

+241

`feat/node-dial-v1` worktree; that worktree is clean.

+242

+243

The live gate starts two enrolled nodes and proves both outcomes using the same

+244

remote file request:

+245

+246

1. With no advertised endpoint, the carrier selects `relay` and the bulk file

+247

response completes.

+248

2. After the same target identity restarts with an explicit VPN listener, the

+249

carrier completes mutual authentication, selects `direct`, and the same

+250

request completes.

+251

+252

Final verdict: `GREEN — DIRECT SUCCESS AND RELAY FALLBACK PASSED`.

+253

+254

### Current protocol boundary

+255

+256

Direct carriers enter the ordinary node listener and therefore support the

+257

existing Resource and Session protocol, including grant enforcement and binary

+258

bulk frames. Relay holders now enact the same dispatch reply descriptors as the

+259

ordinary listener: unary replies, bulk results, deferred `fs/write-file` bodies,

+260

and `fs/watch`/`fs/unwatch` subscriptions share the canonical grant checks and

+261

locked connection sender. Pending write authority is single-use, watcher handles

+262

are holder-owned and close with the stream, and unmatched or replayed bulk

+263

bodies fail closed without changing transport.

+264

+265

The remote provider now persists over the deferred bulk lane and holds watch

+266

callbacks against the selected managed carrier until explicit unwatch or carrier

+267

loss. A bulk write cannot fall back to legacy `ENCLAVE-RPC`, whose unary shape

+268

cannot carry its body; inability to acquire the authenticated companion carrier

+269

is an explicit error rather than a silent protocol migration.

+270

+271

Focused relay coverage exercises successful writes, replay and unmatched-body

+272

refusal, watch delivery/unwatch, continued connection usability, and grant

+273

boundaries. The two-phase live gate performs watch, deferred write, read-back,

+274

and unwatch over both relay and direct carriers while asserting the transport.

+275

+276

Commit `45a7b6b` extends that gate through the Session plane. Both relay and

+277

direct phases now open a real PTY with a deliberately bounded initial window,

+278

prove credit exhaustion and resumption, send input, resize the terminal, and

+279

detach/reattach through a fresh session request while the selected transport

+280

remains explicit. The direct arm exposed an authorization split: Resource

+281

dispatch used the mutually authenticated connection's cached grant table, but

+282

`session/open` rebuilt grants from browser-origin configuration and denied the

+283

node peer. Session open now consumes the same cached authenticated grant table,

+284

with a focused direct-peer regression test and the real two-node gate green.

+285

+286

The direct authentication suites already pin invalid role/TTL inputs, absolute

+287

expiry, single-use consumption, wrong peer transcript binding, wrong proof,

+288

and gateway request/peer/lifecycle correlation. Those focused security cases

+289

remain fail-closed; the outstanding item is a live adversarial handshake gate,

+290

not missing decision-function coverage.

+291

+292

Commits `6313523` and `7b9a35d` close the direct-loss continuity slice. A

+293

managed carrier reattach carries its durable sid through `remote/open`; relay

+294

routing first checks the direct listener's existing daemon hub and binds the

+295

relay adapter to that same hub, otherwise it asks holder children as before.

+296

It never spawns a replacement for a named sid. The reattached event reports the

+297

selected transport explicitly; managed carriers announce on their definitive

+298

attach acknowledgement and leave replay bytes unknown when the loopback drain

+299

cannot attribute them soundly.

+300

+301

The live loss arm puts only the advertised direct WebSocket behind

+302

`slate-netem`. Its controls prove real traffic crossed the proxy, the emulator

+303

closed the established carrier, and a bounded direct retry was refused during

+304

the cut. The original PTY then reattaches through relay, replays output buffered

+305

during loss, accepts new input, and never emits the replacement-process marker.

+306

Together with the two baseline arms the gate ends

+307

`GREEN — DIRECT, RELAY, AND LOSS/REATTACH PASSED`.

+308

+309

The live adversarial gate exercises the remaining direct authentication

+310

boundaries through the genuine listener. It corrupts the caller proof, claims a

+311

wrong caller identity, waits out the acceptor's 15-second ticket while retaining

+312

only the dev caller's local copy, and completes then reconnects a consumed

+313

ticket. Each attack records the explicit `authentication` outcome and the same

+314

full Resource/Session probe proceeds only after selecting the already armed

+315

relay. The replay arm separately proves its first genuine handshake connected,

+316

so the second attempt is demonstrably a replay. These hooks are inert unless

+317

both `SLATE_DEV=1` and a test-only selector are present; they cannot add an

+318

acceptance path. The expanded gate ends

+319

`GREEN — DIRECT, RELAY, LOSS/REATTACH, AND ADVERSARIAL AUTH PASSED`.

+320

+321

The remote `node:` provider now exposes the dispatch plane's existing

+322

`fs/mkdir`, `fs/rename`, and recursive `fs/delete` verbs through the same

+323

correlated managed carrier used by reads, deferred writes, watches, and

+324

sessions. Focused coverage pins their exact paths and selected transport. The

+325

live gate creates, renames, and deletes a directory, verifying each durable

+326

state through a fresh parent listing; it also proves a 2 MiB-plus-tail

+327

deferred write/read-back byte-for-byte on both relay and direct. After the

+328

explicit `fs/unwatch` acknowledgement, a further write and more than one poll

+329

interval produce no subscription event.

+330

+331

This is deliberately the v1 unary-bulk boundary, not an implicit streaming

+332

claim. Sigil-websocket now completes partial native socket writes while

+333

preserving encoded frame bytes, and both Slate and Enclave admit the resulting

+334

frame in bounded 64 KiB reads with an explicit 4 MiB fail-closed ceiling. The

+335

live gate proves a 2 MiB-plus-tail unary write/read-back over relay and direct.

+336

Crossing that ceiling now uses the explicit multi-frame Resource transfer lane.

+337

The node and relay holder share one atomic file adapter, and the renderer shares

+338

one credited client state machine across the local socket and managed remote

+339

carriers. Uploads switch at 3 MiB; file downloads negotiate the transfer lane

+340

up front. Frames remain ordered and bounded at 64 KiB with a 256 KiB initial

+341

credit window, exact-length completion, cancellation, and owner-scoped cleanup

+342

when a local socket generation or remote carrier disappears. The renderer also

+343

publishes an optional acknowledged-byte progress callback; no UI subscribes to

+344

it yet. Transfers never migrate to legacy `ENCLAVE-RPC`.

+345

+346

The live gate now crosses that boundary with a deterministic 5 MiB-plus-tail

+347

upload and download over both relay and direct carriers. It verifies exact

+348

round-trip bytes, monotonic acknowledged progress ending at the negotiated

+349

length, the selected transport, and an empty renderer transfer registry after

+350

each completion. Dedicated throttled direct-carrier arms then cut an upload and

+351

a download after several megabytes have crossed `slate-netem`. Each operation

+352

fails exactly once without completing or migrating, renderer state returns to

+353

zero, interrupted upload publication remains atomic, no sibling staging file

+354

survives, and a fresh request explicitly selects relay and succeeds. Netem's own

+355

liveness and fault controls pass for both cuts.

+356

+357

The same loss gate now routes the two relay `/stream` legs through a distinct,

+358

optional stream ingress while leaving both account/control sockets healthy.

+359

Throttled relay upload and download each cross several megabytes before netem

+360

cuts the active carrier sockets; both fail exactly once, leave no renderer or

+361

staging state, and recover through a fresh relay request. Progress events record

+362

the measured transfer high-water marks on every topology: no frame exceeds 64

+363

KiB and credited/unacknowledged data never exceeds the 256 KiB window. This

+364

completes the multi-frame Resource transfer slice; it does not complete the

+365

broader node-addressing proposal.

+366

+367

The first lifecycle/concurrency slice is also green. Focused coverage now opens

+368

two roots concurrently, completes their carrier negotiations out of order, and

+369

proves that closing one root settles only its own pending work while the other

+370

carrier remains usable. A live relay-owned PTY survives a caller-companion

+371

restart: the dead loopback generation reports loss once, the replacement

+372

generation authenticates and opens a fresh carrier, and the original holder

+373

replays buffered output and accepts new input without spawning a replacement

+374

PTY. Carrier-backed reattach records give that normal companion reconnect one

+375

bounded grace turn before account-plane fallback, avoiding a deterministic race

+376

between the 1s reattach floor and the companion's 1.5s reconnect floor. This is

+377

not evidence that a direct holder survives loss of its hub-side companion;

+378

durable hub-independent direct pairing remains part of the broader audit below.

+379

+380

Target-companion restart is now bounded as a distinct, non-durable case. Its

+381

PTY holder is `die-with-parent`, so the client reports one transport loss and

+382

must not invent a replacement or a reattachment. A restart can race carrier

+383

acquisition before the replacement target has registered; the companion

+384

gateway now expires an opening carrier after five seconds instead of leaving it

+385

wedged in `opening-relay`. The existing account-plane fallback then obtains the

+386

target's definitive `no-session`, retires the ladder, and leaves zero pending

+387

reattach records. The live gate establishes that terminal lifecycle. It also

+388

establishes fresh recovery in a separate client lifetime against that same

+389

replacement target: the complete relay probe opens a new carrier and exercises

+390

PTY, filesystem, watch, and multi-frame transfer work successfully. Isolated

+391

holder logging showed that the earlier apparent ticket-handshake stall was

+392

actually the synthetic test scheduler waiting for two client/account lifetimes

+393

to tear down in one process. Holder children now receive request-scoped log

+394

paths so the logging layer's emulated append cannot race the parent and erase

+395

their startup and handshake evidence. The terminal-lifecycle probe also wakes

+396

its parked account worker before `with-async` joins it, matching the established

+397

cleanup contract used by the other live probes.

+398

+399

The network-transition arm is now explicit as well. A durable PTY first opens

+400

over a direct carrier routed through `slate-netem`; the direct lane is then cut

+401

while the Enclave control and relay paths remain healthy. The original handle

+402

reports exactly one loss and exactly one reattachment, the replacement carrier

+403

is visibly `relay`, buffered output and new input reach the original PTY, and a

+404

sentinel proves no replacement process was spawned. The client observes one

+405

live stream after reattach, then zero streams, pending requests, and reattach

+406

records after explicit close.

+407

Field diagnostics now preserve that same causal chain on real devices. The

+408

acceptor distinguishes paired-context, paired-proof, broker-hello, broker-ticket,

+409

and broker-proof rejection without recording tickets, keys, nonces, or proofs.

+410

The companion records every established carrier closure with target, carrier,

+411

request, and selected transport. The client records stream loss, eligibility,

+412

ladder arming, the one-turn carrier grace, every attach issue and its selected

+413

path, synchronous issue failure, and successful reattachment with transport and

+414

honestly attributable replay size. Together the caller and acceptor traces can

+415

separate direct-auth failure from carrier loss and missing reattachment during

+416

a mobile network transition.

+417

Netem independently proves that the direct WebSocket crossed the proxy, that

+418

the active carrier was cut, and that the bounded direct retry reached the cut.

+419

Focused carrier tests retain the complementary non-migration proof: loss fails

+420

work pinned to that carrier, and a late correlated reply cannot cross another

+421

carrier and resurrect it.

+422

+423

Live concurrent multi-root coverage now matches that focused contract. The

+424

harness enrolls two independent target identities with separate state,

+425

processes, ports, and logs, then keeps one direct carrier and one relay carrier

+426

open at the same time. Both PTYs exchange independently marked input and output;

+427

closing the direct-root session reduces the stream registry from two entries to

+428

one while the relay-root PTY remains writable. Neither root reports a loss or

+429

error, transport attribution remains per root, and explicit final close leaves

+430

zero streams and pending requests. The deterministic carrier suite remains the

+431

proof for deliberately reversed acquisition completion and late-reply

+432

rejection, which the real network does not promise to schedule in a fixed

+433

order.

+434

+435

### Hub-independent direct carrier ownership

+436

+437

Direct-companion restart requires a different process boundary from the one

+438

currently shipped. A connected WebSocket cannot be transferred safely after

+439

the companion has authenticated it, so the durable worker must own the direct

+440

dial from its first network operation. This is carrier durability, not durable

+441

pairing: the Enclave remains the discovery and rendezvous authority, and the

+442

worker receives one already-authorized attempt rather than acquiring its own

+443

account-plane identity.

+444

+445

The implementation is divided into the following explicit phases:

+446

+447

1. **Worker and local carrier protocol.** Add an internal `_direct-carrier`

+448

worker and a `(slate-cli node carrier-worker)` module. The companion creates

+449

a private Unix socket in its mode-0700 state directory, starts the worker

+450

without `die-with-parent`, and sends endpoint, target identity, rendezvous

+451

material, deadline, and stable non-secret attempt id over that socket. No

+452

ticket, proof key, endpoint credential, or adoption capability appears in

+453

argv, logs, or browser-visible state. The worker performs the existing

+454

`(slate-cli node direct)` handshake itself and owns the authenticated

+455

WebSocket thereafter. Browser `remote/text` and `0x11` frames remain opaque

+456

and are forwarded through the local protocol; the companion still owns the

+457

browser-facing carrier id and all policy about direct-versus-relay selection.

+458

2. **Bounded orphaning and adoption.** Once direct authentication succeeds, the

+459

worker atomically publishes a mode-0600 descriptor containing only its Unix

+460

socket path, pid, authenticated target identity, creation time, protocol

+461

version, and a random local adoption capability. Loss of the companion

+462

begins a 30-second orphan grace period; it does not make in-flight Resource

+463

work durable, extend session TTLs, or suppress target-socket failure. A

+464

replacement companion proves the descriptor capability in a nonce-bound

+465

challenge, with the existing same-uid Unix peer gate as a second condition.

+466

Successful adoption rotates the capability and atomically replaces the

+467

descriptor before accepting browser traffic. A failed, replayed, wrong-uid,

+468

wrong-target, expired, or concurrent adoption attempt closes only that local

+469

attempt. If grace expires, the worker closes the direct socket, removes its

+470

descriptor/socket, and exits.

+471

3. **Carrier remapping and session recovery.** Worker identity is never a

+472

browser carrier id. After restart, a fresh `remote/open` for the same target

+473

may adopt the worker and allocate a new companion-local u32 carrier id; stale

+474

ids from the dead companion remain permanently retired. Resource operations

+475

pinned to the lost loopback generation fail exactly once and are never

+476

replayed. Durable sessions enter the existing bounded reattach ladder and

+477

send `session/attach {sid}` over the newly mapped direct carrier. Only a

+478

successful attach emits `reattached: #t` with `transport: direct`; refusal or

+479

worker loss follows the existing relay/account-plane ladder and remains

+480

visible as a transport change.

+481

4. **Limits, cleanup, and observability.** Apply a separate per-node cap to

+482

direct carrier workers and reap exited workers before admission. Startup

+483

inventory removes descriptors only after a failed bounded connect/challenge;

+484

it must not unlink a socket merely because it predates the companion. Logs

+485

use request-scoped worker paths and record target, phase, elapsed time,

+486

adoption generation, session count if known, and stable failure class—never

+487

secrets or endpoint credentials. Normal browser carrier close, target close,

+488

authentication failure, grace expiry, and node shutdown each have one

+489

idempotent cleanup path.

+490

5. **Verification.** Pure protocol tests pin descriptor validation, challenge

+491

rotation/replay rejection, generation checks, grace expiry, carrier-id

+492

remapping, caps, and idempotent cleanup. The live gate opens a direct durable

+493

PTY, kills only the companion, starts its replacement inside the orphan

+494

grace, and proves exactly one loss plus one `reattached: direct` event,

+495

buffered output, new input reaching the original PTY, no replacement

+496

process, and zero residual carrier/session state after close. Separate arms

+497

cover adoption replay and grace expiry; neither may fall through silently to

+498

a purportedly preserved direct carrier.

+499

Showing the first 500 of 924 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

design/slate-git-wire-v1.mdadded

@@ -0,0 +1,149 @@

+1

# Slate Git wire protocol v1

+2

+3

Status: frozen by phase G0. This document and

+4

`packages/slate/test/git-contract-v1.json` are one contract; the executable

+5

declaration is the population authority used by `scripts/check-git-contract`.

+6

+7

## Boundary and envelope

+8

+9

Git operations act on a Slate **source**, never on a client filesystem path.

+10

The source's registered root selects a provider and node destination. Local and

+11

remote node-backed roots use the same callback-shaped operation and wire bytes;

+12

only their destination differs. Browser-only roots report `git-unavailable`.

+13

+14

Every request uses the existing correlated node lane:

+15

+16

```json

+17

{"t":"req","id":41,"verb":"git/status","args":{"repo":{"root":"home","worktree":"/work/app","common_dir":"/work/app/.git"},"recent_limit":20}}

+18

```

+19

+20

Every success is `{"t":"res","id":41,"ok":true,"result":...}`. Every error

+21

is `{"t":"res","id":41,"ok":false,"error":{"code":"...","message":"bounded safe text"}}`.

+22

Unknown fields may be ignored within v1; missing required fields, wrong types,

+23

unknown enum values, and malformed cursors are `operation-failed` replies.

+24

+25

The node validates the requested path/repository against the root's grant on

+26

**every** operation, canonicalizes discovery on the node machine, invokes Git

+27

with explicit argv (never a shell string), fixes locale and presentation

+28

settings, and bounds time, stdout, and stderr. Operation logs contain the verb,

+29

correlation id, duration, outcome, destination, and a bounded path summary.

+30

They never contain patch bodies, file contents, credentials, or unbounded

+31

stderr.

+32

+33

## Frozen resource limits

+34

+35

| resource | v1 ceiling |

+36

|---|---:|

+37

| structured diff lines per reply | 400 |

+38

| UTF-8 encoded diff result per reply | 262144 bytes |

+39

| concurrent diff-page requests per view | 2 |

+40

| mounted diff rows per view | 800 |

+41

| recent commits in status | 50 |

+42

| bounded error text | 4096 UTF-8 bytes |

+43

+44

Both line and encoded-byte limits apply: a reply ends before either would be

+45

exceeded. A single logical line too large to fit is represented by bounded

+46

truncation metadata, not transferred whole. Cursor tokens are opaque,

+47

repository/snapshot/diff-side scoped, and invalid after refresh or collapse.

+48

+49

## Identities

+50

+51

The node-side discovery result contains `node_repo: {worktree, common_dir}` plus

+52

`bare` and `object_format` (`sha1` or `sha256`). The selected provider/client

+53

attaches its registered root to form `repo: {root, worktree, common_dir}`.

+54

`root` is mandatory in that qualified identity: identical paths on two roots

+55

are different repositories. The node treats the name as opaque provenance and

+56

revalidates both paths against its grants on every later request. No

+57

client-generated bare path is repository authority.

+58

+59

`snapshot` is `{head_oid, index_id, worktree_id}`. The ids are opaque node-owned

+60

generation inputs. Every mutation supplies the complete expected snapshot; the

+61

node compares it immediately before changing anything. Mismatch returns

+62

`stale-snapshot` and changes neither index nor worktree.

+63

+64

Status entries carry stable `id`, `path`, optional `original_path`, `kind`,

+65

`index_state`, `worktree_state`, conflict stages, and binary/mode/rename/

+66

submodule metadata. `binary` is `unknown`, `text`, or `binary`; status returns

+67

`unknown` because porcelain v2 does not inspect content, and an explicit lazy

+68

diff request resolves the classification. Stable ids are scoped to the

+69

root-qualified repository and snapshot.

+70

+71

Hunk identities are `{file_id, side, old_start, old_lines, new_start,

+72

new_lines, context_hash}`. They identify a candidate, not authoritative patch

+73

text. A hunk mutation makes the node recompute the diff under the expected

+74

snapshot and reject stale or ambiguous candidates.

+75

+76

## Verb population

+77

+78

The v1 MINIMUM population contains seven verbs. Exact required request/result

+79

fields and error arms live in the executable declaration.

+80

+81

### `git/discover`

+82

+83

Request: `{"path":"/work/app/src"}`. Result:

+84

+85

```json

+86

{"version":1,"node_repo":{"worktree":"/work/app","common_dir":"/work/app/.git"},"bare":false,"object_format":"sha1"}

+87

```

+88

+89

Discovery starts from the source/project directory on the owning node. A

+90

canonical repository escaping the selected root is `grant-denied`.

+91

+92

### `git/status`

+93

+94

Request: `{"repo":REPO,"recent_limit":20}`. Result contains `version`, `repo`,

+95

`snapshot`, `branch`, `operation`, `entries`, `recent_commits`, and

+96

`capabilities`. Branch describes head/detached/unborn, upstream, ahead/behind.

+97

Operation names merge/rebase/cherry-pick/revert/bisect state or is null. Status

+98

contains inventory and summary metadata only: it MUST NOT compute, carry,

+99

parse, or render patch bodies.

+100

+101

### `git/diff`

+102

+103

Request includes `repo`, `snapshot`, `kind`, `target`, `cursor`, `max_lines`,

+104

and `max_bytes`. `kind` is one of `worktree-file`, `index-file`, `staged-all`,

+105

or `commit`; `target` is the stable file id or validated commit oid as

+106

appropriate. Result contains structured `files`, each with structured hunks and

+107

lines carrying old/new coordinates, plus `next_cursor`, `complete`, and

+108

`truncation`. Binary, rename, mode, and submodule changes remain structured

+109

summaries.

+110

+111

No `git/diff` request occurs during status open. Pages start only after explicit

+112

expansion/opening. A view runs at most two page requests concurrently and keeps

+113

at most 800 mounted rows. Collapse, close, repository switch, or refresh

+114

invalidates the relevant generation; late replies cannot mutate current state.

+115

+116

### `git/stage-file` and `git/unstage-file`

+117

+118

Requests contain `repo`, `expected_snapshot`, and `entry_id`. The node resolves

+119

the path identity from its current status under that snapshot. Results contain

+120

`version`, `repo`, and a fresh `snapshot`; the client refreshes immediately.

+121

+122

### `git/stage-hunk` and `git/unstage-hunk`

+123

+124

Requests contain `repo`, `expected_snapshot`, and `hunk_id`. Rendered patch

+125

text is never accepted. The node recomputes, selects, constructs, and applies

+126

the patch. Missing/ambiguous identity is `stale-snapshot`; unsafe partial

+127

operations are `operation-failed` without mutation.

+128

+129

## Error vocabulary

+130

+131

- `not-a-repository`: the source is not contained in a Git repository.

+132

- `git-unavailable`: Git cannot run on the selected root/node.

+133

- `grant-denied`: a path or canonical repository escapes root authority.

+134

- `stale-snapshot`: expected repository state no longer matches; no mutation.

+135

- `conflict`: Git reports a conflict requiring explicit presentation/workflow.

+136

- `operation-failed`: malformed input/result, bounds, timeout, unsupported

+137

partial operation, or another bounded non-conflict failure.

+138

+139

No other v1 error code crosses the node/client boundary.

+140

+141

## Gate transcripts

+142

+143

Gate and sabotage transcripts never live in the source tree. Executors and

+144

reviewers use a fresh directory such as

+145

`$XDG_CACHE_HOME/slate/git-contract-transcripts/<commit-or-run-id>/` or a

+146

`mktemp -d` directory under `/tmp`, record cache warmth and tool versions there,

+147

and copy the command, exit status, and complete output. The gate itself creates

+148

and removes fixture repositories under `mktemp -d`; it never writes beneath the

+149

checkout.

docs/mobile-terminal-input.mdadded

@@ -0,0 +1,86 @@

+1

# Mobile terminal input

+2

+3

The two-row key bar below the Ledge supports a local composer for terminals.

+4

Choose **Term → Compose Input**, or swipe left across the keys, to open it. Swipe right across

+5

its side controls, or tap the back arrow, to return to the keys. The text field

+6

keeps native selection, clipboard editing, autocorrect and IME behavior; swipes

+7

inside the text field belong to native editing.

+8

+9

The Term menu contains Compose Input, C-c, C-d, C-r, and Close. Esc, Tab, and

+10

arrows remain directly available in the key grid. The grid uses the full width

+11

in every view, with no pencil column or empty placeholder.

+12

+13

Typing in the composer sends no terminal input. Enter or Send sends only the

+14

current text, without appending an Enter to the remote application. IME

+15

confirmation does not submit. Shift+Enter inserts a local newline. Sending uses

+16

the terminal's existing paste path, including bracketed paste when enabled and

+17

normalization of embedded newlines. Use the ordinary terminal keyboard to

+18

submit the resulting command separately.

+19

+20

Drafts and selection are kept per terminal in browser memory, across redraws

+21

and view switches. They do not persist through a PWA reload. A known disconnected

+22

or closed terminal refuses submission and retains the draft with an error.

+23

Successful submission means acceptance by the local session writer, not a remote

+24

delivery acknowledgment. Reconnection never automatically submits a draft.

+25

+26

The last five successful submissions are also kept per terminal in browser

+27

memory. When the composer is empty, a clock replaces Send. Tap it to see recent

+28

text, then tap an entry to restore it for editing without sending it. The clock

+29

is disabled until there is history. Typing closes the list and protects the new

+30

draft. Reloading the PWA clears both drafts and history.

+31

+32

See [Terminal copying](terminal-copy.md) for frozen local selection and taking

+33

clipboard text received from tmux.

+34

+35

Alt and Ctrl use the normal sticky-modifier reducer without a full view render.

+36

Their pointer handlers preserve the active native input or editor selection,

+37

cancel on swipes, and consume the compatibility click after a touch. One-shot

+38

modifier highlights clear after the following key without moving focus.

+39

+40

Implementation:

+41

+42

- `packages/slate/assets/terminal-compose.mjs`: native draft state and events.

+43

- `packages/slate/src/slate/accessory.sgl`: key/composer markup.

+44

- `packages/slate/src/slate/main.sgl`: silent modifier and focused-target bridges.

+45

- `packages/slate/src/slate/modes/terminal.sgl`: guarded paste submission.

+46

- `packages/slate/assets/index.html`: host routing, focus and styling.

+47

+48

Build with `guix shell binaryen -- sigil build slate --config web`, then run:

+49

+50

```sh

+51

node packages/slate/test/terminal-compose-browser-gate.mjs

+52

node packages/slate/test/terminal-copy-browser-gate.mjs

+53

node packages/slate/test/terminal-copy-test.mjs

+54

node packages/slate/test/terminal-prediction-browser-gate.mjs

+55

node packages/slate/test/terminal-prediction-test.mjs

+56

node packages/slate/test/terminal-mobile-input-policy-test.mjs

+57

```

+58

+59

For a repeatable heavy-output and viewport-resize profile, run

+60

`node packages/slate/test/terminal-resize-browser-probe.mjs`. It compares live

+61

and frozen terminals under 4× browser CPU throttling, including keyboard-sized

+62

resizes and orientation changes. Set `SLATE_TEST_PROFILE_OUTPUT` to save its

+63

JSON measurements. This is a browser stress probe, not a phone latency measurement.

+64

+65

Terminal and tmux client resizing waits for 120 ms of stable geometry, then

+66

reports only the final size. Initial terminal sizing remains immediate. Keyboard

+67

animations, orientation changes, and sash drags therefore avoid intermediate

+68

remote redraws; tmux may still reflow history for the final size.

+69

+70

Touch scrolling sends mouse wheel reports at twice the previous sensitivity for

+71

tmux and other mouse-tracking applications. Local scrollback remains 1:1, physical

+72

mouse wheel sensitivity is unchanged, and taps retain the same drag threshold.

+73

There is no inertial scrolling or additional queued input after the finger stops.

+74

Run `node packages/slate/test/terminal-resize-policy-test.mjs` and

+75

`node packages/slate/test/terminal-geometry-browser-gate.mjs` to check resize

+76

coalescing and touch report delivery.

+77

+78

Copy/composer synchronization writes only changed DOM state and retains unchanged

+79

history entries. This prevents the app's mutation observer from turning a control

+80

refresh into a continuous loop of full terminal redraws.

+81

+82

The browser gates accept `SLATE_TEST_WEB_ROOT` for an isolated build. The composer

+83

gate uses Chrome's mobile viewport and trusted touch/key input with the actual

+84

WASM terminal provider; it also exercises IME event ordering. Actual Android

+85

keyboard visibility and keyboard-specific autocorrect still require phone

+86

verification.

docs/predictive-terminal-echo.mdadded

@@ -0,0 +1,58 @@

+1

# Predictive terminal echo

+2

+3

Predictive echo previews simple typing in the Slate UI while the remote

+4

terminal processes input. The remote terminal remains authoritative. Predictions

+5

are a removable overlay and never change the emulator, command input, or history.

+6

+7

It defaults to off. Use **Terminal: Toggle Predictive Echo** in the command

+8

palette, or set the boolean option `slate/terminal-predictive-echo:` in the

+9

Terminal options group. The preference is saved through Slate's normal options

+10

store. It takes effect for existing terminals.

+11

+12

The first version predicts printable ASCII appended to an otherwise empty end

+13

of a single-width row. Two separate confirmed echoes over 150 ms enable

+14

prediction for that typing sequence. Two echoes below 80 ms turn it off.

+15

Edits, control keys, paste, non-ASCII input, focus changes, resize, scrollback,

+16

and a hidden cursor clear predictions and require fresh confirmation.

+17

Enter resets learning before the next prompt; no-echo input cannot train the

+18

predictor. The UI does not have the remote process's termios settings, so this

+19

is conservative inference, not a general guarantee about every program's echo

+20

behavior.

+21

+22

Confirmation checks the complete authoritative cursor row, cursor advancement,

+23

and fresh output. Repeated text elsewhere cannot confirm a prediction. A

+24

mismatch discards dependent predictions and imposes a one-second backoff.

+25

Unconfirmed text becomes dim and underlined after 250 ms and disappears after

+26

two seconds. The next authoritative frame always wins.

+27

+28

Performance capture automatically clears and suppresses prediction, even when

+29

the preference is on. For baseline comparisons, leave the option off as well.

+30

`window.slatePredictEcho.report()` reports enablement, suppression and counters

+31

without recording typed text. Predictive paint time is distinct from confirmed

+32

terminal latency and must be measured separately.

+33

+34

Local checks:

+35

+36

```sh

+37

node packages/slate/test/terminal-prediction-test.mjs

+38

node packages/slate/test/terminal-prediction-browser-gate.mjs

+39

```

+40

+41

The browser gate needs a completed web build and Chrome. Set

+42

`SLATE_TEST_WEB_ROOT` to test an isolated build. It uses a temporary profile and

+43

a controlled terminal provider; it does not contact a phone or measure network

+44

performance.

+45

+46

Tmux's alternate screen, application cursor mode, and mouse tracking no longer

+47

exclude echo learning by themselves. The same append-only ASCII and exact

+48

cursor-row confirmation rules apply inside tmux. This can help at shell prompts

+49

inside tmux; it is not general prediction of arbitrary editor operations or

+50

full-screen redraws. Cursor movement, edits and unconfirmed output still reset

+51

learning.

+52

+53

To validate with actual tmux output on a disposable private socket:

+54

+55

```sh

+56

node packages/slate/test/terminal-tmux-prediction-fixture.mjs /tmp/slate-tmux-prediction.json

+57

SLATE_TEST_TMUX_FIXTURE=/tmp/slate-tmux-prediction.json node packages/slate/test/terminal-prediction-browser-gate.mjs

+58

```

docs/terminal-build-baseline.mdadded

@@ -0,0 +1,30 @@

+1

# Terminal build baseline

+2

+3

The terminal improvements validated on 2026-09-07 use the official Sigil 0.22.0

+4

compiler and its matching runtime packages. The lock retains the existing pins

+5

for packages outside the Sigil monorepo.

+6

+7

`sigil-stdlib` is temporarily pinned to

+8

`9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95`, the scheduler fix immediately after

+9

0.22.0. A socket may have independent read and write waiters. Previously,

+10

readiness in one direction could discard the waiter in the other direction,

+11

leaving a terminal stuck during backpressure/replay. The pinned library removes

+12

only the waiter for the ready direction. This fix is compiled into a node;

+13

updating the CLI alone does not change an already-installed node binary.

+14

+15

The explicit standard-library dependency comes first in the app manifest so

+16

workspace dependencies cannot preempt it. Its runtime and test peers resolve

+17

from the same commit; their source is unchanged from 0.22.0.

+18

+19

Use the committed dependency lock with `sigil deps install`. No local source

+20

redirect is required. Replace the temporary standard-library commit pin with a

+21

released version once a Sigil release includes the fix.

+22

+23

The staged client version is `2026-09-07-terminal-compose-1`. Its optimized WASM

+24

build and the actual-browser composer and prediction gates passed. Validation

+25

also includes 27 predictive-echo model checks, 24 gateway/appearance checks, and

+26

six real-socket Unicode HTTP-body cases. See `mobile-terminal-input.md` and

+27

`predictive-terminal-echo.md` for behavior and browser-gate commands.

+28

+29

Composer history and the frozen terminal copy mode are follow-up work, not part

+30

of this checkpoint.

docs/terminal-copy.mdadded

@@ -0,0 +1,84 @@

+1

# Terminal copying

+2

+3

Open **Copy** in the accessory bar, then choose **Enter copy mode** to freeze

+4

the current screen and retained scrollback in the normal terminal pane. Opening

+5

the menu alone leaves the terminal live. The category appears only for terminals;

+6

the keyboard button and key grid keep their positions across view changes.

+7

+8

Incoming output continues feeding the live terminal in the background.

+9

Scrolling and selecting use the frozen rows,

+10

so new output cannot move or erase the selected text, even when the live

+11

scrollback buffer rolls over.

+12

+13

On a phone, tap the beginning of the desired text, tap **Mark**, scroll, then tap

+14

the other endpoint. The selection extends across screens and works in either

+15

direction. The Copy menu contains **Mark**, **Copy selection**, and **Cancel**

+16

while selecting. Tap **Copy selection** to put the region on the system clipboard

+17

and return to live output, or **Cancel** to return without copying. A failed clipboard write

+18

keeps the frozen selection available for another attempt.

+19

+20

Closing the menu keeps the selection frozen. A small **Copy mode** indicator

+21

in the existing terminal header remains visible until copying or canceling.

+22

The help text closes with its menu and returns when that menu is reopened.

+23

On desktop, compact controls live directly in that header. Neither layout adds

+24

a dedicated row above the terminal.

+25

+26

Keyboard controls also work with the mobile bar's sticky Ctrl and Alt keys:

+27

+28

| Action | Keys |

+29

| --- | --- |

+30

| Set mark | Ctrl+Space |

+31

| Move by character or row | Ctrl+B/F/P/N or arrow keys |

+32

| Beginning/end of row | Ctrl+A/E or Home/End |

+33

| Move by word | Alt+B/F |

+34

| Previous/next page | Alt+V / Ctrl+V or PageUp/PageDown |

+35

| Beginning/end of retained buffer | Alt+< / Alt+> or Ctrl+Home/End |

+36

| Copy region and return to live output | Alt+W or Ctrl+Shift+C |

+37

| Cancel | Ctrl+G or Escape |

+38

+39

Other terminal input is consumed locally while copy mode is active. Composer

+40

submission is refused and its draft retained until the terminal is live again.

+41

Copy mode does not detect or enter tmux copy mode: it selects the rows Slate has

+42

received. For a full-screen application using the alternate screen, only that

+43

screen is available; unrelated main-screen history is excluded. History held

+44

privately by tmux must be selected through tmux itself.

+45

+46

Rows currently copy with physical line breaks and omit trailing padding spaces.

+47

The terminal emulator does not retain the soft-wrap metadata needed to rejoin

+48

wrapped logical lines reliably.

+49

+50

## Clipboard text from tmux

+51

+52

When tmux or another terminal application sends an OSC 52 clipboard sequence,

+53

Slate stages the text and badges the terminal's **Copy** category, even while

+54

the menu is closed. Choose **Copy received text** from the menu, or use

+55

Ctrl+Shift+Y, to copy it with a browser user gesture. An unsuccessful clipboard

+56

write keeps the staged text. A delayed acknowledgment

+57

does not clear a newer, different clipboard payload.

+58

+59

Tmux must be configured to emit clipboard sequences to its terminal. For

+60

example, enable `set-clipboard on` and advertise clipboard support in the

+61

appropriate `terminal-features` entry for the outer terminal. Slate's existing

+62

OSC 52 policy still applies; setting it to `off` disables staging.

+63

+64

## Validation

+65

+66

Build the web app, then run:

+67

+68

```sh

+69

node packages/slate/test/terminal-copy-test.mjs

+70

node packages/slate/test/terminal-copy-browser-gate.mjs

+71

```

+72

+73

The browser gate accepts `SLATE_TEST_WEB_ROOT` for an isolated build. It checks

+74

five-entry history, recall without sending, frozen scrollback across live-buffer

+75

rollover, Emacs and touch selection, input isolation, alternate-screen behavior,

+76

clipboard failure recovery, and an actual browser clipboard write.

+77

It also checks menu-only entry, fixed keyboard/key-grid positions across editor

+78

and terminal views, closing/reopening a frozen selection without leaking help

+79

into the category row, the received-text

+80

badge, and desktop header controls. Set

+81

`SLATE_TEST_OSC52_FILE` to a JSON fixture containing `text` and `sequence` to use

+82

clipboard output captured from a real tmux session. Headless Chrome tests do

+83

not establish Android keyboard visibility or platform clipboard permission

+84

behavior; those still need phone dogfooding.

docs/terminal-reattach.mdadded

@@ -0,0 +1,43 @@

+1

# Reattaching terminals

+2

+3

Run **Terminal: Reattach** from the command palette to list running terminals on

+4

the active node. Each row shows the shell command, session ID, starting directory

+5

when known, attachment status, and time since activity. Choose a row to resume

+6

that session. If the terminal is already open in this Slate UI, the command

+7

focuses its existing view.

+8

+9

Listing does not attach or close anything. Reattachment never falls back to

+10

creating a fresh shell if the selected session has exited. Attached sessions

+11

are identified so the user can see when selecting one will take over its input

+12

connection. Underlying tmux sessions continue independently of these wrappers.

+13

+14

Updated nodes combine their direct session hub with retained relay holders.

+15

Each hub filters by the authenticated principal; session identifiers do not grant

+16

access. Queries use the node's private control socket directory and bounded

+17

replies. Unavailable or older holders produce an incomplete-list message.

+18

Older nodes can list sessions in the current hub, but may omit other retained

+19

terminals; the picker asks for a node update instead of presenting that as a

+20

complete inventory.

+21

+22

Remote listing currently requires a connected local companion node to carry

+23

the authenticated request. The older browser-only Enclave RPC path does not

+24

expose this catalog.

+25

+26

Directory and command describe how the shell was started, not a live process

+27

inspection. Node restarts can invalidate plain PTY sessions. A picker cannot

+28

recover a shell whose controlling process is gone, though work inside tmux may

+29

remain accessible through a new tmux client.

+30

Surviving relay holders from a previous node process may appear in discovery,

+31

but adopting them into the replacement node's routing table is separate work;

+32

such an attachment can still be refused without creating a replacement shell.

+33

+34

Checks:

+35

+36

```sh

+37

sigil test slate-cli packages/slate-cli/test/test-terminal-discovery.sgl --no-strict

+38

node packages/slate/test/terminal-reattach-browser-gate.mjs

+39

```

+40

+41

The browser gate accepts `SLATE_TEST_WEB_ROOT` for an isolated build. It uses

+42

controlled catalog replies and the real picker/provider seam. The native tests

+43

exercise Unix-socket discovery, principal filtering, and actual PTY reattachment.

package.sglmodified

@@ -77,6 +77,13 @@

77

output-dir: "build/dev"

78

debug?: #t

79

optimize: 0)

+80

;; Optimized bytecode daemon, retaining the development execution backend.

+81

(config

+82

name: 'node-release

+83

output-dir: "build/node-release"

+84

backend: 'bytecode

+85

debug?: #f

+86

optimize: 2)

87

;; Native release — used to native-compile packages/slate-shell into one

88

;; `slate-shell` binary with the web build baked into the appended SGLPAK archive.

89

(config

@@ -84,6 +91,114 @@

91

output-dir: "build/release"

92

backend: 'native

93

debug?: #f

−87

optimize: 2))

+94

optimize: 2)

+95

;; Static ARM64 Linux build used by the mobile companion validation.

+96

(config

+97

name: 'linux-arm64

+98

output-dir: "build/linux-arm64"

+99

toolchain: 'zig

+100

target: "aarch64-linux-musl"

+101

backend: 'native

+102

static?: #t

+103

debug?: #f

+104

optimize: 2

+105

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG"))

+106

features: '(release cross))

+107

(config

+108

name: 'linux-amd64

+109

output-dir: "build/linux-amd64"

+110

toolchain: 'zig

+111

target: "x86_64-linux-gnu"

+112

backend: 'native

+113

static?: #f

+114

debug?: #f

+115

optimize: 2

+116

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG"))

+117

features: '(release cross))

+118

;; Fully static AMD64 Linux build for Guix and other hosts where the

+119

;; conventional glibc-linked artifact cannot rely on host FHS paths.

+120

(config

+121

name: 'linux-amd64-static

+122

output-dir: "build/linux-amd64-static"

+123

toolchain: 'zig

+124

target: "x86_64-linux-musl"

+125

backend: 'native

+126

static?: #t

+127

debug?: #f

+128

optimize: 2

+129

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG"))

+130

features: '(release cross))

+131

;; Dynamic ARM64 Android build. Sigil's managed Zig compiles the C objects;

+132

;; the Android data-only sysroot supplies bionic headers and link stubs.

+133

(config

+134

name: 'android-arm64

+135

output-dir: "build/android-arm64"

+136

toolchain: 'android

+137

target: "aarch64-linux-android"

+138

backend: 'native

+139

static?: #f

+140

debug?: #f

+141

optimize: 2

+142

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG"))

+143

features: '(release cross android))

+144

(config

+145

name: 'windows-amd64

+146

output-dir: "build/windows-amd64"

+147

toolchain: 'zig

+148

target: "x86_64-windows-gnu"

+149

backend: 'native

+150

static?: #t

+151

debug?: #f

+152

optimize: 2

+153

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG"))

+154

features: '(release cross windows))

+155

(config

+156

name: 'macos-amd64

+157

output-dir: "build/macos-amd64"

+158

toolchain: 'zig

+159

target: "x86_64-macos"

+160

backend: 'native

+161

static?: #f

+162

debug?: #f

+163

optimize: 2

+164

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG"))

+165

features: '(release cross macos))

+166

(config

+167

name: 'macos-arm64

+168

output-dir: "build/macos-arm64"

+169

toolchain: 'zig

+170

target: "aarch64-macos"

+171

backend: 'native

+172

static?: #f

+173

debug?: #f

+174

optimize: 2

+175

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG"))

+176

features: '(release cross macos))

+177

+178

;; OpenBSD release binaries link dynamically against the host libc; OpenBSD

+179

;; deliberately does not promise static binaries as a portable interface.

+180

(config

+181

name: 'openbsd-amd64

+182

output-dir: "build/openbsd-amd64"

+183

toolchain: 'zig

+184

target: "x86_64-openbsd"

+185

backend: 'native

+186

static?: #f

+187

debug?: #f

+188

optimize: 2

+189

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG" "-D_DEFAULT_SOURCE"))

+190

features: '(release cross openbsd))

+191

(config

+192

name: 'openbsd-arm64

+193

output-dir: "build/openbsd-arm64"

+194

toolchain: 'zig

+195

target: "aarch64-openbsd"

+196

backend: 'native

+197

static?: #f

+198

debug?: #f

+199

optimize: 2

+200

bundle?: #t

+201

c-flags: (with-sigil-c-flags '("-Wall" "-O2" "-DNDEBUG" "-D_DEFAULT_SOURCE"))

+202

features: '(release cross openbsd)))

203

204

default-config: 'dev)

packages/slate-cli/design/terminal-lifetime.mdadded

@@ -0,0 +1,63 @@

+1

# Terminal lifetime across node restarts

+2

+3

PTY and process sessions live in independent `slate node _terminal-owner`

+4

processes. Local, paired direct and relay transports delegate their session

+5

frames over Unix sockets in the node's private `pty/` state directory. The

+6

network process still owns pairing, resource RPCs, watches and agent sessions.

+7

+8

After a node restart, discovery validates the owner's IPC version, node key

+9

identity and unique endpoint. The owner retains the original SID, process,

+10

replay buffer, flow control and timestamps. Attach never opens a replacement

+11

shell when its owner is missing. Channels are mapped per frontend connection,

+12

so sessions in different surviving owners cannot collide on their local u32

+13

channel numbers. A fresh owner is started only for an explicit open.

+14

+15

The private IPC reuses bounded WebSocket framing without an HTTP upgrade.

+16

The directory has mode 0700. Each network open is checked against that

+17

connection's actual exec, PTY and cwd grants before delegation; the owner

+18

additionally checks the principal on list, attach and every session frame.

+19

The private socket is a same-OS-user capability and is not a network endpoint.

+20

+21

## Cleanup policy

+22

+23

- Detached PTYs retain the existing 72-hour idle timeout, configurable through

+24

`SLATE_SESSION_TTL`. Zero disables idle expiry. Process sessions keep their

+25

10-minute timeout. Existing sessions retain the policy set when opened.

+26

- Attached sessions are exempt. Detach, input and observed output update the

+27

idle clock. Output behind exhausted flow-control credit is not yet observed.

+28

- Idle expiry and age use wall time, preserving the existing policy and

+29

counting time spent suspended on Android. `created` is the original wall-clock

+30

timestamp. List and attach report age and TTL; restarting the network process

+31

does not reset them. Signal and empty-owner grace deadlines use monotonic time.

+32

- Expiry uses HUP, TERM and KILL with the existing five-second rung graces.

+33

Pending cleanup counts against the owner's 64-session limit and prevents an

+34

empty owner from exiting before its children are reaped.

+35

- An owner with no sessions or pending cleanup exits after ten seconds,

+36

even if an idle frontend link remains open. It removes its endpoint.

+37

The spawning node waits for exited owners while it remains alive; after a

+38

node crash, normal OS orphan reaping applies.

+39

- Owner discovery/spawn has an eight-endpoint admission budget, and each

+40

owner accepts at most 128 IPC connections. Simultaneous first opens in

+41

different transport processes can create additional empty owners; they

+42

retire normally. This is not a transactional, cross-process global quota.

+43

- Transport workers exit explicitly after their streams and local sessions

+44

are gone. Their background reaper must not keep an empty worker alive.

+45

+46

Stopping or upgrading the network node leaves owned sessions running under

+47

this policy. Closing a terminal explicitly ends it. Rebooting the OS or killing

+48

the owner ends its sessions; persistence does not restore killed processes.

+49

The first upgrade from the previous architecture cannot adopt existing PTY

+50

master descriptors, so those old terminal connections need to be reopened.

+51

+52

## Verification

+53

+54

Run `node packages/slate-cli/test/terminal-restart-gate.cjs /path/to/slate` on

+55

Linux with a native candidate. It creates isolated state and disposable PTYs,

+56

checks repeated open/close descriptor counts, local/relay reattachment,

+57

principal isolation, resource RPCs, normal stops, forced crashes, original

+58

PID/SID/timestamps, autonomous expiry, empty-worker retirement and owner-crash

+59

reporting. It does not connect to installed nodes or user tmux sessions.

+60

+61

Session/grant regressions are in `test-terminal-owner.sgl`,

+62

`test-terminal-discovery.sgl`, `test-reaper.sgl` and `test-sessions.sgl`.

+63

Set `SLATE_TEST_BIN` for the reaper's real worker boot check.

packages/slate-cli/docs/sigil-http-streaming-integration.mdmodified

@@ -3,8 +3,7 @@

3

The A4 implementation separates three layers:

4

5

- `(sigil http client)` defines `http-stream-response`: one response-head

−6

callback followed by bytevector body callbacks. `(slate-cli http stream)` is

−7

now only a compatibility re-export that preserves Slate's import boundary.

+6

callback followed by bytevector body callbacks. Slate imports it directly.

7

- `(slate-cli http sse)` is a transport-neutral incremental SSE decoder. It

8

handles arbitrary chunk boundaries, CRLF, comments, multiline data, event

9

names, persistent IDs, and retry values.

@@ -14,9 +13,8 @@ The A4 implementation separates three layers:

13

The transport lives beside `http-fetch-bytes` and reuses sigil-http's connection,

14

deadline, request, header, and framing helpers. It invokes `on-chunk` as each

15

de-framed body chunk arrives instead of accumulating with `fetch-assemble`.

−17

Slate is pinned to sigil-http 0.18.5. It can import `(sigil http client)` directly

−18

and delete `slate-cli/http/stream.sgl` in a later mechanical cleanup; no SSE or

−19

provider code needs to change.

+16

Slate is pinned to sigil-http 0.18.5. No SSE or provider code needs to duplicate

+17

the transport implementation.

18

19

The SSE decoder can still be upstreamed independently as `(sigil http sse)` with

20

the same three exports.

packages/slate-cli/package.sglmodified

@@ -15,8 +15,8 @@

15

;;;

16

;;; Build (from the workspace root):

17

;;; sigil deps install

−18

;;; sigil build slate-cli --config release # builds the slate-cli package

−19

;;; ./build/release/bin/slate serve # ...which produces the `slate` binary

+18

;;; sigil build slate-cli --config node-release # optimized bytecode daemon

+19

;;; ./build/node-release/bin/slate serve # produces the `slate` binary

20

;;;

21

;;; See the design notes (folio: topics/slate-distribution-architecture and

22

;;; topics/familiar-local-transport-design) for the architecture, wire

@@ -24,9 +24,10 @@

24

25

(package

26

name: "slate-cli"

−27

;; version inherited from the workspace (../../package.sgl) — member packages

−28

;; do not declare their own version.

−29

sigil: "0.20.1"

+27

;; The CLI/node has an independent SemVer release stream. The renderer/app

+28

;; uses Slate CalVer, so this package must not inherit that version.

+29

version: "0.1.3"

+30

sigil: "0.21"

31

description: "Slate node — local capability daemon + localhost PWA proxy"

32

url: "https://codeberg.org/sigil/slate"

33

license: "BSD-3-Clause"

@@ -40,29 +41,36 @@

41

;; ex-slate-desktop package) vacated the `slate` bundle name to free it here.

42

bundle-name: "slate"

43

−43

;; NOTE: build configs (`dev` native for tests, `release` native bundle) live

+44

;; NOTE: build configs (`dev` for tests, `node-release` optimized bytecode) live

45

;; at the WORKSPACE level (../../package.sgl) now that slate-cli is a package

46

;; in the slate workspace — mirroring slate / slate-shell. Build the daemon

−46

;; with `sigil build slate-cli --config release`; `sigil test slate-cli` uses

−47

;; `dev`.

+47

;; with `sigil build slate-cli --config node-release`; `sigil test slate-cli`

+48

;; uses `dev`. The native `release` config remains available for comparisons

+49

;; and is the desktop shell's build target.

50

51

dependencies: (list

−50

(from-git url: "codeberg:sigil/sigil" package: "sigil-stdlib" version: "^0.20")

+52

;; Keep independent read/write waiters on the same socket until the next Sigil release.

+53

(from-git url: "codeberg:sigil/sigil" package: "sigil-stdlib"

+54

commit: "9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95")

55

(from-git url: "codeberg:sigil/sigil-system" version: "^0.1")

56

(from-git url: "codeberg:sigil/sigil-wire" version: "^0.1")

−53

(from-git url: "codeberg:sigil/sigil-websocket" version: "^0.10.2")

+57

(from-git url: "codeberg:sigil/sigil-websocket" version: "^0.10.13")

58

(from-git url: "codeberg:sigil/sigil-http" version: "^0.18")

59

(from-git url: "codeberg:sigil/sigil-json" version: "^0.16")

−56

(from-git url: "codeberg:sigil/sigil-mcp" version: "^0.17")

−57

(from-git url: "codeberg:sigil/sigil-crypto" version: "^0.16")

+60

(from-git url: "codeberg:sigil/sigil-mcp" version: "^0.17")

+61

(from-git url: "codeberg:sigil/sigil-crypto" version: "^0.16.6")

+62

(from-git url: "codeberg:sigil/sigil-tls" version: "^0.16.7")

63

;; Diagnostics. `^0.16` is the range courier and folio both declare, so

64

;; the three daemons resolve the same logging library and the `--log` /

65

;; `--log-level` flags mean the same thing everywhere. See

66

;; topics/sigil-log-cli-integration.

67

(from-git url: "codeberg:sigil/sigil-log" version: "^0.17")

−63

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc" version: "^0.16")

−64

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc-websocket" version: "^0.16"))

+68

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc" version: "^0.16.5")

+69

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc-websocket" version: "^0.16.5"))

70

71

dev-dependencies: (list

−67

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: "^0.20")

−68

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: "^0.20")))

+72

;; Repository release automation is a single Sigil script which uses the

+73

;; structured shell API; it is not linked into the shipped node.

+74

(from-git url: "codeberg:sigil/sigil" package: "sigil-shell" version: ">=0.20")

+75

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: ">=0.20")

+76

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: ">=0.20")))

packages/slate-cli/src/slate-cli/agent/ceiling.sgladded

@@ -0,0 +1,108 @@

+1

;;; The agent session's authority ceiling (A1').

+2

;;;

+3

;;; The node computes `(attenuate node-root child-narrowing)` and hands the

+4

;;; child ONLY THE RESULT. The child never receives the node's root as data

+5

;;; it narrows itself: that would be the root crossing the boundary, one

+6

;;; forged field away from a bearer token. This is ENDOWMENT, a parent

+7

;;; creating a child that holds a narrowing of the parent's own authority

+8

;;; at creation, and the separating test is that the receiver can obtain no

+9

;;; more than the sender chose to give and cannot replay it elsewhere.

+10

;;;

+11

;;; Before A1' the harness minted a ceiling FRESH from the workspace and the

+12

;;; exec flag and never intersected it with anything, so an agent session

+13

;;; could hold authority the node itself did not.

+14

;;;

+15

;;; This lives in its own module rather than inside the hub so the ceiling

+16

;;; can be tested as the REAL computation. A test that reimplemented the

+17

;;; arithmetic would agree with itself by construction.

+18

+19

(define-library (slate-cli agent ceiling)

+20

(import (sigil io)

+21

(sigil string)

+22

(sigil process)

+23

(sigil grant))

+24

+25

(export origin-of-principal

+26

child-narrowing-specs

+27

compute-ceiling

+28

ceiling-reduced?

+29

grant-args)

+30

+31

(begin

+32

+33

;; "web:https://example.org" -> "https://example.org"

+34

(define (origin-of-principal p)

+35

(if (string-starts-with? p "web:")

+36

(substring p 4 (string-length p))

+37

p))

+38

+39

;; `(sigil grant)` is PURE and refuses a non-absolute fs path, so `~`

+40

;; must be expanded before the parser ever sees it. `realpath` does NOT

+41

;; expand `~` (probed elsewhere in this codebase), which is why the

+42

;; expansion is explicit here rather than delegated.

+43

(define (expand-tilde-spec spec)

+44

(let ((home (getenv "HOME")))

+45

(if (not home)

+46

spec

+47

(let ((parts (string-split spec ":")))

+48

(if (and (>= (length parts) 3) (string=? (car parts) "fs"))

+49

(let ((path (string-join (cddr parts) ":")))

+50

(string-append

+51

"fs:" (cadr parts) ":"

+52

(cond ((string=? path "~") home)

+53

((string-starts-with? path "~/")

+54

(string-append home (substring path 1 (string-length path))))

+55

(else path))))

+56

spec)))))

+57

+58

;; A spec this build cannot represent is DROPPED, not fatal, and dropped

+59

;; LOUDLY. Silently discarding a configured grant is how an operator ends

+60

;; up debugging a denial with nothing to read; refusing to start over one

+61

;; bad line is worse. Deny-by-default makes the drop the safe direction.

+62

(define (specs->grant-value specs label)

+63

(let loop ((rest specs) (acc '()))

+64

(if (null? rest)

+65

(make-grant acc)

+66

(let ((f (guard (e (#t (begin

+67

(println "agent: ignoring unrepresentable ~a grant ~s: ~a"

+68

label (car rest) (error-object-message e))

+69

#f)))

+70

(spec->facet (expand-tilde-spec (car rest))))))

+71

(loop (cdr rest) (if f (cons f acc) acc))))))

+72

+73

;;; What the session is ASKING for: exactly what the pre-A1' harness

+74

;;; minted, now an input to be intersected rather than a ceiling to be

+75

;;; trusted.

+76

(define (child-narrowing-specs workspace exec?)

+77

(append (list (string-append "fs:rw:" workspace))

+78

(if exec? (list "exec:full") '())))

+79

+80

;;; The ceiling: the greatest authority covered by BOTH what the node

+81

;;; holds and what the session asked for.

+82

;;;

+83

;;; `attenuate` is a proven meet, so this composes and can never widen:

+84

;;; the result is covered by the node root for every possible input.

+85

(define (compute-ceiling node-specs wanted-specs)

+86

(grant->specs

+87

(attenuate (specs->grant-value node-specs "node")

+88

(specs->grant-value wanted-specs "session"))))

+89

+90

;;; Did the session get less than it asked for? Compared by AUTHORITY

+91

;;; rather than by spelling, so a reordering or a redundant facet does

+92

;;; not read as a reduction.

+93

(define (ceiling-reduced? node-specs wanted-specs)

+94

(not (grant=? (specs->grant-value wanted-specs "session")

+95

(specs->grant-value (compute-ceiling node-specs wanted-specs)

+96

"ceiling"))))

+97

+98

;;; ONE SPEC PER ARGV ELEMENT, never a packed string. argv already has

+99

;;; list structure, so nothing here has to split on a separator the spec

+100

;;; grammar is allowed to contain. That is the direct answer at this

+101

;;; boundary to t-deb92a one layer up, where a spec LIST packed into one

+102

;;; string is split on a comma `exec:allowlist:` may itself contain and

+103

;;; the malformed remainder is silently dropped.

+104

(define (grant-args specs)

+105

(let loop ((rest specs) (acc '()))

+106

(if (null? rest)

+107

(reverse acc)

+108

(loop (cdr rest) (cons (car rest) (cons "--grant" acc))))))))

packages/slate-cli/src/slate-cli/agent/host.sglmodified

@@ -146,9 +146,25 @@

146

response))))

147

148

(define (usage!)

−149

(display "usage: slate agent-host SESSION-DIR WORKSPACE PROVIDER MODEL [--exec]\n")

+149

(display "usage: slate agent-host SESSION-DIR WORKSPACE PROVIDER MODEL [--exec] [--grant SPEC]...\n")

150

(exit 2))

151

+152

;; Collect every `--grant SPEC` pair. ONE SPEC PER ARGUMENT, never a

+153

;; packed string: argv already has list structure, so nothing here has

+154

;; to split on a separator the spec grammar is allowed to contain.

+155

;;

+156

;; These specs ARE this session's authority. The node computed them as

+157

;; `(attenuate node-root child-narrowing)` and handed down only the

+158

;; result, so this process holds a ceiling it cannot widen and never

+159

;; sees the node's root at all.

+160

(define (parse-grant-specs args)

+161

(let loop ((rest args) (acc '()))

+162

(cond

+163

((null? rest) (reverse acc))

+164

((and (string=? (car rest) "--grant") (pair? (cdr rest)))

+165

(loop (cddr rest) (cons (cadr rest) acc)))

+166

(else (loop (cdr rest) acc)))))

+167

168

(define (run-agent-host! args)

169

(when (< (length args) 4) (usage!))

170

(let* ((session-dir (car args))

@@ -159,6 +175,7 @@

175

(let ((tail (member "--reasoning-effort" args)))

176

(if (and tail (pair? (cdr tail))) (cadr tail) #f)))

177

(exec? (and (member "--exec" args) #t))

+178

(grant-specs (parse-grant-specs args))

179

(state-dir (config-state-dir (make-config)))

180

(broker (make-credential-broker state-dir))

181

(config (credential-broker-migrate-config! broker))

@@ -368,6 +385,7 @@

385

session-key: session-dir))

386

openai-complete)

387

sink timeout: 120 exec?: turn-exec?

+388

grant-specs: grant-specs

389

cancel-state: cancel-state

390

delivery-id: delivery-id

391

approval-wait: approval-wait

packages/slate-cli/src/slate-cli/agent/hub.sglmodified

@@ -19,6 +19,7 @@

19

(slate-cli agent config)

20

(slate-cli agent credential-broker)

21

(slate-cli agent provider)

+22

(slate-cli agent ceiling)

23

(slate-cli agent policy)

24

(slate-cli agent permissions)

25

(slate-cli agent jobs)

@@ -1893,6 +1894,56 @@

1894

#{ error: #t message: "Child host exited before starting its assignment" }))

1895

(reconcile-child! hub (vector-ref hub 9) session)))

1896

+1897

;; ================================================================

+1898

;; The child's authority ceiling (A1')

+1899

;;

+1900

;; The node computes `(attenuate node-root child-narrowing)` and hands

+1901

;; the child ONLY THE RESULT. The child never receives the node's root

+1902

;; as data it narrows itself: that would be the root crossing the

+1903

;; boundary, one forged field away from a bearer token. This is

+1904

;; ENDOWMENT (a parent creating a child holding a narrowing of its own

+1905

;; authority, at creation), not transmission, and the separating test

+1906

;; is that the receiver can obtain no more than the sender chose to

+1907

;; give and cannot replay it against a third party.

+1908

;;

+1909

;; Before this, `make-agent-grants` minted a ceiling FRESH from the

+1910

;; workspace and the exec flag and never intersected it with anything.

+1911

;; A session could therefore hold authority the node itself did not.

+1912

;; ================================================================

+1913

+1914

;; The ceiling arithmetic lives in (slate-cli agent ceiling) so it can be

+1915

;; tested as the REAL computation rather than through a mirror of itself.

+1916

;; What stays here is the composition and the reporting: which grants this

+1917

;; node holds for this session's principal, and saying so when the session

+1918

;; gets less than it asked for.

+1919

(define (child-ceiling-specs session config)

+1920

(let* ((origin (origin-of-principal (as-principal session)))

+1921

(node-specs (grants-for-origin config origin))

+1922

(session-config (transcript-session-config (as-dir session)))

+1923

(read-only? (and (dict? session-config)

+1924

(dict-ref session-config read-only: #f)))

+1925

(wanted-specs

+1926

(append

+1927

(list (string-append (if read-only? "fs:ro:" "fs:rw:")

+1928

(as-workspace session)))

+1929

(if (and (as-exec? session) (not read-only?))

+1930

(list "exec:full") '())))

+1931

(granted (compute-ceiling node-specs wanted-specs)))

+1932

;; THE REDUCTION IS RECORDED WHENEVER IT HAPPENS. Whether any

+1933

;; deployment relies on the previously un-intersected ceiling is a

+1934

;; question about how machines are configured, which the source

+1935

;; cannot answer, so a session that gets less than it asked for says

+1936

;; so at the moment it is created. An operator whose agent cannot

+1937

;; write where it expects then has a line to read instead of a

+1938

;; mystery.

+1939

(when (ceiling-reduced? node-specs wanted-specs)

+1940

(println "agent: ceiling reduced for ~a: asked ~s, node holds ~s, granted ~s"

+1941

(as-principal session) wanted-specs node-specs granted))

+1942

(when (null? granted)

+1943

(println "agent: ceiling is EMPTY for ~a: the node holds nothing overlapping ~s"

+1944

(as-principal session) wanted-specs))

+1945

granted))

+1946

1947

(define (spawn-sidecar! hub session config)

1948

(let* ((session-config (transcript-session-config (as-dir session)))

1949

(effort (if (transcript-error? session-config) ""

@@ -1906,6 +1957,7 @@

1957

(if (as-exec? session) (list "--exec") '())

1958

(if (> (string-length effort) 0)

1959

(list "--reasoning-effort" effort) '())

+1960

(grant-args (child-ceiling-specs session config))

1961

(list die-with-parent: #t)))

1962

(proc (guard (e (#t #f)) (apply process-spawn args))))

1963

(when proc

@@ -2022,6 +2074,22 @@

2074

grants: #{ exec: exec? } persona: persona drafts: '()

2075

policy: "auto-workspace" policy-version: policy-version

2076

reasoning-effort: effort

+2077

;; A RECORD OF WHAT WAS GRANTED AT OPEN, NOT A

+2078

;; SOURCE OF AUTHORITY. Every spawn recomputes

+2079

;; the ceiling from the session and the CURRENT

+2080

;; config, so a restart picks up a changed node

+2081

;; posture rather than replaying a stale one:

+2082

;; grants are resolved at the consumption site,

+2083

;; never read back from a stored record.

+2084

;;

+2085

;; It is here because the compatibility question

+2086

;; this change raises cannot be answered from the

+2087

;; source. An operator whose session cannot write

+2088

;; where it expects needs something durable and

+2089

;; per-session to read, not a log line they had to

+2090

;; be watching for.

+2091

ceiling: (list->array

+2092

(child-ceiling-specs session config))

2093

limits: limits })))

2094

(if (transcript-error? created)

2095

(reply-err conn id "open-failed" "agent transcript could not be created")

@@ -2943,8 +3011,19 @@

3011

(if (and target (valid-address? args))

3012

(let ((result (update-session-info! target args (principal-of conn) #t)))

3013

(if (dict-ref result ok: #f)

−2946

(begin (reply-ok conn id (dict-ref result result: #{}))

−2947

(publish-fleet! hub target))

+3014

(begin

+3015

;; Grant argv belongs to the host lifetime. Changing

+3016

;; execution permission requires a freshly endowed host;

+3017

;; the transcript and provider session key remain durable.

+3018

(when (and (dict-contains? args exec:) (as-proc target))

+3019

(let ((proc (as-proc target)))

+3020

(stop-child-host! proc)

+3021

(let wait ()

+3022

(when (eq? proc (as-proc target))

+3023

(sleep 0.01)

+3024

(wait)))))

+3025

(reply-ok conn id (dict-ref result result: #{}))

+3026

(publish-fleet! hub target))

3027

(let ((err (dict-ref result error: #{})))

3028

(reply-err conn id (dict-ref err kind: "session-settings")

3029

(dict-ref err message: "Could not update session settings")))))

packages/slate-cli/src/slate-cli/agent/loop.sglmodified

@@ -292,9 +292,18 @@

292

(loop (cdr rest) (append context (list message)) #f)))))))))

293

294

;; complete is the adapter api-family function and has A0's signature.

+295

;; `grant-specs:` is the ceiling the NODE computed and handed down. When

+296

;; it is supplied it IS the session's authority, replacing the ceiling

+297

;; this process used to mint for itself out of the workspace and the

+298

;; exec flag. That old ceiling was never intersected with the node's own

+299

;; grants, so a session could hold authority the node did not.

+300

;;

+301

;; When it is absent the session gets `make-agent-grants`, which is the

+302

;; pre-A1' behaviour and is what the in-process tests exercise. Every

+303

;; production path goes through the sidecar and therefore supplies it.

304

(define (run-agent-turn! session-dir workspace provider model text deliver-as actor

305

complete sink

−297

(keys: (timeout 30) (exec? #f) (cancel-state #f)

+306

(keys: (timeout 30) (exec? #f) (grant-specs #f) (cancel-state #f)

307

(settle? (lambda () #t)) (delivery-id #f)

308

(approval-wait #f) (exec-runner #f) (child-runner #f)

309

(source-kind "controller")

@@ -341,8 +350,10 @@

350

(user (dict-set

351

(dict-set (make-user-message effective-text) actor: actor)

352

source-kind: source-kind))

−344

(grants (make-agent-grants workspace exec?

−345

(dict-ref safe-session-config read-only: #f)))

+353

(grants (if grant-specs

+354

(grants-from-specs grant-specs)

+355

(make-agent-grants workspace exec?

+356

(dict-ref safe-session-config read-only: #f))))

357

(resource-items (filter valid-resource-attachment? context-items))

358

(projection

359

(checkpoint-projection session-dir

packages/slate-cli/src/slate-cli/agent/openai-completions.sglmodified

@@ -6,7 +6,7 @@

6

(sigil io)

7

(sigil array)

8

(sigil json)

−9

(slate-cli http stream)

+9

(sigil http client)

10

(slate-cli http sse)

11

(slate-cli agent provider))

12

packages/slate-cli/src/slate-cli/agent/openai/oauth.sglmodified

@@ -1,7 +1,7 @@

1

;;; Node-owned OpenAI Codex OAuth transaction primitives.

2

(define-library (slate-cli agent openai oauth)

3

(import (sigil core) (sigil math) (sigil string) (sigil crypto) (sigil json)

−4

(slate-cli http stream) (slate-cli http sse)

+4

(sigil http client) (slate-cli http sse)

5

(slate-cli agent provider) (slate-cli agent credential-broker))

6

(export make-codex-oauth-transaction codex-oauth-state codex-oauth-verifier

7

codex-oauth-challenge codex-oauth-public-state

packages/slate-cli/src/slate-cli/agent/openai/responses.sglmodified

@@ -2,7 +2,7 @@

2

(define-library (slate-cli agent openai responses)

3

(import (sigil core) (sigil string) (sigil json) (sigil array) (sigil crypto)

4

(sigil io)

−5

(slate-cli http stream) (slate-cli http sse)

+5

(sigil http client) (slate-cli http sse)

6

(slate-cli agent provider))

7

(export responses-request responses-message->input

8

make-responses-collector responses-stream-feed! responses-stream-result

packages/slate-cli/src/slate-cli/agent/service.sglmodified

@@ -1,6 +1,6 @@

1

;;; One node-owned agent hub, independent of browser and Enclave relay lifetimes.

2

(define-library (slate-cli agent service)

−3

(import (sigil fs) (sigil path) (sigil io) (sigil process)

+3

(import (sigil fs) (sigil string) (sigil path) (sigil io) (sigil process)

4

(sigil socket) (sigil async) (sigil channels)

5

(slate-cli config) (slate-cli listen)

6

(slate-cli agent hub) (slate-cli agent ipc)

@@ -52,7 +52,15 @@

52

;; Private entry point, launched while flock holds the state-directory lock.

53

(define (run-agent-service! args)

54

(unless (= (length args) 1) (error "Agent service requires its state directory"))

−55

(let* ((config (make-config state-dir: (car args)))

+55

(let* (;; The private service represents the OS node owner. Browser grants

+56

;; are checked by the adapter before it can enter this surface.

+57

(configured-grants (getenv "SLATE_NODE_GRANTS"))

+58

(owner-grants

+59

(if (and configured-grants (> (string-length configured-grants) 0))

+60

(string-split configured-grants ",")

+61

owner-silent-pair-grants))

+62

(config (make-config state-dir: (car args)

+63

grants: (list (cons "node-owner" owner-grants))))

64

(dir (agent-service-prepare! config)))

65

(with-async

66

(let* ((hub (make-agent-hub))

packages/slate-cli/src/slate-cli/agent/tools.sglmodified

@@ -1,7 +1,7 @@

1

;;; A1 agent tools. All execution enters through dispatch-agent-tool.

2

3

(define-library (slate-cli agent tools)

−4

(import (sigil fs)

+4

(import (sigil io) (sigil fs)

5

(sigil math)

6

(sigil path)

7

(sigil string)

@@ -16,6 +16,7 @@

16

(export agent-tool-definitions

17

make-agent-grants

18

agent-action-ceiling-ok?

+19

grants-from-specs

20

dispatch-agent-tool)

21

22

(begin

@@ -82,6 +83,35 @@

83

(when exec? (grant-add! g "exec:full"))

84

g))

85

+86

;; Build the session's grants table from the ceiling the node computed

+87

;; and handed down, one spec per element.

+88

;;

+89

;; `grant-add!` is `(sigil system grant)`'s own entry point, so path

+90

;; canonicalisation and the symlink-escape handling that goes with it

+91

;; stay where they belong. A1' deliberately does NOT reimplement that:

+92

;; the escape is real, and a sabotage arm on the sigil-system migration

+93

;; proved it by removing `realpath` from the check site and watching an

+94

;; escaping symlink flip from denied to permitted.

+95

;;

+96

;; An EMPTY spec list yields a table that permits nothing, which is the

+97

;; correct reading: a facet is a permission and absence is denial. A

+98

;; node holding nothing that overlaps what the session asked for should

+99

;; produce a session that can do nothing, not one that falls back to

+100

;; minting its own ceiling.

+101

(define (grants-from-specs specs)

+102

(let ((g (make-grants principal: "agent-session")))

+103

(for-each

+104

(lambda (spec)

+105

;; A spec this build cannot represent is dropped LOUDLY rather

+106

;; than silently: a swallowed grant is how an operator ends up

+107

;; debugging a denial with nothing to read. Dropping is the safe

+108

;; direction under deny-by-default.

+109

(guard (e (#t (println "agent: ignoring unusable grant ~s: ~a"

+110

spec (error-object-message e))))

+111

(grant-add! g spec)))

+112

specs)

+113

g))

+114

115

(define (absolute-target workspace path)

116

(if (and (> (string-length path) 0)

117

(char=? (string-ref path 0) #\/))

packages/slate-cli/src/slate-cli/config.sglmodified

@@ -23,6 +23,11 @@

23

config-port

24

config-dev-mode?

25

config-machine-name

+26

local-node-name-path

+27

valid-local-node-name?

+28

local-node-name

+29

local-node-save-name!

+30

local-node-ensure-name!

31

config-state-dir

32

discover-state-dir

33

discover-config-dir

@@ -104,10 +109,13 @@

109

(cache-dir #f)

110

(session-ttl #f)

111

(agent-host-command #f)))

+112

(let* ((resolved-state-dir (or state-dir (discover-state-dir)))

+113

(resolved-machine-name

+114

(or machine-name (local-node-name resolved-state-dir))))

115

#{ port: port

116

dev-mode?: dev-mode?

−109

machine-name: (or machine-name (discover-machine-name))

−110

state-dir: (or state-dir (discover-state-dir))

+117

machine-name: resolved-machine-name

+118

state-dir: resolved-state-dir

119

promptable-origins: (or promptable-origins default-promptable-origins)

120

grants: (or grants default-grants)

121

app-upstream: (or app-upstream default-app-upstream)

@@ -122,7 +130,7 @@

130

;; Test seam for exercising the native hub against a controlled

131

;; sidecar. Production always falls back to this executable's

132

;; `agent-host` subcommand.

−125

agent-host-command: agent-host-command })

+133

agent-host-command: agent-host-command }))

134

135

(define (config-port c) (dict-ref c port: 32640))

136

(define (config-dev-mode? c) (dict-ref c dev-mode?: #f))

@@ -423,4 +431,67 @@

431

(if (string? s) (string-trim s) "this computer")))

432

(else "this computer"))))

433

+434

;; The local root has an identity before it has Enclave credentials.

+435

;; Keep that identity in its own small durable record: enrollment may be

+436

;; absent, offline, revoked, or recreated without changing addresses that

+437

;; name this node. A missing record deliberately falls back to hostname

+438

;; so foreground/zero-install use remains zero configuration.

+439

(define (local-node-name-path state-dir)

+440

(path-join state-dir "node-name"))

+441

+442

;; Mirror Enclave's valid-bot-nick? grammar so a name accepted locally can

+443

;; later be requested unchanged during enrollment. Length is intentionally

+444

;; not capped: Enclave accepts long names and only truncates UI labels.

+445

(define (valid-local-node-name? name)

+446

(and (string? name)

+447

(> (string-length name) 0)

+448

(let ((first (string-ref name 0)))

+449

(and (not (char=? first #\#))

+450

(not (char=? first #\:))

+451

(not (char=? first #\@))))

+452

(let scan ((i 0))

+453

(if (= i (string-length name))

+454

#t

+455

(let* ((ch (string-ref name i))

+456

(code (char->integer ch)))

+457

(and (>= code 32) (not (= code 127))

+458

(not (member ch (list #\space #\, #\! #\@ #\:)))

+459

(scan (+ i 1))))))))

+460

+461

(define (local-node-name state-dir)

+462

(let* ((path (local-node-name-path state-dir))

+463

(stored (and (file-exists? path)

+464

(guard (e (#t #f))

+465

(string-trim (read-file-string path))))))

+466

(cond

+467

((and stored (valid-local-node-name? stored)) stored)

+468

((file-exists? path)

+469

;; Identity corruption is not permission to invent a new root.

+470

;; Refuse startup/install so the operator can repair it explicitly.

+471

(error "invalid stored Slate node name" path))

+472

(else

+473

(let ((hostname (discover-machine-name)))

+474

(if (valid-local-node-name? hostname) hostname "slate-node"))))))

+475

+476

(define (local-node-save-name! state-dir name)

+477

(unless (valid-local-node-name? name)

+478

(error "invalid Slate node name" name))

+479

(ensure-directory state-dir)

+480

(let* ((path (local-node-name-path state-dir))

+481

(tmp (string-append path ".tmp")))

+482

(write-file-string tmp (string-append name "\n"))

+483

(unless (= (process-run "chmod" "600" tmp) 0)

+484

(error "could not secure Slate node name" tmp))

+485

(rename-file tmp path)

+486

path))

+487

+488

(define (local-node-ensure-name! state-dir requested)

+489

(let ((name (or requested (local-node-name state-dir))))

+490

(unless (valid-local-node-name? name)

+491

(error "invalid Slate node name" name))

+492

(unless (and (not requested)

+493

(file-exists? (local-node-name-path state-dir)))

+494

(local-node-save-name! state-dir name))

+495

name))

+496

497

))

packages/slate-cli/src/slate-cli/dispatch.sglmodified

@@ -38,7 +38,13 @@

38

(sigil wire) ; wire-encode / wire-decode / make-wire-caps

39

(sigil log) ; structured operation logging (t-b24590)

40

(slate-cli config)

−41

(slate-cli logging)) ; next-op-id! / op-label / op-clock

+41

(slate-cli git diff)

+42

(slate-cli git log) (slate-cli git branch)

+43

(slate-cli git mutation)

+44

(slate-cli git status)

+45

(slate-cli logging) ; next-op-id! / op-label / op-clock

+46

(slate-cli node pairing-management)

+47

(slate-cli node-posture))

48

49

(export

50

;; The verb dispatcher (unary verbs -> reply descriptor).

@@ -48,6 +54,7 @@

54

reply-bulk

55

reply-bulk-id

56

reply-pending-write

+57

reply-transfer

58

reply-subscription

59

reply-cancel

60

;; Reply constructors (exported for tests / the bulk-write path).

@@ -121,6 +128,10 @@

128

#{ control: #f bulk: #f bulk-id: 0

129

pending-write: #{ id: id path: path } })

130

+131

(define (reply-transfer-open id direction path size)

+132

#{ control: #f bulk: #f bulk-id: 0 pending-write: #f

+133

transfer: #{ id: id direction: direction path: path size: size } })

+134

135

;; A subscription (fs/watch): the descriptor carries the opened

136

;; watcher handle + path for the front-end to attach to a poll

137

;; goroutine, plus the `ok` control. `sub` is the client's req id.

@@ -141,6 +152,7 @@

152

(define (reply-bulk r) (dict-ref r bulk: #f))

153

(define (reply-bulk-id r) (dict-ref r bulk-id: 0))

154

(define (reply-pending-write r) (dict-ref r pending-write: #f))

+155

(define (reply-transfer r) (dict-ref r transfer: #f))

156

(define (reply-subscription r) (dict-ref r subscription: #f))

157

(define (reply-cancel r) (dict-ref r cancel: #f))

158

@@ -256,7 +268,7 @@

268

req-id: id verb: verb

269

path: (args-path-summary args)

270

code: (reply-code r)

−259

detail: (safe-message e)

+271

detail: (reply-message r)

272

duration-ms: (op-elapsed-ms t0))

273

r)))

274

(let ((r (dispatch-verb daemon origin grants id verb args)))

@@ -296,24 +308,42 @@

308

duration-ms: (op-elapsed-ms t0))))))

309

310

(define (dispatch-verb daemon origin grants id verb args)

−299

(cond

−300

((string=? verb "fs/read-dir") (verb-read-dir grants id args))

−301

((string=? verb "fs/stat") (verb-stat grants id args))

−302

((string=? verb "fs/read-file") (verb-read-file grants id args))

−303

((string=? verb "fs/write-file") (verb-write-file grants id args))

−304

((string=? verb "fs/mkdir") (verb-mkdir grants id args))

−305

((string=? verb "fs/rename") (verb-rename grants id args))

−306

((string=? verb "fs/delete") (verb-delete grants id args))

−307

((string=? verb "proc/run") (verb-proc-run grants id args))

−308

((string=? verb "sys/info") (verb-sys-info daemon origin grants id))

−309

;; fs/watch + fs/unwatch are subscriptions: the capability core

−310

;; (grant check + watcher) lives here so the verb table stays

−311

;; whole; the front-end reads the subscription/cancel descriptor

−312

;; and owns only the transport-specific poll goroutine + ev emit.

−313

((string=? verb "fs/watch") (verb-watch grants id args))

−314

((string=? verb "fs/unwatch") (verb-unwatch id args))

−315

(else

−316

(reply-err id "unknown-verb" (string-append "unknown verb: " verb)))))

+311

(if (not (local-node-allows-verb? verb))

+312

(reply-err id "role-denied"

+313

(string-append "local-node role does not allow verb: " verb))

+314

(cond

+315

((string=? verb "fs/read-dir") (verb-read-dir grants id args))

+316

((string=? verb "fs/home") (verb-fs-home grants id))

+317

((string=? verb "fs/stat") (verb-stat grants id args))

+318

((string=? verb "fs/read-file") (verb-read-file grants id args))

+319

((string=? verb "fs/write-file") (verb-write-file grants id args))

+320

((string=? verb "fs/mkdir") (verb-mkdir grants id args))

+321

((string=? verb "fs/rename") (verb-rename grants id args))

+322

((string=? verb "fs/delete") (verb-delete grants id args))

+323

((string=? verb "proc/run") (verb-proc-run grants id args))

+324

((string=? verb "git/discover") (reply-inline id (git-discover grants args)))

+325

((string=? verb "git/status") (reply-inline id (git-status grants args)))

+326

((string=? verb "git/branches") (reply-inline id (git-branches grants args)))

+327

((string=? verb "git/switch-branch") (reply-inline id (git-switch-branch grants args)))

+328

((string=? verb "git/create-branch") (reply-inline id (git-create-branch grants args)))

+329

((string=? verb "git/log") (reply-inline id (git-log grants args)))

+330

((string=? verb "git/show") (reply-inline id (git-show grants args)))

+331

((string=? verb "git/diff") (reply-inline id (git-diff grants args)))

+332

((string=? verb "git/stage-file") (reply-inline id (git-stage-file grants args)))

+333

((string=? verb "git/unstage-file") (reply-inline id (git-unstage-file grants args)))

+334

((string=? verb "git/stage-hunk") (reply-inline id (git-stage-hunk grants args)))

+335

((string=? verb "git/unstage-hunk") (reply-inline id (git-unstage-hunk grants args)))

+336

((string=? verb "git/discard-file") (reply-inline id (git-discard-file grants args)))

+337

((string=? verb "git/discard-hunk") (reply-inline id (git-discard-hunk grants args)))

+338

((string=? verb "sys/info") (verb-sys-info daemon origin grants id))

+339

;; fs/watch + fs/unwatch are subscriptions: the capability core

+340

;; (grant check + watcher) lives here so the verb table stays

+341

;; whole; the front-end reads the subscription/cancel descriptor

+342

;; and owns only the transport-specific poll goroutine + ev emit.

+343

((string=? verb "fs/watch") (verb-watch grants id args))

+344

((string=? verb "fs/unwatch") (verb-unwatch id args))

+345

(else

+346

(reply-err id "unknown-verb" (string-append "unknown verb: " verb))))))

347

348

;; ---- fs/read-dir -> bulk listing -------------------------------

349

(define (verb-read-dir grants id args)

@@ -325,13 +355,32 @@

355

(let ((entries (list->array (fs-read-dir grants (arg-path args)))))

356

(reply-bulk-resp id (wire-encode (array-map stat->wire entries)))))

357

+358

;; ---- fs/home -> authenticated, grant-checked landing directory --

+359

;; A client entering a machine needs an absolute starting point; falling

+360

;; back to `/` is unfriendly on Unix and invalid on Android/Termux. Validate

+361

;; HOME through the same filesystem grant engine as every later operation,

+362

;; so this does not turn the authenticated metadata lane into a path leak.

+363

(define (verb-fs-home grants id)

+364

(let ((home (getenv "HOME")))

+365

(unless (and (string? home) (> (string-length home) 0))

+366

(error "home-unavailable" "the node has no HOME directory"))

+367

(fs-stat grants home)

+368

(reply-inline id #{ path: home })))

+369

370

;; ---- fs/stat -> inline -----------------------------------------

371

(define (verb-stat grants id args)

372

(reply-inline id (stat->wire (fs-stat grants (arg-path args)))))

373

374

;; ---- fs/read-file -> bulk file body (bytes) --------------------

375

(define (verb-read-file grants id args)

−334

(reply-bulk-resp id (wire-encode (fs-read-file-bytes grants (arg-path args)))))

+376

(let ((path (arg-path args)))

+377

(if (eq? (dict-ref args transfer: #f) #t)

+378

(let* ((stat (fs-stat grants path))

+379

(size (dict-ref stat size: -1)))

+380

(unless (and (integer? size) (>= size 0) (<= size 4294967295))

+381

(error "transfer-too-large" "file exceeds the v1 transfer boundary"))

+382

(reply-transfer-open id 'download path size))

+383

(reply-bulk-resp id (wire-encode (fs-read-file-bytes grants path))))))

384

385

;; ---- fs/write-file: inline (string content) or deferred bulk ---

386

;; Small text content rides the JSON args. A binary body is uploaded

@@ -340,6 +389,13 @@

389

;; frame arrives. P2 is unary bulk only — one req, one body frame.

390

(define (verb-write-file grants id args)

391

(cond

+392

((eq? (dict-ref args transfer: #f) #t)

+393

(let ((path (arg-path args))

+394

(size (dict-ref args size: #f)))

+395

(unless (and (integer? size) (>= size 0) (<= size 4294967295))

+396

(error "invalid-args" "streamed fs/write-file needs a u32 size"))

+397

(grant-assert! grants 'fs-write path)

+398

(reply-transfer-open id 'upload path size)))

399

((eq? (dict-ref args bulk: #f) #t)

400

(reply-defer-write id (arg-path args)))

401

(else

@@ -510,15 +566,53 @@

566

;; own capabilities/grants can't sensibly require one of those grants

567

;; to read. The grant SET shown is the origin's configured spec list.

568

(define (verb-sys-info daemon origin grants id)

−513

(let ((config (dict-ref daemon config: #f)))

+569

(let* ((config (dict-ref daemon config: #f))

+570

(direct-cell (dict-ref daemon direct: #f))

+571

(identity-cell (dict-ref daemon node-identity: #f))

+572

(node-identity

+573

(if (and (vector? identity-cell)

+574

(> (vector-length identity-cell) 0))

+575

(vector-ref identity-cell 0) ""))

+576

(label-cell (dict-ref daemon node-label: #f))

+577

(node-label

+578

(if (and (vector? label-cell) (> (vector-length label-cell) 0))

+579

(vector-ref label-cell 0) ""))

+580

(direct (and (vector? direct-cell)

+581

(> (vector-length direct-cell) 0)

+582

(vector-ref direct-cell 0)))

+583

(advertised-at

+584

(and direct

+585

(vector-ref (dict-ref direct advertised-cell: #()) 0))))

586

(reply-inline id

587

#{ hostname: (if config (config-machine-name config) "this computer")

588

platform: (host-os-string)

589

arch: (host-arch-string)

590

instance: (dict-ref daemon instance: "")

+591

node-identity: node-identity

+592

node-label: node-label

593

principal: (grants-principal grants)

−520

capabilities: #[ "fs" "proc" "sys" ] ; session/pty arrives P3

+594

capabilities: (local-node-capability-names)

595

tmux: (tmux-capability grants)

+596

direct: (if direct

+597

#{ available: #t

+598

address: (dict-ref direct host: "")

+599

port: (dict-ref direct port: 0)

+600

endpoint: (dict-ref direct endpoint: "")

+601

advertisement-expires-at:

+602

(if (> advertised-at 0)

+603

(+ advertised-at 60) 0) }

+604

#{ available: #f

+605

address: "" port: 0 endpoint: ""

+606

advertisement-expires-at: 0 })

+607

pairings: (guard (e (#t '()))

+608

(and config

+609

(pairing-management-list

+610

(config-state-dir config))))

+611

pairing-revocation-freshness:

+612

(if (vector-ref

+613

(dict-ref daemon enclave-control-ready:

+614

(vector #f)) 0)

+615

"current" "stale")

616

grants: (if config (grants-for-origin config origin) '()) })))

617

618

;; ----------------------------------------------------------------

@@ -683,26 +777,28 @@

777

(let ((b (reply-bulk r)))

778

(if (bytevector? b) (bytevector-length b) 0))))

779

−686

;;; The path(s) a request names, for the log line.

−687

;;;

−688

;;; PATHS ARE LOGGED IN FULL AND UNTRUNCATED. That is a decision, not an

−689

;;; oversight — recorded in the task note so it can be revisited. The

−690

;;; symptoms this logging exists to diagnose are "what happened to THIS

−691

;;; file", and a truncated or elided path cannot answer that. The cost is

−692

;;; that a debug-level node log contains the names of every file touched,

−693

;;; which is why debug is not the default level.

−694

;;;

−695

;;; `fs/rename` carries `from:`/`to:` instead of `path:`, and reporting

−696

;;; only one of them would misreport the operation.

+780

;;; Return a bounded path summary for the operation log. Git status names

+781

;;; its worktree inside `repo`, while discovery and filesystem operations

+782

;;; use `path`. Rename carries `from`/`to`. We never inspect or log status

+783

;;; output, patch text, file contents, or Git stderr here.

+784

(define (bounded-path-summary value)

+785

(if (and (string? value) (> (string-length value) 512))

+786

(string-append (substring value 0 509) "...")

+787

value))

+788

789

(define (args-path-summary args)

790

(guard (e (#t "<unreadable>"))

791

(let ((p (dict-ref args path: #f))

792

(from (dict-ref args from: #f))

−701

(to (dict-ref args to: #f)))

+793

(to (dict-ref args to: #f))

+794

(repo (dict-ref args repo: #f)))

795

(cond

−703

((string? p) p)

−704

((and (string? from) (string? to)) (string-append from " -> " to))

−705

((string? from) from)

+796

((string? p) (bounded-path-summary p))

+797

((and (string? from) (string? to))

+798

(bounded-path-summary (string-append from " -> " to)))

+799

((string? from) (bounded-path-summary from))

+800

((dict? repo)

+801

(bounded-path-summary (dict-ref repo worktree: "")))

802

(else "")))))

803

804

;;; Render a value that is NOT known to be well-formed. Used for the

@@ -739,7 +835,10 @@

835

;; Curated client-error slugs (raised as the error message):

836

;; surface the slug as the code and the string irritant as the

837

;; human message. Anything else is a generic "error".

−742

((or (string=? msg "invalid-args") (string=? msg "invalid-bulk"))

+838

((or (string=? msg "invalid-args") (string=? msg "invalid-bulk")

+839

(string=? msg "not-a-repository") (string=? msg "git-unavailable")

+840

(string=? msg "stale-snapshot") (string=? msg "conflict")

+841

(string=? msg "operation-failed"))

842

(reply-err id msg (or (first-irritant e) msg)))

843

(else (reply-err id "error" msg)))))

844

packages/slate-cli/src/slate-cli/enclave-node-init.sglmodified

@@ -10,6 +10,7 @@

10

(sigil json)

11

(sigil irc message))

12

(export node-init-normalize-origin node-init-websocket-url

+13

node-init-stream-websocket-url

14

node-init-request-command node-init-pending-result

15

node-init-complete-result node-init-failure

16

node-init-approval-url node-init-record

@@ -49,6 +50,13 @@

50

(string-append "wss://" (substring value 8 (string-length value)) "/ws"))

51

(else (string-append "ws://" (substring value 7 (string-length value)) "/ws")))))

52

+53

;; Control and relay streams normally share one endpoint. An explicit

+54

;; stream ingress remains optional so split-plane deployments (and their

+55

;; carrier-only fault gates) do not have to perturb the account socket.

+56

(define (node-init-stream-websocket-url record)

+57

(dict-ref record stream-websocket-url:

+58

(dict-ref record websocket-url: "")))

+59

60

(define (node-init-request-command account node-name)

61

(make-irc-command "PAIR-REQUEST" account node-name))

62

@@ -70,11 +78,14 @@

78

(define (node-init-complete-result msg)

79

(let ((status (tag msg "+enclave/result.status"))

80

(node-name (tag msg "+enclave/result.node-name"))

+81

(transport-nick (tag msg "+enclave/result.transport-nick"))

82

(bot-id (tag msg "+enclave/result.bot-id"))

83

(token (tag msg "+enclave/result.token")))

84

(and (pair-request? msg) (equal? status "ok") node-name bot-id token

85

(= (string-length token) 64)

−77

#{ node-name: node-name bot-id: bot-id token: token })))

+86

#{ node-name: node-name

+87

transport-nick: (or transport-nick node-name)

+88

bot-id: bot-id token: token })))

89

90

(define (node-init-failure msg)

91

(and (irc-message? msg) (eq? (irc-message-command msg) 'FAIL)

@@ -87,9 +98,11 @@

98

"/" (dict-ref pending approval-fragment: "")))

99

100

(define (node-init-record origin completed)

−90

#{ version: 1 origin: (node-init-normalize-origin origin)

+101

#{ version: 2 origin: (node-init-normalize-origin origin)

102

websocket-url: (node-init-websocket-url origin)

103

node-name: (dict-ref completed node-name: "")

+104

transport-nick: (dict-ref completed transport-nick:

+105

(dict-ref completed node-name: ""))

106

bot-id: (dict-ref completed bot-id: "")

107

token: (dict-ref completed token: "") })

108

@@ -97,10 +110,16 @@

110

(define (node-init-record<-json text)

111

(guard (e (#t #f))

112

(let ((record (json-decode text)))

−100

(and (= (dict-ref record version: 0) 1)

+113

(and (member (dict-ref record version: 0) '(1 2))

114

(> (string-length (dict-ref record origin: "")) 0)

115

(> (string-length (dict-ref record node-name: "")) 0)

+116

(> (string-length (dict-ref record transport-nick:

+117

(dict-ref record node-name: ""))) 0)

118

(= (string-length (dict-ref record token: "")) 64)

+119

(let ((stream-url (dict-ref record stream-websocket-url: #f)))

+120

(or (not stream-url)

+121

(and (string? stream-url)

+122

(> (string-length stream-url) 0))))

123

record))))

124

125

;; Never silently accept ambient umask permissions for credentials. The

packages/slate-cli/src/slate-cli/enclave-node-session.sglmodified

@@ -15,6 +15,7 @@

15

node-session-format-trailing-command

16

node-session-parse-wire-message

17

node-session-phase node-session-active? node-session-done?

+18

node-session-reconnect!

19

node-session-set-transport! node-session-reset-transport!)

20

(begin

21

(define *ws* #f)

@@ -60,21 +61,30 @@

61

(define (ticket-fields raw)

62

(let ((command-pos (string-find raw "STREAM-TICKET ")))

63

(and command-pos

−63

(let* ((tail (substring raw

−64

(+ command-pos (string-length "STREAM-TICKET "))

−65

(string-length raw)))

−66

(f0 (split-ticket-field tail)))

−67

(and f0

−68

(let ((f1 (split-ticket-field (cdr f0))))

−69

(and f1

−70

(let ((f2 (split-ticket-field (cdr f1))))

−71

(and f2

−72

(let ((f3 (split-ticket-field (cdr f2))))

−73

(and f3

−74

(list (car f0) (car f1) (car f2)

−75

(car f3) (cdr f3)))))))))))))

+64

(let loop ((tail (substring raw

+65

(+ command-pos (string-length "STREAM-TICKET "))

+66

(string-length raw)))

+67

(fields '()))

+68

(let ((field (split-ticket-field tail)))

+69

(if field

+70

(loop (cdr field) (cons (car field) fields))

+71

(let ((all (reverse (cons tail fields))))

+72

(and (member (length all) '(5 13)) all))))))))

+73

+74

(define (direct-ticket-fields raw)

+75

(let ((command-pos (string-find raw "DIRECT-TICKET ")))

+76

(and command-pos

+77

(let loop ((tail (substring raw

+78

(+ command-pos (string-length "DIRECT-TICKET "))

+79

(string-length raw)))

+80

(fields '()))

+81

(let ((field (split-ticket-field tail)))

+82

(if field

+83

(loop (cdr field) (cons (car field) fields))

+84

(let ((all (reverse (cons tail fields))))

+85

(and (member (length all) '(7 15)) all))))))))

86

−77

(define (stream-open-fields raw)

+87

(define (enclave-rpc-fields raw expected-verb)

88

(let ((command-pos (string-find raw "ENCLAVE-RPC ")))

89

(and command-pos

90

(let* ((tail (substring raw

@@ -85,16 +95,28 @@

95

(let ((f1 (split-ticket-field (cdr f0))))

96

(and f1

97

(let ((f2 (split-ticket-field (cdr f1))))

−88

(and f2 (string=? (car f2) "stream/open")

−89

(list (car f0) (car f1) (car f2)

−90

(cdr f2)))))))))))

+98

(and f2 (string=? (car f2) expected-verb)

+99

(let ((payload (cdr f2)))

+100

(list (car f0) (car f1) (car f2)

+101

(if (and (> (string-length payload) 0)

+102

(char=? (string-ref payload 0)

+103

#\:))

+104

(substring payload 1

+105

(string-length payload))

+106

payload))))))))))))

107

108

;; STREAM-TICKET carries two opaque capabilities and can exceed the native

−93

;; 0.18.x IRC parser's recursive scan limit. Locate its fixed five fields

+109

;; 0.18.x IRC parser's recursive scan limit. Locate its legacy five fields

+110

;; or the node-to-node shape with eight authoritative public descriptors

111

;; with the native substring search primitive; never interpret capability

112

;; bytes as either IRC or Sigil syntax. Ordinary lines use the IRC parser.

113

(define (node-session-parse-wire-message raw)

114

(cond

+115

((string-contains? raw "DIRECT-TICKET")

+116

(let ((fields (direct-ticket-fields raw)))

+117

(if fields

+118

(cons 'direct-ticket-message fields)

+119

(parse-irc-message raw))))

120

((string-contains? raw "STREAM-TICKET")

121

(let ((fields (ticket-fields raw)))

122

(if fields

@@ -102,18 +124,24 @@

124

(parse-irc-message raw))))

125

((and (string-contains? raw "ENCLAVE-RPC")

126

(string-contains? raw "stream/open"))

−105

(let ((fields (stream-open-fields raw)))

+127

(let ((fields (enclave-rpc-fields raw "stream/open")))

128

(if fields

129

(cons 'stream-open-message fields)

130

(parse-irc-message raw))))

+131

((and (string-contains? raw "ENCLAVE-RPC")

+132

(string-contains? raw "stream/ticket"))

+133

(let ((fields (enclave-rpc-fields raw "stream/ticket")))

+134

(if fields

+135

(cons 'relay-ticket-message fields)

+136

(parse-irc-message raw))))

137

(else (parse-irc-message raw))))

138

−111

(define (node-session-receive session)

+139

(define (node-session-receive-with receiver session)

140

(let ((queued (pop-wire-message!)))

141

(if queued queued

142

(let ((websocket (irc-ws-session-websocket session)))

143

(if (not websocket) 'closed

−116

(let ((message (ws-receive websocket)))

+144

(let ((message (receiver websocket)))

145

(cond

146

((and (ws-message? message)

147

(eq? (ws-message-type message) 'text))

@@ -122,9 +150,16 @@

150

((eq? message 'closed) 'closed)

151

(else message))))))))

152

+153

(define (node-session-receive-nowait session)

+154

(node-session-receive-with ws-receive-nowait session))

+155

156

(define (default-transport)

157

#{ connect: (lambda (url nick)

−127

(irc-ws-connect url: url nick: nick user: nick realname: "Slate node"))

+158

(irc-ws-connect

+159

url: url nick: nick user: nick realname: "Slate node"

+160

connect-timeout-ms: 5000

+161

handshake-timeout-ms: 5000

+162

upgrade-timeout-ms: 5000))

163

connected?: irc-ws-connected? send: irc-ws-send command: irc-ws-command

164

register: irc-ws-register

165

receive: (lambda (session)

@@ -132,6 +167,7 @@

167

(if (string? line)

168

(node-session-parse-wire-message line)

169

line)))

+170

receive-nowait: node-session-receive-nowait

171

close: irc-ws-close })

172

(define *transport* (default-transport))

173

(define (call key . args) (apply (dict-ref *transport* key) args))

@@ -165,10 +201,15 @@

201

202

(define (open! phase nick)

203

(set! *phase* phase)

−168

(log-info* "enclave connecting"

−169

mod: "enclave" phase: phase nick: nick

−170

url: (node-init-websocket-url *origin*))

−171

(set! *ws* (call connect: (node-init-websocket-url *origin*) nick))

+204

(let ((started-at (current-milliseconds)))

+205

(log-info* "enclave connecting"

+206

mod: "enclave" phase: phase nick: nick

+207

url: (node-init-websocket-url *origin*))

+208

(set! *ws* (call connect: (node-init-websocket-url *origin*) nick))

+209

(log-info* "enclave connect finished"

+210

mod: "enclave" phase: phase

+211

result: (if *ws* "connected" "failed")

+212

elapsed-ms: (- (current-milliseconds) started-at)))

213

(unless *ws* (fail! "CONNECTION_FAILED")))

214

215

(define (node-session-start! origin account node-name on-pending on-record on-ready on-error)

@@ -186,7 +227,8 @@

227

(define (node-session-resume! record on-ready on-message on-error)

228

(node-session-close!)

229

(set! *origin* (dict-ref record origin: ""))

−189

(set! *node-name* (dict-ref record node-name: ""))

+230

(set! *node-name* (dict-ref record transport-nick:

+231

(dict-ref record node-name: "")))

232

(set! *token* (dict-ref record token: #f))

233

(set! *record* record)

234

(set! *on-ready* on-ready)

@@ -194,6 +236,22 @@

236

(set! *on-error* on-error)

237

(open! 'auth-connecting *node-name*))

238

+239

;; Reopen only the account control plane after a transient failure. The

+240

;; daemon owns the local listener, direct listener, carriers and holders;

+241

;; none of those may be torn down merely because Enclave is unavailable.

+242

;; Keep the established callbacks and reload the short-lived SASL secret

+243

;; from the durable record for this fresh authentication attempt.

+244

(define (node-session-reconnect!)

+245

(let ((record *record*)

+246

(on-ready *on-ready*)

+247

(on-message *on-message*)

+248

(on-error *on-error*))

+249

(and record

+250

(begin

+251

(node-session-resume!

+252

record on-ready on-message on-error)

+253

#t))))

+254

255

;; Serialize an IRC command whose final argument is trailing text. Keep

256

;; this list-driven: native 0.18.x currently misapplies the variadic

257

;; contract on make-trailing-command when it is reached through `apply`.

@@ -206,6 +264,11 @@

264

(loop (cdr rest)

265

(string-append line " " (car rest)))))))

266

+267

(define (node-session-format-command command args)

+268

(let loop ((rest args) (line command))

+269

(if (null? rest) line

+270

(loop (cdr rest) (string-append line " " (car rest))))))

+271

272

;; Returns #f — SILENTLY DROPPING THE COMMAND — whenever the socket is

273

;; gone or the session is not yet in phase `done`. `run-node-remote!`

274

;; computes a full RPC response and hands it here, so a #f would mean a

@@ -225,11 +288,14 @@

288

mod: "enclave" command: command phase: *phase*

289

socket: (if *ws* "open" "none")))

290

(and *ws* (eq? *phase* 'done)

−228

(if (string=? command "ENCLAVE-RPC")

−229

(call send: *ws*

−230

(node-session-format-trailing-command command args))

−231

(apply (dict-ref *transport* command:)

−232

(cons *ws* (cons command args))))))

+291

;; Post-auth extension commands use list-driven serializers. Native

+292

;; currently misapplies the variadic command contract through

+293

;; `apply`; ENCLAVE-RPC needs a trailing JSON payload, while

+294

;; DIRECT-OPEN's correlation id is an ordinary middle parameter.

+295

(call send: *ws*

+296

(if (string=? command "ENCLAVE-RPC")

+297

(node-session-format-trailing-command command args)

+298

(node-session-format-command command args)))))

299

300

(define (strip-crlf line)

301

(let loop ((n (string-length line)))

@@ -260,6 +326,8 @@

326

(define (begin-auth! completed)

327

(set! *token* (dict-ref completed token: #f))

328

(set! *record* (node-init-record *origin* completed))

+329

(set! *node-name* (dict-ref completed transport-nick:

+330

(dict-ref completed node-name: "")))

331

(if (*on-record* *record*)

332

(begin

333

(when *ws* (call close: *ws*))

@@ -313,77 +381,47 @@

381

;; Snapshot the transport once. A native websocket poll may dispatch a

382

;; callback that changes *ws*; re-reading the global halfway through this

383

;; poll previously passed #f to irc-ws-receive.

−316

(let ((ws *ws*))

+384

(let* ((ws *ws*)

+385

;; The native readiness probe may synchronously dispatch a failed

+386

;; connect callback. That callback clears *ws* while the wrapper

+387

;; is still unwinding, and some native versions then raise while

+388

;; consulting their now-empty inner socket. Probe once, guarded;

+389

;; the identity check below decides whether its answer is usable.

+390

(connected (and ws

+391

(guard (e (#t #f)) (call connected?: ws)))))

392

(cond

393

((not ws) #f)

−319

((and (eq? *phase* 'request-connecting) (call connected?: ws))

+394

((and connected (eq? *phase* 'request-connecting))

395

(call command: ws "PAIR-REQUEST" *account* *node-name*)

396

(set! *phase* 'request-waiting))

−322

((and (eq? *phase* 'auth-connecting) (call connected?: ws))

+397

((and connected (eq? *phase* 'auth-connecting))

398

(call command: ws "CAP" "LS" "302") (set! *phase* 'auth-cap-ls))

399

(else #f))

−325

(when (and (eq? ws *ws*) (call connected?: ws))

+400

;; A synchronous connect refusal makes both the snapshot and *ws* #f.

+401

;; `(eq? #f #f)` is true, so identity alone is not a socket guard.

+402

(when (and connected (eq? ws *ws*))

403

(let loop ((n 0))

404

(when (< n 16)

−328

;; ===============================================================

−329

;; THE PAIRED RECEIVE TRACE — the wedge instrument.

−330

;;

−331

;; `run-node-remote!` runs OUTSIDE `with-async`, so

−332

;; `(current-scheduler)` is #f, and sigil-websocket only sets the

−333

;; socket non-blocking and only awaits readability

−334

;; `(when (current-scheduler) ...)`. This receive therefore

−335

;; BLOCKS IN THE KERNEL until a frame arrives or the socket

−336

;; closes, with no read timeout anywhere beneath it.

−337

;;

−338

;; That is why these two lines exist instead of a periodic

−339

;; heartbeat in the caller's loop: a heartbeat can only print

−340

;; while messages are arriving, so it goes silent in precisely

−341

;; the failure it was meant to explain. An unmatched

−342

;; `receive-enter` says THE PROCESS STOPPED WHILE INSIDE THIS

−343

;; READ, which is a positive fact where silence is only an

−344

;; absence.

−345

;;

−346

;; READ THE CLAIM NARROWLY — an earlier version of this comment

−347

;; overstated it, and adversarial review was right to object.

−348

;; "Stopped inside the read" has THREE causes, not one:

−349

;; (a) blocked indefinitely — the wedge (folio t-c57a8c);

−350

;; (b) killed while blocked — and note that a perfectly

−351

;; healthy node being restarted by shepherd produces this

−352

;; same signature, so an unmatched enter is NOT by itself

−353

;; evidence of a fault;

−354

;; (c) an exception thrown beneath the read. `parse-irc-message`

−355

;; can blow the native parser's recursive scan limit on a

−356

;; long line (see the STREAM-TICKET note below), and the

−357

;; caller's run-loop has no guard, so the process dies.

−358

;;

−359

;; DISAMBIGUATE BY WHAT FOLLOWS THE UNMATCHED ENTER:

−360

;; nothing, and the pid is still alive -> (a), the wedge;

−361

;; a `--- slate restart ---` marker -> (b) or (c), the

−362

;; process was replaced; check the supervisor's own log,

−363

;; which captures stderr and any backtrace;

−364

;; more lines from the same pid -> not stuck at all.

−365

;; The restart marker is written by `open-log-append!` for

−366

;; exactly this reason.

−367

;;

−368

;; Keep them PAIRED and keep them at the same level. A lone

−369

;; enter-line is the signal; deleting the exit-line, or moving

−370

;; either across a level boundary, destroys the instrument

−371

;; without making anything fail.

−372

;;

−373

;; `debug`, not `trace`: this fires once per inbound CONTROL

−374

;; message, not per byte, so it is affordable at the level the

−375

;; node will actually be run at.

−376

;; ===============================================================

−377

(let ((msg (begin

−378

(log-debug* "enclave receive-enter"

−379

mod: "enclave" phase: *phase*)

−380

(call receive: ws))))

−381

(log-debug* "enclave receive-exit"

−382

mod: "enclave" phase: *phase*)

+405

;; This executes on every 10ms supervisor turn, including the

+406

;; overwhelmingly common no-data case. The former paired

+407

;; enter/exit diagnostic wrote two log lines per poll and drove

+408

;; significant CPU and disk churn while idle. Connection setup

+409

;; is bounded now, and receive-nowait has its own nonblocking

+410

;; contract, so retain only an anomalous-duration measurement.

+411

(let* ((started-at (current-milliseconds))

+412

(msg ((dict-ref *transport* receive-nowait:

+413

(dict-ref *transport* receive:)) ws))

+414

(elapsed (- (current-milliseconds) started-at)))

+415

(when (> elapsed 50)

+416

(log-warn* "slow Enclave nonblocking receive"

+417

mod: "enclave" phase: *phase*

+418

elapsed-ms: elapsed))

419

(cond

420

((and (pair? msg)

−385

(or (eq? (car msg) 'stream-ticket-message)

−386

(eq? (car msg) 'stream-open-message)))

+421

(or (eq? (car msg) 'direct-ticket-message)

+422

(eq? (car msg) 'stream-ticket-message)

+423

(eq? (car msg) 'stream-open-message)

+424

(eq? (car msg) 'relay-ticket-message)))

425

;; A handler may send an RPC response. Return to the outer

426

;; event pump before receiving again so the native send

427

;; continuation and its GC roots are fully unwound.

packages/slate-cli/src/slate-cli/enclave-remote.sglmodified

@@ -19,6 +19,10 @@

19

remote-bulk-base64url-encode

20

remote-response-command)

21

(begin

+22

(define (drop-fields values count)

+23

(if (= count 0) values

+24

(and (pair? values) (drop-fields (cdr values) (- count 1)))))

+25

26

(define (remote-rpc-message? msg)

27

(or (and (irc-message? msg)

28

(eq? (irc-message-command msg) 'ENCLAVE-RPC))

@@ -48,8 +52,9 @@

52

;;; enforced that sender owns this node; the sender account remains the

53

;;; principal key used by the shared grant engine and its audit trail.

54

;;; `note-sid!` (optional) is called EXACTLY ONCE per accepted

−51

;;; `stream/open`, as (note-sid! sender request-id sid-or-#f), and it is

−52

;;; how the durable sid reaches the router. It has to be a callback

+55

;;; `stream/open`, as (note-sid! sender request-id sid-or-#f). Resource

+56

;;; downloads use the same callback with the `resource:` routing hint.

+57

;;; This is how the durable sid reaches the router. It has to be a callback

58

;;; rather than a return value because the sid arrives on `stream/open`

59

;;; and the TICKET it routes arrives later, on a separate inbound

60

;;; `STREAM-TICKET` — the two are correlated by (sender, request-id) and

@@ -89,13 +94,20 @@

94

;; carry the sid and must not be used to look for one. The sid

95

;; is read off the RAW payload, deliberately, because that is

96

;; the path that does not go through the reader above.

−92

(env (if (and verb (string=? verb "stream/open"))

+97

(env (if (and verb (or (string=? verb "stream/open")

+98

(string=? verb "resource/open")))

99

#{ id: (or (and request-id (string->number request-id))

100

request-id)

101

args: #{} }

102

(guard (e (#t #f)) (json-decode payload)))))

103

(and sender request-id verb (dict? env)

−98

(if (string=? verb "stream/open")

+104

(cond

+105

((string=? verb "resource/open")

+106

;; Resource streams never reserve a durable session

+107

;; holder, even when the session quota is full.

+108

(note-sid! sender request-id resource:)

+109

(list "STREAM-TICKET" sender request-id))

+110

((string=? verb "stream/open")

111

;; THE NARROW SCRAPE. `scrape-sid` is a flat, single-pass

112

;; scan that never invokes the recursive native JSON

113

;; reader — the reader the comment above records as

@@ -151,26 +163,27 @@

163

"stream/open"

164

(json-encode

165

#{ control: #{ t: "err" code: "bad-args"

−154

message: "sid is malformed" } })))))

−155

(let* ((id (dict-ref env id: request-id))

−156

(req (dict-set (dict-set env id: id) verb: verb))

−157

;; Enclave proves identity/ownership; the node still

−158

;; decides capability. Unknown account principals are

−159

;; denied by the ordinary grant engine.

−160

(remote-config

−161

(make-config grants:

−162

(list (cons sender (config-silent-pair-grants config)))))

−163

(grants (build-principal-grants remote-config sender))

−164

(reply (dispatch-req

−165

#{ config: remote-config } sender grants req))

−166

(control (reply-control reply))

−167

(bulk (reply-bulk reply))

−168

(body (json-encode

−169

(if bulk

−170

#{ control: control

−171

bulk-base64url: (remote-bulk-base64url-encode bulk) }

−172

#{ control: control }))))

−173

(remote-response-command sender request-id verb body)))))))

+166

message: "sid is malformed" } }))))))

+167

(else

+168

(let* ((id (dict-ref env id: request-id))

+169

(req (dict-set (dict-set env id: id) verb: verb))

+170

;; Enclave proves identity/ownership; the node still

+171

;; decides capability. Unknown account principals are

+172

;; denied by the ordinary grant engine.

+173

(remote-config

+174

(make-config grants:

+175

(list (cons sender (config-silent-pair-grants config)))))

+176

(grants (build-principal-grants remote-config sender))

+177

(reply (dispatch-req

+178

#{ config: remote-config } sender grants req))

+179

(control (reply-control reply))

+180

(bulk (reply-bulk reply))

+181

(body (json-encode

+182

(if bulk

+183

#{ control: control

+184

bulk-base64url: (remote-bulk-base64url-encode bulk) }

+185

#{ control: control }))))

+186

(remote-response-command sender request-id verb body))))))))

187

188

;;; Enclave returns both opaque tickets only to the authenticated node. The

189

;;; node consumes its half locally and sends only the client half back over

@@ -202,7 +215,9 @@

215

(let* ((client (list-ref p 0)) (request-id (list-ref p 1))

216

(client-ticket (list-ref p 2)) (node-ticket (list-ref p 3))

217

(ttl (list-ref p 4))

−205

(outcome (route-ticket client request-id node-ticket)))

+218

(metadata (if (= (length p) 13)

+219

(drop-fields p 5) '()))

+220

(outcome (route-ticket client request-id node-ticket metadata)))

221

(if (dict? outcome)

222

(remote-response-command client request-id "stream/open"

223

(json-encode

@@ -210,5 +225,6 @@

225

code: (dict-ref outcome code: "unavailable")

226

message: (dict-ref outcome message: "stream unavailable") } }))

227

(remote-response-command client request-id "stream/ticket"

−213

(json-encode #{ ticket: client-ticket expires-in: ttl }))))))))

+228

(json-encode #{ ticket: client-ticket expires-in: ttl

+229

pairing-descriptors: metadata }))))))))

230

))

packages/slate-cli/src/slate-cli/enclave-stream.sglmodified

@@ -1,7 +1,7 @@

1

;;; `/stream` node endpoint. Adapts the existing session hub to an opaque,

2

;;; identity-ticketed Enclave WebSocket; Enclave never decodes these frames.

3

(define-library (slate-cli enclave-stream)

−4

(import (sigil io) (sigil json) (sigil string) (sigil async)

+4

(import (sigil io) (sigil json) (sigil string) (sigil array) (sigil async)

5

(only (sigil math) quotient)

6

(sigil log)

7

(sigil time)

@@ -11,16 +11,28 @@

11

;; UNBOUND VARIABLE swallows the error and reports a successful

12

;; unlink that never happened — a silent failure of exactly the kind

13

;; this phase exists to remove.

−14

(sigil fs)

+14

(sigil fs) (sigil path)

15

(sigil socket)

16

17

(sigil websocket) (sigil websocket frame)

−18

(slate-cli config) (slate-cli listen) (slate-cli sessions)

+18

(slate-cli config) (slate-cli dispatch) (slate-cli listen)

+19

(slate-cli sessions)

+20

(slate-cli terminal discovery)

+21

(slate-cli terminal owner)

+22

(slate-cli resource transfer connection)

+23

(slate-cli node pairing)

+24

(slate-cli node pairing-carrier)

25

(slate-cli wire))

−20

(export enclave-stream-start! enclave-stream-poll! enclave-stream-listen!

+26

(export enclave-stream-start! enclave-stream-start-on-hub!

+27

enclave-stream-poll! enclave-stream-listen!

28

enclave-stream-unlisten!

29

enclave-stream-start-reaper!

−23

enclave-stream-control-frame enclave-stream-control-text)

+30

enclave-stream-control-frame enclave-stream-control-text

+31

;; Focused relay Resource-plane test seams. These drive the same

+32

;; holder adapter used by /stream without opening a network socket.

+33

make-enclave-stream-test-holder

+34

enclave-stream-test-text! enclave-stream-test-binary!

+35

enclave-stream-test-close!)

36

(begin

37

(define *streams* '())

38

;; Sessions belong to the authenticated node, not to one relay socket.

@@ -107,17 +119,20 @@

119

;;; spawns that way; `test-logging-contract.sgl` pins the 3-arg arity).

120

;;; A holder GIVEN a path that will not bind has been asked, and failed,

121

;;; and must die loudly before a single session exists to be stranded.

−110

(define (enclave-stream-listen! path config)

+122

(define (enclave-stream-listen! path config . hub)

+123

(when (pair? hub) (set! *session-hub* (car hub)))

124

(set! *ctl-config* config)

−112

(guard (e (#t (log-error "holder control socket UNAVAILABLE; refusing to park unreachable"

−113

mod: "stream" path: path)

−114

#f))

−115

(let ((l (unix-listen path)))

−116

(socket-set-non-blocking! l #t)

−117

(set! *ctl-listener* l)

−118

(set! *ctl-path* path)

−119

(log-info* "holder listening for tickets" mod: "stream" path: path)

−120

#t)))

+125

(if (and *ctl-listener* (equal? path *ctl-path*))

+126

#t

+127

(guard (e (#t (log-error "holder control socket UNAVAILABLE; refusing to park unreachable"

+128

mod: "stream" path: path)

+129

#f))

+130

(let ((l (unix-listen path)))

+131

(socket-set-non-blocking! l #t)

+132

(set! *ctl-listener* l)

+133

(set! *ctl-path* path)

+134

(log-info* "holder listening for tickets" mod: "stream" path: path)

+135

#t))))

136

137

;;; Unlink the socket on the way out. The control node also sweeps stale

138

;;; sockets at startup, because a holder killed with SIGKILL never runs

@@ -153,10 +168,11 @@

168

169

;; Answer one control line on the seam. The router writes it and closes.

170

;;

−156

;; TWO VERBS, and the split is deliberate:

+171

;; Routing and discovery stay separate:

172

;;

173

;; OWNS <sid> -> "OWNS <sid> yes" | "OWNS <sid> no"

174

;; TICKET <ws-url> <client> <ticket> -> dial a replacement /stream

+175

;; LIST <JSON principal> -> local, principal-filtered summaries

176

;;

177

;; THE QUERY CARRIES NO CREDENTIAL, AND THAT IS A SECURITY PROPERTY, not

178

;; a tidiness one. The control node must find out WHICH of its holders owns

@@ -202,6 +218,14 @@

218

(string-append "OWNS " sid

219

(if (hub-holds-sid? *session-hub* sid) " yes" " no")

220

"\n"))))

+221

((string-starts-with? line "LIST ")

+222

(let ((principal (guard (e (#t #f))

+223

(json-decode (substring line 5 (string-length line))))))

+224

(when (string? principal)

+225

(ctl-reply!

+226

(string-append

+227

(json-encode #{ sessions: (list->array

+228

(hub-session-summaries *session-hub* principal)) }) "\n")))))

229

(else (log-warn* "unrecognised control line" mod: "stream")))))

230

231

(define (ctl-drop!)

@@ -251,7 +275,145 @@

275

(enclave-stream-control-frame (utf8->string (ws-frame-payload f))))

276

(ws-send-binary ws (ws-frame-payload f))))))

277

−254

(define (enclave-stream-start! websocket-url client ticket config)

+278

(define (holder-hub-verb? verb)

+279

(and (string? verb)

+280

(or (and (>= (string-length verb) 8)

+281

(string=? (substring verb 0 8) "session/"))

+282

(and (>= (string-length verb) 6)

+283

(string=? (substring verb 0 6) "agent/")))))

+284

+285

;;; Relay Resource requests use the same dispatcher as the direct listener.

+286

;;; The holder's virtual connection owns the transport-specific deferred

+287

;;; write slot and watch handles, exactly as a direct connection does.

+288

(define (holder-on-text daemon conn text)

+289

(let ((env (and (<= (string-length text) 65536)

+290

(decode-control text))))

+291

(unless (pairing-carrier-handle! conn text)

+292

(if (and env (equal? (dict-ref env t: #f) "req")

+293

(not (holder-hub-verb? (dict-ref env verb: ""))))

+294

(holder-send-reply! conn

+295

(dispatch-req daemon (conn-origin conn)

+296

(conn-state-get conn "grants" #f) env))

+297

(if (conn-state-get conn "resource-only" #f)

+298

(ws-send-control! conn

+299

#{ t: "err" id: (if env (dict-ref env id: 0) 0)

+300

code: "unsupported"

+301

message: "resource streams do not support sessions" })

+302

(sessions-on-text daemon conn text))))))

+303

+304

(define (holder-send-reply! conn reply)

+305

(let ((pending (reply-pending-write reply))

+306

(transfer (reply-transfer reply)))

+307

(cond

+308

(pending (conn-state-set! conn "pending-write" pending))

+309

(transfer

+310

(let ((result (resource-transfer-open! conn

+311

(conn-state-get conn "grants" #f) transfer)))

+312

(when (and (conn-state-get conn "resource-only" #f)

+313

(not (eq? (dict-ref result status: #f) 'ready)))

+314

(resource-finished! conn))))

+315

(else

+316

(let ((sub (reply-subscription reply)))

+317

(when sub (holder-watch-start! conn sub)))

+318

(let ((cancel (reply-cancel reply)))

+319

(when cancel (holder-watch-stop! conn cancel)))

+320

(let ((control (reply-control reply)))

+321

(when control (ws-send-control! conn control)))

+322

(let ((bulk (reply-bulk reply)))

+323

(when bulk

+324

(ws-send-binary! conn

+325

(encode-stream-frame frame-bulk

+326

(reply-bulk-id reply) bulk))))

+327

(when (conn-state-get conn "resource-only" #f)

+328

(resource-finished! conn))))))

+329

+330

(define (resource-finished! conn)

+331

;; Sending END does not mean the browser has consumed it. Let its close

+332

;; acknowledge receipt; bound abandoned workers if that close never comes.

+333

(conn-state-set! conn "resource-done" (current-milliseconds)))

+334

+335

;;; Non-control relay frames retain their ordinary node framing. A 0x10

+336

;;; frame completes a holder-owned deferred write; every other frame stays

+337

;;; on the unchanged Session lane.

+338

(define (holder-on-binary daemon conn bytes)

+339

(let ((frame (decode-stream-frame bytes)))

+340

(when frame

+341

(cond

+342

((= (stream-frame-type frame) frame-bulk)

+343

(let* ((id (stream-frame-id frame))

+344

(pending (conn-state-get conn "pending-write" #f)))

+345

(if (and pending (equal? (dict-ref pending id: #f) id))

+346

(begin

+347

;; Consume before dispatch: a raising/invalid body can

+348

;; never be replayed into the same authority slot.

+349

(conn-state-set! conn "pending-write" #f)

+350

(holder-send-reply! conn

+351

(dispatch-bulk-write

+352

(conn-state-get conn "grants" #f) id

+353

(dict-ref pending path: "")

+354

(stream-frame-payload frame))))

+355

(ws-send-control! conn

+356

#{ t: "err" id: id code: "no-pending-bulk"

+357

message: "no fs/write-file awaiting this id" }))))

+358

((resource-transfer-frame? frame)

+359

(let ((result (resource-transfer-frame! conn frame)))

+360

(when (and (conn-state-get conn "resource-only" #f)

+361

(member (dict-ref result status: #f)

+362

'(complete cancelled refused)))

+363

(resource-finished! conn))))

+364

(else

+365

(unless (conn-state-get conn "resource-only" #f)

+366

(sessions-handle-binary daemon conn bytes)))))))

+367

+368

(define holder-watch-poll-interval 1)

+369

+370

(define (holder-watch-start! conn sub)

+371

(let ((id (dict-ref sub sub: #f))

+372

(path (dict-ref sub path: ""))

+373

(watcher (dict-ref sub watcher: #f)))

+374

(conn-state-set! conn "watches"

+375

(cons (cons id watcher) (conn-state-get conn "watches" '())))

+376

(go (holder-watch-loop conn id watcher path))))

+377

+378

(define (holder-watch-stop! conn sub)

+379

(let ((watcher (holder-watch-find conn sub)))

+380

(when watcher (watch-close watcher))

+381

(conn-state-set! conn "watches" (holder-watch-remove conn sub))))

+382

+383

(define (holder-watch-loop conn sub watcher path)

+384

(guard (e (#t #f))

+385

(let loop ()

+386

(sleep holder-watch-poll-interval)

+387

(when (holder-watch-find conn sub)

+388

(let ((changed (watch-changes watcher)))

+389

(when (pair? changed)

+390

(ws-send-control! conn

+391

#{ t: "ev" sub: sub

+392

event: #{ kind: "change" path: path changed: changed } }))

+393

(loop))))))

+394

+395

(define (holder-watch-find conn sub)

+396

(assv-ref sub (conn-state-get conn "watches" '()) #f))

+397

+398

(define (holder-watch-remove conn sub)

+399

(let loop ((watches (conn-state-get conn "watches" '())) (out '()))

+400

(cond

+401

((null? watches) (reverse out))

+402

((eqv? (car (car watches)) sub) (loop (cdr watches) out))

+403

(else (loop (cdr watches) (cons (car watches) out))))))

+404

+405

(define (holder-close! daemon conn)

+406

(pairing-carrier-close! conn)

+407

(resource-transfer-close! conn 'connection-lost)

+408

(for-each (lambda (entry)

+409

(guard (e (#t #f)) (watch-close (cdr entry))))

+410

(conn-state-get conn "watches" '()))

+411

(conn-state-set! conn "watches" '())

+412

(conn-state-set! conn "pending-write" #f)

+413

(sessions-conn-closed! daemon conn))

+414

+415

(define (enclave-stream-start-on-hub! websocket-url client ticket config hub

+416

. maybe-pairing-meta)

417

(let* ((ws (ws-connect (stream-url websocket-url)))

418

;; `session-ttl:` is carried across explicitly. This derived config

419

;; is what the daemon dict hands to `do-open`, so it is what

@@ -265,8 +427,13 @@

427

state-dir: (config-state-dir config)

428

grants: (list (cons client (config-silent-pair-grants config)))

429

session-ttl: (config-session-ttl-arg config)))

−268

(daemon #{ config: (dict-set remote-config agent-service: #t)

−269

sessions: *session-hub* })

+430

(daemon #{ config: (dict-set remote-config agent-service: #t) sessions: hub

+431

session-backend: (make-terminal-backend config)

+432

session-directory: (vector

+433

(lambda (principal mine)

+434

(terminal-discover

+435

(path-join (config-state-dir config) "holders")

+436

*ctl-path* principal mine))) })

437

(conn (make-virtual-conn (lambda (frame) (outbound! ws frame)) client))

438

;; Native ws-connect completes its handshake synchronously, but

439

;; ws-connected? is not promoted until a receive poll. Redeem the

@@ -277,6 +444,31 @@

444

;; authenticated account. Never derive this from client request JSON.

445

(conn-state-set! conn "authed?" #t)

446

(ws-send ws ticket)

+447

(conn-state-set! conn "grants"

+448

(build-principal-grants remote-config client))

+449

(let* ((meta (and (pair? maybe-pairing-meta) (car maybe-pairing-meta)))

+450

(descriptors (and (dict? meta) (dict-ref meta descriptors: '())))

+451

(fields (cond ((list? descriptors) descriptors)

+452

((array? descriptors) (array->list descriptors))

+453

(else '())))

+454

(identity (and (= (length fields) 8)

+455

(pairing-load-identity (config-state-dir config)))))

+456

(when (and (dict? meta) (dict-ref meta resource-only?: #f))

+457

(conn-state-set! conn "resource-only" #t))

+458

(when identity

+459

(pairing-carrier-init! conn 'acceptor

+460

#{ session-id: (dict-ref meta request-id: "")

+461

caller-bot-id: (list-ref fields 0)

+462

caller-transport-nick: (dict-ref meta caller-transport-nick: client)

+463

caller-key-id: (list-ref fields 1)

+464

caller-generation: (string->number (list-ref fields 2))

+465

caller-public-key: (list-ref fields 3)

+466

acceptor-bot-id: (list-ref fields 4)

+467

acceptor-transport-nick: (dict-ref meta acceptor-transport-nick: "")

+468

acceptor-key-id: (list-ref fields 5)

+469

acceptor-generation: (string->number (list-ref fields 6))

+470

acceptor-public-key: (list-ref fields 7) }

+471

identity '() (config-state-dir config))))

472

(set! *streams* (cons st *streams*))

473

;; The TICKET IS A BEARER CAPABILITY and is never logged. See

474

;; main.sgl's safe-command-summary: the child's argv carries it, and

@@ -290,6 +482,11 @@

482

;; enters its steady state.

483

st))

484

+485

(define (enclave-stream-start! websocket-url client ticket config . pairing-meta)

+486

(enclave-stream-start-on-hub!

+487

websocket-url client ticket config *session-hub*

+488

(if (pair? pairing-meta) (car pairing-meta) #f)))

+489

490

;; Take at most one message WITHOUT ever parking.

491

;;

492

;; `ws-receive-nowait` EXCLUSIVELY. Plain `ws-receive` parks, and there is

@@ -314,16 +511,6 @@

511

512

(define (take-message! ws)

513

(let ((m (ws-receive-nowait ws)))

−317

;; Starred macro: the classification is only computed when debug is

−318

;; actually enabled. This sits on the session data plane, so an

−319

;; unguarded call would format a string per frame.

−320

(log-debug* "stream recv"

−321

mod: "stream"

−322

got: (cond ((ws-message? m) "message")

−323

((eq? m 'closed) "CLOSED")

−324

((not m) "none")

−325

(else "other"))

−326

connected: (if (ws-connected? ws) "y" "n"))

514

m))

515

516

;; Drain up to 128 frames from one stream. Returns #t while the stream is

@@ -336,24 +523,29 @@

523

(vector-set! st 1 #f)

524

(vector-set! st 2 #t))

525

(let loop ((n 0))

−339

(if (>= n 128)

−340

#t ; hit the batch cap; still live

+526

(cond

+527

((let ((finished (conn-state-get (vector-ref st 4) "resource-done" #f)))

+528

(and finished (>= (- (current-milliseconds) finished) 30000)))

+529

#f)

+530

((>= n 128) #t) ; hit the batch cap; still live

+531

(else

532

(let ((m (take-message! ws)))

533

(cond

534

((ws-message? m)

−344

(when (eq? (ws-message-type m) 'binary)

+535

(when (and (not (conn-state-get (vector-ref st 4) "resource-done" #f))

+536

(eq? (ws-message-type m) 'binary))

537

(let* ((bytes (ws-message-data m))

538

(fr (decode-stream-frame bytes)))

539

(when fr

540

(if (= (stream-frame-type fr) 1)

−349

(sessions-on-text (vector-ref st 3) (vector-ref st 4)

+541

(holder-on-text (vector-ref st 3) (vector-ref st 4)

542

(enclave-stream-control-text bytes))

−351

(sessions-handle-binary (vector-ref st 3) (vector-ref st 4) bytes)))))

+543

(holder-on-binary (vector-ref st 3) (vector-ref st 4) bytes)))))

544

(loop (+ n 1)))

545

((eq? m 'closed)

546

(log-info* "stream reported CLOSED by the relay" mod: "stream")

547

#f) ; relay closed the stream: dead

−356

(else #t))))))) ; #f / no data: live, idle

+548

(else #t)))))))) ; #f / no data: live, idle

549

550

;; Poll every live stream, drop the ones that reported closed, and return

551

;; #t while any stream remains live. The caller exits its loop on #f so a

@@ -368,8 +560,9 @@

560

;; R1 -- only the local listener wired it -- which is one of the reasons

561

;; remote reattach could not work even in principle.

562

(define (retire-stream! st)

+563

(guard (e (#t #f)) (ws-close (vector-ref st 0)))

564

(guard (e (#t #f))

−372

(sessions-conn-closed! (vector-ref st 3) (vector-ref st 4)))

+565

(holder-close! (vector-ref st 3) (vector-ref st 4)))

566

(log-info* "stream closed; sessions detached" mod: "stream"

567

sessions: (hub-session-count *session-hub*)))

568

@@ -449,9 +642,32 @@

642

(let keep ((xs *streams*) (out '()))

643

(if (null? xs)

644

(reverse out)

−452

(let ((alive? (poll-one! (car xs))))

+645

(let ((alive?

+646

(guard (e (#t

+647

(log-debug* "stream poll failed; closing connection"

+648

mod: "stream")

+649

#f))

+650

(poll-one! (car xs)))))

651

(unless alive? (retire-stream! (car xs)))

652

(keep (cdr xs) (if alive? (cons (car xs) out) out))))))

653

(or (pair? *streams*)

654

(> (hub-session-count *session-hub*) 0)))

+655

+656

;; Network-free holder constructor and drivers for focused tests.

+657

(define (make-enclave-stream-test-holder config client send . resource-only)

+658

(let* ((daemon #{ config: config sessions: (make-session-hub) })

+659

(conn (make-virtual-conn send client)))

+660

(conn-state-set! conn "grants" (build-principal-grants config client))

+661

(when (and (pair? resource-only) (car resource-only))

+662

(conn-state-set! conn "resource-only" #t))

+663

(vector daemon conn)))

+664

+665

(define (enclave-stream-test-text! holder text)

+666

(holder-on-text (vector-ref holder 0) (vector-ref holder 1) text))

+667

+668

(define (enclave-stream-test-binary! holder bytes)

+669

(holder-on-binary (vector-ref holder 0) (vector-ref holder 1) bytes))

+670

+671

(define (enclave-stream-test-close! holder)

+672

(holder-close! (vector-ref holder 0) (vector-ref holder 1)))

673

))

packages/slate-cli/src/slate-cli/git/branch.sgladded

@@ -0,0 +1,122 @@

+1

;;; (slate-cli git branch) — bounded local refs and non-forcing branch operations.

+2

(define-library (slate-cli git branch)

+3

(import (sigil math) (sigil io) (sigil string) (sigil json)

+4

(sigil system grant)

+5

(slate-cli git exec) (slate-cli git status) (slate-cli git log))

+6

(export git-branches git-switch-branch git-create-branch git-branch-before-publish-hook!)

+7

(begin

+8

(define *before-publish* #f)

+9

(define (git-branch-before-publish-hook! hook)

+10

(set! *before-publish* hook))

+11

(define (run grants cwd args)

+12

(let ((result (git-exec grants cwd args output-limit: 262144)))

+13

(unless (and (= (dict-ref result exit: -1) 0)

+14

(not (dict-ref result timeout?: #f))

+15

(not (dict-ref result output-exceeded?: #f))

+16

(not (dict-ref result read-error?: #f)))

+17

(let* ((message (string-trim (dict-ref result stderr: "")))

+18

(short (substring message 0 (min 1600 (string-length message)))))

+19

(error "operation-failed"

+20

(if (string=? short "") "Git branch operation failed or exceeded its limits" short))))

+21

(dict-ref result stdout: "")))

+22

(define (branch-name! grants cwd name)

+23

;; Full refs prevent revision expressions and option/checkout shorthand.

+24

(unless (and (string? name) (> (string-length name) 0)

+25

(<= (string-length name) 240)

+26

(not (string-starts-with? name "-"))

+27

(not (string=? name "HEAD")))

+28

(error "operation-failed" "A valid branch name is required"))

+29

(run grants cwd (list "check-ref-format" (string-append "refs/heads/" name)))

+30

name)

+31

(define (bounded reply)

+32

(when (> (bytevector-length (string->utf8 (json-encode reply))) 262144)

+33

(error "operation-failed" "Branch listing exceeds its byte limit"))

+34

reply)

+35

(define (branch-record line)

+36

(let ((fields (git-split-nul line)))

+37

(unless (and (>= (length fields) 3) (git-commit-oid? (cadr fields)))

+38

(error "operation-failed" "Invalid branch record"))

+39

#{ name: (car fields) oid: (cadr fields) upstream: (list-ref fields 2) }))

+40

(define (git-branches grants args)

+41

(let* ((repo (dict-ref args repo: #f))

+42

(status (git-status grants #{ repo: repo recent-limit: 0 }))

+43

(text (run grants (dict-ref repo worktree: "")

+44

(list "for-each-ref" "--sort=refname" "--count=501"

+45

"--format=%(refname:lstrip=2)%00%(objectname)%00%(upstream:short)%00"

+46

"refs/heads/")))

+47

(rows (map branch-record

+48

(filter (lambda (line) (not (string=? line "")))

+49

(string-split text "\n")))))

+50

;; Ref names cannot contain newlines. The extra row detects truncation

+51

;; instead of silently offering an incomplete branch chooser.

+52

(when (> (length rows) 500)

+53

(error "operation-failed" "This branch chooser supports up to 500 local branches"))

+54

(bounded

+55

#{ version: 1 repo: repo snapshot: (dict-ref status snapshot: #{})

+56

branch: (dict-ref status branch: #{}) branches: rows })))

+57

(define (validate-status! grants args)

+58

(let* ((repo (dict-ref args repo: #f))

+59

(status (git-status grants #{ repo: repo recent-limit: 0 }))

+60

(branch (dict-ref status branch: #{})))

+61

;; Branch changes need repository-wide writes, including linked

+62

;; worktree administration. Narrow file-only grants are insufficient.

+63

(grant-assert! grants 'fs-write (dict-ref repo worktree: ""))

+64

(grant-assert! grants 'fs-write (dict-ref repo common-dir: ""))

+65

(unless (and (git-snapshot=? (dict-ref args expected-snapshot: #f)

+66

(dict-ref status snapshot: #f))

+67

(equal? (dict-ref args expected-branch: #f)

+68

(dict-ref branch head: #f)))

+69

(error "stale-snapshot" "Repository changed; reopen the branch menu"))

+70

(when (dict-ref status operation: #f)

+71

(error "operation-failed" "Finish the current Git operation before changing branches"))

+72

status))

+73

(define (branch-oid grants cwd name)

+74

(string-trim

+75

(run grants cwd

+76

(list "show-ref" "--verify" "--hash" (string-append "refs/heads/" name)))))

+77

(define (result grants repo name switched?)

+78

;; A successful mutation is not turned into a reported refusal if the

+79

;; subsequent status read fails. The client can explicitly refresh then.

+80

#{ version: 1 repo: repo name: name switched: switched? applied: #t

+81

status: (guard (e (#t #f)) (git-status grants #{ repo: repo recent-limit: 20 })) })

+82

(define (git-switch-branch grants args)

+83

(let* ((before (validate-status! grants args))

+84

(repo (dict-ref args repo: #{}))

+85

(cwd (dict-ref repo worktree: ""))

+86

(name (branch-name! grants cwd (dict-ref args name: #f)))

+87

(expected (dict-ref args target-oid: #f)))

+88

(unless (and (git-commit-oid? expected)

+89

(equal? expected (branch-oid grants cwd name)))

+90

(error "stale-snapshot" "Target branch moved; reopen the branch menu"))

+91

(when *before-publish* (*before-publish*))

+92

(validate-status! grants args)

+93

(unless (equal? expected (branch-oid grants cwd name))

+94

(error "stale-snapshot" "Target branch moved; reopen the branch menu"))

+95

;; Git refuses conflicting edits and branches held by another worktree.

+96

;; No force, merge, detach, guess, or auto-stash fallback is permitted.

+97

(run grants cwd (list "switch" "--no-guess" "--" name))

+98

(result grants repo name #t)))

+99

(define (git-create-branch grants args)

+100

(let* ((before (validate-status! grants args))

+101

(repo (dict-ref args repo: #{}))

+102

(cwd (dict-ref repo worktree: ""))

+103

(name (branch-name! grants cwd (dict-ref args name: #f)))

+104

(start (dict-ref args start-oid: #f))

+105

(switch? (dict-ref args switch: #f))

+106

(head (dict-ref (dict-ref before snapshot: #{}) head-oid: "")))

+107

(unless (and (boolean? switch?)

+108

(or (git-commit-oid? start)

+109

(and switch? (equal? start "") (string=? head ""))))

+110

(error "operation-failed" "Branch creation requires a commit"))

+111

(unless (string=? start "")

+112

(run grants cwd (list "cat-file" "-e" (string-append start "^{commit}"))))

+113

(when *before-publish* (*before-publish*))

+114

(validate-status! grants args)

+115

;; switch -c creates the ref only if checkout succeeds. branch without

+116

;; -f never replaces an existing ref, including slash-separated names.

+117

(if switch?

+118

(run grants cwd

+119

(append (list "switch" "--no-guess" "--no-track" "-c" name)

+120

(if (string=? start "") '() (list start))))

+121

(run grants cwd (list "branch" "--no-track" "--" name start)))

+122

(result grants repo name switch?)))))

packages/slate-cli/src/slate-cli/git/diff.sgladded

@@ -0,0 +1,325 @@

+1

;;; (slate-cli git diff) — node-owned, bounded structured Git diff pages.

+2

(define-library (slate-cli git diff)

+3

(import (sigil core) (sigil io) (sigil math) (sigil string) (sigil crypto) (sigil json)

+4

(sigil process) (sigil async) (sigil time) (sigil log)

+5

(sigil system grant) (slate-cli git exec) (slate-cli git status)

+6

(slate-cli logging) (slate-cli git log))

+7

(export git-diff git-diff-records git-diff-active-stream-count)

+8

(begin

+9

(define page-line-ceiling 400)

+10

(define page-byte-ceiling 262144)

+11

(define *diff-streams* #{})

+12

(define stream-lifetime-seconds 30)

+13

(define profile-enabled? (equal? (getenv "SLATE_GIT_PROFILE") "1"))

+14

+15

(define (profile-phase name thunk)

+16

(if (not profile-enabled?) (thunk)

+17

(let* ((start (op-clock))

+18

(result (thunk)))

+19

(log-debug* "node/git-diff-phase" mod: "git" phase: name

+20

duration-ms: (op-elapsed-ms start))

+21

result)))

+22

+23

(define (git-diff-active-stream-count)

+24

(length (dict-keys *diff-streams*)))

+25

+26

(define (stream-token)

+27

(string-append "diff-stream-" (base64url-encode (random-bytes 24))))

+28

+29

(define (stream-remove! token stream kill?)

+30

(let ((closed (vector-ref stream 10)))

+31

(unless (vector-ref closed 0)

+32

(vector-set! closed 0 #t)

+33

(set! *diff-streams* (dict-remove *diff-streams* token))

+34

(let ((proc (vector-ref stream 0)))

+35

(when (and kill? (process-alive? proc)) (process-kill! proc))

+36

(guard (e (#t #f)) (process-wait proc))))))

+37

+38

(define (drain-stderr token stream port)

+39

(let loop ((bytes 0))

+40

(let ((ch (read-char port)))

+41

(unless (eof-object? ch)

+42

(let ((next (+ bytes (bytevector-length (string->utf8 (string ch))))))

+43

(if (> next 65536)

+44

(stream-remove! token stream #t)

+45

(loop next)))))))

+46

+47

(define (expire-stream token stream)

+48

(let loop ()

+49

(when (and (not (vector-ref (vector-ref stream 10) 0))

+50

(< (current-second) (vector-ref stream 9)))

+51

(sleep 0.05)

+52

(loop)))

+53

(unless (vector-ref (vector-ref stream 10) 0)

+54

(stream-remove! token stream #t)))

+55

+56

(define (valid-limit value ceiling label)

+57

(if (and (integer? value) (> value 0) (<= value ceiling)) value

+58

(error "operation-failed" (string-append label " exceeds v1 ceiling"))))

+59

+60

(define (snapshot=? a b)

+61

(and (dict? a) (dict? b)

+62

(equal? (dict-ref a head-oid: #f) (dict-ref b head-oid: #f))

+63

(equal? (dict-ref a index-id: #f) (dict-ref b index-id: #f))

+64

(equal? (dict-ref a worktree-id: #f) (dict-ref b worktree-id: #f))))

+65

+66

(define (line-kind line)

+67

(cond ((string-starts-with? line "diff --git ") file:)

+68

((string-starts-with? line "@@ ") hunk:)

+69

((string-starts-with? line "+") addition:)

+70

((string-starts-with? line "-") deletion:)

+71

((string-starts-with? line " ") context:)

+72

((string-starts-with? line "Binary files ") binary:)

+73

((or (string-starts-with? line "old mode ")

+74

(string-starts-with? line "new mode ")) mode:)

+75

((or (string-starts-with? line "rename from ")

+76

(string-starts-with? line "rename to ")) rename:)

+77

(else meta:)))

+78

+79

(define (range-start token)

+80

(let* ((body (if (> (string-length token) 1)

+81

(substring token 1 (string-length token)) "0"))

+82

(parts (string-split body ",")))

+83

(or (string->number (car parts)) 0)))

+84

+85

(define (range-count token)

+86

(let* ((body (if (> (string-length token) 1)

+87

(substring token 1 (string-length token)) "0"))

+88

(parts (string-split body ",")))

+89

(if (null? (cdr parts)) 1 (or (string->number (cadr parts)) 0))))

+90

+91

(define (hunk-starts line)

+92

(let ((parts (string-split line " ")))

+93

(if (>= (length parts) 3)

+94

(cons (range-start (list-ref parts 1))

+95

(range-start (list-ref parts 2)))

+96

(cons 0 0))))

+97

+98

(define (decorate-hunk record line)

+99

(if (not (eq? (dict-ref record kind: #f) hunk:)) record

+100

(let ((parts (string-split line " ")))

+101

(if (< (length parts) 3) record

+102

(dict-set

+103

(dict-set

+104

(dict-set

+105

(dict-set

+106

(dict-set record old-start: (range-start (list-ref parts 1)))

+107

old-lines: (range-count (list-ref parts 1)))

+108

new-start: (range-start (list-ref parts 2)))

+109

new-lines: (range-count (list-ref parts 2)))

+110

context-hash: (sha256 line))))))

+111

+112

(define (git-diff-records text)

+113

(let loop ((lines (string-split text "\n")) (old-line 0) (new-line 0) (out '()))

+114

(if (null? lines) (reverse out)

+115

(let* ((line (car lines)) (kind (line-kind line))

+116

(old (if (or (eq? kind deletion:) (eq? kind context:)) old-line #f))

+117

(new (if (or (eq? kind addition:) (eq? kind context:)) new-line #f))

+118

(record (decorate-hunk

+119

#{ kind: kind text: line old-line: old new-line: new } line)))

+120

(let ((starts (and (eq? kind hunk:) (hunk-starts line))))

+121

(loop (cdr lines)

+122

(if starts (car starts) (if old (+ old-line 1) old-line))

+123

(if starts (cdr starts) (if new (+ new-line 1) new-line))

+124

(cons record out)))))))

+125

+126

(define (diff-argv kind target)

+127

(let ((base (list "diff" "--no-ext-diff" "--no-color" "--find-renames"

+128

"--unified=3" "--no-textconv")))

+129

(cond

+130

((string=? kind "worktree")

+131

(append base (if target (list "--" target) '())))

+132

((string=? kind "untracked")

+133

(if (and target (string? target))

+134

(list "diff" "--no-ext-diff" "--no-color" "--unified=3"

+135

"--no-textconv" "--no-index" "--" "/dev/null" target)

+136

(error "operation-failed" "untracked diff requires a path")))

+137

((string=? kind "staged")

+138

(append base (list "--cached") (if target (list "--" target) '())))

+139

((string=? kind "commit")

+140

(if (git-commit-oid? target)

+141

(list "show" "--format=" "--root" "--first-parent"

+142

"--no-ext-diff" "--no-color" "--no-textconv" "--find-renames"

+143

"--unified=3" target "--")

+144

(error "operation-failed" "commit diff requires an oid")))

+145

((string=? kind "conflict-stage")

+146

(let ((path (and (dict? target) (dict-ref target path: #f)))

+147

(stage (and (dict? target) (dict-ref target stage: #f))))

+148

(unless (and (string? path) (member stage (list 1 2 3)))

+149

(error "operation-failed" "conflict stage requires a path and stage 1, 2, or 3"))

+150

;; A stage visit remains a bounded structured diff. Base compares

+151

;; ours→base; ours/theirs compare base→that side.

+152

(let ((left (if (= stage 1) 2 1)) (right stage))

+153

(append base

+154

(list (string-append ":" (number->string left) ":" path)

+155

(string-append ":" (number->string right) ":" path) "--")))))

+156

(else (error "operation-failed" "unsupported diff kind")))))

+157

+158

;; Stream state: [process stdout old-line new-line continued-kind

+159

;; repo snapshot kind target deadline closed-box

+160

;; read-buffer read-position]. Git is

+161

;; started once; cursors name this node-held stream, so later pages neither

+162

;; rerun Git nor materialize/drop the complete prefix.

+163

(define (stream-open grants worktree argv repo snapshot kind target)

+164

(let* ((proc (git-spawn grants worktree argv))

+165

;; process-wait closes pipe descriptors that have not yet been

+166

;; claimed as ports. Claim stderr before scheduling its drainer:

+167

;; a short diff can otherwise finish before that task first runs.

+168

(stderr (process-stderr proc))

+169

(token (stream-token))

+170

(stream (vector proc (process-stdout proc) 0 0 #f

+171

repo snapshot kind target

+172

(+ (current-second) stream-lifetime-seconds)

+173

(vector #f) #f 0)))

+174

(set! *diff-streams* (dict-set *diff-streams* token stream))

+175

(when (in-async-context?)

+176

(go (drain-stderr token stream stderr))

+177

(go (expire-stream token stream)))

+178

(cons token stream)))

+179

+180

(define (stream-ref cursor)

+181

(and (string? cursor) (dict-ref *diff-streams* cursor #f)))

+182

+183

(define (stream-request=? stream repo snapshot kind target)

+184

(and (equal? (vector-ref stream 5) repo)

+185

(snapshot=? (vector-ref stream 6) snapshot)

+186

(string=? (vector-ref stream 7) kind)

+187

(equal? (vector-ref stream 8) target)))

+188

+189

;; Keep each buffered line as UTF-8 bytes so page boundaries do not walk

+190

;; or allocate every character, even for a multi-megabyte source line.

+191

(define (stream-ready-buffer stream)

+192

(or (vector-ref stream 11)

+193

;; read-string waits for its entire request on process ports and can

+194

;; deadlock behind a full child pipe. The runtime buffers read-line.

+195

(let ((line (read-line (vector-ref stream 1))))

+196

(if (eof-object? line)

+197

line

+198

(let ((bytes (string->utf8 line)))

+199

(vector-set! stream 11 bytes)

+200

(vector-set! stream 12 0)

+201

bytes)))))

+202

+203

(define (utf8-page-end buffer position remaining)

+204

(let ((size (bytevector-length buffer)))

+205

(let loop ((end (min size (+ position remaining))))

+206

(if (or (= end size) (= end position))

+207

end

+208

(let ((byte (bytevector-u8-ref buffer end)))

+209

(if (and (>= byte 128) (< byte 192))

+210

(loop (- end 1))

+211

end))))))

+212

+213

(define (record-from-line stream line continued?)

+214

(let* ((remembered (vector-ref stream 4))

+215

(kind (or remembered (line-kind line)))

+216

(old-line (vector-ref stream 2))

+217

(new-line (vector-ref stream 3))

+218

(old (if (or (eq? kind deletion:) (eq? kind context:)) old-line #f))

+219

(new (if (or (eq? kind addition:) (eq? kind context:)) new-line #f))

+220

(record (decorate-hunk

+221

#{ kind: kind text: line old-line: old new-line: new

+222

continued: continued? } line)))

+223

(if continued?

+224

(vector-set! stream 4 kind)

+225

(begin

+226

(vector-set! stream 4 #f)

+227

(let ((starts (and (eq? kind hunk:) (hunk-starts line))))

+228

(vector-set! stream 2

+229

(if starts (car starts) (if old (+ old-line 1) old-line)))

+230

(vector-set! stream 3

+231

(if starts (cdr starts) (if new (+ new-line 1) new-line))))))

+232

record))

+233

+234

(define (stream-finish token stream out)

+235

(if (vector-ref (vector-ref stream 10) 0)

+236

(error "operation-failed" "Git diff stream expired or was cancelled")

+237

(let ((exit (process-wait (vector-ref stream 0))))

+238

(set! *diff-streams* (dict-remove *diff-streams* token))

+239

(vector-set! (vector-ref stream 10) 0 #t)

+240

(unless (or (= exit 0)

+241

(and (string=? (vector-ref stream 7) "untracked") (= exit 1)))

+242

(error "operation-failed" "Git diff failed"))

+243

#{ records: (reverse out) complete: #t })))

+244

+245

(define (stream-page token stream max-lines max-bytes)

+246

;; Reserve space for record keys, identity, quoting and the RPC envelope.

+247

;; The final encoded-size assertion remains authoritative. Four bytes

+248

;; guarantee progress for a full UTF-8 character on a fresh page.

+249

(let ((content-limit (max 4 (min 196608 (- max-bytes 65536)))))

+250

(let loop ((page-bytes 0) (count 0) (out '()))

+251

(if (or (= count max-lines) (>= page-bytes content-limit))

+252

#{ records: (reverse out) complete: #f }

+253

(let ((buffer (stream-ready-buffer stream)))

+254

(if (eof-object? buffer)

+255

(stream-finish token stream out)

+256

(let* ((position (vector-ref stream 12))

+257

(size (bytevector-length buffer))

+258

(end (utf8-page-end buffer position (- content-limit page-bytes))))

+259

(if (and (= end position) (< position size))

+260

#{ records: (reverse out) complete: #f }

+261

(let* ((continued? (< end size))

+262

(line (utf8->string

+263

(if (and (= position 0) (= end size))

+264

buffer

+265

(bytevector-copy buffer position end))))

+266

(record (record-from-line stream line continued?)))

+267

(vector-set! stream 12 end)

+268

(unless continued? (vector-set! stream 11 #f))

+269

(loop (+ page-bytes (- end position)) (+ count 1)

+270

(cons record out)))))))))))

+271

+272

(define (encoded-bytes value)

+273

(bytevector-length (string->utf8 (json-encode value))))

+274

+275

(define (git-diff grants args)

+276

(let* ((repo (dict-ref args repo: #f))

+277

(snapshot (dict-ref args snapshot: #f))

+278

(worktree (and (dict? repo) (dict-ref repo worktree: #f)))

+279

(kind (dict-ref args kind: #f))

+280

(target (dict-ref args target: #f))

+281

(cursor (dict-ref args cursor: #f))

+282

(cancel? (dict-ref args cancel: #f))

+283

(max-lines (valid-limit (dict-ref args max-lines: 0) page-line-ceiling "max-lines"))

+284

(max-bytes (valid-limit (dict-ref args max-bytes: 0) page-byte-ceiling "max-bytes")))

+285

(unless (and (string? worktree) (string? kind) (dict? snapshot))

+286

(error "operation-failed" "invalid diff request"))

+287

(grant-assert! grants 'fs-read worktree)

+288

(if cancel?

+289

(begin

+290

(let ((stream (stream-ref cursor)))

+291

(when stream (stream-remove! cursor stream #t)))

+292

#{ version: 1 cancelled: #t cursor: cursor })

+293

(begin

+294

(let ((current (dict-ref

+295

(profile-phase "validate"

+296

(lambda () (git-status grants #{ repo: repo recent-limit: 0 })))

+297

snapshot: #f)))

+298

(unless (snapshot=? snapshot current)

+299

(error "stale-snapshot" "diff snapshot is stale")))

+300

(let* ((opened (if cursor

+301

(let ((stream (stream-ref cursor)))

+302

(if (and stream (stream-request=? stream repo snapshot kind target))

+303

(cons cursor stream)

+304

(error "stale-snapshot" "diff cursor expired")))

+305

(profile-phase "open"

+306

(lambda ()

+307

(stream-open grants worktree (diff-argv kind target)

+308

repo snapshot kind target)))))

+309

(token (car opened)) (stream (cdr opened))

+310

(page (profile-phase "page"

+311

(lambda () (stream-page token stream max-lines max-bytes))))

+312

(records (dict-ref page records: '()))

+313

(complete? (dict-ref page complete: #f))

+314

(reply #{ version: 1 repo: repo snapshot: snapshot

+315

files: (if (null? records) '()

+316

(list #{ id: (sha256 (string-append kind ":" (or target "*")))

+317

kind: kind target: target hunks: records }))

+318

next-cursor: (if complete? #f token)

+319

complete: complete?

+320

truncation: (if complete? #f #{ reason: "page-ceiling" }) }))

+321

(let ((size (profile-phase "encode" (lambda () (encoded-bytes reply)))))

+322

(when (> (+ size 256) max-bytes)

+323

(stream-remove! token stream #t)

+324

(error "operation-failed" "diff reply exceeded byte ceiling"))

+325

(dict-set reply payload-bytes: size)))))))))

packages/slate-cli/src/slate-cli/git/exec.sgladded

@@ -0,0 +1,134 @@

+1

;;; (slate-cli git exec) — portable, bounded Git process execution.

+2

;;;

+3

;;; This is the sole place the Git domain starts a process. It deliberately

+4

;;; uses Sigil's ordinary captured-port process API, which is implemented on

+5

;;; Linux, macOS, and Windows. The tempting raw-pipe API is Unix-only.

+6

;;;

+7

;;; Invariants enforced here:

+8

;;; * executable plus argv, never a shell command string;

+9

;;; * no /bin/sh, GNU timeout, env --chdir, pipelines, or POSIX signals;

+10

;;; * native spawn options supply child-local cwd and environment;

+11

;;; * Git -c arguments fix presentation without mutating ambient config;

+12

;;; * stdout and stderr are drained concurrently under byte ceilings;

+13

;;; * timeout and overflow terminate through portable process-kill!.

+14

;;;

+15

;;; Callers receive a typed execution record. They never inspect exceptions or

+16

;;; platform-specific exit conventions to decide whether a request timed out or

+17

;;; exceeded its output budget.

+18

(define-library (slate-cli git exec)

+19

(import (sigil core) (sigil io) (sigil process) (sigil async)

+20

(sigil channels) (sigil time) (sigil system grant))

+21

(export git-exec git-spawn git-command-available? git-default-timeout git-output-limit)

+22

(begin

+23

(define (git-default-timeout) 10)

+24

(define (git-output-limit) 8388608)

+25

(define (git-command-available?)

+26

(command-exists? "git"))

+27

+28

(define (bounded-read port limit proc)

+29

(guard (e (#t

+30

#{ text: ""

+31

error: #t

+32

exceeded: #f }))

+33

;; Captured process ports support binary reads even though their public

+34

;; handle is also textual. Reading bytevector chunks avoids one

+35

;; scheduler-aware operation per character and preserves NUL-delimited

+36

;; porcelain output exactly. Decode only after chunks are joined so a

+37

;; UTF-8 sequence split at a chunk boundary remains valid.

+38

(let loop ((chunks '()) (bytes 0))

+39

(let ((chunk (read-bytevector 65536 port)))

+40

(if (eof-object? chunk)

+41

(let ((joined (if (null? chunks) (bytevector)

+42

(apply bytevector-append (reverse chunks)))))

+43

#{ text: (utf8->string joined) error: #f exceeded: #f })

+44

(let ((next (+ bytes (bytevector-length chunk))))

+45

(if (> next limit)

+46

(begin

+47

(process-kill! proc)

+48

;; A retained chunk can end inside a UTF-8 sequence.

+49

;; Overflow is already a failed operation; do not let

+50

;; decoding its partial output hide the named ceiling.

+51

#{ text: ""

+52

error: #f

+53

exceeded: #t })

+54

(loop (cons chunk chunks) next))))))))

+55

+56

(define (git-environment)

+57

(list "LC_ALL=C"

+58

"LANG=C"

+59

"GIT_TERMINAL_PROMPT=0"

+60

"GIT_OPTIONAL_LOCKS=0"))

+61

(define (git-environment-with extra)

+62

(append (git-environment) extra))

+63

+64

(define (git-spawn grants cwd args)

+65

(grant-assert! grants 'exec "git")

+66

(grant-assert! grants 'fs-read cwd)

+67

(unless (git-command-available?)

+68

(error "git-unavailable" "Git is unavailable"))

+69

(apply process-spawn "git" cwd: cwd environment: (git-environment)

+70

(append (list "-c" "color.ui=false" "-c" "core.quotepath=false"

+71

"-c" "core.pager=cat") args)))

+72

+73

(define (run-async cwd argv timeout-seconds output-limit environment)

+74

(let ((proc

+75

(apply process-spawn

+76

(car argv)

+77

cwd: cwd

+78

environment: (git-environment-with environment)

+79

(cdr argv))))

+80

(unless (process? proc)

+81

(error "git-unavailable" "Git could not be started"))

+82

(let ((out-ch (make-channel 1))

+83

(err-ch (make-channel 1))

+84

(timed-out? (vector #f)))

+85

(go

+86

(channel-send

+87

out-ch

+88

(bounded-read (process-stdout proc) output-limit proc)))

+89

(go

+90

(channel-send

+91

err-ch

+92

(bounded-read (process-stderr proc) output-limit proc)))

+93

(go

+94

(let ((deadline (+ (current-second) timeout-seconds)))

+95

(let loop ()

+96

(when (and (process-alive? proc)

+97

(< (current-second) deadline))

+98

(sleep 0.01)

+99

(loop)))

+100

(when (process-alive? proc)

+101

(vector-set! timed-out? 0 #t)

+102

(process-kill! proc))))

+103

(let ((out (channel-receive out-ch))

+104

(err (channel-receive err-ch)))

+105

(let ((exit (process-wait proc)))

+106

#{ exit: exit

+107

stdout: (dict-ref out text: "")

+108

stderr: (dict-ref err text: "")

+109

timeout?: (vector-ref timed-out? 0)

+110

output-exceeded?:

+111

(or (dict-ref out exceeded: #f)

+112

(dict-ref err exceeded: #f))

+113

read-error?:

+114

(or (dict-ref out error: #f)

+115

(dict-ref err error: #f)) })))))

+116

+117

(define (git-exec grants cwd args

+118

(keys: (timeout (git-default-timeout))

+119

(output-limit (git-output-limit))

+120

(environment '())))

+121

(grant-assert! grants 'exec "git")

+122

(grant-assert! grants 'fs-read cwd)

+123

(unless (git-command-available?)

+124

(error "git-unavailable" "Git is unavailable"))

+125

(let ((argv (append (list "git" "-c" "color.ui=false"

+126

"-c" "core.quotepath=false"

+127

"-c" "core.pager=cat") args)))

+128

(if (in-async-context?)

+129

(run-async cwd argv timeout output-limit environment)

+130

(let ((box (vector #f)))

+131

(with-async

+132

(vector-set!

+133

box 0 (run-async cwd argv timeout output-limit environment)))

+134

(vector-ref box 0)))))))

packages/slate-cli/src/slate-cli/git/log.sgladded

@@ -0,0 +1,90 @@

+1

;;; (slate-cli git log) — bounded, node-owned history and commit metadata.

+2

(define-library (slate-cli git log)

+3

(import (sigil io) (sigil string) (sigil json) (slate-cli git exec) (slate-cli git status))

+4

(export git-log git-show git-commit-oid?)

+5

(begin

+6

(define (git-commit-oid? value)

+7

(and (string? value) (member (string-length value) '(40 64))

+8

(let loop ((i 0))

+9

(or (= i (string-length value))

+10

(and (string-contains? "0123456789abcdef" (substring value i (+ i 1)))

+11

(loop (+ i 1)))))))

+12

(define (run grants cwd argv)

+13

(let ((result (git-exec grants cwd argv output-limit: 262144)))

+14

(unless (and (= (dict-ref result exit: -1) 0)

+15

(not (dict-ref result timeout?: #f))

+16

(not (dict-ref result output-exceeded?: #f))

+17

(not (dict-ref result read-error?: #f)))

+18

(error "operation-failed" "Git history could not be read within its limits"))

+19

(dict-ref result stdout: "")))

+20

;; Fixed NUL fields, rather than punctuation delimiters in user text.

+21

(define (records fields body?)

+22

(if (null? fields) '()

+23

(let ((width (if body? 9 8)))

+24

(unless (>= (length fields) width)

+25

(error "operation-failed" "invalid Git history record"))

+26

(let ((oid (car fields)))

+27

(unless (git-commit-oid? oid)

+28

(error "operation-failed" "invalid Git commit identity"))

+29

(cons #{ oid: oid

+30

parents: (filter (lambda (s) (not (string=? s "")))

+31

(string-split (list-ref fields 1) " "))

+32

author: (list-ref fields 2) email: (list-ref fields 3)

+33

author-time: (or (string->number (list-ref fields 4)) 0)

+34

date: (list-ref fields 5) refs: (list-ref fields 6)

+35

subject: (list-ref fields 7)

+36

body: (if body? (list-ref fields 8) #f) }

+37

(records (drop-fields fields width) body?))))))

+38

(define (drop-fields fields n)

+39

(if (= n 0) fields (drop-fields (cdr fields) (- n 1))))

+40

(define format-fields "--format=%H%x00%P%x00%an%x00%ae%x00%at%x00%aI%x00%D%x00%s")

+41

(define (bounded-reply reply)

+42

(when (> (bytevector-length (string->utf8 (json-encode reply))) 262144)

+43

(error "operation-failed" "Git history page exceeds byte limit"))

+44

reply)

+45

(define (git-log grants args)

+46

(let* ((repo (dict-ref args repo: #f))

+47

(limit (dict-ref args limit: 50))

+48

(cursor (dict-ref args cursor: #f))

+49

(offset (if (dict? cursor) (dict-ref cursor offset: -1) 0)))

+50

(unless (and (integer? limit) (> limit 0) (<= limit 100)

+51

(or (not cursor) (dict? cursor))

+52

(integer? offset) (>= offset 0) (<= offset 10000000))

+53

(error "operation-failed" "invalid history page bounds"))

+54

;; Status revalidates grants and canonical repository identity on every

+55

;; page. The cursor is stateless: no retained process or node session.

+56

(let* ((status (git-status grants #{ repo: repo recent-limit: 0 }))

+57

(snapshot (dict-ref status snapshot: #{}))

+58

(head (dict-ref snapshot head-oid: "")))

+59

(when (and cursor (not (equal? head (dict-ref cursor head-oid: #f))))

+60

(error "stale-snapshot" "HEAD changed; refresh history"))

+61

(let* ((commits

+62

(if (string=? head "") '()

+63

(records

+64

(git-split-nul

+65

(run grants (dict-ref repo worktree: "")

+66

(list "log" "-z" "--topo-order" "--no-show-signature"

+67

"--decorate=short" format-fields

+68

(string-append "--max-count=" (number->string (+ limit 1)))

+69

(string-append "--skip=" (number->string offset)) head "--"))) #f)))

+70

(more? (> (length commits) limit))

+71

(page (if more? (reverse (cdr (reverse commits))) commits)))

+72

(bounded-reply

+73

#{ version: 1 repo: repo snapshot: snapshot branch: (dict-ref status branch: #{})

+74

commits: page offset: offset complete: (not more?)

+75

next-cursor: (and more? #{ head-oid: head offset: (+ offset limit) }) })))))

+76

(define (git-show grants args)

+77

(let ((repo (dict-ref args repo: #f)) (oid (dict-ref args oid: #f)))

+78

(unless (git-commit-oid? oid)

+79

(error "operation-failed" "commit inspection requires a full object ID"))

+80

(let* ((status (git-status grants #{ repo: repo recent-limit: 0 }))

+81

(commits (records

+82

(git-split-nul

+83

(run grants (dict-ref repo worktree: "")

+84

(list "log" "-z" "-1" "--no-show-signature" "--decorate=short"

+85

(string-append format-fields "%x00%b") oid "--"))) #t)))

+86

(unless (and (= (length commits) 1) (string=? oid (dict-ref (car commits) oid: "")))

+87

(error "operation-failed" "object is not the requested commit"))

+88

(bounded-reply

+89

#{ version: 1 repo: repo snapshot: (dict-ref status snapshot: #{})

+90

commit: (car commits) }))))))

packages/slate-cli/src/slate-cli/git/mutation.sgladded

@@ -0,0 +1,347 @@

+1

;;; Node-owned, snapshot-guarded file staging operations.

+2

(define-library (slate-cli git mutation)

+3

(import (sigil core) (sigil fs) (sigil path) (sigil crypto) (sigil string)

+4

(sigil time) (sigil random)

+5

(sigil system grant)

+6

(slate-cli git exec) (slate-cli git status))

+7

(export git-stage-file git-unstage-file git-stage-hunk git-unstage-hunk

+8

git-discard-file git-discard-hunk

+9

git-mutation-before-publish-hook!)

+10

(begin

+11

;; A deliberately narrow deterministic seam for the exact validation /

+12

;; publication race fixture. Production leaves it false.

+13

(define *before-publish-hook* #f)

+14

(define (git-mutation-before-publish-hook! hook)

+15

(set! *before-publish-hook* hook))

+16

+17

(define (entry-by-id entries id)

+18

(find (lambda (entry) (string=? (dict-ref entry id: "") id)) entries))

+19

+20

(define (entry-paths entry)

+21

(let ((path (dict-ref entry path: #f))

+22

(original (dict-ref entry original-path: #f)))

+23

(unless (string? path)

+24

(error "stale-snapshot" "status entry no longer has a path"))

+25

(if (and (string? original) (not (string=? original path)))

+26

(list original path)

+27

(list path))))

+28

+29

(define (run-mutation! grants worktree args . rest)

+30

(let ((result (if (null? rest)

+31

(git-exec grants worktree args)

+32

(git-exec grants worktree args environment: (car rest)))))

+33

(unless (= (dict-ref result exit: -1) 0)

+34

(error "operation-failed" "Git file mutation failed"))

+35

result))

+36

+37

(define (git-stdout! grants worktree args . rest)

+38

(string-trim

+39

(dict-ref (apply run-mutation! grants worktree args rest) stdout: "")))

+40

+41

(define (cleanup-file! path)

+42

(when (file-exists? path)

+43

(guard (e (#t #f)) (delete-file path))))

+44

+45

(define (worktree-index-path grants worktree)

+46

(git-stdout! grants worktree

+47

(list "rev-parse" "--path-format=absolute" "--git-path" "index")))

+48

+49

(define (candidate-index! grants worktree index-path paths stage? head new-entry?)

+50

(let* ((admin (path-dirname index-path))

+51

(token (sha256 (string-append index-path (number->string (current-second))

+52

(number->string (random)))))

+53

(real-index index-path)

+54

(candidate (path-join admin (string-append "slate-index-" token)))

+55

(patch (path-join admin (string-append "slate-index-" token ".patch")))

+56

(environment (list (string-append "GIT_INDEX_FILE=" candidate))))

+57

(guard (e (#t (cleanup-file! candidate) (cleanup-file! patch) (raise e)))

+58

(when (file-exists? real-index) (copy-file real-index candidate))

+59

(let ((old-tree (git-stdout! grants worktree (list "write-tree"))))

+60

(if stage?

+61

(run-mutation! grants worktree (append (list "add" "-A" "--") paths) environment)

+62

(if (or new-entry? (string=? head ""))

+63

(run-mutation! grants worktree

+64

(append (list "rm" "-r" "--cached" "--ignore-unmatch" "--") paths)

+65

environment)

+66

(run-mutation! grants worktree

+67

(append (list "restore" "--staged" "--") paths) environment)))

+68

(let ((new-tree (git-stdout! grants worktree (list "write-tree") environment)))

+69

(let ((diff (run-mutation! grants worktree

+70

(append (list "diff-tree" "-p" "--binary" "--no-ext-diff"

+71

old-tree new-tree "--") paths))))

+72

(write-file-string patch (dict-ref diff stdout: ""))

+73

#{ candidate: candidate patch: patch }))))))

+74

+75

(define (publish-candidate! grants worktree candidate)

+76

;; git apply owns index.lock and either publishes the complete cached

+77

;; patch atomically or leaves the real index byte-identical on failure.

+78

(run-mutation! grants worktree

+79

(list "apply" "--cached" "--whitespace=nowarn" "--"

+80

(dict-ref candidate patch: ""))))

+81

+82

(define (range-parts token)

+83

(let* ((body (substring token 1 (string-length token)))

+84

(parts (string-split body ",")))

+85

(cons (or (string->number (car parts)) 0)

+86

(if (null? (cdr parts)) 1

+87

(or (string->number (cadr parts)) 0)))))

+88

+89

(define (hunk-identity side file-id header)

+90

(let* ((parts (string-split header " "))

+91

(old (and (>= (length parts) 3) (range-parts (list-ref parts 1))))

+92

(new (and old (range-parts (list-ref parts 2)))))

+93

(and old new

+94

#{ file-id: file-id side: side

+95

old-start: (car old) old-lines: (cdr old)

+96

new-start: (car new) new-lines: (cdr new)

+97

context-hash: (sha256 header) })))

+98

+99

(define (hunk-identity=? expected actual)

+100

(and (dict? expected) (dict? actual)

+101

(equal? (dict-ref expected file-id: #f) (dict-ref actual file-id: #f))

+102

(equal? (dict-ref expected side: #f) (dict-ref actual side: #f))

+103

(= (dict-ref expected old-start: -1) (dict-ref actual old-start: -2))

+104

(= (dict-ref expected old-lines: -1) (dict-ref actual old-lines: -2))

+105

(= (dict-ref expected new-start: -1) (dict-ref actual new-start: -2))

+106

(= (dict-ref expected new-lines: -1) (dict-ref actual new-lines: -2))

+107

(equal? (dict-ref expected context-hash: #f)

+108

(dict-ref actual context-hash: #f))))

+109

+110

;; Return the file prelude paired with every complete hunk. Git's patch is

+111

;; reconstructed here; no rendered client text crosses this boundary.

+112

(define (patch-hunks text side file-id)

+113

(let loop ((lines (string-split text "\n")) (prelude '())

+114

(header #f) (body '()) (out '()))

+115

(cond

+116

((null? lines)

+117

(reverse

+118

(if header

+119

(cons (cons (hunk-identity side file-id header)

+120

(string-append

+121

(string-join (reverse prelude) "\n") "\n"

+122

(string-join (cons header (reverse body)) "\n") "\n")) out)

+123

out)))

+124

((string-starts-with? (car lines) "@@ ")

+125

(let ((out (if header

+126

(cons (cons (hunk-identity side file-id header)

+127

(string-append

+128

(string-join (reverse prelude) "\n") "\n"

+129

(string-join (cons header (reverse body)) "\n") "\n")) out)

+130

out)))

+131

(loop (cdr lines) prelude (car lines) '() out)))

+132

(header (loop (cdr lines) prelude header (cons (car lines) body) out))

+133

(else (loop (cdr lines) (cons (car lines) prelude) #f body out)))))

+134

+135

(define (unsupported-partial? text)

+136

(or (string-contains? text "GIT binary patch")

+137

(string-contains? text "Binary files ")

+138

(string-contains? text "rename from ")

+139

(string-contains? text "rename to ")

+140

(string-contains? text "old mode ")

+141

(string-contains? text "new mode ")

+142

(string-contains? text "Subproject commit ")))

+143

+144

(define (entry-partial-safe? entry stage?)

+145

(let* ((kind (dict-ref entry kind: ""))

+146

(modes (dict-ref entry modes: #{}))

+147

(head (dict-ref modes head: ""))

+148

(index (dict-ref modes index: ""))

+149

(worktree (dict-ref modes worktree: ""))

+150

(submodule (dict-ref entry submodule: "N...")))

+151

(and (string=? kind "ordinary")

+152

(string=? submodule "N...")

+153

(if stage? (string=? index worktree) (string=? head index)))))

+154

+155

(define (candidate-hunk! grants worktree index-path patch-text reverse?)

+156

(let* ((admin (path-dirname index-path))

+157

(token (sha256 (string-append index-path (number->string (current-second))

+158

(number->string (random)) patch-text)))

+159

(real-index index-path)

+160

(candidate (path-join admin (string-append "slate-index-" token)))

+161

(selected (path-join admin (string-append "slate-hunk-" token ".patch")))

+162

(publish (path-join admin (string-append "slate-index-" token ".patch")))

+163

(environment (list (string-append "GIT_INDEX_FILE=" candidate))))

+164

(guard (e (#t (cleanup-file! candidate) (cleanup-file! selected)

+165

(cleanup-file! publish) (raise e)))

+166

(when (file-exists? real-index) (copy-file real-index candidate))

+167

(write-file-string selected patch-text)

+168

(let ((old-tree (git-stdout! grants worktree (list "write-tree"))))

+169

(run-mutation! grants worktree

+170

(append (list "apply" "--cached" "--whitespace=nowarn")

+171

(if reverse? (list "--reverse") '()) (list "--" selected))

+172

environment)

+173

(let* ((new-tree (git-stdout! grants worktree (list "write-tree") environment))

+174

(delta (run-mutation! grants worktree

+175

(list "diff-tree" "-p" "--binary" "--no-ext-diff"

+176

old-tree new-tree))))

+177

(write-file-string publish (dict-ref delta stdout: ""))

+178

(cleanup-file! selected)

+179

#{ candidate: candidate patch: publish })))))

+180

+181

(define (mutate-hunk grants args stage?)

+182

(let* ((repo (dict-ref args repo: #f))

+183

(expected (dict-ref args expected-snapshot: #f))

+184

(wanted (dict-ref args hunk-id: #f))

+185

(worktree (and (dict? repo) (dict-ref repo worktree: #f)))

+186

(common (and (dict? repo) (dict-ref repo common-dir: #f)))

+187

(file-id (and (dict? wanted) (dict-ref wanted file-id: #f)))

+188

(side (if stage? "worktree" "staged")))

+189

(unless (and (dict? expected) (dict? wanted) (string? file-id)

+190

(string? worktree) (string? common)

+191

(string=? (dict-ref wanted side: "") side))

+192

(error "operation-failed" "invalid hunk mutation request"))

+193

(let ((index-path (worktree-index-path grants worktree)))

+194

(grant-assert! grants 'fs-write index-path)

+195

(let* ((before (git-status grants #{ repo: repo recent-limit: 0 }))

+196

(current (dict-ref before snapshot: #f)))

+197

(unless (git-snapshot=? expected current)

+198

(error "stale-snapshot" "hunk mutation snapshot is stale"))

+199

(let* ((entry (entry-by-id (dict-ref before entries: '()) file-id))

+200

(path (and entry (dict-ref entry path: #f))))

+201

(unless (and entry (string? path))

+202

(error "stale-snapshot" "hunk file no longer exists"))

+203

(unless (entry-partial-safe? entry stage?)

+204

(error "operation-failed" "partial mutation is unsafe for this entry"))

+205

(let* ((argv (append (list "diff" "--no-ext-diff" "--no-color"

+206

"--no-textconv" "--unified=3")

+207

(if stage? '() (list "--cached")) (list "--" path)))

+208

(text (dict-ref (run-mutation! grants worktree argv) stdout: "")))

+209

(when (unsupported-partial? text)

+210

(error "operation-failed" "partial mutation is unsafe for this entry"))

+211

(let ((matches (filter (lambda (pair) (hunk-identity=? wanted (car pair)))

+212

(patch-hunks text side file-id))))

+213

(unless (= (length matches) 1)

+214

(error "stale-snapshot" "hunk identity is missing or ambiguous"))

+215

(let ((candidate (candidate-hunk! grants worktree index-path

+216

(cdr (car matches)) (not stage?))))

+217

(guard (e (#t (cleanup-file! (dict-ref candidate candidate: ""))

+218

(cleanup-file! (dict-ref candidate patch: "")) (raise e)))

+219

(when *before-publish-hook* (*before-publish-hook*))

+220

(let ((latest (dict-ref (git-status grants #{ repo: repo recent-limit: 0 })

+221

snapshot: #f)))

+222

(unless (git-snapshot=? expected latest)

+223

(error "stale-snapshot" "hunk mutation snapshot is stale"))

+224

(publish-candidate! grants worktree candidate)

+225

(cleanup-file! (dict-ref candidate candidate: ""))

+226

(cleanup-file! (dict-ref candidate patch: ""))

+227

(git-status grants #{ repo: repo recent-limit: 20 })))))))))))

+228

+229

(define (mutate-file grants args stage?)

+230

(let* ((repo (dict-ref args repo: #f))

+231

(expected (dict-ref args expected-snapshot: #f))

+232

(entry-id (dict-ref args entry-id: #f))

+233

(worktree (and (dict? repo) (dict-ref repo worktree: #f)))

+234

(common (and (dict? repo) (dict-ref repo common-dir: #f))))

+235

(unless (and (dict? expected) (string? entry-id)

+236

(string? worktree) (string? common))

+237

(error "operation-failed" "invalid file mutation request"))

+238

;; fs-write checks a mutation target, not a directory handle. The

+239

;; index (and its adjacent lock) is the file-level authority Git needs.

+240

(let ((index-path (worktree-index-path grants worktree)))

+241

(grant-assert! grants 'fs-write index-path)

+242

;; Validate once before doing candidate work so stale requests cannot

+243

;; select an entry from a newer snapshot.

+244

(let* ((before (git-status grants #{ repo: repo recent-limit: 0 }))

+245

(current (dict-ref before snapshot: #f)))

+246

(unless (git-snapshot=? expected current)

+247

(error "stale-snapshot" "file mutation snapshot is stale"))

+248

(let* ((entry (entry-by-id (dict-ref before entries: '()) entry-id))

+249

(paths (and entry (entry-paths entry))))

+250

(unless entry

+251

(error "stale-snapshot" "status entry no longer exists"))

+252

(let* ((modes (dict-ref entry modes: #{}))

+253

(new-entry? (string=? (dict-ref modes head: "") "000000"))

+254

(candidate (candidate-index! grants worktree index-path paths stage?

+255

(dict-ref current head-oid: "") new-entry?)))

+256

(guard (e (#t

+257

(cleanup-file! (dict-ref candidate candidate: ""))

+258

(cleanup-file! (dict-ref candidate patch: ""))

+259

(raise e)))

+260

(when *before-publish-hook* (*before-publish-hook*))

+261

;; Candidate construction may race worktree/index changes.

+262

;; Revalidate only after it is complete and before Git's atomic

+263

;; cached-patch publication.

+264

(let* ((latest (git-status grants #{ repo: repo recent-limit: 0 }))

+265

(latest-snapshot (dict-ref latest snapshot: #f)))

+266

(unless (git-snapshot=? expected latest-snapshot)

+267

(error "stale-snapshot" "file mutation snapshot is stale"))

+268

(publish-candidate! grants worktree candidate)

+269

(cleanup-file! (dict-ref candidate candidate: ""))

+270

(cleanup-file! (dict-ref candidate patch: ""))

+271

;; Return authoritative fresh status so the client does not

+272

;; create a post-success acknowledgement/refresh race.

+273

(git-status grants #{ repo: repo recent-limit: 20 })))))))))

+274

+275

(define (git-stage-file grants args) (mutate-file grants args #t))

+276

(define (git-unstage-file grants args) (mutate-file grants args #f))

+277

(define (git-stage-hunk grants args) (mutate-hunk grants args #t))

+278

(define (git-unstage-hunk grants args) (mutate-hunk grants args #f))

+279

+280

;; Discard is deliberately narrower than stage/unstage: a file row is

+281

;; eligible only when it has worktree content to throw away (including an

+282

;; untracked row), and a hunk is eligible only on the worktree side.

+283

;; Rendered paths/patches are never accepted as authority.

+284

(define (discard-request grants args hunk?)

+285

(let* ((repo (dict-ref args repo: #f))

+286

(expected (dict-ref args expected-snapshot: #f))

+287

(worktree (and (dict? repo) (dict-ref repo worktree: #f)))

+288

(wanted (dict-ref args (if hunk? hunk-id: entry-id:) #f))

+289

(entry-id (if hunk? (and (dict? wanted) (dict-ref wanted file-id: #f)) wanted)))

+290

(unless (and (dict? expected) (string? worktree) (string? entry-id))

+291

(error "operation-failed" "invalid discard request"))

+292

(let* ((before (git-status grants #{ repo: repo recent-limit: 0 }))

+293

(current (dict-ref before snapshot: #f))

+294

(entry (entry-by-id (dict-ref before entries: '()) entry-id))

+295

(path (and entry (dict-ref entry path: #f))))

+296

(unless (git-snapshot=? expected current)

+297

(error "stale-snapshot" "discard snapshot is stale"))

+298

(unless (and entry (string? path))

+299

(error "stale-snapshot" "discard entry no longer exists"))

+300

(grant-assert! grants 'fs-write (path-join worktree path))

+301

(cond

+302

(hunk?

+303

(unless (and (dict? wanted)

+304

(string=? (dict-ref wanted side: "") "worktree")

+305

(entry-partial-safe? entry #t))

+306

(error "operation-failed" "partial discard is unsafe for this entry"))

+307

(let* ((text (dict-ref (run-mutation! grants worktree

+308

(list "diff" "--no-ext-diff" "--no-color"

+309

"--no-textconv" "--unified=3" "--" path))

+310

stdout: ""))

+311

(matches (filter (lambda (pair)

+312

(hunk-identity=? wanted (car pair)))

+313

(patch-hunks text "worktree" entry-id))))

+314

(when (unsupported-partial? text)

+315

(error "operation-failed" "partial discard is unsafe for this entry"))

+316

(unless (= (length matches) 1)

+317

(error "stale-snapshot" "discard hunk is missing or ambiguous"))

+318

(when *before-publish-hook* (*before-publish-hook*))

+319

(unless (git-snapshot=? expected

+320

(dict-ref (git-status grants #{ repo: repo recent-limit: 0 }) snapshot: #f))

+321

(error "stale-snapshot" "discard snapshot is stale"))

+322

(let* ((common (dict-ref repo common-dir: ""))

+323

(patch (path-join common

+324

(string-append "slate-discard-" (sha256 text) ".patch"))))

+325

(guard (e (#t (cleanup-file! patch) (raise e)))

+326

(write-file-string patch (cdr (car matches)))

+327

(run-mutation! grants worktree

+328

(list "apply" "--reverse" "--whitespace=nowarn" "--" patch))

+329

(cleanup-file! patch)))))

+330

((string=? (dict-ref entry kind: "") "untracked")

+331

(when *before-publish-hook* (*before-publish-hook*))

+332

(unless (git-snapshot=? expected

+333

(dict-ref (git-status grants #{ repo: repo recent-limit: 0 }) snapshot: #f))

+334

(error "stale-snapshot" "discard snapshot is stale"))

+335

(run-mutation! grants worktree (list "clean" "-f" "-d" "--" path)))

+336

((not (string=? (dict-ref entry worktree-state: ".") "."))

+337

(when *before-publish-hook* (*before-publish-hook*))

+338

(unless (git-snapshot=? expected

+339

(dict-ref (git-status grants #{ repo: repo recent-limit: 0 }) snapshot: #f))

+340

(error "stale-snapshot" "discard snapshot is stale"))

+341

(run-mutation! grants worktree (append (list "restore" "--worktree" "--")

+342

(entry-paths entry))))

+343

(else (error "operation-failed" "status entry has no discardable worktree change")))

+344

(git-status grants #{ repo: repo recent-limit: 20 }))))

+345

+346

(define (git-discard-file grants args) (discard-request grants args #f))

+347

(define (git-discard-hunk grants args) (discard-request grants args #t))))

packages/slate-cli/src/slate-cli/git/status.sgladded

@@ -0,0 +1,494 @@

+1

;;; (slate-cli git status) — node-owned Git repository discovery and status.

+2

;;;

+3

;;; This module owns the interpretation of Git output. The client never parses

+4

;;; porcelain text and never assembles generic proc/run calls. Both public

+5

;;; operations execute on the machine that owns the selected Slate root.

+6

;;;

+7

;;; `git-discover` validates the requested source path, asks Git for canonical

+8

;;; repository facts, then validates the discovered worktree and common-dir

+9

;;; again. It returns node-owned facts only; the provider/client attaches its

+10

;;; registered root name, per D3 in tasks/slate-git-status-plan.

+11

;;;

+12

;;; `git-status` validates that qualified repository afresh and parses

+13

;;; `--porcelain=v2 -z`. NUL delimiters are load-bearing: filenames may contain

+14

;;; spaces, tabs, newlines, non-ASCII text, leading dashes, and literal rename

+15

;;; arrows. Status replies contain inventory and summary metadata, never patch

+16

;;; bodies. All process execution, timeout, and byte bounds live in

+17

;;; (slate-cli git exec).

+18

(define-library (slate-cli git status)

+19

(import (sigil core) (sigil string) (sigil path) (sigil fs) (sigil crypto)

+20

(sigil system grant) (sigil system fs) (slate-cli git exec))

+21

(export git-snapshot=? git-discover git-status git-split-nul git-status-records)

+22

(begin

+23

(define (git-snapshot=? a b)

+24

(and (dict? a) (dict? b)

+25

(equal? (dict-ref a head-oid: #f) (dict-ref b head-oid: #f))

+26

(equal? (dict-ref a index-id: #f) (dict-ref b index-id: #f))

+27

(equal? (dict-ref a worktree-id: #f) (dict-ref b worktree-id: #f))))

+28

+29

+30

(define (required-string args key)

+31

(let ((v (dict-ref args key #f)))

+32

(if (string? v)

+33

v

+34

(error

+35

"operation-failed"

+36

"missing or non-string argument"))))

+37

(define (bounded-limit args)

+38

(let ((n (dict-ref args recent-limit: 20)))

+39

(if (and (integer? n) (>= n 0) (<= n 50))

+40

n

+41

(error

+42

"operation-failed"

+43

"recent-limit must be between 0 and 50"))))

+44

+45

(define (run-ok grants cwd args)

+46

(let ((r (git-exec grants cwd args)))

+47

(cond

+48

((dict-ref r timeout?: #f)

+49

(error "operation-failed" "Git operation timed out"))

+50

((dict-ref r output-exceeded?: #f)

+51

(error "operation-failed" "Git output exceeded limit"))

+52

((dict-ref r read-error?: #f)

+53

(error "operation-failed" "Git output could not be read"))

+54

((not (= (dict-ref r exit: -1) 0))

+55

(error "not-a-repository" "not a Git repository"))

+56

(else

+57

(dict-ref r stdout: "")))))

+58

+59

(define (run-status-ok grants cwd args)

+60

(guard (e (#t

+61

(error "operation-failed" "Git status operation failed")))

+62

(let ((result (git-exec grants cwd args)))

+63

(cond

+64

((dict-ref result timeout?: #f)

+65

(error "operation-failed" "Git operation timed out"))

+66

((dict-ref result output-exceeded?: #f)

+67

(error "operation-failed" "Git output exceeded limit"))

+68

((dict-ref result read-error?: #f)

+69

(error "operation-failed" "Git output could not be read"))

+70

((not (= (dict-ref result exit: -1) 0))

+71

(error "operation-failed" "Git status operation failed"))

+72

(else

+73

(dict-ref result stdout: ""))))))

+74

+75

(define (git-split-nul s)

+76

(let loop ((i 0) (start 0) (out '()))

+77

(cond ((>= i (string-length s))

+78

(reverse (if (< start i) (cons (substring s start i) out) out)))

+79

((= (char->integer (string-ref s i)) 0)

+80

(loop (+ i 1) (+ i 1) (cons (substring s start i) out)))

+81

(else (loop (+ i 1) start out)))))

+82

+83

(define (discover-repository grants args)

+84

(let ((path (required-string args path:)))

+85

(grant-assert! grants 'fs-read path)

+86

;; Repository discovery is on every status/snapshot hot path. Gather

+87

;; the facts shared by bare and non-bare repositories in one process

+88

;; instead of paying for four serial rev-parse invocations.

+89

(let* ((facts

+90

(string-split

+91

(string-trim

+92

(run-ok grants path

+93

(list "rev-parse" "--is-bare-repository"

+94

"--path-format=absolute" "--absolute-git-dir"

+95

"--git-common-dir" "--show-object-format")))

+96

"\n"))

+97

(bare-text (if (pair? facts) (car facts) "false"))

+98

(bare? (string=? bare-text "true"))

+99

(git-dir (if (> (length facts) 1) (list-ref facts 1) ""))

+100

(worktree

+101

(if bare?

+102

git-dir

+103

(string-trim

+104

(run-ok grants path

+105

(list "rev-parse" "--path-format=absolute"

+106

"--show-toplevel")))))

+107

(common (if (> (length facts) 2) (list-ref facts 2) ""))

+108

(format (if (> (length facts) 3) (list-ref facts 3) "")))

+109

(unless (and (not (string=? worktree ""))

+110

(not (string=? git-dir ""))

+111

(not (string=? common ""))

+112

(not (string=? format "")))

+113

(error "not-a-repository" "not a Git repository"))

+114

(grant-assert! grants 'fs-read worktree)

+115

(grant-assert! grants 'fs-read common)

+116

(grant-assert! grants 'fs-read git-dir)

+117

#{ version: 1

+118

git-dir: git-dir

+119

node-repo:

+120

#{ worktree: worktree

+121

common-dir: common }

+122

bare: bare?

+123

object-format: format })))

+124

+125

(define (git-discover grants args)

+126

;; Keep administrative paths node-owned. Public repository identity is

+127

;; still the root-qualified worktree/common-dir pair.

+128

(let ((facts (discover-repository grants args)))

+129

#{ version: 1

+130

node-repo: (dict-ref facts node-repo: #{})

+131

bare: (dict-ref facts bare: #f)

+132

object-format: (dict-ref facts object-format: "") }))

+133

+134

(define (field-at s n)

+135

(let ((parts (string-split s " ")))

+136

(if (< n (length parts))

+137

(list-ref parts n)

+138

"")))

+139

+140

(define (tail-after-fields s n)

+141

(let loop ((i 0) (spaces 0))

+142

(cond

+143

((>= i (string-length s))

+144

"")

+145

((char=? (string-ref s i) #\space)

+146

(if (= (+ spaces 1) n)

+147

(substring s (+ i 1) (string-length s))

+148

(loop (+ i 1) (+ spaces 1))))

+149

(else

+150

(loop (+ i 1) spaces)))))

+151

+152

(define (entry kind xy path original)

+153

#{ id: (sha256

+154

(string-append

+155

kind "\x1f;" xy "\x1f;" path "\x1f;" (or original "")))

+156

path: path

+157

original-path: original

+158

kind: kind

+159

index-state: (substring xy 0 1)

+160

worktree-state: (substring xy 1 2) })

+161

+162

(define (decorate-entry entry record)

+163

(let ((kind (dict-ref entry kind: "")))

+164

(cond

+165

((string=? kind "ordinary")

+166

(dict-set

+167

(dict-set

+168

(dict-set entry submodule: (field-at record 2))

+169

modes:

+170

#{ head: (field-at record 3)

+171

index: (field-at record 4)

+172

worktree: (field-at record 5) })

+173

binary: "unknown"))

+174

((string=? kind "rename")

+175

(dict-set

+176

(dict-set

+177

(dict-set

+178

(dict-set entry submodule: (field-at record 2))

+179

modes:

+180

#{ head: (field-at record 3)

+181

index: (field-at record 4)

+182

worktree: (field-at record 5) })

+183

rename-score: (field-at record 8))

+184

binary: "unknown"))

+185

((string=? kind "conflict")

+186

(dict-set

+187

(dict-set

+188

(dict-set entry submodule: (field-at record 2))

+189

conflict-stages:

+190

#{ stage-1: (field-at record 7)

+191

stage-2: (field-at record 8)

+192

stage-3: (field-at record 9) })

+193

binary: "unknown"))

+194

(else

+195

(dict-set entry binary: "unknown")))))

+196

+197

(define (git-status-records raw)

+198

(let loop ((records (git-split-nul raw)) (out '()))

+199

(if (null? records)

+200

(reverse out)

+201

(let* ((record (car records))

+202

(tag

+203

(if (> (string-length record) 0)

+204

(substring record 0 1)

+205

"")))

+206

(cond

+207

((string=? tag "1")

+208

(loop

+209

(cdr records)

+210

(cons

+211

(decorate-entry

+212

(entry "ordinary"

+213

(field-at record 1)

+214

(tail-after-fields record 8)

+215

#f)

+216

record)

+217

out)))

+218

((string=? tag "2")

+219

(let ((original

+220

(and (pair? (cdr records)) (cadr records))))

+221

(loop

+222

(if original (cddr records) (cdr records))

+223

(cons

+224

(decorate-entry

+225

(entry "rename"

+226

(field-at record 1)

+227

(tail-after-fields record 9)

+228

original)

+229

record)

+230

out))))

+231

((string=? tag "u")

+232

(loop

+233

(cdr records)

+234

(cons

+235

(decorate-entry

+236

(entry "conflict"

+237

(field-at record 1)

+238

(tail-after-fields record 10)

+239

#f)

+240

record)

+241

out)))

+242

((string=? tag "?")

+243

(loop

+244

(cdr records)

+245

(cons

+246

(decorate-entry

+247

(entry "untracked"

+248

"??"

+249

(substring record 2 (string-length record))

+250

#f)

+251

record)

+252

out)))

+253

(else

+254

(loop (cdr records) out)))))))

+255

+256

(define (branch-info headers)

+257

(let loop ((remaining headers)

+258

(branch #{ head: ""

+259

detached: #f

+260

unborn: #f

+261

upstream: #f

+262

ahead: 0

+263

behind: 0 }))

+264

(if (null? remaining)

+265

branch

+266

(let ((header (car remaining)))

+267

(cond

+268

((string-starts-with? header "# branch.head ")

+269

(let ((head (substring header 14 (string-length header))))

+270

(loop

+271

(cdr remaining)

+272

(dict-set

+273

(dict-set branch head: head)

+274

detached:

+275

(string=? head "(detached)")))))

+276

((string-starts-with? header "# branch.oid ")

+277

(loop

+278

(cdr remaining)

+279

(dict-set

+280

branch

+281

unborn:

+282

(string=?

+283

(substring header 13 (string-length header))

+284

"(initial)"))))

+285

((string-starts-with? header "# branch.upstream ")

+286

(loop

+287

(cdr remaining)

+288

(dict-set

+289

branch

+290

upstream:

+291

(substring header 18 (string-length header)))))

+292

((string-starts-with? header "# branch.ab ")

+293

(let ((parts (string-split header " ")))

+294

(loop

+295

(cdr remaining)

+296

(dict-set

+297

(dict-set

+298

branch

+299

ahead:

+300

(or (string->number

+301

(substring

+302

(list-ref parts 2)

+303

1

+304

(string-length (list-ref parts 2))))

+305

0))

+306

behind:

+307

(or (string->number

+308

(substring

+309

(list-ref parts 3)

+310

1

+311

(string-length (list-ref parts 3))))

+312

0)))))

+313

(else

+314

(loop (cdr remaining) branch)))))))

+315

+316

(define (branch-oid headers)

+317

(let loop ((remaining headers))

+318

(cond ((null? remaining) "")

+319

((string-starts-with? (car remaining) "# branch.oid ")

+320

(let ((oid (substring (car remaining) 13

+321

(string-length (car remaining)))))

+322

(if (string=? oid "(initial)") "" oid)))

+323

(else (loop (cdr remaining))))))

+324

+325

(define (git-operation git-dir)

+326

(cond

+327

((or (directory-exists? (path-join git-dir "rebase-merge"))

+328

(directory-exists? (path-join git-dir "rebase-apply")))

+329

#{ kind: "rebase" })

+330

((file-exists? (path-join git-dir "MERGE_HEAD"))

+331

#{ kind: "merge" })

+332

((file-exists? (path-join git-dir "CHERRY_PICK_HEAD"))

+333

#{ kind: "cherry-pick" })

+334

((file-exists? (path-join git-dir "REVERT_HEAD"))

+335

#{ kind: "revert" })

+336

((file-exists? (path-join git-dir "BISECT_LOG"))

+337

#{ kind: "bisect" })

+338

(else #f)))

+339

+340

(define (split-unit-separator record)

+341

(string-split record "\x1f;"))

+342

+343

(define (commit-record record)

+344

(let ((parts (split-unit-separator record)))

+345

#{ oid: (if (pair? parts) (car parts) "")

+346

parents: (if (> (length parts) 1)

+347

(string-split (list-ref parts 1) " ")

+348

'())

+349

author-time: (if (> (length parts) 2)

+350

(or (string->number (list-ref parts 2)) 0)

+351

0)

+352

subject: (if (> (length parts) 3) (list-ref parts 3) "") }))

+353

+354

(define (scope-entry-id entry repo head index-id worktree-id)

+355

(dict-set

+356

entry

+357

id:

+358

(sha256

+359

(string-append

+360

(dict-ref repo root: "") "\x1f;"

+361

(dict-ref repo worktree: "") "\x1f;"

+362

(dict-ref repo common-dir: "") "\x1f;"

+363

head "\x1f;" index-id "\x1f;" worktree-id "\x1f;"

+364

(dict-ref entry id: "")))))

+365

+366

;; Porcelain state alone cannot distinguish two successive modifications

+367

;; of the same path. Include Git-computed worktree object identities so a

+368

;; mutation snapshot detects content races without transporting patches.

+369

(define (zip-identities paths hashes)

+370

(if (or (null? paths) (null? hashes)) '()

+371

(cons (cons (car paths) (car hashes))

+372

(zip-identities (cdr paths) (cdr hashes)))))

+373

+374

(define (batched-worktree-identities grants worktree entries)

+375

(let* ((paths (map (lambda (entry) (dict-ref entry path: ""))

+376

(filter (lambda (entry)

+377

(not (string=? (dict-ref entry kind: "") "untracked")))

+378

entries)))

+379

(result (and (pair? paths)

+380

(git-exec grants worktree

+381

(append (list "hash-object" "--no-filters" "--") paths))))

+382

(hashes (if (and result (= (dict-ref result exit: -1) 0))

+383

(filter (lambda (line) (not (string=? line "")))

+384

(string-split (dict-ref result stdout: "") "\n"))

+385

'())))

+386

(and (= (length paths) (length hashes)) (zip-identities paths hashes))))

+387

+388

(define (worktree-fingerprint grants worktree raw entries)

+389

(let ((batched (batched-worktree-identities grants worktree entries)))

+390

(sha256

+391

(fold-left

+392

(lambda (out entry)

+393

(let* ((path (dict-ref entry path: ""))

+394

(untracked? (string=? (dict-ref entry kind: "") "untracked"))

+395

(stat (and untracked?

+396

(guard (e (#t #f)) (fs-stat grants (path-join worktree path)))))

+397

(known (and batched (assoc path batched)))

+398

(result (and (not untracked?) (not known)

+399

(git-exec grants worktree

+400

(list "hash-object" "--no-filters" "--" path))))

+401

(identity

+402

(cond (stat

+403

(string-append "stat:"

+404

(number->string (dict-ref stat size: 0)) ":"

+405

(number->string (dict-ref stat mtime: 0)) ":"

+406

(number->string (dict-ref stat mode: 0))))

+407

(known (cdr known))

+408

((and result (= (dict-ref result exit: -1) 0))

+409

(string-trim (dict-ref result stdout: "")))

+410

(else "missing"))))

+411

(string-append out "\x1f;" path "\x1f;" identity)))

+412

raw entries))))

+413

+414

(define (git-status grants args)

+415

(let* ((repo (dict-ref args repo: #f))

+416

(worktree (and (dict? repo) (dict-ref repo worktree: #f)))

+417

(common (and (dict? repo) (dict-ref repo common-dir: #f)))

+418

(limit (bounded-limit args)))

+419

(unless (and (string? worktree) (string? common))

+420

(error "operation-failed" "invalid repository identity"))

+421

(grant-assert! grants 'fs-read worktree)

+422

(grant-assert! grants 'fs-read common)

+423

(let* ((facts (discover-repository grants #{ path: worktree }))

+424

(git-dir (dict-ref facts git-dir: ""))

+425

(discovered

+426

(dict-ref

+427

facts

+428

node-repo:

+429

#{}))

+430

(canonical-worktree

+431

(dict-ref discovered worktree: #f))

+432

(canonical-common

+433

(dict-ref discovered common-dir: #f)))

+434

(unless (and (string=? worktree canonical-worktree)

+435

(string=? common canonical-common))

+436

(error

+437

"operation-failed"

+438

"repository identity does not match canonical Git metadata"))

+439

(let* ((raw

+440

(run-status-ok

+441

grants worktree

+442

(list "status" "--porcelain=v2" "-z"

+443

"--branch" "--untracked-files=all")))

+444

(index-raw

+445

(run-status-ok

+446

grants worktree

+447

(list "ls-files" "--stage" "-z")))

+448

(records (git-split-nul raw))

+449

(headers

+450

(filter

+451

(lambda (record)

+452

(string-starts-with? record "# "))

+453

records))

+454

;; porcelain v2 already reports HEAD, including the unborn

+455

;; marker, so a separate rev-parse adds latency but no data.

+456

(head (branch-oid headers))

+457

(parsed-entries (git-status-records raw))

+458

(index-id (sha256 index-raw))

+459

(worktree-id (worktree-fingerprint grants worktree raw parsed-entries))

+460

(entries

+461

(map

+462

(lambda (entry)

+463

(scope-entry-id

+464

entry repo head index-id worktree-id))

+465

parsed-entries))

+466

(log-result

+467

(and

+468

(> limit 0)

+469

(git-exec

+470

grants worktree

+471

(list "log" "-z"

+472

(string-append "-n" (number->string limit))

+473

"--format=%H%x1f%P%x1f%at%x1f%s"))))

+474

(log-text

+475

(if (and log-result

+476

(= (dict-ref log-result exit: -1) 0))

+477

(dict-ref log-result stdout: "")

+478

""))

+479

(commits (map commit-record (git-split-nul log-text))))

+480

#{ version: 1

+481

repo: repo

+482

snapshot:

+483

#{ head-oid: head

+484

index-id: index-id

+485

worktree-id: worktree-id }

+486

branch: (branch-info headers)

+487

operation: (git-operation git-dir)

+488

entries: entries

+489

recent-commits: commits

+490

capabilities:

+491

#{ stage-file: #t

+492

unstage-file: #t

+493

stage-hunk: #t

+494

unstage-hunk: #t } }))))))

packages/slate-cli/src/slate-cli/http/stream.sgldeleted

@@ -1,8 +0,0 @@

−1

;;; Compatibility import for sigil-http's incremental response API.

−2

;;;

−3

;;; Keeping this small module preserves Slate's existing import boundary while

−4

;;; allowing it to disappear in a later package-upgrade-only cleanup.

−5

−6

(define-library (slate-cli http stream)

−7

(import (sigil http client))

−8

(export http-stream-response))

packages/slate-cli/src/slate-cli/httpfetch.sglmodified

@@ -69,11 +69,20 @@

69

;; this covers other https callers, e.g. cli-latest.)

70

(if (and (https-url? url) (not (tls-verification-available?)))

71

#f

−72

(let ((r (http-fetch-bytes method url

−73

headers: (forward-request-headers req-headers)

−74

body: body

−75

timeout: timeout)))

−76

(and r (dict-set r headers: (strip-response-hops (fetch-headers r))))))))

+72

;; Transport failures are an expected offline condition for the

+73

;; proxy. Keep exceptions from escaping the connection handler

+74

;; (which would otherwise look like an empty HTTP response), and

+75

;; retain the diagnostic in the supervised service output.

+76

(guard (e (#t

+77

(display "slate proxy: upstream fetch failed: " (current-error-port))

+78

(write e (current-error-port))

+79

(newline (current-error-port))

+80

#f))

+81

(let ((r (http-fetch-bytes method url

+82

headers: (forward-request-headers req-headers)

+83

body: body

+84

timeout: timeout)))

+85

(and r (dict-set r headers: (strip-response-hops (fetch-headers r)))))))))

86

87

;; ---- request header shaping -----------------------------------

88

;; Forward the caller's headers minus hop-by-hop / host / framing, and

packages/slate-cli/src/slate-cli/listen.sglmodified

@@ -67,7 +67,10 @@

67

;; Cap the unassembled WS-frame buffer (finding #3). P0/P1 traffic is

68

;; control frames + small echoes; the credited session/transfer lanes

69

;; (P3) will raise this behind auth. 1 MiB is generous pre-auth.

−70

(define max-frame-bytes 1048576)

+70

;; v1 bulk remains one WebSocket message. Bound it above the live 2 MiB

+71

;; round-trip while continuing to reject an unbounded declared frame.

+72

(define max-frame-bytes 4194304)

+73

(define frame-read-chunk-bytes 65536)

74

75

;; ----------------------------------------------------------------

76

;; Listener state

@@ -108,6 +111,9 @@

111

(cond

112

((not client) (loop))

113

(else

+114

;; Interactive terminal frames must not wait for an ACK

+115

;; before the next small response can leave this socket.

+116

(socket-set-tcp-nodelay! client #t)

117

(socket-set-non-blocking! client #t)

118

;; Each connection is fully isolated: a raise in one

119

;; connection's goroutine must never tear down the

@@ -246,7 +252,10 @@

252

;; nothing at all. The Host header is echoed because it is the

253

;; whole evidence: it names what the request claimed to be talking

254

;; to.

−249

((not (host-allowed? headers port))

+255

((not (let ((allowed (dict-ref handlers request-allowed?: #f)))

+256

(if allowed

+257

(allowed daemon headers port)

+258

(host-allowed? headers port))))

259

(log-warn* "node/http-refused" mod: "node" status: 421

260

reason: "host-not-allowed"

261

host-header: (log-bounded-token (header-ref headers "host" ""))

@@ -263,7 +272,11 @@

272

;; an alias for the existing harness + older clients during the

273

;; pivot. Both are reserved: never proxied upstream.

274

((and (websocket-upgrade? headers)

−266

(or (string=? path "/node/ws") (string=? path "/ws")))

+275

(let ((path-ok (dict-ref handlers websocket-path?: #f)))

+276

(if path-ok

+277

(path-ok daemon path)

+278

(or (string=? path "/node/ws")

+279

(string=? path "/ws")))))

280

(upgrade-and-run! client buffer daemon handlers))

281

;; Everything else is a plain HTTP request (pairing pages).

282

(else

@@ -285,17 +298,21 @@

298

((or (not clen) (<= clen 0)) "")

299

((> clen max-head-bytes) "") ; pairing bodies are tiny; refuse huge

300

(else

−288

(let ((have (body-after-headers buffer)))

+301

;; Content-Length counts UTF-8 bytes, not Scheme characters.

+302

;; Keep partial code points intact until the body is complete.

+303

(let ((have (string->utf8 (body-after-headers buffer))))

304

(let loop ((body have))

305

(cond

−291

((>= (string-length body) clen) (substring body 0 clen))

+306

((>= (bytevector-length body) clen)

+307

(utf8->string (bytevector-copy body 0 clen)))

308

(else

309

(await-readable client)

−294

(let ((chunk (socket-read client)))

+310

(let ((chunk (socket-read-bytevector

+311

client (- clen (bytevector-length body)))))

312

(cond

−296

((or (not chunk) (eof-object? chunk)) body)

−297

((string=? chunk "") (loop body))

−298

(else (loop (string-append body chunk)))))))))))))

+313

((or (not chunk) (eof-object? chunk)) (utf8->string body))

+314

((= (bytevector-length chunk) 0) (loop body))

+315

(else (loop (bytevector-append body chunk)))))))))))))

316

317

;; The substring of the accumulated head-read that follows the

318

;; CRLFCRLF header terminator (the start of the body, if any).

@@ -443,7 +460,12 @@

460

((not frame)

461

;; Need more bytes.

462

(await-readable client)

−446

(let ((chunk (socket-read-bytevector client)))

+463

(let ((chunk

+464

;; The native ABI accepts an optional maximum. Larger

+465

;; chunks keep accumulation of a bounded multi-megabyte

+466

;; frame from repeatedly copying it in 4 KiB steps.

+467

(apply socket-read-bytevector

+468

(list client frame-read-chunk-bytes))))

469

(cond

470

((or (not chunk) (eof-object? chunk)) (safe-close client))

471

((zero? (bytevector-length chunk)) (loop buf))

@@ -566,8 +588,10 @@

588

;; Host gate (anti-DNS-rebinding, design §1.6)

589

;; ----------------------------------------------------------------

590

−569

;;; The Host header must literally name the loopback authority on

−570

;;; the daemon's port. Anything else (a rebound `evil.example`, a

+591

;;; The Host header must literally name the loopback authority. Native

+592

;;; sigil-websocket currently omits a non-default port from Host, so the

+593

;;; exact bound literals are accepted both bare and with this listener's

+594

;;; port. Anything else (a rebound `evil.example`, a

595

;;; public name) is a misdirected request.

596

;; Compared case-insensitively (hostnames are case-insensitive;

597

;; finding #10). We accept only the authorities we actually bind —

@@ -578,7 +602,9 @@

602

(let ((host (string-downcase (header-ref headers "host" "")))

603

(ps (number->string port)))

604

(or (string=? host (string-append "127.0.0.1:" ps))

−581

(string=? host (string-append "localhost:" ps)))))

+605

(string=? host (string-append "localhost:" ps))

+606

(string=? host "127.0.0.1")

+607

(string=? host "localhost"))))

608

609

;; ----------------------------------------------------------------

610

;; Plain HTTP responses

packages/slate-cli/src/slate-cli/logging.sglmodified

@@ -557,10 +557,10 @@

557

;;; Optional because `test-logging-contract.sgl` pins the 3-positional

558

;;; shape and it must keep passing; the control node always supplies it.

559

(define (stream-child-argv exe ws-url client ticket log-file log-level

−560

. sock-path)

+560

. extra-positionals)

561

(append

562

(list exe "node" "_stream" ws-url client ticket)

−563

(if (and (pair? sock-path) (car sock-path)) (list (car sock-path)) '())

+563

(filter (lambda (value) value) extra-positionals)

564

(if log-file (list "--log" log-file) '())

565

(if (and log-file log-level) (list "--log-level" log-level) '())))

566

packages/slate-cli/src/slate-cli/main.sglmodified

@@ -24,7 +24,12 @@

24

(sigil socket)

25

(sigil process)

26

(sigil async)

+27

(only (sigil math) min)

+28

(sigil websocket)

+29

(sigil json)

+30

(sigil array)

31

(sigil log)

+32

(sigil irc message)

33

(slate-cli logging)

34

(slate-cli config)

35

(slate-cli origins)

@@ -33,11 +38,16 @@

38

(slate-cli peercred)

39

(slate-cli wire)

40

(slate-cli dispatch)

+41

(slate-cli resource transfer connection)

42

(slate-cli sessions)

+43

(slate-cli terminal discovery)

+44

(slate-cli terminal owner)

45

(slate-cli listen)

46

(slate-cli cache)

47

(slate-cli proxy)

48

(slate-cli launch)

+49

(slate-cli persistent)

+50

(slate-cli node-posture)

51

(slate-cli tlsguard)

52

(slate-cli enclave-node-init)

53

(slate-cli enclave-node-session)

@@ -46,15 +56,23 @@

56

(slate-cli agent service)

57

(slate-cli agent service-client)

58

(slate-cli agent ipc)

+59

(slate-cli node dial)

+60

(slate-cli node direct)

+61

(slate-cli node pairing)

+62

(slate-cli node pairing-management)

+63

(slate-cli node pairing-carrier)

+64

(slate-cli node pairing-client)

+65

(slate-cli node gateway)

66

(slate-cli agent cli)

67

(slate-cli agent host))

68

−52

(export main)

+69

(export main http-route-kind)

70

71

(begin

72

73

(define port-candidates (list 32640 32641 32642 32643))

74

(define loopback-host "127.0.0.1")

+75

(define default-direct-port 32644)

76

77

;; THE ARGUMENT LIST IS PARSED EXACTLY ONCE, HERE, AND NOTHING BELOW

78

;; RE-READS `(command-line)` FOR THE LOGGING FLAGS.

@@ -109,7 +127,7 @@

127

(string=? (car args) "-h"))

128

(print-help))

129

((string=? (car args) "--version")

−112

(display "slate 0.1.0\n"))

+130

(display (string-append "slate " local-node-version "\n")))

131

(else

132

(log-warn "unknown subcommand" mod: "main" arg: (car args))

133

(display (string-append "slate: unknown subcommand: " (car args) "\n"))

@@ -146,7 +164,7 @@

164

(define (log-startup-facts! args)

165

(log-info* "slate starting"

166

mod: "main"

−149

version: "0.1.0"

+167

version: local-node-version

168

pid: (process-id)

169

command: (safe-command-summary args)

170

state-dir: (config-state-dir (load-config))

@@ -215,7 +233,7 @@

233

(or (dict-ref opts key #f)

234

(begin

235

(display (string-append "slate node init: " label " is required\n"))

−218

(display "usage: slate node init --enclave <https-url> --account <nick> --name <node-name>\n")

+236

(display "usage: slate node init --enclave <https-url> --account <nick> [--name <node-name>]\n")

237

(exit 2))))

238

239

;; `opts` is the parsed logging configuration from `main`, threaded here

@@ -231,27 +249,66 @@

249

(cond

250

;; Identity setup stays outside with-async: native suspension through

251

;; this caller boundary restarts the whole command (folio t-899b78).

−234

;; `node run` installs its scheduler only around the steady-state poll

−235

;; loop, where remote PTY streams need it.

+252

;; `node run` owns one scheduler for the loopback listener and its

+253

;; optional Enclave control subsystem.

254

((and (pair? args) (string=? (car args) "init"))

255

(run-node-init! (cdr args)))

256

((and (pair? args) (string=? (car args) "run"))

−239

(run-node-remote! opts))

+257

(run-node-companion! (cdr args) opts))

+258

((and (pair? args) (string=? (car args) "pairing"))

+259

(run-node-pairing! (cdr args)))

+260

((and (pair? args) (string=? (car args) "install"))

+261

(run-persistent-install! (cdr args)))

+262

((and (pair? args) (member (car args) '("start" "stop" "status" "logs" "restart" "uninstall" "app")))

+263

(run-persistent-command! (car args) (cdr args)))

264

;; 3 args is the pre-R1 shape and still works. A FOURTH is the

265

;; holder's control-socket path: the seam over which a parked holder

266

;; is handed a new ticket, so it can dial a replacement /stream for

267

;; sessions it is already holding. Optional so nothing that spawns

268

;; the old way breaks.

+269

((and (= (length args) 4) (string=? (car args) "_terminal-owner"))

+270

(run-terminal-owner! (cadr args) (caddr args)

+271

(or (string->number (list-ref args 3)) default-session-ttl)))

272

((and (pair? args) (string=? (car args) "_stream")

−246

(or (= (length (cdr args)) 3) (= (length (cdr args)) 4)))

+273

(member (length (cdr args)) '(3 4 5)))

274

(run-node-stream-worker! (cadr args) (caddr args) (list-ref args 3)

275

(if (= (length (cdr args)) 4)

276

(list-ref args 4)

−250

#f)))

+277

(and (>= (length (cdr args)) 4)

+278

(list-ref args 4)))

+279

(if (= (length (cdr args)) 5)

+280

(guard (e (#t '()))

+281

(json-decode (list-ref args 5)))

+282

'())))

283

(else

−252

         (display "usage: slate node init --enclave <https-url> --account <nick> --name <node-name>\n       slate node run\n")

+284

         (display "usage: slate node init --enclave <https-url> --account <nick> [--name <node-name>]\n       slate node run [--direct-host <vpn-address>] [--direct-port <port>]\n       slate node pairing list|revoke <peer>|rotate\n       slate node install --persistent [--name <node-name>]\n       slate node start|stop|status [--json]|logs|restart|uninstall\n       slate node app <staging|production|https-url>\n")

285

(exit 2))))

286

+287

(define (run-node-pairing! args)

+288

(let ((state-dir (config-state-dir (load-config))))

+289

(guard (e (#t

+290

(display (string-append "slate node pairing: "

+291

(guard (ignored (#t "operation failed"))

+292

(if (and (pair? (exception-irritants e))

+293

(string? (car (exception-irritants e))))

+294

(car (exception-irritants e)) "operation failed")) "\n"))

+295

(exit 1)))

+296

(cond

+297

((or (null? args) (string=? (car args) "list"))

+298

(display (json-encode

+299

(pairing-management-dispatch state-dir "pairing/list" #{})))

+300

(newline))

+301

((and (string=? (car args) "revoke") (pair? (cdr args)))

+302

(display (json-encode

+303

(pairing-management-dispatch state-dir "pairing/revoke"

+304

#{ peer: (cadr args) })))

+305

(newline))

+306

((string=? (car args) "rotate")

+307

(display (json-encode

+308

(pairing-management-dispatch state-dir "pairing/rotate" #{})))

+309

(newline))

+310

(else (error "usage: slate node pairing list|revoke <peer>|rotate"))))))

+311

312

;; How many stream children this process has spawned. A COUNTER, NOT A

313

;; LIST OF HANDLES, and the distinction is the whole point.

314

;;

@@ -396,6 +453,56 @@

453

(define (note-stream-child!)

454

(set! *stream-children-spawned* (+ *stream-children-spawned* 1)))

455

+456

;; Resource transfers use short-lived workers, separate from durable

+457

;; session holders. Keeping binary sockets out of the control process

+458

;; prevents a slow or closing transfer from blocking later node requests.

+459

(define *resource-workers* '())

+460

+461

(define (reap-resource-workers!)

+462

(set! *resource-workers*

+463

(filter

+464

(lambda (worker)

+465

(if (process-alive? (car worker))

+466

#t

+467

(begin

+468

(process-wait (car worker))

+469

(guard (e (#t #f)) (delete-file (cdr worker)))

+470

#f)))

+471

*resource-workers*)))

+472

+473

(define (spawn-resource! record opts config client request-id ticket metadata)

+474

(reap-resource-workers!)

+475

(if (>= (length *resource-workers*) 8)

+476

#{ code: "busy" message: "the node is busy transferring files" }

+477

(guard (e (#t

+478

#{ code: "unavailable"

+479

message: "the node could not start a file transfer" }))

+480

(let* ((dir (path-join (config-state-dir config) "resources"))

+481

(sock (mint-sock-path dir))

+482

(log-file (and (log-opts-file opts)

+483

(string-append (log-opts-file opts)

+484

".resource-" request-id))))

+485

(ensure-directory dir)

+486

(unless (= 0 (process-run "chmod" "700" dir))

+487

(error "cannot secure resource directory"))

+488

(let* ((argv (stream-child-argv

+489

(car (command-line))

+490

(node-init-stream-websocket-url record)

+491

client ticket log-file (log-opts-level opts)

+492

sock (json-encode

+493

(dict-set metadata resource-only?: #t))))

+494

(proc (apply process-spawn

+495

(append argv

+496

(list die-with-parent: #t

+497

in: "/dev/null" out: "/dev/null"

+498

err: (if log-file

+499

(string-append log-file ".stderr")

+500

"/dev/null"))))))

+501

(unless proc (error "cannot start resource worker"))

+502

(set! *resource-workers*

+503

(cons (cons proc sock) *resource-workers*))

+504

#t)))))

+505

506

;; ================================================================

507

;; THE ROUTER (R1b)

508

;;

@@ -529,6 +636,7 @@

636

637

;;; Remember the sid a `stream/open` named. `sid` #f means "no sid key at

638

;;; all" => a NEW session; nothing is stored and the ticket will spawn.

+639

;;; `resource:` routes a `resource/open` ticket to a file-transfer worker.

640

(define (pending-note! sender request-id sid)

641

(let ((now (current-second)))

642

(pending-sweep! now)

@@ -696,7 +804,7 @@

804

805

;;; Spawn a holder for a NEW session. Returns the process, or a refusal

806

;;; dict.

−699

(define (spawn-holder! record opts config client request-id ticket)

+807

(define (spawn-holder! record opts config client request-id ticket metadata)

808

;; Reap BEFORE testing the cap, so an exited holder never occupies a

809

;; slot. Otherwise a node that has churned eight terminals refuses the

810

;; ninth while holding eight corpses.

@@ -719,13 +827,22 @@

827

(else

828

(let* ((exe (car (command-line)))

829

(sock (mint-sock-path dir))

+830

;; `open-log-append!` emulates append with read/truncate/write

+831

;; and is not safe for concurrent processes sharing a path.

+832

;; A holder therefore gets a request-scoped file rather than

+833

;; racing its parent and erasing the very startup evidence

+834

;; needed when its relay handshake fails.

+835

(child-log

+836

(and (log-opts-file opts)

+837

(string-append (log-opts-file opts)

+838

".holder-" request-id)))

839

(argv (stream-child-argv

840

exe

−724

(dict-ref record websocket-url: "")

+841

(node-init-stream-websocket-url record)

842

client ticket

−726

(log-opts-file opts)

+843

child-log

844

(log-opts-level opts)

−728

sock))

+845

sock (json-encode metadata)))

846

;; GUARDED, AND THE #f CASE IS HANDLED SEPARATELY.

847

;; `process-spawn` returns #f when the process cannot be

848

;; started (fork failure under RLIMIT_NPROC or memory

@@ -777,26 +894,54 @@

894

(guard (e (#t #f)) (socket-close s))

895

ok))))

896

−780

(define (run-node-remote! opts)

−781

(let* ((configured-grants (getenv "SLATE_NODE_GRANTS"))

−782

(config (make-config

−783

dev-mode?: (env-flag? "SLATE_DEV")

−784

;; Until the file-backed config loader lands, allow a

−785

;; headless node operator (and the real-system gate) to

−786

;; narrow the owner grant set explicitly. Never widens

−787

;; unless the operator supplies the capability specs.

−788

silent-pair-grants:

−789

(if (and configured-grants

−790

(> (string-length configured-grants) 0))

−791

(string-split configured-grants ",")

−792

(silent-pair-grants-for-host loopback-host))))

+897

(define (run-node-remote! opts config direct daemon)

+898

(let* (

899

(target (enclave-node-path config))

900

(record (node-init-load target))

+901

(direct-identity

+902

(and record

+903

(or (pairing-load-identity (config-state-dir config))

+904

(let ((identity (pairing-make-identity 1)))

+905

(pairing-save-identity! (config-state-dir config) identity)

+906

identity))))

907

(failure #f))

−796

(unless record

−797

(log-fatal "no Enclave identity" mod: "node" target: target)

−798

(display "slate node run: no Enclave identity; run 'slate node init' first\n")

−799

(exit 2))

+908

(when direct-identity

+909

(vector-set! (dict-ref daemon pairing-identity: #()) 0 direct-identity))

+910

;; No credential is a normal pure-local companion posture. The caller

+911

;; keeps the loopback node alive and checks again later, so enrollment

+912

;; can be completed by a separate CLI invocation without restarting it.

+913

(when record

+914

(vector-set! (dict-ref daemon node-identity: #()) 0

+915

(dict-ref record transport-nick:

+916

(dict-ref record node-name: "")))

+917

(vector-set! (dict-ref daemon node-label: #()) 0

+918

(dict-ref record node-name: ""))

+919

(vector-set! (dict-ref daemon node-bot-id: #()) 0

+920

(dict-ref record bot-id: ""))

+921

;; The loopback gateway is allowed to name only a target identity and

+922

;; correlation id. Enclave resolves ownership and endpoint material;

+923

;; the browser never supplies either an endpoint or a ticket.

+924

(vector-set! (dict-ref daemon gateway-open: #()) 0

+925

(lambda (target request-id carrier sid)

+926

(if (not (node-session-done?))

+927

(gateway-handle-paired-open! daemon target request-id carrier sid)

+928

(let* ((registry (dict-ref daemon gateway: #f))

+929

(relay (gateway-mark-relay! registry carrier 'standby))

+930

;; Enclave preserves command order on this control

+931

;; connection. Ask for direct rendezvous first so its

+932

;; ticket/failure is observed before the already-armed

+933

;; relay response can bind the carrier.

+934

(direct-sent

+935

(node-session-send-command!

+936

"DIRECT-OPEN" target request-id))

+937

(relay-sent

+938

(and relay

+939

(node-session-send-command!

+940

"ENCLAVE-RPC" target request-id "stream/open"

+941

(json-encode

+942

#{ id: carrier

+943

args: (if sid #{ sid: sid } #{}) })))))

+944

(and relay-sent direct-sent)))))

945

(log-info* "node run starting"

946

mod: "node"

947

node-name: (dict-ref record node-name: "")

@@ -830,22 +975,90 @@

975

(let ((removed (holder-sock-sweep! dir)))

976

(log-info* "holder socket directory ready"

977

mod: "node" dir: dir

−833

stale-removed: removed))))

−834

;; Resume durable managed work even before a browser opens a stream.

+978

stale-removed: removed))

+979

(let ((path (path-join dir "node.sock")))

+980

(when (enclave-stream-listen! path config (dict-ref daemon sessions: #f))

+981

(vector-set! (dict-ref daemon session-directory: #f) 0

+982

(lambda (principal mine)

+983

(terminal-discover dir path principal mine)))))))

+984

;; Resume durable managed work before the first browser attachment.

985

(agent-ipc-close! (agent-service-connect! config))

+986

;; [next-at delay]. Failed Enclave dials must not become an almost

+987

;; continuous tax on the direct gateway when the hub is unreachable.

+988

;; Back off independently; a successful registration resets it.

+989

(let ((reconnect-at (vector 0 5)))

990

(node-session-resume!

991

record

992

(lambda (ready)

+993

(set! failure #f)

+994

(vector-set! reconnect-at 1 5)

+995

;; Identity enrollment is independent of listener availability: a

+996

;; relay-only node may initiate pairing and must still prove the

+997

;; public descriptor Enclave places in the rendezvous ticket.

+998

(when direct-identity

+999

(node-session-send-command!

+1000

"NODE-IDENTITY" (dict-ref record bot-id: "")

+1001

(dict-ref direct-identity key-id: "")

+1002

(number->string (dict-ref direct-identity generation: 0))

+1003

(dict-ref direct-identity public-key: "")))

+1004

(when direct

+1005

(vector-set! (dict-ref direct node-cell: #()) 0

+1006

(dict-ref record transport-nick: ""))

+1007

;; Advertise only after the separate socket has successfully

+1008

;; bound and the durable node identity has authenticated.

+1009

(node-session-send-command!

+1010

"NODE-ENDPOINT" (dict-ref direct endpoint: "") "60"

+1011

(dict-ref record bot-id: "")

+1012

(dict-ref direct-identity key-id: "")

+1013

(number->string (dict-ref direct-identity generation: 0))

+1014

(dict-ref direct-identity public-key: ""))

+1015

(vector-set! (dict-ref direct advertised-cell: #()) 0

+1016

(current-second)))

1017

(log-info* "enclave session ready"

1018

mod: "node" node-name: (dict-ref ready node-name: "node"))

1019

(display (string-append "Slate node connected to Enclave as "

1020

(dict-ref ready node-name: "node") "\n")))

1021

(lambda (msg)

−844

(let ((response

+1022

(let* ((direct-ticket (direct-ticket-from-message msg))

+1023

(ticket-store (dict-ref daemon direct-tickets: #f))

+1024

(_stored (and direct-ticket

+1025

(direct-ticket-store-put!

+1026

ticket-store direct-ticket)))

+1027

(_gateway

+1028

(and direct-ticket

+1029

(eq? (dict-ref direct-ticket role: #f) 'caller)

+1030

(let ((cell (dict-ref daemon direct-ticket-pending: #())))

+1031

(and (> (vector-length cell) 0)

+1032

(begin (vector-set! cell 0 direct-ticket) #t)))))

+1033

(gateway-relay?

+1034

(and (gateway-relay-response? daemon msg)

+1035

(let ((cell

+1036

(dict-ref daemon relay-ticket-pending: #())))

+1037

(and (> (vector-length cell) 0)

+1038

(begin

+1039

(vector-set! cell 0 msg)

+1040

(log-info* "relay ticket queued"

+1041

mod: "node")

+1042

#t)))))

+1043

(_direct-failure

+1044

(gateway-handle-direct-failure! daemon msg))

+1045

(response

+1046

(and (not gateway-relay?)

1047

(or (remote-handle-ticket msg

−846

(lambda (client request-id ticket)

−847

(let ((sid (pending-take! client request-id)))

−848

(if sid

+1048

(lambda (client request-id ticket metadata)

+1049

(let ((sid (pending-take! client request-id))

+1050

(pairing-meta

+1051

#{ request-id: request-id

+1052

caller-transport-nick: client

+1053

acceptor-transport-nick:

+1054

(dict-ref record transport-nick:

+1055

(dict-ref record node-name: ""))

+1056

descriptors: metadata }))

+1057

(cond

+1058

((eq? sid resource:)

+1059

(spawn-resource! record opts config

+1060

client request-id ticket pairing-meta))

+1061

(sid

1062

;; ---- REATTACH: route, never spawn ----

1063

;;

1064

;; The client named a session. Falling back

@@ -855,11 +1068,21 @@

1068

;; the duplicate-session defect and is worse

1069

;; than an error they can see. So a failure

1070

;; here refuses.

−858

(let ((owner (holder-owner-of sid)))

−859

(cond

+1071

(let ((local-hub (dict-ref daemon sessions: #f)))

+1072

(if (or (terminal-owner-holds? config sid)

+1073

(and local-hub

+1074

(hub-holds-sid? local-hub sid)))

+1075

;; Direct sessions live in this daemon.

+1076

;; Attach the relay adapter to the same

+1077

;; hub; never migrate it into a child.

+1078

(enclave-stream-start-on-hub!

+1079

(node-init-stream-websocket-url record)

+1080

client ticket config local-hub pairing-meta)

+1081

(let ((owner (holder-owner-of sid)))

+1082

(cond

1083

((dict? owner) owner) ; refusal, as-is

1084

((holder-deliver-ticket!

−862

owner (dict-ref record websocket-url: "")

+1085

owner (node-init-stream-websocket-url record)

1086

client ticket)

1087

(log-info* "ticket routed to the owning holder"

1088

mod: "node"

@@ -879,11 +1102,12 @@

1102

pid: (holder-pid owner))

1103

(reap-exited-holders!)

1104

#{ code: "dead"

−882

message: "the holder for this session is gone" })))

+1105

message: "the holder for this session is gone" }))))))

+1106

(else

1107

;; ---- NEW SESSION: spawn a holder ----

1108

(spawn-holder! record opts config

−885

client request-id ticket)))))

−886

(remote-handle-rpc config msg pending-note!))))

+1109

client request-id ticket pairing-meta))))))

+1110

(remote-handle-rpc config msg pending-note!)))))

1111

;; DEBUG, not warn, and the level is the whole point: once the

1112

;; session reaches phase `done` EVERY inbound IRC message lands

1113

;; here, including numerics and notices that legitimately need no

@@ -906,33 +1130,16 @@

1130

(apply node-session-send-command! response))))

1131

(lambda (reason)

1132

(log-error "enclave session failed" mod: "node" reason: reason)

−909

(set! failure reason)))

−910

;; Keep the control plane on its proven synchronous path. Each terminal

−911

;; stream runs in a short-lived child process so its blocking websocket

−912

;; and async PTY pumps cannot starve control RPCs in this native runtime.

−913

;;

−914

;; NO PERIODIC HEARTBEAT IS EMITTED HERE, AND THAT IS DELIBERATE.

−915

;; This loop does not turn on a timer. Because `run-node-remote!` is

−916

;; not inside `with-async`, `(current-scheduler)` is #f, and

−917

;; sigil-websocket only switches the socket to non-blocking and only

−918

;; awaits readability `(when (current-scheduler) ...)`. So

−919

;; `node-session-poll!` BLOCKS IN THE KERNEL inside `ws-receive` until

−920

;; a frame arrives or the socket closes, and this loop ticks once per

−921

;; inbound message rather than every 10ms.

−922

;;

−923

;; A heartbeat here would therefore be inbound-traffic-driven: it could

−924

;; only print while messages were arriving, and would fall silent in

−925

;; exactly the wedge it was meant to diagnose (folio t-c57a8c: shepherd

−926

;; healthy, socket ESTABLISHED, parent in `wait_woken` — which is the

−927

;; signature of this blocked read, not of polling). The instrument that

−928

;; DOES work is the paired receive-enter/receive-exit trace in

−929

;; (slate-cli enclave-node-session): an unmatched enter as the last

−930

;; line in the log names the blocked call positively, where silence

−931

;; could only hint at it.

−932

;;

−933

;; Making this loop tick on a timer means a non-blocking or

−934

;; timeout-bounded control read. That is a behaviour change to the path

−935

;; the comment above calls proven, and it belongs to R1.

+1133

(set! failure reason)

+1134

(let ((delay (vector-ref reconnect-at 1)))

+1135

(vector-set! reconnect-at 0 (+ (current-second) delay))

+1136

(vector-set! reconnect-at 1 (min 60 (* delay 2)))

Showing the first 500 of 2020 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate-cli/src/slate-cli/node-posture.sgladded

@@ -0,0 +1,66 @@

+1

;;; (slate-cli node-posture) — declared role and capability posture.

+2

;;;

+3

;;; This is build/runtime posture, not an authorization result. Effective

+4

;;; per-origin grants remain on the authenticated sys/info surface. Keeping

+5

;;; the remote transport manager explicitly unavailable makes the local-node

+6

;;; boundary machine-readable without introducing transport ownership here.

+7

(define-library (slate-cli node-posture)

+8

(import (sigil core) (sigil meta))

+9

(export local-node-version local-node-identity local-node-capability-posture

+10

local-node-upgrade-posture local-node-capability-names

+11

local-node-allows-verb?)

+12

(begin

+13

;; Baked by sigil-build from slate-cli's package version. Keep runtime

+14

;; posture and release metadata on the same manifest authority.

+15

(define local-node-version (or (app-version) "unknown"))

+16

+17

(define (local-node-identity)

+18

#{ role: "local-node" scope: "local-device" })

+19

+20

(define (local-node-capability-posture)

+21

#{ resource: #{ available: #t operations: #[ "fs" "proc" "sys" "git" ] }

+22

session: #{ available: #t operations: #[ "terminal" ] }

+23

agent: #{ available: #t operations: #[ "agent" ] }

+24

renderer: #{ available: #t same-origin: #t }

+25

upgrade: #{ available: #t operations: #[ "check" ]

+26

apply-available: #f }

+27

remote-transport-manager:

+28

#{ available: #f reason: "not-implemented" } })

+29

+30

;; Read-only upgrade posture. Checking is safe and already has a dedicated

+31

;; same-origin endpoint; applying and rollback remain closed until their

+32

;; staging, verification, restart, and recovery contracts are implemented.

+33

(define (local-node-upgrade-posture platform environment installed latest)

+34

#{ current-version: local-node-version

+35

available-version: latest

+36

state: (cond ((not (string? latest)) "not-checked")

+37

((string=? latest local-node-version) "up-to-date")

+38

(else "upgrade-available"))

+39

check: #{ available: #t endpoint: "/node/api/version" }

+40

apply: #{ available: #f reason: "not-implemented" }

+41

rollback: #{ available: #f reason: "not-implemented" }

+42

installation:

+43

#{ installed: installed

+44

strategy: (if (string=? environment "termux")

+45

"atomic-version-directory"

+46

"package-managed")

+47

platform: platform environment: environment } })

+48

+49

;; The capability names advertised by authenticated sys/info are sourced

+50

;; from the same declaration as the public posture document.

+51

(define (local-node-capability-names)

+52

#[ "fs" "proc" "sys" "git" "session" "agent" ])

+53

+54

;; Closed role policy seam. Current dispatchers recognize only these

+55

;; families; a future remote transport family must be added deliberately.

+56

(define (prefix? value prefix)

+57

(and (>= (string-length value) (string-length prefix))

+58

(string=? (substring value 0 (string-length prefix)) prefix)))

+59

+60

(define (local-node-allows-verb? verb)

+61

(or (prefix? verb "fs/")

+62

(prefix? verb "git/")

+63

(string=? verb "proc/run")

+64

(string=? verb "sys/info")

+65

(prefix? verb "session/")

+66

(prefix? verb "agent/")))))

packages/slate-cli/src/slate-cli/node/dial.sgladded

@@ -0,0 +1,76 @@

+1

;;; (slate-cli node dial) — transport selection for companion-to-node sessions.

+2

;;;

+3

;;; This module deliberately knows nothing about Resource/Session verbs or grants.

+4

;;; Both connectors return an already-authenticated carrier for the existing wire

+5

;;; protocol. Keeping selection here prevents a direct path from becoming a

+6

;;; second authorization model.

+7

+8

(define-library (slate-cli node dial)

+9

(import (sigil core) (sigil time))

+10

(export node-dial node-dial-failure-class direct-advertisement-current?)

+11

(begin

+12

(define public-failure-classes

+13

'(timeout refused stale-advertisement network authentication unavailable))

+14

+15

;;; Collapse connector errors before they reach status or logs. In

+16

;;; particular, never expose an endpoint, ticket, exception, or OS error.

+17

(define (node-dial-failure-class value)

+18

(let ((candidate

+19

(cond ((symbol? value) value)

+20

((dict? value) (dict-ref value reason: 'unavailable))

+21

(else 'unavailable))))

+22

(if (member candidate public-failure-classes)

+23

candidate

+24

'unavailable)))

+25

+26

(define (direct-advertisement-current? advertisement now)

+27

(and (dict? advertisement)

+28

(let ((endpoint (dict-ref advertisement endpoint: #f))

+29

(expires-at (dict-ref advertisement expires-at: #f)))

+30

(and (string? endpoint) (not (string=? endpoint ""))

+31

(number? expires-at) (> expires-at now)))))

+32

+33

(define (accepted result)

+34

(and (dict? result) (dict-ref result connection: #f)))

+35

+36

(define (relay-result target relay-connect reason started now-ms)

+37

;; relay-connect is invoked only here, after the direct outcome is known.

+38

;; Its implementation must ask Enclave for a fresh relay ticket; a direct

+39

;; rendezvous credential is never passed into this callback.

+40

(let ((relay (guard (e (#t #f)) (relay-connect target))))

+41

(if (accepted relay)

+42

#{ transport: 'relay

+43

connection: (dict-ref relay connection: #f)

+44

fallback-reason: reason

+45

elapsed-ms: (- (now-ms) started) }

+46

#{ transport: 'unavailable

+47

connection: #f

+48

fallback-reason: reason

+49

relay-failure: (node-dial-failure-class relay)

+50

elapsed-ms: (- (now-ms) started) })))

+51

+52

;;; Select a carrier for one session.

+53

;;;

+54

;;; direct-connect receives the authenticated, broker-supplied

+55

;;; advertisement and performs ONE bounded connect+peer-auth attempt. It

+56

;;; returns #{ connection: ... } or #{ reason: <public class> }. Timeout

+57

;;; ownership belongs to the connector because only it owns the socket.

+58

;;; relay-connect receives only TARGET, forcing fallback to acquire a fresh

+59

;;; relay ticket rather than reusing a direct credential.

+60

(define (node-dial target advertisement direct-connect relay-connect

+61

. maybe-now-ms)

+62

(let* ((now-ms (if (pair? maybe-now-ms) (car maybe-now-ms)

+63

(lambda () (* (current-second) 1000))))

+64

(started (now-ms)))

+65

(if (not (direct-advertisement-current? advertisement started))

+66

(relay-result target relay-connect 'stale-advertisement started now-ms)

+67

(let ((direct (guard (e (#t #{ reason: 'unavailable }))

+68

(direct-connect target advertisement))))

+69

(if (accepted direct)

+70

#{ transport: 'direct

+71

connection: (dict-ref direct connection: #f)

+72

fallback-reason: #f

+73

elapsed-ms: (- (now-ms) started) }

+74

(relay-result target relay-connect

+75

(node-dial-failure-class direct) started now-ms))))))

+76

))

packages/slate-cli/src/slate-cli/node/direct.sgladded

@@ -0,0 +1,645 @@

+1

;;; (slate-cli node direct) — direct rendezvous ticket and peer proofs.

+2

+3

(define-library (slate-cli node direct)

+4

(import (sigil core) (sigil math) (sigil string) (sigil crypto) (sigil time)

+5

(slate-cli node pairing))

+6

(export direct-ticket-from-message direct-ticket-current?

+7

direct-ticket-transcript direct-caller-proof direct-acceptor-proof

+8

direct-verify-caller? direct-verify-acceptor?

+9

make-direct-ticket-store direct-ticket-store-put!

+10

direct-ticket-store-find direct-ticket-store-await

+11

direct-ticket-store-consume!

+12

direct-new-nonce direct-caller-hello direct-broker-hello?

+13

direct-accept-challenge

+14

direct-caller-response direct-accept-response

+15

direct-caller-connect direct-test-mutate-control

+16

direct-test-ticket-for-attempt

+17

paired-direct-make paired-direct-start paired-direct-handle

+18

paired-direct-phase paired-direct-message? paired-direct-disconnect

+19

paired-direct-caller-connect)

+20

(begin

+21

(define (direct-ticket-from-message message . maybe-now)

+22

(and (pair? message) (eq? (car message) 'direct-ticket-message)

+23

(member (length (cdr message)) '(7 15))

+24

(let* ((fields (cdr message))

+25

(role-text (list-ref fields 0))

+26

(role (cond ((string=? role-text "caller") 'caller)

+27

((string=? role-text "acceptor") 'acceptor)

+28

(else #f)))

+29

(ttl (guard (e (#t #f)) (string->number (list-ref fields 6))))

+30

(now (if (pair? maybe-now) (car maybe-now) (current-second))))

+31

(and role (integer? ttl) (> ttl 0) (<= ttl 30)

+32

#{ role: role peer: (list-ref fields 1)

+33

request-id: (list-ref fields 2)

+34

endpoint: (list-ref fields 3)

+35

caller-key: (list-ref fields 4)

+36

acceptor-key: (list-ref fields 5)

+37

expires-at: (+ now ttl) used?: #f

+38

caller-bot-id: (if (= (length fields) 15) (list-ref fields 7) "")

+39

caller-key-id: (if (= (length fields) 15) (list-ref fields 8) "")

+40

caller-generation: (if (= (length fields) 15)

+41

(string->number (list-ref fields 9)) 0)

+42

caller-public-key: (if (= (length fields) 15) (list-ref fields 10) "")

+43

acceptor-bot-id: (if (= (length fields) 15) (list-ref fields 11) "")

+44

acceptor-key-id: (if (= (length fields) 15) (list-ref fields 12) "")

+45

acceptor-generation: (if (= (length fields) 15)

+46

(string->number (list-ref fields 13)) 0)

+47

acceptor-public-key: (if (= (length fields) 15) (list-ref fields 14) "") }))))

+48

+49

(define (direct-ticket-current? ticket now)

+50

(and (dict? ticket)

+51

(not (dict-ref ticket used?: #t))

+52

(> (dict-ref ticket expires-at: 0) now)))

+53

+54

;;; Length-prefix every field so concatenation cannot create ambiguous

+55

;;; transcripts. Peer names and request ids are authenticated context.

+56

(define (transcript-field value)

+57

(string-append (number->string (string-length value)) ":" value))

+58

+59

(define (direct-ticket-transcript caller acceptor request-id

+60

caller-nonce acceptor-nonce)

+61

(string-append "slate-direct-v1|"

+62

(transcript-field caller) "|" (transcript-field acceptor) "|"

+63

(transcript-field request-id) "|" (transcript-field caller-nonce) "|"

+64

(transcript-field acceptor-nonce)))

+65

+66

(define (direct-caller-proof ticket transcript)

+67

(hmac-sha256 (dict-ref ticket caller-key: "") transcript))

+68

+69

(define (direct-acceptor-proof ticket transcript)

+70

(hmac-sha256 (dict-ref ticket acceptor-key: "") transcript))

+71

+72

(define (direct-verify-caller? ticket transcript proof)

+73

(and (string? proof)

+74

(timing-safe-equal? (direct-caller-proof ticket transcript) proof)))

+75

+76

(define (direct-verify-acceptor? ticket transcript proof)

+77

(and (string? proof)

+78

(timing-safe-equal? (direct-acceptor-proof ticket transcript) proof)))

+79

+80

;;; Process-local rendezvous inbox. Tickets are intentionally neither

+81

;;; durable nor shared with relay tickets. The vector is a mutable cell

+82

;;; containing an alist keyed by role/peer/request-id.

+83

(define (make-direct-ticket-store) (vector '()))

+84

+85

(define (ticket-key ticket)

+86

(list (dict-ref ticket role: #f) (dict-ref ticket peer: "")

+87

(dict-ref ticket request-id: "")))

+88

+89

(define (same-key? a b) (equal? (ticket-key a) (ticket-key b)))

+90

+91

(define (direct-ticket-store-put! store ticket . maybe-now)

+92

(let ((now (if (pair? maybe-now) (car maybe-now) (current-second))))

+93

(and (direct-ticket-current? ticket now)

+94

(begin

+95

(vector-set! store 0

+96

(cons ticket

+97

(filter (lambda (old)

+98

(and (direct-ticket-current? old now)

+99

(not (same-key? old ticket))))

+100

(vector-ref store 0))))

+101

#t))))

+102

+103

(define (direct-ticket-store-find store role peer request-id now)

+104

(let loop ((tickets (vector-ref store 0)))

+105

(and (pair? tickets)

+106

(let ((ticket (car tickets)))

+107

(if (and (eq? role (dict-ref ticket role: #f))

+108

(string=? peer (dict-ref ticket peer: ""))

+109

(string=? request-id (dict-ref ticket request-id: ""))

+110

(direct-ticket-current? ticket now))

+111

ticket

+112

(loop (cdr tickets)))))))

+113

+114

;;; Enclave sends the caller and acceptor copies independently. A caller

+115

;;; can receive its copy, cross the network, and present `direct/hello`

+116

;;; before the acceptor's control-plane task has stored its copy. Await

+117

;;; only that exact role/peer/request tuple, under an injected monotonic

+118

;;; deadline. `pause` must yield the ambient scheduler; no listener-wide

+119

;;; lock or credential copy is introduced here.

+120

(define (direct-ticket-store-await store role peer request-id

+121

now-ms timeout-ms pause)

+122

(let ((started (now-ms)))

+123

(let loop ()

+124

(let* ((now (now-ms))

+125

(ticket (direct-ticket-store-find

+126

store role peer request-id (quotient now 1000))))

+127

(cond (ticket ticket)

+128

((>= (- now started) timeout-ms) #f)

+129

(else (pause) (loop)))))))

+130

+131

;;; Remove before returning: even if the caller subsequently raises, the

+132

;;; credential cannot be replayed.

+133

(define (direct-ticket-store-consume! store ticket now)

+134

(and (direct-ticket-current? ticket now)

+135

(let ((found #f))

+136

(vector-set! store 0

+137

(filter (lambda (item)

+138

(if (and (not found) (eq? item ticket))

+139

(begin (set! found #t) #f)

+140

(direct-ticket-current? item now)))

+141

(vector-ref store 0)))

+142

found)))

+143

+144

(define (direct-new-nonce)

+145

(base64url-encode (random-bytes 18)))

+146

+147

;;; The pre-release direct protocol has one wire version and two explicit

+148

;;; authentication modes. These messages are the durable-pairing branch;

+149

;;; broker tickets continue to use the direct/* branch below.

+150

(define (paired-direct-message? message)

+151

(and (dict? message)

+152

(= (dict-ref message version: 0) 1)

+153

(equal? (dict-ref message auth: #f) "paired")

+154

(member (dict-ref message t: #f)

+155

'("direct/hello" "direct/challenge" "direct/proof" "direct/ok"))))

+156

+157

(define (paired-lp value)

+158

(let ((text (cond ((string? value) value)

+159

((number? value) (number->string value))

+160

(else (error "paired direct: invalid transcript field")))))

+161

(string-append (number->string (string-length text)) ":" text)))

+162

+163

(define (paired-transcript state caller-ephemeral acceptor-ephemeral

+164

caller-nonce acceptor-nonce connection-id)

+165

(let* ((identity (dict-ref state identity: #{}))

+166

(peer (dict-ref state peer: #{}))

+167

(caller? (eq? (dict-ref state role: #f) 'caller))

+168

(caller-bot (if caller? (dict-ref state local-bot-id: "")

+169

(dict-ref peer bot-id: "")))

+170

(acceptor-bot (if caller? (dict-ref peer bot-id: "")

+171

(dict-ref state local-bot-id: "")))

+172

(caller-key (if caller? (dict-ref identity key-id: "")

+173

(dict-ref peer peer-key-id: "")))

+174

(acceptor-key (if caller? (dict-ref peer peer-key-id: "")

+175

(dict-ref identity key-id: "")))

+176

(caller-gen (if caller? (dict-ref identity generation: 0)

+177

(dict-ref peer peer-generation: 0)))

+178

(acceptor-gen (if caller? (dict-ref peer peer-generation: 0)

+179

(dict-ref identity generation: 0))))

+180

(string-join

+181

(map paired-lp

+182

(list "slate-paired-direct-v1" caller-bot acceptor-bot

+183

caller-key caller-gen acceptor-key acceptor-gen

+184

caller-nonce acceptor-nonce caller-ephemeral

+185

acceptor-ephemeral connection-id)) "|")))

+186

+187

(define (paired-direct-make role local-bot-id identity peer . rest)

+188

(unless (member role '(caller acceptor))

+189

(error "paired direct: invalid role"))

+190

(unless (and (string? local-bot-id) (> (string-length local-bot-id) 0)

+191

(pairing-identity-valid? identity)

+192

(pairing-record-valid? peer)

+193

(not (dict-ref peer revoked: #t)))

+194

(error "paired direct: invalid identity or pairing"))

+195

(let ((ephemeral (pairing-generate-keypair)))

+196

#{ role: role phase: (if (eq? role 'caller) 'new 'waiting-hello)

+197

local-bot-id: local-bot-id identity: identity peer: peer

+198

nonce: (if (pair? rest) (car rest) (direct-new-nonce))

+199

connection-id: (if (and (pair? rest) (pair? (cdr rest))) (cadr rest)

+200

(if (eq? role 'acceptor) (direct-new-nonce) ""))

+201

ephemeral: ephemeral transcript: #f confirmation-key: #f }))

+202

+203

(define (paired-direct-phase state) (dict-ref state phase: 'invalid))

+204

(define (paired-out state send authed?)

+205

#{ state: state send: send authed?: authed? })

+206

(define (paired-fail state)

+207

(paired-out

+208

(dict-set

+209

(dict-set

+210

(dict-set

+211

(dict-set

+212

(dict-set state phase: 'failed)

+213

ephemeral: #f)

+214

confirmation-key: #f)

+215

transcript: #f)

+216

nonce: #f)

+217

#f #f))

+218

(define (paired-confirmation-valid? expected actual)

+219

(and (string? expected) (string? actual)

+220

(timing-safe-equal? expected actual)))

+221

(define (paired-descriptors-match? state message peer-prefix)

+222

(let ((peer (dict-ref state peer: #{})))

+223

(and (equal? (dict-ref message (if peer-prefix caller-bot-id: acceptor-bot-id:) #f)

+224

(dict-ref peer bot-id: #f))

+225

(equal? (dict-ref message (if peer-prefix caller-key-id: acceptor-key-id:) #f)

+226

(dict-ref peer peer-key-id: #f))

+227

(= (dict-ref message (if peer-prefix caller-generation:

+228

acceptor-generation:) 0)

+229

(dict-ref peer peer-generation: 0)))))

+230

+231

(define (paired-direct-start state)

+232

(if (and (eq? (dict-ref state role: #f) 'caller)

+233

(eq? (paired-direct-phase state) 'new))

+234

(let* ((identity (dict-ref state identity: #{}))

+235

(peer (dict-ref state peer: #{}))

+236

(next (dict-set state phase: 'waiting-challenge)))

+237

(paired-out next

+238

#{ t: "direct/hello" version: 1 auth: "paired"

+239

caller-bot-id: (dict-ref state local-bot-id: "")

+240

caller-key-id: (dict-ref identity key-id: "")

+241

caller-generation: (dict-ref identity generation: 0)

+242

acceptor-bot-id: (dict-ref peer bot-id: "")

+243

acceptor-key-id: (dict-ref peer peer-key-id: "")

+244

acceptor-generation: (dict-ref peer peer-generation: 0)

+245

caller-nonce: (dict-ref state nonce: "")

+246

caller-ephemeral: (dict-ref (dict-ref state ephemeral: #{}) public-key: "") }

+247

#f))

+248

(paired-out state #f #f)))

+249

+250

(define (paired-direct-handle state message)

+251

(let ((role (dict-ref state role: #f))

+252

(phase (paired-direct-phase state))

+253

(identity (dict-ref state identity: #{}))

+254

(peer (dict-ref state peer: #{})))

+255

(cond

+256

((and (eq? role 'acceptor) (eq? phase 'waiting-hello)

+257

(paired-direct-message? message)

+258

(equal? (dict-ref message t: #f) "direct/hello")

+259

(paired-descriptors-match? state message #t)

+260

(equal? (dict-ref message acceptor-bot-id: #f)

+261

(dict-ref state local-bot-id: #f))

+262

(equal? (dict-ref message acceptor-key-id: #f)

+263

(dict-ref identity key-id: #f))

+264

(= (dict-ref message acceptor-generation: 0)

+265

(dict-ref identity generation: 0)))

+266

(let* ((caller-ephemeral (dict-ref message caller-ephemeral: #f))

+267

(caller-nonce (dict-ref message caller-nonce: #f))

+268

(acceptor-ephemeral

+269

(dict-ref (dict-ref state ephemeral: #{}) public-key: ""))

+270

(transcript (and (string? caller-ephemeral) (string? caller-nonce)

+271

(paired-transcript state caller-ephemeral acceptor-ephemeral

+272

caller-nonce (dict-ref state nonce: "")

+273

(dict-ref state connection-id: ""))))

+274

(shared (and transcript

+275

(pairing-shared-secret

+276

(dict-ref (dict-ref state ephemeral: #{}) private-key: "")

+277

caller-ephemeral)))

+278

(key (and shared (pairing-confirmation-key shared transcript))))

+279

(if (not key) (paired-fail state)

+280

(let ((next (dict-set (dict-set (dict-set state phase: 'waiting-proof)

+281

transcript: transcript)

+282

confirmation-key: key)))

+283

(paired-out next

+284

#{ t: "direct/challenge" version: 1 auth: "paired"

+285

acceptor-nonce: (dict-ref state nonce: "")

+286

acceptor-ephemeral: acceptor-ephemeral

+287

connection-id: (dict-ref state connection-id: "")

+288

signature: (pairing-sign (dict-ref identity private-key: "") transcript) }

+289

#f)))))

+290

((and (eq? role 'caller) (eq? phase 'waiting-challenge)

+291

(paired-direct-message? message)

+292

(equal? (dict-ref message t: #f) "direct/challenge"))

+293

(let* ((acceptor-ephemeral (dict-ref message acceptor-ephemeral: #f))

+294

(acceptor-nonce (dict-ref message acceptor-nonce: #f))

+295

(connection-id (dict-ref message connection-id: #f))

+296

(caller-ephemeral (dict-ref (dict-ref state ephemeral: #{}) public-key: ""))

+297

(transcript (and (string? acceptor-ephemeral) (string? acceptor-nonce)

+298

(string? connection-id)

+299

(paired-transcript state caller-ephemeral acceptor-ephemeral

+300

(dict-ref state nonce: "") acceptor-nonce connection-id)))

+301

(valid (and transcript

+302

(pairing-verify? (dict-ref peer peer-public-key: "") transcript

+303

(dict-ref message signature: ""))))

+304

(shared (and valid (pairing-shared-secret

+305

(dict-ref (dict-ref state ephemeral: #{}) private-key: "")

+306

acceptor-ephemeral)))

+307

(key (and shared (pairing-confirmation-key shared transcript))))

+308

(if (not key) (paired-fail state)

+309

(let ((next (dict-set (dict-set (dict-set state phase: 'waiting-ok)

+310

transcript: transcript)

+311

confirmation-key: key)))

+312

(paired-out next

+313

#{ t: "direct/proof" version: 1 auth: "paired"

+314

signature: (pairing-sign (dict-ref identity private-key: "") transcript)

+315

confirmation: (pairing-confirmation key "caller" transcript) }

+316

#f)))))

+317

((and (eq? role 'acceptor) (eq? phase 'waiting-proof)

+318

(paired-direct-message? message)

+319

(equal? (dict-ref message t: #f) "direct/proof"))

+320

(let* ((transcript (dict-ref state transcript: ""))

+321

(key (dict-ref state confirmation-key: #f))

+322

(valid (and

+323

(pairing-verify? (dict-ref peer peer-public-key: "") transcript

+324

(dict-ref message signature: ""))

+325

(paired-confirmation-valid?

+326

(pairing-confirmation key "caller" transcript)

+327

(dict-ref message confirmation: "")))))

+328

(if (not valid) (paired-fail state)

+329

(let ((next (dict-set

+330

(dict-set

+331

(dict-set

+332

(dict-set state phase: 'active)

+333

ephemeral: #f)

+334

confirmation-key: #f)

+335

transcript: #f)))

+336

(paired-out next

+337

#{ t: "direct/ok" version: 1 auth: "paired" transport: "direct"

+338

confirmation: (pairing-confirmation key "acceptor" transcript) }

+339

#t)))))

+340

((and (eq? role 'caller) (eq? phase 'waiting-ok)

+341

(paired-direct-message? message)

+342

(equal? (dict-ref message t: #f) "direct/ok"))

+343

(let* ((transcript (dict-ref state transcript: ""))

+344

(key (dict-ref state confirmation-key: #f))

+345

(valid (paired-confirmation-valid?

+346

(pairing-confirmation key "acceptor" transcript)

+347

(dict-ref message confirmation: ""))))

+348

(if (not valid) (paired-fail state)

+349

(paired-out

+350

(dict-set

+351

(dict-set

+352

(dict-set

+353

(dict-set state phase: 'active)

+354

ephemeral: #f)

+355

confirmation-key: #f)

+356

transcript: #f)

+357

#f #t))))

+358

(else (paired-fail state)))))

+359

+360

(define (paired-direct-disconnect state)

+361

(if (eq? (paired-direct-phase state) 'active) state #f))

+362

+363

(define (paired-direct-caller-connect local-bot identity peer transport timeout-ms)

+364

(define open (dict-ref transport open: (lambda (endpoint) #f)))

+365

;; Some native transports complete their handshake synchronously but do

+366

;; not publish the open state until their receive pump runs once. Keep

+367

;; that transport detail out of the authentication state machine while

+368

;; still refusing to send the first proof onto a not-yet-open socket.

+369

(define connected? (dict-ref transport connected?: (lambda (conn) #t)))

+370

(define send (dict-ref transport send: (lambda (conn message) #f)))

+371

(define receive (dict-ref transport receive: (lambda (conn) #f)))

+372

(define close (dict-ref transport close: (lambda (conn) #f)))

+373

(define now-ms (dict-ref transport now-ms: (lambda () (* (current-second) 1000))))

+374

(define pause (dict-ref transport pause: (lambda () #f)))

+375

(define started (now-ms))

+376

(define (failed conn reason)

+377

(when conn (guard (e (#t #f)) (close conn)))

+378

#{ connection: #f reason: reason })

+379

(define (await-connected conn)

+380

(let loop ()

+381

(cond

+382

((guard (e (#t #f)) (connected? conn)) #t)

+383

((>= (- (now-ms) started) timeout-ms) #f)

+384

(else

+385

;; `receive` is also the native WebSocket state pump. No peer

+386

;; protocol message can precede our hello, so discarding #f here

+387

;; cannot consume authenticated traffic.

+388

(let ((message (guard (e (#t 'closed)) (receive conn))))

+389

(if (eq? message 'closed) #f

+390

(begin (pause) (loop))))))))

+391

(define (exchange endpoint)

+392

(let ((conn (guard (e (#t #f)) (open endpoint))))

+393

(if (not conn) #f

+394

(if (not (await-connected conn))

+395

(begin (guard (e (#t #f)) (close conn)) #f)

+396

(let* ((initial (paired-direct-make 'caller local-bot identity peer))

+397

(start (paired-direct-start initial)))

+398

(if (not (guard (e (#t #f)) (send conn (dict-ref start send: #{}))))

+399

(begin (guard (e (#t #f)) (close conn)) #f)

+400

(let loop ((state (dict-ref start state: #{})))

+401

(if (>= (- (now-ms) started) timeout-ms)

+402

(begin (guard (e (#t #f)) (close conn)) #f)

+403

(let ((message (guard (e (#t 'closed)) (receive conn))))

+404

(cond

+405

((not message) (pause) (loop state))

+406

((eq? message 'closed)

+407

(guard (e (#t #f)) (close conn)) #f)

+408

(else

+409

(let* ((out (paired-direct-handle state message))

+410

(next (dict-ref out state: #{}))

+411

(reply (dict-ref out send: #f)))

+412

(cond

+413

((eq? (paired-direct-phase next) 'failed)

+414

(guard (e (#t #f)) (close conn)) #f)

+415

((and reply (not (guard (e (#t #f)) (send conn reply))))

+416

(guard (e (#t #f)) (close conn)) #f)

+417

((dict-ref out authed?: #f) conn)

+418

(else (loop next)))))))))))))))

+419

(if (or (not (pairing-identity-valid? identity))

+420

(not (pairing-record-valid? peer))

+421

(dict-ref peer revoked: #t))

+422

#{ connection: #f reason: 'authentication }

+423

(let loop ((endpoints (dict-ref peer endpoints: '())))

+424

(cond

+425

((null? endpoints) #{ connection: #f reason: 'unavailable })

+426

((>= (- (now-ms) started) timeout-ms)

+427

#{ connection: #f reason: 'timeout })

+428

(else

+429

(let ((conn (exchange (car endpoints))))

+430

(if conn #{ connection: conn reason: #f }

+431

(loop (cdr endpoints)))))))))

+432

+433

(define (direct-caller-hello local-node ticket nonce)

+434

#{ t: "direct/hello" version: 1 auth: "broker" caller: local-node

+435

acceptor: (dict-ref ticket peer: "")

+436

request-id: (dict-ref ticket request-id: "") caller-nonce: nonce })

+437

+438

;;; Cheap structural gate before an acceptor yields while awaiting its

+439

;;; independently delivered ticket. Invalid or misaddressed sockets fail

+440

;;; immediately rather than consuming the bounded wait budget.

+441

(define (direct-broker-hello? hello local-node)

+442

(and (dict? hello)

+443

(equal? (dict-ref hello t: #f) "direct/hello")

+444

(= (dict-ref hello version: 0) 1)

+445

(equal? (dict-ref hello auth: #f) "broker")

+446

(let ((caller (dict-ref hello caller: #f))

+447

(acceptor (dict-ref hello acceptor: #f))

+448

(request-id (dict-ref hello request-id: #f))

+449

(nonce (dict-ref hello caller-nonce: #f)))

+450

(and (string? caller) (> (string-length caller) 0)

+451

(string? acceptor) (string=? acceptor local-node)

+452

(string? request-id) (> (string-length request-id) 0)

+453

(string? nonce) (> (string-length nonce) 0)))))

+454

+455

;;; Validate the caller's unauthenticated hello against an acceptor ticket

+456

;;; and return both the public challenge and private transcript state.

+457

(define (direct-accept-challenge local-node ticket hello acceptor-nonce now)

+458

(and (direct-ticket-current? ticket now)

+459

(dict? hello)

+460

(equal? (dict-ref hello t: #f) "direct/hello")

+461

(= (dict-ref hello version: 0) 1)

+462

(equal? (dict-ref hello auth: #f) "broker")

+463

(equal? (dict-ref hello caller: #f) (dict-ref ticket peer: #f))

+464

(equal? (dict-ref hello acceptor: #f) local-node)

+465

(equal? (dict-ref hello request-id: #f)

+466

(dict-ref ticket request-id: #f))

+467

(let* ((caller-nonce (dict-ref hello caller-nonce: #f))

+468

(transcript

+469

(and (string? caller-nonce) (> (string-length caller-nonce) 0)

+470

(direct-ticket-transcript

+471

(dict-ref ticket peer: "") local-node

+472

(dict-ref ticket request-id: "")

+473

caller-nonce acceptor-nonce))))

+474

(and transcript

+475

#{ transcript: transcript

+476

challenge:

+477

#{ t: "direct/challenge" version: 1 auth: "broker"

+478

request-id: (dict-ref ticket request-id: "")

+479

acceptor-nonce: acceptor-nonce

+480

proof: (direct-acceptor-proof ticket transcript) } }))))

+481

+482

;;; Verify the acceptor before revealing the caller proof.

+483

(define (direct-caller-response local-node ticket caller-nonce challenge now)

+484

(and (direct-ticket-current? ticket now) (dict? challenge)

+485

(equal? (dict-ref challenge t: #f) "direct/challenge")

+486

(= (dict-ref challenge version: 0) 1)

+487

(equal? (dict-ref challenge auth: #f) "broker")

+488

(equal? (dict-ref challenge request-id: #f)

+489

(dict-ref ticket request-id: #f))

+490

(let* ((acceptor-nonce (dict-ref challenge acceptor-nonce: #f))

+491

(transcript

+492

(and (string? acceptor-nonce) (> (string-length acceptor-nonce) 0)

+493

(direct-ticket-transcript

+494

local-node (dict-ref ticket peer: "")

+495

(dict-ref ticket request-id: "")

+496

caller-nonce acceptor-nonce))))

+497

(and transcript

+498

(direct-verify-acceptor?

+499

ticket transcript (dict-ref challenge proof: #f))

Showing the first 500 of 646 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate-cli/src/slate-cli/node/gateway.sgladded

@@ -0,0 +1,343 @@

+1

;;; (slate-cli node gateway) — loopback carrier multiplexing for remote nodes.

+2

;;;

+3

;;; The browser already uses one authenticated WebSocket for the local node.

+4

;;; Remote carriers therefore need their own id namespace: their native node

+5

;;; frames cannot be injected into the local connection without request/channel

+6

;;; collisions. This module is deliberately pure socket-independent machinery.

+7

+8

(define-library (slate-cli node gateway)

+9

(import (sigil math) (slate-cli wire))

+10

(export GATEWAY-FRAME

+11

gateway-frame-encode gateway-frame-decode

+12

gateway-stamp-trace-received

+13

gateway-text-envelope gateway-text-envelope?

+14

make-gateway-registry gateway-register! gateway-ref gateway-bind!

+15

gateway-remove! gateway-remove-owner! gateway-owned?

+16

gateway-find-request gateway-ticket-entry gateway-mark-relay!

+17

gateway-relay-completion gateway-opening-expired?

+18

gateway-opened-event gateway-failed-event

+19

gateway-remove-paired!

+20

gateway-valid-target? gateway-count gateway-entries)

+21

(begin

+22

;; Binary loopback envelope:

+23

;; [0x11 gateway-frame][u32 carrier-id BE][original node frame bytes]

+24

;; Existing local-node frame types occupy 0x02..0x10. Keeping a distinct

+25

;; outer type makes accidental delivery to the local session dispatcher a

+26

;; clean unknown frame rather than a plausible request for the wrong node.

+27

(define GATEWAY-FRAME #x11)

+28

(define max-carrier-id 4294967295)

+29

+30

(define (write-u32-be! bytes offset value)

+31

(bytevector-u8-set! bytes offset

+32

(modulo (quotient value 16777216) 256))

+33

(bytevector-u8-set! bytes (+ offset 1)

+34

(modulo (quotient value 65536) 256))

+35

(bytevector-u8-set! bytes (+ offset 2)

+36

(modulo (quotient value 256) 256))

+37

(bytevector-u8-set! bytes (+ offset 3) (modulo value 256)))

+38

+39

(define (read-u32-be bytes offset)

+40

(+ (* (bytevector-u8-ref bytes offset) 16777216)

+41

(* (bytevector-u8-ref bytes (+ offset 1)) 65536)

+42

(* (bytevector-u8-ref bytes (+ offset 2)) 256)

+43

(bytevector-u8-ref bytes (+ offset 3))))

+44

+45

(define (valid-carrier-id? value)

+46

(and (integer? value) (> value 0) (<= value max-carrier-id)))

+47

+48

(define (gateway-frame-encode carrier payload)

+49

(unless (valid-carrier-id? carrier)

+50

(error "gateway-frame-encode: invalid carrier id" carrier))

+51

(unless (bytevector? payload)

+52

(error "gateway-frame-encode: payload must be bytes"))

+53

(let* ((length (bytevector-length payload))

+54

(out (make-bytevector (+ length 5) 0)))

+55

(bytevector-u8-set! out 0 GATEWAY-FRAME)

+56

(write-u32-be! out 1 carrier)

+57

(let loop ((i 0))

+58

(when (< i length)

+59

(bytevector-u8-set! out (+ i 5) (bytevector-u8-ref payload i))

+60

(loop (+ i 1))))

+61

out))

+62

+63

(define (gateway-frame-decode bytes)

+64

(and (bytevector? bytes)

+65

(>= (bytevector-length bytes) 5)

+66

(= (bytevector-u8-ref bytes 0) GATEWAY-FRAME)

+67

(let ((carrier (read-u32-be bytes 1)))

+68

(and (valid-carrier-id? carrier)

+69

#{ carrier: carrier

+70

payload: (bytevector-copy bytes 5

+71

(bytevector-length bytes)) }))))

+72

+73

;; Capture-only attribution: preserve every ordinary inner frame exactly,

+74

;; but extend a v1 trace reply with the caller gateway's receive clock.

+75

;; The browser compares this modulo-u32 epoch with its keydown epoch; no

+76

;; terminal bytes or normal protocol frames are modified.

+77

(define (gateway-stamp-trace-received bytes now-ms . maybe-outbound-ms)

+78

(let ((frame (and (bytevector? bytes) (decode-stream-frame bytes))))

+79

(if (and frame

+80

(= (stream-frame-type frame) frame-trace-out)

+81

(= (bytevector-length (stream-frame-payload frame)) 12)

+82

(integer? now-ms))

+83

(let* ((payload (stream-frame-payload frame))

+84

(has-outbound? (and (pair? maybe-outbound-ms)

+85

(integer? (car maybe-outbound-ms))))

+86

(stamped (make-bytevector (if has-outbound? 20 16) 0)))

+87

(bytevector-copy! stamped 0 payload 0 12)

+88

(if has-outbound?

+89

(begin

+90

(write-u32-be! stamped 12

+91

(modulo (car maybe-outbound-ms) 4294967296))

+92

(write-u32-be! stamped 16 (modulo now-ms 4294967296)))

+93

(write-u32-be! stamped 12 (modulo now-ms 4294967296)))

+94

(encode-stream-frame frame-trace-out

+95

(stream-frame-id frame) stamped))

+96

bytes)))

+97

+98

;; Text frames remain JSON control envelopes at the listener boundary. The

+99

;; inner value is the exact original node protocol JSON string, not decoded

+100

;; and re-encoded by the gateway.

+101

(define (gateway-text-envelope carrier payload)

+102

(unless (valid-carrier-id? carrier)

+103

(error "gateway-text-envelope: invalid carrier id" carrier))

+104

(unless (string? payload)

+105

(error "gateway-text-envelope: payload must be text"))

+106

#{ t: "remote/text" carrier: carrier payload: payload })

+107

+108

(define (gateway-text-envelope? value)

+109

(and (dict? value)

+110

(equal? (dict-ref value t: #f) "remote/text")

+111

(valid-carrier-id? (dict-ref value carrier: #f))

+112

(string? (dict-ref value payload: #f))))

+113

+114

;;; Enclave node identities use the IRC-safe token alphabet. Refuse spaces,

+115

;;; separators, URLs, and oversized values at loopback before allocating

+116

;;; state. Enclave remains authoritative for existence and common ownership.

+117

(define (gateway-valid-target? target)

+118

(define (safe-char? ch)

+119

(or (and (char>=? ch #\a) (char<=? ch #\z))

+120

(and (char>=? ch #\A) (char<=? ch #\Z))

+121

(and (char>=? ch #\0) (char<=? ch #\9))

+122

(char=? ch #\-) (char=? ch #\_)))

+123

(and (string? target)

+124

(> (string-length target) 0) (<= (string-length target) 64)

+125

(let loop ((i 0))

+126

(or (= i (string-length target))

+127

(and (safe-char? (string-ref target i))

+128

(loop (+ i 1)))))))

+129

+130

;; Registry vector slots: next-id, entries. Entries are public non-secret

+131

;; status records. The live connection is retained for routing but callers

+132

;; must not serialize an entry directly onto status/log surfaces.

+133

(define (make-gateway-registry) (vector 0 '()))

+134

+135

(define (gateway-entries registry) (vector-ref registry 1))

+136

(define (gateway-count registry) (length (gateway-entries registry)))

+137

+138

(define (gateway-ref registry carrier)

+139

(let loop ((entries (gateway-entries registry)))

+140

(and (pair? entries)

+141

(let ((entry (car entries)))

+142

(if (= carrier (dict-ref entry carrier: 0))

+143

entry

+144

(loop (cdr entries)))))))

+145

+146

(define (gateway-find-request registry request-id)

+147

(and (string? request-id)

+148

(let loop ((entries (gateway-entries registry)))

+149

(and (pair? entries)

+150

(let ((entry (car entries)))

+151

(if (equal? request-id

+152

(dict-ref entry request-id: #f))

+153

entry

+154

(loop (cdr entries))))))))

+155

+156

;;; A caller ticket completes exactly one still-opening carrier. Role,

+157

;;; correlation id, and peer identity are all load-bearing: a ticket for a

+158

;;; different target must never be attached merely because its id parses.

+159

(define (gateway-ticket-entry registry ticket)

+160

(and (dict? ticket)

+161

(eq? (dict-ref ticket role: #f) 'caller)

+162

(let ((entry

+163

(gateway-find-request registry

+164

(dict-ref ticket request-id: #f))))

+165

(and entry

+166

;; Relay is armed before DIRECT-OPEN so fallback never has

+167

;; to send from the control socket's receive continuation.

+168

;; A direct ticket may still win while that relay request is

+169

;; in flight; once either transport binds, state is `ready`

+170

;; and the loser is rejected here/on relay completion.

+171

(member (dict-ref entry state: #f)

+172

'(opening opening-relay))

+173

(equal? (dict-ref entry target: #f)

+174

(dict-ref ticket peer: #f))

+175

(dict-ref entry owner: #f)

+176

entry))))

+177

+178

(define (carrier-in-use? registry carrier)

+179

(and (gateway-ref registry carrier) #t))

+180

+181

(define (allocate-carrier! registry)

+182

(let loop ((candidate (+ (vector-ref registry 0) 1)) (attempts 0))

+183

(let ((id (if (> candidate max-carrier-id) 1 candidate)))

+184

(cond

+185

((>= attempts max-carrier-id)

+186

(error "gateway carrier id space exhausted"))

+187

((carrier-in-use? registry id)

+188

(loop (+ id 1) (+ attempts 1)))

+189

(else

+190

(vector-set! registry 0 id)

+191

id)))))

+192

+193

(define (gateway-register! registry target . metadata)

+194

(unless (gateway-valid-target? target)

+195

(error "gateway-register!: target must be a node identity"))

+196

(let* ((meta (if (pair? metadata) (car metadata) #{}))

+197

(carrier (allocate-carrier! registry))

+198

(entry #{ carrier: carrier target: target state: 'opening

+199

transport: #f fallback-reason: #f connection: #f

+200

owner: (dict-ref meta owner: #f)

+201

client-request: (dict-ref meta client-request: #f)

+202

opened-at: (dict-ref meta opened-at: #f)

+203

request-id: (dict-ref meta request-id:

+204

(string-append "g"

+205

(number->string carrier))) }))

+206

(vector-set! registry 1 (cons entry (gateway-entries registry)))

+207

entry))

+208

+209

(define (gateway-owned? registry carrier owner)

+210

(let ((entry (gateway-ref registry carrier)))

+211

(and entry owner (eq? owner (dict-ref entry owner: #f)))))

+212

+213

(define (replace-entry! registry carrier replacement)

+214

(let ((found #f))

+215

(vector-set! registry 1

+216

(map (lambda (entry)

+217

(if (= carrier (dict-ref entry carrier: 0))

+218

(begin (set! found #t) replacement)

+219

entry))

+220

(gateway-entries registry)))

+221

(and found replacement)))

+222

+223

(define (gateway-bind! registry carrier connection transport fallback-reason . auth)

+224

(let ((entry (gateway-ref registry carrier)))

+225

(and entry connection (member transport '(direct relay))

+226

(replace-entry! registry carrier

+227

(dict-set

+228

(dict-set

+229

(dict-set

+230

(dict-set

+231

(dict-set entry state: 'ready)

+232

connection: connection)

+233

transport: transport)

+234

fallback-reason: fallback-reason)

+235

auth-kind: (if (pair? auth) (car auth) 'broker))))))

+236

+237

(define (gateway-remove-paired! registry peer close!)

+238

(let ((targets

+239

(filter (lambda (entry)

+240

(and (eq? (dict-ref entry auth-kind: #f) 'paired)

+241

(or (not peer)

+242

(equal? peer (dict-ref entry target: #f)))))

+243

(gateway-entries registry))))

+244

(for-each (lambda (entry)

+245

(gateway-remove! registry (dict-ref entry carrier: 0) close!))

+246

targets)

+247

(length targets)))

+248

+249

(define (gateway-mark-relay! registry carrier reason)

+250

(let ((entry (gateway-ref registry carrier)))

+251

(and entry (eq? (dict-ref entry state: #f) 'opening)

+252

(replace-entry! registry carrier

+253

(dict-set

+254

(dict-set entry state: 'opening-relay)

+255

fallback-reason: reason)))))

+256

+257

(define (gateway-opening-expired? entry now timeout)

+258

(let ((opened-at (dict-ref entry opened-at: #f)))

+259

(and (member (dict-ref entry state: #f) '(opening opening-relay))

+260

(number? opened-at) (number? now) (number? timeout)

+261

(>= (- now opened-at) timeout))))

+262

+263

;;; Validate the client half of Enclave's stream/ticket response without

+264

;;; retaining it in registry state. SENDER must remain the target node and

+265

;;; the carrier must already have crossed the one-way opening-relay gate.

+266

(define (gateway-relay-completion registry sender request-id verb payload now)

+267

(and (string? sender) (string? request-id)

+268

(equal? verb "stream/ticket") (dict? payload)

+269

(let* ((entry (gateway-find-request registry request-id))

+270

(ticket (dict-ref payload ticket: #f))

+271

(ttl-raw (dict-ref payload expires-in: #f))

+272

(ttl (cond ((integer? ttl-raw) ttl-raw)

+273

((string? ttl-raw)

+274

(guard (e (#t #f)) (string->number ttl-raw)))

+275

(else #f))))

+276

(and entry

+277

(eq? (dict-ref entry state: #f) 'opening-relay)

+278

(equal? sender (dict-ref entry target: #f))

+279

(string? ticket) (not (string=? ticket ""))

+280

(integer? ttl) (> ttl 0) (<= ttl 60)

+281

#{ entry: entry ticket: ticket expires-at: (+ now ttl)

+282

pairing-descriptors:

+283

(dict-ref payload pairing-descriptors: '()) }))))

+284

+285

;;; Browser events are constructed from an explicit safe field set. In

+286

;;; particular, CONNECTION, OWNER, TARGET, and REQUEST-ID never cross the

+287

;;; loopback status surface.

+288

(define (gateway-opened-event entry)

+289

(and (dict? entry) (eq? (dict-ref entry state: #f) 'ready)

+290

#{ t: "ev" event: "remote/opened"

+291

carrier: (dict-ref entry carrier: #f)

+292

request: (dict-ref entry client-request: #f)

+293

transport: (if (eq? (dict-ref entry transport: #f) 'direct)

+294

"direct" "relay")

+295

fallback-reason:

+296

(let ((reason (dict-ref entry fallback-reason: #f)))

+297

(and reason (symbol->string reason))) }))

+298

+299

(define (gateway-failed-event entry direct-failure relay-failure)

+300

#{ t: "ev" event: "remote/failed"

+301

carrier: (dict-ref entry carrier: #f)

+302

request: (dict-ref entry client-request: #f)

+303

reason: "unavailable"

+304

direct-failure: (symbol->string direct-failure)

+305

relay-failure: (symbol->string relay-failure) })

+306

+307

;;; Remove before closing. A close callback that re-enters the gateway can

+308

;;; never find and route another frame onto the dying carrier.

+309

(define (gateway-remove! registry carrier . maybe-close)

+310

(let ((entry (gateway-ref registry carrier)))

+311

(and entry

+312

(begin

+313

(vector-set! registry 1

+314

(filter (lambda (item)

+315

(not (= carrier (dict-ref item carrier: 0))))

+316

(gateway-entries registry)))

+317

(when (and (pair? maybe-close)

+318

(dict-ref entry connection: #f))

+319

(guard (e (#t #f))

+320

((car maybe-close) (dict-ref entry connection: #f))))

+321

entry))))

+322

+323

;;; Drop every carrier belonging to one loopback connection. Removal of the

+324

;;; complete set happens before any close callback runs, giving disconnect

+325

;;; cleanup the same re-entrancy guarantee as gateway-remove!.

+326

(define (gateway-remove-owner! registry owner . maybe-close)

+327

(let ((removed

+328

(filter (lambda (entry)

+329

(eq? owner (dict-ref entry owner: #f)))

+330

(gateway-entries registry))))

+331

(vector-set! registry 1

+332

(filter (lambda (entry)

+333

(not (eq? owner (dict-ref entry owner: #f))))

+334

(gateway-entries registry)))

+335

(when (pair? maybe-close)

+336

(for-each

+337

(lambda (entry)

+338

(let ((connection (dict-ref entry connection: #f)))

+339

(when connection

+340

(guard (e (#t #f)) ((car maybe-close) connection)))))

+341

removed))

+342

removed))

+343

))

packages/slate-cli/src/slate-cli/node/pairing-carrier.sgladded

@@ -0,0 +1,72 @@

+1

;;; Shared authenticated-carrier adapter for durable node pairing.

+2

+3

(define-library (slate-cli node pairing-carrier)

+4

(import (sigil core) (sigil json) (sigil log)

+5

(slate-cli listen)

+6

(slate-cli node pairing)

+7

(slate-cli node pairing-control))

+8

(export pairing-carrier-init! pairing-carrier-start!

+9

pairing-carrier-handle! pairing-carrier-close!)

+10

(begin

+11

(define (persist! conn state)

+12

(let* ((state-dir (conn-state-get conn "pairing-state-dir" #f))

+13

(record (pairing-control-record state))

+14

(old (and state-dir (pairing-load-records state-dir)))

+15

(merged (and (list? old) record (pairing-record-merge old record))))

+16

(and merged (begin (pairing-save-records! state-dir merged) #t))))

+17

+18

(define (pairing-carrier-init! conn role context identity endpoints state-dir)

+19

(conn-state-set! conn "pairing-state-dir" state-dir)

+20

(conn-state-set! conn "pairing-control"

+21

(pairing-control-make role context identity endpoints))

+22

#t)

+23

+24

(define (apply-result! conn result)

+25

(let ((state (dict-ref result state: #f))

+26

(send (dict-ref result send: #f))

+27

(activate? (dict-ref result activate?: #f)))

+28

(cond

+29

;; The acceptor activates only after the final frame was written.

+30

;; This is the explicitly accepted final-delivery asymmetry.

+31

((and activate? send)

+32

(if (and (ws-send-control! conn send) (persist! conn state))

+33

(begin (conn-state-set! conn "pairing-control" state) #t)

+34

(begin (conn-state-set! conn "pairing-control" #f) #f)))

+35

;; The initiator has already validated pair/committed and has no

+36

;; further write. Persisting is its activation point.

+37

(activate?

+38

(if (persist! conn state)

+39

(begin (conn-state-set! conn "pairing-control" state) #t)

+40

(begin (conn-state-set! conn "pairing-control" #f) #f)))

+41

(else

+42

(conn-state-set! conn "pairing-control" state)

+43

(when send (ws-send-control! conn send))

+44

#t))))

+45

+46

(define (pairing-carrier-start! conn)

+47

(let ((state (conn-state-get conn "pairing-control" #f)))

+48

(and state (apply-result! conn (pairing-control-start state)))))

+49

+50

;; Returns #t when `text` belongs to the built-in pairing family, including

+51

;; malformed pairing JSON. Ordinary Resource/Session dispatch must not see

+52

;; a reserved family frame.

+53

(define (pairing-carrier-handle! conn text)

+54

(let ((env (guard (e (#t #f)) (json-decode text))))

+55

(if (not (pairing-control-message? env)) #f

+56

(let ((state (conn-state-get conn "pairing-control" #f)))

+57

(when state

+58

(log-debug "pairing carrier received control"

+59

phase: (symbol->string (pairing-control-phase state))

+60

type: (dict-ref env t: ""))

+61

(let* ((result (pairing-control-handle state env))

+62

(next (dict-ref result state: #f)))

+63

(log-debug "pairing carrier advanced"

+64

phase: (symbol->string (pairing-control-phase next))

+65

activate: (dict-ref result activate?: #f))

+66

(apply-result! conn result)))

+67

#t))))

+68

+69

(define (pairing-carrier-close! conn)

+70

(let ((state (conn-state-get conn "pairing-control" #f)))

+71

(conn-state-set! conn "pairing-control"

+72

(and state (pairing-control-disconnect state)))))))

packages/slate-cli/src/slate-cli/node/pairing-client.sgladded

@@ -0,0 +1,48 @@

+1

;;; Initiator driver for the carrier-independent pairing state machine.

+2

+3

(define-library (slate-cli node pairing-client)

+4

(import (sigil core) (sigil time) (sigil log)

+5

(slate-cli node pairing) (slate-cli node pairing-control))

+6

(export pairing-client-run!)

+7

(begin

+8

(define (save-record! state-dir record)

+9

(let* ((old (pairing-load-records state-dir))

+10

(merged (and (list? old) (pairing-record-merge old record))))

+11

(and merged (begin (pairing-save-records! state-dir merged) #t))))

+12

+13

;; Transport supplies send:/receive:/pause:/now-ms:. receive returns a

+14

;; decoded control dict, #f when idle, or 'closed.

+15

(define (pairing-client-run! context identity endpoints state-dir transport

+16

. maybe-timeout)

+17

(let* ((timeout (if (pair? maybe-timeout) (car maybe-timeout) 2000))

+18

(now (dict-ref transport now-ms: current-milliseconds))

+19

(deadline (+ (now) timeout))

+20

(send! (dict-ref transport send: #f))

+21

(receive! (dict-ref transport receive: #f))

+22

(pause! (dict-ref transport pause: (lambda () (sleep 0.01))))

+23

(started (pairing-control-start

+24

(pairing-control-make 'caller context identity endpoints))))

+25

(send! (dict-ref started send: #f))

+26

(let loop ((state (dict-ref started state: #f)))

+27

(if (>= (now) deadline) #f

+28

(let ((message (receive!)))

+29

(cond

+30

((or (not message) (eq? message 'idle)) (pause!) (loop state))

+31

((eq? message 'closed) #f)

+32

((not (pairing-control-message? message)) #f)

+33

(else

+34

(log-debug "pairing client received control"

+35

phase: (symbol->string (pairing-control-phase state))

+36

type: (dict-ref message t: ""))

+37

(let* ((result (pairing-control-handle state message))

+38

(next (dict-ref result state: #f))

+39

(reply (dict-ref result send: #f)))

+40

(log-debug "pairing client advanced"

+41

phase: (symbol->string (pairing-control-phase next))

+42

activate: (dict-ref result activate?: #f))

+43

(when reply (send! reply))

+44

(if (dict-ref result activate?: #f)

+45

(and (save-record! state-dir

+46

(pairing-control-record next)) #t)

+47

(if (eq? (pairing-control-phase next) 'failed)

+48

#f (loop next)))))))))))))

packages/slate-cli/src/slate-cli/node/pairing-control.sgladded

@@ -0,0 +1,156 @@

+1

;;; Pure four-message durable node-pairing exchange.

+2

+3

(define-library (slate-cli node pairing-control)

+4

(import (sigil core) (sigil crypto) (sigil math) (sigil time)

+5

(slate-cli node pairing))

+6

(export pairing-control-make pairing-control-start pairing-control-handle

+7

pairing-control-disconnect pairing-control-phase

+8

pairing-control-record pairing-control-message?)

+9

(begin

+10

(define (required context key)

+11

(let ((value (dict-ref context key #f)))

+12

(if value value (error "node pairing: missing authenticated carrier field" key))))

+13

+14

(define (pairing-control-message? env)

+15

(and (dict? env)

+16

(member (dict-ref env t: #f)

+17

'("pair/offer" "pair/accept" "pair/commit" "pair/committed"))))

+18

+19

;; `context` is supplied only by an authenticated broker carrier. The

+20

;; wire message never gets to choose either identity bound below.

+21

(define (pairing-control-make role context identity endpoints . rest)

+22

(unless (member role '(caller acceptor)) (error "node pairing: invalid role"))

+23

(unless (pairing-identity-valid? identity) (error "node pairing: invalid identity"))

+24

(for-each (lambda (key) (required context key))

+25

(list session-id: caller-bot-id: caller-transport-nick:

+26

caller-key-id: caller-generation: caller-public-key:

+27

acceptor-bot-id: acceptor-transport-nick:

+28

acceptor-key-id: acceptor-generation: acceptor-public-key:))

+29

#{ role: role phase: (if (eq? role 'caller) 'new 'waiting-offer)

+30

context: context identity: identity endpoints: endpoints

+31

nonce: (if (pair? rest) (car rest)

+32

(base64url-encode (random-bytes 32)))

+33

created: (if (and (pair? rest) (pair? (cdr rest))) (cadr rest)

+34

(exact (floor (current-second))))

+35

peer-nonce: #f transcript: #f confirmation-key: #f record: #f })

+36

+37

(define (pairing-control-phase state) (dict-ref state phase: 'invalid))

+38

(define (pairing-control-record state) (dict-ref state record: #f))

+39

(define (out state send activate?)

+40

#{ state: state send: send activate?: activate? })

+41

+42

(define (context-transcript context caller-nonce acceptor-nonce)

+43

(pairing-transcript

+44

(dict-ref context session-id: "")

+45

(dict-ref context caller-bot-id: "")

+46

(dict-ref context caller-transport-nick: "")

+47

(dict-ref context caller-key-id: "")

+48

(dict-ref context caller-generation: 0)

+49

(dict-ref context acceptor-bot-id: "")

+50

(dict-ref context acceptor-transport-nick: "")

+51

(dict-ref context acceptor-key-id: "")

+52

(dict-ref context acceptor-generation: 0)

+53

(dict-ref context caller-public-key: "")

+54

(dict-ref context acceptor-public-key: "")

+55

caller-nonce acceptor-nonce))

+56

+57

(define (peer-record state)

+58

(let* ((role (dict-ref state role: #f))

+59

(ctx (dict-ref state context: #{}))

+60

(caller? (eq? role 'caller)))

+61

#{ bot-id: (dict-ref ctx (if caller? acceptor-bot-id: caller-bot-id:) "")

+62

transport-nick: (dict-ref ctx (if caller? acceptor-transport-nick:

+63

caller-transport-nick:) "")

+64

peer-key-id: (dict-ref ctx (if caller? acceptor-key-id: caller-key-id:) "")

+65

peer-generation: (dict-ref ctx (if caller? acceptor-generation:

+66

caller-generation:) 0)

+67

peer-public-key: (dict-ref ctx (if caller? acceptor-public-key:

+68

caller-public-key:) "")

+69

endpoints: (dict-ref state endpoints: '())

+70

created: (dict-ref state created: 0) revoked: #f }))

+71

+72

(define (derive state transcript peer-public)

+73

(let* ((identity (dict-ref state identity: #{}))

+74

(shared (pairing-shared-secret

+75

(dict-ref identity private-key: "") peer-public))

+76

(key (and shared (pairing-confirmation-key shared transcript))))

+77

(and key (dict-set (dict-set state transcript: transcript)

+78

confirmation-key: key))))

+79

+80

(define (pairing-control-start state)

+81

(if (and (eq? (dict-ref state role: #f) 'caller)

+82

(eq? (pairing-control-phase state) 'new))

+83

(let ((next (dict-set state phase: 'waiting-accept)))

+84

(out next #{ t: "pair/offer" nonce: (dict-ref state nonce: "") } #f))

+85

(out state #f #f)))

+86

+87

(define (same-confirmation? actual expected)

+88

(and (string? actual) (string? expected) (timing-safe-equal? actual expected)))

+89

+90

(define (pairing-control-handle state env)

+91

(let ((type (and (dict? env) (dict-ref env t: #f)))

+92

(phase (pairing-control-phase state))

+93

(role (dict-ref state role: #f))

+94

(ctx (dict-ref state context: #{}))

+95

(identity (dict-ref state identity: #{})))

+96

(cond

+97

((and (eq? role 'acceptor) (eq? phase 'waiting-offer)

+98

(equal? type "pair/offer") (string? (dict-ref env nonce: #f)))

+99

(let* ((caller-nonce (dict-ref env nonce: ""))

+100

(acceptor-nonce (dict-ref state nonce: ""))

+101

(transcript (context-transcript ctx caller-nonce acceptor-nonce))

+102

(next (derive (dict-set state peer-nonce: caller-nonce) transcript

+103

(dict-ref ctx caller-public-key: ""))))

+104

(if (not next) (out (dict-set state phase: 'failed) #f #f)

+105

(out (dict-set next phase: 'waiting-commit)

+106

#{ t: "pair/accept" nonce: acceptor-nonce

+107

signature: (pairing-sign

+108

(dict-ref identity private-key: "") transcript) }

+109

#f))))

+110

((and (eq? role 'caller) (eq? phase 'waiting-accept)

+111

(equal? type "pair/accept") (string? (dict-ref env nonce: #f)))

+112

(let* ((acceptor-nonce (dict-ref env nonce: ""))

+113

(transcript (context-transcript ctx (dict-ref state nonce: "") acceptor-nonce))

+114

(valid (pairing-verify? (dict-ref ctx acceptor-public-key: "") transcript

+115

(dict-ref env signature: "")))

+116

(next (and valid

+117

(derive (dict-set state peer-nonce: acceptor-nonce) transcript

+118

(dict-ref ctx acceptor-public-key: "")))))

+119

(if (not next) (out (dict-set state phase: 'failed) #f #f)

+120

(out (dict-set next phase: 'waiting-committed)

+121

#{ t: "pair/commit"

+122

signature: (pairing-sign (dict-ref identity private-key: "") transcript)

+123

confirmation: (pairing-confirmation

+124

(dict-ref next confirmation-key: #f) "caller" transcript) }

+125

#f))))

+126

((and (eq? role 'acceptor) (eq? phase 'waiting-commit)

+127

(equal? type "pair/commit"))

+128

(let* ((transcript (dict-ref state transcript: ""))

+129

(key (dict-ref state confirmation-key: #f))

+130

(valid (and

+131

(pairing-verify? (dict-ref ctx caller-public-key: "") transcript

+132

(dict-ref env signature: ""))

+133

(same-confirmation? (dict-ref env confirmation: "")

+134

(pairing-confirmation key "caller" transcript)))))

+135

(if (not valid) (out (dict-set state phase: 'failed) #f #f)

+136

(let* ((record (peer-record state))

+137

(next (dict-set (dict-set state phase: 'active) record: record)))

+138

;; The adapter persists `record` before it writes this reply.

+139

(out next #{ t: "pair/committed"

+140

confirmation: (pairing-confirmation key "acceptor" transcript) }

+141

#t)))))

+142

((and (eq? role 'caller) (eq? phase 'waiting-committed)

+143

(equal? type "pair/committed"))

+144

(let* ((transcript (dict-ref state transcript: ""))

+145

(valid (same-confirmation? (dict-ref env confirmation: "")

+146

(pairing-confirmation (dict-ref state confirmation-key: #f)

+147

"acceptor" transcript))))

+148

(if (not valid) (out (dict-set state phase: 'failed) #f #f)

+149

(let ((record (peer-record state)))

+150

(out (dict-set (dict-set state phase: 'active) record: record) #f #t)))))

+151

(else (out (dict-set state phase: 'failed) #f #f)))))

+152

+153

;; Active means durable and survives carrier loss. Every other phase is

+154

;; pending in memory and is discarded without producing a usable record.

+155

(define (pairing-control-disconnect state)

+156

(if (eq? (pairing-control-phase state) 'active) state #f))))

packages/slate-cli/src/slate-cli/node/pairing-management.sgladded

@@ -0,0 +1,63 @@

+1

;;; Durable pairing management. All public results are reconstructed summaries.

+2

+3

(define-library (slate-cli node pairing-management)

+4

(import (sigil core) (sigil time) (slate-cli node pairing))

+5

(export pairing-management-list pairing-management-revoke!

+6

pairing-management-rotate! pairing-management-dispatch)

+7

(begin

+8

(define (safe-summary record)

+9

(let ((summary (pairing-public-summary record)))

+10

(dict-set summary offline-ready?:

+11

(and (not (dict-ref record revoked: #t))

+12

(pair? (dict-ref record endpoints: '()))))))

+13

+14

(define (pairing-management-list state-dir)

+15

(let ((records (pairing-load-records state-dir)))

+16

(unless records (error "pairing-store-corrupt" "pairing store is corrupt"))

+17

(map safe-summary records)))

+18

+19

(define (pairing-management-revoke! state-dir peer)

+20

(unless (and (string? peer) (> (string-length peer) 0))

+21

(error "invalid-args" "pairing revoke needs a peer identity"))

+22

(let ((records (pairing-load-records state-dir)))

+23

(unless records (error "pairing-store-corrupt" "pairing store is corrupt"))

+24

(let* ((found #f)

+25

(updated

+26

(map (lambda (record)

+27

(if (or (equal? peer (dict-ref record bot-id: #f))

+28

(equal? peer (dict-ref record transport-nick: #f)))

+29

(begin (set! found #t) (dict-set record revoked: #t))

+30

record))

+31

records)))

+32

(unless found (error "not-found" "pairing not found"))

+33

(pairing-save-records! state-dir updated)

+34

(safe-summary (pairing-record-find-inclusive updated peer)))))

+35

+36

(define (pairing-record-find-inclusive records peer)

+37

(let loop ((rest records))

+38

(and (pair? rest)

+39

(if (or (equal? peer (dict-ref (car rest) bot-id: #f))

+40

(equal? peer (dict-ref (car rest) transport-nick: #f)))

+41

(car rest) (loop (cdr rest))))))

+42

+43

(define (pairing-management-rotate! state-dir)

+44

(let ((identity (pairing-load-identity state-dir)))

+45

(unless identity (error "identity-unavailable" "direct identity is unavailable"))

+46

(let ((replacement

+47

(pairing-make-identity (+ 1 (dict-ref identity generation: 0))

+48

(+ 1 (dict-ref identity created: 0)))))

+49

(pairing-save-identity! state-dir replacement)

+50

(pairing-public-summary replacement))))

+51

+52

;;; Typed operation seam shared by the listener and CLI. The caller owns

+53

;;; authorization; this function owns validation, persistence and redaction.

+54

(define (pairing-management-dispatch state-dir verb args)

+55

(cond

+56

((string=? verb "pairing/list")

+57

#{ pairings: (pairing-management-list state-dir) })

+58

((string=? verb "pairing/revoke")

+59

#{ pairing: (pairing-management-revoke! state-dir

+60

(dict-ref args peer: #f)) })

+61

((string=? verb "pairing/rotate")

+62

#{ identity: (pairing-management-rotate! state-dir) })

+63

(else (error "unknown-verb" "unknown pairing management verb"))))))

packages/slate-cli/src/slate-cli/node/pairing.sgladded

@@ -0,0 +1,294 @@

+1

;;; Durable, hub-independent node pairing primitives and stores.

+2

+3

(define-library (slate-cli node pairing)

+4

(import (sigil string) (sigil array) (sigil io) (sigil fs) (sigil path)

+5

(sigil process) (sigil json) (sigil crypto) (sigil time) (sigil math))

+6

(export pairing-transcript pairing-transcript-hash

+7

pairing-generate-keypair pairing-sign pairing-verify?

+8

pairing-shared-secret pairing-confirmation-key pairing-confirmation

+9

pairing-make-identity pairing-identity-valid?

+10

pairing-record-valid? pairing-record-relation pairing-record-merge

+11

pairing-record-find

+12

pairing-identity-path pairing-records-path

+13

pairing-save-identity! pairing-load-identity

+14

pairing-save-records! pairing-load-records

+15

make-pairing-identity-reader make-pairing-records-reader

+16

pairing-public-summary pairing-require-mode!)

+17

(begin

+18

(define (nonempty-string? value)

+19

(and (string? value) (> (string-length value) 0)))

+20

+21

(define (natural? value) (and (integer? value) (> value 0)))

+22

+23

(define (starts-with? text prefix)

+24

(and (string? text) (>= (string-length text) (string-length prefix))

+25

(string=? (substring text 0 (string-length prefix)) prefix)))

+26

+27

(define (lp value)

+28

(let ((text (cond ((string? value) value)

+29

((symbol? value) (symbol->string value))

+30

((number? value) (number->string value))

+31

(else (error "node pairing: invalid transcript field")))))

+32

(string-append (number->string (string-length text)) ":" text)))

+33

+34

;; The order is protocol, not dictionary order. Callers supply every field

+35

;; explicitly so a future JSON encoder cannot alter the signed bytes.

+36

(define (pairing-transcript session-id caller-bot caller-nick caller-key caller-gen

+37

acceptor-bot acceptor-nick acceptor-key acceptor-gen

+38

caller-public acceptor-public caller-nonce acceptor-nonce)

+39

(string-join

+40

(map lp (list "slate-node-pairing-v1" session-id

+41

caller-bot caller-nick caller-key caller-gen

+42

acceptor-bot acceptor-nick acceptor-key acceptor-gen

+43

caller-public acceptor-public caller-nonce acceptor-nonce)) "|"))

+44

+45

(define (pairing-transcript-hash transcript) (sha256 transcript))

+46

+47

(define (encoded-key? value bytes first-byte)

+48

(and (nonempty-string? value)

+49

(guard (e (#t #f))

+50

(let ((raw (base64url-decode value)))

+51

(and (bytevector? raw) (= (bytevector-length raw) bytes)

+52

(or (not first-byte)

+53

(= (bytevector-u8-ref raw 0) first-byte)))))))

+54

+55

(define (public-key-valid? value)

+56

(and (encoded-key? value 65 #x04)

+57

(guard (e (#t #f))

+58

;; Scalar one is a fixed validation probe; ECDH rejects points

+59

;; with valid SEC1 shape that are not actually on P-256.

+60

(let ((one (make-bytevector 32 0)))

+61

(bytevector-u8-set! one 31 1)

+62

(and (ecdh-p256-shared-secret one (decode-key value)) #t)))))

+63

+64

(define (pairing-generate-keypair)

+65

(let ((kp (ecdsa-p256-generate-keypair)))

+66

#{ private-key: (base64url-encode (car kp))

+67

public-key: (base64url-encode (cdr kp)) }))

+68

+69

(define (decode-key key) (base64url-decode key))

+70

(define (pairing-sign private-key transcript)

+71

(base64url-encode (ecdsa-p256-sign (decode-key private-key) transcript)))

+72

(define (pairing-verify? public-key transcript signature)

+73

(and (encoded-key? public-key 65 #x04) (encoded-key? signature 64 #f)

+74

(guard (e (#t #f))

+75

(ecdsa-p256-verify (decode-key public-key) transcript

+76

(decode-key signature)))))

+77

(define (pairing-shared-secret private-key peer-public-key)

+78

(guard (e (#t #f))

+79

(ecdh-p256-shared-secret (decode-key private-key)

+80

(decode-key peer-public-key))))

+81

(define (pairing-confirmation-key shared transcript)

+82

(and (bytevector? shared)

+83

(hkdf-sha256 (sha256-bytes transcript) shared

+84

"slate-paired-direct-v1" 32)))

+85

(define (pairing-confirmation key role transcript)

+86

(and (bytevector? key)

+87

(hmac-sha256 key (string-append (lp role) "|" transcript))))

+88

+89

(define (pairing-make-identity generation . maybe-created)

+90

(let* ((kp (pairing-generate-keypair))

+91

(public (dict-ref kp public-key: "")))

+92

#{ version: 1 key-id: (substring (sha256 public) 0 24)

+93

generation: generation

+94

private-key: (dict-ref kp private-key: "") public-key: public

+95

;; current-second is inexact in the native runtime. Persistent

+96

;; generations require an integer timestamp, just like decoded JSON.

+97

created: (if (pair? maybe-created) (car maybe-created)

+98

(exact (floor (current-second)))) }))

+99

+100

(define (pairing-identity-valid? record)

+101

(and (dict? record) (= (dict-ref record version: 0) 1)

+102

(nonempty-string? (dict-ref record key-id: #f))

+103

(natural? (dict-ref record generation: #f))

+104

(natural? (dict-ref record created: #f))

+105

(encoded-key? (dict-ref record private-key: #f) 32 #f)

+106

(public-key-valid? (dict-ref record public-key: #f))

+107

(string=? (dict-ref record key-id: "")

+108

(substring (sha256 (dict-ref record public-key: "")) 0 24))

+109

(let* ((private (dict-ref record private-key: ""))

+110

(public (dict-ref record public-key: ""))

+111

(probe "slate-node-pairing-identity-check")

+112

(signature (guard (e (#t #f)) (pairing-sign private probe))))

+113

(and signature (pairing-verify? public probe signature)))))

+114

+115

(define (safe-endpoint? endpoint)

+116

(and (nonempty-string? endpoint)

+117

(or (starts-with? endpoint "ws://") (starts-with? endpoint "wss://"))

+118

(not (string-contains? endpoint "0.0.0.0"))

+119

(not (string-contains? endpoint "[::]"))

+120

(not (string-contains? endpoint "localhost"))

+121

(not (string-contains? endpoint "127.0.0.1"))

+122

(not (string-contains? endpoint "[::1]"))))

+123

+124

(define (sequence->list value)

+125

(cond ((list? value) value) ((array? value) (array->list value)) (else #f)))

+126

+127

(define (normalize-record record)

+128

(let ((endpoints (and (dict? record)

+129

(sequence->list (dict-ref record endpoints: #f)))))

+130

(and endpoints (dict-set record endpoints: endpoints))))

+131

+132

(define (pairing-record-valid? record)

+133

(and (dict? record)

+134

(nonempty-string? (dict-ref record bot-id: #f))

+135

(nonempty-string? (dict-ref record transport-nick: #f))

+136

(nonempty-string? (dict-ref record peer-key-id: #f))

+137

(natural? (dict-ref record peer-generation: #f))

+138

(public-key-valid? (dict-ref record peer-public-key: #f))

+139

(sequence->list (dict-ref record endpoints: #f))

+140

(every safe-endpoint? (sequence->list (dict-ref record endpoints: '())))

+141

(natural? (dict-ref record created: #f))

+142

(boolean? (dict-ref record revoked: #f))))

+143

+144

;; Values are: identical, newer, stale, or conflict. A key change at the

+145

;; same generation is never selected silently.

+146

(define (pairing-record-relation old new)

+147

(cond

+148

((or (not (pairing-record-valid? old)) (not (pairing-record-valid? new))) 'invalid)

+149

((not (string=? (dict-ref old bot-id: "") (dict-ref new bot-id: ""))) 'different)

+150

((< (dict-ref new peer-generation: 0) (dict-ref old peer-generation: 0)) 'stale)

+151

((> (dict-ref new peer-generation: 0) (dict-ref old peer-generation: 0)) 'newer)

+152

((and (string=? (dict-ref old peer-key-id: "") (dict-ref new peer-key-id: ""))

+153

(string=? (dict-ref old peer-public-key: "")

+154

(dict-ref new peer-public-key: ""))) 'identical)

+155

(else 'conflict)))

+156

+157

(define (pairing-record-merge records record)

+158

(and (pairing-record-valid? record)

+159

(let loop ((rest records) (out '()) (found #f))

+160

(if (null? rest)

+161

(reverse (if found out (cons record out)))

+162

(let ((old (car rest)))

+163

(if (string=? (dict-ref old bot-id: "") (dict-ref record bot-id: ""))

+164

(case (pairing-record-relation old record)

+165

((identical) (loop (cdr rest) (cons old out) #t))

+166

((newer) (loop (cdr rest) (cons record out) #t))

+167

(else #f))

+168

(loop (cdr rest) (cons old out) found)))))))

+169

+170

(define (pairing-record-find records identity)

+171

(let loop ((rest records))

+172

(and (pair? rest)

+173

(let ((record (car rest)))

+174

(if (and (pairing-record-valid? record)

+175

(not (dict-ref record revoked: #t))

+176

(or (equal? identity (dict-ref record bot-id: #f))

+177

(equal? identity (dict-ref record transport-nick: #f))))

+178

record

+179

(loop (cdr rest)))))))

+180

+181

(define (pairing-identity-path state-dir)

+182

(path-join state-dir "node-direct-identity.json"))

+183

(define (pairing-records-path state-dir)

+184

(path-join state-dir "node-direct-pairings.json"))

+185

+186

(define (pairing-require-mode! target mode

+187

(keys: (exists? command-exists?) (run process-run)))

+188

(unless (exists? "chmod") (error "node pairing: chmod is required" target))

+189

(let ((rc (guard (e (#t 1)) (run "chmod" mode target))))

+190

(unless (and (integer? rc) (= rc 0))

+191

(error "node pairing: could not secure state path" target))))

+192

+193

(define (atomic-save! state-dir path value)

+194

(let ((tmp (string-append path ".tmp")))

+195

(ensure-directory state-dir)

+196

(pairing-require-mode! state-dir "700")

+197

(write-file-string tmp "")

+198

(guard (e (#t (when (file-exists? tmp) (delete-file tmp)) (raise e)))

+199

(pairing-require-mode! tmp "600")

+200

(write-file-string tmp (json-encode value))

+201

(pairing-require-mode! tmp "600")

+202

(rename-file tmp path)

+203

(pairing-require-mode! path "600")

+204

path)))

+205

+206

(define (pairing-save-identity! state-dir identity)

+207

(unless (pairing-identity-valid? identity) (error "node pairing: invalid identity"))

+208

(atomic-save! state-dir (pairing-identity-path state-dir) identity))

+209

(define (pairing-load-identity state-dir)

+210

(let ((path (pairing-identity-path state-dir)))

+211

(and (file-exists? path)

+212

(guard (e (#t #f))

+213

(decode-identity (read-file-string path))))))

+214

+215

(define (decode-identity text)

+216

(let ((record (json-decode text)))

+217

(and (pairing-identity-valid? record) record)))

+218

+219

(define (records-valid? records)

+220

(and (list? records) (every pairing-record-valid? records)

+221

(let loop ((rest records) (seen '()))

+222

(or (null? rest)

+223

(let* ((r (car rest))

+224

(key (dict-ref r bot-id: "")))

+225

(and (not (member key seen))

+226

(loop (cdr rest) (cons key seen))))))))

+227

(define (pairing-save-records! state-dir records)

+228

(unless (records-valid? records) (error "node pairing: invalid pairing records"))

+229

(atomic-save! state-dir (pairing-records-path state-dir)

+230

#{ version: 1 pairings: records }))

+231

(define (pairing-load-records state-dir)

+232

(let ((path (pairing-records-path state-dir)))

+233

(if (not (file-exists? path)) '()

+234

(guard (e (#t #f))

+235

(decode-records (read-file-string path))))))

+236

+237

(define (decode-records text)

+238

(let* ((root (json-decode text))

+239

(raw (sequence->list (dict-ref root pairings: #f)))

+240

(records (and raw (map normalize-record raw))))

+241

(and (= (dict-ref root version: 0) 1)

+242

(records-valid? records)

+243

records)))

+244

+245

;; A reader retains only its last successfully validated snapshot. Always

+246

;; re-read the file: mtime equality can miss same-second revocations. Exact

+247

;; contents equality avoids repeating P-256 checks on unchanged state.

+248

;; Missing, unreadable, or invalid data discards the snapshot; no caller can

+249

;; seed the cache with an unvalidated record.

+250

(define (make-pairing-file-reader path decode missing)

+251

(let ((cached-text #f)

+252

(cached-value #f))

+253

(define (invalidate!)

+254

(set! cached-text #f)

+255

(set! cached-value #f))

+256

(lambda ()

+257

(guard (e (#t

+258

(invalidate!)

+259

#f))

+260

(if (file-exists? path)

+261

(let ((text (read-file-string path)))

+262

(if (and cached-text (string=? text cached-text))

+263

cached-value

+264

(begin

+265

(invalidate!)

+266

(let ((value (decode text)))

+267

(when value

+268

(set! cached-value value)

+269

(set! cached-text text))

+270

value))))

+271

(begin

+272

(invalidate!)

+273

missing))))))

+274

+275

(define (make-pairing-identity-reader state-dir)

+276

(make-pairing-file-reader

+277

(pairing-identity-path state-dir) decode-identity #f))

+278

+279

(define (make-pairing-records-reader state-dir)

+280

(make-pairing-file-reader

+281

(pairing-records-path state-dir) decode-records '()))

+282

+283

;; Safe for logs/status: deliberately reconstruct instead of subtracting

+284

;; known secret names from a potentially extended record.

+285

(define (pairing-public-summary record)

+286

(if (pairing-identity-valid? record)

+287

#{ version: 1 key-id: (dict-ref record key-id: "")

+288

generation: (dict-ref record generation: 0)

+289

created: (dict-ref record created: 0) }

+290

#{ bot-id: (dict-ref record bot-id: "")

+291

transport-nick: (dict-ref record transport-nick: "")

+292

peer-key-id: (dict-ref record peer-key-id: "")

+293

peer-generation: (dict-ref record peer-generation: 0)

+294

revoked: (dict-ref record revoked: #t) }))))

packages/slate-cli/src/slate-cli/persistent.sgladded

@@ -0,0 +1,527 @@

+1

;;; Persistent local-node installation for Android/Termux and desktop Unix.

+2

;;;

+3

;;; This deliberately owns only the persistent local node lifecycle. It is

+4

;;; not a transport manager and does not register or dial remote nodes.

+5

(define-library (slate-cli persistent)

+6

(import (sigil core) (sigil string) (sigil fs) (sigil path) (sigil process)

+7

(sigil json)

+8

(slate-cli config)

+9

(slate-cli node-posture))

+10

(export run-persistent-install! run-persistent-command!

+11

;; Pure/generated seams used by the persistent-install tests.

+12

persistent-root-dir persistent-service-script

+13

persistent-control-script persistent-boot-script

+14

persistent-launcher-script

+15

persistent-openbsd-rc-script

+16

persistent-install-source

+17

persistent-app-url persistent-status-schema

+18

persistent-status-from-observations persistent-runtime-status

+19

persistent-fallback-status persistent-status-json)

+20

(begin

+21

(define slate-version local-node-version)

+22

+23

(define (env-required name message)

+24

(let ((v (getenv name)))

+25

(if (and v (> (string-length v) 0)) v

+26

(begin (display (string-append "slate node: " message "\n")) (exit 2)))))

+27

+28

(define (termux-home)

+29

(or (getenv "SLATE_PERSIST_ROOT")

+30

(env-required "HOME" "HOME is not set")))

+31

+32

(define (termux-prefix)

+33

(or (getenv "SLATE_TERMUX_PREFIX")

+34

(env-required "PREFIX" "--persistent is supported only in Termux (PREFIX is not set)")))

+35

+36

(define (termux-environment?)

+37

(or (getenv "TERMUX_VERSION") (getenv "SLATE_TERMUX_PREFIX")))

+38

+39

(define (openbsd-environment?)

+40

(or (getenv "SLATE_OPENBSD_RC")

+41

(file-exists? "/etc/rc.d/rc.subr")))

+42

+43

(define (root-dir) (path-join (termux-home) ".local" "share" "slate" "node"))

+44

(define (bin-dir) (path-join (termux-home) ".local" "bin"))

+45

(define (control-path) (path-join (bin-dir) "slate-service"))

+46

(define (service-dir) (path-join (termux-prefix) "var" "service" "slate"))

+47

(define (boot-path) (path-join (termux-home) ".termux" "boot" "20-slate"))

+48

(define (version-dir) (path-join (root-dir) "versions" slate-version))

+49

(define (installed-binary) (path-join (version-dir) "slate"))

+50

+51

;; Stable CLI path. Version directories remain the atomic upgrade unit,

+52

;; while shells and service definitions never need a release-specific path.

+53

(define (launcher-script)

+54

(string-append

+55

"#!/bin/sh\nset -eu\n"

+56

"ROOT=" (quoted (root-dir)) "\n"

+57

"version=$(cat \"$ROOT/active\")\n"

+58

"case \"$version\" in ''|*[!A-Za-z0-9._-]*) echo 'slate: invalid active version' >&2; exit 70;; esac\n"

+59

"binary=\"$ROOT/versions/$version/slate\"\n"

+60

"[ -x \"$binary\" ] || { echo \"slate: active binary is unavailable: $binary\" >&2; exit 70; }\n"

+61

"exec \"$binary\" \"$@\"\n"))

+62

+63

(define (persistent-launcher-script) (launcher-script))

+64

+65

;; OpenBSD has one system rc.d graph, but rc.subr can drop the daemon to an

+66

;; ordinary login user. Launch through Slate's stable command so atomic

+67

;; version switches need no service-file edit; pexp follows the executable

+68

;; after the launcher execs the selected version.

+69

(define (persistent-openbsd-rc-script home user)

+70

(let ((stable (path-join home ".local" "bin" "slate"))

+71

(versions (path-join home ".local" "share" "slate" "node" "versions")))

+72

(string-append

+73

"#!/bin/ksh\n\n"

+74

"daemon=" (quoted stable) "\n"

+75

"daemon_flags=\"--log-level info node run\"\n"

+76

"daemon_user=" (quoted user) "\n"

+77

"daemon_execdir=" (quoted home) "\n"

+78

"daemon_logger=\"daemon.info\"\n"

+79

"rc_bg=YES\n"

+80

"pexp=\"" versions "/.*/slate --log-level info node run\"\n\n"

+81

". /etc/rc.d/rc.subr\n\n"

+82

"rc_cmd $1\n")))

+83

+84

(define (persistent-status-from-observations o)

+85

(let* ((installed (dict-ref o installed: #f))

+86

(pid (dict-ref o pid: #f))

+87

(pid-live (dict-ref o pid-live: #f))

+88

(boot (dict-ref o boot-configured: #f))

+89

(url (dict-ref o app-url: "https://useslate.org"))

+90

(platform-kind (dict-ref o platform-kind: "linux-desktop"))

+91

(environment (dict-ref o environment: "native"))

+92

(supervision-kind (dict-ref o supervision-kind: "none"))

+93

(autostart-posture

+94

(dict-ref o autostart-posture: (if boot "configured" "not-configured"))))

+95

#{ schema-version: 3

+96

identity: (local-node-identity)

+97

capability-posture: (local-node-capability-posture)

+98

upgrade: (local-node-upgrade-posture platform-kind environment installed

+99

(dict-ref o latest-version: #f))

+100

platform: #{ kind: platform-kind environment: environment }

+101

installation: #{ installed: installed

+102

posture: (if installed "installed" "not-installed") }

+103

supervision: #{ kind: supervision-kind

+104

available: (dict-ref o supervisor-available: #f)

+105

running: (dict-ref o supervisor-running: #f) }

+106

persistence: #{ installed: installed

+107

posture: (if installed "installed" "not-installed") }

+108

supervisor: #{ available: (dict-ref o supervisor-available: #f)

+109

running: (dict-ref o supervisor-running: #f) }

+110

process: #{ pid: pid live: pid-live

+111

pid-state: (cond ((not pid) "absent")

+112

(pid-live "exact")

+113

(else "stale")) }

+114

health: #{ healthy: (dict-ref o healthy: #f)

+115

url: "http://127.0.0.1:32640/node/health" }

+116

listener: #{ healthy: (dict-ref o healthy: #f)

+117

url: "http://127.0.0.1:32640/node/health" }

+118

app: #{ url: url

+119

selection: (cond ((string=? url "https://useslate.org") "production")

+120

((string=? url "https://next.useslate.org") "staging")

+121

(else "custom")) }

+122

boot: #{ configured: boot }

+123

autostart: #{ configured: boot posture: autostart-posture }

+124

lifecycle: #{ state: (dict-ref o lifecycle-state: "missing")

+125

last-start: (dict-ref o last-start: #f)

+126

last-exit: (dict-ref o last-exit: #f)

+127

restart-count: (dict-ref o restart-count: 0) }

+128

wake-lock: #{ choice: (dict-ref o wake-lock: "disabled") }

+129

platform-details:

+130

(if (string=? environment "termux")

+131

#{ termux: #{ boot-configured: boot

+132

wake-lock: (dict-ref o wake-lock: "disabled")

+133

android-persistence-posture:

+134

(if boot "user-managed" "unknown")

+135

autostart: "unknown" background: "unknown"

+136

battery-exemption: "unknown" } }

+137

#{ desktop: #{ service-manager: supervision-kind

+138

autostart-posture: autostart-posture } })

+139

android: #{ persistence-posture:

+140

(if (and (string=? environment "termux") boot)

+141

"user-managed" "unknown")

+142

autostart: "unknown" background: "unknown"

+143

battery-exemption: "unknown" } }))

+144

+145

(define (persistent-status-schema)

+146

(persistent-status-from-observations #{}))

+147

+148

;; The CLI can be installed independently of Termux's generated control

+149

;; script (notably when a desktop package is supervised by Shepherd). Its

+150

;; read-only fallback must describe the host it is actually running on;

+151

;; the absence of slate-service is not evidence that the host is Android.

+152

(define (persistent-fallback-status)

+153

(let ((termux? (termux-environment?)))

+154

(persistent-status-from-observations

+155

#{ platform-kind: (if termux? "android" "desktop")

+156

environment: (if termux? "termux" "native")

+157

supervision-kind: (if termux? "runit" "none") })))

+158

+159

(define (read-optional path)

+160

(and (file-exists? path)

+161

(guard (e (#t #f)) (string-trim (read-file-string path)))))

+162

+163

(define (natural-or-false value)

+164

(and value

+165

(> (string-length value) 0)

+166

(let ((n (string->number value)))

+167

(and n (integer? n) (>= n 0) n))))

+168

+169

;; A service manager declares itself to the child. Inferring supervision

+170

;; from PPID or process names is racy and breaks across Shepherd versions.

+171

;; Unknown values fail closed to the ordinary foreground posture.

+172

(define (desktop-supervision-kind)

+173

(let ((kind (getenv "SLATE_SUPERVISION")))

+174

(and kind (member kind '("shepherd" "systemd" "launchd")) kind)))

+175

+176

(define (desktop-autostart-configured?)

+177

(string=? (or (getenv "SLATE_AUTOSTART") "") "configured"))

+178

+179

;; Runtime view used by the loopback HTTP surface. Foreground desktop

+180

;; nodes are healthy nodes even though they have no persistent supervisor;

+181

;; Termux contributes its runit/boot vocabulary without shaping the common

+182

;; contract. Persistent lifecycle files remain optional observations.

+183

(define (persistent-runtime-status healthy?)

+184

(let* ((termux? (or (getenv "TERMUX_VERSION")

+185

(getenv "SLATE_TERMUX_PREFIX")))

+186

(desktop-supervision (and (not termux?)

+187

(desktop-supervision-kind)))

+188

(desktop-autostart (and desktop-supervision

+189

(desktop-autostart-configured?)))

+190

(home (or (getenv "SLATE_PERSIST_ROOT") (getenv "HOME")))

+191

(root (and home (path-join home ".local" "share" "slate" "node")))

+192

(life (and root (path-join root "lifecycle")))

+193

(active (and root (read-optional (path-join root "active"))))

+194

(installed (and active

+195

(file-exists? (path-join root "versions" active "slate"))))

+196

(boot (and termux? home

+197

(file-exists? (path-join home ".termux" "boot" "20-slate"))))

+198

(pid-text (and life (read-optional (path-join life "child.pid"))))

+199

(pid (natural-or-false pid-text))

+200

(pid-valid? (or (not pid-text) pid))

+201

(last-start (and life (read-optional (path-join life "last-start-at"))))

+202

(last-reason (and life (read-optional (path-join life "last-exit-reason"))))

+203

(last-at (and life (read-optional (path-join life "last-exit-at"))))

+204

(last-observed

+205

(and life (read-optional (path-join life "last-exit-observed-at"))))

+206

(last-status-text

+207

(and life (read-optional (path-join life "last-exit-status"))))

+208

(last-status (natural-or-false last-status-text))

+209

(restart-text (and life (read-optional (path-join life "restart-count"))))

+210

(restart-count (or (natural-or-false restart-text) 0))

+211

(corrupt? (or (not pid-valid?)

+212

(and restart-text (not (natural-or-false restart-text)))

+213

(and last-status-text (not last-status))

+214

(and last-reason (not (or last-at last-observed)))))

+215

(last-exit (and last-reason

+216

#{ at: last-at observed-at: last-observed

+217

status: last-status reason: last-reason }))

+218

(exact-child? (and pid (= pid (process-id)))))

+219

(persistent-status-from-observations

+220

#{ platform-kind: (if termux? "android" "desktop")

+221

environment: (if termux? "termux" "native")

+222

installed: installed

+223

supervision-kind: (cond (termux? "runit")

+224

(desktop-supervision desktop-supervision)

+225

(else "none"))

+226

supervisor-available: (if termux?

+227

(command-exists? "sv")

+228

(if desktop-supervision #t #f))

+229

supervisor-running: (if termux?

+230

exact-child?

+231

(if desktop-supervision #t #f))

+232

pid: (or pid (process-id)) pid-live: (if pid exact-child? #t)

+233

healthy: healthy?

+234

app-url: (or (and root (read-optional (path-join root "app-upstream")))

+235

"https://useslate.org")

+236

boot-configured: (if termux? boot desktop-autostart)

+237

wake-lock: (if (and root (file-exists? (path-join root "wake-lock-enabled")))

+238

"enabled" "disabled")

+239

autostart-posture: (if (if termux? boot desktop-autostart)

+240

"configured" "not-configured")

+241

lifecycle-state: (cond (corrupt? "corrupt")

+242

((and life (file-exists? life)) "valid")

+243

(else "missing"))

+244

last-start: last-start last-exit: last-exit

+245

restart-count: restart-count })))

+246

+247

(define (persistent-status-json status)

+248

(json-encode status))

+249

+250

(define (persistent-root-dir) (root-dir))

+251

+252

(define (quoted s)

+253

;; Generated paths come from HOME/PREFIX. Refuse the one byte that would

+254

;; make single-quoted shell data executable rather than trying to be clever.

+255

(if (string-contains? s "'")

+256

(begin (display "slate node: HOME/PREFIX containing a quote is unsupported\n") (exit 2))

+257

(string-append "'" s "'")))

+258

+259

(define (write-executable! path content)

+260

(ensure-directory (path-dirname path))

+261

(let ((tmp (string-append path ".tmp")))

+262

(write-file-string tmp content)

+263

(unless (= (process-run "chmod" "700" tmp) 0)

+264

(error "could not secure generated executable" tmp))

+265

(rename-file tmp path)))

+266

+267

;; Native bundles already expose the platform-correct executable path

+268

;; (including macOS, where /proc/self/exe does not exist). The override is

+269

;; retained for package managers and for upgrading a running service from a

+270

;; separately staged artifact.

+271

(define (persistent-install-source)

+272

(let ((override (getenv "SLATE_PERSIST_EXECUTABLE")))

+273

(or (and override (> (string-length override) 0) override)

+274

(guard (e (#t #f)) (executable-path))

+275

"/proc/self/exe")))

+276

+277

(define (copy-self!)

+278

(ensure-directory (version-dir))

+279

(let* ((source (persistent-install-source))

+280

(tmp (string-append (installed-binary) ".tmp")))

+281

(unless (file-exists? source)

+282

(error "Slate executable is unavailable" source))

+283

(guard (e (#t (error "could not install Slate binary" source tmp)))

+284

(copy-file source tmp))

+285

;; Some platform copy backends report success after a missing source;

+286

;; never continue into chmod/rename with an absent temporary file.

+287

(unless (file-exists? tmp)

+288

(error "could not install Slate binary" source tmp))

+289

;; Android's copy primitive does not preserve the source mode (the

+290

;; desktop implementation currently does), so make executability an

+291

;; explicit, checked part of the atomic install on every platform.

+292

(unless (= (process-run "chmod" "700" tmp) 0)

+293

(error "could not secure Slate binary" tmp))

+294

(rename-file tmp (installed-binary))

+295

(write-file-string (string-append (root-dir) "/active.tmp") slate-version)

+296

(rename-file (string-append (root-dir) "/active.tmp") (path-join (root-dir) "active"))))

+297

+298

(define (service-script)

+299

(string-append

+300

"#!" (termux-prefix) "/bin/sh\n"

+301

"set -u\nROOT=" (quoted (root-dir)) "\n"

+302

"PREFIX=" (quoted (termux-prefix)) "\n"

+303

"export XDG_STATE_HOME=\"$ROOT/state\" XDG_CACHE_HOME=\"$ROOT/cache\"\n"

+304

"export SSL_CERT_FILE=\"${SSL_CERT_FILE:-$PREFIX/etc/tls/cert.pem}\"\n"

+305

"LIFE=\"$ROOT/lifecycle\"\nmkdir -p \"$LIFE\"\n"

+306

"atomic() { p=$1; shift; t=\"$p.tmp.$$\"; printf '%s\\n' \"$*\" >\"$t\" && mv \"$t\" \"$p\"; }\n"

+307

"count=$(cat \"$LIFE/restart-count\" 2>/dev/null || printf 0)\ncase \"$count\" in ''|*[!0-9]*) count=0;; esac\n"

+308

"prior=$(cat \"$LIFE/child.pid\" 2>/dev/null || true)\n"

+309

        "case \"$prior\" in ''|*[!0-9]*) ;; *) if ! kill -0 \"$prior\" 2>/dev/null; then count=$((count + 1)); atomic \"$LIFE/restart-count\" \"$count\"; atomic \"$LIFE/last-exit-observed-at\" \"$(date -Iseconds)\"; atomic \"$LIFE/last-exit-reason\" unclean-supervisor-recovery; rm -f \"$LIFE/last-exit-at\" \"$LIFE/last-exit-status\"; fi;; esac\n"

+310

"delay=1\nchild=\n"

+311

"stop_child() {\n"

+312

" trap - TERM INT HUP\n"

+313

        "  if [ -n \"$child\" ] && kill -0 \"$child\" 2>/dev/null; then kill \"$child\"; wait \"$child\" 2>/dev/null; rc=$?; atomic \"$LIFE/last-exit-at\" \"$(date -Iseconds)\"; atomic \"$LIFE/last-exit-status\" \"$rc\"; atomic \"$LIFE/last-exit-reason\" stop-requested; rm -f \"$LIFE/last-exit-observed-at\"; fi\n"

+314

" rm -f \"$LIFE/child.pid\"\n"

+315

" exit 0\n"

+316

"}\n"

+317

"trap stop_child TERM INT HUP\n"

+318

"while :; do\n"

+319

" version=$(cat \"$ROOT/active\") || exit 70\n"

+320

" upstream=$(cat \"$ROOT/app-upstream\" 2>/dev/null || printf '%s' https://useslate.org)\n"

+321

        "  \"$ROOT/versions/$version/slate\" node run --host 127.0.0.1 --port 32640 --app-upstream \"$upstream\" --log \"$ROOT/log/slate.log\" >>\"$ROOT/log/service-output.log\" 2>&1 &\n"

+322

" child=$!\n"

+323

" atomic \"$LIFE/child.pid\" \"$child\"\n"

+324

" atomic \"$LIFE/last-start-at\" \"$(date -Iseconds)\"\n"

+325

" wait \"$child\"; rc=$?; child=\n"

+326

" rm -f \"$LIFE/child.pid\"\n"

+327

" atomic \"$LIFE/last-exit-at\" \"$(date -Iseconds)\"\n"

+328

" atomic \"$LIFE/last-exit-status\" \"$rc\"\n"

+329

" atomic \"$LIFE/last-exit-reason\" exited\n"

+330

" rm -f \"$LIFE/last-exit-observed-at\"\n"

+331

" count=$((count + 1)); atomic \"$LIFE/restart-count\" \"$count\"\n"

+332

        "  printf '%s exit=%s restart-delay=%s\\n' \"$(date -Iseconds)\" \"$rc\" \"$delay\" >>\"$ROOT/log/supervisor.log\"\n"

+333

" sleep \"$delay\"\n"

+334

" if [ \"$delay\" -lt 30 ]; then delay=$((delay * 2)); [ \"$delay\" -le 30 ] || delay=30; fi\n"

+335

"done\n"))

+336

+337

(define (control-script)

+338

(string-append

+339

"#!" (termux-prefix) "/bin/sh\nset -u\n"

+340

"ROOT=" (quoted (root-dir)) "\nPREFIX=" (quoted (termux-prefix)) "\n"

+341

"export SVDIR=\"$PREFIX/var/service\"\n"

+342

"SERVICE=slate\nURL=http://127.0.0.1:32640/node/health\n"

+343

"health() { curl -fsS --max-time 2 \"$URL\" >/dev/null 2>&1; }\n"

+344

"running() { sv status \"$SERVICE\" 2>/dev/null | grep -q '^run:'; }\n"

+345

"json_string() { printf '%s' \"$1\" | tr '\\r\\n' ' ' | sed 's/[\\\\\"]/\\\\&/g'; }\n"

+346

"status_json() {\n"

+347

        " installed=false; active=$(cat \"$ROOT/active\" 2>/dev/null || true); [ -n \"$active\" ] && [ -x \"$ROOT/versions/$active/slate\" ] && installed=true\n"

+348

        " available=false; command -v sv >/dev/null 2>&1 && [ -x \"$PREFIX/var/service/$SERVICE/run\" ] && available=true\n"

+349

" supervised=false; [ \"$available\" = true ] && running && supervised=true\n"

+350

" pid=null; live=false; pidstate=absent; life=missing; corrupt=false\n"

+351

" [ -d \"$ROOT/lifecycle\" ] && life=valid\n"

+352

        " if [ -f \"$ROOT/lifecycle/child.pid\" ]; then p=$(cat \"$ROOT/lifecycle/child.pid\" 2>/dev/null); case \"$p\" in ''|*[!0-9]*) pidstate=invalid; corrupt=true;; *) pid=$p; if kill -0 \"$p\" 2>/dev/null; then live=true; pidstate=exact; else pidstate=stale; fi;; esac; fi\n"

+353

" healthy=false; health && healthy=true\n"

+354

        " upstream=$(cat \"$ROOT/app-upstream\" 2>/dev/null || printf '%s' https://useslate.org); selection=custom; [ \"$upstream\" = https://useslate.org ] && selection=production; [ \"$upstream\" = https://next.useslate.org ] && selection=staging\n"

+355

" boot=false; [ -x " (quoted (boot-path)) " ] && boot=true\n"

+356

        " start=null; if [ -f \"$ROOT/lifecycle/last-start-at\" ]; then v=$(cat \"$ROOT/lifecycle/last-start-at\"); [ -n \"$v\" ] && start=\"\\\"$(json_string \"$v\")\\\"\" || corrupt=true; fi\n"

+357

        " restart=0; if [ -f \"$ROOT/lifecycle/restart-count\" ]; then restart=$(cat \"$ROOT/lifecycle/restart-count\"); case \"$restart\" in ''|*[!0-9]*) restart=0; corrupt=true;; esac; fi\n"

+358

        " lastexit=null; if [ -f \"$ROOT/lifecycle/last-exit-reason\" ]; then reason=$(cat \"$ROOT/lifecycle/last-exit-reason\" 2>/dev/null); at=null; observed=null; rc=null; if [ -f \"$ROOT/lifecycle/last-exit-at\" ]; then v=$(cat \"$ROOT/lifecycle/last-exit-at\"); [ -n \"$v\" ] && at=\"\\\"$(json_string \"$v\")\\\"\" || corrupt=true; fi; if [ -f \"$ROOT/lifecycle/last-exit-observed-at\" ]; then v=$(cat \"$ROOT/lifecycle/last-exit-observed-at\"); [ -n \"$v\" ] && observed=\"\\\"$(json_string \"$v\")\\\"\" || corrupt=true; fi; if [ -f \"$ROOT/lifecycle/last-exit-status\" ]; then rc=$(cat \"$ROOT/lifecycle/last-exit-status\"); case \"$rc\" in ''|*[!0-9]*) rc=null; corrupt=true;; esac; fi; [ -n \"$reason\" ] && { [ \"$at\" != null ] || [ \"$observed\" != null ]; } && lastexit=\"{\\\"at\\\":$at,\\\"observed-at\\\":$observed,\\\"status\\\":$rc,\\\"reason\\\":\\\"$(json_string \"$reason\")\\\"}\" || corrupt=true; fi\n"

+359

" [ \"$corrupt\" = true ] && life=corrupt\n"

+360

" wake=disabled; [ -f \"$ROOT/wake-lock-enabled\" ] && wake=enabled\n"

+361

" posture=unknown; [ \"$boot\" = true ] && posture=user-managed\n"

+362

" [ \"$installed\" = true ] && installposture=installed || installposture=not-installed\n"

+363

        " printf '{\"schema-version\":3,\"identity\":{\"role\":\"local-node\",\"scope\":\"local-device\"},\"capability-posture\":{\"resource\":{\"available\":true,\"operations\":[\"fs\",\"proc\",\"sys\"]},\"session\":{\"available\":true,\"operations\":[\"terminal\"]},\"agent\":{\"available\":true,\"operations\":[\"agent\"]},\"renderer\":{\"available\":true,\"same-origin\":true},\"upgrade\":{\"available\":true,\"operations\":[\"check\"],\"apply-available\":false},\"remote-transport-manager\":{\"available\":false,\"reason\":\"not-implemented\"}},\"upgrade\":{\"current-version\":\"" slate-version "\",\"available-version\":false,\"state\":\"not-checked\",\"check\":{\"available\":true,\"endpoint\":\"/node/api/version\"},\"apply\":{\"available\":false,\"reason\":\"not-implemented\"},\"rollback\":{\"available\":false,\"reason\":\"not-implemented\"},\"installation\":{\"strategy\":\"atomic-version-directory\",\"platform\":\"android\",\"environment\":\"termux\"}},\"platform\":{\"kind\":\"android\",\"environment\":\"termux\"},\"installation\":{\"installed\":%s,\"posture\":\"%s\"},\"supervision\":{\"kind\":\"runit\",\"available\":%s,\"running\":%s},\"persistence\":{\"installed\":%s,\"posture\":\"%s\"},\"supervisor\":{\"available\":%s,\"running\":%s},\"process\":{\"pid\":%s,\"live\":%s,\"pid-state\":\"%s\"},\"health\":{\"healthy\":%s,\"url\":\"%s\"},\"listener\":{\"healthy\":%s,\"url\":\"%s\"},\"app\":{\"url\":\"%s\",\"selection\":\"%s\"},\"boot\":{\"configured\":%s},\"autostart\":{\"configured\":%s,\"posture\":\"%s\"},\"lifecycle\":{\"state\":\"%s\",\"last-start\":%s,\"last-exit\":%s,\"restart-count\":%s},\"wake-lock\":{\"choice\":\"%s\"},\"platform-details\":{\"termux\":{\"boot-configured\":%s,\"wake-lock\":\"%s\",\"android-persistence-posture\":\"%s\",\"autostart\":\"unknown\",\"background\":\"unknown\",\"battery-exemption\":\"unknown\"}},\"android\":{\"persistence-posture\":\"%s\",\"autostart\":\"unknown\",\"background\":\"unknown\",\"battery-exemption\":\"unknown\"}}\\n' \"$installed\" \"$installposture\" \"$available\" \"$supervised\" \"$installed\" \"$installposture\" \"$available\" \"$supervised\" \"$pid\" \"$live\" \"$pidstate\" \"$healthy\" \"$URL\" \"$healthy\" \"$URL\" \"$(json_string \"$upstream\")\" \"$selection\" \"$boot\" \"$boot\" \"$([ \"$boot\" = true ] && printf configured || printf not-configured)\" \"$life\" \"$start\" \"$lastexit\" \"$restart\" \"$wake\" \"$boot\" \"$wake\" \"$posture\" \"$posture\"\n"

+364

"}\n"

+365

"case \"${1:-}\" in\n"

+366

        " start) sv up \"$SERVICE\" || exit $?; i=0; while [ $i -lt 30 ]; do health && exit 0; i=$((i+1)); sleep 1; done; echo 'slate-service: loopback health check timed out' >&2; exit 1;;\n"

+367

        " stop) sv down \"$SERVICE\" || exit $?; i=0; while running || [ -f \"$ROOT/lifecycle/child.pid\" ]; do i=$((i+1)); [ \"$i\" -lt 30 ] || { echo 'slate-service: supervisor stop timed out' >&2; exit 1; }; sleep 1; done;;\n"

+368

" restart) sv restart \"$SERVICE\" || exit $?; \"$0\" start;;\n"

+369

        " status) sv status \"$SERVICE\"; if health; then echo 'loopback health: ok'; else echo 'loopback health: unavailable'; exit 1; fi;;\n"

+370

" status-json) status_json;;\n"

+371

" health) health;;\n"

+372

" running) running;;\n"

+373

        " logs) tail -n 200 \"$ROOT/log/slate.log\" \"$ROOT/log/supervisor.log\" \"$ROOT/log/service-output.log\" 2>/dev/null;;\n"

+374

" *) echo 'usage: slate-service start|stop|restart|status|logs' >&2; exit 2;;\n"

+375

"esac\n"))

+376

+377

(define (boot-script)

+378

(string-append

+379

"#!" (termux-prefix) "/bin/sh\n"

+380

"# Slate node: start supervision silently; never open a browser at boot.\n"

+381

"ROOT=" (quoted (root-dir)) "\n"

+382

"mkdir -p \"$ROOT/log\"\n"

+383

"printf '%s boot-invoked\\n' \"$(date -Iseconds)\" >>\"$ROOT/log/boot.log\"\n"

+384

". " (termux-prefix) "/etc/profile.d/start-services.sh\n"

+385

        "command -v termux-wake-lock >/dev/null 2>&1 && [ -f \"$HOME/.local/share/slate/node/wake-lock-enabled\" ] && termux-wake-lock\n"

+386

"i=0\n"

+387

"while ! sv status slate >/dev/null 2>&1; do\n"

+388

" i=$((i + 1))\n"

+389

        "  if [ \"$i\" -ge 30 ]; then printf '%s runit-readiness-timeout\\n' \"$(date -Iseconds)\" >>\"$ROOT/log/boot.log\"; exit 1; fi\n"

+390

" sleep 1\n"

+391

"done\n"

+392

"$HOME/.local/bin/slate-service start >>\"$ROOT/log/boot.log\" 2>&1\n"))

+393

+394

(define (persistent-service-script) (service-script))

+395

(define (persistent-control-script) (control-script))

+396

(define (persistent-boot-script) (boot-script))

+397

+398

(define (persistent-app-url requested)

+399

(let ((url (cond ((string=? requested "production") "https://useslate.org")

+400

((string=? requested "staging") "https://next.useslate.org")

+401

(else requested))))

+402

(and (>= (string-length url) 8)

+403

(string=? (substring url 0 8) "https://")

+404

url)))

+405

+406

(define (persistent-install-opts args)

+407

(let loop ((rest args) (persistent? #f) (name #f))

+408

(cond

+409

((null? rest) (and persistent? #{ name: name }))

+410

((string=? (car rest) "--persistent")

+411

(and (not persistent?) (loop (cdr rest) #t name)))

+412

((and (string=? (car rest) "--name") (pair? (cdr rest)) (not name))

+413

(loop (cddr rest) persistent? (cadr rest)))

+414

(else #f))))

+415

+416

(define (run-persistent-install! args)

+417

(let ((opts (persistent-install-opts args)))

+418

(unless opts

+419

(display "usage: slate node install --persistent [--name <node-name>]\n") (exit 2))

+420

(for-each ensure-directory (list (root-dir) (path-join (root-dir) "log")

+421

(path-join (root-dir) "state") (path-join (root-dir) "cache")))

+422

(let ((name (dict-ref opts name: #f))

+423

;; Termux deliberately contains all daemon state below its owned

+424

;; node root. Desktop nodes retain the ordinary XDG state location

+425

;; so an existing enrollment and pairings survive installation.

+426

(state-dir (if (termux-environment?)

+427

(path-join (root-dir) "state" "slate")

+428

(config-state-dir (make-config)))))

+429

(unless (or (not name) (valid-local-node-name? name))

+430

(display "slate node install: invalid node name\n") (exit 2))

+431

(local-node-ensure-name! state-dir name))

+432

(copy-self!)

+433

(write-executable! (path-join (bin-dir) "slate") (launcher-script))

+434

(if (termux-environment?)

+435

(begin

+436

(termux-prefix)

+437

(write-executable! (path-join (service-dir) "run") (service-script))

+438

(write-executable! (control-path) (control-script))

+439

(write-executable! (boot-path) (boot-script))

+440

(unless (and (command-exists? "sv") (command-exists? "curl"))

+441

              (display "Slate was installed, but termux-services and curl are required. Run: pkg install termux-services curl\n")

+442

(exit 1))

+443

;; An idempotent reinstall is also an upgrade: the old inode may

+444

;; still be running, so restart an active service and merely start

+445

;; a stopped/new one.

+446

(let ((verb (if (= (process-run (control-path) "running") 0) "restart" "start")))

+447

(unless (= (process-run (control-path) verb) 0) (exit 1)))

+448

(display "Slate node is supervised and healthy on http://127.0.0.1:32640/.\n")

+449

            (display "Termux:Boot: install it, open it once, and allow background execution. The boot entry is ready.\n")

+450

            (display "Android may still stop Termux; consider a battery-optimization exemption. Wake lock remains opt-in.\n")

+451

(when (command-exists? "termux-open-url")

+452

(process-run "termux-open-url" "http://127.0.0.1:32640/?install=1")))

+453

(if (openbsd-environment?)

+454

(let* ((user (or (getenv "USER") (getenv "LOGNAME") ""))

+455

(staged (path-join (root-dir) "slate_node.rc")))

+456

(when (or (string=? user "") (string=? user "root"))

+457

(display "slate node install: run OpenBSD nodes from a non-root login account\n")

+458

(exit 2))

+459

(unless (command-exists? "doas")

+460

(display "slate node install: OpenBSD service installation requires doas\n")

+461

(exit 1))

+462

(write-executable! staged (persistent-openbsd-rc-script (termux-home) user))

+463

(unless (= (process-run "doas" "install" "-o" "root" "-g" "wheel"

+464

"-m" "555" staged "/etc/rc.d/slate_node") 0)

+465

(error "could not install OpenBSD rc.d service"))

+466

(unless (= (process-run "doas" "rcctl" "enable" "slate_node") 0)

+467

(error "could not enable OpenBSD rc.d service"))

+468

;; Idempotent installation is an upgrade: restart when already

+469

;; running, otherwise perform the first start.

+470

(let ((verb (if (= (process-run "doas" "rcctl" "check" "slate_node") 0)

+471

"restart" "start")))

+472

(unless (= (process-run "doas" "rcctl" verb "slate_node") 0)

+473

(error "could not start OpenBSD rc.d service")))

+474

(display "Slate node is installed as OpenBSD service slate_node.\n"))

+475

(begin

+476

;; Guix Home is declarative. Installation owns the immutable-ish

+477

;; version directory and active marker, but never rewrites or

+478

;; reconfigures the user's service graph behind their back.

+479

(display (string-append "Slate node binary installed at " (installed-binary) "\n"))

+480

(display (string-append "Stable Slate command installed at "

+481

(path-join (bin-dir) "slate") "\n")))))))

+482

+483

(define (run-persistent-command! verb args)

+484

(unless (or (null? args)

+485

(and (string=? verb "app") (= (length args) 1))

+486

(and (string=? verb "status") (equal? args '("--json"))))

+487

(display (string-append "usage: slate node " verb "\n")) (exit 2))

+488

(cond

+489

((string=? verb "app")

+490

(unless (file-exists? (control-path))

+491

(display "slate node: persistent node is not installed\n") (exit 1))

+492

(when (= (process-run (control-path) "running") 0)

+493

(display "slate node app: stop the node before changing its served app\n") (exit 1))

+494

(let ((url (persistent-app-url (car args))))

+495

(unless url

+496

(display "slate node app: expected staging, production, or an https:// URL\n") (exit 2))

+497

(let ((tmp (string-append (root-dir) "/app-upstream.tmp")))

+498

(write-file-string tmp url)

+499

(rename-file tmp (path-join (root-dir) "app-upstream")))

Showing the first 500 of 528 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate-cli/src/slate-cli/proxy.sglmodified

@@ -29,7 +29,8 @@

29

(slate-cli config)

30

(slate-cli cache)

31

(slate-cli httpfetch)

−32

(slate-cli listen))

+32

(slate-cli listen)

+33

(slate-cli node-posture))

34

35

(export

36

;; main's HTTP router calls this for every non-/pair/ path.

@@ -48,10 +49,11 @@

49

50

(begin

51

−51

;; The CLI's own version + wire protocol (design §2.1). Kept in step

−52

;; with package.sgl by hand for now; a build-stamp is a follow-up.

−53

(define cli-version "0.1.0")

+52

;; The CLI's own version + wire protocol (design §2.1).

+53

(define cli-version local-node-version)

54

(define protocol-version 1)

+55

(define release-metadata-url

+56

"https://useslate.org/releases/cli/latest.json")

57

58

;; ================================================================

59

;; HTTP router for the app surface (everything main didn't send to

@@ -266,46 +268,51 @@

268

;;; The version dict. `cli-latest` is present only when upstream is

269

;;; reachable (best-effort, short-TTL cached); absent offline, so the

270

;;; endpoint degrades honestly.

−269

(define (version-info daemon)

+271

(define (version-info daemon . fetch-arg)

272

(let* ((config (dict-ref daemon config: #f))

273

(cache (make-cache (config-cache-dir config)))

274

(base #{ cli-version: cli-version

275

protocol: protocol-version

276

pwa-version-seen: (cache-version-seen cache)

277

pwa-version-cached: (cache-version-cached cache) })

−276

(latest (cli-latest config)))

+278

;; Tests inject the release fetch so their offline claim cannot

+279

;; silently reach production. Normal callers use the TTL cache.

+280

(latest (if (null? fetch-arg)

+281

(cli-latest)

+282

(fetch-cli-latest (car fetch-arg)))))

283

(if latest (dict-set base cli-latest: latest) base)))

284

−279

;; ---- cli-latest: <upstream>/release/latest.json, TTL-cached ----

+285

;; ---- cli-latest: trusted Slate release metadata, TTL-cached ----

286

;; A module-level cell is fine: one daemon per process, one upstream.

287

(define latest-cell (vector #f 0)) ; (version . fetched-at)

288

(define latest-ttl-secs 300)

289

−284

(define (cli-latest config)

+290

(define (cli-latest)

291

(let ((now (current-second))

292

(cached-v (vector-ref latest-cell 0))

293

(cached-at (vector-ref latest-cell 1)))

294

(cond

295

((and cached-v (< (- now cached-at) latest-ttl-secs)) cached-v)

−290

(else (refresh-cli-latest config now)))))

+296

(else (refresh-cli-latest now)))))

297

−292

(define (refresh-cli-latest config now)

−293

(let* ((upstream (config-app-upstream config))

−294

(url (string-append (strip-trailing-slash upstream) "/release/latest.json"))

−295

(result (http-fetch 'GET url '())))

+298

(define (fetch-cli-latest fetch-fn)

+299

(let ((result (fetch-fn 'GET release-metadata-url '())))

300

(cond

301

((and result (= (fetch-status result) 200))

302

(let ((v (guard (e (#t #f))

303

(let ((j (json-decode (utf8->string (fetch-body result)))))

−300

(and (dict? j) (dict-ref j version: #f))))))

−301

(when (string? v)

−302

(vector-set! latest-cell 0 v)

−303

(vector-set! latest-cell 1 now))

+304

(and (dict? j) (dict-ref j latest: #f))))))

305

(and (string? v) v)))

−305

(else

−306

;; unreachable: keep any prior value but report absent when we

−307

;; have never learned one (honest offline behavior).

−308

(vector-ref latest-cell 0)))))

+306

(else #f))))

+307

+308

(define (refresh-cli-latest now)

+309

(let ((v (fetch-cli-latest http-fetch)))

+310

(when v

+311

(vector-set! latest-cell 0 v)

+312

(vector-set! latest-cell 1 now))

+313

;; Unreachable: keep a previously learned value, but report absent

+314

;; when this process has never learned one.

+315

(or v (vector-ref latest-cell 0))))

316

317

;; ================================================================

318

;; Byte-exact HTTP response (send-http-response! in listen is

packages/slate-cli/src/slate-cli/registry.sglmodified

@@ -21,6 +21,8 @@

21

registry-remove!

22

registry-entries

23

entry-origin

+24

entry-metadata

+25

registry-close-matching!

26

close-revoked!

27

origin-still-paired?)

28

@@ -31,8 +33,9 @@

33

;; the connection can remove exactly its own on disconnect.

34

(define (make-conn-registry) (vector '()))

35

−34

(define (registry-add! reg origin close-thunk)

−35

(let ((entry (vector origin close-thunk)))

+36

(define (registry-add! reg origin close-thunk . metadata)

+37

(let ((entry (vector origin close-thunk

+38

(if (pair? metadata) (car metadata) #{}))))

39

(vector-set! reg 0 (cons entry (vector-ref reg 0)))

40

entry))

41

@@ -46,8 +49,18 @@

49

50

(define (registry-entries reg) (vector-ref reg 0))

51

(define (entry-origin e) (vector-ref e 0))

+52

(define (entry-metadata e)

+53

(if (> (vector-length e) 2) (vector-ref e 2) #{}))

54

(define (entry-close! e) ((vector-ref e 1)))

55

+56

(define (registry-close-matching! reg predicate)

+57

(let ((targets (filter predicate (registry-entries reg))))

+58

(for-each (lambda (entry)

+59

(registry-remove! reg entry)

+60

(guard (e (#t #f)) (entry-close! entry)))

+61

targets)

+62

(length targets)))

+63

64

;;; Does `origin` still have a pairing in the (freshly reloaded)

65

;;; store?

66

(define (origin-still-paired? store origin)

packages/slate-cli/src/slate-cli/resource/transfer.sgladded

@@ -0,0 +1,165 @@

+1

;;; (slate-cli resource transfer) — bounded multi-frame Resource transfers.

+2

;;;

+3

;;; This module owns no sockets or files. It is the shared protocol decision

+4

;;; layer used by the direct listener and relay holder: frames may arrive over

+5

;;; either carrier, but ordering, credit, completion, and cancellation must be

+6

;;; identical. Transport adapters perform I/O only after a transition returns

+7

;;; `accepted`.

+8

+9

(define-library (slate-cli resource transfer)

+10

(import (sigil core))

+11

(export transfer-chunk-bytes transfer-initial-credit

+12

make-transfer-registry transfer-count transfer-ids transfer-ref

+13

transfer-open! transfer-grant! transfer-batch! transfer-end!

+14

transfer-cancel! transfer-remove!)

+15

(begin

+16

;; Deliberately below the 4 MiB WebSocket ceiling and aligned with the

+17

;; listener's bounded read size. Credit is measured in payload bytes.

+18

(define transfer-chunk-bytes 65536)

+19

(define transfer-initial-credit (* transfer-chunk-bytes 4))

+20

(define max-u32 4294967295)

+21

+22

;; Registry slots: entries. Entry fields are intentionally non-secret and

+23

;; safe to expose to focused tests/status summaries.

+24

(define (make-transfer-registry) (vector '()))

+25

(define (entries registry) (vector-ref registry 0))

+26

(define (transfer-count registry) (length (entries registry)))

+27

(define (transfer-ids registry)

+28

(map (lambda (entry) (dict-ref entry id: #f)) (entries registry)))

+29

+30

(define (valid-id? id)

+31

(and (integer? id) (>= id 0) (<= id max-u32)))

+32

+33

(define (transfer-ref registry id)

+34

(let loop ((rest (entries registry)))

+35

(and (pair? rest)

+36

(let ((entry (car rest)))

+37

(if (equal? id (dict-ref entry id: #f))

+38

entry

+39

(loop (cdr rest)))))))

+40

+41

(define (replace! registry id replacement)

+42

(let ((found #f))

+43

(vector-set! registry 0

+44

(map (lambda (entry)

+45

(if (equal? id (dict-ref entry id: #f))

+46

(begin (set! found #t) replacement)

+47

entry))

+48

(entries registry)))

+49

(and found replacement)))

+50

+51

(define (transfer-remove! registry id)

+52

(let ((old (transfer-ref registry id)))

+53

(when old

+54

(vector-set! registry 0

+55

(filter (lambda (entry)

+56

(not (equal? id (dict-ref entry id: #f))))

+57

(entries registry))))

+58

old))

+59

+60

;;; Open one transfer. DIRECTION is `send` or `receive` from this endpoint's

+61

;;; perspective. EXPECTED-SIZE may be #f when not known in advance.

+62

(define (transfer-open! registry id direction expected-size . metadata)

+63

(cond

+64

((not (valid-id? id)) #{ status: 'refused reason: 'invalid-id })

+65

((not (member direction '(send receive)))

+66

#{ status: 'refused reason: 'invalid-direction })

+67

((and expected-size

+68

(not (and (integer? expected-size) (>= expected-size 0))))

+69

#{ status: 'refused reason: 'invalid-size })

+70

((transfer-ref registry id)

+71

#{ status: 'refused reason: 'duplicate-id })

+72

(else

+73

(let* ((meta (if (pair? metadata) (car metadata) #{}))

+74

(entry #{ id: id direction: direction state: 'active

+75

next-seq: 0 bytes: 0 credit: 0

+76

expected-size: expected-size metadata: meta }))

+77

(vector-set! registry 0 (cons entry (entries registry)))

+78

entry))))

+79

+80

;;; Grant additional payload bytes. Overflow and grants to terminal state

+81

;;; are refused rather than wrapping the window.

+82

(define (transfer-grant! registry id amount)

+83

(let ((entry (transfer-ref registry id)))

+84

(cond

+85

((not entry) #{ status: 'refused reason: 'unknown-id })

+86

((not (eq? (dict-ref entry state: #f) 'active))

+87

#{ status: 'refused reason: 'not-active })

+88

((not (and (integer? amount) (> amount 0) (<= amount max-u32)))

+89

#{ status: 'refused reason: 'invalid-credit })

+90

((> (+ (dict-ref entry credit: 0) amount) max-u32)

+91

#{ status: 'refused reason: 'credit-overflow })

+92

(else

+93

(replace! registry id

+94

(dict-set entry credit:

+95

(+ (dict-ref entry credit: 0) amount)))))))

+96

+97

;;; Accept one ordered chunk. The transport frame id correlates the

+98

;;; transfer; SEQ lives in the batch payload header and starts at zero.

+99

(define (transfer-batch! registry id seq payload)

+100

(let ((entry (transfer-ref registry id)))

+101

(cond

+102

((not entry) #{ status: 'refused reason: 'unknown-id })

+103

((not (eq? (dict-ref entry state: #f) 'active))

+104

#{ status: 'refused reason: 'not-active })

+105

((not (bytevector? payload))

+106

#{ status: 'refused reason: 'invalid-payload })

+107

((not (and (integer? seq) (>= seq 0)))

+108

#{ status: 'refused reason: 'invalid-sequence })

+109

((not (= seq (dict-ref entry next-seq: 0)))

+110

#{ status: 'refused reason: 'out-of-order

+111

expected: (dict-ref entry next-seq: 0) })

+112

((> (bytevector-length payload) transfer-chunk-bytes)

+113

#{ status: 'refused reason: 'chunk-too-large })

+114

((> (bytevector-length payload) (dict-ref entry credit: 0))

+115

#{ status: 'refused reason: 'credit-exhausted })

+116

((let ((expected (dict-ref entry expected-size: #f)))

+117

(and expected

+118

(> (+ (dict-ref entry bytes: 0)

+119

(bytevector-length payload))

+120

expected)))

+121

#{ status: 'refused reason: 'size-overrun })

+122

(else

+123

(let ((updated

+124

(dict-set

+125

(dict-set

+126

(dict-set entry next-seq: (+ seq 1))

+127

bytes: (+ (dict-ref entry bytes: 0)

+128

(bytevector-length payload)))

+129

credit: (- (dict-ref entry credit: 0)

+130

(bytevector-length payload)))))

+131

(replace! registry id updated)

+132

#{ status: 'accepted id: id seq: seq

+133

bytes: (bytevector-length payload)

+134

total: (dict-ref updated bytes: 0) })))))

+135

+136

;;; END names the next sequence number, so a missing final batch cannot be

+137

;;; mistaken for success. The entry remains terminal until transport glue

+138

;;; has committed/closed its resource and explicitly removes it.

+139

(define (transfer-end! registry id next-seq total)

+140

(let ((entry (transfer-ref registry id)))

+141

(cond

+142

((not entry) #{ status: 'refused reason: 'unknown-id })

+143

((not (eq? (dict-ref entry state: #f) 'active))

+144

#{ status: 'refused reason: 'not-active })

+145

((or (not (integer? next-seq))

+146

(not (= next-seq (dict-ref entry next-seq: 0))))

+147

#{ status: 'refused reason: 'incomplete })

+148

((or (not (integer? total))

+149

(not (= total (dict-ref entry bytes: 0))))

+150

#{ status: 'refused reason: 'size-mismatch })

+151

((let ((expected (dict-ref entry expected-size: #f)))

+152

(and expected (not (= expected total))))

+153

#{ status: 'refused reason: 'size-mismatch })

+154

(else

+155

(replace! registry id (dict-set entry state: 'complete))

+156

#{ status: 'complete id: id bytes: total }))))

+157

+158

;;; Cancellation is idempotent for an existing entry. The adapter gets the

+159

;;; old metadata back so it can close/delete the owned temporary resource.

+160

(define (transfer-cancel! registry id reason)

+161

(let ((entry (transfer-remove! registry id)))

+162

(if entry

+163

#{ status: 'cancelled id: id reason: reason entry: entry }

+164

#{ status: 'refused reason: 'unknown-id })))

+165

))

packages/slate-cli/src/slate-cli/resource/transfer/connection.sgladded

@@ -0,0 +1,96 @@

+1

;;; (slate-cli resource transfer connection) — shared listener/relay adapter.

+2

+3

(define-library (slate-cli resource transfer connection)

+4

(import (sigil core)

+5

(slate-cli listen) (slate-cli wire)

+6

(slate-cli resource transfer file))

+7

(export resource-transfer-open! resource-transfer-frame!

+8

resource-transfer-frame? resource-transfer-close!)

+9

(begin

+10

(define manager-key "resource-transfers")

+11

+12

(define (manager conn)

+13

(or (conn-state-get conn manager-key #f)

+14

(let ((created (make-file-transfer-manager)))

+15

(conn-state-set! conn manager-key created)

+16

created)))

+17

+18

(define (resource-transfer-frame? frame)

+19

(and frame

+20

(member (stream-frame-type frame)

+21

(list frame-batch frame-end frame-cancel

+22

frame-transfer-credit))))

+23

+24

(define (send-error! conn id reason)

+25

(ws-send-control! conn

+26

#{ t: "err" id: id code: "transfer-refused"

+27

message: (if (symbol? reason) (symbol->string reason)

+28

"transfer refused") }))

+29

+30

(define (send-open! conn transfer result)

+31

(let ((id (dict-ref transfer id: #f)))

+32

(if (not (eq? (dict-ref result status: #f) 'ready))

+33

(send-error! conn id (dict-ref result reason: 'open-failed))

+34

(begin

+35

(ws-send-control! conn

+36

#{ t: "ok" id: id

+37

transfer: #{ direction: (symbol->string

+38

(dict-ref result direction: 'unknown))

+39

size: (dict-ref result size: 0)

+40

chunk-bytes: (dict-ref result chunk-bytes: 0) } })

+41

(let ((credit (dict-ref result credit: #f)))

+42

(when credit

+43

(ws-send-binary! conn (encode-transfer-credit id credit))))))))

+44

+45

(define (resource-transfer-open! conn grants transfer)

+46

(let* ((direction (dict-ref transfer direction: #f))

+47

(result

+48

(cond

+49

((eq? direction 'upload)

+50

(file-upload-open! (manager conn) grants

+51

(dict-ref transfer id: #f)

+52

(dict-ref transfer path: "")

+53

(dict-ref transfer size: #f)))

+54

((eq? direction 'download)

+55

(file-download-open! (manager conn) grants

+56

(dict-ref transfer id: #f)

+57

(dict-ref transfer path: "")))

+58

(else #{ status: 'refused reason: 'invalid-direction }))))

+59

(send-open! conn transfer result)

+60

result))

+61

+62

(define (send-frames! conn frames)

+63

(for-each (lambda (bytes) (ws-send-binary! conn bytes)) frames))

+64

+65

(define (resource-transfer-frame! conn frame)

+66

(let* ((id (stream-frame-id frame))

+67

(type (stream-frame-type frame))

+68

(m (manager conn))

+69

(result

+70

(cond

+71

((= type frame-batch) (file-upload-batch! m frame))

+72

((= type frame-end) (file-transfer-end! m frame))

+73

((= type frame-transfer-credit) (file-download-credit! m frame))

+74

((= type frame-cancel) (file-transfer-cancel! m id 'peer-cancelled))

+75

(else #{ status: 'refused reason: 'unknown-frame }))))

+76

(let ((credit (dict-ref result credit-frame: #f)))

+77

(when credit (ws-send-binary! conn credit)))

+78

(send-frames! conn (dict-ref result frames: '()))

+79

(cond

+80

((and (= type frame-end)

+81

(eq? (dict-ref result status: #f) 'complete))

+82

(ws-send-control! conn

+83

#{ t: "ok" id: id result: #{ path: (dict-ref result path: "")

+84

bytes: (dict-ref result bytes: 0) } }))

+85

((and (= type frame-cancel)

+86

(eq? (dict-ref result status: #f) 'cancelled))

+87

(ws-send-control! conn

+88

#{ t: "ok" id: id result: #{ cancelled: #t } }))

+89

((eq? (dict-ref result status: #f) 'refused)

+90

(send-error! conn id (dict-ref result reason: 'transfer-refused))))

+91

result))

+92

+93

(define (resource-transfer-close! conn reason)

+94

(let ((m (conn-state-get conn manager-key #f)))

+95

(if m (file-transfer-close-all! m reason) 0)))

+96

))

packages/slate-cli/src/slate-cli/resource/transfer/file.sgladded

@@ -0,0 +1,203 @@

+1

;;; (slate-cli resource transfer file) — streaming file lifecycle.

+2

;;;

+3

;;; Authorization happens once, before a port is opened. Uploads write a unique

+4

;;; sibling and publish only after an exact END, so cancellation or transport

+5

;;; loss cannot expose partial destination content. The caller owns transport;

+6

;;; this module returns ordinary node frames for it to send.

+7

+8

(define-library (slate-cli resource transfer file)

+9

(import (sigil core) (sigil io) (sigil fs) (sigil crypto)

+10

(sigil system grant) (sigil system fs)

+11

(slate-cli resource transfer) (slate-cli wire))

+12

(export make-file-transfer-manager file-transfer-count

+13

file-upload-open! file-upload-batch! file-transfer-end!

+14

file-download-open! file-download-credit!

+15

file-transfer-cancel! file-transfer-close-all!)

+16

(begin

+17

;; Manager slot 0 is the protocol registry. Keeping file resources in entry

+18

;; metadata makes one removal return everything cleanup needs.

+19

(define (make-file-transfer-manager)

+20

(vector (make-transfer-registry)))

+21

(define (registry manager) (vector-ref manager 0))

+22

(define (file-transfer-count manager) (transfer-count (registry manager)))

+23

+24

;; A sibling temp keeps the final rename on the destination filesystem.

+25

;; The random suffix prevents concurrent connections with equal request ids

+26

;; from sharing or truncating one another's staging path.

+27

(define (upload-temp-path target)

+28

(string-append target ".slate-transfer-"

+29

(base64url-encode (random-bytes 16)) ".tmp"))

+30

+31

(define (active-entry manager id)

+32

(transfer-ref (registry manager) id))

+33

(define (entry-meta entry) (and entry (dict-ref entry metadata: #f)))

+34

+35

(define (cleanup-entry! entry publish?)

+36

(let* ((meta (entry-meta entry))

+37

(port (and meta (dict-ref meta port: #f)))

+38

(temp (and meta (dict-ref meta temporary: #f)))

+39

(target (and meta (dict-ref meta target: #f))))

+40

(when port (guard (e (#t #f)) (close-port port)))

+41

(cond

+42

((and publish? temp target)

+43

(rename-file temp target))

+44

(temp (guard (e (#t #f)) (delete-file temp))))))

+45

+46

(define (file-upload-open! manager grants id path size)

+47

(guard (e (#t #{ status: 'refused reason: 'open-failed }))

+48

(grant-assert! grants 'fs-write path)

+49

(unless (and (integer? size) (>= size 0) (<= size 4294967295))

+50

(error "invalid transfer size"))

+51

(let* ((temp (upload-temp-path path))

+52

(port (open-binary-output-file temp))

+53

(opened (transfer-open! (registry manager) id 'receive size

+54

#{ kind: 'upload target: path temporary: temp port: port })))

+55

(if (eq? (dict-ref opened status: #f) 'refused)

+56

(begin (close-port port) (delete-file temp) opened)

+57

(begin

+58

(transfer-grant! (registry manager) id transfer-initial-credit)

+59

#{ status: 'ready id: id direction: 'upload size: size

+60

chunk-bytes: transfer-chunk-bytes

+61

credit: transfer-initial-credit })))))

+62

+63

(define (file-upload-batch! manager frame)

+64

(let* ((decoded (decode-transfer-batch frame))

+65

(id (and decoded (dict-ref decoded id: #f)))

+66

(entry (and id (active-entry manager id)))

+67

(meta (entry-meta entry)))

+68

(if (not (and decoded entry meta

+69

(eq? (dict-ref meta kind: #f) 'upload)))

+70

#{ status: 'refused reason: 'unknown-id }

+71

(let* ((bytes (dict-ref decoded bytes: #f))

+72

(accepted (transfer-batch! (registry manager) id

+73

(dict-ref decoded seq: #f) bytes)))

+74

(if (not (eq? (dict-ref accepted status: #f) 'accepted))

+75

accepted

+76

(guard (e (#t

+77

(file-transfer-cancel! manager id 'write-failed)

+78

#{ status: 'refused reason: 'write-failed }))

+79

(write-bytevector bytes (dict-ref meta port: #f))

+80

;; Replenish only bytes successfully handed to the file.

+81

(transfer-grant! (registry manager) id

+82

(bytevector-length bytes))

+83

#{ status: 'accepted id: id

+84

progress: (dict-ref accepted total: 0)

+85

credit-frame: (encode-transfer-credit id

+86

(bytevector-length bytes)) }))))))

+87

+88

(define (file-download-open! manager grants id path)

+89

(guard (e (#t #{ status: 'refused reason: 'open-failed }))

+90

(let* ((stat (fs-stat grants path))

+91

(size (dict-ref stat size: -1)))

+92

(unless (and (integer? size) (>= size 0) (<= size 4294967295))

+93

(error "file is outside the v1 transfer size boundary"))

+94

(let* ((port (open-binary-input-file path))

+95

(opened (transfer-open! (registry manager) id 'send size

+96

#{ kind: 'download target: path port: port })))

+97

(if (eq? (dict-ref opened status: #f) 'refused)

+98

(begin (close-port port) opened)

+99

#{ status: 'ready id: id direction: 'download size: size

+100

chunk-bytes: transfer-chunk-bytes })))))

+101

+102

;; Drain at most the newly available credit. The returned frame list is

+103

;; bounded by the caller's grant and is normally four 64 KiB frames.

+104

(define (file-download-credit! manager credit-frame)

+105

(let* ((decoded (decode-transfer-credit credit-frame))

+106

(id (and decoded (dict-ref decoded id: #f)))

+107

(entry (and id (active-entry manager id)))

+108

(meta (entry-meta entry)))

+109

(if (not (and decoded entry meta

+110

(eq? (dict-ref meta kind: #f) 'download)))

+111

#{ status: 'refused reason: 'unknown-id }

+112

(let ((granted (transfer-grant! (registry manager) id

+113

(dict-ref decoded amount: 0))))

+114

(if (eq? (dict-ref granted status: #f) 'refused)

+115

granted

+116

(let loop ((frames '()))

+117

(let* ((current (active-entry manager id))

+118

(credit (dict-ref current credit: 0))

+119

(total (dict-ref current bytes: 0))

+120

(expected (dict-ref current expected-size: 0)))

+121

(cond

+122

((= total expected)

+123

(let ((done (transfer-end! (registry manager) id

+124

(dict-ref current next-seq: 0) total)))

+125

(cleanup-entry! current #f)

+126

(transfer-remove! (registry manager) id)

+127

#{ status: 'complete progress: total

+128

frames: (reverse

+129

(cons (encode-transfer-end id

+130

(dict-ref current next-seq: 0) total)

+131

frames)) }))

+132

((= credit 0)

+133

#{ status: 'active progress: total frames: (reverse frames) })

+134

(else

+135

(let* ((want (let ((remaining (- expected total)))

+136

(cond ((< credit transfer-chunk-bytes)

+137

(if (< credit remaining) credit remaining))

+138

((< transfer-chunk-bytes remaining)

+139

transfer-chunk-bytes)

+140

(else remaining))))

+141

(bytes (read-bytevector want

+142

(dict-ref meta port: #f))))

+143

(if (or (eof-object? bytes)

+144

(not (= (bytevector-length bytes) want)))

+145

(begin

+146

(file-transfer-cancel! manager id 'short-read)

+147

#{ status: 'refused reason: 'short-read

+148

frames: (reverse frames) })

+149

(let* ((seq (dict-ref current next-seq: 0))

+150

(accepted (transfer-batch!

+151

(registry manager) id seq bytes)))

+152

(if (not (eq? (dict-ref accepted status: #f)

+153

'accepted))

+154

accepted

+155

(loop (cons (encode-transfer-batch id seq bytes)

+156

frames)))))))))))))))

+157

+158

(define (file-transfer-end! manager end-frame)

+159

(let* ((decoded (decode-transfer-end end-frame))

+160

(id (and decoded (dict-ref decoded id: #f)))

+161

(entry (and id (active-entry manager id)))

+162

(meta (entry-meta entry)))

+163

(if (not (and decoded entry meta

+164

(eq? (dict-ref meta kind: #f) 'upload)))

+165

#{ status: 'refused reason: 'unknown-id }

+166

(let ((done (transfer-end! (registry manager) id

+167

(dict-ref decoded next-seq: #f)

+168

(dict-ref decoded total: #f))))

+169

(if (not (eq? (dict-ref done status: #f) 'complete))

+170

done

+171

(guard (e (#t

+172

(cleanup-entry! entry #f)

+173

(transfer-remove! (registry manager) id)

+174

#{ status: 'refused reason: 'commit-failed }))

+175

(flush-output-port (dict-ref meta port: #f))

+176

(close-port (dict-ref meta port: #f))

+177

;; Publish directly from the captured metadata. Do not

+178

;; rebuild the entry after close: dict updates may share

+179

;; structure with the live entry in native builds.

+180

(rename-file (dict-ref meta temporary: "")

+181

(dict-ref meta target: ""))

+182

(transfer-remove! (registry manager) id)

+183

#{ status: 'complete id: id

+184

path: (dict-ref meta target: "")

+185

bytes: (dict-ref done bytes: 0) }))))))

+186

+187

(define (file-transfer-cancel! manager id reason)

+188

(let ((entry (active-entry manager id)))

+189

(if (not entry)

+190

#{ status: 'refused reason: 'unknown-id }

+191

(begin

+192

(transfer-remove! (registry manager) id)

+193

(cleanup-entry! entry #f)

+194

#{ status: 'cancelled id: id reason: reason }))))

+195

+196

(define (file-transfer-close-all! manager reason)

+197

(let* ((ids (transfer-ids (registry manager)))

+198

;; Capture before cancellation mutates the registry. Some native

+199

;; list walkers reuse their traversal spine.

+200

(count (length ids)))

+201

(for-each (lambda (id) (file-transfer-cancel! manager id reason)) ids)

+202

count))

+203

))

packages/slate-cli/src/slate-cli/sessions.sglmodified

@@ -64,12 +64,12 @@

64

sessions-conn-closed!

65

sessions-agent-oauth-callback!

66

start-reaper!

−67

hub-session-count

+67

hub-session-count hub-session-summaries hub-quiescent?

68

hub-holds-sid?

69

;; testable internals

70

make-ring ring-append! ring-bytes ring-length

71

u16-be u32-be u16-at u32-at

−72

build-grants

+72

build-grants sessions-authorize-open!

73

;; R6 reaper internals. `reap-pass` and `reap-escalate!` are exported so

74

;; the exit gate can drive the SAME procedures the reaper loop drives,

75

;; rather than a reimplementation of them — `reaper-loop` adds only a

@@ -240,7 +240,7 @@

240

(define (make-session-hub)

241

;; Agent sessions live in this same hub object, not in a parallel

242

;; daemon table. Their typed event plane is implemented by agent/hub.

−243

(vector 'session-hub (cell 0) (cell '()) (make-agent-hub)))

+243

(vector 'session-hub (cell 0) (cell '()) (make-agent-hub) (cell '())))

244

; next-chan, terminal sessions, agent sessions

245

246

(define (sessions-start-agents! hub config)

@@ -283,6 +283,12 @@

283

(hub-set-sessions! hub (remove-eq hs (hub-sessions hub))))

284

(define (hub-session-count hub) (length (hub-sessions hub)))

285

+286

;; A condemned session leaves the catalog before its signal ladder ends.

+287

;; An independent owner must finish that work before it may exit.

+288

(define (hub-quiescent? hub)

+289

(and (= (hub-session-count hub) 0)

+290

(null? (cell-get (vector-ref hub 4)))))

+291

292

;; Find a principal-owned session by id — the principal check is the

293

;; capability gate: a connection can only ever name its OWN sessions.

294

;; Control lane: find by DURABLE STRING sid.

@@ -341,9 +347,15 @@

347

;; 12 pump-window (hub's mirror of the sigil-system window: += on

348

;; session-credit, -= on each delivered data event; used to clamp

349

;; the window on reattach so it can't inflate unboundedly)

+350

;; 13 chan 14 bounded capture-only latency markers 15 launch metadata

351

(define (make-hs sid chan principal kind sess ring wake ttl)

−345

(vector 'hs sid principal kind sess ring #f 0 wake (current-second) #f ttl 0

−346

chan))

+352

(vector 'hs sid principal kind sess ring #f 0 wake (session-clock) #f ttl 0

+353

chan '() #{}))

+354

+355

;; Preserve wall-time retention, including time the phone spends suspended.

+356

;; Linux/Android's CLOCK_MONOTONIC excludes suspend; using current-jiffy for

+357

;; this policy would silently turn 72 hours into 72 hours of awake time.

+358

(define (session-clock) (current-second))

359

(define (hs-sid h) (vector-ref h 1))

360

(define (hs-chan h) (vector-ref h 13))

361

(define (hs-principal h) (vector-ref h 2))

@@ -362,6 +374,38 @@

374

(define (hs-ttl h) (vector-ref h 11))

375

(define (hs-pump-window h) (vector-ref h 12))

376

(define (set-hs-pump-window! h v) (vector-set! h 12 v))

+377

(define (hs-traces h) (vector-ref h 14))

+378

(define (set-hs-traces! h v) (vector-set! h 14 v))

+379

+380

(define (bounded-u32 n) (max 0 (min 4294967295 n)))

+381

(define (trace-register! hs body)

+382

(when (= (bytevector-length body) 4)

+383

(let* ((entry (vector (u32-at body 0) (current-milliseconds) -1))

+384

(traces (append (hs-traces hs) (list entry))))

+385

(set-hs-traces! hs

+386

(if (> (length traces) 32) (cdr traces) traces)))))

+387

(define (trace-note-write! hs elapsed)

+388

(let loop ((xs (hs-traces hs)))

+389

(when (pair? xs)

+390

(if (< (vector-ref (car xs) 2) 0)

+391

(vector-set! (car xs) 2 (bounded-u32 elapsed))

+392

(loop (cdr xs))))))

+393

(define (trace-take-output! hs)

+394

;; A PTY may coalesce several rapid writes into one output chunk. Retire

+395

;; every marker whose write has completed against that chunk; leaving

+396

;; them queued one-at-a-time drifts later markers onto unrelated output.

+397

(let loop ((xs (hs-traces hs)) (taken '()))

+398

(if (and (pair? xs) (>= (vector-ref (car xs) 2) 0))

+399

(loop (cdr xs) (cons (car xs) taken))

+400

(begin

+401

(set-hs-traces! hs xs)

+402

(reverse taken)))))

+403

(define (trace-payload entry)

+404

(bytevector-append

+405

(u32-be (vector-ref entry 0))

+406

(u32-be (bounded-u32 (vector-ref entry 2)))

+407

(u32-be (bounded-u32

+408

(- (current-milliseconds) (vector-ref entry 1))))))

409

410

;; Credit the sigil-system pump window by n and mirror it locally.

411

(define (grant-pump! hs n)

@@ -521,7 +565,9 @@

565

((session-verb? verb)

566

;; The Enclave node's steady-state scheduler owns the stream,

567

;; writer, and PTY consumer tasks together.

−524

(dispatch-req daemon conn env verb))

+568

(let ((backend (dict-ref daemon session-backend: #f)))

+569

(if backend (backend daemon conn 'text text)

+570

(dispatch-req daemon conn env verb))))

571

((agent-verb? verb)

572

(ensure-writer! conn)

573

(let ((hub (dict-ref daemon sessions: #f))

@@ -593,6 +639,23 @@

639

(string-append "web:" (conn-origin conn)))

640

641

;; ---- session/open ----------------------------------------------

+642

;; The private PTY owner receives only operations authorized by the

+643

;; transport node. Use the same grant checks as sigil-system/session-open;

+644

;; check each OPEN, including on a previously established owner link.

+645

(define (sessions-authorize-open! daemon conn args)

+646

(let* ((config (dict-ref daemon config: #f))

+647

(origin (conn-origin conn))

+648

(argv (to-string-list (dict-ref args argv: #f)))

+649

(kind (kind-of (dict-ref args kind: "pty")))

+650

(cwd (dict-ref args cwd: #f))

+651

(g (or (conn-state-get conn "grants" #f)

+652

(build-grants (principal-of conn)

+653

(grants-for-origin config origin)))))

+654

(unless (and kind (pair? argv)) (error "invalid session spec"))

+655

(when (eq? kind 'pty) (grant-assert! g 'pty #t))

+656

(grant-assert! g 'exec (car argv))

+657

(when (string? cwd) (grant-assert! g 'fs-read cwd))))

+658

659

(define (do-open daemon conn id args)

660

(let* ((hub (dict-ref daemon sessions: #f))

661

(config (dict-ref daemon config: #f))

@@ -600,9 +663,14 @@

663

(principal (string-append "web:" origin))

664

(argv (to-string-list (dict-ref args argv: #f)))

665

(kind (kind-of (dict-ref args kind: "pty")))

+666

(cwd (dict-ref args cwd: #f))

667

(cols (dict-ref args cols: 80))

668

(rows (dict-ref args rows: 24)))

669

(cond

+670

((and (dict-ref daemon max-sessions: #f)

+671

(>= (+ (hub-session-count hub) (length (cell-get (vector-ref hub 4))))

+672

(dict-ref daemon max-sessions: #f)))

+673

(reply-err conn id "busy" "this terminal owner has reached its session limit"))

674

((not (pair? argv))

675

(log-warn* "node/session-refused" mod: "node" req-id: id

676

verb: "session/open" code: "bad-args"

@@ -624,7 +692,13 @@

692

(kind-label (dict-ref args kind: "pty"))

693

" -- only \"pty\" and \"process\" are supported")))

694

(else

−627

(let ((g (build-grants principal (grants-for-origin config origin)))

+695

;; Direct peers authenticate outside the browser-origin pairing

+696

;; path and cache their verified grant table on the connection.

+697

;; Rebuilding solely from daemon config here discards that posture

+698

;; (resources already use the cache) and denies every direct PTY.

+699

(let ((g (or (conn-state-get conn "grants" #f)

+700

(build-grants principal

+701

(grants-for-origin config origin))))

702

(t-open (op-clock)))

703

;; THE RAISE REASON IS NOW RECORDED BEFORE IT IS DISCARDED.

704

;; This guard collapses every cause of a failed terminal open —

@@ -644,8 +718,12 @@

718

reason: (safe-raise-message e)

719

duration-ms: (op-elapsed-ms t-open))

720

(reply-err conn id "open-failed" "session-open failed")))

−647

(let* ((spec (dict kind: kind argv: argv cols: cols rows: rows

−648

credit: 0))

+721

(let* ((spec0 (dict kind: kind argv: argv cols: cols rows: rows

+722

credit: 0))

+723

;; cwd is optional at the session seam. Passing #f as a

+724

;; present cwd reaches the filesystem grant validator as

+725

;; a path and rejects every legacy caller that omitted it.

+726

(spec (if (string? cwd) (dict-set spec0 cwd: cwd) spec0))

727

(sess (session-open g spec))

728

(sid (mint-sid!))

729

(chan (hub-next-chan! hub))

@@ -653,6 +731,10 @@

731

(wake (make-channel 1))

732

(hs (make-hs sid chan principal kind sess ring wake

733

(kind-ttl config kind))))

+734

(vector-set! hs 15

+735

#{ command: (safe-argv0 argv) cwd: (if (string? cwd) cwd "")

+736

created: (exact (floor (current-second)))

+737

started: (session-clock) })

738

(ensure-writer! conn)

739

(set-hs-attached! hs conn)

740

(hub-add! hub hs)

@@ -694,13 +776,22 @@

776

(if (string? m) m "<non-string>"))))

777

778

;; ---- session/list ----------------------------------------------

+779

(define (hub-session-summaries hub principal)

+780

(map-list session-summary

+781

(filter-list (lambda (hs) (string=? (hs-principal hs) principal))

+782

(hub-sessions hub))))

+783

784

(define (do-list daemon conn id)

785

(let* ((hub (dict-ref daemon sessions: #f))

786

(principal (principal-of conn))

−700

(mine (filter-list (lambda (hs) (string=? (hs-principal hs) principal))

−701

(hub-sessions hub))))

+787

(mine (hub-session-summaries hub principal))

+788

(cell (dict-ref daemon session-directory: #f))

+789

(discover (and cell (vector-ref cell 0))))

790

(reply-ok conn id

−703

#{ sessions: (list->array (map-list session-summary mine)) })))

+791

(dict-set

+792

(if discover (discover principal mine)

+793

#{ sessions: (list->array mine) unavailable: 0 })

+794

catalog-version: 1))))

795

796

;; R6: `idle` and `ttl` are ADDITIVE fields on an existing reply shape, so

797

;; no protocol version moves — an older client ignores them, and a newer

@@ -730,18 +821,21 @@

821

;; n => reaped after n idle seconds. Found in adversarial review — the

822

;; sentinel disease surviving one layer out from where it was purged.

823

(define (session-summary hs)

−733

#{ sid: (hs-sid hs)

−734

chan: (hs-chan hs)

−735

kind: (symbol->string (hs-kind hs))

−736

alive: (not (hs-dead? hs))

−737

attached: (if (hs-attached hs) #t #f)

−738

;; WHOLE SECONDS. `current-second` is a FLOAT here (probed: it reads

−739

;; 1.78768e+09, not an integer), so the raw difference would put six

−740

;; decimal places of meaningless precision on the wire for a value the

−741

;; UI renders as "3h". Floored rather than rounded, so a freshly

−742

;; detached session reads 0 and never 1.

−743

idle: (exact (floor (max 0 (- (current-second) (hs-last hs)))))

−744

ttl: (or (hs-ttl hs) 0) })

+824

(let ((meta (if (> (vector-length hs) 15) (vector-ref hs 15) #{})))

+825

#{ command: (dict-ref meta command: "shell")

+826

cwd: (dict-ref meta cwd: "")

+827

created: (dict-ref meta created: 0)

+828

age: (exact (floor (max 0

+829

(- (session-clock) (dict-ref meta started: (session-clock))))))

+830

sid: (hs-sid hs)

+831

chan: (hs-chan hs)

+832

kind: (symbol->string (hs-kind hs))

+833

alive: (not (hs-dead? hs))

+834

attached: (if (hs-attached hs) #t #f)

+835

;; Report elapsed whole seconds, so a freshly detached session

+836

;; reads zero even when the clock has subsecond precision.

+837

idle: (exact (floor (max 0 (- (session-clock) (hs-last hs)))))

+838

ttl: (or (hs-ttl hs) 0) }))

839

840

;; ---- session/attach --------------------------------------------

841

(define (do-attach daemon conn id args)

@@ -780,15 +874,26 @@

874

(else

875

(ensure-writer! conn)

876

(set-hs-attached! hs conn)

−783

;; Ack first, then replay scrollback, then resume the pump.

−784

(reply-ok conn id #{ pv: protocol-version sid: sid

−785

chan: (hs-chan hs)

−786

kind: (symbol->string (hs-kind hs)) })

877

;; The scrollback is read on its own line and BOUND before it is

−788

;; logged. `ring-bytes` copies out of the replay ring — real work,

−789

;; and inlining it into a keyword slot would mean the client got

−790

;; its scrollback only when debug logging happened to be on.

−791

(let ((scroll (ring-bytes (hs-ring hs))))

+878

;; acknowledged and logged. `ring-bytes` copies out of the replay

+879

;; ring — real work, and evaluating it twice could make the declared

+880

;; byte count disagree with the frame if the ring advances between

+881

;; the two reads.

+882

(let ((scroll (ring-bytes (hs-ring hs)))

+883

(summary (session-summary hs)))

+884

;; Ack first, then replay scrollback, then resume the pump. The

+885

;; additive count lets a reconnecting emulator distinguish this

+886

;; authoritative reseed from ordinary live output. In particular,

+887

;; zero means there is no replay frame and the retained screen must

+888

;; not be cleared.

+889

(reply-ok conn id #{ pv: protocol-version sid: sid

+890

created: (dict-ref summary created: 0)

+891

age: (dict-ref summary age: 0)

+892

idle: (dict-ref summary idle: 0)

+893

ttl: (or (hs-ttl hs) 0)

+894

chan: (hs-chan hs)

+895

kind: (symbol->string (hs-kind hs))

+896

replay-bytes: (bytevector-length scroll) })

897

(when (> (bytevector-length scroll) 0)

898

(enqueue-binary! conn frame-data-out (hs-chan hs) scroll))

899

(log-debug* "node/terminal-attach" mod: "node" req-id: id

@@ -847,7 +952,7 @@

952

;; last OUTPUT. R1 is the phase that makes "detached" the normal

953

;; parked state, so the bug stops being theoretical here. Named as an

954

;; R6 prerequisite in the phase plan; it has to land with R1.

−850

(set-hs-last! hs (current-second))

+955

(set-hs-last! hs (session-clock))

956

(channel-try-send (hs-wake hs) #t))

957

958

;; Re-arm the flow window on open/attach: reset wire-credit to the

@@ -903,7 +1008,7 @@

1008

;; connection. Always mirror into the ring first (scrollback), so a

1009

;; killed-then-reopened tab replays recent output.

1010

(define (deliver-out! hub hs bytes)

−906

(set-hs-last! hs (current-second))

+1011

(set-hs-last! hs (session-clock))

1012

(ring-append! (hs-ring hs) bytes)

1013

(let ((n (bytevector-length bytes)))

1014

;; The pump consumed n bytes of its window to produce this event;

@@ -942,7 +1047,12 @@

1047

;; consumer, so forwarding to a socket buffer is not

1048

;; "consumed" yet. Crediting on both paths would double the

1049

;; window and defeat the kernel-backpressure design (§2.4).

−945

(set-hs-credit! hs (- (hs-credit hs) n))

+1050

(set-hs-credit! hs (- (hs-credit hs) n))

+1051

(for-each

+1052

(lambda (trace)

+1053

(enqueue-binary! conn frame-trace-out (hs-chan hs)

+1054

(trace-payload trace)))

+1055

(trace-take-output! hs))

1056

;; PER-CHUNK OUTPUT IS TRACE, NOT DEBUG. This runs for every

1057

;; chunk the pty produces — `cat largefile` is thousands of

1058

;; these. At debug it would bury every other line in the file

@@ -1008,6 +1118,11 @@

1118

;;; `payload` is the WS binary frame body — the raw stream-frame

1119

;;; bytes `[u8 type][u32 id][payload]`.

1120

(define (sessions-handle-binary daemon conn payload)

+1121

(let ((backend (dict-ref daemon session-backend: #f)))

+1122

(if backend (backend daemon conn 'binary payload)

+1123

(sessions-handle-local-binary daemon conn payload))))

+1124

+1125

(define (sessions-handle-local-binary daemon conn payload)

1126

(let ((fr (decode-stream-frame payload)))

1127

(if (not (stream-frame? fr))

1128

;; Was silently discarded. A malformed binary frame is either a

@@ -1031,11 +1146,30 @@

1146

;; on the node, which is where you look when the client says

1147

;; its terminal stopped taking input.

1148

((not hs)

−1034

(log-warn* "node/frame-refused" mod: "node"

−1035

reason: "no-such-session"

−1036

chan: chan frame-type: type

−1037

origin: (conn-origin conn))

−1038

(enqueue-binary! conn frame-error chan (ascii-bytes "no such session")))

+1149

;; CREDIT ACKNOWLEDGES BYTES THE NODE ALREADY SENT. A short

+1150

;; process can exit and leave the hub before those acks make

+1151

;; the round trip, especially on Android where the holder and

+1152

;; relay pumps are scheduled more coarsely. Turning that

+1153

;; ordinary late ack into frame-error lets the error overtake

+1154

;; the already-queued output/exit and makes a successful PTY

+1155

;; appear to have failed with "no such session".

+1156

;;

+1157

;; Credit is additive flow-control bookkeeping, so applying it

+1158

;; after retirement has no remaining effect and ignoring it is

+1159

;; idempotent. Every operation that can change user state

+1160

;; (input, resize, signal, close) keeps the loud refusal below.

+1161

(if (= type frame-credit)

+1162

(log-debug* "node/frame-ignored" mod: "node"

+1163

reason: "late-credit-after-session-retired"

+1164

chan: chan frame-type: type

+1165

origin: (conn-origin conn))

+1166

(begin

+1167

(log-warn* "node/frame-refused" mod: "node"

+1168

reason: "no-such-session"

+1169

chan: chan frame-type: type

+1170

origin: (conn-origin conn))

+1171

(enqueue-binary! conn frame-error chan

+1172

(ascii-bytes "no such session")))))

1173

;; Input frames may only come from the currently-attached

1174

;; connection (a detached session takes no keystrokes).

1175

((not (eq? (hs-attached hs) conn))

@@ -1051,7 +1185,7 @@

1185

(guard (e (#t -1)) (if (bytevector? p) (bytevector-length p) -1)))

1186

1187

(define (drive-frame hs type body)

−1054

(set-hs-last! hs (current-second))

+1188

(set-hs-last! hs (session-clock))

1189

(cond

1190

;; INPUT. Trace, for the same volume reason as `node/terminal-out`:

1191

;; this is one line per keystroke.

@@ -1062,16 +1196,20 @@

1196

;; produced no evidence of any kind. The behaviour is unchanged — the

1197

;; write still fails silently as far as the client is concerned —

1198

;; but the node now records that it happened.

+1199

((= type frame-trace-in)

+1200

(trace-register! hs body))

1201

((= type frame-data-in)

1202

(log-trace* "node/terminal-in" mod: "node"

1203

sid: (hs-sid hs) chan: (hs-chan hs)

1204

bytes: (safe-bv-length body))

−1069

(guard (e (#t (log-warn* "node/terminal-write-failed" mod: "node"

+1205

(let ((started (current-milliseconds)))

+1206

(guard (e (#t (log-warn* "node/terminal-write-failed" mod: "node"

1207

sid: (hs-sid hs) chan: (hs-chan hs)

1208

bytes: (safe-bv-length body)

1209

reason: (safe-raise-message e))

1210

#f))

−1074

(session-write (hs-sess hs) body)))

+1211

(session-write (hs-sess hs) body)

+1212

(trace-note-write! hs (- (current-milliseconds) started)))))

1213

((= type frame-resize) (apply-resize hs body))

1214

((= type frame-signal) (apply-signal hs body))

1215

((= type frame-credit) (apply-credit hs body))

@@ -1171,6 +1309,8 @@

1309

;; reattach that the client may never send.

1310

(define (sessions-conn-closed! daemon conn)

1311

(agent-service-detach! conn)

+1312

(let ((backend (dict-ref daemon session-backend: #f)))

+1313

(when backend (backend daemon conn 'close #f)))

1314

(let ((hub (dict-ref daemon sessions: #f))

1315

(t0 (op-clock)))

1316

(when hub

@@ -1319,7 +1459,7 @@

1459

(loop))))

1460

1461

(define (reap-pass hub)

−1322

(let ((now (current-second)))

+1462

(let ((now (session-clock)))

1463

(for-each

1464

(lambda (hs)

1465

(cond

@@ -1351,6 +1491,8 @@

1491

(define (reap-idle! hub hs now)

1492

(let ((idle (- now (hs-last hs)))

1493

(sess (hs-sess hs)))

+1494

(cell-set! (vector-ref hub 4)

+1495

(cons hs (cell-get (vector-ref hub 4))))

1496

(set-hs-dead! hs #t)

1497

(hub-remove! hub hs)

1498

(channel-try-send (hs-wake hs) #t)

@@ -1388,6 +1530,9 @@

1530

;; skipped — this call is the `process-wait`, not a second

1531

;; execution.

1532

(session-close sess)

+1533

(unless (session-alive? sess)

+1534

(cell-set! (vector-ref hub 4)

+1535

(remove-eq hs (cell-get (vector-ref hub 4)))))

1536

(if (eq? ended 'survived)

1537

(log-error* "node/reap-survived" mod: "node"

1538

sid: (hs-sid hs)

@@ -1478,11 +1623,11 @@

1623

;;; That is load-bearing. Had a zombie read as alive, every ladder would

1624

;;; have run to SIGKILL and the stand-down arm could never pass.

1625

(define (wait-for-exit sess seconds)

−1481

(let ((deadline (+ (current-second) seconds)))

+1626

(let ((deadline (+ (current-jiffy) (* seconds (jiffies-per-second)))))

1627

(let poll ()

1628

(cond

1629

((not (session-alive? sess)) #t)

−1485

((>= (current-second) deadline) #f)

+1630

((>= (current-jiffy) deadline) #f)

1631

(else (sleep 0.05) (poll))))))

1632

1633

;;; The idle TTL for a session of `kind`, in seconds, or `#f` for never.

packages/slate-cli/src/slate-cli/terminal/discovery.sgladded

@@ -0,0 +1,60 @@

+1

;;; (slate-cli terminal discovery) — bounded queries of node-local session hubs.

+2

(define-library (slate-cli terminal discovery)

+3

(import (sigil array) (sigil async) (sigil fs) (sigil io) (sigil json)

+4

(sigil path) (sigil socket) (sigil string) (sigil time))

+5

(export terminal-discover terminal-query)

+6

(begin

+7

;; The directory is private to the node user. Only summaries cross this

+8

;; socket; the authenticated connection supplies the principal, never args.

+9

(define (terminal-query path principal)

+10

(let ((sock (guard (e (#t #f)) (unix-connect path))))

+11

(and sock

+12

(let ((result

+13

(guard (e (#t #f))

+14

(socket-write sock

+15

(string-append "LIST " (json-encode principal) "\n"))

+16

(socket-set-non-blocking! sock #t)

+17

(let ((deadline (+ (current-second) 0.25)))

+18

(let loop ((buf (bytevector)))

+19

(cond

+20

((and (> (bytevector-length buf) 0)

+21

(= (bytevector-u8-ref buf (- (bytevector-length buf) 1)) 10))

+22

(let ((reply (json-decode (utf8->string buf))))

+23

(and (dict? reply)

+24

(array? (dict-ref reply sessions: #f))

+25

(array->list (dict-ref reply sessions: #f)))))

+26

((or (> (bytevector-length buf) 65536)

+27

(> (current-second) deadline)) #f)

+28

(else

+29

(let ((bytes (socket-read-bytevector sock 4096)))

+30

(cond

+31

((eof-object? bytes) #f)

+32

((and (bytevector? bytes) (> (bytevector-length bytes) 0))

+33

(loop (bytevector-append buf bytes)))

+34

(else (sleep 0.005) (loop buf)))))))))))

+35

(socket-close sock)

+36

result))))

+37

+38

(define (terminal-discover dir own-path principal local)

+39

(let ((paths (guard (e (#t '())) (or (directory-list dir) '()))))

+40

(let loop ((names paths) (rows local) (unavailable 0) (count 0))

+41

(if (or (null? names) (>= count 32))

+42

#{ sessions: (list->array rows)

+43

unavailable: (+ unavailable (if (null? names) 0 1)) }

+44

(let* ((name (car names))

+45

(path (path-join dir name)))

+46

(if (or (equal? path own-path)

+47

(not (or (equal? name "node.sock")

+48

(and (string-starts-with? name "h-")

+49

(string-ends-with? name ".sock")))))

+50

(loop (cdr names) rows unavailable count)

+51

(let ((found (terminal-query path principal)))

+52

(loop (cdr names)

+53

(if found

+54

(append rows

+55

(map (lambda (row)

+56

(dict-set row route: "relay")) found))

+57

rows)

+58

(+ unavailable (if found 0 1))

+59

(+ count 1)))))))))

+60

))

packages/slate-cli/src/slate-cli/terminal/ipc.sgladded

@@ -0,0 +1,59 @@

+1

;;; Private node IPC uses the existing bounded WebSocket frame codec.

+2

;;; There is no HTTP upgrade and no externally reachable listener here.

+3

(define-library (slate-cli terminal ipc)

+4

(import (sigil async) (sigil socket) (sigil time) (sigil math)

+5

(sigil websocket frame) (slate-cli listen))

+6

(export terminal-ipc terminal-ipc-close! terminal-ipc-read!

+7

terminal-ipc-send! terminal-ipc-json!)

+8

(begin

+9

(define (terminal-ipc sock)

+10

(socket-set-non-blocking! sock #t)

+11

(vector sock (bytevector) #f

+12

(make-virtual-conn (lambda (bytes) (write-all! sock bytes)) "ipc")))

+13

+14

(define (terminal-ipc-close! ipc)

+15

(unless (vector-ref ipc 2)

+16

(vector-set! ipc 2 #t)

+17

(socket-close (vector-ref ipc 0))))

+18

+19

(define (terminal-ipc-send! ipc bytes)

+20

(and (not (vector-ref ipc 2))

+21

(conn-send! (vector-ref ipc 3) bytes)))

+22

+23

(define (terminal-ipc-json! ipc value)

+24

(ws-send-control! (vector-ref ipc 3) value))

+25

+26

;; A deadline is required for handshakes/queries; steady-state readers

+27

;; park on readability, so a terminal owner has no periodic input poll.

+28

(define (terminal-ipc-read! ipc . timeout)

+29

(let ((deadline (and (pair? timeout)

+30

(+ (current-second) (car timeout)))))

+31

(let loop ()

+32

(let* ((buf (vector-ref ipc 1))

+33

(decoded (decode-frame buf))

+34

(frame (frame-decode-result-frame decoded)))

+35

(cond

+36

((vector-ref ipc 2) #f)

+37

((> (bytevector-length buf) (* 1024 1024))

+38

(terminal-ipc-close! ipc)

+39

#f)

+40

(frame

+41

(vector-set! ipc 1

+42

(bytevector-copy buf (frame-decode-result-bytes-consumed decoded)))

+43

frame)

+44

((and deadline (>= (current-second) deadline)) #f)

+45

(else

+46

(let ((bytes (socket-read-bytevector (vector-ref ipc 0) 65536)))

+47

(cond

+48

((eof-object? bytes) (terminal-ipc-close! ipc) #f)

+49

((and (bytevector? bytes) (> (bytevector-length bytes) 0))

+50

(vector-set! ipc 1 (bytevector-append buf bytes))

+51

(loop))

+52

(else

+53

(await-readable-any (list (vector-ref ipc 0))

+54

timeout-ms: (if deadline

+55

(max 1 (exact (floor

+56

(* 1000 (- deadline (current-second))))))

+57

1000))

+58

(loop))))))))))

+59

))

packages/slate-cli/src/slate-cli/terminal/owner.sgladded

@@ -0,0 +1,355 @@

+1

;;; Restart-independent PTY ownership. Network transports delegate their

+2

;;; authenticated session plane over a private local socket. Resource RPCs,

+3

;;; watches, pairing and agent sessions remain in the network process.

+4

(define-library (slate-cli terminal owner)

+5

(import (sigil array) (sigil async) (sigil fs) (sigil io) (sigil json)

+6

(sigil path) (sigil process) (sigil socket) (sigil string) (sigil time)

+7

(sigil log) (sigil channels) (sigil websocket frame) (sigil system grant)

+8

(slate-cli config) (slate-cli listen) (slate-cli sessions)

+9

(slate-cli wire) (slate-cli node pairing)

+10

(slate-cli terminal ipc))

+11

(export make-terminal-backend terminal-owner-holds? run-terminal-owner!)

+12

(begin

+13

(define owner-version 1)

+14

(define owner-limit 8)

+15

(define session-limit 64)

+16

(define connection-limit 128)

+17

(define empty-grace 10)

+18

+19

(define (owner-dir config)

+20

;; Keep sockaddr_un paths short enough for Termux's long home path.

+21

(path-join (config-state-dir config) "pty"))

+22

+23

(define (owner-identity config)

+24

(let ((identity (pairing-load-identity (config-state-dir config))))

+25

(if identity (dict-ref identity key-id: "") "local")))

+26

+27

(define (owner-paths config)

+28

(let ((dir (owner-dir config)))

+29

(map (lambda (name) (path-join dir name))

+30

(filter (lambda (name)

+31

(and (string-starts-with? name "o-")

+32

(string-ends-with? name ".sock")))

+33

(or (directory-list dir) '())))))

+34

+35

(define (frame-json frame)

+36

(and frame (= (ws-frame-opcode frame) opcode-text)

+37

(guard (e (#t #f))

+38

(json-decode (utf8->string (ws-frame-payload frame))))))

+39

+40

(define (owner-connect config path origin mode)

+41

(let* ((identity (owner-identity config))

+42

(sock (guard (e (#t #f)) (unix-connect path))))

+43

(and sock

+44

(let ((ipc (terminal-ipc sock)))

+45

(terminal-ipc-json! ipc

+46

#{ version: owner-version identity: identity origin: origin mode: mode })

+47

(let ((hello (frame-json (terminal-ipc-read! ipc 0.5))))

+48

(if (and (dict? hello)

+49

(equal? (dict-ref hello version: 0) owner-version)

+50

(equal? (dict-ref hello identity: #f) identity)

+51

(equal? (dict-ref hello endpoint: #f) path))

+52

ipc

+53

(begin (terminal-ipc-close! ipc) #f)))))))

+54

+55

(define (owner-query config path principal sid)

+56

(let ((ipc (owner-connect config path "" "query")))

+57

(and ipc

+58

(let ((reply

+59

(guard (e (#t #f))

+60

(terminal-ipc-json! ipc #{ principal: principal sid: sid })

+61

(frame-json (terminal-ipc-read! ipc 0.5)))))

+62

(terminal-ipc-close! ipc)

+63

(and (dict? reply) reply)))))

+64

+65

(define (terminal-owner-holds? config sid)

+66

(let loop ((paths (owner-paths config)) (left owner-limit))

+67

(and (pair? paths) (> left 0)

+68

(let ((reply (owner-query config (car paths) "" sid)))

+69

(or (and reply (dict-ref reply holds: #f))

+70

(loop (cdr paths) (- left 1)))))))

+71

+72

;; Never bind over a shared pathname: unix-listen unlinks before binding.

+73

;; Each owner has an unguessable endpoint, discovered by protocol+identity,

+74

;; so a crash/restart or PID reuse cannot redirect a surviving terminal.

+75

;; Redundant empty owners from simultaneous first opens retire themselves.

+76

(define (spawn-owner! config)

+77

(let* ((dir (owner-dir config))

+78

(path (path-join dir

+79

(string-append "o-" (substring (mint-sid!) 2 18) ".sock"))))

+80

(ensure-directory dir)

+81

(unless (= 0 (process-run "chmod" "700" dir))

+82

(error "cannot secure terminal owner directory"))

+83

(when (>= (length (owner-paths config)) owner-limit)

+84

(error "terminal owner limit reached"))

+85

(let ((proc (process-spawn (car (command-line))

+86

"node" "_terminal-owner" path (config-state-dir config)

+87

(number->string (config-session-ttl-arg config))

+88

new-process-group: #t die-with-parent: #f

+89

in: "/dev/null" out: "/dev/null"

+90

err: (path-join dir "owner.log") append: #t)))

+91

(unless proc (error "cannot start terminal owner"))

+92

;; Reap our child if it exits while this main node is still alive.

+93

;; After a main-node crash the system's process reaper adopts it.

+94

(go (let loop ()

+95

(if (process-alive? proc)

+96

(begin (sleep 1) (loop))

+97

(process-wait proc))))

+98

(let ((deadline (+ (current-second) 5)))

+99

(let wait ()

+100

(let ((reply (and (file-exists? path) (owner-query config path "" #f))))

+101

(cond

+102

(reply path)

+103

((or (not (process-alive? proc)) (> (current-second) deadline))

+104

(error "terminal owner startup failed"))

+105

(else (sleep 0.02) (wait)))))))))

+106

+107

(define (inventory config principal)

+108

(let loop ((paths (owner-paths config)) (left owner-limit)

+109

(rows '()) (owners '()) (unavailable 0))

+110

(if (or (null? paths) (= left 0))

+111

(vector rows owners (+ unavailable (if (null? paths) 0 1)))

+112

(let* ((path (car paths))

+113

(reply (owner-query config path principal #f)))

+114

(if reply

+115

(loop (cdr paths) (- left 1)

+116

(append rows (array->list (dict-ref reply sessions: #[])))

+117

(cons path owners) unavailable)

+118

(begin

+119

;; Remove only endpoints whose OS socket cannot connect.

+120

;; An incompatible/live owner remains visible as unavailable.

+121

(let ((sock (guard (e (#t #f)) (unix-connect path))))

+122

(if sock (socket-close sock)

+123

(guard (e (#t #f)) (delete-file path))))

+124

(loop (cdr paths) (- left 1) rows owners (+ unavailable 1))))))))

+125

+126

(define (owner-for-sid config sid)

+127

(let loop ((paths (owner-paths config)) (left owner-limit))

+128

(and (pair? paths) (> left 0)

+129

(let ((reply (owner-query config (car paths) "" sid)))

+130

(if (and reply (dict-ref reply holds: #f)) (car paths)

+131

(loop (cdr paths) (- left 1)))))))

+132

+133

;; Map channels at the transport boundary: a connection may attach to

+134

;; sessions held by different surviving owners whose u32 counters overlap.

+135

;; SID remains unchanged; the frontend channel counter is connection-local.

+136

(define (bridge-channel! conn bridge remote)

+137

(let ((found (assv remote (vector-ref bridge 2))))

+138

(if found (cdr found)

+139

(let ((next (+ 1 (conn-state-get conn "owner-next-channel" 0))))

+140

(conn-state-set! conn "owner-next-channel" next)

+141

(vector-set! bridge 2 (cons (cons remote next) (vector-ref bridge 2)))

+142

next))))

+143

+144

(define (forward-owner-frame! conn bridge frame)

+145

(let ((payload (ws-frame-payload frame)))

+146

(cond

+147

((= (ws-frame-opcode frame) opcode-text)

+148

(let* ((reply (frame-json frame))

+149

(result (and reply (dict-ref reply result: #f)))

+150

(chan (and (dict? result) (dict-ref result chan: #f))))

+151

(when reply

+152

(vector-set! bridge 4

+153

(filter (lambda (id) (not (equal? id (dict-ref reply id: #f))))

+154

(vector-ref bridge 4)))

+155

(ws-send-control! conn

+156

(if chan

+157

(dict-set reply result:

+158

(dict-set result chan: (bridge-channel! conn bridge chan)))

+159

reply)))))

+160

((= (ws-frame-opcode frame) opcode-binary)

+161

(let ((fr (decode-stream-frame payload)))

+162

(when fr

+163

(ws-send-binary! conn

+164

(encode-stream-frame (stream-frame-type fr)

+165

(bridge-channel! conn bridge (stream-frame-id fr))

+166

(stream-frame-payload fr)))

+167

(when (= (stream-frame-type fr) frame-close)

+168

(vector-set! bridge 2

+169

(filter (lambda (entry) (not (= (car entry) (stream-frame-id fr))))

+170

(vector-ref bridge 2))))))))))

+171

+172

(define (open-bridge! config conn path)

+173

(let* ((bridges (conn-state-get conn "terminal-owner-links" '()))

+174

(found (assoc path bridges)))

+175

(if (and found (not (vector-ref (cdr found) 3))) (cdr found)

+176

(let ((ipc (owner-connect config path (conn-origin conn) "stream")))

+177

(unless ipc (error "terminal owner unavailable"))

+178

(let ((bridge (vector path ipc '() #f '())))

+179

(conn-state-set! conn "terminal-owner-links"

+180

(cons (cons path bridge) bridges))

+181

(go

+182

(guard (e (#t #f))

+183

(let loop ()

+184

(let ((frame (terminal-ipc-read! ipc)))

+185

(when frame

+186

(forward-owner-frame! conn bridge frame)

+187

(loop)))))

+188

(vector-set! bridge 3 #t)

+189

(terminal-ipc-close! ipc)

+190

(for-each (lambda (id)

+191

(ws-send-control! conn

+192

#{ t: "err" id: id code: "unavailable"

+193

message: "the terminal owner disconnected" }))

+194

(vector-ref bridge 4))

+195

(for-each (lambda (entry)

+196

(ws-send-binary! conn

+197

(encode-stream-frame frame-error (cdr entry)

+198

(string->utf8 "terminal owner disconnected"))))

+199

(vector-ref bridge 2))

+200

(conn-state-set! conn "terminal-owner-links"

+201

(filter (lambda (entry) (not (eq? (cdr entry) bridge)))

+202

(conn-state-get conn "terminal-owner-links" '()))))

+203

bridge)))))

+204

+205

(define (proxy-binary! conn payload)

+206

(let ((fr (decode-stream-frame payload)))

+207

(when fr

+208

(let loop ((links (conn-state-get conn "terminal-owner-links" '())))

+209

(when (pair? links)

+210

(let* ((bridge (cdar links))

+211

(mapping (find (lambda (entry)

+212

(= (cdr entry) (stream-frame-id fr)))

+213

(vector-ref bridge 2))))

+214

(if mapping

+215

(terminal-ipc-send! (vector-ref bridge 1)

+216

(encode-server-binary-frame

+217

(encode-stream-frame (stream-frame-type fr) (car mapping)

+218

(stream-frame-payload fr))))

+219

(loop (cdr links)))))))))

+220

+221

(define (make-terminal-backend config)

+222

;; Serialize first opens in this process; transport holders also discover

+223

;; these endpoints, and never own PTYs themselves.

+224

(let ((lock (make-channel 1)))

+225

(channel-send lock #t)

+226

(lambda (daemon conn action payload)

+227

(case action

+228

((close)

+229

(for-each (lambda (entry)

+230

(terminal-ipc-close! (vector-ref (cdr entry) 1)))

+231

(conn-state-get conn "terminal-owner-links" '()))

+232

(conn-state-set! conn "terminal-owner-links" '()))

+233

((binary) (proxy-binary! conn payload))

+234

((text)

+235

(let* ((env (decode-control payload))

+236

(id (dict-ref env id: 0))

+237

(verb (dict-ref env verb: ""))

+238

(args (dict-ref env args: #{})))

+239

(guard (e (#t

+240

(log-warn* "terminal owner request failed" mod: "terminal"

+241

verb: verb reason: e)

+242

(ws-send-control! conn

+243

#{ t: "err" id: id code: "unavailable"

+244

message: "the terminal owner could not handle this request" })))

+245

(cond

+246

((equal? verb "session/list")

+247

(let ((catalog (inventory config (string-append "web:" (conn-origin conn)))))

+248

(ws-send-control! conn

+249

#{ t: "ok" id: id

+250

result: #{ catalog-version: 1

+251

sessions: (list->array (vector-ref catalog 0))

+252

unavailable: (vector-ref catalog 2) } })))

+253

(else

+254

(when (equal? verb "session/open")

+255

(sessions-authorize-open! daemon conn args))

+256

(let* ((sid (dict-ref args sid: #f))

+257

(path

+258

(if (equal? verb "session/open")

+259

(begin

+260

(channel-receive lock)

+261

(dynamic-wind

+262

(lambda () #f)

+263

(lambda ()

+264

(let ((catalog (inventory config "")))

+265

(if (pair? (vector-ref catalog 1))

+266

(car (vector-ref catalog 1))

+267

(spawn-owner! config))))

+268

(lambda () (channel-send lock #t))))

+269

(and (valid-sid? sid) (owner-for-sid config sid)))))

+270

(if path

+271

(let ((bridge (open-bridge! config conn path)))

+272

(vector-set! bridge 4 (cons id (vector-ref bridge 4)))

+273

(unless (terminal-ipc-send! (vector-ref bridge 1)

+274

(encode-server-text-frame payload))

+275

(error "terminal owner disconnected")))

+276

(ws-send-control! conn

+277

#{ t: "err" id: id code: "no-session"

+278

message: "unknown session" }))))))))))))

+279

+280

(define (serve-owner-client! config path identity hub ipc)

+281

(let ((conn #f))

+282

(guard (e (#t (log-warn* "terminal owner connection failed" mod: "terminal" reason: e)))

+283

(let ((hello (frame-json (terminal-ipc-read! ipc 1))))

+284

(when (and (dict? hello)

+285

(equal? (dict-ref hello version: 0) owner-version)

+286

(equal? (dict-ref hello identity: #f) identity))

+287

(terminal-ipc-json! ipc

+288

#{ version: owner-version identity: identity endpoint: path pid: (process-id) })

+289

(if (equal? (dict-ref hello mode: "") "query")

+290

(let ((query (frame-json (terminal-ipc-read! ipc 1))))

+291

(when (dict? query)

+292

(terminal-ipc-json! ipc

+293

#{ sessions: (list->array

+294

(hub-session-summaries hub (dict-ref query principal: "")))

+295

holds: (hub-holds-sid? hub (dict-ref query sid: #f)) })))

+296

(when (and (equal? (dict-ref hello mode: "") "stream")

+297

(string? (dict-ref hello origin: #f)))

+298

(set! conn

+299

(make-virtual-conn (lambda (bytes) (terminal-ipc-send! ipc bytes))

+300

(dict-ref hello origin: "")))

+301

;; The same OS user can already spawn these commands.

+302

;; Network grant enforcement stays at every frontend OPEN;

+303

;; this private endpoint executes that delegated operation.

+304

(conn-state-set! conn "grants"

+305

(grant-allow-all principal: (string-append "web:" (conn-origin conn))))

+306

(let ((daemon #{ config: config sessions: hub max-sessions: session-limit }))

+307

(let loop ()

+308

(let ((frame (terminal-ipc-read! ipc)))

+309

(when frame

+310

(cond

+311

((= (ws-frame-opcode frame) opcode-text)

+312

(sessions-on-text daemon conn (utf8->string (ws-frame-payload frame))))

+313

((= (ws-frame-opcode frame) opcode-binary)

+314

(sessions-handle-binary daemon conn (ws-frame-payload frame))))

+315

(loop))))))))))

+316

(when conn (sessions-conn-closed! #{ sessions: hub } conn))

+317

(terminal-ipc-close! ipc)))

+318

+319

(define (run-terminal-owner! path state-dir ttl)

+320

(let* ((config (make-config state-dir: state-dir session-ttl: ttl))

+321

(identity (owner-identity config))

+322

(hub (make-session-hub))

+323

(listener (unix-listen path))

+324

(connections 0)

+325

(idle-since (current-jiffy))

+326

(running #t))

+327

(socket-set-non-blocking! listener #t)

+328

(with-async

+329

(start-reaper! hub config)

+330

(go

+331

(let accept ()

+332

(when running

+333

(await-readable listener)

+334

(let ((sock (tcp-accept listener)))

+335

(when sock

+336

(if (>= connections connection-limit)

+337

(socket-close sock)

+338

(begin

+339

(set! connections (+ connections 1))

+340

(go

+341

(serve-owner-client! config path identity hub (terminal-ipc sock))

+342

(set! connections (- connections 1)))))))

+343

(accept))))

+344

(let loop ()

+345

(sleep 0.1)

+346

(when (not (hub-quiescent? hub))

+347

(set! idle-since (current-jiffy)))

+348

(if (> (- (current-jiffy) idle-since) (* empty-grace (jiffies-per-second)))

+349

(begin

+350

(set! running #f)

+351

(socket-close listener)

+352

(delete-file path)

+353

(exit 0))

+354

(loop))))))

+355

))

packages/slate-cli/src/slate-cli/wire.sglmodified

@@ -29,8 +29,12 @@

29

;; Binary frame type codes (design §3.2 / §3.2b)

30

frame-data-in frame-data-out frame-data-err

31

frame-resize frame-signal frame-credit frame-close frame-error

+32

frame-trace-in frame-trace-out

33

frame-bulk

34

frame-batch frame-end frame-cancel frame-transfer-credit

+35

encode-transfer-batch decode-transfer-batch

+36

encode-transfer-end decode-transfer-end

+37

encode-transfer-credit decode-transfer-credit

38

;; Binary frame codec

39

encode-stream-frame

40

decode-stream-frame

@@ -62,6 +66,11 @@

66

(define frame-credit #x07) ; payload = u32 bytes granted

67

(define frame-close #x08) ; id = sid

68

(define frame-error #x09) ; payload = JSON detail

+69

;; Capture-only terminal latency markers. They never contain terminal data:

+70

;; trace-in carries a u32 correlation id; trace-out carries that id plus

+71

;; remote receive->PTY-write and receive->first-output durations.

+72

(define frame-trace-in #x0a)

+73

(define frame-trace-out #x0b)

74

(define frame-bulk #x10) ; id = req-id, payload = sigil-wire bytes

75

(define frame-batch #x20) ; id = req-id, one batch of records

76

(define frame-end #x21) ; id = req-id, transfer complete

@@ -136,6 +145,63 @@

145

(get-u32-be bv 1)

146

(bytevector-copy bv header-size len)))))

147

+148

;; Transfer-plane payloads keep their ordering and accounting fields in a

+149

;; fixed binary prefix. V1 intentionally uses u32 byte totals: it covers

+150

;; the multi-frame gap above 4 MiB while retaining exact arithmetic in the

+151

;; browser and putting an explicit 4 GiB ceiling on one operation.

+152

(define (u32? value)

+153

(and (integer? value) (>= value 0) (<= value 4294967295)))

+154

+155

(define (encode-transfer-batch id seq bytes)

+156

(unless (and (u32? id) (u32? seq) (bytevector? bytes))

+157

(error "encode-transfer-batch: invalid id, sequence, or payload"))

+158

(let* ((n (bytevector-length bytes))

+159

(payload (make-bytevector (+ 4 n) 0)))

+160

(put-u32-be! payload 0 seq)

+161

(when (> n 0) (bytevector-copy! payload 4 bytes 0 n))

+162

(encode-stream-frame frame-batch id payload)))

+163

+164

(define (decode-transfer-batch frame)

+165

(and (stream-frame? frame)

+166

(= (stream-frame-type frame) frame-batch)

+167

(let ((payload (stream-frame-payload frame)))

+168

(and (>= (bytevector-length payload) 4)

+169

#{ id: (stream-frame-id frame)

+170

seq: (get-u32-be payload 0)

+171

bytes: (bytevector-copy payload 4

+172

(bytevector-length payload)) }))))

+173

+174

(define (encode-transfer-end id next-seq total)

+175

(unless (and (u32? id) (u32? next-seq) (u32? total))

+176

(error "encode-transfer-end: invalid id, sequence, or total"))

+177

(let ((payload (make-bytevector 8 0)))

+178

(put-u32-be! payload 0 next-seq)

+179

(put-u32-be! payload 4 total)

+180

(encode-stream-frame frame-end id payload)))

+181

+182

(define (decode-transfer-end frame)

+183

(and (stream-frame? frame)

+184

(= (stream-frame-type frame) frame-end)

+185

(= (bytevector-length (stream-frame-payload frame)) 8)

+186

#{ id: (stream-frame-id frame)

+187

next-seq: (get-u32-be (stream-frame-payload frame) 0)

+188

total: (get-u32-be (stream-frame-payload frame) 4) }))

+189

+190

(define (encode-transfer-credit id amount)

+191

(unless (and (u32? id) (u32? amount) (> amount 0))

+192

(error "encode-transfer-credit: invalid id or amount"))

+193

(let ((payload (make-bytevector 4 0)))

+194

(put-u32-be! payload 0 amount)

+195

(encode-stream-frame frame-transfer-credit id payload)))

+196

+197

(define (decode-transfer-credit frame)

+198

(and (stream-frame? frame)

+199

(= (stream-frame-type frame) frame-transfer-credit)

+200

(= (bytevector-length (stream-frame-payload frame)) 4)

+201

(let ((amount (get-u32-be (stream-frame-payload frame) 0)))

+202

(and (> amount 0)

+203

#{ id: (stream-frame-id frame) amount: amount }))))

+204

205

;; ----------------------------------------------------------------

206

;; Control envelope (text frame) codec

207

;;

packages/slate-cli/test/helpers/relay-peer.cjsadded

@@ -0,0 +1,60 @@

+1

// A local, byte-transparent stand-in for Enclave's ticketed relay.

+2

const http = require('node:http');

+3

const crypto = require('node:crypto');

+4

const assert = require('node:assert/strict');

+5

const {Client} = require('./terminal-client.cjs');

+6

+7

async function relayServer() {

+8

const server = http.createServer();

+9

const waiting = [], peers = [];

+10

server.on('upgrade', (request, socket, head) => {

+11

const accept = crypto.createHash('sha1').update(request.headers['sec-websocket-key'] +

+12

'258EAFA5-E914-47DA-95CA-C5AB0DC85B11').digest('base64');

+13

    socket.write(`HTTP/1.1 101 Switching Protocols\r\nUpgrade: websocket\r\nConnection: Upgrade\r\nSec-WebSocket-Accept: ${accept}\r\n\r\n`);

+14

const peer = Object.create(Client.prototype);

+15

Object.assign(peer, {socket, queue: [], frames: [], tail: '', sequence: 0, outputBytes: 0});

+16

peer.send = (opcode, payload) => {

+17

payload = Buffer.from(payload);

+18

if (opcode === 1) { payload = Buffer.concat([Buffer.from([1, 0, 0, 0, 0]), payload]); opcode = 2; }

+19

const header = Buffer.alloc(payload.length < 126 ? 2 : 4);

+20

header[0] = 128 | opcode;

+21

header[1] = payload.length < 126 ? payload.length : 126;

+22

if (payload.length >= 126) header.writeUInt16BE(payload.length, 2);

+23

socket.write(Buffer.concat([header, payload]));

+24

};

+25

let buffer = Buffer.from(head);

+26

socket.on('error', error => { peer.error = error; });

+27

socket.on('data', data => {

+28

buffer = Buffer.concat([buffer, data]);

+29

while (buffer.length >= 2) {

+30

const opcode = buffer[0] & 15, masked = buffer[1] & 128;

+31

let size = buffer[1] & 127, offset = 2;

+32

if (size === 126) { if (buffer.length < 4) return; size = buffer.readUInt16BE(2); offset = 4; }

+33

if (size === 127) { if (buffer.length < 10) return; size = Number(buffer.readBigUInt64BE(2)); offset = 10; }

+34

assert.ok(size <= 1024 * 1024, 'relay frame stays bounded');

+35

const header = offset + (masked ? 4 : 0);

+36

if (buffer.length < header + size) return;

+37

const payload = Buffer.from(buffer.subarray(header, header + size));

+38

if (masked) for (let i = 0; i < size; i++) payload[i] ^= buffer[offset + i % 4];

+39

buffer = buffer.subarray(header + size);

+40

if (opcode === 1) peer.ticket = payload.toString();

+41

if (opcode === 2 && payload[0] === 1) peer.queue.push(JSON.parse(payload.subarray(5).toString()));

+42

if (opcode === 2 && payload[0] === 3) peer.tail = (peer.tail + payload.subarray(5).toString()).slice(-4096);

+43

if (opcode === 2) peer.frames.push(payload);

+44

if (opcode === 9) peer.send(10, payload);

+45

}

+46

});

+47

peers.push(peer);

+48

if (waiting.length) waiting.shift()(peer);

+49

});

+50

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+51

return {

+52

url: `ws://127.0.0.1:${server.address().port}/stream`,

+53

next: () => new Promise(resolve => waiting.push(resolve)),

+54

close: async () => {

+55

for (const peer of peers) peer.socket.destroy();

+56

await new Promise(resolve => server.close(resolve));

+57

}

+58

};

+59

}

+60

module.exports = {relayServer};

packages/slate-cli/test/helpers/terminal-client.cjsadded

@@ -0,0 +1,82 @@

+1

const net = require('node:net');

+2

const crypto = require('node:crypto');

+3

const assert = require('node:assert/strict');

+4

const delay = ms => new Promise(resolve => setTimeout(resolve, ms));

+5

class Client {

+6

constructor(port) {

+7

this.buffer = Buffer.alloc(0); this.upgraded = false; this.queue = [];

+8

this.outputBytes = 0; this.tail = ''; this.sequence = 0; this.frames = []; this.outputWaiters = [];

+9

this.socket = net.connect(port, '127.0.0.1');

+10

this.socket.on('error', error => { this.error = error; });

+11

this.socket.on('connect', () => this.socket.write(

+12

      `GET /node/ws HTTP/1.1\r\nHost: 127.0.0.1:${process.env.SLATE_PROBE_ORIGIN_PORT || port}\r\nOrigin: http://127.0.0.1:${process.env.SLATE_PROBE_ORIGIN_PORT || port}\r\nUpgrade: websocket\r\nConnection: Upgrade\r\nSec-WebSocket-Version: 13\r\nSec-WebSocket-Key: ${crypto.randomBytes(16).toString('base64')}\r\n\r\n`));

+13

this.socket.on('data', bytes => {

+14

this.buffer = Buffer.concat([this.buffer, bytes]);

+15

if (!this.upgraded) {

+16

const end = this.buffer.indexOf('\r\n\r\n'); if (end < 0) return;

+17

assert.match(this.buffer.subarray(0,end).toString(), /^HTTP\/1.1 101/);

+18

this.buffer = this.buffer.subarray(end+4); this.upgraded = true;

+19

}

+20

while(this.buffer.length >= 2) {

+21

const opcode = this.buffer[0] & 15; let size = this.buffer[1] & 127, header = 2;

+22

if(size === 126) { if(this.buffer.length < 4) return; size = this.buffer.readUInt16BE(2); header=4; }

+23

if(size === 127) { if(this.buffer.length < 10) return; size=Number(this.buffer.readBigUInt64BE(2)); header=10; }

+24

if(this.buffer.length < header+size) return;

+25

const payload = this.buffer.subarray(header,header+size);

+26

this.buffer=this.buffer.subarray(header+size);

+27

if(opcode === 1) this.queue.push(JSON.parse(payload.toString()));

+28

if(opcode === 2) this.frames.push(Buffer.from(payload));

+29

if(opcode === 2 && payload[0] === 3) {

+30

this.outputBytes += payload.length-5;

+31

this.tail=(this.tail+payload.subarray(5).toString()).slice(-2048);

+32

for (const waiter of [...this.outputWaiters]) if (this.tail.includes(waiter.text)) waiter.resolve();

+33

}

+34

if(opcode === 9) this.send(10,payload);

+35

}

+36

});

+37

}

+38

send(opcode,payload) {

+39

payload=Buffer.from(payload); const mask=crypto.randomBytes(4);

+40

const header=Buffer.alloc(payload.length < 126 ? 6 : 8); header[0]=128|opcode;

+41

if(payload.length < 126) header[1]=128|payload.length;

+42

else { header[1]=254; header.writeUInt16BE(payload.length,2); }

+43

mask.copy(header,header.length-4);

+44

const bytes=Buffer.from(payload);for(let i=0;i<bytes.length;i++) bytes[i]^=mask[i%4];

+45

this.socket.write(Buffer.concat([header,bytes]));

+46

}

+47

frame(kind,channel,payload) {

+48

const header=Buffer.alloc(5);header[0]=kind;header.writeUInt32BE(channel,1);

+49

this.send(2,Buffer.concat([header,Buffer.from(payload)]));

+50

}

+51

async wait(predicate, label, timeout=12000) {

+52

const until=Date.now()+timeout;

+53

while(Date.now()<until) {

+54

if(this.error) throw this.error;

+55

if(predicate()) return;

+56

await delay(10);

+57

}

+58

throw Error('Timeout: '+label);

+59

}

+60

async paired() { await this.wait(()=>this.queue.some(x=>x.t==='pair/ok'),'silent pairing'); }

+61

waitOutput(text) {

+62

return new Promise((resolve, reject) => {

+63

const waiter = {text, resolve: () => { cleanup(); resolve(); }};

+64

const timer = setTimeout(() => { cleanup(); reject(Error(`Missing output: ${text}`)); }, 10000);

+65

      const cleanup = () => { clearTimeout(timer); this.outputWaiters = this.outputWaiters.filter(item => item !== waiter); };

+66

this.outputWaiters.push(waiter);

+67

});

+68

}

+69

async request(verb,args) {

+70

const reply = await this.requestRaw(verb,args);

+71

assert.equal(reply.t,'ok',JSON.stringify(reply)); return reply.result;

+72

}

+73

async requestRaw(verb,args) {

+74

const id=++this.sequence;

+75

this.send(1,JSON.stringify({t:'req',id,verb,args}));

+76

await this.wait(()=>this.queue.some(x=>x.id===id),'reply '+verb);

+77

const reply=this.queue.splice(this.queue.findIndex(x=>x.id===id),1)[0];

+78

return reply;

+79

}

+80

}

+81

+82

module.exports = {Client, delay};

packages/slate-cli/test/terminal-restart-gate.cjsadded

@@ -0,0 +1,209 @@

+1

// Real-process gate. Only disposable state, nodes and PTYs are touched.

+2

const fs = require('node:fs');

+3

const os = require('node:os');

+4

const path = require('node:path');

+5

const net = require('node:net');

+6

const assert = require('node:assert/strict');

+7

const {spawn} = require('node:child_process');

+8

const {Client, delay} = require('./helpers/terminal-client.cjs');

+9

const {relayServer} = require('./helpers/relay-peer.cjs');

+10

+11

async function waitFor(test, label, milliseconds = 10000) {

+12

const deadline = Date.now() + milliseconds;

+13

while (Date.now() < deadline) {

+14

if (await test()) return;

+15

await delay(50);

+16

}

+17

throw Error(`Timeout: ${label}`);

+18

}

+19

function running(pid) {

+20

try { return fs.readFileSync(`/proc/${pid}/stat`, 'utf8').split(') ')[1][0] !== 'Z'; }

+21

catch { return false; }

+22

}

+23

async function refusedOwnerHandshake(endpoint, hello) {

+24

await new Promise((resolve, reject) => {

+25

const socket = net.connect(endpoint);

+26

const timer = setTimeout(() => { socket.destroy(); reject(Error('owner handshake did not close')); }, 3000);

+27

let bytes = 0;

+28

socket.on('connect', () => {

+29

const payload = Buffer.from(JSON.stringify(hello));

+30

const header = Buffer.alloc(4);

+31

header[0] = 0x81; header[1] = 126; header.writeUInt16BE(payload.length, 2);

+32

socket.write(Buffer.concat([header, payload]));

+33

});

+34

socket.on('data', data => { bytes += data.length; });

+35

socket.on('error', reject);

+36

socket.on('close', () => {

+37

clearTimeout(timer);

+38

if (bytes === 0) resolve(); else reject(Error('owner accepted an invalid identity/version'));

+39

});

+40

});

+41

}

+42

+43

(async () => {

+44

const binary = path.resolve(process.argv[2] || process.env.SLATE_TEST_BIN);

+45

const root = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-restart-'));

+46

const clients = [], children = [], shells = new Set(), owners = new Set();

+47

const state = path.join(root, 'slate');

+48

fs.mkdirSync(state, {mode: 0o700});

+49

fs.mkdirSync(path.join(root, 'app'));

+50

fs.writeFileSync(path.join(root, 'app/index.html'), 'Disposable lifecycle test');

+51

fs.writeFileSync(path.join(state, 'enclave-node.json'), JSON.stringify({

+52

version: 2, origin: 'http://127.0.0.1:9', 'websocket-url': 'ws://127.0.0.1:9/ws',

+53

'node-name': 'restart-test', 'transport-nick': 'restart-test',

+54

'bot-id': 'fixture', token: '0'.repeat(64)

+55

}), {mode: 0o600});

+56

const reservation = net.createServer();

+57

await new Promise(resolve => reservation.listen(0, '127.0.0.1', resolve));

+58

const port = reservation.address().port;

+59

await new Promise(resolve => reservation.close(resolve));

+60

async function start() {

+61

const log = fs.openSync(path.join(root, `node-${children.length}.log`), 'a');

+62

const child = spawn(binary, ['node', 'run', '--port', String(port), '--app-dir', path.join(root, 'app')], {

+63

cwd: root, env: {...process.env, XDG_STATE_HOME: root,

+64

XDG_CONFIG_HOME: path.join(root, 'config'), SLATE_SESSION_TTL: '4'},

+65

stdio: ['ignore', log, 'pipe']

+66

});

+67

fs.closeSync(log);

+68

children.push(child);

+69

child.stderr.on('data', data => fs.appendFileSync(path.join(root, 'stderr.log'), data));

+70

child.finished = new Promise(resolve => child.once('exit', resolve));

+71

await waitFor(async () => {

+72

assert.equal(child.exitCode, null, 'node remains alive');

+73

try { return (await fetch(`http://127.0.0.1:${port}/node/health`,

+74

{signal: AbortSignal.timeout(500)})).ok; } catch { return false; }

+75

}, 'node health');

+76

return child;

+77

}

+78

async function connect() {

+79

const client = new Client(port); clients.push(client); await client.paired(); return client;

+80

}

+81

async function stop(child, signal) { child.kill(signal); await child.finished; }

+82

async function relayCheck(principal, sid, permitted) {

+83

const relay = await relayServer();

+84

const next = relay.next();

+85

const worker = spawn(binary, ['node', '_stream', relay.url, principal, 'disposable-ticket',

+86

path.join(state, 'holders', `h-test-${children.length}.sock`)], {

+87

cwd: root, env: {...process.env, XDG_STATE_HOME: root, SLATE_SESSION_TTL: '4'}, stdio: 'ignore'

+88

});

+89

children.push(worker);

+90

worker.finished = new Promise(resolve => worker.once('exit', resolve));

+91

try {

+92

const peer = await Promise.race([next, delay(10000).then(() => { throw Error('relay did not connect'); })]);

+93

await peer.wait(() => peer.ticket, 'worker ticket');

+94

const rows = (await peer.request('session/list', {})).sessions;

+95

assert.equal(rows.some(row => row.sid === sid), permitted);

+96

const attached = await peer.requestRaw('session/attach', {sid});

+97

assert.equal(attached.t, permitted ? 'ok' : 'err');

+98

if (permitted) {

+99

peer.frame(2, attached.result.chan, 'relay-survival\r');

+100

await peer.wait(() => peer.tail.includes('REPLY:relay-survival'), 'relay input reaches original shell');

+101

await peer.request('fs/stat', {path: path.join(root, 'app/index.html')});

+102

}

+103

peer.socket.destroy();

+104

await waitFor(() => worker.exitCode !== null || worker.signalCode !== null, 'empty transport worker retires');

+105

} finally {

+106

await relay.close();

+107

if (worker.exitCode === null && worker.signalCode === null) await stop(worker, 'SIGKILL');

+108

}

+109

}

+110

try {

+111

let node = await start(), client = await connect();

+112

const opened = await client.request('session/open', {argv: ['/bin/sh', '-c',

+113

'printf "SHELL-PID:%s\\n" "$$"; while read line; do printf "REPLY:%s\\n" "$line"; done'], cols: 80, rows: 24});

+114

await client.wait(() => /SHELL-PID:(\d+)/.test(client.tail), 'shell PID');

+115

const pid = Number(client.tail.match(/SHELL-PID:(\d+)/)[1]); shells.add(pid);

+116

const ownerPid = Number(fs.readFileSync(`/proc/${pid}/stat`, 'utf8').split(') ')[1].split(' ')[1]);

+117

if (ownerPid !== node.pid) owners.add(ownerPid);

+118

const latency = [];

+119

for (let i = 0; i < 64; i++) {

+120

const reply = client.waitOutput(`REPLY:latency-${i}\r\n`);

+121

const before = performance.now();

+122

client.frame(2, opened.chan, `latency-${i}\r`);

+123

await reply;

+124

latency.push(performance.now() - before);

+125

}

+126

latency.sort((a, b) => a - b);

+127

    console.log(`Local input/reply smoke measurement (64 lines): p50=${latency[32].toFixed(2)}ms p95=${latency[60].toFixed(2)}ms`);

+128

if (process.env.SLATE_LATENCY_ONLY === '1') {

+129

client.frame(8, opened.chan, Buffer.alloc(0));

+130

await waitFor(() => !running(pid), 'benchmark shell closes');

+131

return;

+132

}

+133

assert.notEqual(ownerPid, node.pid, 'PTY has an independent owner');

+134

const ownerDir = path.join(state, 'pty');

+135

assert.equal(fs.statSync(ownerDir).mode & 0o777, 0o700);

+136

const endpoint = path.join(ownerDir, fs.readdirSync(ownerDir).find(name => name.endsWith('.sock')));

+137

const identityFile = path.join(state, 'node-direct-identity.json');

+138

    const identity = fs.existsSync(identityFile) ? JSON.parse(fs.readFileSync(identityFile, 'utf8'))['key-id'] : 'local';

+139

await refusedOwnerHandshake(endpoint, {version: 1, identity: 'wrong-node', mode: 'stream', origin: 'phone'});

+140

await refusedOwnerHandshake(endpoint, {version: 99, identity, mode: 'stream', origin: 'phone'});

+141

console.log('PASS private owner directory and refusal of invalid identity/protocol');

+142

const initial = (await client.request('session/list', {})).sessions.find(row => row.sid === opened.sid);

+143

const fdCount = () => fs.readdirSync(`/proc/${ownerPid}/fd`).length;

+144

const baselineFds = fdCount();

+145

for (let i = 0; i < 24; i++) {

+146

const disposable = i % 2 ? client : await connect();

+147

      const extra = await disposable.request('session/open', {argv: ['/bin/sh', '-c', 'read line'], cols: 80, rows: 24});

+148

disposable.frame(8, extra.chan, Buffer.alloc(0));

+149

      await waitFor(async () => !(await client.request('session/list', {})).sessions.some(row => row.sid === extra.sid), 'closed session leaves catalog');

+150

if (disposable !== client) disposable.socket.destroy();

+151

}

+152

await waitFor(() => fdCount() <= baselineFds + 1, 'owner descriptors settle after repeated open/close');

+153

assert.equal((await client.request('session/list', {})).sessions.length, 1);

+154

console.log(`PASS 24 open/close cycles; owner descriptors ${baselineFds} -> ${fdCount()}`);

+155

await client.request('session/detach', {sid: opened.sid});

+156

await relayCheck(`http://127.0.0.1:${port}`, opened.sid, true);

+157

await relayCheck('foreign-principal', opened.sid, false);

+158

await client.request('session/attach', {sid: opened.sid});

+159

assert.ok(running(pid));

+160

    console.log('PASS relay reattaches same shell, foreign principal is refused, resource RPC works, empty transport workers retire');

+161

for (const signal of ['SIGTERM', 'SIGKILL', 'SIGTERM']) {

+162

await stop(node, signal); client.socket.destroy();

+163

assert.ok(running(pid), `PTY survives node ${signal}`);

+164

node = await start(); client = await connect();

+165

const row = (await client.request('session/list', {})).sessions.find(row => row.sid === opened.sid);

+166

assert.ok(row, 'same session is discovered by replacement node');

+167

assert.equal(row.created, initial.created, 'creation time is retained');

+168

const attached = await client.request('session/attach', {sid: opened.sid});

+169

assert.equal(attached.created, initial.created, 'attach reports original creation time');

+170

assert.ok(attached.age >= row.age, 'attach reports retained age');

+171

const nonce = `${signal}-${Date.now()}`;

+172

client.frame(2, attached.chan, `${nonce}\r`);

+173

await client.wait(() => client.tail.includes(`REPLY:${nonce}`), 'original shell accepts input');

+174

assert.ok(running(pid));

+175

console.log(`PASS same PID, SID, creation time and working input after ${signal}`);

+176

}

+177

await client.request('session/detach', {sid: opened.sid});

+178

await stop(node, 'SIGKILL'); client.socket.destroy();

+179

await waitFor(() => !running(pid), 'detached shell expires while node is down', 25000);

+180

console.log('PASS owner reaps detached PTY without a main node');

+181

await waitFor(() => {

+182

const dir = path.join(state, 'pty');

+183

return !fs.existsSync(dir) || !fs.readdirSync(dir).some(name => name.endsWith('.sock'));

+184

}, 'empty owner retires', 20000);

+185

console.log('PASS empty owner retires and removes its endpoint');

+186

assert.ok(!running(ownerPid), 'retired owner is no longer running');

+187

+188

node = await start(); client = await connect();

+189

    const doomed = await client.request('session/open', {argv: ['/bin/sh', '-c', 'printf "DOOMED:%s\\n" "$$"; read line'], cols: 80, rows: 24});

+190

await client.wait(() => /DOOMED:(\d+)/.test(client.tail), 'second owner shell');

+191

const doomedPid = Number(client.tail.match(/DOOMED:(\d+)/)[1]); shells.add(doomedPid);

+192

const doomedOwner = Number(fs.readFileSync(`/proc/${doomedPid}/stat`, 'utf8').split(') ')[1].split(' ')[1]);

+193

owners.add(doomedOwner);

+194

process.kill(doomedOwner, 'SIGKILL');

+195

await waitFor(() => !running(doomedPid), 'owner crash ends its PTY');

+196

    await client.wait(() => client.frames.some(frame => frame[0] === 9 && frame.readUInt32BE(1) === doomed.chan), 'owner failure is reported');

+197

const refused = await client.requestRaw('session/attach', {sid: doomed.sid});

+198

assert.equal(refused.t, 'err'); assert.equal(refused.code, 'no-session');

+199

assert.equal((await client.request('session/list', {})).sessions.length, 0);

+200

await waitFor(() => !fs.existsSync(`/proc/${doomedOwner}`), 'main node reaps exited owner');

+201

    console.log('PASS owner crash is reported, child ends, stale attach refuses without a replacement shell, owner is reaped');

+202

} finally {

+203

for (const client of clients) client.socket.destroy();

+204

    for (const child of children) if (child.exitCode === null && child.signalCode === null) await stop(child, 'SIGKILL');

+205

for (const pid of shells) if (running(pid)) { try { process.kill(pid, 'SIGKILL'); } catch {} }

+206

for (const pid of owners) if (running(pid)) { try { process.kill(pid, 'SIGKILL'); } catch {} }

+207

console.log(`Lifecycle evidence: ${root}`);

+208

}

+209

})().catch(error => { console.error(error); process.exitCode = 1; });

packages/slate-cli/test/test-agent-ceiling.sgladded

@@ -0,0 +1,244 @@

+1

;;; A1' — the agent session's authority ceiling.

+2

;;;

+3

;;; The arms here test the REAL computation from (slate-cli agent ceiling),

+4

;;; not a reimplementation of it. A test that redid the arithmetic would

+5

;;; agree with itself by construction.

+6

;;;

+7

;;; Two rules shape the file, the same ones the grant algebra's own gate

+8

;;; uses. Every arm prints the size of what it inspected, because a property

+9

;;; that holds over zero cases is indistinguishable from one that holds. And

+10

;;; every checker is run against a deliberately wrong implementation in this

+11

;;; same file, because a checker that has never returned a violation has not

+12

;;; been shown able to.

+13

+14

(import (sigil test)

+15

(sigil io)

+16

(sigil list)

+17

(sigil string)

+18

(sigil process)

+19

(sigil grant)

+20

(sigil fs)

+21

(sigil system grant)

+22

(slate-cli agent tools)

+23

(slate-cli agent ceiling))

+24

+25

(define HOME (or (getenv "HOME") "/home/nobody"))

+26

(define (under-home p) (string-append HOME "/" p))

+27

+28

;; The node postures that actually exist in config.sgl, not invented ones.

+29

(define postures

+30

(list

+31

(cons "owner" (list "fs:rw:~" "fs:ro:/" "exec:full" "pty:on"))

+32

(cons "default" (list "fs:rw:~"))

+33

(cons "useslate" (list "fs:rw:~" "exec:full" "pty:on"))

+34

(cons "empty" '())))

+35

+36

(define workspaces

+37

(list (cons "under-home" (under-home "proj"))

+38

(cons "home-itself" HOME)

+39

(cons "outside-home" "/srv/project")))

+40

+41

(define exec-flags (list (cons "noexec" #f) (cons "exec" #t)))

+42

+43

;; Every (posture x workspace x exec?) combination.

+44

(define cases

+45

(let loop ((ps postures) (acc '()))

+46

(if (null? ps) (reverse acc)

+47

(loop (cdr ps)

+48

(let loop2 ((ws workspaces) (acc acc))

+49

(if (null? ws) acc

+50

(loop2 (cdr ws)

+51

(let loop3 ((es exec-flags) (acc acc))

+52

(if (null? es) acc

+53

(loop3 (cdr es)

+54

(cons (list (string-append (car (car ps)) "/" (car (car ws)) "/" (car (car es)))

+55

(cdr (car ps))

+56

(cdr (car ws))

+57

(cdr (car es)))

+58

acc)))))))))))

+59

+60

(define (specs->g specs) (grant-from-specs (map expand-for-test specs)))

+61

;; The module expands `~` internally; the test must do the same to build the

+62

;; comparison value, and doing it here rather than importing a private helper

+63

;; keeps the module's surface honest.

+64

(define (expand-for-test s)

+65

(let ((parts (string-split s ":")))

+66

(if (and (>= (length parts) 3) (string=? (car parts) "fs"))

+67

(let ((p (string-join (cddr parts) ":")))

+68

(string-append "fs:" (cadr parts) ":"

+69

(cond ((string=? p "~") HOME)

+70

((string-starts-with? p "~/")

+71

(string-append HOME (substring p 1 (string-length p))))

+72

(else p))))

+73

s)))

+74

+75

;; ============================================================

+76

;; Checkers, each taking the ceiling function under test

+77

;; ============================================================

+78

+79

;; THE LOAD-BEARING ARM. The node must provably cover every ceiling it

+80

;; hands out. This is the property that makes the whole change worth

+81

;; making: before A1' a session could hold authority the node did not.

+82

(define (count-not-covered-by-node ceiling-fn)

+83

(let loop ((rest cases) (checked 0) (bad 0))

+84

(if (null? rest) (list checked bad)

+85

(let* ((c (car rest))

+86

(node (cadr c))

+87

(wanted (child-narrowing-specs (caddr c) (cadddr c)))

+88

(granted (ceiling-fn node wanted)))

+89

(loop (cdr rest) (+ checked 1)

+90

(if (grant-covers? (specs->g node) (specs->g granted))

+91

bad (+ bad 1)))))))

+92

+93

;; A ceiling must also never exceed what the session ASKED for: the meet is

+94

;; a lower bound of both inputs, not just of the node's root.

+95

(define (count-not-covered-by-request ceiling-fn)

+96

(let loop ((rest cases) (checked 0) (bad 0))

+97

(if (null? rest) (list checked bad)

+98

(let* ((c (car rest))

+99

(wanted (child-narrowing-specs (caddr c) (cadddr c)))

+100

(granted (ceiling-fn (cadr c) wanted)))

+101

(loop (cdr rest) (+ checked 1)

+102

(if (grant-covers? (specs->g wanted) (specs->g granted))

+103

bad (+ bad 1)))))))

+104

+105

;; The ceiling must round-trip through the argv handoff unchanged. This is

+106

;; A1's OWN corpus (workspace paths, harness argv) rather than the algebra's,

+107

;; because the module's suite can be green while this consumer's assumption

+108

;; is false.

+109

(define (count-roundtrip-violations ceiling-fn)

+110

(let loop ((rest cases) (checked 0) (bad 0))

+111

(if (null? rest) (list checked bad)

+112

(let* ((c (car rest))

+113

(wanted (child-narrowing-specs (caddr c) (cadddr c)))

+114

(granted (ceiling-fn (cadr c) wanted))

+115

;; through the wire and back: argv out, specs in

+116

(args (grant-args granted))

+117

(back (let loop2 ((a args) (acc '()))

+118

(cond ((null? a) (reverse acc))

+119

((and (string=? (car a) "--grant") (pair? (cdr a)))

+120

(loop2 (cddr a) (cons (cadr a) acc)))

+121

(else (loop2 (cdr a) acc))))))

+122

(loop (cdr rest) (+ checked 1)

+123

(if (grant=? (specs->g granted) (specs->g back)) bad (+ bad 1)))))))

+124

+125

;; ============================================================

+126

;; Deliberately wrong ceilings, as positive controls

+127

;; ============================================================

+128

+129

;; Ignores the node entirely: the PRE-A1' behaviour, and exactly the defect

+130

;; this change closes. Must violate the node-covers arm.

+131

(define (ceiling-ignoring-node node-specs wanted-specs) wanted-specs)

+132

+133

;; Hands back the node's whole root: widens past what was asked for. Must

+134

;; violate the request-covers arm.

+135

(define (ceiling-whole-root node-specs wanted-specs) node-specs)

+136

+137

(define node-real (count-not-covered-by-node compute-ceiling))

+138

(define node-ctl (count-not-covered-by-node ceiling-ignoring-node))

+139

(define req-real (count-not-covered-by-request compute-ceiling))

+140

(define req-ctl (count-not-covered-by-request ceiling-whole-root))

+141

(define rt-real (count-roundtrip-violations compute-ceiling))

+142

+143

(println "DENOM ceiling-cases ~a" (length cases))

+144

(println "DENOM node-covers-checked ~a" (car node-real))

+145

(println "DENOM request-covers-checked ~a" (car req-real))

+146

(println "DENOM roundtrip-checked ~a" (car rt-real))

+147

(println "CONTROL ignoring-node-violations ~a" (cadr node-ctl))

+148

(println "CONTROL whole-root-violations ~a" (cadr req-ctl))

+149

+150

(test-group "A1' ceiling — instrument controls"

+151

(test "the corpus is not empty"

+152

(assert-true (> (length cases) 0)))

+153

+154

(test "the node-covers checker CAN report a violation"

+155

;; The wrong implementation here is the PRE-A1' behaviour: mint the

+156

;; ceiling from the request and ignore the node. If this reported zero,

+157

;; the arm could not tell the old defect from the fix.

+158

(assert-true (> (cadr node-ctl) 0)))

+159

+160

(test "the request-covers checker CAN report a violation"

+161

(assert-true (> (cadr req-ctl) 0))))

+162

+163

(test-group "A1' ceiling — the properties"

+164

(test "the node provably covers every ceiling it hands out"

+165

(assert-equal 0 (cadr node-real)))

+166

+167

(test "no ceiling exceeds what the session asked for"

+168

(assert-equal 0 (cadr req-real)))

+169

+170

(test "the ceiling survives the argv handoff unchanged"

+171

(assert-equal 0 (cadr rt-real))))

+172

+173

(test-group "A1' ceiling — the cases that MUST NOT change"

+174

;; The common deployment: owner posture, workspace under HOME. This is

+175

;; what a local user actually runs, and A1' must not touch it.

+176

(test "owner posture with a workspace under HOME is unchanged"

+177

(let* ((node (cdr (assoc "owner" postures)))

+178

(ws (under-home "proj"))

+179

(wanted (child-narrowing-specs ws #t)))

+180

(assert-true (grant=? (specs->g wanted)

+181

(specs->g (compute-ceiling node wanted))))))

+182

+183

(test "and it is not reported as a reduction"

+184

(let ((node (cdr (assoc "owner" postures))))

+185

(assert-false (ceiling-reduced? node (child-narrowing-specs (under-home "proj") #t))))))

+186

+187

(test-group "A1' ceiling — the cases that SHOULD change, named individually"

+188

;; Each is asserted BY NAME so an unintended change cannot hide among the

+189

;; intended ones.

+190

(test "a workspace outside HOME loses WRITE under the owner posture"

+191

;; The node holds fs:ro:/ out there, so read survives and write does not.

+192

(let* ((node (cdr (assoc "owner" postures)))

+193

(granted (compute-ceiling node (child-narrowing-specs "/srv/project" #f))))

+194

(assert-true (grant-covers? (specs->g granted)

+195

(grant-from-specs '("fs:ro:/srv/project"))))

+196

(assert-false (grant-covers? (specs->g granted)

+197

(grant-from-specs '("fs:rw:/srv/project"))))))

+198

+199

(test "the restricted posture grants no exec even when the session asks"

+200

(let* ((node (cdr (assoc "default" postures)))

+201

(granted (compute-ceiling node (child-narrowing-specs (under-home "p") #t))))

+202

(assert-false (grant-covers? (specs->g granted) (grant-from-specs '("exec:full"))))))

+203

+204

(test "a node holding nothing yields an empty ceiling"

+205

(assert-equal '() (compute-ceiling '() (child-narrowing-specs (under-home "p") #t))))

+206

+207

(test "a reduction is reported as one"

+208

(assert-true (ceiling-reduced? (cdr (assoc "default" postures))

+209

(child-narrowing-specs "/srv/project" #t)))))

+210

+211

(test-group "A1' ceiling — an empty ceiling DENIES, it does not fall back"

+212

;; The case where the node holds nothing overlapping the request. The

+213

;; failure mode guarded here is a silent WIDENING: the sidecar decides

+214

;; between the handed-down ceiling and the legacy self-minted one on

+215

;; `(if grant-specs ...)`, and `'()` is TRUTHY, so an empty ceiling

+216

;; correctly takes the handed-down branch and permits nothing. Rewriting

+217

;; that test as `(pair? grant-specs)` would send the empty ceiling to the

+218

;; fallback and silently restore the un-intersected ceiling, in exactly

+219

;; the situation where the node granted nothing.

+220

(test "a table built from no specs permits no read"

+221

(assert-false (grant-check (grants-from-specs '()) 'fs-read "/tmp")))

+222

+223

(test "a table built from no specs permits no exec"

+224

(assert-false (grant-check (grants-from-specs '()) 'exec "ls")))

+225

+226

(test "and a table built from real specs DOES permit, so the arm above is not vacuous"

+227

;; Without this, "permits nothing" would also be satisfied by

+228

;; grants-from-specs being broken for every input.

+229

(let ((dir (make-temp-directory)))

+230

(assert-true (grant-check (grants-from-specs (list (string-append "fs:rw:" dir)))

+231

'fs-read dir)))))

+232

+233

(test-group "A1' ceiling — the handoff shape"

+234

(test "one spec per argv element, never packed"

+235

(assert-equal '("--grant" "fs:rw:/w" "--grant" "exec:full")

+236

(grant-args '("fs:rw:/w" "exec:full"))))

+237

+238

(test "an empty ceiling produces no arguments at all"

+239

(assert-equal '() (grant-args '())))

+240

+241

(test "a principal maps to its origin"

+242

(assert-equal "https://useslate.org" (origin-of-principal "web:https://useslate.org"))))

+243

+244

(run-tests)

packages/slate-cli/test/test-enclave-node-init.sglmodified

@@ -21,6 +21,49 @@

21

(assert-equal client-ticket (list-ref msg 3))

22

(assert-equal node-ticket (list-ref msg 4)))))

23

+24

(test "node relay ticket preserves authoritative pairing descriptors"

+25

(let* ((fields '("alice" "g7" "ct" "nt" "30"

+26

"11" "ck" "1" "cpub" "22" "ak" "2" "apub"))

+27

(line (string-append ":enclave STREAM-TICKET "

+28

(string-join fields " ")))

+29

(msg (node-session-parse-wire-message line)))

+30

(assert-equal 'stream-ticket-message (car msg))

+31

(assert-equal fields (cdr msg))))

+32

+33

(test "long DIRECT-TICKET keys bypass recursive IRC scanning"

+34

(let* ((caller-key (string-repeat "c:?[]{}+/=" 18))

+35

(acceptor-key (string-repeat "a:{}[]?+/=" 18))

+36

(line (string-append ":enclave DIRECT-TICKET caller phone req-7 "

+37

"ws://10.11.0.9:32644/direct " caller-key " "

+38

acceptor-key " 15"))

+39

(msg (node-session-parse-wire-message line)))

+40

(assert-equal 'direct-ticket-message (car msg))

+41

(assert-equal "caller" (cadr msg))

+42

(assert-equal caller-key (list-ref msg 5))

+43

(assert-equal acceptor-key (list-ref msg 6))))

+44

+45

(test "extended DIRECT-TICKET preserves both authenticated key descriptors"

+46

(let* ((line (string-append

+47

":enclave DIRECT-TICKET caller phone req-8 ws://10.0.0.2/x ckey akey 15 "

+48

"41 caller-key 2 caller-public 42 acceptor-key 3 acceptor-public"))

+49

(msg (node-session-parse-wire-message line)))

+50

(assert-equal 'direct-ticket-message (car msg))

+51

(assert-equal 15 (length (cdr msg)))

+52

(assert-equal "41" (list-ref msg 8))

+53

(assert-equal "acceptor-public" (list-ref msg 15))))

+54

+55

(test "relayed stream ticket bypasses recursive IRC scanning"

+56

(let* ((ticket (string-repeat "t:?[]{}+/=" 24))

+57

(payload (string-append "{\"ticket\":\"" ticket

+58

"\",\"expires-in\":30}"))

+59

(line (string-append

+60

":enclave ENCLAVE-RPC phone g1 stream/ticket :" payload))

+61

(msg (node-session-parse-wire-message line)))

+62

(assert-equal 'relay-ticket-message (car msg))

+63

(assert-equal "phone" (cadr msg))

+64

(assert-equal "g1" (list-ref msg 2))

+65

(assert-equal payload (list-ref msg 4))))

+66

67

(test-group "Enclave node init contract"

68

(test "pending reply pins approval URL to the configured HTTPS origin"

69

(let* ((msg (parse-irc-message

@@ -35,12 +78,18 @@

78

(msg (parse-irc-message

79

(string-append

80

"@+enclave/result.status=ok;+enclave/result.node-name=workstation;"

+81

"+enclave/result.transport-nick=slate-node-123456789abc;"

82

"+enclave/result.bot-id=42;+enclave/result.token=" token

−39

" PAIR-REQUEST workstation OK")))

+83

" PAIR-REQUEST slate-node-123456789abc OK")))

84

(completed (node-init-complete-result msg))

85

(record (and completed (node-init-record "chat.example" completed))))

86

(assert-true completed)

87

(assert-equal (dict-ref record websocket-url: "") "wss://chat.example/ws")

+88

(assert-equal (node-init-stream-websocket-url record)

+89

"wss://chat.example/ws")

+90

(assert-equal (dict-ref record node-name: "") "workstation")

+91

(assert-equal (dict-ref record transport-nick: "")

+92

"slate-node-123456789abc")

93

(assert-equal (dict-ref (node-init-record<-json (node-init-record->json record))

94

token: "") token)

95

(assert-false

@@ -48,6 +97,18 @@

97

(parse-irc-message

98

"@+enclave/result.status=ok;+enclave/result.node-name=workstation PAIR-REQUEST workstation OK")))))

99

+100

(test "a node identity may route relay streams through a distinct ingress"

+101

(let* ((token (make-string 64 #\e))

+102

(record (node-init-record<-json

+103

(string-append

+104

"{\"version\":2,\"origin\":\"https://chat.example\","

+105

"\"websocket-url\":\"wss://chat.example/ws\","

+106

"\"stream-websocket-url\":\"wss://stream.example/ws\","

+107

"\"node-name\":\"machine\",\"transport-nick\":\"machine\","

+108

"\"bot-id\":\"1\",\"token\":\"" token "\"}"))))

+109

(assert-equal (node-init-stream-websocket-url record)

+110

"wss://stream.example/ws")))

+111

112

(test "structured PAIR-REQUEST failures expose only the reason code"

113

(assert-equal

114

(node-init-failure

@@ -128,6 +189,8 @@

189

(define *inbound* '())

190

(define *sent* '())

191

(define *connections* 0)

+192

(define *blocking-receives* 0)

+193

(define *nowait-receives* 0)

194

(define (enqueue! line)

195

(set! *inbound* (append *inbound* (list (parse-irc-message line)))))

196

(define mock-transport

@@ -139,13 +202,20 @@

202

(set! *sent* (cons (apply make-irc-command command params) *sent*)))

203

register: (lambda (ws) (set! *sent* (cons "REGISTER" *sent*)))

204

receive: (lambda (ws)

+205

(set! *blocking-receives* (+ *blocking-receives* 1))

206

(if (null? *inbound*) #f

207

(let ((msg (car *inbound*)))

208

(set! *inbound* (cdr *inbound*)) msg)))

+209

receive-nowait: (lambda (ws)

+210

(set! *nowait-receives* (+ *nowait-receives* 1))

+211

(if (null? *inbound*) #f

+212

(let ((msg (car *inbound*)))

+213

(set! *inbound* (cdr *inbound*)) msg)))

214

close: (lambda (ws) #t) })

215

216

(test "node session waits for approval, persists, then proves a fresh SASL login"

217

(set! *inbound* '()) (set! *sent* '()) (set! *connections* 0)

+218

(set! *blocking-receives* 0) (set! *nowait-receives* 0)

219

(node-session-set-transport! mock-transport)

220

(let ((pending-seen #f) (saved #f) (ready #f) (failure #f)

221

(token (make-string 64 #\f)))

@@ -162,21 +232,59 @@

232

(assert-true pending-seen)

233

(enqueue!

234

(string-append "@+enclave/result.status=ok;+enclave/result.node-name=workstation;"

+235

"+enclave/result.transport-nick=slate-node-123456789abc;"

236

"+enclave/result.bot-id=42;+enclave/result.token=" token

−166

" PAIR-REQUEST workstation OK"))

+237

" PAIR-REQUEST slate-node-123456789abc OK"))

238

(node-session-poll!)

239

(assert-equal *connections* 2)

240

(assert-equal (dict-ref saved token: "") token)

+241

(assert-equal (dict-ref saved node-name: "") "workstation")

+242

(assert-equal (dict-ref saved transport-nick: "")

+243

"slate-node-123456789abc")

244

(node-session-poll!)

−171

(enqueue! ":enclave CAP workstation LS :sasl") (node-session-poll!)

−172

(enqueue! ":enclave CAP workstation ACK :sasl") (node-session-poll!)

+245

(enqueue! ":enclave CAP slate-node-123456789abc LS :sasl") (node-session-poll!)

+246

(enqueue! ":enclave CAP slate-node-123456789abc ACK :sasl") (node-session-poll!)

247

(enqueue! "AUTHENTICATE +") (node-session-poll!)

−174

(enqueue! ":enclave 903 workstation :SASL authentication successful")

+248

(enqueue! ":enclave 903 slate-node-123456789abc :SASL authentication successful")

249

(node-session-poll!)

−176

(enqueue! ":enclave 001 workstation :Welcome") (node-session-poll!)

+250

(enqueue! ":enclave 001 slate-node-123456789abc :Welcome") (node-session-poll!)

251

(assert-true ready)

252

(assert-false failure)

253

(assert-true (node-session-done?))

−180

(assert-true (member "REGISTER" *sent*)))

+254

(assert-true (member "REGISTER" *sent*))

+255

(node-session-send-command! "DIRECT-OPEN" "target-node" "g1")

+256

(assert-true (member "DIRECT-OPEN target-node g1" *sent*))

+257

;; The direct gateway shares this supervisor during authentication too.

+258

;; No auth phase may block the pump while Enclave is unavailable.

+259

(node-session-poll!)

+260

(assert-equal 0 *blocking-receives*)

+261

(assert-true (> *nowait-receives* 0))

+262

;; Losing Enclave must permit the daemon supervisor to reopen only this

+263

;; child control session without rebuilding listeners or re-enrolling.

+264

(set! *inbound* (list 'closed))

+265

(node-session-poll!)

+266

(assert-equal 'failed (node-session-phase))

+267

(assert-true (node-session-reconnect!))

+268

(assert-equal 3 *connections*)

+269

(assert-equal 'auth-connecting (node-session-phase)))

+270

(node-session-close!)

+271

(node-session-reset-transport!))

+272

+273

(test "synchronous reconnect refusal never probes a null socket"

+274

(let ((failure #f))

+275

(node-session-set-transport!

+276

#{ connect: (lambda (url nick) #f)

+277

connected?: (lambda (ws) (error "null socket was probed"))

+278

send: (lambda args #f) command: (lambda args #f)

+279

register: (lambda args #f) receive: (lambda args #f)

+280

receive-nowait: (lambda args #f) close: (lambda args #t) })

+281

(node-session-resume!

+282

#{ origin: "https://chat.example" transport-nick: "slate-node-test"

+283

token: (make-string 64 #\f) }

+284

(lambda (record) #t) (lambda (message) #t)

+285

(lambda (reason) (set! failure reason)))

+286

(node-session-poll!)

+287

(assert-equal "CONNECTION_FAILED" failure)

+288

(assert-equal 'failed (node-session-phase)))

289

(node-session-close!)

290

(node-session-reset-transport!))

packages/slate-cli/test/test-enclave-remote.sglmodified

@@ -60,13 +60,24 @@

60

(response (remote-handle-rpc (make-config) msg)))

61

(assert-equal '("STREAM-TICKET" "alice" "19") response)))

62

+63

(test "resource open routes without a session holder"

+64

(let* ((route #f)

+65

(response

+66

(remote-handle-rpc (make-config)

+67

(parse-irc-message

+68

":enclave.local ENCLAVE-RPC alice 21 resource/open :{\"id\":21,\"args\":{}}")

+69

(lambda (sender request-id hint)

+70

(set! route (list sender request-id hint))))))

+71

(assert-equal '("STREAM-TICKET" "alice" "21") response)

+72

(assert-equal (list "alice" "21" resource:) route)))

+73

74

(test "node keeps its ticket and returns only the client half"

75

(let* ((started '())

76

(response

77

(remote-handle-ticket

78

(parse-irc-message

79

":enclave.local STREAM-TICKET alice 19 client-secret node-secret 30")

−69

(lambda (client sid ticket)

+80

(lambda (client sid ticket metadata)

81

(set! started (list client sid ticket))))))

82

(assert-equal '("alice" "19" "node-secret") started)

83

(assert-equal "ENCLAVE-RPC" (car response))

@@ -78,8 +89,20 @@

89

(remote-handle-ticket

90

(parse-irc-message

91

":enclave.local STREAM-TICKET alice 20 client-marker node-marker 30")

−81

(lambda (client sid ticket) #t)))

+92

(lambda (client sid ticket metadata) #t)))

93

(wire (car (reverse response))))

94

(assert-true (string-contains? wire "client-marker"))

95

(assert-false (string-contains? wire "node-marker"))))

+96

+97

(test "node relay response forwards only public pairing descriptors"

+98

(let* ((fields '("node-a" "g9" "client-secret" "node-secret" "30"

+99

"11" "ck" "1" "cpub" "22" "ak" "2" "apub"))

+100

(response (remote-handle-ticket

+101

(cons 'stream-ticket-message fields)

+102

(lambda (client request ticket metadata) #t)))

+103

(wire (car (reverse response))))

+104

(assert-true (string-contains? wire "pairing-descriptors"))

+105

(assert-true (string-contains? wire "cpub"))

+106

(assert-true (string-contains? wire "apub"))

+107

(assert-false (string-contains? wire "node-secret"))))

108

)

packages/slate-cli/test/test-enclave-stream-resource.sgladded

@@ -0,0 +1,211 @@

+1

;;; Relay holder Resource-plane coverage. This exercises the production

+2

;;; decode/dispatch/deferred-state/send adapter without an Enclave server.

+3

+4

(import (sigil test)

+5

(sigil core)

+6

(sigil io)

+7

(sigil fs)

+8

(sigil path)

+9

(sigil json)

+10

(sigil async)

+11

(sigil wire)

+12

(sigil websocket frame)

+13

(slate-cli config)

+14

(slate-cli wire)

+15

(slate-cli enclave-stream))

+16

+17

(define ROOT (make-temp-directory))

+18

(define CLIENT "relay-test-node")

+19

(define CONFIG

+20

(make-config grants: (list (cons CLIENT

+21

(list (string-append "fs:rw:" ROOT))))))

+22

+23

(define (make-capture)

+24

(let ((frames (vector '())))

+25

(cons frames

+26

(lambda (encoded)

+27

(let ((frame (frame-decode-result-frame (decode-frame encoded))))

+28

(when frame

+29

(vector-set! frames 0 (append (vector-ref frames 0) (list frame)))))))))

+30

+31

(define (capture-frames capture) (vector-ref (car capture) 0))

+32

(define (capture-send capture) (cdr capture))

+33

+34

(define (binary-node-frames capture)

+35

(let loop ((frames (capture-frames capture)) (out '()))

+36

(cond

+37

((null? frames) (reverse out))

+38

((= (ws-frame-opcode (car frames)) opcode-binary)

+39

(let ((decoded (decode-stream-frame (ws-frame-payload (car frames)))))

+40

(loop (cdr frames) (if decoded (cons decoded out) out))))

+41

(else (loop (cdr frames) out)))))

+42

+43

(define (binary-frame-for capture type id)

+44

(let loop ((frames (binary-node-frames capture)))

+45

(and (pair? frames)

+46

(if (and (= (stream-frame-type (car frames)) type)

+47

(= (stream-frame-id (car frames)) id))

+48

(car frames)

+49

(loop (cdr frames))))))

+50

+51

(define (controls capture)

+52

(let loop ((frames (capture-frames capture)) (out '()))

+53

(cond

+54

((null? frames) (reverse out))

+55

((= (ws-frame-opcode (car frames)) opcode-text)

+56

(loop (cdr frames)

+57

(cons (decode-control (utf8->string (ws-frame-payload (car frames)))) out)))

+58

(else (loop (cdr frames) out)))))

+59

+60

(define (control-for capture type id)

+61

(let loop ((values (controls capture)))

+62

(and (pair? values)

+63

(let ((value (car values)))

+64

(if (and (equal? (dict-ref value t: #f) type)

+65

(equal? (dict-ref value id: #f) id))

+66

value

+67

(loop (cdr values)))))))

+68

+69

(define (event-for capture sub)

+70

(let loop ((values (controls capture)))

+71

(and (pair? values)

+72

(let ((value (car values)))

+73

(if (and (equal? (dict-ref value t: #f) "ev")

+74

(equal? (dict-ref value sub: #f) sub))

+75

value

+76

(loop (cdr values)))))))

+77

+78

(define (request! holder value)

+79

(enclave-stream-test-text! holder (json-encode value)))

+80

+81

(test "resource-only streams reject session creation and still read files"

+82

(let* ((capture (make-capture))

+83

(holder (make-enclave-stream-test-holder CONFIG CLIENT

+84

(capture-send capture) #t)))

+85

(request! holder #{ t: "req" id: 1 verb: "session/open"

+86

args: #{ kind: "pty" } })

+87

(assert-equal "unsupported" (dict-ref (control-for capture "err" 1) code: #f))

+88

(request! holder #{ t: "req" id: 2 verb: "fs/stat"

+89

args: #{ path: ROOT } })

+90

(assert-true (control-for capture "ok" 2))

+91

(enclave-stream-test-close! holder)))

+92

+93

(test "relay holder completes a deferred bulk write once"

+94

(let* ((capture (make-capture))

+95

(holder (make-enclave-stream-test-holder CONFIG CLIENT

+96

(capture-send capture)))

+97

(path (path-join ROOT "bulk.txt"))

+98

(payload (wire-encode (string->utf8 "relay bulk body"))))

+99

(request! holder

+100

#{ t: "req" id: 41 verb: "fs/write-file"

+101

args: #{ path: path bulk: #t } })

+102

(assert-false (control-for capture "ok" 41))

+103

(enclave-stream-test-binary! holder

+104

(encode-stream-frame frame-bulk 41 payload))

+105

(assert-true (control-for capture "ok" 41))

+106

(assert-equal "relay bulk body" (read-file-string path))

+107

;; The authority slot was consumed before dispatch; replay fails closed.

+108

(enclave-stream-test-binary! holder

+109

(encode-stream-frame frame-bulk 41 payload))

+110

(assert-equal "no-pending-bulk"

+111

(dict-ref (control-for capture "err" 41) code: #f))

+112

(enclave-stream-test-close! holder)))

+113

+114

(test "relay holder rejects an unmatched bulk body and remains usable"

+115

(let* ((capture (make-capture))

+116

(holder (make-enclave-stream-test-holder CONFIG CLIENT

+117

(capture-send capture))))

+118

(enclave-stream-test-binary! holder

+119

(encode-stream-frame frame-bulk 99 (wire-encode (string->utf8 "x"))))

+120

(assert-equal "no-pending-bulk"

+121

(dict-ref (control-for capture "err" 99) code: #f))

+122

(request! holder #{ t: "req" id: 100 verb: "fs/stat"

+123

args: #{ path: ROOT } })

+124

(assert-true (control-for capture "ok" 100))

+125

(enclave-stream-test-close! holder)))

+126

+127

(test "relay holder streams an atomic upload with receiver credit"

+128

(let* ((capture (make-capture))

+129

(holder (make-enclave-stream-test-holder CONFIG CLIENT

+130

(capture-send capture)))

+131

(path (path-join ROOT "stream-upload.bin"))

+132

(body (bytevector 9 8 7 6 5)))

+133

(write-file-string path "old")

+134

(request! holder

+135

#{ t: "req" id: 51 verb: "fs/write-file"

+136

args: #{ path: path transfer: #t size: 5 } })

+137

(assert-equal "upload"

+138

(dict-ref (dict-ref (control-for capture "ok" 51) transfer: #{})

+139

direction: #f))

+140

(assert-true (binary-frame-for capture frame-transfer-credit 51))

+141

(enclave-stream-test-binary! holder

+142

(encode-transfer-batch 51 0 body))

+143

(assert-equal "old" (read-file-string path))

+144

(enclave-stream-test-binary! holder (encode-transfer-end 51 1 5))

+145

(assert-true (control-for capture "ok" 51))

+146

(assert-true (equal? body (read-file-bytes path)))

+147

(enclave-stream-test-close! holder)))

+148

+149

(test "relay holder download parks until credit then sends batch and end"

+150

(let* ((capture (make-capture))

+151

(holder (make-enclave-stream-test-holder CONFIG CLIENT

+152

(capture-send capture)))

+153

(path (path-join ROOT "stream-download.bin")))

+154

(write-file-bytes path (bytevector 1 3 5 7))

+155

(request! holder

+156

#{ t: "req" id: 52 verb: "fs/read-file"

+157

args: #{ path: path transfer: #t } })

+158

(assert-equal "download"

+159

(dict-ref (dict-ref (control-for capture "ok" 52) transfer: #{})

+160

direction: #f))

+161

(assert-false (binary-frame-for capture frame-batch 52))

+162

(enclave-stream-test-binary! holder (encode-transfer-credit 52 4))

+163

(let* ((batch-frame (binary-frame-for capture frame-batch 52))

+164

(batch (and batch-frame (decode-transfer-batch batch-frame))))

+165

(assert-true batch)

+166

(assert-equal (bytevector 1 3 5 7) (dict-ref batch bytes: #f)))

+167

(assert-true (binary-frame-for capture frame-end 52))

+168

(enclave-stream-test-close! holder)))

+169

+170

(test "relay holder emits watch events and unwatch stops the subscription"

+171

(with-async

+172

(let* ((capture (make-capture))

+173

(holder (make-enclave-stream-test-holder CONFIG CLIENT

+174

(capture-send capture)))

+175

(watched (path-join ROOT "watched"))

+176

(path (path-join watched "changed.txt")))

+177

(ensure-directory watched)

+178

(request! holder #{ t: "req" id: 61 verb: "fs/watch"

+179

args: #{ path: watched } })

+180

(assert-true (control-for capture "ok" 61))

+181

(write-file-string path "changed")

+182

(let loop ((tries 40))

+183

(unless (or (event-for capture 61) (<= tries 0))

+184

(sleep 0.1)

+185

(loop (- tries 1))))

+186

(assert-true (event-for capture 61))

+187

(request! holder #{ t: "req" id: 62 verb: "fs/unwatch"

+188

args: #{ sub: 61 } })

+189

(assert-true (control-for capture "ok" 62))

+190

(enclave-stream-test-close! holder))))

+191

+192

(test "relay holder applies the canonical grant boundary to deferred state"

+193

(let* ((capture (make-capture))

+194

(holder (make-enclave-stream-test-holder CONFIG CLIENT

+195

(capture-send capture))))

+196

(request! holder

+197

#{ t: "req" id: 71 verb: "fs/write-file"

+198

args: #{ path: "/etc/slate-relay-must-not-write" bulk: #t } })

+199

;; Deferred writes intentionally authorize at body completion, through

+200

;; dispatch-bulk-write, so no path decision is duplicated in the adapter.

+201

(enclave-stream-test-binary! holder

+202

(encode-stream-frame frame-bulk 71

+203

(wire-encode (string->utf8 "must not land"))))

+204

(assert-equal "grant-denied"

+205

(dict-ref (control-for capture "err" 71) code: #f))

+206

(request! holder

+207

#{ t: "req" id: 72 verb: "fs/watch"

+208

args: #{ path: "/etc" } })

+209

(assert-equal "grant-denied"

+210

(dict-ref (control-for capture "err" 72) code: #f))

+211

(enclave-stream-test-close! holder)))

packages/slate-cli/test/test-git-branches.sgladded

@@ -0,0 +1,143 @@

+1

(import (sigil test) (sigil fs) (sigil path) (sigil string)

+2

(sigil system grant) (sigil system process)

+3

(slate-cli git status) (slate-cli git branch))

+4

(define ROOT #f)

+5

(define GRANTS #f)

+6

(define REPO #f)

+7

(define BASE #f)

+8

(define NEXT #f)

+9

(define (run . args)

+10

(process-exec GRANTS (append (list "git" "-C" ROOT) args)))

+11

(define (text . args)

+12

(string-trim (dict-ref (apply run args) stdout: "")))

+13

(define (empty!)

+14

(set! ROOT (make-temp-directory))

+15

(set! GRANTS (make-grants principal: "branch-test"))

+16

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+17

(grant-add! GRANTS "exec:full")

+18

(run "init" "-q" "--initial-branch=main")

+19

(run "config" "user.name" "Branch Test")

+20

(run "config" "user.email" "branch@example.invalid")

+21

(set! REPO (dict-ref (git-discover GRANTS #{ path: ROOT }) node-repo: #{})))

+22

(define (setup!)

+23

(empty!)

+24

(write-file-string (path-join ROOT "tracked.txt") "base\n")

+25

(run "add" "tracked.txt")

+26

(run "commit" "-q" "-m" "base")

+27

(set! BASE (text "rev-parse" "HEAD"))

+28

(run "branch" "old")

+29

(write-file-string (path-join ROOT "tracked.txt") "next\n")

+30

(run "commit" "-qam" "next")

+31

(set! NEXT (text "rev-parse" "HEAD")))

+32

(define (status) (git-status GRANTS #{ repo: REPO recent-limit: 0 }))

+33

(define (args name)

+34

(let ((s (status)))

+35

#{ repo: REPO name: name expected-snapshot: (dict-ref s snapshot: #{})

+36

expected-branch: (dict-ref (dict-ref s branch: #{}) head: "") }))

+37

(define (create name oid switch?)

+38

(git-create-branch GRANTS (dict-set (dict-set (args name) start-oid: oid) switch: switch?)))

+39

(define (switch name)

+40

(git-switch-branch GRANTS (dict-set (args name) target-oid: (text "rev-parse" (string-append "refs/heads/" name)))))

+41

(define (fails thunk)

+42

(guard (e (#t #t)) (thunk) #f))

+43

(test "unborn repositories can create-and-switch their initial branch"

+44

(empty!)

+45

(assert-equal '() (dict-ref (git-branches GRANTS #{ repo: REPO }) branches: #f))

+46

(assert-true (dict-ref (create "initial" "" #t) applied: #f))

+47

(assert-equal "initial" (text "symbolic-ref" "--short" "HEAD")))

+48

(test "local refs preserve names and exact object IDs"

+49

(setup!)

+50

(run "branch" "feature/naïve" BASE)

+51

(let* ((reply (git-branches GRANTS #{ repo: REPO }))

+52

(branch (find (lambda (b) (equal? "feature/naïve" (dict-ref b name: #f)))

+53

(dict-ref reply branches: '()))))

+54

(assert-equal BASE (dict-ref branch oid: #f))

+55

(assert-equal "main" (dict-ref (dict-ref reply branch: #{}) head: #f))))

+56

(test "create from selected commit leaves HEAD and index untouched"

+57

(setup!)

+58

(let ((index (read-file-bytes (path-join ROOT ".git/index"))))

+59

(assert-true (dict-ref (create "review/old" BASE #f) applied: #f))

+60

(assert-equal BASE (text "rev-parse" "review/old"))

+61

(assert-equal NEXT (text "rev-parse" "HEAD"))

+62

(assert-equal index (read-file-bytes (path-join ROOT ".git/index")))))

+63

(test "create-and-switch and switch return authoritative status"

+64

(setup!)

+65

(let ((reply (create "new/topic" NEXT #t)))

+66

(assert-equal "new/topic" (dict-ref (dict-ref (dict-ref reply status: #{}) branch: #{}) head: #f)))

+67

(assert-true (dict-ref (switch "main") applied: #f))

+68

(assert-equal "main" (text "symbolic-ref" "--short" "HEAD")))

+69

(test "switch preserves non-conflicting local work"

+70

(setup!)

+71

(run "branch" "same-tip")

+72

(write-file-string (path-join ROOT "untracked.txt") "keep me\n")

+73

(write-file-string (path-join ROOT "tracked.txt") "local changes\n")

+74

(switch "same-tip")

+75

(assert-equal "same-tip" (text "symbolic-ref" "--short" "HEAD"))

+76

(assert-equal "local changes\n" (read-file-string (path-join ROOT "tracked.txt")))

+77

(assert-equal "keep me\n" (read-file-string (path-join ROOT "untracked.txt"))))

+78

(test "conflicting checkout preserves files, index and refs"

+79

(setup!)

+80

(write-file-string (path-join ROOT "tracked.txt") "local changes\n")

+81

(let ((index (read-file-bytes (path-join ROOT ".git/index"))))

+82

(assert-true (fails (lambda () (switch "old"))))

+83

(assert-true (fails (lambda () (create "refused" BASE #t))))

+84

(assert-equal "main" (text "symbolic-ref" "--short" "HEAD"))

+85

(assert-equal "local changes\n" (read-file-string (path-join ROOT "tracked.txt")))

+86

(assert-equal index (read-file-bytes (path-join ROOT ".git/index")))

+87

(assert-false (= 0 (dict-ref (run "show-ref" "--verify" "refs/heads/refused") exit: -1)))))

+88

(test "existing refs and invalid names cannot be overwritten"

+89

(setup!)

+90

(assert-true (fails (lambda () (create "old" NEXT #f))))

+91

(assert-equal BASE (text "rev-parse" "old"))

+92

(for-each (lambda (name)

+93

(assert-true (fails (lambda () (create name BASE #f)))))

+94

'("--force" "HEAD" "../escape" "bad..name" "@{-1}" "has space" "refs.lock"))

+95

(assert-true (fails (lambda () (create "invalid-start" "HEAD~1" #f)))))

+96

(test "stale snapshots reject branch changes"

+97

(setup!)

+98

(let ((request (dict-set (args "old") target-oid: BASE)))

+99

(write-file-string (path-join ROOT "untracked.txt") "changed after prompt\n")

+100

(assert-true (fails (lambda () (git-switch-branch GRANTS request))))

+101

(assert-equal "main" (text "symbolic-ref" "--short" "HEAD"))))

+102

(test "publication rechecks the selected branch tip"

+103

(setup!)

+104

(let ((request (dict-set (args "old") target-oid: BASE)))

+105

(git-branch-before-publish-hook! (lambda () (run "branch" "-f" "old" NEXT)))

+106

(assert-true (fails (lambda () (git-switch-branch GRANTS request))))

+107

(git-branch-before-publish-hook! #f)

+108

(assert-equal "main" (text "symbolic-ref" "--short" "HEAD"))))

+109

(test "publication rechecks repository state before creating a ref"

+110

(setup!)

+111

(let ((request (dict-set (dict-set (args "raced") start-oid: BASE) switch: #f)))

+112

(git-branch-before-publish-hook! (lambda () (write-file-string (path-join ROOT "new.txt") "race\n")))

+113

(assert-true (fails (lambda () (git-create-branch GRANTS request))))

+114

(git-branch-before-publish-hook! #f)

+115

(assert-false (= 0 (dict-ref (run "show-ref" "--verify" "refs/heads/raced") exit: -1)))))

+116

(test "read-only grants and canonical mismatch cannot change branches"

+117

(setup!)

+118

(let ((readonly (make-grants principal: "reader")))

+119

(grant-add! readonly (string-append "fs:ro:" ROOT))

+120

(grant-add! readonly "exec:full")

+121

(assert-true (dict? (git-branches readonly #{ repo: REPO })))

+122

(assert-true (fails (lambda ()

+123

                          (git-create-branch readonly (dict-set (dict-set (args "denied") start-oid: BASE) switch: #f))))))

+124

(assert-true (fails (lambda () (git-branches GRANTS #{ repo: (dict-set REPO common-dir: ROOT) })))))

+125

(test "linked worktree ownership is respected"

+126

(setup!)

+127

(let ((linked (path-join ROOT "linked")))

+128

(run "worktree" "add" "-q" linked "old")

+129

(assert-true (fails (lambda () (switch "old"))))

+130

(assert-equal "main" (text "symbolic-ref" "--short" "HEAD"))))

+131

(test "in-progress operations refuse branch mutations"

+132

(setup!)

+133

(write-file-string (path-join ROOT ".git/CHERRY_PICK_HEAD") (string-append BASE "\n"))

+134

(assert-true (fails (lambda () (create "during-pick" BASE #f)))))

+135

(test "branch listing refuses overflow rather than silently omitting refs"

+136

(setup!)

+137

(let loop ((i 0))

+138

(when (< i 499)

+139

(run "branch" (string-append "many/" (number->string i)) BASE)

+140

(loop (+ i 1))))

+141

(assert-true (fails (lambda () (git-branches GRANTS #{ repo: REPO })))))

+142

+143

(test-summary)

packages/slate-cli/test/test-git-diff-contract.sgladded

@@ -0,0 +1,174 @@

+1

;;; A4 node-owned structured diff paging.

+2

(import (sigil core) (sigil test) (sigil fs) (sigil path) (sigil process)

+3

(sigil async) (sigil system grant) (sigil system process)

+4

(slate-cli git status) (slate-cli git diff))

+5

+6

(define ROOT (make-temp-directory))

+7

(define REPO (path-join ROOT "repo"))

+8

(ensure-directory REPO)

+9

(define GRANTS (make-grants principal: "git-diff-test"))

+10

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+11

(grant-add! GRANTS "exec:full")

+12

(define (run . args) (process-exec GRANTS (append (list "git" "-C" REPO) args)))

+13

(run "init" "-q" "--initial-branch=main")

+14

(run "config" "user.name" "Slate Test")

+15

(run "config" "user.email" "slate@example.invalid")

+16

(write-file-string (path-join REPO "review.txt") "one\ntwo\nthree\n")

+17

(write-file-string (path-join REPO "huge.txt") "base\n")

+18

(run "add" "--" "review.txt" "huge.txt")

+19

(run "commit" "-q" "-m" "base")

+20

(write-file-string (path-join REPO "review.txt") "one\nchanged\nthree\nadded\n")

+21

(define DISCOVERY (git-discover GRANTS #{ path: REPO }))

+22

(define NODE-REPO (dict-ref DISCOVERY node-repo: #{}))

+23

(define REPOSITORY #{ root: "test" worktree: (dict-ref NODE-REPO worktree: "")

+24

common-dir: (dict-ref NODE-REPO common-dir: "") })

+25

(define STATUS (git-status GRANTS #{ repo: REPOSITORY recent-limit: 0 }))

+26

(define SNAPSHOT (dict-ref STATUS snapshot: #{}))

+27

+28

(test "worktree diff returns structured bounded pages"

+29

(let* ((page (git-diff GRANTS #{ repo: REPOSITORY snapshot: SNAPSHOT

+30

kind: "worktree" target: "review.txt" cursor: #f

+31

max-lines: 3 max-bytes: 262144 }))

+32

(file (car (dict-ref page files: '())))

+33

(lines (dict-ref file hunks: '())))

+34

(assert-equal 1 (dict-ref page version: 0))

+35

(assert-true (<= (length lines) 3))

+36

(assert-false (dict-ref page complete: #t))

+37

(assert-true (string? (dict-ref page next-cursor: #f)))

+38

(git-diff GRANTS #{ repo: REPOSITORY snapshot: SNAPSHOT

+39

kind: "worktree" target: "review.txt"

+40

cursor: (dict-ref page next-cursor: #f) cancel: #t

+41

max-lines: 3 max-bytes: 262144 })))

+42

+43

(test "continuation completes without exceeding requested line ceiling"

+44

(let loop ((cursor #f) (pages 0))

+45

(let ((page (git-diff GRANTS #{ repo: REPOSITORY snapshot: SNAPSHOT

+46

kind: "worktree" target: "review.txt" cursor: cursor

+47

max-lines: 4 max-bytes: 262144 })))

+48

(assert-true (<= (length (dict-ref (car (dict-ref page files: '())) hunks: '())) 4))

+49

(if (dict-ref page complete: #f)

+50

(assert-true (> pages 0))

+51

(loop (dict-ref page next-cursor: #f) (+ pages 1))))))

+52

+53

(test "hunk lines carry old and new source coordinates"

+54

(let* ((records (git-diff-records "@@ -10,2 +20,2 @@\n old\n-gone\n+new"))

+55

(context (list-ref records 1)) (deleted (list-ref records 2))

+56

(added (list-ref records 3)))

+57

(assert-equal 10 (dict-ref context old-line: #f))

+58

(assert-equal 20 (dict-ref context new-line: #f))

+59

(assert-equal 11 (dict-ref deleted old-line: #f))

+60

(assert-equal 21 (dict-ref added new-line: #f))))

+61

+62

(test "short completed diffs let asynchronous stderr drain after process exit"

+63

(let ((baseline (git-diff-active-stream-count)))

+64

(with-async

+65

(let loop ((remaining 8))

+66

(when (> remaining 0)

+67

(let ((page (git-diff GRANTS

+68

#{ repo: REPOSITORY snapshot: SNAPSHOT kind: "worktree"

+69

target: "huge.txt" cursor: #f

+70

max-lines: 400 max-bytes: 262144 })))

+71

(assert-true (dict-ref page complete: #f))

+72

(assert-equal '() (dict-ref page files: '(unexpected))))

+73

(loop (- remaining 1)))))

+74

(assert-equal baseline (git-diff-active-stream-count))))

+75

+76

(test "untracked file diff compares the file against an empty source"

+77

(write-file-string (path-join REPO "new.txt") "first\nsecond\n")

+78

(let* ((fresh (git-status GRANTS #{ repo: REPOSITORY recent-limit: 0 }))

+79

(snap (dict-ref fresh snapshot: #{}))

+80

(page (git-diff GRANTS #{ repo: REPOSITORY snapshot: snap kind: "untracked"

+81

target: "new.txt" cursor: #f max-lines: 400 max-bytes: 262144 }))

+82

(records (dict-ref (car (dict-ref page files: '())) hunks: '())))

+83

(assert-true (any (lambda (row) (eq? (dict-ref row kind: #f) addition:)) records))))

+84

+85

(test "staged and commit diff kinds use the same structured contract"

+86

(run "add" "--" "review.txt")

+87

(let* ((fresh (git-status GRANTS #{ repo: REPOSITORY recent-limit: 0 }))

+88

(snap (dict-ref fresh snapshot: #{}))

+89

(staged (git-diff GRANTS #{ repo: REPOSITORY snapshot: snap kind: "staged"

+90

target: "review.txt" cursor: #f max-lines: 400 max-bytes: 262144 }))

+91

(head (dict-ref snap head-oid: ""))

+92

(commit (git-diff GRANTS #{ repo: REPOSITORY snapshot: snap kind: "commit"

+93

target: head cursor: #f max-lines: 400 max-bytes: 262144 })))

+94

(assert-true (pair? (dict-ref staged files: '())))

+95

(assert-true (pair? (dict-ref commit files: '())))))

+96

+97

(test "byte boundaries preserve every multibyte character and continuation coordinate"

+98

(let* ((text (string-append (make-string 80 (string-ref "λ" 0)) "😀end"))

+99

(limit (+ 65536 37)))

+100

(write-file-string (path-join REPO "huge.txt") (string-append text "\n"))

+101

(let* ((fresh (git-status GRANTS #{ repo: REPOSITORY recent-limit: 0 }))

+102

(snap (dict-ref fresh snapshot: #{})))

+103

(let loop ((cursor #f) (pages 0) (parts '()))

+104

(assert-true (< pages 30))

+105

(let* ((page (git-diff GRANTS

+106

#{ repo: REPOSITORY snapshot: snap kind: "worktree"

+107

target: "huge.txt" cursor: cursor

+108

max-lines: 400 max-bytes: limit }))

+109

(files (dict-ref page files: '()))

+110

(records (if (null? files) '() (dict-ref (car files) hunks: '())))

+111

(added (filter

+112

(lambda (row)

+113

(and (eq? (dict-ref row kind: #f) addition:)

+114

(> (dict-ref row new-line: 0) 0)))

+115

records))

+116

(next (append parts (map (lambda (row) (dict-ref row text: "")) added))))

+117

(assert-true (<= (+ (dict-ref page payload-bytes: limit) 256) limit))

+118

(for-each (lambda (row) (assert-equal 1 (dict-ref row new-line: #f))) added)

+119

(if (dict-ref page complete: #f)

+120

(begin

+121

(assert-true (> pages 1))

+122

(assert-equal (string-append "+" text) (apply string-append next)))

+123

(loop (dict-ref page next-cursor: #f) (+ pages 1) next)))))))

+124

+125

(test "multi-megabyte single line streams in encoded-byte-bounded pages"

+126

(write-file-string (path-join REPO "huge.txt") (string-append (make-string 9000000 #\x) "\n"))

+127

(let* ((fresh (git-status GRANTS #{ repo: REPOSITORY recent-limit: 0 }))

+128

(snap (dict-ref fresh snapshot: #{})))

+129

(let loop ((cursor #f) (pages 0))

+130

(let* ((page (git-diff GRANTS #{ repo: REPOSITORY snapshot: snap kind: "worktree"

+131

target: "huge.txt" cursor: cursor

+132

max-lines: 400 max-bytes: 262144 }))

+133

(records (if (null? (dict-ref page files: '())) '()

+134

(dict-ref (car (dict-ref page files: '())) hunks: '()))))

+135

(assert-true (<= (+ (dict-ref page payload-bytes: 262145) 256) 262144))

+136

(assert-true (<= (length records) 400))

+137

(if (dict-ref page complete: #f)

+138

(assert-true (> pages 30))

+139

(loop (dict-ref page next-cursor: #f) (+ pages 1)))))))

+140

+141

(test "abandoned cursors are explicitly cancelled without leaking children"

+142

(let* ((fresh (git-status GRANTS #{ repo: REPOSITORY recent-limit: 0 }))

+143

(snap (dict-ref fresh snapshot: #{}))

+144

(baseline (git-diff-active-stream-count)))

+145

(let loop ((remaining 3) (tokens '()))

+146

(if (= remaining 0)

+147

(begin

+148

(assert-equal baseline (git-diff-active-stream-count))

+149

(assert-equal 3 (length tokens)))

+150

(let* ((page (git-diff GRANTS #{ repo: REPOSITORY snapshot: snap kind: "worktree"

+151

target: "huge.txt" cursor: #f

+152

max-lines: 400 max-bytes: 262144 }))

+153

(cursor (dict-ref page next-cursor: #f)))

+154

(assert-true (string? cursor))

+155

(assert-true (not (member cursor tokens)))

+156

(assert-equal (+ baseline 1) (git-diff-active-stream-count))

+157

(git-diff GRANTS #{ repo: REPOSITORY snapshot: snap kind: "worktree"

+158

target: "huge.txt" cursor: cursor cancel: #t

+159

max-lines: 400 max-bytes: 262144 })

+160

(assert-equal baseline (git-diff-active-stream-count))

+161

(loop (- remaining 1) (cons cursor tokens)))))))

+162

+163

(test "stale snapshot is rejected before diff execution"

+164

(write-file-string (path-join REPO "new-untracked.txt") "new generation\n")

+165

(guard (e (#t (assert-true #t)))

+166

(git-diff GRANTS #{ repo: REPOSITORY snapshot: SNAPSHOT kind: "worktree"

+167

target: "review.txt" cursor: #f max-lines: 400 max-bytes: 262144 })

+168

(assert-true #f)))

+169

+170

(test "v1 line and byte ceilings fail closed"

+171

(guard (e (#t (assert-true #t)))

+172

(git-diff GRANTS #{ repo: REPOSITORY snapshot: SNAPSHOT kind: "worktree"

+173

target: "review.txt" cursor: #f max-lines: 401 max-bytes: 262144 })

+174

(assert-true #f)))

packages/slate-cli/test/test-git-discard.sgladded

@@ -0,0 +1,64 @@

+1

(import (sigil core) (sigil test) (sigil fs) (sigil path) (sigil process)

+2

(sigil json) (sigil system grant) (sigil system process)

+3

(slate-cli wire) (slate-cli dispatch) (slate-cli config)

+4

(slate-cli git mutation))

+5

+6

(define ROOT (make-temp-directory))

+7

(define ORIGIN "https://git-discard.test")

+8

(define GRANTS (make-grants principal: (string-append "web:" ORIGIN)))

+9

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+10

(grant-add! GRANTS "exec:full")

+11

(define DAEMON #{ config: (make-config state-dir: ROOT) instance: "discard-test" })

+12

(define REPO (path-join ROOT "repo"))

+13

(define (run . args) (process-exec GRANTS (append (list "git" "-C" REPO) args)))

+14

(define (req id verb args)

+15

(dispatch-req DAEMON ORIGIN GRANTS

+16

(decode-control (json-encode #{ t: "req" id: id verb: verb args: args }))))

+17

(define (ctl reply) (reply-control reply))

+18

(define (res reply) (dict-ref (ctl reply) result: #{}))

+19

(define (entry data path)

+20

(find (lambda (item) (string=? path (dict-ref item path: "")))

+21

(dict-ref data entries: '())))

+22

+23

(ensure-directory REPO)

+24

(run "init" "-q" "--initial-branch=main")

+25

(run "config" "user.name" "Slate Test")

+26

(run "config" "user.email" "slate@example.invalid")

+27

(write-file-string (path-join REPO "tracked.txt") "base\n")

+28

(run "add" "--" "tracked.txt")

+29

(run "commit" "-q" "-m" "base")

+30

+31

(define discovered (res (req 1 "git/discover" #{ path: REPO })))

+32

(define node-repo (dict-ref discovered node-repo: #{}))

+33

(define REPO-ID #{ root: "remote" worktree: (dict-ref node-repo worktree: "")

+34

common-dir: (dict-ref node-repo common-dir: "") })

+35

(define (status) (res (req 2 "git/status" #{ repo: REPO-ID recent-limit: 0 })))

+36

(define (discard id data path)

+37

(req id "git/discard-file"

+38

#{ repo: REPO-ID expected-snapshot: (dict-ref data snapshot: #{})

+39

entry-id: (dict-ref (entry data path) id: "") }))

+40

+41

(test "tracked file discard restores node-owned content"

+42

(write-file-string (path-join REPO "tracked.txt") "changed\n")

+43

(let ((reply (discard 10 (status) "tracked.txt")))

+44

(assert-equal "ok" (dict-ref (ctl reply) t: ""))

+45

(assert-equal "base\n" (read-file-string (path-join REPO "tracked.txt")))))

+46

+47

(test "untracked discard removes only the selected path"

+48

(write-file-string (path-join REPO "throw.txt") "throw\n")

+49

(write-file-string (path-join REPO "keep.txt") "keep\n")

+50

(let ((reply (discard 11 (status) "throw.txt")))

+51

(assert-equal "ok" (dict-ref (ctl reply) t: ""))

+52

(assert-equal #f (file-exists? (path-join REPO "throw.txt")))

+53

(assert-true (file-exists? (path-join REPO "keep.txt")))))

+54

+55

(test "stale discard changes neither index nor newer worktree bytes"

+56

(write-file-string (path-join REPO "tracked.txt") "rendered\n")

+57

(let* ((old (status)) (wanted (entry old "tracked.txt")))

+58

(write-file-string (path-join REPO "tracked.txt") "newer\n")

+59

(let ((reply (req 12 "git/discard-file"

+60

#{ repo: REPO-ID expected-snapshot: (dict-ref old snapshot: #{})

+61

entry-id: (dict-ref wanted id: "") })))

+62

(assert-equal "err" (dict-ref (ctl reply) t: ""))

+63

(assert-equal "stale-snapshot" (dict-ref (ctl reply) code: ""))

+64

(assert-equal "newer\n" (read-file-string (path-join REPO "tracked.txt"))))))

packages/slate-cli/test/test-git-file-mutations.sgladded

@@ -0,0 +1,175 @@

+1

(import (sigil core) (sigil test) (sigil fs) (sigil path) (sigil process) (sigil string)

+2

(sigil json) (sigil crypto) (sigil system grant) (sigil system process)

+3

(slate-cli wire) (slate-cli dispatch) (slate-cli config)

+4

(slate-cli git mutation))

+5

+6

(define ROOT (make-temp-directory))

+7

(define ORIGIN "https://git-mutation.test")

+8

(define GRANTS (make-grants principal: (string-append "web:" ORIGIN)))

+9

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+10

(grant-add! GRANTS "exec:full")

+11

(define DAEMON #{ config: (make-config state-dir: ROOT) instance: "mutation-test" })

+12

+13

(define (run cwd . args) (process-exec GRANTS (append (list "git" "-C" cwd) args)))

+14

(define (request id verb args)

+15

(dispatch-req DAEMON ORIGIN GRANTS

+16

(decode-control (json-encode #{ t: "req" id: id verb: verb args: args }))))

+17

(define (control reply) (reply-control reply))

+18

(define (result reply) (dict-ref (control reply) result: #{}))

+19

(define (repo-for path root-name)

+20

(let ((node-repo (dict-ref (result (request 1 "git/discover" #{ path: path })) node-repo: #{})))

+21

#{ root: root-name worktree: (dict-ref node-repo worktree: "")

+22

common-dir: (dict-ref node-repo common-dir: "") }))

+23

(define (status repo) (result (request 2 "git/status" #{ repo: repo recent-limit: 0 })))

+24

(define (entry-for data path)

+25

(find (lambda (entry) (string=? (dict-ref entry path: "") path))

+26

(dict-ref data entries: '())))

+27

(define (mutate id verb repo snapshot entry)

+28

(request id verb #{ repo: repo expected-snapshot: snapshot

+29

entry-id: (dict-ref entry id: "") }))

+30

(define (git-text cwd . args)

+31

(string-trim (dict-ref (apply run cwd args) stdout: "")))

+32

(define (index-bytes repo)

+33

(read-file-bytes (path-join (dict-ref repo common-dir: "") "index")))

+34

+35

(define REPO (path-join ROOT "repo"))

+36

(ensure-directory REPO)

+37

(run REPO "init" "-q" "--initial-branch=main")

+38

(run REPO "config" "user.name" "Slate Test")

+39

(run REPO "config" "user.email" "slate@example.invalid")

+40

(write-file-string (path-join REPO "both.txt") "base\n")

+41

(write-file-string (path-join REPO "delete.txt") "delete\n")

+42

(write-file-string (path-join REPO "old name.txt") "rename\n")

+43

(run REPO "add" "--" "both.txt" "delete.txt" "old name.txt")

+44

(run REPO "commit" "-q" "-m" "base")

+45

+46

(test-group "snapshot guarded file mutations"

+47

(test "linked worktree unstages a newly added file from its own index"

+48

(let ((linked (path-join ROOT "linked")))

+49

(run REPO "worktree" "add" "-q" "-b" "linked-file-test" linked)

+50

(write-file-string (path-join linked "linked-new.txt") "new\n")

+51

(let* ((repo (repo-for linked "linked")) (before (status repo))

+52

(staged (mutate 8 "git/stage-file" repo (dict-ref before snapshot: #{})

+53

(entry-for before "linked-new.txt")))

+54

(after (result staged))

+55

(unstaged (mutate 9 "git/unstage-file" repo (dict-ref after snapshot: #{})

+56

(entry-for after "linked-new.txt"))))

+57

(assert-equal "ok" (dict-ref (control staged) t: ""))

+58

(assert-equal "ok" (dict-ref (control unstaged) t: ""))

+59

(assert-equal "" (git-text linked "diff" "--cached" "--" "linked-new.txt")))))

+60

+61

(test "stage and unstage hostile untracked filenames through real dispatch"

+62

(for-each

+63

(lambda (path)

+64

(write-file-string (path-join REPO path) "new\n")

+65

(let* ((repo (repo-for REPO "local")) (before (status repo))

+66

(entry (entry-for before path))

+67

(staged (mutate 10 "git/stage-file" repo (dict-ref before snapshot: #{}) entry)))

+68

(assert-equal "ok" (dict-ref (control staged) t: ""))

+69

(let* ((after (result staged)) (staged-entry (entry-for after path))

+70

(unstaged (mutate 11 "git/unstage-file" repo

+71

(dict-ref after snapshot: #{}) staged-entry)))

+72

(assert-equal "ok" (dict-ref (control unstaged) t: ""))

+73

(assert-true (file-exists? (path-join REPO path))))))

+74

(list "space name.txt" "tab\tname.txt" "line\nname.txt" "naïve.txt" "-leading.txt")))

+75

+76

(test "staged plus unstaged state stages only the selected current state"

+77

(write-file-string (path-join REPO "both.txt") "staged\n")

+78

(run REPO "add" "--" "both.txt")

+79

(write-file-string (path-join REPO "both.txt") "worktree\n")

+80

(let* ((repo (repo-for REPO "local")) (before (status repo))

+81

(reply (mutate 20 "git/stage-file" repo (dict-ref before snapshot: #{})

+82

(entry-for before "both.txt"))))

+83

(assert-equal "ok" (dict-ref (control reply) t: ""))

+84

(assert-equal "worktree" (git-text REPO "show" ":both.txt"))))

+85

+86

(test "deleted and renamed entries preserve Git path semantics"

+87

(run REPO "reset" "-q" "--hard" "HEAD")

+88

(delete-file (path-join REPO "delete.txt"))

+89

(run REPO "mv" "--" "old name.txt" "new name.txt")

+90

(let* ((repo (repo-for REPO "local")) (before (status repo))

+91

(deleted (entry-for before "delete.txt"))

+92

(r1 (mutate 30 "git/stage-file" repo (dict-ref before snapshot: #{}) deleted))

+93

(after1 (result r1)) (renamed (entry-for after1 "new name.txt"))

+94

(r2 (mutate 31 "git/unstage-file" repo (dict-ref after1 snapshot: #{}) renamed)))

+95

(assert-equal "ok" (dict-ref (control r1) t: ""))

+96

(assert-equal "ok" (dict-ref (control r2) t: ""))

+97

(let* ((after2 (result r2))

+98

(renamed2 (or (entry-for after2 "new name.txt")

+99

(entry-for after2 "old name.txt")))

+100

(r3 (mutate 32 "git/stage-file" repo (dict-ref after2 snapshot: #{}) renamed2)))

+101

(assert-equal "ok" (dict-ref (control r3) t: "")))))

+102

+103

(test "stale snapshot changes neither index nor newer worktree state"

+104

(run REPO "reset" "-q" "--hard" "HEAD")

+105

(write-file-string (path-join REPO "both.txt") "rendered\n")

+106

(let* ((repo (repo-for REPO "remote")) (rendered (status repo))

+107

(entry (entry-for rendered "both.txt")))

+108

(write-file-string (path-join REPO "both.txt") "concurrent\n")

+109

(let* ((current (status repo))

+110

(index-before (index-bytes repo))

+111

(worktree-before (read-file-string (path-join REPO "both.txt")))

+112

(reply (mutate 40 "git/stage-file" repo

+113

(dict-ref rendered snapshot: #{}) entry))

+114

(after (status repo)))

+115

(assert-equal "err" (dict-ref (control reply) t: ""))

+116

(assert-equal "stale-snapshot" (dict-ref (control reply) code: ""))

+117

(assert-equal index-before (index-bytes repo))

+118

(assert-equal worktree-before (read-file-string (path-join REPO "both.txt"))))))

+119

+120

(test "edit in the validation publication window changes neither index nor worktree"

+121

(run REPO "reset" "-q" "--hard" "HEAD")

+122

(write-file-string (path-join REPO "both.txt") "rendered-window\n")

+123

(let* ((repo (repo-for REPO "remote")) (rendered (status repo))

+124

(entry (entry-for rendered "both.txt"))

+125

(index-before (index-bytes repo)))

+126

(git-mutation-before-publish-hook!

+127

(lambda ()

+128

(git-mutation-before-publish-hook! #f)

+129

(write-file-string (path-join REPO "both.txt") "exact-window\n")))

+130

(let ((reply (mutate 45 "git/stage-file" repo

+131

(dict-ref rendered snapshot: #{}) entry)))

+132

(git-mutation-before-publish-hook! #f)

+133

(assert-equal "err" (dict-ref (control reply) t: ""))

+134

(assert-equal "stale-snapshot" (dict-ref (control reply) code: ""))

+135

(assert-equal index-before (index-bytes repo))

+136

(assert-equal "exact-window\n"

+137

(read-file-string (path-join REPO "both.txt"))))))

+138

+139

(test "atomic publication failure leaves index and worktree byte-identical"

+140

(run REPO "reset" "-q" "--hard" "HEAD")

+141

(write-file-string (path-join REPO "both.txt") "publish-failure\n")

+142

(let* ((repo (repo-for REPO "remote")) (rendered (status repo))

+143

(entry (entry-for rendered "both.txt"))

+144

(lock (path-join (dict-ref repo common-dir: "") "index.lock"))

+145

(index-before (index-bytes repo))

+146

(worktree-before (read-file-string (path-join REPO "both.txt"))))

+147

(git-mutation-before-publish-hook!

+148

(lambda ()

+149

(git-mutation-before-publish-hook! #f)

+150

(write-file-string lock "held\n")))

+151

(let ((reply (mutate 46 "git/stage-file" repo

+152

(dict-ref rendered snapshot: #{}) entry)))

+153

(git-mutation-before-publish-hook! #f)

+154

(when (file-exists? lock) (delete-file lock))

+155

(assert-equal "err" (dict-ref (control reply) t: ""))

+156

(assert-equal "operation-failed" (dict-ref (control reply) code: ""))

+157

(assert-equal index-before (index-bytes repo))

+158

(assert-equal worktree-before

+159

(read-file-string (path-join REPO "both.txt"))))))

+160

+161

(test "unborn HEAD unstage preserves the worktree file"

+162

(let ((unborn (path-join ROOT "unborn")))

+163

(ensure-directory unborn)

+164

(run unborn "init" "-q" "--initial-branch=main")

+165

(write-file-string (path-join unborn "intent.txt") "intent\n")

+166

(run unborn "add" "-N" "--" "intent.txt")

+167

(let* ((repo (repo-for unborn "local")) (before (status repo))

+168

(entry (entry-for before "intent.txt"))

+169

(staged (mutate 50 "git/stage-file" repo (dict-ref before snapshot: #{}) entry))

+170

(after (result staged))

+171

(unstaged (mutate 51 "git/unstage-file" repo

+172

(dict-ref after snapshot: #{}) (entry-for after "intent.txt"))))

+173

(assert-equal "ok" (dict-ref (control staged) t: ""))

+174

(assert-equal "ok" (dict-ref (control unstaged) t: ""))

+175

(assert-true (file-exists? (path-join unborn "intent.txt")))))))

packages/slate-cli/test/test-git-hunk-mutations.sgladded

@@ -0,0 +1,175 @@

+1

(import (sigil core) (sigil test) (sigil fs) (sigil path) (sigil process) (sigil string)

+2

(sigil json) (sigil crypto) (sigil system grant) (sigil system process)

+3

(slate-cli wire) (slate-cli dispatch) (slate-cli config)

+4

(slate-cli git mutation))

+5

+6

(define ROOT (make-temp-directory))

+7

(define ORIGIN "https://git-hunk-mutation.test")

+8

(define GRANTS (make-grants principal: (string-append "web:" ORIGIN)))

+9

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+10

(grant-add! GRANTS "exec:full")

+11

(define DAEMON #{ config: (make-config state-dir: ROOT) instance: "hunk-test" })

+12

(define (run cwd . args) (process-exec GRANTS (append (list "git" "-C" cwd) args)))

+13

(define (request id verb args)

+14

(dispatch-req DAEMON ORIGIN GRANTS

+15

(decode-control (json-encode #{ t: "req" id: id verb: verb args: args }))))

+16

(define (control reply) (reply-control reply))

+17

(define (result reply) (dict-ref (control reply) result: #{}))

+18

(define (repo-for path)

+19

(let ((node-repo (dict-ref (result (request 1 "git/discover" #{ path: path })) node-repo: #{})))

+20

#{ root: "remote" worktree: (dict-ref node-repo worktree: "")

+21

common-dir: (dict-ref node-repo common-dir: "") }))

+22

(define (status repo) (result (request 2 "git/status" #{ repo: repo recent-limit: 0 })))

+23

(define (entry-for data path)

+24

(find (lambda (entry) (string=? (dict-ref entry path: "") path))

+25

(dict-ref data entries: '())))

+26

(define (git-text cwd . args) (dict-ref (apply run cwd args) stdout: ""))

+27

(define (index-bytes repo) (read-file-bytes (path-join (dict-ref repo common-dir: "") "index")))

+28

(define (range-parts token)

+29

(let* ((parts (string-split (substring token 1 (string-length token)) ",")))

+30

(cons (or (string->number (car parts)) 0)

+31

(if (null? (cdr parts)) 1 (or (string->number (cadr parts)) 0)))))

+32

(define (identities data path side diff)

+33

(let ((file-id (dict-ref (entry-for data path) id: "")))

+34

(filter-map

+35

(lambda (line)

+36

(and (string-starts-with? line "@@ ")

+37

(let* ((parts (string-split line " "))

+38

(old (range-parts (list-ref parts 1)))

+39

(new (range-parts (list-ref parts 2))))

+40

#{ file-id: file-id side: side old-start: (car old) old-lines: (cdr old)

+41

new-start: (car new) new-lines: (cdr new) context-hash: (sha256 line) })))

+42

(string-split diff "\n"))))

+43

(define (mutate id verb repo snapshot identity)

+44

(request id verb #{ repo: repo expected-snapshot: snapshot hunk-id: identity }))

+45

(define (make-lines first second)

+46

(string-join

+47

(map (lambda (n)

+48

(cond ((= n 3) first) ((= n 70) second)

+49

(else (string-append "line " (number->string n)))))

+50

(iota 100)) "\n"))

+51

+52

(define REPO (path-join ROOT "repo"))

+53

(ensure-directory REPO)

+54

(run REPO "init" "-q" "--initial-branch=main")

+55

(run REPO "config" "user.name" "Slate Test")

+56

(run REPO "config" "user.email" "slate@example.invalid")

+57

(write-file-string (path-join REPO "multi.txt") (make-lines "line 3" "line 70"))

+58

(run REPO "add" "--" "multi.txt")

+59

(run REPO "commit" "-q" "-m" "base")

+60

+61

(test-group "node-owned hunk mutations"

+62

(test "linked worktree stages a hunk against its own index"

+63

(let ((linked (path-join ROOT "linked")))

+64

(run REPO "worktree" "add" "-q" "-b" "linked-hunk-test" linked)

+65

(write-file-string (path-join linked "multi.txt")

+66

(make-lines "linked change" "line 70"))

+67

(let* ((repo (repo-for linked)) (before (status repo))

+68

(wanted (car (identities before "multi.txt" "worktree"

+69

(git-text linked "diff" "--" "multi.txt"))))

+70

(staged (mutate 8 "git/stage-hunk" repo

+71

(dict-ref before snapshot: #{}) wanted)))

+72

(assert-equal "ok" (dict-ref (control staged) t: ""))

+73

(assert-true (string-contains? (git-text linked "diff" "--cached")

+74

"linked change")))))

+75

+76

(test "stage the exact non-first worktree hunk and unstage its exact index hunk"

+77

(write-file-string (path-join REPO "multi.txt") (make-lines "changed first" "changed second"))

+78

(let* ((repo (repo-for REPO)) (before (status repo))

+79

(ids (identities before "multi.txt" "worktree" (git-text REPO "diff" "--" "multi.txt")))

+80

(staged (mutate 10 "git/stage-hunk" repo (dict-ref before snapshot: #{}) (cadr ids))))

+81

(assert-equal "ok" (dict-ref (control staged) t: ""))

+82

(assert-equal (make-lines "line 3" "changed second")

+83

(git-text REPO "show" ":multi.txt"))

+84

(let* ((after (result staged))

+85

(staged-ids (identities after "multi.txt" "staged" (git-text REPO "diff" "--cached" "--" "multi.txt")))

+86

(unstaged (mutate 11 "git/unstage-hunk" repo (dict-ref after snapshot: #{})

+87

(car staged-ids))))

+88

(assert-equal "ok" (dict-ref (control unstaged) t: ""))

+89

(assert-equal (make-lines "line 3" "line 70")

+90

(git-text REPO "show" ":multi.txt"))

+91

(assert-equal "" (git-text REPO "diff" "--cached")))))

+92

+93

(test "new first hunk returns stale and changes nothing"

+94

(run REPO "reset" "-q" "--hard" "HEAD")

+95

(write-file-string (path-join REPO "multi.txt") (make-lines "rendered" "line 70"))

+96

(let* ((repo (repo-for REPO)) (rendered (status repo))

+97

(wanted (car (identities rendered "multi.txt" "worktree"

+98

(git-text REPO "diff" "--" "multi.txt")))))

+99

(write-file-string (path-join REPO "multi.txt") (make-lines "rendered" "inserted new hunk"))

+100

(let ((index-before (index-bytes repo)) (worktree-before (read-file-string (path-join REPO "multi.txt")))

+101

(reply (mutate 20 "git/stage-hunk" repo (dict-ref rendered snapshot: #{}) wanted)))

+102

(assert-equal "err" (dict-ref (control reply) t: ""))

+103

(assert-equal "stale-snapshot" (dict-ref (control reply) code: ""))

+104

(assert-equal index-before (index-bytes repo))

+105

(assert-equal worktree-before (read-file-string (path-join REPO "multi.txt"))))))

+106

+107

(test "no-newline marker is preserved by partial staging"

+108

(run REPO "reset" "-q" "--hard" "HEAD")

+109

(write-file-string (path-join REPO "multi.txt") "replacement without newline")

+110

(let* ((repo (repo-for REPO)) (before (status repo))

+111

(wanted (car (identities before "multi.txt" "worktree"

+112

(git-text REPO "diff" "--" "multi.txt"))))

+113

(reply (mutate 30 "git/stage-hunk" repo (dict-ref before snapshot: #{}) wanted)))

+114

(assert-equal "ok" (dict-ref (control reply) t: ""))

+115

(assert-true (string-contains? (git-text REPO "diff" "--cached")

+116

"No newline at end of file"))))

+117

+118

(test "publication failure leaves index and worktree byte-identical"

+119

(run REPO "reset" "-q" "--hard" "HEAD")

+120

(write-file-string (path-join REPO "multi.txt") (make-lines "lock failure" "line 70"))

+121

(let* ((repo (repo-for REPO)) (before (status repo))

+122

(wanted (car (identities before "multi.txt" "worktree"

+123

(git-text REPO "diff" "--" "multi.txt"))))

+124

(lock (path-join (dict-ref repo common-dir: "") "index.lock"))

+125

(index-before (index-bytes repo))

+126

(worktree-before (read-file-string (path-join REPO "multi.txt"))))

+127

(git-mutation-before-publish-hook!

+128

(lambda () (git-mutation-before-publish-hook! #f) (write-file-string lock "held\n")))

+129

(let ((reply (mutate 35 "git/stage-hunk" repo (dict-ref before snapshot: #{}) wanted)))

+130

(git-mutation-before-publish-hook! #f)

+131

(when (file-exists? lock) (delete-file lock))

+132

(assert-equal "err" (dict-ref (control reply) t: ""))

+133

(assert-equal "operation-failed" (dict-ref (control reply) code: ""))

+134

(assert-equal index-before (index-bytes repo))

+135

(assert-equal worktree-before (read-file-string (path-join REPO "multi.txt"))))))

+136

+137

(test "binary partial staging is rejected without mutation"

+138

(run REPO "reset" "-q" "--hard" "HEAD")

+139

(write-file-bytes (path-join REPO "binary.bin") (bytevector 0 1 2 3))

+140

(run REPO "add" "--" "binary.bin")

+141

(run REPO "commit" "-q" "-m" "binary")

+142

(write-file-bytes (path-join REPO "binary.bin") (bytevector 0 8 2 3))

+143

(let* ((repo (repo-for REPO)) (before (status repo))

+144

(entry (entry-for before "binary.bin"))

+145

(fake #{ file-id: (dict-ref entry id: "") side: "worktree"

+146

old-start: 1 old-lines: 1 new-start: 1 new-lines: 1 context-hash: "fake" })

+147

(index-before (index-bytes repo))

+148

(reply (mutate 40 "git/stage-hunk" repo (dict-ref before snapshot: #{}) fake)))

+149

(assert-equal "err" (dict-ref (control reply) t: ""))

+150

(assert-equal "operation-failed" (dict-ref (control reply) code: ""))

+151

(assert-equal index-before (index-bytes repo))))

+152

+153

(test "rename and mode-only partial staging are rejected"

+154

(run REPO "reset" "-q" "--hard" "HEAD")

+155

(run REPO "mv" "--" "multi.txt" "renamed.txt")

+156

(let* ((repo (repo-for REPO)) (before (status repo))

+157

(entry (entry-for before "renamed.txt"))

+158

(fake #{ file-id: (dict-ref entry id: "") side: "staged"

+159

old-start: 1 old-lines: 1 new-start: 1 new-lines: 1 context-hash: "fake" })

+160

(index-before (index-bytes repo))

+161

(reply (mutate 50 "git/unstage-hunk" repo (dict-ref before snapshot: #{}) fake)))

+162

(assert-equal "err" (dict-ref (control reply) t: ""))

+163

(assert-equal "operation-failed" (dict-ref (control reply) code: ""))

+164

(assert-equal index-before (index-bytes repo)))

+165

(run REPO "reset" "-q" "--hard" "HEAD")

+166

(run REPO "update-index" "--chmod=+x" "multi.txt")

+167

(let* ((repo (repo-for REPO)) (before (status repo))

+168

(entry (entry-for before "multi.txt"))

+169

(fake #{ file-id: (dict-ref entry id: "") side: "staged"

+170

old-start: 1 old-lines: 1 new-start: 1 new-lines: 1 context-hash: "fake" })

+171

(index-before (index-bytes repo))

+172

(reply (mutate 51 "git/unstage-hunk" repo (dict-ref before snapshot: #{}) fake)))

+173

(assert-equal "err" (dict-ref (control reply) t: ""))

+174

(assert-equal "operation-failed" (dict-ref (control reply) code: ""))

+175

(assert-equal index-before (index-bytes repo)))))

packages/slate-cli/test/test-git-log.sgladded

@@ -0,0 +1,75 @@

+1

(import (sigil test) (sigil fs) (sigil path) (sigil string)

+2

(sigil system grant) (sigil system process)

+3

(slate-cli git status) (slate-cli git log) (slate-cli git diff))

+4

(define ROOT (make-temp-directory))

+5

(define GRANTS (make-grants principal: "history-test"))

+6

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+7

(grant-add! GRANTS "exec:full")

+8

(define (run . args) (process-exec GRANTS (append (list "git" "-C" ROOT) args)))

+9

(run "init" "-q" "--initial-branch=main")

+10

(run "config" "user.name" "History Test")

+11

(run "config" "user.email" "history@example.invalid")

+12

(define REPO (dict-ref (git-discover GRANTS #{ path: ROOT }) node-repo: #{}))

+13

(define UNBORN (git-log GRANTS #{ repo: REPO }))

+14

(test "unborn history is empty"

+15

(assert-equal '() (dict-ref UNBORN commits: #f)))

+16

(write-file-string (path-join ROOT "first.txt") "root commit text\n")

+17

(run "add" "--" "first.txt")

+18

(run "commit" "-q" "-m" "Initial naïve subject" "-m" "A body with <markup> and a second paragraph.")

+19

(define FIRST (dict-ref (car (dict-ref (git-log GRANTS #{ repo: REPO }) commits: '())) oid: ""))

+20

(run "checkout" "-q" "-b" "topic")

+21

(write-file-string (path-join ROOT "topic.txt") "topic change\n")

+22

(run "add" "--" "topic.txt")

+23

(run "commit" "-q" "-m" "Topic change")

+24

(run "checkout" "-q" "main")

+25

(run "commit" "-q" "--allow-empty" "-m" "Main change")

+26

(run "merge" "-q" "--no-ff" "topic" "-m" "Merge topic")

+27

(define PAGE (git-log GRANTS #{ repo: REPO limit: 2 }))

+28

(define MERGE (dict-ref (car (dict-ref PAGE commits: '())) oid: ""))

+29

(test "bounded history preserves merge relationships and refs"

+30

(assert-equal 2 (length (dict-ref PAGE commits: '())))

+31

(assert-equal 2 (length (dict-ref (car (dict-ref PAGE commits: '())) parents: '())))

+32

(assert-true (string-contains? (dict-ref (car (dict-ref PAGE commits: '())) refs: "") "main"))

+33

(assert-true (dict? (dict-ref PAGE next-cursor: #f))))

+34

(test "pages continue without duplicating the first page"

+35

(let ((next (git-log GRANTS #{ repo: REPO limit: 2 cursor: (dict-ref PAGE next-cursor: #f) })))

+36

(assert-equal 2 (dict-ref next offset: -1))

+37

(assert-equal #t (dict-ref next complete: #f))

+38

(assert-equal FIRST (dict-ref (cadr (dict-ref next commits: '())) oid: #f))))

+39

(test "show returns full message and canonical identity without a patch"

+40

(let ((show (git-show GRANTS #{ repo: REPO oid: FIRST })))

+41

(assert-equal REPO (dict-ref show repo: #f))

+42

(assert-true (string-contains? (dict-ref (dict-ref show commit: #{}) body: "") "<markup>"))

+43

(assert-equal #f (dict-ref show files: #f))))

+44

(define (diff-text oid)

+45

(let* ((snapshot (dict-ref (git-status GRANTS #{ repo: REPO recent-limit: 0 }) snapshot: #{}))

+46

(page (git-diff GRANTS #{ repo: REPO snapshot: snapshot kind: "commit" target: oid

+47

max-lines: 400 max-bytes: 262144 })))

+48

(string-join (fold-left

+49

(lambda (out file)

+50

(append out (map (lambda (row) (dict-ref row text: "")) (dict-ref file hunks: '()))))

+51

'() (dict-ref page files: '())) "\n")))

+52

(test "root commit inspection includes the initial tree"

+53

(assert-true (string-contains? (diff-text FIRST) "+root commit text")))

+54

(test "merge inspection compares the first parent"

+55

(assert-true (string-contains? (diff-text MERGE) "+topic change")))

+56

(define (fails thunk)

+57

(guard (e (#t #t)) (thunk) #f))

+58

(test "untrusted revision syntax and page bounds are refused"

+59

(assert-true (fails (lambda () (git-show GRANTS #{ repo: REPO oid: "--all" }))))

+60

(assert-true (fails (lambda () (git-log GRANTS #{ repo: REPO limit: 101 }))))

+61

(assert-true (fails (lambda () (git-log GRANTS #{ repo: REPO cursor: #{ offset: -1 } })))))

+62

(test "canonical repository mismatch and grant refusal fail"

+63

(assert-true (fails (lambda () (git-log GRANTS #{ repo: (dict-set REPO common-dir: ROOT) }))))

+64

(assert-true (fails (lambda () (git-log (make-grants principal: "denied") #{ repo: REPO })))))

+65

(test "a cursor cannot silently walk a changed HEAD"

+66

(run "commit" "-q" "--allow-empty" "-m" "New HEAD")

+67

(assert-true (fails (lambda () (git-log GRANTS #{ repo: REPO cursor: (dict-ref PAGE next-cursor: #f) })))))

+68

+69

(test "oversized commit metadata cannot escape the page byte ceiling"

+70

(let ((message (path-join ROOT "oversized-message.txt")))

+71

(write-file-string message (make-string 300000 #\x))

+72

(run "commit" "-q" "--allow-empty" "-F" message)

+73

(let ((oid (dict-ref (dict-ref (git-status GRANTS #{ repo: REPO recent-limit: 0 }) snapshot: #{}) head-oid: #f)))

+74

(assert-true (fails (lambda () (git-show GRANTS #{ repo: REPO oid: oid }))))

+75

(assert-true (fails (lambda () (git-log GRANTS #{ repo: REPO })))))))

packages/slate-cli/test/test-git-node-contract.sgladded

@@ -0,0 +1,423 @@

+1

;;; A1 Git node contract: real Git repositories through the real unary dispatch.

+2

(import (sigil core) (sigil test) (sigil fs) (sigil path) (sigil json)

+3

(sigil process) (sigil io) (sigil string) (sigil log)

+4

(sigil system grant) (sigil system process)

+5

(slate-cli wire) (slate-cli dispatch) (slate-cli config)

+6

(slate-cli git exec) (slate-cli git status))

+7

+8

(define ROOT (make-temp-directory))

+9

(define ORIGIN "https://git-contract.test")

+10

(define GRANTS (make-grants principal: (string-append "web:" ORIGIN)))

+11

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+12

(grant-add! GRANTS "exec:full")

+13

(define DAEMON #{ config: (make-config state-dir: ROOT) instance: "git-test" })

+14

+15

(define (run cwd . args)

+16

(process-exec GRANTS (append (list "git" "-C" cwd) args)))

+17

+18

(define REPO (path-join ROOT "repo"))

+19

(ensure-directory REPO)

+20

(run REPO "init" "-q" "--initial-branch=main")

+21

(run REPO "config" "user.name" "Slate Test")

+22

(run REPO "config" "user.email" "slate@example.invalid")

+23

(write-file-string (path-join REPO "tracked.txt") "base\n")

+24

(write-file-string (path-join REPO "old name.txt") "rename me\n")

+25

(write-file-bytes (path-join REPO "blob.bin") (bytevector 0 1 2 0 3))

+26

(run REPO "add" "--" "tracked.txt" "old name.txt" "blob.bin")

+27

(run REPO "commit" "-q" "-m" "initial")

+28

(write-file-string

+29

(path-join REPO "tracked.txt")

+30

"SECRET_PATCH_BODY_SHOULD_NOT_LOG\n")

+31

(write-file-bytes (path-join REPO "blob.bin") (bytevector 0 9 8 0 7))

+32

(run REPO "mv" "--" "old name.txt" "renamed -> file.txt")

+33

(for-each

+34

(lambda (name)

+35

(write-file-string (path-join REPO name) "special\n"))

+36

(list "space name.txt"

+37

"tab\tname.txt"

+38

"line\nname.txt"

+39

"naïve.txt"

+40

"-leading.txt"

+41

"from -> to.txt"))

+42

+43

(define BARE (path-join ROOT "bare.git"))

+44

(ensure-directory BARE)

+45

(run BARE "init" "-q" "--bare")

+46

+47

(define UNBORN (path-join ROOT "unborn"))

+48

(ensure-directory UNBORN)

+49

(run UNBORN "init" "-q" "--initial-branch=main")

+50

+51

(define DIVERGED (path-join ROOT "diverged"))

+52

(ensure-directory DIVERGED)

+53

(run DIVERGED "init" "-q" "--initial-branch=main")

+54

(run DIVERGED "config" "user.name" "Slate Test")

+55

(run DIVERGED "config" "user.email" "slate@example.invalid")

+56

(write-file-string (path-join DIVERGED "base.txt") "base\n")

+57

(run DIVERGED "add" "--" "base.txt")

+58

(run DIVERGED "commit" "-q" "-m" "base")

+59

(run DIVERGED "branch" "upstream-base")

+60

(run DIVERGED "branch" "--set-upstream-to=upstream-base" "main")

+61

(write-file-string (path-join DIVERGED "ahead.txt") "ahead\n")

+62

(run DIVERGED "add" "--" "ahead.txt")

+63

(run DIVERGED "commit" "-q" "-m" "ahead")

+64

(run DIVERGED "checkout" "-q" "upstream-base")

+65

(write-file-string (path-join DIVERGED "behind.txt") "behind\n")

+66

(run DIVERGED "add" "--" "behind.txt")

+67

(run DIVERGED "commit" "-q" "-m" "behind")

+68

(run DIVERGED "checkout" "-q" "main")

+69

+70

(define CONFLICT (path-join ROOT "conflict"))

+71

(ensure-directory CONFLICT)

+72

(run CONFLICT "init" "-q" "--initial-branch=main")

+73

(run CONFLICT "config" "user.name" "Slate Test")

+74

(run CONFLICT "config" "user.email" "slate@example.invalid")

+75

(write-file-string (path-join CONFLICT "both.txt") "base\n")

+76

(run CONFLICT "add" "--" "both.txt")

+77

(run CONFLICT "commit" "-q" "-m" "base")

+78

(run CONFLICT "checkout" "-q" "-b" "other")

+79

(write-file-string (path-join CONFLICT "both.txt") "other\n")

+80

(run CONFLICT "commit" "-q" "-am" "other")

+81

(run CONFLICT "checkout" "-q" "main")

+82

(write-file-string (path-join CONFLICT "both.txt") "main\n")

+83

(run CONFLICT "commit" "-q" "-am" "main")

+84

(guard (e (#t #f))

+85

(run CONFLICT "merge" "other"))

+86

+87

(define LINKED-CLEAN (path-join ROOT "linked-clean"))

+88

(define LINKED-CONFLICT (path-join ROOT "linked-conflict"))

+89

(run CONFLICT "worktree" "add" "-q" "-b" "linked-clean" LINKED-CLEAN "HEAD")

+90

(run CONFLICT "worktree" "add" "-q" "-b" "linked-conflict" LINKED-CONFLICT "HEAD")

+91

(guard (e (#t #f))

+92

(run LINKED-CONFLICT "merge" "other"))

+93

+94

(define (status-at path)

+95

(let* ((discovered (git-discover GRANTS #{ path: path }))

+96

(repo (dict-ref discovered node-repo: #{})))

+97

(git-status GRANTS #{ repo: repo recent-limit: 0 })))

+98

+99

(define (request id verb args grants)

+100

(dispatch-req

+101

DAEMON ORIGIN grants

+102

(decode-control

+103

(json-encode #{ t: "req" id: id verb: verb args: args }))))

+104

+105

(define (control-result reply)

+106

(dict-ref (reply-control reply) result: #{}))

+107

+108

(define (capture-debug thunk)

+109

(let ((sink (open-output-string)))

+110

(log-configure! target: sink level: 'debug format: 'text)

+111

(thunk)

+112

(let ((output (get-output-string sink)))

+113

(log-configure! level: 6)

+114

output)))

+115

+116

(test-group "git node contract - real dispatch"

+117

(test "linked worktree merge is reported as active"

+118

(let* ((status (status-at LINKED-CONFLICT))

+119

(operation (dict-ref status operation: #f)))

+120

(assert-true

+121

(file-exists?

+122

(path-join CONFLICT ".git/worktrees/linked-conflict/MERGE_HEAD")))

+123

(assert-equal "merge"

+124

(if operation (dict-ref operation kind: "") "missing"))))

+125

+126

(test "main checkout operation does not leak into a clean linked worktree"

+127

(assert-true (file-exists? (path-join CONFLICT ".git/MERGE_HEAD")))

+128

(assert-false (dict-ref (status-at LINKED-CLEAN) operation: #f)))

+129

+130

(test "captured output preserves UTF-8 across byte chunks"

+131

(let ((content (string-append (make-string 65535 #\a) "λ\x0;tail\n")))

+132

(write-file-bytes (path-join LINKED-CLEAN "capture.txt") (string->utf8 content))

+133

(run LINKED-CLEAN "add" "capture.txt")

+134

(let ((result (git-exec GRANTS LINKED-CLEAN (list "show" ":capture.txt"))))

+135

(assert-equal (string-length content)

+136

(string-length (dict-ref result stdout: "")))

+137

(assert-true (string=? content (dict-ref result stdout: "")))

+138

(assert-false (dict-ref result read-error?: #t)))

+139

(let ((result (git-exec GRANTS LINKED-CLEAN

+140

(list "show" ":capture.txt") output-limit: 65536)))

+141

(assert-true (dict-ref result output-exceeded?: #f))

+142

(assert-false (dict-ref result read-error?: #t)))))

+143

+144

(test "released runtime applies child cwd and environment"

+145

(let* ((child-dir (make-temp-directory))

+146

(parent-dir (current-directory))

+147

(variable "SLATE_GIT_CHILD_CONTEXT_PROBE")

+148

(program

+149

(string-append

+150

"(begin (import (sigil fs) (sigil process)) "

+151

"(display (current-directory)) (newline) "

+152

"(display (getenv \"" variable "\")) (newline))")))

+153

(setenv! variable #f)

+154

(let* ((child

+155

(process-spawn

+156

(executable-path) "eval" program

+157

cwd: child-dir

+158

environment:

+159

(list (string-append variable "=child"))))

+160

(child-cwd (read-line (process-stdout child)))

+161

(child-value (read-line (process-stdout child))))

+162

(assert-equal 0 (process-wait child))

+163

(assert-equal child-dir child-cwd)

+164

(assert-equal "child" child-value)

+165

(assert-equal parent-dir (current-directory))

+166

(assert-false (getenv variable)))))

+167

+168

(test "status discovery stays bounded to two rev-parse processes"

+169

(let ((trace (path-join ROOT "status-trace.jsonl"))

+170

(repo (dict-ref (git-discover GRANTS #{ path: LINKED-CLEAN }) node-repo: #{})))

+171

(let ((previous (getenv "GIT_TRACE2_EVENT")))

+172

(dynamic-wind

+173

(lambda () (setenv! "GIT_TRACE2_EVENT" trace))

+174

(lambda () (git-status GRANTS #{ repo: repo recent-limit: 0 }))

+175

(lambda () (setenv! "GIT_TRACE2_EVENT" previous))))

+176

(let* ((lines (string-split (read-file-string trace) "\n"))

+177

(starts (filter

+178

(lambda (line) (string-contains? line "\"event\":\"start\""))

+179

lines))

+180

(discovery (filter

+181

(lambda (line) (string-contains? line "\"rev-parse\""))

+182

starts)))

+183

(assert-equal 2 (length discovery))

+184

(assert-true (<= (length starts) 5)))))

+185

+186

(test "discover returns node-owned canonical facts"

+187

(let* ((reply (request 1 "git/discover" #{ path: REPO } GRANTS))

+188

(control (reply-control reply))

+189

(result (dict-ref control result: #{}))

+190

(node-repo (dict-ref result node-repo: #{})))

+191

(assert-equal "ok" (dict-ref control t: ""))

+192

(assert-equal 1 (dict-ref result version: 0))

+193

(assert-equal REPO (dict-ref node-repo worktree: ""))

+194

(assert-false (dict-contains? node-repo root:))))

+195

+196

(test "status independently validates and returns typed inventory"

+197

(let* ((discovered (control-result

+198

(request 2 "git/discover" #{ path: REPO } GRANTS)))

+199

(node-repo (dict-ref discovered node-repo: #{}))

+200

(repo #{ root: "local"

+201

worktree: (dict-ref node-repo worktree: "")

+202

common-dir: (dict-ref node-repo common-dir: "") })

+203

(status (control-result

+204

(request 3 "git/status"

+205

#{ repo: repo recent-limit: 10 } GRANTS))))

+206

(assert-equal repo (dict-ref status repo: #{}))

+207

(assert-true (pair? (dict-ref status entries: '())))

+208

(assert-false (dict-contains? status patch:))

+209

(assert-false (dict-contains? (car (dict-ref status entries: '())) patch:))))

+210

+211

(test "bare repository discovery returns canonical node identity"

+212

(let* ((result

+213

(control-result

+214

(request 31 "git/discover" #{ path: BARE } GRANTS)))

+215

(node-repo (dict-ref result node-repo: #{})))

+216

(assert-true (dict-ref result bare: #f))

+217

(assert-equal BARE (dict-ref node-repo worktree: ""))

+218

(assert-equal BARE (dict-ref node-repo common-dir: ""))))

+219

+220

(test "status supports an unborn branch with no commit history"

+221

(let* ((discovered

+222

(control-result

+223

(request 36 "git/discover" #{ path: UNBORN } GRANTS)))

+224

(node-repo (dict-ref discovered node-repo: #{}))

+225

(repo #{ root: "local"

+226

worktree: (dict-ref node-repo worktree: "")

+227

common-dir: (dict-ref node-repo common-dir: "") })

+228

(status

+229

(control-result

+230

(request 37 "git/status"

+231

#{ repo: repo recent-limit: 10 }

+232

GRANTS))))

+233

(assert-true (dict-ref (dict-ref status branch: #{}) unborn: #f))

+234

(assert-equal "" (dict-ref (dict-ref status snapshot: #{}) head-oid: "x"))

+235

(assert-equal '() (dict-ref status recent-commits: '(unexpected)))))

+236

+237

(test "branch status reports both sides of upstream divergence"

+238

(let* ((discovered

+239

(control-result

+240

(request 32 "git/discover" #{ path: DIVERGED } GRANTS)))

+241

(node-repo (dict-ref discovered node-repo: #{}))

+242

(repo #{ root: "local"

+243

worktree: (dict-ref node-repo worktree: "")

+244

common-dir: (dict-ref node-repo common-dir: "") })

+245

(status

+246

(control-result

+247

(request 33 "git/status"

+248

#{ repo: repo recent-limit: 10 }

+249

GRANTS)))

+250

(branch (dict-ref status branch: #{}))

+251

(commits (dict-ref status recent-commits: '())))

+252

(assert-equal 1 (dict-ref branch ahead: 0))

+253

(assert-equal 1 (dict-ref branch behind: 0))

+254

(assert-true (pair? commits))

+255

(assert-true (dict-contains? (car commits) subject:))))

+256

+257

(test "Git execution enforces its output ceiling"

+258

(let ((result

+259

(git-exec GRANTS ROOT (list "--version") output-limit: 1)))

+260

(assert-true (dict-ref result output-exceeded?: #f))))

+261

+262

(test "Git execution terminates a command at its deadline"

+263

(let ((result

+264

(git-exec

+265

GRANTS

+266

ROOT

+267

(list "hash-object" "--stdin")

+268

timeout: 0.01)))

+269

(assert-true (dict-ref result timeout?: #f))))

+270

+271

(test "missing Git is a named product error"

+272

(let* ((original-path (or (getenv "PATH") ""))

+273

(message

+274

(guard (e (#t

+275

(setenv! "PATH" original-path)

+276

(error-object-message e)))

+277

(setenv! "PATH" "")

+278

(git-exec GRANTS ROOT (list "--version"))

+279

(setenv! "PATH" original-path)

+280

"no-error")))

+281

(assert-equal "git-unavailable" message)))

+282

+283

(test "malformed status identity is a named operation failure"

+284

(let ((control

+285

(reply-control

+286

(request 38 "git/status"

+287

#{ repo: #{} recent-limit: 10 }

+288

GRANTS))))

+289

(assert-equal "err" (dict-ref control t: ""))

+290

(assert-equal "operation-failed" (dict-ref control code: ""))))

+291

+292

(test "status rejects a worktree and common-dir spliced across repositories"

+293

(let* ((left

+294

(control-result

+295

(request 41 "git/discover" #{ path: REPO } GRANTS)))

+296

(right

+297

(control-result

+298

(request 42 "git/discover" #{ path: DIVERGED } GRANTS)))

+299

(left-repo (dict-ref left node-repo: #{}))

+300

(right-repo (dict-ref right node-repo: #{}))

+301

(spliced

+302

#{ root: "local"

+303

worktree: (dict-ref left-repo worktree: "")

+304

common-dir: (dict-ref right-repo common-dir: "") })

+305

(control

+306

(reply-control

+307

(request 43 "git/status"

+308

#{ repo: spliced recent-limit: 10 }

+309

GRANTS))))

+310

(assert-equal "err" (dict-ref control t: ""))

+311

(assert-equal "operation-failed" (dict-ref control code: ""))))

+312

+313

(test "dispatch logs correlated bounded outcomes without repository content"

+314

(let ((plain (path-join ROOT "log-plain")))

+315

(ensure-directory plain)

+316

(let* ((discovered

+317

(control-result

+318

(request 44 "git/discover" #{ path: REPO } GRANTS)))

+319

(node-repo (dict-ref discovered node-repo: #{}))

+320

(repo #{ root: "local"

+321

worktree: (dict-ref node-repo worktree: "")

+322

common-dir: (dict-ref node-repo common-dir: "") })

+323

(long-path (apply string-append (make-list 700 "x")))

+324

(output

+325

(capture-debug

+326

(lambda ()

+327

(request 45 "git/status"

+328

#{ repo: repo recent-limit: 1 }

+329

GRANTS)

+330

(request 46 "git/unsupported" #{ repo: repo } GRANTS)

+331

(request 47 "git/unsupported"

+332

#{ repo: #{ worktree: long-path } }

+333

GRANTS)

+334

(request 48 "git/discover" #{ path: plain } GRANTS)))))

+335

(assert-true (string-contains? output "node/rpc-begin"))

+336

(assert-true (string-contains? output "node/rpc-end"))

+337

(assert-true (string-contains? output "node/rpc-refused"))

+338

(assert-true (string-contains? output "req-id=45"))

+339

(assert-true (string-contains? output "req-id=46"))

+340

(assert-true (string-contains? output "verb=git/status"))

+341

(assert-true (string-contains? output "duration-ms="))

+342

(assert-true (string-contains? output (string-append "path=" REPO)))

+343

(assert-true (string-contains? output "..."))

+344

(assert-false (string-contains? output long-path))

+345

(assert-false

+346

(string-contains? output "SECRET_PATCH_BODY_SHOULD_NOT_LOG"))

+347

(assert-false (string-contains? output "fatal:")))))

+348

+349

(test "status reports an in-progress operation and conflict metadata"

+350

(let* ((discovered

+351

(control-result

+352

(request 34 "git/discover" #{ path: CONFLICT } GRANTS)))

+353

(node-repo (dict-ref discovered node-repo: #{}))

+354

(repo #{ root: "local"

+355

worktree: (dict-ref node-repo worktree: "")

+356

common-dir: (dict-ref node-repo common-dir: "") })

+357

(status

+358

(control-result

+359

(request 35 "git/status"

+360

#{ repo: repo recent-limit: 10 }

+361

GRANTS)))

+362

(operation (dict-ref status operation: #{}))

+363

(conflicts

+364

(filter

+365

(lambda (entry)

+366

(string=? (dict-ref entry kind: "") "conflict"))

+367

(dict-ref status entries: '()))))

+368

(assert-equal "merge" (dict-ref operation kind: ""))

+369

(assert-true (pair? conflicts))

+370

(assert-true

+371

(dict-contains? (car conflicts) conflict-stages:))))

+372

+373

(test "discovery outside the grant is refused without killing dispatch"

+374

(let* ((none (make-grants principal: "web:none"))

+375

(reply (request 4 "git/discover" #{ path: REPO } none))

+376

(control (reply-control reply)))

+377

(assert-equal "err" (dict-ref control t: ""))

+378

(assert-equal "grant-denied" (dict-ref control code: ""))))

+379

+380

(test "ordinary path is a named not-a-repository result"

+381

(let ((plain (path-join ROOT "plain")))

+382

(ensure-directory plain)

+383

(let ((control (reply-control

+384

(request 5 "git/discover" #{ path: plain } GRANTS))))

+385

(assert-equal "not-a-repository" (dict-ref control code: "")))))

+386

+387

(test "real dispatch preserves hostile filenames and rename pairing"

+388

(let* ((discovered

+389

(control-result

+390

(request 39 "git/discover" #{ path: REPO } GRANTS)))

+391

(node-repo (dict-ref discovered node-repo: #{}))

+392

(repo #{ root: "local"

+393

worktree: (dict-ref node-repo worktree: "")

+394

common-dir: (dict-ref node-repo common-dir: "") })

+395

(status

+396

(control-result

+397

(request 40 "git/status"

+398

#{ repo: repo recent-limit: 10 }

+399

GRANTS)))

+400

(entries (dict-ref status entries: '()))

+401

(paths (map (lambda (entry) (dict-ref entry path: "")) entries))

+402

(renames

+403

(filter

+404

(lambda (entry)

+405

(string=? (dict-ref entry kind: "") "rename"))

+406

entries)))

+407

(assert-true (member "space name.txt" paths))

+408

(assert-true (member "tab\tname.txt" paths))

+409

(assert-true (member "line\nname.txt" paths))

+410

(assert-true (member "naïve.txt" paths))

+411

(assert-true (member "-leading.txt" paths))

+412

(assert-true (member "from -> to.txt" paths))

+413

(assert-true (member "renamed -> file.txt" paths))

+414

(let ((binary-entry

+415

(find

+416

(lambda (entry)

+417

(string=? (dict-ref entry path: "") "blob.bin"))

+418

entries)))

+419

(assert-true binary-entry)

+420

(assert-equal "unknown" (dict-ref binary-entry binary: #f)))

+421

(assert-true (pair? renames))

+422

(assert-equal "old name.txt"

+423

(dict-ref (car renames) original-path: "")))))

packages/slate-cli/test/test-http-stream.sglmodified

@@ -3,7 +3,7 @@

3

(sigil process)

4

(sigil time)

5

(sigil test)

−6

(slate-cli http stream))

+6

(sigil http client))

7

8

(test "incremental HTTP response exposes headers before split body chunks"

9

(let* ((port (+ 19000 (modulo (current-jiffy) 1000)))

packages/slate-cli/test/test-main-router.sgladded

@@ -0,0 +1,21 @@

+1

;;; Regression for the app route accidentally being nested under /pair.

+2

+3

(import (sigil test) (slate-cli main))

+4

+5

(test-group "top-level HTTP routing"

+6

(test "the exact GET health endpoint is local"

+7

(assert-equal 'health (http-route-kind "GET" "/node/health")))

+8

(test "the exact GET status endpoint is local"

+9

(assert-equal 'node-status (http-route-kind "GET" "/node/status")))

+10

(test "the status endpoint is read-only"

+11

(assert-equal 'node-status-method (http-route-kind "POST" "/node/status")))

+12

(test "performance captures post to the local node"

+13

(assert-equal 'node-performance (http-route-kind "POST" "/node/performance")))

+14

(test "the performance endpoint refuses other methods"

+15

(assert-equal 'node-performance-method (http-route-kind "GET" "/node/performance")))

+16

(test "pair paths reach the pairing handler"

+17

(assert-equal 'pair (http-route-kind "GET" "/pair/start")))

+18

(test "the app root reaches the app proxy"

+19

(assert-equal 'app (http-route-kind "GET" "/")))

+20

(test "ordinary assets reach the app proxy"

+21

(assert-equal 'app (http-route-kind "GET" "/assets/app.js"))))

packages/slate-cli/test/test-node-dial.sgladded

@@ -0,0 +1,72 @@

+1

(import (sigil test) (sigil core) (slate-cli node dial))

+2

+3

(define clock 1000)

+4

(define (now-ms) (set! clock (+ clock 5)) clock)

+5

(define current-ad #{ endpoint: "ws://10.11.0.9:32644/direct"

+6

expires-at: 5000 ticket: "must-never-reach-relay" })

+7

+8

(test-group "companion node direct dialing"

+9

(test "authenticated direct success does not mint a relay ticket"

+10

(let ((direct-calls 0) (relay-calls 0))

+11

(let ((result

+12

(node-dial "zerocool" current-ad

+13

(lambda (target ad)

+14

(set! direct-calls (+ direct-calls 1))

+15

#{ connection: 'direct-carrier })

+16

(lambda (target)

+17

(set! relay-calls (+ relay-calls 1))

+18

#{ connection: 'relay-carrier }) now-ms)))

+19

(assert-equal 'direct (dict-ref result transport: #f))

+20

(assert-equal 'direct-carrier (dict-ref result connection: #f))

+21

(assert-equal 1 direct-calls)

+22

(assert-equal 0 relay-calls))))

+23

+24

(test "unreachable direct endpoint falls back once with a fresh relay path"

+25

(let ((direct-calls 0) (relay-calls 0))

+26

(let ((result

+27

(node-dial "phone" current-ad

+28

(lambda (target ad)

+29

(set! direct-calls (+ direct-calls 1))

+30

#{ reason: 'timeout })

+31

(lambda (target)

+32

(set! relay-calls (+ relay-calls 1))

+33

;; The callback receives no advertisement or direct ticket.

+34

#{ connection: 'fresh-relay-carrier }) now-ms)))

+35

(assert-equal 'relay (dict-ref result transport: #f))

+36

(assert-equal 'timeout (dict-ref result fallback-reason: #f))

+37

(assert-equal 1 direct-calls)

+38

(assert-equal 1 relay-calls))))

+39

+40

(test "expired advertisement is never dialled and uses relay"

+41

(let ((direct-calls 0))

+42

(let ((result

+43

(node-dial "sleeping-phone"

+44

#{ endpoint: "ws://10.11.0.8:32644/direct" expires-at: 1 }

+45

(lambda (target ad)

+46

(set! direct-calls (+ direct-calls 1))

+47

#{ connection: 'should-not-connect })

+48

(lambda (target) #{ connection: 'relay-carrier }) now-ms)))

+49

(assert-equal 0 direct-calls)

+50

(assert-equal 'relay (dict-ref result transport: #f))

+51

(assert-equal 'stale-advertisement

+52

(dict-ref result fallback-reason: #f)))))

+53

+54

(test "peer authentication failure is observable but non-secret"

+55

(let ((result

+56

(node-dial "wrong-peer" current-ad

+57

(lambda (target ad)

+58

#{ reason: 'authentication detail: "secret-ticket" })

+59

(lambda (target) #{ connection: 'relay-carrier }) now-ms)))

+60

(assert-equal 'relay (dict-ref result transport: #f))

+61

(assert-equal 'authentication (dict-ref result fallback-reason: #f))

+62

(assert-false (dict-ref result detail: #f))))

+63

+64

(test "unknown failures are collapsed and relay failure stays explicit"

+65

(let ((result

+66

(node-dial "offline" current-ad

+67

(lambda (target ad) #{ reason: "ECONNRESET at 10.11.0.9" })

+68

(lambda (target) #{ reason: 'network }) now-ms)))

+69

(assert-equal 'unavailable (dict-ref result transport: #f))

+70

(assert-equal 'unavailable (dict-ref result fallback-reason: #f))

+71

(assert-equal 'network (dict-ref result relay-failure: #f))))

+72

)

packages/slate-cli/test/test-node-direct.sgladded

@@ -0,0 +1,283 @@

+1

(import (sigil test) (sigil core) (slate-cli node direct))

+2

+3

(define message

+4

(list 'direct-ticket-message "caller" "phone" "req-7"

+5

"ws://10.11.0.9:32644/direct" "caller-secret" "acceptor-secret" "15"))

+6

+7

(define extended-message

+8

(append message

+9

(list "41" "caller-static" "2" "caller-public"

+10

"42" "acceptor-static" "3" "acceptor-public")))

+11

+12

(test-group "direct node peer authentication"

+13

(test "ticket parsing pins role, peer, endpoint, and absolute expiry"

+14

(let ((ticket (direct-ticket-from-message message 100)))

+15

(assert-equal 'caller (dict-ref ticket role: #f))

+16

(assert-equal "phone" (dict-ref ticket peer: ""))

+17

(assert-equal 115 (dict-ref ticket expires-at: 0))

+18

(assert-true (direct-ticket-current? ticket 114))

+19

(assert-false (direct-ticket-current? ticket 115))))

+20

+21

(test "extended ticket retains authenticated bot and key generations"

+22

(let ((ticket (direct-ticket-from-message extended-message 100)))

+23

(assert-equal "41" (dict-ref ticket caller-bot-id: ""))

+24

(assert-equal 2 (dict-ref ticket caller-generation: 0))

+25

(assert-equal "42" (dict-ref ticket acceptor-bot-id: ""))

+26

(assert-equal 3 (dict-ref ticket acceptor-generation: 0))))

+27

+28

(test "both peers prove distinct keys over the same bound transcript"

+29

(let* ((ticket (direct-ticket-from-message message 100))

+30

(transcript (direct-ticket-transcript

+31

"laptop" "phone" "req-7" "nonce-c" "nonce-a"))

+32

(caller-proof (direct-caller-proof ticket transcript))

+33

(acceptor-proof (direct-acceptor-proof ticket transcript)))

+34

(assert-false (string=? caller-proof acceptor-proof))

+35

(assert-true (direct-verify-caller? ticket transcript caller-proof))

+36

(assert-true (direct-verify-acceptor? ticket transcript acceptor-proof))

+37

(assert-false (direct-verify-caller? ticket transcript acceptor-proof))))

+38

+39

(test "wrong peer identity changes the transcript and fails proof"

+40

(let* ((ticket (direct-ticket-from-message message 100))

+41

(right (direct-ticket-transcript

+42

"laptop" "phone" "req-7" "nonce-c" "nonce-a"))

+43

(wrong (direct-ticket-transcript

+44

"mallory" "phone" "req-7" "nonce-c" "nonce-a")))

+45

(assert-false

+46

(direct-verify-caller? ticket wrong (direct-caller-proof ticket right)))))

+47

+48

(test "invalid role and excessive lifetime fail closed"

+49

(assert-false

+50

(direct-ticket-from-message

+51

(list 'direct-ticket-message "admin" "phone" "r" "ws://x" "a" "b" "15")

+52

100))

+53

(assert-false

+54

(direct-ticket-from-message

+55

(list 'direct-ticket-message "caller" "phone" "r" "ws://x" "a" "b" "300")

+56

100)))

+57

+58

(test "mutual handshake authenticates both peers before caller proof"

+59

(let* ((caller-ticket (direct-ticket-from-message message 100))

+60

(acceptor-ticket

+61

(direct-ticket-from-message

+62

(list 'direct-ticket-message "acceptor" "laptop" "req-7"

+63

"ws://10.11.0.9:32644/direct"

+64

"caller-secret" "acceptor-secret" "15") 100))

+65

(hello (direct-caller-hello "laptop" caller-ticket "nonce-c"))

+66

(state (direct-accept-challenge

+67

"phone" acceptor-ticket hello "nonce-a" 101))

+68

(response (and state

+69

(direct-caller-response

+70

"laptop" caller-ticket "nonce-c"

+71

(dict-ref state challenge: #{}) 101))))

+72

(assert-true (dict? state))

+73

(assert-true (dict? response))

+74

(assert-true (direct-accept-response acceptor-ticket state response 101))))

+75

+76

(test "only a well-formed hello addressed to this acceptor may await"

+77

(let ((hello #{ t: "direct/hello" version: 1 auth: "broker"

+78

caller: "laptop" acceptor: "phone"

+79

request-id: "req-7" caller-nonce: "nonce-c" } ))

+80

(assert-true (direct-broker-hello? hello "phone"))

+81

(assert-false

+82

(direct-broker-hello? (dict-set hello acceptor: "other") "phone"))

+83

(assert-false

+84

(direct-broker-hello? (dict-set hello caller-nonce: "") "phone"))))

+85

+86

(test "wrong acceptor proof is refused without emitting caller proof"

+87

(let* ((ticket (direct-ticket-from-message message 100))

+88

(challenge #{ t: "direct/challenge" version: 1 auth: "broker"

+89

request-id: "req-7"

+90

acceptor-nonce: "nonce-a" proof: "forged" }))

+91

(assert-false

+92

(direct-caller-response "laptop" ticket "nonce-c" challenge 101))))

+93

+94

(test "the dev instrument corrupts only caller proof messages"

+95

(let ((hello #{ t: "direct/hello" proof: "keep" })

+96

(proof #{ t: "direct/proof" proof: "real" } ))

+97

(assert-equal hello (direct-test-mutate-control "invalid-proof" hello))

+98

(assert-equal "real"

+99

(dict-ref (direct-test-mutate-control #f proof) proof: #f))

+100

(assert-equal "invalid-test-proof"

+101

(dict-ref (direct-test-mutate-control "invalid-proof" proof) proof: #f))))

+102

+103

(test "the dev instrument changes only the caller identity in hello"

+104

(let ((hello #{ t: "direct/hello" caller: "laptop" acceptor: "phone"

+105

request-id: "req-7" caller-nonce: "nonce-c" })

+106

(proof #{ t: "direct/proof" caller: "keep" } ))

+107

(let ((mutated (direct-test-mutate-control "wrong-peer" hello)))

+108

(assert-equal "wrong-test-peer" (dict-ref mutated caller: #f))

+109

(assert-equal "phone" (dict-ref mutated acceptor: #f))

+110

(assert-equal "req-7" (dict-ref mutated request-id: #f))

+111

(assert-equal "nonce-c" (dict-ref mutated caller-nonce: #f)))

+112

(assert-equal proof (direct-test-mutate-control "wrong-peer" proof))))

+113

+114

(test "the dev instrument targets each paired authentication boundary"

+115

(let ((hello #{ t: "direct/hello" auth: "paired"

+116

caller-bot-id: "bot-a" caller-key-id: "key-a"

+117

caller-ephemeral: "point-a" })

+118

(proof #{ t: "direct/proof" auth: "paired"

+119

signature: "signature" confirmation: "confirmation" }))

+120

(assert-equal "wrong-test-bot"

+121

(dict-ref (direct-test-mutate-control "paired-wrong-bot" hello)

+122

caller-bot-id: #f))

+123

(assert-equal "wrong-test-key"

+124

(dict-ref (direct-test-mutate-control "paired-wrong-static-key" hello)

+125

caller-key-id: #f))

+126

(assert-equal "not-a-p256-point"

+127

(dict-ref (direct-test-mutate-control "paired-malformed-ephemeral" hello)

+128

caller-ephemeral: #f))

+129

(assert-equal "wrong-test-signature"

+130

(dict-ref (direct-test-mutate-control "paired-wrong-signature" proof)

+131

signature: #f))

+132

(assert-equal "wrong-test-confirmation"

+133

(dict-ref (direct-test-mutate-control "paired-failed-confirmation" proof)

+134

confirmation: #f))

+135

(assert-equal hello

+136

(direct-test-mutate-control "paired-wrong-signature" hello))))

+137

+138

(test "the expired-ticket instrument extends only the local expiry"

+139

(let* ((ticket (direct-ticket-from-message message 100))

+140

(mutated (direct-test-ticket-for-attempt "expired-ticket" ticket 120)))

+141

(assert-equal 150 (dict-ref mutated expires-at: #f))

+142

(assert-equal (dict-ref ticket caller-key: #f)

+143

(dict-ref mutated caller-key: #f))

+144

(assert-equal (dict-ref ticket request-id: #f)

+145

(dict-ref mutated request-id: #f))

+146

(assert-equal ticket

+147

(direct-test-ticket-for-attempt "wrong-peer" ticket 120))))

+148

+149

(test "ticket inbox replaces duplicates, expires entries, and consumes once"

+150

(let* ((store (make-direct-ticket-store))

+151

(ticket (direct-ticket-from-message message 100)))

+152

(assert-true (direct-ticket-store-put! store ticket 101))

+153

(assert-equal ticket

+154

(direct-ticket-store-find store 'caller "phone" "req-7" 101))

+155

(assert-true (direct-ticket-store-consume! store ticket 101))

+156

(assert-false

+157

(direct-ticket-store-find store 'caller "phone" "req-7" 101))

+158

(assert-false (direct-ticket-store-consume! store ticket 101))

+159

(assert-false

+160

(direct-ticket-store-put!

+161

store (direct-ticket-from-message message 100) 115))))

+162

+163

(test "acceptor can await a ticket that arrives after the direct hello"

+164

(let* ((store (make-direct-ticket-store))

+165

(ticket

+166

(direct-ticket-from-message

+167

(list 'direct-ticket-message "acceptor" "laptop" "req-7"

+168

"ws://10.11.0.9:32644/direct"

+169

"caller-secret" "acceptor-secret" "15") 100))

+170

(clock (vector 101000))

+171

(pauses (vector 0))

+172

(found

+173

(direct-ticket-store-await store 'acceptor "laptop" "req-7"

+174

(lambda ()

+175

(let ((value (vector-ref clock 0)))

+176

(vector-set! clock 0 (+ value 10))

+177

value))

+178

100

+179

(lambda ()

+180

(vector-set! pauses 0 (+ (vector-ref pauses 0) 1))

+181

(when (= (vector-ref pauses 0) 2)

+182

(direct-ticket-store-put! store ticket 101))))))

+183

(assert-equal ticket found)

+184

(assert-equal 2 (vector-ref pauses 0))

+185

;; Awaiting does not consume the credential before proof validation.

+186

(assert-equal ticket

+187

(direct-ticket-store-find store 'acceptor "laptop" "req-7" 101))))

+188

+189

(test "acceptor ticket wait is bounded when no correlated ticket arrives"

+190

(let ((clock (vector 101000))

+191

(pauses (vector 0)))

+192

(assert-false

+193

(direct-ticket-store-await (make-direct-ticket-store)

+194

'acceptor "laptop" "missing"

+195

(lambda ()

+196

(let ((value (vector-ref clock 0)))

+197

(vector-set! clock 0 (+ value 10))

+198

value))

+199

25

+200

(lambda ()

+201

(vector-set! pauses 0 (+ (vector-ref pauses 0) 1)))))

+202

(assert-equal 2 (vector-ref pauses 0))))

+203

+204

(test "caller connector completes mutual proof and returns its socket"

+205

(let* ((ticket (direct-ticket-from-message message 100))

+206

(sent (vector '()))

+207

(closed (vector #f))

+208

(clock (vector 101000))

+209

(transport

+210

#{ open: (lambda (endpoint) 'socket)

+211

send: (lambda (conn control)

+212

(vector-set! sent 0

+213

(append (vector-ref sent 0) (list control)))

+214

#t)

+215

receive:

+216

(lambda (conn)

+217

(let ((out (vector-ref sent 0)))

+218

(cond

+219

((= (length out) 1)

+220

(dict-ref

+221

(direct-accept-challenge

+222

"phone"

+223

(direct-ticket-from-message

+224

(list 'direct-ticket-message "acceptor" "laptop"

+225

"req-7" "ws://10.11.0.9:32644/direct"

+226

"caller-secret" "acceptor-secret" "15")

+227

100)

+228

(car out) "acceptor-live" 101)

+229

challenge: #f))

+230

((= (length out) 2)

+231

#{ t: "direct/ok" version: 1 auth: "broker"

+232

transport: "direct" })

+233

(else #f))))

+234

close: (lambda (conn) (vector-set! closed 0 #t))

+235

now-ms: (lambda ()

+236

(let ((value (vector-ref clock 0)))

+237

(vector-set! clock 0 (+ value 5))

+238

value))

+239

pause: (lambda () #t) })

+240

(result (direct-caller-connect "laptop" ticket transport 100)))

+241

(assert-equal 'socket (dict-ref result connection: #f))

+242

(assert-equal 2 (length (vector-ref sent 0)))

+243

(assert-false (vector-ref closed 0))))

+244

+245

(test "caller connector closes a bad acceptor proof"

+246

(let* ((ticket (direct-ticket-from-message message 100))

+247

(closed (vector #f))

+248

(clock (vector 101000))

+249

(transport

+250

#{ open: (lambda (endpoint) 'socket)

+251

send: (lambda (conn control) #t)

+252

receive: (lambda (conn)

+253

#{ t: "direct/challenge" version: 1 auth: "broker"

+254

request-id: "req-7" acceptor-nonce: "bad"

+255

proof: "wrong" })

+256

close: (lambda (conn) (vector-set! closed 0 #t))

+257

now-ms: (lambda ()

+258

(let ((value (vector-ref clock 0)))

+259

(vector-set! clock 0 (+ value 5))

+260

value)) })

+261

(result (direct-caller-connect "laptop" ticket transport 100)))

+262

(assert-equal 'authentication (dict-ref result reason: #f))

+263

(assert-false (dict-ref result connection: #f))

+264

(assert-true (vector-ref closed 0))))

+265

+266

(test "caller connector bounds an unresponsive endpoint"

+267

(let* ((ticket (direct-ticket-from-message message 100))

+268

(closed (vector #f))

+269

(clock (vector 101000))

+270

(transport

+271

#{ open: (lambda (endpoint) 'socket)

+272

send: (lambda (conn control) #t)

+273

receive: (lambda (conn) #f)

+274

close: (lambda (conn) (vector-set! closed 0 #t))

+275

now-ms: (lambda ()

+276

(let ((value (vector-ref clock 0)))

+277

(vector-set! clock 0 (+ value 5))

+278

value))

+279

pause: (lambda () #t) })

+280

(result (direct-caller-connect "laptop" ticket transport 20)))

+281

(assert-equal 'timeout (dict-ref result reason: #f))

+282

(assert-true (vector-ref closed 0))))

+283

)

packages/slate-cli/test/test-node-gateway.sgladded

@@ -0,0 +1,214 @@

+1

(import (sigil test) (slate-cli node gateway) (slate-cli wire))

+2

+3

(test-group "node gateway multiplexing"

+4

(test "binary envelope preserves carrier id and original frame bytes"

+5

(let* ((inner (bytevector #x03 0 0 0 7 65 66 67))

+6

(encoded (gateway-frame-encode 42 inner))

+7

(decoded (gateway-frame-decode encoded)))

+8

(assert-equal GATEWAY-FRAME (bytevector-u8-ref encoded 0))

+9

(assert-equal 42 (dict-ref decoded carrier: #f))

+10

(assert-equal inner (dict-ref decoded payload: #f))))

+11

+12

(test "local node frames and malformed carrier zero are not gateway frames"

+13

(assert-false

+14

(gateway-frame-decode (bytevector #x03 0 0 0 7 65)))

+15

(assert-false

+16

(gateway-frame-decode (bytevector GATEWAY-FRAME 0 0 0 0 65))))

+17

+18

(test "caller receive timestamp extends only capture trace replies"

+19

(let* ((payload (bytevector 0 0 0 7 0 0 0 2 0 0 0 9))

+20

(trace (encode-stream-frame frame-trace-out 31 payload))

+21

(stamped (gateway-stamp-trace-received trace 4294967301))

+22

(decoded (decode-stream-frame stamped))

+23

(out (stream-frame-payload decoded))

+24

(data (encode-stream-frame frame-data-out 31 (bytevector 65))))

+25

(assert-equal frame-trace-out (stream-frame-type decoded))

+26

(assert-equal 31 (stream-frame-id decoded))

+27

(assert-equal 16 (bytevector-length out))

+28

(assert-equal payload (bytevector-copy out 0 12))

+29

(assert-equal (bytevector 0 0 0 5) (bytevector-copy out 12 16))

+30

(let* ((with-outbound

+31

(gateway-stamp-trace-received trace 4294967301 4294967299))

+32

(with-payload

+33

(stream-frame-payload (decode-stream-frame with-outbound))))

+34

(assert-equal 20 (bytevector-length with-payload))

+35

(assert-equal payload (bytevector-copy with-payload 0 12))

+36

(assert-equal (bytevector 0 0 0 3 0 0 0 5)

+37

(bytevector-copy with-payload 12 20)))

+38

(assert-equal data (gateway-stamp-trace-received data 42))

+39

(assert-equal (bytevector 1 2 3)

+40

(gateway-stamp-trace-received (bytevector 1 2 3) 42))))

+41

+42

(test "text envelope preserves opaque inner JSON"

+43

(let ((env (gateway-text-envelope 9

+44

"{\"t\":\"req\",\"id\":1,\"verb\":\"session/open\"}")))

+45

(assert-true (gateway-text-envelope? env))

+46

(assert-equal 9 (dict-ref env carrier: #f))

+47

(assert-equal "{\"t\":\"req\",\"id\":1,\"verb\":\"session/open\"}"

+48

(dict-ref env payload: #f))))

+49

+50

(test "registry allocates distinct opening carriers and binds one transport"

+51

(let* ((registry (make-gateway-registry))

+52

(first (gateway-register! registry "phone"))

+53

(second (gateway-register! registry "laptop"))

+54

(bound (gateway-bind! registry

+55

(dict-ref first carrier: 0) 'socket 'direct #f)))

+56

(assert-equal 2 (gateway-count registry))

+57

(assert-false (= (dict-ref first carrier: 0)

+58

(dict-ref second carrier: 0)))

+59

(assert-equal "g1" (dict-ref first request-id: #f))

+60

(assert-equal 'ready (dict-ref bound state: #f))

+61

(assert-equal 'direct (dict-ref bound transport: #f))

+62

(assert-equal 'socket (dict-ref bound connection: #f))))

+63

+64

(test "relay binding records only the public fallback class"

+65

(let* ((registry (make-gateway-registry))

+66

(entry (gateway-register! registry "phone"))

+67

(bound (gateway-bind! registry (dict-ref entry carrier: 0)

+68

'relay-socket 'relay 'timeout)))

+69

(assert-equal 'relay (dict-ref bound transport: #f))

+70

(assert-equal 'timeout (dict-ref bound fallback-reason: #f))))

+71

+72

(test "removal is atomic before the connection close callback"

+73

(let* ((registry (make-gateway-registry))

+74

(entry (gateway-register! registry "phone"))

+75

(carrier (dict-ref entry carrier: 0))

+76

(saw-missing #f))

+77

(gateway-bind! registry carrier 'socket 'direct #f)

+78

(gateway-remove! registry carrier

+79

(lambda (connection)

+80

(set! saw-missing (not (gateway-ref registry carrier)))))

+81

(assert-true saw-missing)

+82

(assert-equal 0 (gateway-count registry))

+83

(assert-false (gateway-ref registry carrier))))

+84

+85

(test "paired invalidation closes only matching paired-auth carriers"

+86

(let* ((registry (make-gateway-registry))

+87

(phone (gateway-register! registry "phone"))

+88

(tablet (gateway-register! registry "tablet"))

+89

(broker (gateway-register! registry "phone"))

+90

(closed '()))

+91

(gateway-bind! registry (dict-ref phone carrier: 0) 'phone-socket

+92

'direct #f 'paired)

+93

(gateway-bind! registry (dict-ref tablet carrier: 0) 'tablet-socket

+94

'direct #f 'paired)

+95

(gateway-bind! registry (dict-ref broker carrier: 0) 'broker-socket

+96

'relay #f 'broker)

+97

(assert-equal 1

+98

(gateway-remove-paired! registry "phone"

+99

(lambda (socket) (set! closed (cons socket closed)))))

+100

(assert-equal '(phone-socket) closed)

+101

(assert-equal 2 (gateway-count registry))

+102

(assert-equal 'paired

+103

(dict-ref (gateway-ref registry (dict-ref tablet carrier: 0))

+104

auth-kind: #f))

+105

(assert-equal 'broker

+106

(dict-ref (gateway-ref registry (dict-ref broker carrier: 0))

+107

auth-kind: #f))))

+108

+109

(test "target identities are bounded tokens, never browser-supplied URLs"

+110

(assert-true (gateway-valid-target? "slate-node_123-abc"))

+111

(assert-false (gateway-valid-target? ""))

+112

(assert-false (gateway-valid-target? "ws://10.0.0.2/direct"))

+113

(assert-false (gateway-valid-target? "phone workstation")))

+114

+115

(test "carrier ownership gates close and disconnect removes the whole set"

+116

(let* ((registry (make-gateway-registry))

+117

(owner-a (vector 'browser-a))

+118

(owner-b (vector 'browser-b))

+119

(a1 (gateway-register! registry "phone"

+120

#{ owner: owner-a request-id: 7 }))

+121

(a2 (gateway-register! registry "tablet" #{ owner: owner-a }))

+122

(b1 (gateway-register! registry "laptop" #{ owner: owner-b })))

+123

(assert-true

+124

(gateway-owned? registry (dict-ref a1 carrier: 0) owner-a))

+125

(assert-false

+126

(gateway-owned? registry (dict-ref a1 carrier: 0) owner-b))

+127

(assert-equal 2 (length (gateway-remove-owner! registry owner-a)))

+128

(assert-equal 1 (gateway-count registry))

+129

(assert-equal b1

+130

(gateway-ref registry (dict-ref b1 carrier: 0)))

+131

(assert-false

+132

(gateway-ref registry (dict-ref a2 carrier: 0)))))

+133

+134

(test "caller ticket correlation pins role, request id, peer, and opening state"

+135

(let* ((registry (make-gateway-registry))

+136

(owner (vector 'browser))

+137

(entry (gateway-register! registry "phone" #{ owner: owner }))

+138

(ticket #{ role: 'caller peer: "phone" request-id: "g1" }))

+139

(assert-equal entry (gateway-ticket-entry registry ticket))

+140

(assert-false

+141

(gateway-ticket-entry registry

+142

#{ role: 'acceptor peer: "phone" request-id: "g1" }))

+143

(assert-false

+144

(gateway-ticket-entry registry

+145

#{ role: 'caller peer: "tablet" request-id: "g1" }))

+146

(gateway-bind! registry 1 'socket 'direct #f)

+147

(assert-false (gateway-ticket-entry registry ticket))))

+148

+149

(test "direct failure transitions once to fresh-relay acquisition"

+150

(let* ((registry (make-gateway-registry))

+151

(entry (gateway-register! registry "phone" #{ owner: 'browser }))

+152

(relay (gateway-mark-relay! registry

+153

(dict-ref entry carrier: 0) 'timeout)))

+154

(assert-equal 'opening-relay (dict-ref relay state: #f))

+155

(assert-equal relay

+156

(gateway-ticket-entry registry

+157

#{ role: 'caller peer: "phone" request-id: "g1" }))

+158

(assert-equal 'timeout (dict-ref relay fallback-reason: #f))

+159

(assert-false

+160

(gateway-mark-relay! registry (dict-ref entry carrier: 0) 'network))))

+161

+162

(test "opening carriers have a bounded deadline"

+163

(let* ((registry (make-gateway-registry))

+164

(entry (gateway-register! registry "phone" #{ opened-at: 100 })))

+165

(assert-false (gateway-opening-expired? entry 104 5))

+166

(assert-true (gateway-opening-expired? entry 105 5))

+167

(let ((relay (gateway-mark-relay! registry 1 'standby)))

+168

(assert-true (gateway-opening-expired? relay 106 5)))

+169

(let ((ready (gateway-bind! registry 1 'socket 'relay 'standby)))

+170

(assert-false (gateway-opening-expired? ready 1000 5)))))

+171

+172

(test "opened and failed events expose no carrier internals or secrets"

+173

(let* ((registry (make-gateway-registry))

+174

(entry (gateway-register! registry "phone"

+175

#{ owner: 'browser request-id: "private-correlation"

+176

client-request: 81 }))

+177

(ready (gateway-bind! registry (dict-ref entry carrier: 0)

+178

'secret-socket 'relay 'timeout))

+179

(opened (gateway-opened-event ready))

+180

(failed (gateway-failed-event entry 'timeout 'network)))

+181

(assert-equal "relay" (dict-ref opened transport: #f))

+182

(assert-equal 81 (dict-ref opened request: #f))

+183

(assert-equal 81 (dict-ref failed request: #f))

+184

(assert-equal "timeout" (dict-ref opened fallback-reason: #f))

+185

(assert-false (dict-ref opened connection: #f))

+186

(assert-false (dict-ref opened owner: #f))

+187

(assert-false (dict-ref opened target: #f))

+188

(assert-false (dict-ref opened request-id: #f))

+189

(assert-equal "unavailable" (dict-ref failed reason: #f))))

+190

+191

(test "relay completion pins sender, correlation, lifecycle, and bounded ttl"

+192

(let* ((registry (make-gateway-registry))

+193

(entry (gateway-register! registry "phone" #{ owner: 'browser }))

+194

(_relay (gateway-mark-relay! registry 1 'timeout))

+195

(completion

+196

(gateway-relay-completion registry "phone" "g1" "stream/ticket"

+197

#{ ticket: "relay-secret" expires-in: "30"

+198

pairing-descriptors: '("11" "ck" "1" "cp" "22" "ak" "1" "ap") }

+199

100)))

+200

(assert-equal (dict-ref entry carrier: #f)

+201

(dict-ref (dict-ref completion entry: #{}) carrier: #f))

+202

(assert-equal 'opening-relay

+203

(dict-ref (dict-ref completion entry: #{}) state: #f))

+204

(assert-equal "relay-secret" (dict-ref completion ticket: #f))

+205

(assert-equal 130 (dict-ref completion expires-at: 0))

+206

(assert-equal '("11" "ck" "1" "cp" "22" "ak" "1" "ap")

+207

(dict-ref completion pairing-descriptors: #f))

+208

(assert-false

+209

(gateway-relay-completion registry "tablet" "g1" "stream/ticket"

+210

#{ ticket: "x" expires-in: "30" } 100))

+211

(assert-false

+212

(gateway-relay-completion registry "phone" "g1" "stream/ticket"

+213

#{ ticket: "x" expires-in: "300" } 100))))

+214

)

packages/slate-cli/test/test-node-paired-direct.sgladded

@@ -0,0 +1,158 @@

+1

(import (sigil test) (sigil core)

+2

(slate-cli node pairing) (slate-cli node direct))

+3

+4

(define caller-id (pairing-make-identity 1 100))

+5

(define acceptor-id (pairing-make-identity 1 100))

+6

+7

(define (peer bot nick identity . revoked)

+8

#{ bot-id: bot transport-nick: nick

+9

peer-key-id: (dict-ref identity key-id: "")

+10

peer-generation: (dict-ref identity generation: 0)

+11

peer-public-key: (dict-ref identity public-key: "")

+12

endpoints: '("ws://10.0.0.2:32644/node/direct")

+13

created: 100 revoked: (and (pair? revoked) (car revoked)) })

+14

+15

(define caller-peer (peer "bot-b" "node-b" acceptor-id))

+16

(define acceptor-peer (peer "bot-a" "node-a" caller-id))

+17

+18

(define (exchange)

+19

(let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

+20

(a0 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer "an" "conn"))

+21

(h (paired-direct-start c0))

+22

(a1 (paired-direct-handle a0 (dict-ref h send: #f)))

+23

(c1 (paired-direct-handle (dict-ref h state: #f) (dict-ref a1 send: #f)))

+24

(a2 (paired-direct-handle (dict-ref a1 state: #f) (dict-ref c1 send: #f)))

+25

(c2 (paired-direct-handle (dict-ref c1 state: #f) (dict-ref a2 send: #f))))

+26

(list h a1 c1 a2 c2)))

+27

+28

(test-group "unified v1 paired direct authentication"

+29

(test "both peers authenticate only after key confirmation"

+30

(let ((steps (exchange)))

+31

(assert-false (dict-ref (list-ref steps 0) authed?: #t))

+32

(assert-false (dict-ref (list-ref steps 1) authed?: #t))

+33

(assert-false (dict-ref (list-ref steps 2) authed?: #t))

+34

(assert-true (dict-ref (list-ref steps 3) authed?: #f))

+35

(assert-true (dict-ref (list-ref steps 4) authed?: #f))

+36

(assert-equal 'active

+37

(paired-direct-phase (dict-ref (list-ref steps 4) state: #{})))))

+38

+39

(test "paired mode is explicit and broker messages are not reinterpreted"

+40

(assert-true (paired-direct-message?

+41

#{ t: "direct/hello" version: 1 auth: "paired" }))

+42

(assert-false (paired-direct-message?

+43

#{ t: "direct/hello" version: 1 auth: "broker" })))

+44

+45

(test "wrong static identity descriptor fails before challenge"

+46

(let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

+47

(a0 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer "an" "conn"))

+48

(h (paired-direct-start c0))

+49

(bad (dict-set (dict-ref h send: #{}) caller-key-id: "wrong"))

+50

(out (paired-direct-handle a0 bad)))

+51

(assert-equal 'failed (paired-direct-phase (dict-ref out state: #{})))

+52

(assert-false (dict-ref out send: #f))))

+53

+54

(test "wrong acceptor signature reveals no caller proof"

+55

(let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

+56

(a0 (paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer "an" "conn"))

+57

(h (paired-direct-start c0))

+58

(a1 (paired-direct-handle a0 (dict-ref h send: #f)))

+59

(bad (dict-set (dict-ref a1 send: #{}) signature: "forged"))

+60

(out (paired-direct-handle (dict-ref h state: #{}) bad)))

+61

(assert-equal 'failed (paired-direct-phase (dict-ref out state: #{})))

+62

(assert-false (dict-ref out send: #f))))

+63

+64

(test "replayed challenge does not advance an active caller"

+65

(let* ((steps (exchange))

+66

(active (dict-ref (list-ref steps 4) state: #{}))

+67

(challenge (dict-ref (list-ref steps 1) send: #{}))

+68

(out (paired-direct-handle active challenge)))

+69

(assert-equal 'failed (paired-direct-phase (dict-ref out state: #{})))))

+70

+71

(test "partial state is discarded on disconnect"

+72

(let* ((c0 (paired-direct-make 'caller "bot-a" caller-id caller-peer "cn"))

+73

(started (dict-ref (paired-direct-start c0) state: #{})))

+74

(assert-false (paired-direct-disconnect started))))

+75

+76

(test "caller connector authenticates a stored endpoint"

+77

(let* ((sent (vector '()))

+78

(acceptor (vector

+79

(paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer

+80

"an" "conn")))

+81

(closed (vector #f))

+82

(clock (vector 1000))

+83

(transport

+84

#{ open: (lambda (endpoint) 'socket)

+85

send: (lambda (conn message)

+86

(vector-set! sent 0

+87

(append (vector-ref sent 0) (list message)))

+88

#t)

+89

receive:

+90

(lambda (conn)

+91

(let ((messages (vector-ref sent 0)))

+92

(and (pair? messages)

+93

(let ((out (paired-direct-handle

+94

(vector-ref acceptor 0)

+95

(car (reverse messages)))))

+96

(vector-set! acceptor 0 (dict-ref out state: #{}))

+97

(dict-ref out send: #f)))))

+98

close: (lambda (conn) (vector-set! closed 0 #t))

+99

now-ms: (lambda ()

+100

(let ((now (vector-ref clock 0)))

+101

(vector-set! clock 0 (+ now 5)) now))

+102

pause: (lambda () #t) })

+103

(result (paired-direct-caller-connect

+104

"bot-a" caller-id caller-peer transport 100)))

+105

(assert-equal 'socket (dict-ref result connection: #f))

+106

(assert-false (vector-ref closed 0))))

+107

+108

(test "caller connector refuses an empty cached endpoint set"

+109

(let ((result (paired-direct-caller-connect "bot-a" caller-id

+110

(dict-set caller-peer endpoints: '()) #{} 100)))

+111

(assert-equal 'unavailable (dict-ref result reason: #f))))

+112

+113

(test "caller waits for native transport readiness before first hello"

+114

(let* ((sent (vector '()))

+115

(acceptor (vector

+116

(paired-direct-make 'acceptor "bot-b" acceptor-id acceptor-peer

+117

"an" "conn")))

+118

(ready (vector #f))

+119

(polls (vector 0))

+120

(clock (vector 1000))

+121

(transport

+122

#{ open: (lambda (endpoint) 'socket)

+123

connected?: (lambda (conn) (vector-ref ready 0))

+124

send: (lambda (conn message)

+125

(and (vector-ref ready 0)

+126

(begin

+127

(vector-set! sent 0

+128

(append (vector-ref sent 0) (list message)))

+129

#t)))

+130

receive:

+131

(lambda (conn)

+132

(if (not (vector-ref ready 0))

+133

(begin

+134

(vector-set! polls 0 (+ 1 (vector-ref polls 0)))

+135

(vector-set! ready 0 #t)

+136

#f)

+137

(let ((messages (vector-ref sent 0)))

+138

(and (pair? messages)

+139

(let ((out (paired-direct-handle

+140

(vector-ref acceptor 0)

+141

(car (reverse messages)))))

+142

(vector-set! acceptor 0

+143

(dict-ref out state: #{}))

+144

(dict-ref out send: #f))))))

+145

close: (lambda (conn) #t)

+146

now-ms: (lambda ()

+147

(let ((now (vector-ref clock 0)))

+148

(vector-set! clock 0 (+ now 5)) now))

+149

pause: (lambda () #t) })

+150

(result (paired-direct-caller-connect

+151

"bot-a" caller-id caller-peer transport 100)))

+152

(assert-equal 1 (vector-ref polls 0))

+153

(assert-equal 'socket (dict-ref result connection: #f))))

+154

+155

(test "revoked pairing cannot construct an authentication state"

+156

(assert-error

+157

(paired-direct-make 'caller "bot-a" caller-id

+158

(peer "bot-b" "node-b" acceptor-id #t) "cn"))))

packages/slate-cli/test/test-node-pairing-control.sgladded

@@ -0,0 +1,84 @@

+1

(import (sigil core) (sigil test)

+2

(slate-cli node pairing) (slate-cli node pairing-control))

+3

+4

(define caller-id (pairing-make-identity 1 100))

+5

(define acceptor-id (pairing-make-identity 1 100))

+6

(define context

+7

#{ session-id: "broker-session-7"

+8

caller-bot-id: "11" caller-transport-nick: "alpha"

+9

caller-key-id: (dict-ref caller-id key-id: "") caller-generation: 1

+10

caller-public-key: (dict-ref caller-id public-key: "")

+11

acceptor-bot-id: "22" acceptor-transport-nick: "beta"

+12

acceptor-key-id: (dict-ref acceptor-id key-id: "") acceptor-generation: 1

+13

acceptor-public-key: (dict-ref acceptor-id public-key: "") })

+14

+15

(define (exchange)

+16

(let* ((c0 (pairing-control-make 'caller context caller-id

+17

(list "wss://beta.example:32644") "caller-nonce" 100))

+18

(a0 (pairing-control-make 'acceptor context acceptor-id

+19

(list "wss://alpha.example:32644") "acceptor-nonce" 100))

+20

(o (pairing-control-start c0))

+21

(a1 (pairing-control-handle a0 (dict-ref o send: #f)))

+22

(c1 (pairing-control-handle (dict-ref o state: #f) (dict-ref a1 send: #f)))

+23

(a2 (pairing-control-handle (dict-ref a1 state: #f) (dict-ref c1 send: #f)))

+24

(c2 (pairing-control-handle (dict-ref c1 state: #f) (dict-ref a2 send: #f))))

+25

(list o a1 c1 a2 c2)))

+26

+27

(define (default-exchange)

+28

(let* ((c0 (pairing-control-make 'caller context caller-id '()))

+29

(a0 (pairing-control-make 'acceptor context acceptor-id '()))

+30

(o (pairing-control-start c0))

+31

(a1 (pairing-control-handle a0 (dict-ref o send: #f)))

+32

(c1 (pairing-control-handle (dict-ref o state: #f) (dict-ref a1 send: #f)))

+33

(a2 (pairing-control-handle (dict-ref a1 state: #f) (dict-ref c1 send: #f)))

+34

(c2 (pairing-control-handle (dict-ref c1 state: #f) (dict-ref a2 send: #f))))

+35

(list a2 c2)))

+36

+37

(test-group "four-message node pairing control"

+38

(test "default construction generates a nonce"

+39

(let* ((state (pairing-control-make 'caller context caller-id '()))

+40

(offer (dict-ref (pairing-control-start state) send: #f))

+41

(nonce (and offer (dict-ref offer nonce: #f))))

+42

(assert-true (string? nonce))

+43

(assert-equal 43 (string-length nonce))))

+44

(test "default construction commits valid records"

+45

(let ((xs (default-exchange)))

+46

(assert-true

+47

(pairing-record-valid?

+48

(pairing-control-record (dict-ref (list-ref xs 0) state: #f))))

+49

(assert-true

+50

(pairing-record-valid?

+51

(pairing-control-record (dict-ref (list-ref xs 1) state: #f))))))

+52

(test "only committed endpoints activate"

+53

(let ((xs (exchange)))

+54

(assert-false (dict-ref (list-ref xs 0) activate?: #t))

+55

(assert-false (dict-ref (list-ref xs 1) activate?: #t))

+56

(assert-false (dict-ref (list-ref xs 2) activate?: #t))

+57

(assert-true (dict-ref (list-ref xs 3) activate?: #f))

+58

(assert-true (dict-ref (list-ref xs 4) activate?: #f))))

+59

(test "disconnect discards every pending phase"

+60

(let ((xs (exchange)))

+61

(assert-false (pairing-control-disconnect

+62

(dict-ref (list-ref xs 0) state: #f)))

+63

(assert-false (pairing-control-disconnect

+64

(dict-ref (list-ref xs 1) state: #f)))

+65

(assert-false (pairing-control-disconnect

+66

(dict-ref (list-ref xs 2) state: #f)))

+67

(assert-true (pairing-record-valid?

+68

(pairing-control-record

+69

(pairing-control-disconnect

+70

(dict-ref (list-ref xs 3) state: #f)))))))

+71

(test "carrier does not affect record bytes"

+72

(let* ((direct (exchange)) (relay (exchange))

+73

(d (pairing-control-record (dict-ref (list-ref direct 4) state: #f)))

+74

(r (pairing-control-record (dict-ref (list-ref relay 4) state: #f))))

+75

(assert-equal d r)))

+76

(test "tampered accept fails closed"

+77

(let* ((c0 (pairing-control-make 'caller context caller-id '() "c"))

+78

(a0 (pairing-control-make 'acceptor context acceptor-id '() "a"))

+79

(o (pairing-control-start c0))

+80

(a1 (pairing-control-handle a0 (dict-ref o send: #f)))

+81

(bad (dict-set (dict-ref a1 send: #f) signature: "bad"))

+82

(c1 (pairing-control-handle (dict-ref o state: #f) bad)))

+83

(assert-equal 'failed (pairing-control-phase (dict-ref c1 state: #f)))

+84

(assert-false (dict-ref c1 activate?: #t)))))

packages/slate-cli/test/test-node-pairing-management.sgladded

@@ -0,0 +1,53 @@

+1

(import (sigil test) (sigil core) (sigil fs) (sigil path) (sigil process)

+2

(slate-cli node pairing) (slate-cli node pairing-management))

+3

+4

(define (record bot nick identity endpoints)

+5

#{ bot-id: bot transport-nick: nick

+6

peer-key-id: (dict-ref identity key-id: "")

+7

peer-generation: (dict-ref identity generation: 0)

+8

peer-public-key: (dict-ref identity public-key: "")

+9

endpoints: endpoints created: 100 revoked: #f })

+10

+11

(test-group "durable pairing management"

+12

(test "list reconstructs safe readiness summaries"

+13

(let* ((dir (string-append "/tmp/slate-pair-manage-" (number->string (process-id))))

+14

(identity (pairing-make-identity 1 100))

+15

(peer (record "bot-b" "node-b" identity

+16

'("ws://10.0.0.2:32644/node/direct"))))

+17

(ensure-directory dir)

+18

(pairing-save-records! dir (list peer))

+19

(let* ((items (pairing-management-list dir)) (item (car items)))

+20

(assert-true (dict-ref item offline-ready?: #f))

+21

(assert-false (dict-ref item endpoints: #f))

+22

(assert-false (dict-ref item peer-public-key: #f)))))

+23

+24

(test "revoke tombstones by bot id and makes the record unusable"

+25

(let* ((dir (string-append "/tmp/slate-pair-revoke-" (number->string (process-id))))

+26

(identity (pairing-make-identity 1 100))

+27

(peer (record "bot-c" "node-c" identity

+28

'("ws://10.0.0.3:32644/node/direct"))))

+29

(ensure-directory dir)

+30

(pairing-save-records! dir (list peer))

+31

(let ((summary (pairing-management-revoke! dir "bot-c")))

+32

(assert-true (dict-ref summary revoked: #f))

+33

(assert-false (dict-ref summary offline-ready?: #t))

+34

(assert-false (pairing-record-find (pairing-load-records dir) "bot-c")))))

+35

+36

(test "rotation increments generation and atomically replaces key identity"

+37

(let* ((dir (string-append "/tmp/slate-pair-rotate-" (number->string (process-id))))

+38

(old (pairing-make-identity 4 100)))

+39

(ensure-directory dir)

+40

(pairing-save-identity! dir old)

+41

(let* ((summary (pairing-management-rotate! dir))

+42

(fresh (pairing-load-identity dir)))

+43

(assert-equal 5 (dict-ref summary generation: 0))

+44

(assert-equal 5 (dict-ref fresh generation: 0))

+45

(assert-false (equal? (dict-ref old key-id: #f)

+46

(dict-ref fresh key-id: #f)))

+47

(assert-false (dict-ref summary private-key: #f)))))

+48

+49

(test "missing peers and corrupt state fail closed"

+50

(let ((dir (string-append "/tmp/slate-pair-missing-" (number->string (process-id)))))

+51

(ensure-directory dir)

+52

(pairing-save-records! dir '())

+53

(assert-error (pairing-management-revoke! dir "missing")))))

packages/slate-cli/test/test-node-pairing-readers.sgladded

@@ -0,0 +1,142 @@

+1

(import (sigil test) (sigil fs) (sigil json) (sigil process) (sigil time)

+2

(slate-cli node pairing) (slate-cli node pairing-management))

+3

+4

(define (test-store)

+5

(let ((dir (string-append "/tmp/slate-pairing-readers-"

+6

(number->string (current-jiffy)))))

+7

(ensure-directory dir)

+8

dir))

+9

+10

(define (peer-record identity)

+11

#{ bot-id: "peer" transport-nick: "peer-nick"

+12

peer-key-id: (dict-ref identity key-id: "")

+13

peer-generation: (dict-ref identity generation: 0)

+14

peer-public-key: (dict-ref identity public-key: "")

+15

endpoints: '("ws://10.0.0.2:32644/node/direct")

+16

created: 100 revoked: #f })

+17

+18

(define (fixed-mtime! path)

+19

(assert-equal 0 (process-run "touch" "-d" "@1700000000" path)))

+20

+21

(test-group "pairing file readers"

+22

(test "unchanged valid contents reuse their validated snapshot"

+23

(let* ((dir (test-store))

+24

(identity (pairing-make-identity 1 100))

+25

(read-identity (make-pairing-identity-reader dir))

+26

(read-records (make-pairing-records-reader dir)))

+27

(pairing-save-identity! dir identity)

+28

(pairing-save-records! dir (list (peer-record identity)))

+29

(let ((first-identity (read-identity))

+30

(first-records (read-records)))

+31

(assert-equal identity first-identity)

+32

(assert-equal (list (peer-record identity)) first-records)

+33

(assert-true (eq? first-identity (read-identity)))

+34

(assert-true (eq? first-records (read-records)))

+35

;; Replacing a file with the same contents is also safe to reuse.

+36

(pairing-save-identity! dir identity)

+37

(assert-true (eq? first-identity (read-identity))))))

+38

+39

(test "revocation and rotation are visible even with identical mtimes"

+40

(let* ((dir (test-store))

+41

(identity (pairing-make-identity 1 100))

+42

(read-identity (make-pairing-identity-reader dir))

+43

(read-records (make-pairing-records-reader dir)))

+44

(pairing-save-identity! dir identity)

+45

(pairing-save-records! dir (list (peer-record identity)))

+46

(fixed-mtime! (pairing-identity-path dir))

+47

(fixed-mtime! (pairing-records-path dir))

+48

(assert-equal identity (read-identity))

+49

(assert-false (dict-ref (car (read-records)) revoked: #t))

+50

(pairing-management-revoke! dir "peer")

+51

(pairing-management-rotate! dir)

+52

(fixed-mtime! (pairing-identity-path dir))

+53

(fixed-mtime! (pairing-records-path dir))

+54

(assert-true (dict-ref (car (read-records)) revoked: #f))

+55

(assert-equal 2 (dict-ref (read-identity) generation: 0))

+56

(assert-false (equal? (dict-ref identity key-id: #f)

+57

(dict-ref (read-identity) key-id: #f)))))

+58

+59

(test "changed keys are fully validated instead of trusting prior ids"

+60

(let* ((dir (test-store))

+61

(identity (pairing-make-identity 1 100))

+62

(other (pairing-make-identity 1 100))

+63

(read-identity (make-pairing-identity-reader dir))

+64

(read-records (make-pairing-records-reader dir)))

+65

(pairing-save-identity! dir identity)

+66

(pairing-save-records! dir (list (peer-record identity)))

+67

(assert-equal identity (read-identity))

+68

(assert-true (pair? (read-records)))

+69

;; Valid encoding and unchanged key id, but a mismatched private key.

+70

(write-file-string (pairing-identity-path dir)

+71

(json-encode (dict-set identity private-key:

+72

(dict-ref other private-key: ""))))

+73

(write-file-string (pairing-records-path dir)

+74

(json-encode #{ version: 1 pairings:

+75

(list (dict-set (peer-record identity) peer-public-key: "bad")) }))

+76

(assert-false (read-identity))

+77

(assert-false (read-records))))

+78

+79

(test "invalid snapshots are discarded and valid restoration is reloaded"

+80

(let* ((dir (test-store))

+81

(identity (pairing-make-identity 1 100))

+82

(read-identity (make-pairing-identity-reader dir))

+83

(read-records (make-pairing-records-reader dir)))

+84

(pairing-save-identity! dir identity)

+85

(pairing-save-records! dir (list (peer-record identity)))

+86

(let ((old-identity (read-identity))

+87

(old-records (read-records)))

+88

(write-file-string (pairing-identity-path dir) "{broken")

+89

(write-file-string (pairing-records-path dir) "{broken")

+90

(assert-false (read-identity))

+91

(assert-false (read-records))

+92

(assert-false (read-identity))

+93

(pairing-save-identity! dir identity)

+94

(pairing-save-records! dir (list (peer-record identity)))

+95

(let ((fresh-identity (read-identity))

+96

(fresh-records (read-records)))

+97

(assert-equal old-identity fresh-identity)

+98

(assert-equal old-records fresh-records)

+99

(assert-false (eq? old-identity fresh-identity))

+100

(assert-false (eq? old-records fresh-records))))))

+101

+102

(test "missing files and read errors never return a previous snapshot"

+103

(let* ((dir (test-store))

+104

(identity (pairing-make-identity 1 100))

+105

(read-identity (make-pairing-identity-reader dir))

+106

(read-records (make-pairing-records-reader dir)))

+107

(assert-false (read-identity))

+108

(assert-equal '() (read-records))

+109

(pairing-save-identity! dir identity)

+110

(pairing-save-records! dir (list (peer-record identity)))

+111

(assert-equal identity (read-identity))

+112

(assert-true (pair? (read-records)))

+113

(delete-file (pairing-identity-path dir))

+114

(delete-file (pairing-records-path dir))

+115

(assert-false (read-identity))

+116

(assert-equal '() (read-records))

+117

(ensure-directory (pairing-identity-path dir))

+118

(ensure-directory (pairing-records-path dir))

+119

(assert-false (read-identity))

+120

(assert-false (read-records))

+121

(delete-directory (pairing-identity-path dir))

+122

(delete-directory (pairing-records-path dir))

+123

(pairing-save-identity! dir identity)

+124

(pairing-save-records! dir '())

+125

(assert-equal identity (read-identity))

+126

(assert-equal '() (read-records))))

+127

+128

(test "readers are independent across stores and daemon lifetimes"

+129

(let* ((a (test-store))

+130

(b (test-store))

+131

(identity (pairing-make-identity 1 100))

+132

(read-a (make-pairing-identity-reader a))

+133

(read-b (make-pairing-identity-reader b)))

+134

(pairing-save-identity! a identity)

+135

(pairing-save-identity! b identity)

+136

(let ((first (read-a)))

+137

(assert-equal first (read-b))

+138

(assert-false (eq? first (read-b)))

+139

(assert-false (eq? first ((make-pairing-identity-reader a)))))

+140

(pairing-management-rotate! b)

+141

(assert-equal 1 (dict-ref (read-a) generation: 0))

+142

(assert-equal 2 (dict-ref (read-b) generation: 0)))))

packages/slate-cli/test/test-node-pairing.sgladded

@@ -0,0 +1,85 @@

+1

(import (sigil test) (sigil core) (sigil string) (sigil fs) (sigil path) (sigil json)

+2

(sigil process) (sigil time) (slate-cli node pairing))

+3

+4

(define (record public key-id generation)

+5

#{ bot-id: "bot-2" transport-nick: "peer-transport" label: "Peer"

+6

peer-key-id: key-id peer-generation: generation peer-public-key: public

+7

endpoints: (list "ws://100.64.0.2:32644/node/direct")

+8

created: 100 last-connected: 101 last-enclave-validated: 102 revoked: #f })

+9

+10

(test-group "durable node pairing primitives"

+11

(test "default identity timestamps validate in the native runtime"

+12

(assert-true (pairing-identity-valid? (pairing-make-identity 1))))

+13

+14

(test "transcript is ordered, length-prefixed, and identity-bound"

+15

(let ((a (pairing-transcript "s" "a" "an" "ak" 1 "b" "bn" "bk" 2

+16

"ap" "bp" "cn" "an"))

+17

(b (pairing-transcript "s" "aa" "n" "ak" 1 "b" "bn" "bk" 2

+18

"ap" "bp" "cn" "an")))

+19

(assert-false (string=? a b))

+20

(let ((prefix "21:slate-node-pairing-v1|1:s"))

+21

(assert-true (string=? (substring a 0 (string-length prefix)) prefix)))))

+22

+23

(test "P-256 signatures and ephemeral confirmation agree"

+24

(let* ((a (pairing-generate-keypair)) (b (pairing-generate-keypair))

+25

(msg "bound transcript")

+26

(sig (pairing-sign (dict-ref a private-key: "") msg))

+27

(za (pairing-shared-secret (dict-ref a private-key: "")

+28

(dict-ref b public-key: "")))

+29

(zb (pairing-shared-secret (dict-ref b private-key: "")

+30

(dict-ref a public-key: ""))))

+31

(assert-true (pairing-verify? (dict-ref a public-key: "") msg sig))

+32

(assert-false (pairing-verify? (dict-ref b public-key: "") msg sig))

+33

(assert-equal (pairing-confirmation-key za msg)

+34

(pairing-confirmation-key zb msg))))

+35

+36

(test "same-generation key conflict and stale generation fail closed"

+37

(let* ((a (pairing-generate-keypair)) (b (pairing-generate-keypair))

+38

(old (record (dict-ref a public-key: "") "a" 2))

+39

(conflict (record (dict-ref b public-key: "") "b" 2))

+40

(stale (record (dict-ref a public-key: "") "a" 1)))

+41

(assert-equal 'conflict (pairing-record-relation old conflict))

+42

(assert-equal 'stale (pairing-record-relation old stale))

+43

(assert-false (pairing-record-merge (list old) conflict))

+44

(assert-false (pairing-record-merge (list old) stale))))

+45

+46

(test "malformed keys, unsafe endpoints, and corruption are refused"

+47

(let* ((kp (pairing-generate-keypair))

+48

(good (record (dict-ref kp public-key: "") "key" 1)))

+49

(assert-true (pairing-record-valid? good))

+50

(assert-false (pairing-record-valid? (dict-set good peer-public-key: "bad")))

+51

(assert-false (pairing-record-valid?

+52

(dict-set good endpoints: (list "ws://127.0.0.1:1/x"))))))

+53

+54

(test "identity and pairing stores are atomic and owner-only"

+55

(let* ((dir (string-append "/tmp/slate-node-pairing-"

+56

(number->string (current-jiffy))))

+57

(identity (pairing-make-identity 1 100))

+58

(peer (record (dict-ref identity public-key: "") "peer-key" 1)))

+59

(guard (e (#t (raise e)))

+60

(pairing-save-identity! dir identity)

+61

(pairing-save-records! dir (list peer))

+62

(assert-equal "700" (string-trim (process-output->string "stat" "-c" "%a" dir)))

+63

(assert-equal "600" (string-trim (process-output->string "stat" "-c" "%a"

+64

(pairing-identity-path dir))))

+65

(assert-equal identity (pairing-load-identity dir))

+66

(assert-equal (list peer) (pairing-load-records dir))

+67

(assert-false (file-exists? (string-append (pairing-records-path dir) ".tmp"))))))

+68

+69

(test "corrupt stores quarantine instead of returning partial trust"

+70

(let ((dir (string-append "/tmp/slate-node-pairing-corrupt-"

+71

(number->string (current-jiffy)))))

+72

(ensure-directory dir)

+73

(write-file-string (pairing-records-path dir) "{not json")

+74

(assert-false (pairing-load-records dir))))

+75

+76

(test "permission failure is fatal"

+77

(assert-error (pairing-require-mode! "/tmp/x" "600"

+78

exists?: (lambda (name) #f) run: (lambda args 0))))

+79

+80

(test "public output is reconstructed without private material or endpoints"

+81

(let* ((identity (pairing-make-identity 1 100))

+82

(summary (pairing-public-summary identity))

+83

(rendered (json-encode summary)))

+84

(assert-false (string-contains? rendered (dict-ref identity private-key: "")))

+85

(assert-false (dict-ref summary private-key: #f)))))

packages/slate-cli/test/test-pairing-threats.sglmodified

@@ -158,6 +158,8 @@

158

(assert-false (host-allowed? (list (cons "host" "evil.example")) 32640)))

159

(test "the loopback authority is accepted"

160

(assert-true (host-allowed? (list (cons "host" "127.0.0.1:32640")) 32640)))

+161

(test "the exact bare loopback literal used by the native client is accepted"

+162

(assert-true (host-allowed? (list (cons "host" "127.0.0.1")) 32640)))

163

(test "localhost authority is accepted"

164

(assert-true (host-allowed? (list (cons "host" "localhost:32640")) 32640)))

165

(test "the right host but the wrong port is rejected"

packages/slate-cli/test/test-persistent.sgladded

@@ -0,0 +1,364 @@

+1

;;; Persistent Android/Termux node installation contract.

+2

+3

(import (sigil test)

+4

(sigil core)

+5

(sigil string)

+6

(sigil fs)

+7

(sigil json)

+8

(sigil process)

+9

(slate-cli config)

+10

(slate-cli persistent)

+11

(slate-cli node-posture))

+12

+13

(define test-home "/tmp/slate-persistent-test-home")

+14

(define test-prefix "/tmp/slate-persistent-test-prefix")

+15

(setenv! "SLATE_PERSIST_ROOT" test-home)

+16

(setenv! "SLATE_TERMUX_PREFIX" test-prefix)

+17

+18

(test-group "persistent node layout and generated supervision"

+19

(let ((run (persistent-service-script))

+20

(control (persistent-control-script))

+21

(boot (persistent-boot-script))

+22

(launcher (persistent-launcher-script)))

+23

(test "installation root is named node"

+24

(assert-equal "/tmp/slate-persistent-test-home/.local/share/slate/node"

+25

(persistent-root-dir)))

+26

(test "service uses the canonical node entrypoint on loopback"

+27

(assert-true (and (string-contains? run "slate\" node run")

+28

(not (string-contains? run "slate\" serve"))

+29

(string-contains? run "--host 127.0.0.1")

+30

(string-contains? run "--app-upstream \"$upstream\""))))

+31

(test "stable CLI launcher follows only a safe active version"

+32

(assert-true

+33

(and (string-contains? launcher "cat \"$ROOT/active\"")

+34

(string-contains? launcher "*[!A-Za-z0-9._-]*")

+35

(string-contains? launcher "exec \"$binary\" \"$@\""))))

+36

(test "supervisor forwards termination to its exact child"

+37

(assert-true (and (string-contains? run "trap stop_child TERM INT HUP")

+38

(string-contains? run "kill \"$child\"")

+39

(string-contains? run "wait \"$child\""))))

+40

(test "supervisor atomically records exact child lifecycle"

+41

(assert-true (and (string-contains? run "LIFE=\"$ROOT/lifecycle\"")

+42

(string-contains? run "atomic \"$LIFE/child.pid\" \"$child\"")

+43

(string-contains? run "last-start-at")

+44

(string-contains? run "last-exit-status")

+45

(string-contains? run "restart-count"))))

+46

(test "supervisor startup records an unclean prior child"

+47

(assert-true (and (string-contains? run "last-exit-observed-at")

+48

(string-contains? run "unclean-supervisor-recovery")

+49

(string-contains? run "rm -f \"$LIFE/last-exit-at\""))))

+50

(test "restart backoff is bounded and service output is retained"

+51

(assert-true (and (string-contains? run "delay=30")

+52

(string-contains? run "service-output.log"))))

+53

(test "control operations use Termux's explicit runit directory"

+54

(assert-true (and (string-contains? control "SVDIR=\"$PREFIX/var/service\"")

+55

(string-contains? control "start|stop|restart|status|logs"))))

+56

(test "structured status distinguishes runtime observations"

+57

(assert-true (and (string-contains? control "status-json) status_json")

+58

(string-contains? control "pidstate=stale")

+59

(string-contains? control "life=corrupt")

+60

(string-contains? control "available=false")

+61

(string-contains? control "healthy=false"))))

+62

(test "status JSON sanitizes corrupt multiline scalar state"

+63

(assert-true (string-contains? control "tr '\\r\\n' ' '")))

+64

(test "generated control shell is valid and emits decodable JSON"

+65

(let ((script "/tmp/slate-persistent-control-test.sh")

+66

(output "/tmp/slate-persistent-control-test.json"))

+67

(write-file-string script control)

+68

(assert-equal 0 (process-run "sh" "-n" script))

+69

(assert-equal 0 (process-run "sh" "-c"

+70

"sh /tmp/slate-persistent-control-test.sh status-json > /tmp/slate-persistent-control-test.json"))

+71

(let ((status (json-decode (read-file-string output))))

+72

(assert-equal 3 (dict-ref status schema-version: 0))

+73

(assert-equal "local-node"

+74

(dict-ref (dict-ref status identity: #{}) role: ""))

+75

(assert-equal "atomic-version-directory"

+76

(dict-ref

+77

(dict-ref (dict-ref status upgrade: #{}) installation: #{})

+78

strategy: ""))

+79

(assert-equal local-node-version

+80

(dict-ref (dict-ref status upgrade: #{}) current-version: ""))

+81

(assert-false

+82

(dict-ref

+83

(dict-ref (dict-ref status upgrade: #{}) apply: #{})

+84

available: #t))

+85

(assert-false (dict-ref (dict-ref status persistence: #{}) installed: #t)))))

+86

(test "start waits for the exact loopback health endpoint"

+87

(assert-true (and (string-contains? control "/node/health")

+88

(string-contains? control "loopback health check timed out"))))

+89

(test "stop waits for runit and exact-child cleanup"

+90

(assert-true (and (string-contains? control

+91

"while running || [ -f \"$ROOT/lifecycle/child.pid\" ]")

+92

(string-contains? control "supervisor stop timed out"))))

+93

(test "boot starts services without opening a browser"

+94

(assert-true (and (string-contains? boot "start-services.sh")

+95

(string-contains? boot "slate-service start")

+96

(not (string-contains? boot "termux-open-url")))))

+97

(test "boot records invocation and waits boundedly for runit"

+98

(assert-true (and (string-contains? boot "boot-invoked")

+99

(string-contains? boot "while ! sv status slate")

+100

(string-contains? boot "runit-readiness-timeout")

+101

(string-contains? boot "boot.log"))))

+102

(test "wake lock remains opt-in under the node root"

+103

(assert-true (string-contains? boot

+104

".local/share/slate/node/wake-lock-enabled")))))

+105

+106

(test-group "persistent install source"

+107

(test "explicit staged executable wins"

+108

(setenv! "SLATE_PERSIST_EXECUTABLE" "/tmp/staged-slate")

+109

(assert-equal "/tmp/staged-slate" (persistent-install-source))

+110

(setenv! "SLATE_PERSIST_EXECUTABLE" ""))

+111

(test "native executable path replaces Linux-only procfs assumption"

+112

(assert-true

+113

(let ((source (persistent-install-source)))

+114

(and (string? source)

+115

(> (string-length source) 0)

+116

(not (string=? source "/proc/self/exe")))))))

+117

+118

(test-group "OpenBSD rc.d service"

+119

(let ((rc (persistent-openbsd-rc-script "/home/daviwil" "daviwil")))

+120

(test "runs the stable Slate command as the login user"

+121

(assert-true

+122

(and (string-contains? rc "daemon='/home/daviwil/.local/bin/slate'")

+123

(string-contains? rc "daemon_user='daviwil'")

+124

(string-contains? rc "daemon_execdir='/home/daviwil'"))))

+125

(test "tracks any atomically selected version"

+126

(assert-true

+127

(string-contains? rc

+128

"versions/.*/slate --log-level info node run")))

+129

(test "uses foreground-safe rc.subr supervision and syslog"

+130

(assert-true

+131

(and (string-contains? rc "rc_bg=YES")

+132

(string-contains? rc "daemon_logger=\"daemon.info\"")

+133

(string-contains? rc ". /etc/rc.d/rc.subr")

+134

(string-contains? rc "rc_cmd $1"))))))

+135

+136

(test-group "canonical local node identity"

+137

(define identity-dir "/tmp/slate-persistent-test-identity")

+138

(test "Enclave-compatible names are accepted locally"

+139

(assert-true (valid-local-node-name? "phone-1"))

+140

(assert-false (valid-local-node-name? "phone one"))

+141

(assert-false (valid-local-node-name? "local:"))

+142

(assert-false (valid-local-node-name? "@phone")))

+143

(test "an explicit install name is durable"

+144

(let ((name (local-node-ensure-name! identity-dir "pocket")))

+145

(assert-equal "pocket" name)

+146

(assert-equal "pocket" (local-node-name identity-dir))

+147

(assert-equal "pocket"

+148

(config-machine-name (make-config state-dir: identity-dir)))))

+149

(test "an existing configured name wins over the ambient hostname"

+150

(setenv! "HOSTNAME" "ambient-host")

+151

(assert-equal "pocket" (local-node-ensure-name! identity-dir #f)))

+152

(test "a corrupt durable identity never falls back to hostname"

+153

(let ((corrupt-dir "/tmp/slate-persistent-test-corrupt-identity"))

+154

(ensure-directory corrupt-dir)

+155

(write-file-string (local-node-name-path corrupt-dir) "local:\n")

+156

(assert-error (local-node-name corrupt-dir)))))

+157

+158

(test-group "persistent status JSON schema"

+159

(let ((status (persistent-status-schema)))

+160

(test "top-level contract is versioned and typed"

+161

(assert-equal 3 (dict-ref status schema-version: 0))

+162

(assert-false (dict-ref (dict-ref status persistence: #{}) installed: #t))

+163

(assert-equal "not-installed" (dict-ref (dict-ref status persistence: #{}) posture: "")))

+164

(test "installed running healthy and boot are independent"

+165

(assert-false (dict-ref (dict-ref status supervisor: #{}) running: #t))

+166

(assert-false (dict-ref (dict-ref status health: #{}) healthy: #t))

+167

(assert-false (dict-ref (dict-ref status boot: #{}) configured: #t)))

+168

(test "unknown Android state remains explicit"

+169

(let ((android (dict-ref status android: #{})))

+170

(assert-equal "unknown" (dict-ref android persistence-posture: ""))

+171

(assert-equal "unknown" (dict-ref android autostart: ""))

+172

(assert-equal "unknown" (dict-ref android background: ""))

+173

(assert-equal "unknown" (dict-ref android battery-exemption: ""))))

+174

(test "lifecycle defaults distinguish missing state"

+175

(let ((life (dict-ref status lifecycle: #{})))

+176

(assert-equal "missing" (dict-ref life state: ""))

+177

(assert-false (dict-ref life last-start: #t))

+178

(assert-false (dict-ref life last-exit: #t))

+179

(assert-equal 0 (dict-ref life restart-count: -1))))))

+180

+181

(test-group "persistent status state matrix"

+182

(define (section observations key)

+183

(dict-ref (persistent-status-from-observations observations) key #{}))

+184

(test "installed but stopped"

+185

(let ((s (persistent-status-from-observations

+186

#{ installed: #t supervisor-available: #t lifecycle-state: "valid" })))

+187

(assert-true (dict-ref (dict-ref s persistence: #{}) installed: #f))

+188

(assert-false (dict-ref (dict-ref s supervisor: #{}) running: #t))

+189

(assert-equal "absent" (dict-ref (dict-ref s process: #{}) pid-state: ""))))

+190

(test "running healthy exact PID"

+191

(let ((s (persistent-status-from-observations

+192

#{ installed: #t supervisor-available: #t supervisor-running: #t

+193

pid: 4242 pid-live: #t healthy: #t })))

+194

(assert-equal "exact" (dict-ref (dict-ref s process: #{}) pid-state: ""))

+195

(assert-true (dict-ref (dict-ref s health: #{}) healthy: #f))))

+196

(test "running unhealthy is not collapsed"

+197

(let ((s (persistent-status-from-observations

+198

#{ supervisor-running: #t pid: 4242 pid-live: #t healthy: #f })))

+199

(assert-true (dict-ref (dict-ref s supervisor: #{}) running: #f))

+200

(assert-false (dict-ref (dict-ref s health: #{}) healthy: #t))))

+201

(test "stale PID"

+202

(assert-equal "stale"

+203

(dict-ref (section #{ pid: 4242 pid-live: #f } process:) pid-state: "")))

+204

(test "missing supervisor"

+205

(assert-false

+206

(dict-ref (section #{ installed: #t supervisor-available: #f } supervisor:)

+207

available: #t)))

+208

(test "Termux boot configuration changes only Android user-managed posture"

+209

(let ((s (persistent-status-from-observations

+210

#{ platform-kind: "android" environment: "termux"

+211

boot-configured: #t })))

+212

(assert-true (dict-ref (dict-ref s boot: #{}) configured: #f))

+213

(assert-equal "user-managed"

+214

(dict-ref (dict-ref s android: #{}) persistence-posture: ""))))

+215

(test "corrupt lifecycle remains corrupt"

+216

(assert-equal "corrupt"

+217

(dict-ref (section #{ lifecycle-state: "corrupt" } lifecycle:) state: "")))

+218

(test "restart bookkeeping and exit detail survive"

+219

(let* ((last #{ at: "2026-08-30T12:00:00+03:00" status: 159 reason: "exited" })

+220

(life (section #{ restart-count: 7 last-exit: last } lifecycle:)))

+221

(assert-equal 7 (dict-ref life restart-count: 0))

+222

(assert-equal 159 (dict-ref (dict-ref life last-exit: #{}) status: 0))))

+223

(test "unclean recovery can carry unknown exit time and status"

+224

(let* ((last #{ at: #f observed-at: "2026-08-30T17:00:27+03:00"

+225

status: #f reason: "unclean-supervisor-recovery" })

+226

(life (section #{ restart-count: 2 last-exit: last } lifecycle:)))

+227

(assert-false (dict-ref (dict-ref life last-exit: #{}) status: #t))

+228

(assert-equal 2 (dict-ref life restart-count: 0)))))

+229

+230

(test-group "cross-platform local node status"

+231

(test "missing control script falls back to native desktop status"

+232

(let ((prefix (getenv "SLATE_TERMUX_PREFIX"))

+233

(termux-version (getenv "TERMUX_VERSION")))

+234

(setenv! "SLATE_TERMUX_PREFIX" #f)

+235

(setenv! "TERMUX_VERSION" #f)

+236

(let* ((s (persistent-fallback-status))

+237

(platform (dict-ref s platform: #{}))

+238

(supervision (dict-ref s supervision: #{})))

+239

(assert-equal "desktop" (dict-ref platform kind: ""))

+240

(assert-equal "native" (dict-ref platform environment: ""))

+241

(assert-equal "none" (dict-ref supervision kind: "")))

+242

(setenv! "SLATE_TERMUX_PREFIX" prefix)

+243

(setenv! "TERMUX_VERSION" termux-version)))

+244

(test "missing control script retains Termux status on Android"

+245

(let* ((s (persistent-fallback-status))

+246

(platform (dict-ref s platform: #{}))

+247

(supervision (dict-ref s supervision: #{})))

+248

(assert-equal "android" (dict-ref platform kind: ""))

+249

(assert-equal "termux" (dict-ref platform environment: ""))

+250

(assert-equal "runit" (dict-ref supervision kind: ""))))

+251

(test "foreground desktop is healthy without pretending to be supervised"

+252

(let* ((s (persistent-status-from-observations

+253

#{ platform-kind: "linux" environment: "native"

+254

supervision-kind: "none" pid: 4242 pid-live: #t healthy: #t }))

+255

(platform (dict-ref s platform: #{}))

+256

(supervision (dict-ref s supervision: #{})))

+257

(assert-equal "native" (dict-ref platform environment: ""))

+258

(assert-equal "none" (dict-ref supervision kind: ""))

+259

(assert-false (dict-ref supervision running: #t))

+260

(assert-true (dict-ref (dict-ref s listener: #{}) healthy: #f))))

+261

(test "supervised desktop uses the common contract"

+262

(let* ((s (persistent-status-from-observations

+263

#{ platform-kind: "linux" environment: "native"

+264

supervision-kind: "systemd" supervisor-available: #t

+265

supervisor-running: #t boot-configured: #t }))

+266

(details (dict-ref (dict-ref s platform-details: #{}) desktop: #{})))

+267

(assert-equal "systemd" (dict-ref details service-manager: ""))

+268

(assert-equal "configured"

+269

(dict-ref (dict-ref s autostart: #{}) posture: ""))

+270

(assert-equal "unknown"

+271

(dict-ref (dict-ref s android: #{}) persistence-posture: ""))))

+272

(test "Termux details do not shape the shared supervision fields"

+273

(let* ((s (persistent-status-from-observations

+274

#{ platform-kind: "android" environment: "termux"

+275

supervision-kind: "runit" supervisor-available: #t

+276

supervisor-running: #t boot-configured: #t wake-lock: "enabled" }))

+277

(termux (dict-ref (dict-ref s platform-details: #{}) termux: #{})))

+278

(assert-equal "runit" (dict-ref (dict-ref s supervision: #{}) kind: ""))

+279

(assert-equal "enabled" (dict-ref termux wake-lock: ""))

+280

(assert-equal "user-managed" (dict-ref termux android-persistence-posture: ""))))

+281

(test "status serialization preserves schema version"

+282

(let ((decoded (json-decode

+283

(persistent-status-json (persistent-status-schema)))))

+284

(assert-equal 3 (dict-ref decoded schema-version: 0)))))

+285

+286

(test-group "local-node role and capability posture"

+287

(test "role is local-node on every platform"

+288

(for-each

+289

(lambda (environment)

+290

(let ((status (persistent-status-from-observations

+291

#{ environment: environment })))

+292

(assert-equal "local-node"

+293

(dict-ref (dict-ref status identity: #{}) role: ""))))

+294

'("native" "termux")))

+295

(test "implemented local planes are declared independently of grants"

+296

(let ((posture (local-node-capability-posture)))

+297

(for-each

+298

(lambda (key)

+299

(assert-true (dict-ref (dict-ref posture key #{}) available: #f)))

+300

(list resource: session: agent: renderer:))))

+301

(test "remote transport management is explicitly unavailable"

+302

(let ((remote (dict-ref (local-node-capability-posture)

+303

remote-transport-manager: #{})))

+304

(assert-false (dict-ref remote available: #t))

+305

(assert-equal "not-implemented" (dict-ref remote reason: ""))))

+306

(test "closed policy does not admit a remote transport family"

+307

(assert-true (local-node-allows-verb? "fs/read-file"))

+308

(assert-true (local-node-allows-verb? "git/status"))

+309

(assert-true (local-node-allows-verb? "git/switch-branch"))

+310

(assert-true (local-node-allows-verb? "session/open"))

+311

(assert-false (local-node-allows-verb? "remote/dial"))))

+312

+313

(test-group "local-node upgrade posture"

+314

(test "desktop and Android share the read-only upgrade contract"

+315

(for-each

+316

(lambda (fixture)

+317

(let ((upgrade (dict-ref fixture upgrade: #{})))

+318

(assert-equal local-node-version

+319

(dict-ref upgrade current-version: ""))

+320

(assert-equal "/node/api/version"

+321

(dict-ref (dict-ref upgrade check: #{}) endpoint: ""))

+322

(assert-false

+323

(dict-ref (dict-ref upgrade apply: #{}) available: #t))

+324

(assert-false

+325

(dict-ref (dict-ref upgrade rollback: #{}) available: #t))))

+326

(list

+327

(persistent-status-from-observations

+328

#{ platform-kind: "desktop" environment: "native" })

+329

(persistent-status-from-observations

+330

#{ platform-kind: "android" environment: "termux" }))))

+331

(test "version observations classify upgrade state"

+332

(assert-equal "not-checked"

+333

(dict-ref (local-node-upgrade-posture "desktop" "native" #f #f)

+334

state: ""))

+335

(assert-equal "up-to-date"

+336

(dict-ref

+337

(local-node-upgrade-posture "desktop" "native" #f local-node-version)

+338

state: ""))

+339

(assert-equal "upgrade-available"

+340

(dict-ref

+341

(local-node-upgrade-posture "android" "termux" #t "0.2.0")

+342

state: "")))

+343

(test "platform install strategy is explicit"

+344

(assert-equal "package-managed"

+345

(dict-ref

+346

(dict-ref (local-node-upgrade-posture "desktop" "native" #f #f)

+347

installation: #{})

+348

strategy: ""))

+349

(assert-equal "atomic-version-directory"

+350

(dict-ref

+351

(dict-ref (local-node-upgrade-posture "android" "termux" #t #f)

+352

installation: #{})

+353

strategy: ""))))

+354

+355

(test-group "persistent app selection"

+356

(test "staging alias"

+357

(assert-equal "https://next.useslate.org" (persistent-app-url "staging")))

+358

(test "production alias"

+359

(assert-equal "https://useslate.org" (persistent-app-url "production")))

+360

(test "arbitrary https URL"

+361

(assert-equal "https://preview.example/app" (persistent-app-url "https://preview.example/app")))

+362

(test "plaintext and unknown aliases are refused"

+363

(assert-false (persistent-app-url "http://example.com"))

+364

(assert-false (persistent-app-url "preview"))))

packages/slate-cli/test/test-proxy.sglmodified

@@ -105,7 +105,7 @@

105

(cache-set-version-seen! c "V-9")

106

(cache-put! c "/sw.js" "V-9" (string->utf8 "x") "text/javascript" "no-cache")

107

(let* ((daemon #{ config: config instance: "t" })

−108

(info (version-info daemon)))

+108

(info (version-info daemon (dead-fetch))))

109

(test "reports cli-version" (assert-equal cli-version (dict-ref info cli-version: #f)))

110

(test "reports protocol 1" (assert-equal 1 (dict-ref info protocol: #f)))

111

(test "reports pwa-version-seen from the cache"

packages/slate-cli/test/test-reaper.sglmodified

@@ -476,7 +476,9 @@

476

(sleep 1.6)

477

(reap-pass hub)

478

(vector-set! gone 0 (hub-session-count hub))

−479

(sleep 1.0)))

+479

(assert-true (not (hub-quiescent? hub)))

+480

(sleep 1.0)

+481

(assert-true (hub-quiescent? hub))))

482

(assert-equal 0 (vector-ref gone 0))))

483

484

;; ARM 2 — THE STAND-DOWN CONTROL, and the arm the brief calls most likely

@@ -740,7 +742,7 @@

742

;; A harness that supplies the context production is missing cannot see a

743

;; missing-context defect. The only cure is an arm that runs the REAL BINARY on

744

;; the REAL PATH, which is what this is.

−743

(define (slate-binary) "./build/dev/bin/slate")

+745

(define (slate-binary) (or (getenv "SLATE_TEST_BIN") "./build/dev/bin/slate"))

746

747

(test-group "reaper - the holder boots (real binary, real entry point)"

748

packages/slate-cli/test/test-resource-plane.sglmodified

@@ -27,6 +27,7 @@

27

(sigil io)

28

(sigil fs)

29

(sigil path)

+30

(sigil process)

31

(sigil json)

32

(sigil array)

33

(sigil wire)

@@ -46,9 +47,14 @@

47

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

48

(grant-add! GRANTS "exec:full")

49

+50

(define HOME-GRANTS (make-grants principal: (string-append "web:" ORIGIN)))

+51

(grant-add! HOME-GRANTS (string-append "fs:ro:" (getenv "HOME")))

+52

53

(define DAEMON

−50

#{ config: (make-config machine-name: "testhost" state-dir: "/tmp")

−51

instance: "test-instance" })

+54

#{ config: (make-config machine-name: "testhost" state-dir: ROOT)

+55

instance: "test-instance"

+56

node-identity: (vector "slate-node-test-opaque")

+57

node-label: (vector "testbox") })

58

59

;; A dedicated listing dir: sub/ (dir), a.txt, b.txt.

60

(define LIST (path-join ROOT "listing"))

@@ -87,6 +93,18 @@

93

;; ============================================================

94

;; fs/read-dir — bulk listing round-trip + canonical order

95

;; ============================================================

+96

(test-group "fs/home - root landing"

+97

(test "returns the process home when that tree is granted"

+98

(let ((rep (send #{ t: "req" id: 6 verb: "fs/home" args: #{} } HOME-GRANTS)))

+99

(assert-equal "ok" (rt rep))

+100

(assert-equal (getenv "HOME") (dict-ref (rresult rep) path: #f))))

+101

+102

(test "does not disclose home without a filesystem grant"

+103

(let* ((nogrants (make-grants principal: "web:evil"))

+104

(rep (send #{ t: "req" id: 61 verb: "fs/home" args: #{} } nogrants)))

+105

(assert-equal "err" (rt rep))

+106

(assert-equal "grant-denied" (rcode rep)))))

+107

108

(test-group "fs/read-dir - bulk listing"

109

(test "real dir -> bulk frame the client decodes, canonical order"

110

(let* ((rep (send #{ t: "req" id: 7 verb: "fs/read-dir" args: #{ path: LIST } }

@@ -183,7 +201,25 @@

201

(assert-true (string? (dict-ref r platform: #f)))

202

(assert-true (string? (dict-ref r hostname: #f)))

203

(assert-equal "testhost" (dict-ref r hostname: #f))

+204

(assert-equal "slate-node-test-opaque"

+205

(dict-ref r node-identity: #f))

+206

(assert-equal "testbox" (dict-ref r node-label: #f))

+207

(assert-false

+208

(dict-ref (dict-ref r direct: #{}) available: #t))

209

(assert-true (array? (dict-ref r capabilities: #f)))

+210

(assert-true

+211

(string-contains? (call-with-output-string

+212

(lambda (port)

+213

(write (dict-ref r capabilities: #[]) port)))

+214

"session"))

+215

(assert-true

+216

(string-contains? (call-with-output-string

+217

(lambda (port)

+218

(write (dict-ref r capabilities: #[]) port)))

+219

"agent"))

+220

(assert-equal '() (dict-ref r pairings: #f))

+221

(assert-equal "stale"

+222

(dict-ref r pairing-revocation-freshness: #f))

223

;; grant summary = the origin's configured spec list (non-empty).

224

(assert-true (pair? (dict-ref r grants: #f))))))

225

@@ -212,6 +248,41 @@

248

(assert-true (bytevector? body))

249

(assert-equal "bee" (utf8->string body))))))

250

+251

(test-group "fs/read-file and fs/write-file - streamed transfer negotiation"

+252

(test "read negotiation authorizes and reports size without a unary body"

+253

(let* ((p (path-join ROOT "stream-read.bin"))

+254

(_ (write-file-bytes p (bytevector 1 2 3 4 5 6)))

+255

(rep (send #{ t: "req" id: 70 verb: "fs/read-file"

+256

args: #{ path: p transfer: #t } } GRANTS))

+257

(transfer (reply-transfer rep)))

+258

(assert-equal 'download (dict-ref transfer direction: #f))

+259

(assert-equal p (dict-ref transfer path: #f))

+260

(assert-equal 6 (dict-ref transfer size: #f))

+261

(assert-false (reply-bulk rep))))

+262

+263

(test "write negotiation checks grants and pins the declared size"

+264

(let* ((p (path-join ROOT "stream-write.bin"))

+265

(rep (send #{ t: "req" id: 71 verb: "fs/write-file"

+266

args: #{ path: p transfer: #t size: 9000000 } } GRANTS))

+267

(transfer (reply-transfer rep)))

+268

(assert-equal 'upload (dict-ref transfer direction: #f))

+269

(assert-equal 9000000 (dict-ref transfer size: #f))

+270

(assert-false (file-exists? p))))

+271

+272

(test "invalid size and denied paths open no transfer descriptor"

+273

(let ((bad-size (send #{ t: "req" id: 72 verb: "fs/write-file"

+274

args: #{ path: (path-join ROOT "bad.bin")

+275

transfer: #t size: -1 } } GRANTS))

+276

(denied (send #{ t: "req" id: 73 verb: "fs/write-file"

+277

args: #{ path: "/etc/slate-transfer-denied"

+278

transfer: #t size: 1 } }

+279

(make-grants principal: "web:none"))))

+280

(assert-equal "invalid-args" (rcode bad-size))

+281

(assert-equal "grant-denied" (rcode denied))

+282

(assert-false (reply-transfer bad-size))

+283

(assert-false (reply-transfer denied))))

+284

)

+285

286

(test-group "fs/write-file - inline string"

287

(test "writes and returns the new stat"

288

(let* ((p (path-join ROOT "written.txt"))

@@ -325,6 +396,10 @@

396

(test "unknown verb -> unknown-verb err"

397

(let ((rep (send #{ t: "req" id: 50 verb: "fs/bogus" args: #{} } GRANTS)))

398

(assert-equal "unknown-verb" (rcode rep))))

+399

(test "local-node role refuses an undeclared remote transport family"

+400

(let ((rep (send #{ t: "req" id: 54 verb: "remote/dial" } GRANTS)))

+401

(assert-equal "err" (rt rep))

+402

(assert-equal "role-denied" (rcode rep))))

403

404

(test "missing id -> invalid-id err"

405

(let ((rep (dispatch-req DAEMON ORIGIN GRANTS #{ t: "req" verb: "sys/info" })))

packages/slate-cli/test/test-revoke.sglmodified

@@ -81,3 +81,21 @@

81

(_ (mint! store useslate)))

82

(test "paired origin -> #t" (assert-true (origin-still-paired? store useslate)))

83

(test "unpaired origin -> #f" (assert-false (origin-still-paired? store other)))))

+84

+85

(test-group "metadata-driven connection invalidation"

+86

(test "matched paired connections are removed before close"

+87

(let* ((reg (make-conn-registry))

+88

(closed '())

+89

(paired (registry-add! reg "direct"

+90

(lambda () (set! closed (cons 'paired closed)))

+91

#{ auth-kind: 'paired peer: "phone" }))

+92

(_broker (registry-add! reg "broker"

+93

(lambda () (set! closed (cons 'broker closed)))

+94

#{ auth-kind: 'broker peer: "phone" })))

+95

(assert-equal "phone" (dict-ref (entry-metadata paired) peer: #f))

+96

(assert-equal 1

+97

(registry-close-matching! reg

+98

(lambda (entry)

+99

(eq? (dict-ref (entry-metadata entry) auth-kind: #f) 'paired))))

+100

(assert-equal '(paired) closed)

+101

(assert-equal 1 (length (registry-entries reg))))))

packages/slate-cli/test/test-sessions.sglmodified

@@ -26,6 +26,7 @@

26

(sigil math)

27

(sigil string)

28

(sigil io)

+29

(sigil process)

30

(sigil async)

31

(sigil channels)

32

(sigil websocket frame)

@@ -153,6 +154,21 @@

154

(define (marker? cap sid s)

155

(string-contains? (utf8->string (collected-out cap sid)) s))

156

+157

(define (trace-result cap sid seq)

+158

(let loop ((frames (cap-frames cap)))

+159

(cond

+160

((null? frames) #f)

+161

((= (ws-frame-opcode (car frames)) opcode-binary)

+162

(let ((frame (decode-stream-frame (ws-frame-payload (car frames)))))

+163

(if (and (stream-frame? frame)

+164

(= (stream-frame-type frame) frame-trace-out)

+165

(= (stream-frame-id frame) sid)

+166

(= (bytevector-length (stream-frame-payload frame)) 12)

+167

(= (u32-at (stream-frame-payload frame) 0) seq))

+168

frame

+169

(loop (cdr frames)))))

+170

(else (loop (cdr frames))))))

+171

172

(define (error-text cap sid)

173

(let loop ((frames (cap-frames cap)))

174

(cond

@@ -183,13 +199,48 @@

199

(define (send-frame! daemon conn type sid payload)

200

(sessions-handle-binary daemon conn (encode-stream-frame type sid payload)))

201

−186

(test-group "sessions - late client frames fail cleanly"

−187

(test "credit racing session exit returns an encoded error"

+202

(test-group "sessions - late client frames distinguish acknowledgements from operations"

+203

(test "credit racing session exit is an idempotent acknowledgement"

204

(let ((daemon (make-test-daemon)) (conn (make-fake-conn)) (cap (make-cap)))

205

(send-frame! daemon conn frame-credit 99 (u32-be 10))

206

(drain! conn cap)

+207

(assert-false (error-text cap 99))))

+208

+209

(test "input targeting a retired session still returns an encoded error"

+210

(let ((daemon (make-test-daemon)) (conn (make-fake-conn)) (cap (make-cap)))

+211

(send-frame! daemon conn frame-data-in 99 (string->utf8 "whoami\n"))

+212

(drain! conn cap)

213

(assert-equal "no such session" (error-text cap 99)))))

214

+215

(test-group "sessions - opt-in terminal performance trace"

+216

(test "trace marker correlates the next terminal write and output"

+217

(let ((seen (vector #f)))

+218

(with-async

+219

(let ((daemon (make-test-daemon))

+220

(conn (make-fake-conn))

+221

(cap (make-cap)))

+222

(sessions-on-text daemon conn (open-req #[ "sh" "-c" "cat" ]))

+223

(pump-until conn cap (lambda () (> (out-length cap 1) 0)) 250)

+224

(send-frame! daemon conn frame-trace-in 1 (u32-be 4242))

+225

(send-frame! daemon conn frame-data-in 1 (string->utf8 "TRACE-"))

+226

;; Two writes may be coalesced into one PTY output chunk; both trace

+227

;; markers must be retired by that chunk rather than drifting.

+228

(send-frame! daemon conn frame-trace-in 1 (u32-be 4243))

+229

(send-frame! daemon conn frame-data-in 1 (string->utf8 "OK\n"))

+230

(pump-until conn cap

+231

(lambda () (and (marker? cap 1 "TRACE-OK")

+232

(trace-result cap 1 4242)

+233

(trace-result cap 1 4243)))

+234

250)

+235

(let ((frame (trace-result cap 1 4242)))

+236

(vector-set! seen 0

+237

(and frame

+238

(trace-result cap 1 4243)

+239

(>= (u32-at (stream-frame-payload frame) 4) 0)

+240

(>= (u32-at (stream-frame-payload frame) 8) 0))))

+241

(teardown! daemon conn 1)))

+242

(assert-true (vector-ref seen 0)))))

+243

244

;; Wake (credit) + close a session and let it reap, so no goroutine

245

;; lingers past the with-async block.

246

(define (teardown! daemon conn sid)

@@ -209,6 +260,24 @@

260

;; 4. On-the-wire: session/open runs a real pty

261

;; ============================================================

262

(test-group "sessions - open + stream (real pty)"

+263

(test "session/open honors grants cached by an authenticated direct peer"

+264

(let ((ok (vector #f)))

+265

(with-async

+266

(let ((daemon (make-test-daemon))

+267

(conn (make-fake-conn))

+268

(cap (make-cap)))

+269

;; This peer is intentionally absent from daemon config. Direct

+270

;; mutual authentication supplies the effective grants on CONN.

+271

(conn-state-set! conn "test-origin" "gate-caller")

+272

(conn-state-set! conn "grants"

+273

(build-grants "web:gate-caller" (list "pty:on" "exec:full")))

+274

(sessions-on-text daemon conn

+275

(open-req #[ "sh" "-c" "printf DIRECT-GRANTS-OK" ]))

+276

(pump-until conn cap

+277

(lambda () (marker? cap 1 "DIRECT-GRANTS-OK")) 250)

+278

(vector-set! ok 0 (marker? cap 1 "DIRECT-GRANTS-OK"))))

+279

(assert-true (vector-ref ok 0))))

+280

281

(test "session/open runs a shell and streams its output as data-out"

282

(let ((ok (vector #f)))

283

(with-async

@@ -253,6 +322,23 @@

322

(teardown! daemon conn 1)))

323

(assert-true (string-contains? (vector-ref seen 0) "ARGV-HONOURED"))))

324

+325

(test "session/open starts the child in the requested working directory"

+326

(let ((seen (vector ""))

+327

(home (getenv "HOME")))

+328

(with-async

+329

(let ((daemon (make-test-daemon))

+330

(conn (make-fake-conn))

+331

(cap (make-cap)))

+332

(sessions-on-text daemon conn

+333

(encode-control #{ t: "req" id: 1 verb: "session/open"

+334

args: #{ argv: #[ "sh" "-c" "pwd" ]

+335

kind: "pty" cwd: home

+336

cols: 80 rows: 24 } }))

+337

(pump-until conn cap (lambda () (marker? cap 1 home)) 250)

+338

(vector-set! seen 0 (utf8->string (collected-out cap 1)))

+339

(teardown! daemon conn 1)))

+340

(assert-true (string-contains? (vector-ref seen 0) home))))

+341

342

;; NAMED FOR WHAT IT ACTUALLY EXERCISES. It sends `kind: "pty"` EXPLICITLY, so

343

;; it is about an honoured explicit kind — its first version used `open-req`,

344

;; which sends no `kind` field at all, and therefore only ever exercised

@@ -490,6 +576,18 @@

576

(or sid (loop (cdr fs)))))

577

(else (loop (cdr fs))))))

578

+579

(define (ok-result-for cap id)

+580

(let loop ((fs (cap-frames cap)))

+581

(cond

+582

((null? fs) #f)

+583

((= (ws-frame-opcode (car fs)) opcode-text)

+584

(let ((v (decode-control (utf8->string (ws-frame-payload (car fs))))))

+585

(if (and v (string=? (dict-ref v t: "") "ok")

+586

(= (dict-ref v id: -1) id))

+587

(dict-ref v result: #{})

+588

(loop (cdr fs)))))

+589

(else (loop (cdr fs))))))

+590

591

(test-group "sessions - detach keeps alive, attach replays"

592

(test "a new connection attaching to a detached session replays the ring"

593

(let ((got (vector #f)) (minted (vector #f)))

@@ -516,6 +614,12 @@

614

args: #{ sid: (vector-ref minted 0) } }))

615

(pump-until c2 cap2 (lambda () (marker? cap2 1 "MARK-REPLAY")) 150)

616

(vector-set! got 0 (marker? cap2 1 "MARK-REPLAY"))

+617

;; The count is part of the attach ack, before the ordered replay

+618

;; frame. A client can therefore reseed its retained emulator

+619

;; without guessing whether the next output is replay or live.

+620

(let ((result (ok-result-for cap2 3)))

+621

(assert-true (dict? result))

+622

(assert-true (> (dict-ref result replay-bytes: 0) 0)))

623

(teardown! daemon c2 1))))

624

;; Assert the sid's grammar too: if session/open ever stopped reporting a

625

;; durable sid, `ok-sid` would yield #f, both verbs would fail on a

packages/slate-cli/test/test-terminal-discovery.sgladded

@@ -0,0 +1,133 @@

+1

(import (sigil test) (sigil array) (sigil time) (sigil io)

+2

(slate-cli sessions))

+3

+4

(define (fixture-session sid principal command)

+5

(vector 'hs sid principal 'pty #f #f #f 0 #f (current-second) #f 259200 0

+6

1 '() #{ command: command cwd: "/work" created: 123 }))

+7

+8

(test "terminal catalog respects the authenticated principal and reports identity"

+9

(let* ((hub (make-session-hub))

+10

(mine (fixture-session "s-1111111111111111" "web:phone" "bash"))

+11

(other (fixture-session "s-2222222222222222" "web:other" "zsh")))

+12

(vector-set! (vector-ref hub 2) 0 (list mine other))

+13

(let ((rows (hub-session-summaries hub "web:phone")))

+14

(assert-equal 1 (length rows))

+15

(assert-equal "s-1111111111111111" (dict-ref (car rows) sid: #f))

+16

(assert-equal "bash" (dict-ref (car rows) command: #f))

+17

(assert-equal "/work" (dict-ref (car rows) cwd: #f))

+18

(assert-equal 123 (dict-ref (car rows) created: #f))

+19

(assert-true (not (dict-ref (car rows) attached: #t))))

+20

(assert-equal '() (hub-session-summaries hub "web:stranger"))

+21

(vector-set! mine 6 'connection)

+22

(assert-true (dict-ref (car (hub-session-summaries hub "web:phone")) attached: #f))

+23

(vector-set! mine 10 #t)

+24

(assert-true (not (dict-ref (car (hub-session-summaries hub "web:phone")) alive: #t)))))

+25

+26

(import (sigil async) (sigil channels) (sigil fs) (sigil path) (sigil process)

+27

(sigil websocket frame)

+28

(slate-cli config) (slate-cli listen) (slate-cli wire)

+29

(slate-cli enclave-stream) (slate-cli terminal discovery))

+30

+31

(define (catalog-conn origin)

+32

(let ((conn (make-conn-ctx #f #f)))

+33

(conn-state-set! conn "test-origin" origin)

+34

(conn-state-set! conn "authed?" #t)

+35

(conn-state-set! conn "outq" (make-channel 256))

+36

conn))

+37

(define (catalog-request daemon conn id verb args)

+38

(sessions-on-text daemon conn

+39

(encode-control #{ t: "req" id: id verb: verb args: args }))

+40

(let loop ()

+41

(let ((item (channel-try-receive (conn-state-get conn "outq" #f))))

+42

(and (pair? item)

+43

(let ((frame (frame-decode-result-frame (decode-frame (car item)))))

+44

(if (and frame (= (ws-frame-opcode frame) opcode-text))

+45

(let ((reply (decode-control (utf8->string (ws-frame-payload frame)))))

+46

(if (equal? (dict-ref reply id: #f) id) reply (loop)))

+47

(loop)))))))

+48

+49

(test "holder LIST answers with principal-filtered summaries over its real socket"

+50

(let* ((dir (string-append "/tmp/slate-catalog-test-" (number->string (process-id))))

+51

(path (path-join dir "h-test.sock"))

+52

(hub (make-session-hub))

+53

(running (vector #t)))

+54

(ensure-directory dir)

+55

(vector-set! (vector-ref hub 2) 0

+56

(list (fixture-session "s-3333333333333333" "web:phone" "bash")

+57

(fixture-session "s-4444444444444444" "web:other" "zsh")))

+58

(with-async

+59

(assert-true (enclave-stream-listen! path (make-config) hub))

+60

(go (let poll ()

+61

(when (vector-ref running 0)

+62

(enclave-stream-poll!)

+63

(sleep 0.005)

+64

(poll))))

+65

(let ((rows (terminal-query path "web:phone")))

+66

(assert-equal 1 (length rows))

+67

(assert-equal "s-3333333333333333" (dict-ref (car rows) sid: #f)))

+68

(assert-equal '() (terminal-query path "web:unknown"))

+69

(let ((result (terminal-discover dir #f "web:phone" '())))

+70

(assert-equal 0 (dict-ref result unavailable: -1))

+71

(assert-equal 1 (array-length (dict-ref result sessions: #[]))))

+72

(let* ((local (make-session-hub))

+73

(conn (catalog-conn "phone"))

+74

(daemon #{ sessions: local config: (make-config)

+75

session-directory: (vector

+76

(lambda (principal mine)

+77

(terminal-discover dir #f principal mine))) }))

+78

(vector-set! (vector-ref local 2) 0

+79

(list (fixture-session "s-5555555555555555" "web:phone" "sh")))

+80

(let* ((reply (catalog-request daemon conn 12 "session/list"

+81

#{ principal: "web:other" }))

+82

(result (dict-ref reply result: #{}))

+83

(rows (array->list (dict-ref result sessions: #[]))))

+84

(assert-equal 1 (dict-ref result catalog-version: #f))

+85

(assert-equal 2 (length rows))

+86

(assert-equal "s-5555555555555555" (dict-ref (car rows) sid: #f))

+87

(assert-equal "s-3333333333333333" (dict-ref (cadr rows) sid: #f))

+88

(assert-equal "relay" (dict-ref (cadr rows) route: #f))))

+89

(vector-set! running 0 #f)

+90

(enclave-stream-unlisten!)

+91

(sleep 0.02))))

+92

+93

(test "listing and reattaching a real PTY preserves its process and session identity"

+94

(with-async

+95

(let* ((hub (make-session-hub))

+96

(daemon #{ sessions: hub config: (make-config

+97

grants: (list (cons "https://useslate.org"

+98

(list "exec:full" "pty:on" "fs:rw:/tmp")))) })

+99

(first (catalog-conn "https://useslate.org"))

+100

(second (catalog-conn "https://useslate.org"))

+101

(foreign (catalog-conn "https://other.example"))

+102

(opened (catalog-request daemon first 1 "session/open"

+103

#{kind: "pty" argv: (list "sh" "-c" "while read line; do echo alive; done")

+104

cwd: "/tmp" cols: 80 rows: 24}))

+105

(binding (dict-ref opened result: #{}))

+106

(sid (dict-ref binding sid: #f))

+107

(chan (dict-ref binding chan: #f)))

+108

(assert-equal "ok" (dict-ref opened t: #f))

+109

(let* ((hs (car (vector-ref (vector-ref hub 2) 0)))

+110

;; Inspect the actual process handle, independently of the wire SID.

+111

(process (vector-ref (vector-ref hs 4) 3))

+112

(pid (process-pid process)))

+113

(catalog-request daemon first 2 "session/detach" #{sid: sid})

+114

(let* ((listed (catalog-request daemon second 3 "session/list" #{}))

+115

(rows (array->list (dict-ref (dict-ref listed result: #{}) sessions: #[]))))

+116

(assert-equal 1 (length rows))

+117

(assert-equal sid (dict-ref (car rows) sid: #f))

+118

(assert-equal "/tmp" (dict-ref (car rows) cwd: #f))

+119

(assert-true (not (dict-ref (car rows) attached: #t))))

+120

(assert-equal "err"

+121

(dict-ref (catalog-request daemon foreign 4 "session/attach" #{sid: sid}) t: #f))

+122

(assert-equal "ok"

+123

(dict-ref (catalog-request daemon second 5 "session/attach" #{sid: sid}) t: #f))

+124

(assert-equal 1 (hub-session-count hub))

+125

(assert-true (process-alive? process))

+126

(assert-equal pid

+127

(process-pid (vector-ref (vector-ref (car (vector-ref (vector-ref hub 2) 0)) 4) 3)))

+128

(sessions-handle-binary daemon second

+129

(encode-stream-frame frame-credit chan (u32-be 1000000)))

+130

(sessions-handle-binary daemon second

+131

(encode-stream-frame frame-close chan (bytevector)))

+132

(sleep 0.3)))))

+133

(test-summary)

packages/slate-cli/test/test-terminal-owner.sgladded

@@ -0,0 +1,85 @@

+1

(import (sigil test) (sigil async) (sigil channels) (sigil fs) (sigil io)

+2

(sigil system grant) (sigil websocket frame)

+3

(slate-cli config) (slate-cli listen) (slate-cli sessions)

+4

(slate-cli terminal owner) (slate-cli wire))

+5

+6

(test "delegated opens enforce the connection's actual exec, PTY and cwd grants"

+7

(with-async

+8

(let* ((conn (make-virtual-conn (lambda (bytes) #t) "phone"))

+9

(daemon #{config: (make-config

+10

grants: (list (cons "phone" (list "exec:full" "pty:on" "fs:rw:/")) ))})

+11

(restricted (make-grants principal: "web:phone")))

+12

(grant-add! restricted "exec:allowlist:sh")

+13

(conn-state-set! conn "grants" restricted)

+14

;; The permissive config must never override an authenticated connection.

+15

(assert-error (sessions-authorize-open! daemon conn #{argv: (list "sh")}))

+16

(grant-add! restricted "pty:on")

+17

(sessions-authorize-open! daemon conn #{argv: (list "sh")})

+18

(assert-error (sessions-authorize-open! daemon conn #{argv: (list "bash")}))

+19

(assert-error (sessions-authorize-open! daemon conn #{argv: (list "sh") cwd: "/tmp"}))

+20

(grant-add! restricted "fs:ro:/tmp")

+21

(sessions-authorize-open! daemon conn #{argv: (list "sh") cwd: "/tmp"})

+22

;; Replacing grants after a previous successful open must take effect.

+23

(conn-state-set! conn "grants" (make-grants principal: "web:phone"))

+24

(assert-error (sessions-authorize-open! daemon conn #{argv: (list "sh")})))))

+25

+26

(test "denied delegated opens answer the caller before starting any owner"

+27

(with-async

+28

(call-with-temp-directory

+29

(lambda (dir)

+30

(let* ((replies '())

+31

(conn (make-virtual-conn

+32

(lambda (bytes) (set! replies (cons bytes replies))) "phone"))

+33

(config (make-config state-dir: dir))

+34

(daemon #{config: config sessions: (make-session-hub)

+35

session-backend: (make-terminal-backend config)}))

+36

(conn-state-set! conn "grants" (make-grants principal: "web:phone"))

+37

(sessions-on-text daemon conn

+38

(encode-control #{t: "req" id: 1 verb: "session/open" args: #{argv: (list "sh")}}))

+39

(assert-equal 1 (length replies))

+40

(let* ((frame (frame-decode-result-frame (decode-frame (car replies))))

+41

(reply (decode-control (utf8->string (ws-frame-payload frame)))))

+42

(assert-equal "err" (dict-ref reply t: #f)))

+43

(assert-true (not (directory? (string-append dir "/pty"))))))

+44

recursive: #t)))

+45

+46

(test "the owner refuses excess sessions and releases capacity after real cleanup"

+47

(with-async

+48

(let* ((replies '())

+49

(conn (make-virtual-conn

+50

(lambda (bytes)

+51

(let ((frame (frame-decode-result-frame (decode-frame bytes))))

+52

(when (= (ws-frame-opcode frame) opcode-text)

+53

(set! replies

+54

(cons (decode-control (utf8->string (ws-frame-payload frame))) replies)))))

+55

"phone"))

+56

(hub (make-session-hub))

+57

(daemon #{config: (make-config) sessions: hub max-sessions: 1}))

+58

(define (open! id)

+59

(sessions-on-text daemon conn

+60

(encode-control #{t: "req" id: id verb: "session/open"

+61

args: #{argv: (list "sh" "-c" "read line")}}))

+62

(let loop ((tries 100))

+63

(let ((reply (find (lambda (item) (equal? id (dict-ref item id: #f))) replies)))

+64

(cond

+65

(reply reply)

+66

((= tries 0) (error "session reply timed out"))

+67

(else (sleep 0.01) (loop (- tries 1)))))))

+68

(define (close! reply)

+69

(sessions-handle-binary daemon conn

+70

(encode-stream-frame frame-close (dict-ref (dict-ref reply result: #{}) chan: 0)

+71

(bytevector)))

+72

(let loop ((tries 200))

+73

(unless (or (hub-quiescent? hub) (= tries 0))

+74

(sleep 0.01) (loop (- tries 1))))

+75

(assert-true (hub-quiescent? hub)))

+76

(conn-state-set! conn "grants" (grant-allow-all principal: "web:phone"))

+77

(let ((first (open! 1)))

+78

(assert-equal "ok" (dict-ref first t: #f))

+79

(assert-equal "busy" (dict-ref (open! 2) code: #f))

+80

(assert-equal 1 (hub-session-count hub))

+81

(close! first)

+82

(let ((replacement (open! 3)))

+83

(assert-equal "ok" (dict-ref replacement t: #f))

+84

(close! replacement)))

+85

(sessions-conn-closed! daemon conn))))

packages/slate-cli/test/test-transfer-file.sgladded

@@ -0,0 +1,93 @@

+1

(import (sigil test) (sigil core) (sigil fs) (sigil path)

+2

(sigil system grant)

+3

(slate-cli resource transfer)

+4

(slate-cli resource transfer file)

+5

(slate-cli wire))

+6

+7

(define ROOT (make-temp-directory))

+8

(define GRANTS (make-grants principal: "web:test"))

+9

(grant-add! GRANTS (string-append "fs:rw:" ROOT))

+10

+11

(define (frame-list-bytes frames)

+12

(let loop ((rest frames) (out (make-bytevector 0 0)))

+13

(if (null? rest) out

+14

(let* ((frame (decode-stream-frame (car rest)))

+15

(batch (decode-transfer-batch frame)))

+16

(if batch

+17

(loop (cdr rest) (bytevector-append out (dict-ref batch bytes: #f)))

+18

(loop (cdr rest) out))))))

+19

+20

(test-group "streaming file transfer adapter"

+21

(test "upload is invisible until exact end then publishes atomically"

+22

(let* ((m (make-file-transfer-manager))

+23

(path (path-join ROOT "upload.bin"))

+24

(body (bytevector 1 2 3 4 5)))

+25

(write-file-string path "old")

+26

(assert-equal 'ready

+27

(dict-ref (file-upload-open! m GRANTS 1 path 5) status: #f))

+28

(assert-equal 'accepted

+29

(dict-ref (file-upload-batch! m

+30

(decode-stream-frame (encode-transfer-batch 1 0 body)))

+31

status: #f))

+32

(assert-equal "old" (read-file-string path))

+33

(assert-equal 'complete

+34

(dict-ref (file-transfer-end! m

+35

(decode-stream-frame (encode-transfer-end 1 1 5)))

+36

status: #f))

+37

(let ((actual (read-file-bytes path)))

+38

(assert-equal 5 (bytevector-length actual))

+39

(assert-equal 1 (bytevector-u8-ref actual 0))

+40

(assert-equal 5 (bytevector-u8-ref actual 4)))

+41

(assert-equal 0 (file-transfer-count m))))

+42

+43

(test "cancel and connection close preserve destination and remove state"

+44

(let* ((m (make-file-transfer-manager))

+45

(a (path-join ROOT "cancel-a.bin"))

+46

(b (path-join ROOT "cancel-b.bin")))

+47

(write-file-string a "before-a")

+48

(write-file-string b "before-b")

+49

(assert-equal 'ready

+50

(dict-ref (file-upload-open! m GRANTS 2 a 3) status: #f))

+51

(assert-equal 'ready

+52

(dict-ref (file-upload-open! m GRANTS 3 b 3) status: #f))

+53

(assert-equal 2 (file-transfer-count m))

+54

(file-upload-batch! m

+55

(decode-stream-frame (encode-transfer-batch 2 0 (bytevector 1))))

+56

(assert-equal 'cancelled

+57

(dict-ref (file-transfer-cancel! m 2 'user) status: #f))

+58

(assert-equal 1 (file-transfer-count m))

+59

(assert-equal 1 (file-transfer-close-all! m 'connection-lost))

+60

(assert-equal "before-a" (read-file-string a))

+61

(assert-equal "before-b" (read-file-string b))

+62

(assert-equal 0 (file-transfer-count m))))

+63

+64

(test "download obeys credit and emits an exact end"

+65

(let* ((m (make-file-transfer-manager))

+66

(path (path-join ROOT "download.bin"))

+67

(body (make-bytevector (+ transfer-chunk-bytes 7) 42)))

+68

(write-file-bytes path body)

+69

(assert-equal 'ready

+70

(dict-ref (file-download-open! m GRANTS 4 path) status: #f))

+71

(let ((first (file-download-credit! m

+72

(decode-stream-frame

+73

(encode-transfer-credit 4 transfer-chunk-bytes)))))

+74

(assert-equal 'active (dict-ref first status: #f))

+75

(assert-equal transfer-chunk-bytes (dict-ref first progress: #f))

+76

(assert-equal transfer-chunk-bytes

+77

(bytevector-length (frame-list-bytes (dict-ref first frames: '())))))

+78

(let ((last (file-download-credit! m

+79

(decode-stream-frame (encode-transfer-credit 4 7)))))

+80

(assert-equal 'complete (dict-ref last status: #f))

+81

(assert-equal 2 (length (dict-ref last frames: '())))

+82

(assert-equal 7

+83

(bytevector-length (frame-list-bytes (dict-ref last frames: '())))))

+84

(assert-equal 0 (file-transfer-count m))))

+85

+86

(test "grant denial opens no transfer"

+87

(let ((m (make-file-transfer-manager))

+88

(none (make-grants principal: "web:none")))

+89

(assert-equal 'refused

+90

(dict-ref (file-upload-open! m none 5

+91

(path-join ROOT "denied.bin") 1) status: #f))

+92

(assert-equal 0 (file-transfer-count m))))

+93

)

packages/slate-cli/test/test-transfer.sgladded

@@ -0,0 +1,86 @@

+1

(import (sigil test) (sigil core)

+2

(slate-cli resource transfer) (slate-cli wire))

+3

+4

(test-group "multi-frame transfer state"

+5

(test "ordered batches spend credit and complete at the exact boundary"

+6

(let ((r (make-transfer-registry)))

+7

(transfer-open! r 7 'receive 5)

+8

(assert-equal 5 (dict-ref (transfer-grant! r 7 5) credit: #f))

+9

(assert-equal 'accepted

+10

(dict-ref (transfer-batch! r 7 0 (bytevector 1 2 3)) status: #f))

+11

(assert-equal 2 (dict-ref (transfer-ref r 7) credit: #f))

+12

(assert-equal 'accepted

+13

(dict-ref (transfer-batch! r 7 1 (bytevector 4 5)) status: #f))

+14

(assert-equal 'complete

+15

(dict-ref (transfer-end! r 7 2 5) status: #f))))

+16

+17

(test "out-of-order, over-credit, and size overruns fail closed"

+18

(let ((r (make-transfer-registry)))

+19

(transfer-open! r 8 'receive 3)

+20

(transfer-grant! r 8 2)

+21

(assert-equal 'out-of-order

+22

(dict-ref (transfer-batch! r 8 1 (bytevector 1)) reason: #f))

+23

(assert-equal 'credit-exhausted

+24

(dict-ref (transfer-batch! r 8 0 (bytevector 1 2 3)) reason: #f))

+25

(transfer-grant! r 8 2)

+26

(assert-equal 'size-overrun

+27

(dict-ref (transfer-batch! r 8 0 (bytevector 1 2 3 4)) reason: #f))

+28

;; Refusals do not advance or spend the transfer.

+29

(assert-equal 0 (dict-ref (transfer-ref r 8) next-seq: #f))

+30

(assert-equal 4 (dict-ref (transfer-ref r 8) credit: #f))))

+31

+32

(test "end detects truncation and cancellation releases the id"

+33

(let ((r (make-transfer-registry)))

+34

(transfer-open! r 9 'receive 4 #{ temporary: "x.tmp" })

+35

(transfer-grant! r 9 4)

+36

(transfer-batch! r 9 0 (bytevector 1 2))

+37

(assert-equal 'size-mismatch

+38

(dict-ref (transfer-end! r 9 1 2) reason: #f))

+39

(let ((cancelled (transfer-cancel! r 9 'connection-lost)))

+40

(assert-equal 'cancelled (dict-ref cancelled status: #f))

+41

(assert-equal "x.tmp"

+42

(dict-ref (dict-ref (dict-ref cancelled entry: #{}) metadata: #{})

+43

temporary: #f)))

+44

(assert-equal 0 (transfer-count r))

+45

(assert-false (transfer-ref r 9))))

+46

+47

(test "ids cannot be replayed while active and credits cannot wrap"

+48

(let ((r (make-transfer-registry)))

+49

(transfer-open! r 10 'send #f)

+50

(assert-equal 'duplicate-id

+51

(dict-ref (transfer-open! r 10 'receive #f) reason: #f))

+52

(transfer-grant! r 10 4294967295)

+53

(assert-equal 'credit-overflow

+54

(dict-ref (transfer-grant! r 10 1) reason: #f))))

+55

+56

(test "transfer frame codecs preserve sequence, totals, and raw bytes"

+57

(let* ((batch-frame (decode-stream-frame

+58

(encode-transfer-batch 11 3 (bytevector 0 255 7))))

+59

(batch (decode-transfer-batch batch-frame))

+60

(end (decode-transfer-end

+61

(decode-stream-frame (encode-transfer-end 11 4 70000))))

+62

(credit (decode-transfer-credit

+63

(decode-stream-frame

+64

(encode-transfer-credit 11 transfer-initial-credit)))))

+65

(assert-equal 11 (dict-ref batch id: #f))

+66

(assert-equal 3 (dict-ref batch seq: #f))

+67

(assert-equal (bytevector 0 255 7) (dict-ref batch bytes: #f))

+68

(assert-equal 4 (dict-ref end next-seq: #f))

+69

(assert-equal 70000 (dict-ref end total: #f))

+70

(assert-equal transfer-initial-credit (dict-ref credit amount: #f))))

+71

+72

(test "malformed transfer payloads are refused by the codec"

+73

(assert-false

+74

(decode-transfer-batch

+75

(decode-stream-frame

+76

(encode-stream-frame frame-batch 1 (bytevector 0 0 0)))))

+77

(assert-false

+78

(decode-transfer-end

+79

(decode-stream-frame

+80

(encode-stream-frame frame-end 1 (make-bytevector 7 0)))))

+81

(assert-false

+82

(decode-transfer-credit

+83

(decode-stream-frame

+84

(encode-stream-frame frame-transfer-credit 1

+85

(make-bytevector 4 0))))))

+86

)

packages/slate-netem/package.sglmodified

@@ -24,7 +24,7 @@

24

(package

25

name: "slate-netem"

26

;; version inherited from the workspace (../../package.sgl)

−27

sigil: "0.20.1"

+27

sigil: "0.20.3"

28

description: "Slate connectivity emulator — reproducible degraded/broken links"

29

url: "https://codeberg.org/sigil/slate"

30

license: "BSD-3-Clause"

@@ -34,9 +34,10 @@

34

bundle-name: "slate-netem"

35

36

dependencies: (list

−37

(from-git url: "codeberg:sigil/sigil" package: "sigil-stdlib" version: "^0.20")

−38

)

+37

;; Keep independent read/write waiters on the same socket until the next Sigil release.

+38

(from-git url: "codeberg:sigil/sigil" package: "sigil-stdlib"

+39

commit: "9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95"))

40

41

dev-dependencies: (list

−41

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: "^0.20")

−42

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: "^0.20")))

+42

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: ">=0.20")

+43

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: ">=0.20")))

packages/slate-netem/scenarios/node-direct-loss.scnadded

@@ -0,0 +1,23 @@

+1

;;; Direct carrier cut while the independent Enclave relay stays healthy.

+2

(scenario

+3

name: "node-direct-loss"

+4

summary: "12s direct setup, 8s hard direct-only cut, 8s recovered"

+5

+6

timeline: (list

+7

(phase name: "direct-up" ms: 12000 link: (up))

+8

(phase name: "direct-cut" ms: 8000 link: (cut))

+9

(phase name: "recovered" ms: 8000 link: (up)))

+10

+11

controls: (list

+12

(control name: "the real direct WebSocket crossed the proxy"

+13

role: liveness

+14

check: (forwarded-bytes phase: "direct-up" at-least: 1))

+15

(control name: "the direct carrier was actually cut"

+16

role: fault

+17

check: (closes phase: "direct-cut" by: emulator at-least: 1))

+18

(control name: "a bounded direct retry reached the cut"

+19

role: fault

+20

check: (refusals phase: "direct-cut" at-least: 1))

+21

(control name: "the proxy stopped refusing after recovery"

+22

role: fault

+23

check: (refusals phase: "recovered" at-most: 0))))

packages/slate-netem/scenarios/node-transfer-loss.scnadded

@@ -0,0 +1,20 @@

+1

;;; A deliberately slow direct carrier followed by a hard cut. A 5 MiB

+2

;;; transfer cannot finish inside the throttled phase, so the fault lands after

+3

;;; negotiation and multiple frames rather than racing setup or completion.

+4

(scenario

+5

name: "node-transfer-loss"

+6

summary: "20s throttled carrier transfer, 6s hard cut, 10s recovery"

+7

+8

timeline: (list

+9

(phase name: "transfer" ms: 20000 link: (up)

+10

bandwidth: (up-bps 262144 down-bps 262144))

+11

(phase name: "cut" ms: 6000 link: (cut))

+12

(phase name: "recovered" ms: 10000 link: (up)))

+13

+14

controls: (list

+15

(control name: "multiple transfer windows crossed the carrier proxy"

+16

role: liveness

+17

check: (forwarded-bytes phase: "transfer" at-least: 524288))

+18

(control name: "the active transfer carrier was cut"

+19

role: fault

+20

check: (closes phase: "cut" by: emulator at-least: 1))))

packages/slate-netem/sigil.lockmodified

@@ -2,42 +2,27 @@

2

(lock

3

(package name: "sigil-stdlib"

4

url: "codeberg:sigil/sigil"

−5

ref: "^0.18"

−6

sha: "a256db1dac67574c9c9f82a4c758a51b2c378705"

+5

ref: "^0.20.3"

+6

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

7

package-selector: "sigil-stdlib"

−8

version: "0.18.5")

−9

(package name: "sigil-socket"

−10

url: "codeberg:sigil/sigil-socket"

−11

ref: "^0.16.0"

−12

sha: "6b9e36eb4d4a944b463e5f6826bd711186ba6710"

−13

version: "0.16.0")

+8

version: "0.20.3")

9

(package name: "sigil-test"

10

url: "codeberg:sigil/sigil"

−16

ref: "^0.18"

−17

sha: "a256db1dac67574c9c9f82a4c758a51b2c378705"

+11

ref: "^0.20.3"

+12

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

13

package-selector: "sigil-test"

−19

version: "0.18.5")

+14

version: "0.20.3")

15

(package name: "sigil-test-runner"

16

url: "codeberg:sigil/sigil"

−22

ref: "^0.18"

−23

sha: "a256db1dac67574c9c9f82a4c758a51b2c378705"

+17

ref: "^0.20.3"

+18

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

19

package-selector: "sigil-test-runner"

−25

version: "0.18.5")

−26

(package name: "sigil-ansi"

−27

url: "codeberg:sigil/sigil-ansi"

−28

ref: "^0.16.0"

−29

sha: "1e14b6f9d034ca8ef9f404e2ded316d0780ad7cf"

−30

version: "0.16.0")

+20

version: "0.20.3")

21

(package name: "sigil-json"

22

url: "codeberg:sigil/sigil-json"

23

ref: "^0.16.0"

24

sha: "55c9e74712b5f79b45d41c65cfe0aef2c8f7e155"

25

version: "0.16.0")

−36

(package name: "sigil-version"

−37

url: "codeberg:sigil/sigil-version"

−38

ref: "^0.16.0"

−39

sha: "2d2c9ef9c2694466f65abc14cddf9bfb9cada4a4"

−40

version: "0.16.0")

26

(package name: "sigil-crypto"

27

url: "codeberg:sigil/sigil-crypto"

28

ref: "^0.16.0"

@@ -48,15 +33,10 @@

33

ref: "^0.16.0"

34

sha: "3d441fb32a216aaf99d0e2732bef5877e91d5d48"

35

version: "0.16.2")

−51

(package name: "sigil-git"

−52

url: "codeberg:sigil/sigil-git"

−53

ref: "^0.16.0"

−54

sha: "2d54eb99d3ca0597b3ccd9d4829d312c54721086"

−55

version: "0.16.1")

36

(package name: "sigil-lib"

37

url: "codeberg:sigil/sigil"

38

ref: "^0.17"

−59

sha: "a256db1dac67574c9c9f82a4c758a51b2c378705"

+39

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

40

package-selector: "sigil-lib"

−61

version: "0.18.5")

+41

version: "0.20.3")

42

)

packages/slate-netem/slate-netem.sgladded

@@ -0,0 +1,5 @@

+1

;;; Source launcher for the connectivity emulator. Keeping this two-line path

+2

;;; available also lets integration gates run the exact compiled netem modules

+3

;;; when a workspace bundler has selected another member's default entry point.

+4

(import (slate-netem main))

+5

(main)

packages/slate-netem/src/slate-netem/main.sglmodified

@@ -304,10 +304,19 @@

304

;; A setup error exits 3, distinct from every verdict, so a gate

305

;; can never read "the emulator would not start" as "the fault did

306

;; not fire".

−307

(let ((code (guard (e (#t

+307

(let* ((raw-args (cdr (command-line)))

+308

;; Running this library from its tiny source launcher leaves the

+309

;; launcher pathname in command-line. This path is also useful as

+310

;; a faithful fallback when a workspace bundler selects the wrong

+311

;; default entry point.

+312

(args (if (and (pair? raw-args)

+313

(string-contains? (car raw-args) ".sgl"))

+314

(cdr raw-args)

+315

raw-args))

+316

(code (guard (e (#t

317

(display "slate-netem: ")

318

(display (if (error-object? e) (error-object-message e) e))

319

(newline)

320

3))

−312

(dispatch (cdr (command-line))))))

+321

(dispatch args))))

322

(exit code)))))

packages/slate-shell/package.sglmodified

@@ -11,7 +11,7 @@

11

name: "slate-shell"

12

;; version inherited from the workspace (../../package.sgl) — member packages

13

;; do not declare their own version.

−14

sigil: "0.20.1"

+14

sigil: "0.20.3"

15

description: "Slate — a programmable, extensible editor — as a native desktop app"

16

url: "https://codeberg.org/sigil/slate"

17

license: "BSD-3-Clause"

@@ -99,16 +99,17 @@

99

(error "slate-shell before-build: stage-assets.sh failed (exit)" stage-status)))))))

100

101

dependencies: (list

−102

;; Lantern 0.1.4 still imports the removed (sigil env) compatibility

−103

;; library. Pin the Sigil 0.18 fix until the next Lantern release.

+102

;; Lantern 0.1.4 contains the Sigil compatibility fix previously consumed

+103

;; by raw commit. Keep the released range explicit so release builds never

+104

;; depend on an unpublished revision.

105

(from-git url: "codeberg:sigil/lantern" package: "lantern"

−105

commit: "16cf13897cb48e4cc1eb4065a9969dfbf23d73f6")

+106

version: "^0.1.4")

107

(from-git url: "codeberg:sigil/lantern" package: "lantern-system"

−107

commit: "16cf13897cb48e4cc1eb4065a9969dfbf23d73f6"))

+108

version: "^0.1.4"))

109

110

;; sigil-test + sigil-test-runner build the harness for test/run-checks.sgl

111

;; (the slate-client protocol / session / server unit checks). slate-shell has

112

;; native deps (lantern), so the harness needs these explicitly declared.

113

dev-dependencies: (list

−113

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: "^0.20")

−114

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: "^0.20")))

+114

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: ">=0.20")

+115

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: ">=0.20")))

packages/slate/assets/folder-browser.mjsadded

@@ -0,0 +1,68 @@

+1

// The folder renderer owns row content and the bounded listing window. This

+2

// controller owns point markers, so n/p can move them without reconciling every

+3

// row or running the editor/terminal post-render passes.

+4

export function createFolderBrowser({ evaluate, flushPreview }) {

+5

let timer = null;

+6

let scheduledToken = '';

+7

const rendered = new WeakMap();

+8

+9

function schedule() {

+10

const token = evaluate('(slate-folder-preview-token)') || '';

+11

if (token === scheduledToken) return;

+12

if (timer !== null) clearTimeout(timer);

+13

timer = null;

+14

scheduledToken = token;

+15

if (!token) return;

+16

timer = setTimeout(() => {

+17

timer = null;

+18

scheduledToken = '';

+19

// Tokens are decimal generation numbers, minted by the model. The model

+20

// also validates the token before starting a request.

+21

if (/^\d+$/.test(token)) flushPreview(token);

+22

}, 500);

+23

}

+24

+25

function point(view, index) {

+26

const selected = view.querySelector('.folder-row.selected');

+27

const next = view.querySelector(`.folder-row[data-slate-click="folder-select-index:${index}"]`);

+28

if (selected !== next) {

+29

if (selected) {

+30

selected.classList.remove('selected');

+31

selected.setAttribute('aria-selected', 'false');

+32

}

+33

if (next) {

+34

next.classList.add('selected');

+35

next.setAttribute('aria-selected', 'true');

+36

next.scrollIntoView({ block: 'nearest' });

+37

}

+38

}

+39

}

+40

+41

function motion() {

+42

const raw = evaluate('(slate-folder-take-motion)');

+43

if (!raw) return false;

+44

const update = JSON.parse(raw);

+45

for (const view of document.querySelectorAll('.view.folder')) {

+46

if (view.dataset.folderView !== update.name) continue;

+47

point(view, update.point);

+48

view.querySelector('.folder-preview')?.classList.toggle('pending', update.pending);

+49

}

+50

schedule();

+51

return true;

+52

}

+53

+54

function ensure() {

+55

for (const view of document.querySelectorAll('.view.folder')) {

+56

if (rendered.get(view) !== view.dataset.folderRender) {

+57

point(view, Number(view.dataset.folderPoint));

+58

// A full render supplies the current header and waiting/loading/content

+59

// text. Only motion between renders needs to mask obsolete contents.

+60

view.querySelector('.folder-preview')?.classList.remove('pending');

+61

rendered.set(view, view.dataset.folderRender);

+62

}

+63

}

+64

schedule();

+65

}

+66

+67

return { motion, ensure };

+68

}

packages/slate/assets/index.htmlmodified

@@ -16,6 +16,7 @@

16

<link rel="icon" href="icons/icon-192.png" sizes="192x192" type="image/png">

17

<link rel="apple-touch-icon" href="icons/icon-192.png">

18

<script>

+19

const SLATE_WEB_CLIENT_VERSION = '2026-09-08-git-terminal-merge-1';

20

// The node: pairing return page. When the daemon's approval page 303-

21

// redirects the pairing popup to <origin>/pair-return#familiar_code=…&state=…,

22

// this popup lands HERE. Handle it BEFORE booting the heavy wasm app: parse

@@ -45,8 +46,64 @@

46

// progressive-enhancement spirit as the LANTERN-BRIDGE feature-detect below.

47

if ('serviceWorker' in navigator && location.protocol.startsWith('http')) {

48

window.addEventListener('load', function () {

−48

navigator.serviceWorker.register('sw.js').catch(function (e) {

−49

console.warn('[slate] service worker registration failed:', e);

+49

function announceWaitingClient(worker) {

+50

if (!worker || worker.state === 'redundant') return;

+51

fetch('sw.js', { cache: 'no-store' })

+52

.then(function (response) { return response.text(); })

+53

.then(function (source) {

+54

var match = source.match(/const VERSION = '([^']+)'/);

+55

window.__slateWaitingClientVersion = match ? match[1] : 'available';

+56

if (window.__slateAnnounceClientUpdate) window.__slateAnnounceClientUpdate();

+57

}).catch(function () {

+58

window.__slateWaitingClientVersion = 'available';

+59

if (window.__slateAnnounceClientUpdate) window.__slateAnnounceClientUpdate();

+60

});

+61

}

+62

+63

function watchClientUpdate(registration) {

+64

if (registration.waiting) announceWaitingClient(registration.waiting);

+65

registration.addEventListener('updatefound', function () {

+66

var installing = registration.installing;

+67

if (!installing) return;

+68

installing.addEventListener('statechange', function () {

+69

// An active registration also proves this is a replacement. The

+70

// page can temporarily be uncontrolled after bootstrapping the

+71

// manual-update policy, and must still report the waiting update.

+72

if (installing.state === 'installed' &&

+73

(navigator.serviceWorker.controller || registration.active)) {

+74

announceWaitingClient(installing);

+75

}

+76

});

+77

});

+78

}

+79

+80

// Never let the browser's HTTP cache satisfy an update check for sw.js.

+81

// Slate's assets are versioned by the worker, so accepting a stale worker

+82

// here strands the whole application on the old asset cache.

+83

navigator.serviceWorker.register('sw.js', { updateViaCache: 'none' })

+84

.then(function (registration) {

+85

watchClientUpdate(registration);

+86

// Chrome may otherwise throttle its automatic worker checks. Check on

+87

// every boot and whenever an installed PWA returns to the foreground.

+88

registration.update().catch(function () {});

+89

document.addEventListener('visibilitychange', function () {

+90

if (document.visibilityState === 'visible') {

+91

registration.update().catch(function () {});

+92

}

+93

});

+94

}).catch(function (e) {

+95

console.warn('[slate] service worker registration failed:', e);

+96

});

+97

+98

// A controller change is acted upon only when the user invoked the

+99

// update command. Background registration/update checks may download a

+100

// worker, but must never replace or reload the running UI on their own.

+101

var reloadingForWorkerUpdate = false;

+102

navigator.serviceWorker.addEventListener('controllerchange', function () {

+103

if (!window.__slateClientUpdateReloadArmed) return;

+104

if (reloadingForWorkerUpdate) return;

+105

reloadingForWorkerUpdate = true;

+106

window.location.reload();

107

});

108

});

109

}

@@ -325,33 +382,92 @@

382

}

383

384

/* ---- Folder view: a minimal, Emacs-dired-like list. No chrome. ---- */

−328

.view.folder { font-family: var(--font-code); font-size: var(--text-code); }

−329

/* A long filename must never scroll the buffer sideways, so the name

−330

MIDDLE-truncates and keeps its extension: really-long-name….scm. The

−331

extension is what tells you the kind of thing in a file list, so an

−332

end-ellipsis (which eats it) is the wrong trade.

−333

CSS cannot middle-truncate one string — but it doesn't need to, because the

−334

name is rendered as STEM + EXT: the stem is the flex item that shrinks and

−335

ellipsises, the ext never shrinks, so the ellipsis lands between them at any

−336

pane width. No character budget, so it stays right on a phone too. */

−337

.folder-row { display: flex; align-items: baseline; white-space: pre; cursor: default;

−338

overflow: hidden; }

−339

.folder-row.selected { background: color-mix(in srgb, var(--accent) 16%, transparent); }

−340

.folder-mark { color: transparent; flex: none; width: 2ch; font-weight: 700; }

−341

.folder-row.marked .folder-mark { color: var(--accent); }

−342

.folder-row.marked:not(.selected) {

−343

background: color-mix(in srgb, var(--accent) 7%, transparent);

−344

}

−345

/* min-width:0 is what lets a flex item shrink below its content width — without

−346

it the stem refuses to ellipsis and the row overflows anyway. */

−347

.folder-name { color: var(--fg-1); display: flex; min-width: 0; }

−348

.folder-stem { overflow: hidden; text-overflow: ellipsis; white-space: pre; min-width: 0; }

−349

.folder-ext { flex: none; white-space: pre; }

−350

.folder-row.is-dir .folder-name { color: var(--fg-0); font-weight: 600; }

−351

/* flex:none so the size column keeps its width and the NAME gives way instead. */

−352

.folder-size { color: var(--fg-2); margin-left: auto; padding-left: var(--sp-3);

−353

flex: none; }

−354

.folder-more { color: var(--fg-2); font-style: italic; }

+385

/* Folder buffers share the Git views' compact rows and focus language. */

+386

.view.folder { container:folder / inline-size; display:flex; flex-direction:column;

+387

min-width:0; min-height:0; padding:0; overflow:hidden; font-family:var(--font-code);

+388

font-size:var(--text-code); }

+389

.folder-header { flex:none; display:flex; align-items:center; gap:10px; min-height:44px;

+390

padding:0 12px; border-bottom:1px solid var(--edge-1); background:var(--bg-1); }

+391

.folder-header button, .folder-preview-label button { background:transparent; border:0;

+392

color:var(--fg-1); font:inherit; min-width:30px; min-height:34px; cursor:pointer; }

+393

.folder-parent { font-size:20px!important; }

+394

.folder-path { flex:1; display:flex; min-width:0; overflow:hidden; white-space:nowrap; }

+395

.folder-ancestry { overflow:hidden; text-overflow:ellipsis; color:var(--fg-1); }

+396

.folder-path strong { flex:none; max-width:100%; overflow:hidden; text-overflow:ellipsis; font-weight:600; }

+397

    .folder-host { color:var(--fg-2); font-size:.8em; max-width:30%; overflow:hidden; text-overflow:ellipsis; white-space:nowrap; }

+398

.folder-workbench { flex:1; min-height:0; display:grid; grid-template-columns:minmax(0,1fr); }

+399

.folder.with-preview .folder-workbench { grid-template-columns:minmax(0, 65%) minmax(0,35%); }

+400

.folder-directory { display:flex; flex-direction:column; min-width:0; min-height:0; }

+401

.folder-listing { flex:1; min-height:0; overflow:auto; }

+402

.folder-columns, .folder-row { display:grid; grid-template-columns:28px minmax(0,1fr) 8ch 12ch;

+403

align-items:center; column-gap:8px; padding:0 14px 0 0; }

+404

.folder.with-git .folder-columns, .folder.with-git .folder-row {

+405

grid-template-columns:28px minmax(0,1fr) 3ch 8ch 12ch; }

+406

.folder-columns { flex:none; min-height:30px; border-bottom:1px solid var(--edge-0);

+407

color:var(--fg-2); font-size:.75em; }

+408

.folder-columns>span:nth-last-child(-n+2) { text-align:right; }

+409

.folder-row { min-height:34px; border-left:3px solid transparent; cursor:default; }

+410

.folder-row:hover { background:var(--bg-1); }

+411

    .folder-row.selected { background:color-mix(in srgb,var(--accent) 22%,var(--bg-1)); border-left-color:var(--accent); }

+412

.folder-row.marked:not(.selected) { background:color-mix(in srgb,var(--accent) 7%,transparent); }

+413

.folder-row button { border:0; border-radius:0; background:transparent; font:inherit; cursor:pointer; padding:0; }

+414

.folder-mark { color:var(--accent); min-height:30px; width:25px; font-size:.8em!important; }

+415

.folder-name { color:var(--fg-0); display:flex; min-width:0; align-items:center; text-align:left; min-height:30px; }

+416

.folder-stem { overflow:hidden; text-overflow:ellipsis; white-space:pre; min-width:0; }

+417

.folder-ext { flex:none; white-space:pre; color:var(--fg-1); }

+418

.folder-row.is-dir .folder-name { font-weight:600; }

+419

.folder-row.is-dir .folder-ext { color:var(--accent); }

+420

.folder-size, .folder-modified { color:var(--fg-2); text-align:right; font-size:.8em; white-space:nowrap; }

+421

.folder-git { display:none; text-align:center; font-size:.8em; }

+422

.folder.with-git .folder-git { display:block; }

+423

.folder-git.modified { color:var(--accent); }

+424

.folder-git.added, .folder-git.untracked { color:var(--ok); }

+425

.folder-git.conflict { color:var(--err); }

+426

.folder-more { display:block; width:100%; min-height:36px; padding:8px 14px; border:0;

+427

background:var(--bg-1); color:var(--accent); text-align:left; font:inherit; font-size:.85em; cursor:pointer; }

+428

.folder-more:hover { background:var(--bg-2); }

+429

.folder-preview { display:flex; flex-direction:column; min-width:0; min-height:0;

+430

overflow:hidden; border-left:1px solid var(--edge-1); background:var(--bg-1); }

+431

.folder-preview-label { flex:none; min-height:30px; display:flex; justify-content:space-between;

+432

align-items:center; padding:0 14px; border-bottom:1px solid var(--edge-0);

+433

color:var(--fg-2); font-size:.75em; text-transform:uppercase; letter-spacing:.1em; }

+434

.folder-preview-header { flex:none; padding:18px; }

+435

.folder-preview-name { border:0; background:transparent; padding:0; text-align:left;

+436

color:var(--fg-0); font:600 1.1em var(--font-code); overflow-wrap:anywhere; cursor:pointer; }

+437

.folder-preview-header dl { display:grid; grid-template-columns:9ch minmax(0,1fr);

+438

gap:6px; margin:15px 0 0; font-size:.8em; color:var(--fg-1); }

+439

.folder-preview-header dt { color:var(--fg-2); }

+440

.folder-preview-header dd { margin:0; overflow-wrap:anywhere; }

+441

.folder-preview-content { flex:1; min-height:0; overflow:auto; margin:0; padding:16px 18px;

+442

border-top:1px solid var(--edge-0); background:var(--bg-0); color:var(--fg-1);

+443

font:.85em/1.7 var(--font-code); tab-size:2; white-space:pre; }

+444

.folder-preview-image { display:flex; align-items:center; justify-content:center; padding:12px; }

+445

.folder-preview-image img { display:block; max-width:100%; max-height:100%; object-fit:contain; }

+446

.folder-preview.pending .folder-preview-header,

+447

.folder-preview.pending .folder-preview-content { visibility:hidden; pointer-events:none; }

+448

.folder-preview.pending { position:relative; }

+449

.folder-preview.pending::after { content:"Waiting…"; position:absolute; top:54px; left:18px;

+450

color:var(--fg-2); font-size:.85em; }

+451

.folder button:focus-visible { outline:2px solid var(--accent); outline-offset:-2px; }

+452

.folder.compact .folder-row { min-height:26px; }

+453

.folder.compact .folder-row button { min-height:24px; }

+454

@container folder (max-width: 760px) {

+455

.folder-columns, .folder-row { grid-template-columns:28px minmax(0,1fr) 7ch; }

+456

      .folder.with-git .folder-columns, .folder.with-git .folder-row { grid-template-columns:28px minmax(0,1fr) 3ch 7ch; }

+457

.folder-modified { display:none; }

+458

}

+459

@container folder (max-width: 600px) {

+460

      .folder.with-preview .folder-workbench { grid-template-columns:minmax(0,1fr); grid-template-rows:minmax(0,1fr) minmax(0,1fr); }

+461

.folder-preview { border-left:0; border-top:1px solid var(--edge-1); }

+462

.folder-preview-header { padding:10px 14px; }

+463

.folder-preview-header dl { margin-top:8px; }

+464

.folder-header { padding:0 8px; gap:6px; }

+465

}

+466

@media (pointer:coarse) {

+467

.folder .folder-row, .folder.compact .folder-row { min-height:44px; }

+468

.folder .folder-row button, .folder.compact .folder-row button { min-height:42px; }

+469

.folder-more, .folder-header button { min-height:44px; }

+470

}

471

/* An empty view centers its hint (see .empty-hint below) rather than pinning

472

"(empty)" to the top-left, so a blank folder/buffer reads as intentional. */

473

.view:has(> .empty-hint) { display: flex; align-items: center; justify-content: center; }

@@ -402,8 +518,16 @@

518

block height: without it the inline line box was taller than the row, and

519

overflow:hidden clipped the top ~1px of an unfocused pane's box cursor

520

(its inset 1px border). Now the cursor cell fills the row exactly. */

−405

    .term-content .tr { white-space: pre; height: var(--cell-h, 1.3em); line-height: var(--cell-h, 1.3em); overflow: hidden; }

+521

    .term-content .tr { position: relative; white-space: pre; height: var(--cell-h, 1.3em); line-height: var(--cell-h, 1.3em); overflow: hidden; }

522

.term-content .tr br { line-height: inherit; }

+523

/* R4 prediction is deliberately a disposable overlay inside a row, never

+524

emulator state. Once an unconfirmed claim ages past 250ms it becomes

+525

visibly provisional; reconciliation can remove this node wholesale. */

+526

.term-prediction { position: absolute; top: 0; white-space: pre; pointer-events: none; }

+527

.term-prediction.stale { opacity: 0.58; text-decoration: underline; }

+528

.tr:has(.term-prediction) .term-cursor { visibility: hidden; }

+529

.term-prediction::after { content: '\00a0'; display: inline-block;

+530

width: var(--cell-w, 8px); box-shadow: inset 0 -2px currentColor; }

531

/* One cell, enforced. HTML text layout lets a glyph's natural advance win,

532

so any char the primary font lacks falls back to a font with a different

533

advance and the row drifts (a 40-`♦` row ran 1.5x long; the Claude Code

@@ -1051,6 +1175,74 @@

1175

-webkit-tap-highlight-color: transparent; touch-action: manipulation;

1176

}

1177

.acc-btn:active { background: var(--bg-3); transform: translateY(1px); }

+1178

/* Global literal key deck. It follows the Ledge in the frame, so the

+1179

two rows sit below app chrome and immediately above the system keyboard. */

+1180

.accessory-key-deck { display: none; flex: 0 0 auto; background: var(--key-deck-bg); touch-action: pan-y; }

+1181

@media (max-width: 767px) {

+1182

.accessory-key-deck {

+1183

display: flex; flex-direction: column; gap: 0;

+1184

padding: 0 0 env(safe-area-inset-bottom);

+1185

border-top: 1px solid var(--edge-0);

+1186

}

+1187

}

+1188

.terminal-key-row { display: grid; grid-template-columns: repeat(7, minmax(0, 1fr)); gap: 0; }

+1189

.terminal-key-page, .terminal-compose-page { display: flex; min-width: 0; height: 64px; position: relative; }

+1190

.terminal-key-rows { flex: 1; min-width: 0; }

+1191

.terminal-key-page[hidden], .terminal-compose-page[hidden] { display: none; }

+1192

.terminal-compose-back, .terminal-compose-send {

+1193

flex: 0 0 auto; min-width: 36px; padding: 0 8px; border: 1px solid var(--edge-0);

+1194

border-radius: 0; background: var(--key-deck-bg); color: var(--fg-0);

+1195

font: 600 var(--text-xs)/1 var(--font-code); touch-action: pan-y;

+1196

}

+1197

.terminal-compose-input {

+1198

flex: 1; min-width: 0; height: 56px; margin: 4px; padding: 6px 8px;

+1199

resize: none; box-sizing: border-box; border: 1px solid var(--edge-0); border-radius: 4px;

+1200

background: var(--bg-1); color: var(--fg-0); font: 16px/1.35 var(--font-code);

+1201

touch-action: auto;

+1202

}

+1203

.terminal-compose-input:focus { outline: 1px solid var(--accent); }

+1204

.terminal-compose-status:not(:empty) {

+1205

position: absolute; bottom: 100%; left: 0; right: 0; padding: 8px;

+1206

background: var(--bg-1); color: var(--fg-0); font-size: var(--text-sm);

+1207

border: 1px solid var(--edge-0);

+1208

}

+1209

.terminal-compose-send.history { font-size: 24px; }

+1210

.terminal-compose-send:disabled { opacity: .4; }

+1211

.terminal-compose-history { position: absolute; z-index: 15; bottom: 100%; left: 0; right: 0;

+1212

max-height: min(40vh, 280px); overflow-y: auto; padding: 6px; background: var(--bg-1);

+1213

border: 1px solid var(--edge-0); box-shadow: 0 -3px 12px #0002; }

+1214

.terminal-compose-history[hidden] { display: none; }

+1215

.terminal-history-title { padding: 6px; color: var(--fg-1); font-size: var(--text-xs); }

+1216

.terminal-compose-history button { display: block; width: 100%; padding: 10px; text-align: left;

+1217

white-space: pre-wrap; overflow-wrap: anywhere; background: var(--bg-1); color: var(--fg-0);

+1218

border: 0; border-top: 1px solid var(--edge-0); font: 14px/1.4 var(--font-code); }

+1219

.terminal-copy-tools { flex-wrap: wrap; }

+1220

.terminal-copy-tools [hidden], .terminal-copy-header-tools [hidden], .terminal-copy-label[hidden] { display: none; }

+1221

.terminal-copy-tools button:disabled, .terminal-copy-header-tools button:disabled { opacity: .4; }

+1222

    .terminal-copy-tools [aria-pressed="true"], .terminal-copy-header-tools [aria-pressed="true"] { color: var(--accent); border-color: var(--accent); }

+1223

.terminal-copy-label { color: var(--accent); font-size: var(--text-xs); white-space: nowrap; }

+1224

.acc-host-status:empty { display: none; }

+1225

.acc-cats .terminal-copy-status { display: none; }

+1226

.terminal-copy-status:not(:empty) { flex-basis: 100%; font-size: var(--text-xs); color: var(--fg-1); }

+1227

.terminal-copy-header-tools { display: inline-flex; gap: 4px; align-items: center; }

+1228

    .terminal-copy-header-tools button { padding: 0 4px; font: inherit; color: var(--fg-0); background: var(--bg-1); border: 1px solid var(--edge-0); }

+1229

    .terminal-copy-header-tools .terminal-copy-status { max-width: 240px; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }

+1230

    .acc-chip.copy-received::after { content: ''; width: 6px; height: 6px; border-radius: 50%; background: var(--accent); }

+1231

@media (max-width: 767px) { .terminal-copy-header-tools { display: none; } }

+1232

.term-content.terminal-copy-active { user-select: none; -webkit-user-select: none; touch-action: none; }

+1233

    .terminal-copy-region { position: absolute; top: 0; bottom: 0; background: var(--accent); opacity: .28; pointer-events: none; }

+1234

    .terminal-copy-point { position: absolute; top: 0; bottom: 0; border-left: 2px solid var(--accent); pointer-events: none; }

+1235

.term-key {

+1236

min-width: 0; height: 32px; display: flex; align-items: center; justify-content: center;

+1237

background: var(--key-deck-bg); color: var(--fg-0); border: 1px solid var(--edge-0);

+1238

border-radius: 0; font: 600 var(--text-xs)/1 var(--font-code);

+1239

user-select: none; -webkit-user-select: none; touch-action: pan-y;

+1240

-webkit-tap-highlight-color: transparent;

+1241

}

+1242

.term-key:active { background: var(--bg-3); }

+1243

.term-key-mod.once { color: var(--on-accent); background: var(--accent); border-color: var(--accent); }

+1244

.term-key-mod.locked { color: var(--on-accent); background: var(--accent); border-color: var(--accent);

+1245

box-shadow: inset 0 0 0 2px var(--bg-1); }

1246

/* (The ux-sweep #8 overflow fade lives on the SCROLLING chip row .acc-cats

1247

above; the action row does not scroll, so it carries no fade.) */

1248

/* Handedness (design §5): the default 'right (right thumb) anchors the

@@ -1101,11 +1293,11 @@

1293

flex: 1 1 auto; min-width: 0; color: var(--fg-1);

1294

white-space: nowrap; overflow: hidden; text-overflow: ellipsis;

1295

}

−1104

/* Echo auto-dismiss (slate-ux-sweep #2): once a message has lingered, Sigil

−1105

adds .fading and the message fades out; it's cleared just after. Duration

−1106

must match echo-fade-ms in (slate main). Keyframe (not a transition) so it

−1107

runs on the freshly-rendered element. reduced-motion collapses it below. */

−1108

.ledge-echo.fading { animation: ledge-echo-fade 500ms var(--ease) forwards; }

+1296

/* One host-owned animation replaces the old 200ms WASM polling loop: linger

+1297

for 4.5s, fade for 0.5s, then animationend clears this exact generation. */

+1298

.ledge-echo.echo-active {

+1299

animation: ledge-echo-fade 500ms var(--ease) 4500ms forwards;

+1300

}

1301

@keyframes ledge-echo-fade { from { opacity: 1; } to { opacity: 0; } }

1302

/* Dedicated ≡ button to the *messages* buffer — its own click target so it

1303

never competes with the ledge's palette click. */

@@ -1131,6 +1323,15 @@

1323

font-weight: 650; }

1324

.ledge-ind { flex: 0 0 auto; display: inline-flex; align-items: center; gap: var(--sp-2);

1325

color: var(--fg-2); font-size: var(--text-xs); }

+1326

@media (max-width: 767px) {

+1327

.frame { --bottom-chrome-h: calc(100px + env(safe-area-inset-bottom)); }

+1328

.ledge { height: 36px; padding: 0 var(--sp-2); gap: var(--sp-2); }

+1329

.ledge-msgs, .ledge-notif, .ledge-ind {

+1330

min-width: 36px; height: 36px; padding: 0;

+1331

align-items: center; justify-content: center;

+1332

}

+1333

.ledge-notif { margin-left: 0; }

+1334

}

1335

/* The clock/date ledge item (a live item; hidden on small screens by default

1336

via .ledge-hide-sm below — the phone has its own clock). */

1337

.ledge-clock { flex: 0 0 auto; color: var(--fg-2); font-size: var(--text-xs);

@@ -1193,7 +1394,11 @@

1394

Dimming is purely presentational, so it reverses cleanly on reattach and

1395

costs the terminal emulator nothing.

1396

---------------------------------------------------------------------- */

−1196

.term-ribbon { flex: 0 0 auto; display: flex; align-items: center;

+1397

/* This slot is always rendered. Keeping the terminal kernel's keyed DOM

+1398

sibling stable prevents a disconnect transition from clearing the last

+1399

known grid while the ribbon is inserted. */

+1400

.term-ribbon-slot { flex: 0 0 auto; min-height: 0; }

+1401

.term-ribbon { display: flex; align-items: center;

1402

gap: var(--sp-2); padding: 2px var(--sp-3);

1403

background: color-mix(in srgb, var(--warn) 16%, var(--bg-1));

1404

border-bottom: 1px solid color-mix(in srgb, var(--warn) 45%, transparent);

@@ -1237,7 +1442,7 @@

1442

the bottom, so the panel lands JUST ABOVE the ledge (and the ledge stays

1443

visible + clickable below it). --vvh already excludes the on-screen keyboard. */

1444

.palette-scrim { position: fixed; left: 0; right: 0; z-index: 30;

−1240

top: var(--vvo, 0px); height: calc(var(--vvh, 100dvh) - var(--ledge-h));

+1445

top: var(--vvo, 0px); height: calc(var(--vvh, 100dvh) - var(--bottom-chrome-h, var(--ledge-h)));

1446

/* Backdrop is undimmed for now (David's call): the scrim only catches

1447

click-outside-to-close; the panel's own top shadow gives it separation. To

1448

reintroduce a *very subtle* dim later, set e.g. background: rgba(3,5,10,0.18). */

@@ -1256,7 +1461,7 @@

1461

border-radius: 0;

1462

/* Cap the height so context stays visible above the panel; the .pal-list

1463

scrolls internally. Leaves headroom above and clears the ledge below. */

−1259

max-height: min(52dvh, calc(var(--vvh, 100dvh) - var(--ledge-h) - 2rem));

+1464

max-height: min(52dvh, calc(var(--vvh, 100dvh) - var(--bottom-chrome-h, var(--ledge-h)) - 2rem));

1465

display: flex; flex-direction: column; overflow: hidden;

1466

box-shadow: var(--shadow-sheet);

1467

}

@@ -1269,7 +1474,7 @@

1474

y/n could never reach Sigil. Its own class keeps the frame focused, so the

1475

confirm keymap resolves. See render-confirm in (slate selector). */

1476

.confirm-scrim { position: fixed; left: 0; right: 0; z-index: 30;

−1272

top: var(--vvo, 0px); height: calc(var(--vvh, 100dvh) - var(--ledge-h));

+1477

top: var(--vvo, 0px); height: calc(var(--vvh, 100dvh) - var(--bottom-chrome-h, var(--ledge-h)));

1478

background: transparent; display: flex; align-items: flex-end;

1479

/* Never swallow a click: the panel answers keys only, and the buffer behind

1480

it must keep working exactly as the ledge echo does. */

@@ -1289,11 +1494,11 @@

1494

the NEXT chord key still reaches on-key:. pointer-events:none so it never

1495

eats a click either. Rises above the ledge like the palette. */

1496

.which-key-scrim { position: fixed; left: 0; right: 0; z-index: 29;

−1292

top: var(--vvo, 0px); height: calc(var(--vvh, 100dvh) - var(--ledge-h));

+1497

top: var(--vvo, 0px); height: calc(var(--vvh, 100dvh) - var(--bottom-chrome-h, var(--ledge-h)));

1498

background: transparent; display: flex; align-items: flex-end;

1499

pointer-events: none; }

1500

.which-key-panel {

−1296

width: 100%; max-height: min(45dvh, calc(var(--vvh, 100dvh) - var(--ledge-h) - 2rem));

+1501

width: 100%; max-height: min(45dvh, calc(var(--vvh, 100dvh) - var(--bottom-chrome-h, var(--ledge-h)) - 2rem));

1502

overflow: auto; background: var(--bg-1); border-top: 1px solid var(--edge-1);

1503

box-shadow: var(--shadow-sheet); font-family: var(--font-code);

1504

padding: var(--sp-2) var(--sp-3);

@@ -1318,6 +1523,13 @@

1523

.wk-arrow { color: var(--fg-2); flex: 0 0 auto; }

1524

.wk-cmd { color: var(--fg-1); overflow: hidden; text-overflow: ellipsis;

1525

white-space: nowrap; min-width: 0; }

+1526

.which-key-panel:has(button.wk-row) { pointer-events:auto; }

+1527

.which-key-panel:has(button.wk-row) .wk-grid {

+1528

grid-template-columns:repeat(auto-fit, minmax(min(100%, 360px), 1fr)); }

+1529

.which-key-panel button.wk-row { width:100%; min-height:44px; border:0; background:transparent;

+1530

color:inherit; font:inherit; text-align:left; cursor:pointer; }

+1531

.which-key-panel button.wk-row:hover, .which-key-panel button.wk-row:focus-visible {

+1532

background:var(--bg-2); outline:1px solid var(--accent); outline-offset:-1px; }

1533

.wk-row-prefix .wk-cmd { color: var(--fg-2); font-style: italic; }

1534

.pal-crumbs {

1535

display: flex; align-items: center; gap: 0.2em; flex: 0 0 auto;

@@ -2208,6 +2420,11 @@

2420

2421

@media (prefers-reduced-motion: reduce) {

2422

* { transition: none !important; animation: none !important; }

+2423

/* Preserve dismissal without visually animating the message. */

+2424

.ledge-echo.echo-active {

+2425

animation: ledge-echo-hold 4500ms linear forwards !important;

+2426

}

+2427

@keyframes ledge-echo-hold { from { opacity: 1; } to { opacity: 1; } }

2428

}

2429

2430

/* Transport diagnostics toggle — HIDDEN for now. The 🩺 diag button +

@@ -2294,7 +2511,290 @@

2511

.agent-child-identity { display: flex; flex-wrap: wrap; gap: 8px 16px;

2512

padding: 10px 0 16px; font-size: 12px; color: var(--fg-2); }

2513

.agent-child-identity strong { color: var(--fg-0); }

−2297

</style>

+2514

    .git-buffer { position:relative; min-width: 0; max-width: 100%; padding: var(--sp-3); overflow: auto; font-family: var(--font-code);

+2515

font-size: var(--text-code); color: var(--fg-0); }

+2516

.git-buffer-header { position: relative; display: grid; grid-template-columns: minmax(0, 1fr) auto;

+2517

gap: 0 var(--sp-3); padding: var(--sp-2) var(--sp-3) var(--sp-3);

+2518

margin-bottom: var(--sp-2); border-bottom: 1px solid var(--edge-1); background: transparent; }

+2519

.git-header-line { grid-column: 1; display: grid; grid-template-columns: 14ch minmax(0, 1fr);

+2520

min-height: 1.55em; align-items: baseline; }

+2521

.git-header-label { color: var(--fg-2); white-space:nowrap; }

+2522

.git-header-value { color: var(--fg-0); overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }

+2523

.git-header-actions { grid-column: 2; grid-row: 1 / span 6; display: flex; align-items: start;

+2524

gap: var(--sp-2); }

+2525

.git-header-icon { display:grid; place-items:center; width:30px; height:30px; padding:0;

+2526

border:1px solid var(--edge-1); border-radius:var(--r-1); background:transparent;

+2527

color:var(--fg-2); font:inherit; }

+2528

.git-header-icon:hover, .git-header-icon:focus-visible { border-color:var(--accent); color:var(--accent); }

+2529

.git-row, .git-diff-row { position: relative; display: flex; width: 100%; min-height: 44px;

+2530

align-items: center; border: 0; border-radius: 0; padding: var(--sp-2) var(--sp-3);

+2531

background: transparent; color: var(--fg-0); text-align: left; font: inherit; }

+2532

.git-row:hover, .git-row:focus-visible, .git-diff-row:hover, .git-diff-row:focus-visible {

+2533

background: color-mix(in srgb, var(--accent) 7%, transparent); }

+2534

.git-row.selected, .git-diff-row.selected {

+2535

background: color-mix(in srgb, var(--accent) 22%, var(--bg-1));

+2536

box-shadow: inset 4px 0 0 var(--accent); }

+2537

.git-section { margin-top: var(--sp-2); border-top: 1px solid var(--edge-1);

+2538

font-weight: 700; color: var(--fg-1); }

+2539

.git-section:first-of-type { border-top: 0; }

+2540

.git-entry { display: grid; grid-template-columns: 3ch 3ch minmax(0, 1fr) auto auto auto;

+2541

min-height:34px; padding:2px var(--sp-2) 2px var(--sp-5); }

+2542

.git-entry-state { color: var(--fg-2); }

+2543

.git-entry-toggle { min-height:30px; border:0; background:transparent; color:var(--fg-2); font:inherit; }

+2544

.git-entry-path { min-height: 30px; border: 0; background: transparent; color: inherit;

+2545

font: inherit; text-align: left; overflow: hidden; text-overflow: ellipsis; white-space: nowrap; }

+2546

.git-entry-diff { min-width: 42px; min-height: 30px; padding:0 var(--sp-2); border: 1px solid var(--edge-1);

+2547

border-radius: var(--r-1); background: transparent; color: var(--fg-1); font: inherit; font-size:var(--text-xs); }

+2548

.git-entry-diff:hover, .git-entry-diff:focus-visible { border-color: var(--accent); color: var(--accent); }

+2549

.git-entry-diff, .git-entry-mutation, .git-entry-discard { display:grid; place-items:center; min-width:30px; }

+2550

.git-entry-mutation { min-height:30px; padding:0 var(--sp-2); margin-left:var(--sp-1);

+2551

border:1px solid var(--edge-1); border-radius:var(--r-1); background:transparent;

+2552

color:var(--fg-1); font:inherit; font-size:var(--text-xs); }

+2553

.git-entry-mutation:hover, .git-entry-mutation:focus-visible { border-color:var(--accent); color:var(--accent); }

+2554

.git-entry-discard { min-height:30px; padding:0 var(--sp-2); margin-left:var(--sp-1);

+2555

border:1px solid color-mix(in srgb, var(--err) 45%, var(--edge-1)); border-radius:var(--r-1);

+2556

background:transparent; color:var(--err); font:inherit; font-size:var(--text-xs); }

+2557

.git-entry-discard:hover, .git-entry-discard:focus-visible {

+2558

border-color:var(--err); background:color-mix(in srgb, var(--err) 10%, transparent); }

+2559

.git-section-toggle { flex:1; min-width:0; border:0; background:transparent;

+2560

color:inherit; text-align:left; font:inherit; font-weight:inherit; }

+2561

.git-conflicts { color: var(--err); }

+2562

.git-untracked { color: var(--ok); }

+2563

.git-commit { display:grid; grid-template-columns:9ch minmax(0, 1fr);

+2564

gap:var(--sp-2); padding-left:var(--sp-5); color:var(--fg-1); }

+2565

.git-commit-oid { color:var(--fg-2); font-variant-numeric:tabular-nums; }

+2566

.git-commit-subject { overflow:hidden; text-overflow:ellipsis; white-space:nowrap; }

+2567

+2568

/* History keeps one bounded page and one explicitly opened review. */

+2569

    .git-log.git-buffer { container:history / inline-size; display:flex; flex-direction:column; overflow:hidden; padding:0; }

+2570

    .git-log-header { position:relative; display:flex; align-items:center; flex-wrap:wrap; gap:16px; padding:22px 24px 16px; border-bottom:1px solid var(--edge-1); }

+2571

.git-log-header > div:first-child { flex:1; min-width:0; }

+2572

.git-log-header h1 { font:600 1.3em var(--font-code); margin:6px 0; }

+2573

.git-log .git-eyebrow { font-size:.75em; letter-spacing:.13em; color:var(--fg-2); }

+2574

.git-log-path { color:var(--fg-2); font-size:.8em; overflow:hidden; text-overflow:ellipsis; white-space:nowrap; }

+2575

    .git-log-workbench { flex:1; min-height:0; display:grid; grid-template-columns:minmax(0,1fr); grid-template-rows:minmax(0,2fr) minmax(0,3fr); overflow:hidden; }

+2576

.git-log-list { min-width:0; min-height:0; overflow:auto; }

+2577

    .git-log-pane-label { position:sticky; top:0; z-index:2; display:flex; align-items:center; justify-content:space-between; gap:8px; padding:5px 12px;

+2578

background:var(--bg-1); border-bottom:1px solid var(--edge-1); color:var(--fg-2); font-size:.75em; }

+2579

.git-log-pane-label span { overflow:hidden; text-overflow:ellipsis; white-space:nowrap; }

+2580

.git-log[data-focus="list"] .git-log-list > .git-log-pane-label,

+2581

    .git-log[data-focus="review"] .git-log-review > .git-log-pane-label { color:var(--accent); box-shadow:inset 3px 0 var(--accent); background:var(--bg-2); }

+2582

.git-log-review-body { flex:1; min-height:0; overflow:auto; outline:none; }

+2583

.git-log-pagination { display:flex; align-items:center; gap:12px; padding:12px; color:var(--fg-2); font-size:.8em; }

+2584

.git-log-pagination span { flex:1; }

+2585

.git-log button { font:inherit; color:inherit; background:transparent; border:0; padding:4px 8px; cursor:pointer; }

+2586

.git-log .git-header-actions button, .git-log-pagination button, .git-log-commit-header button {

+2587

border:1px solid var(--edge-1); border-radius:var(--r-1); font-size:.85em; }

+2588

.git-log button:hover { background:var(--bg-2); color:var(--accent); }

+2589

.git-log kbd { font:inherit; font-size:.9em; color:var(--accent); margin-right:7px; white-space:nowrap; }

+2590

.git-log button:focus-visible { outline:2px solid var(--accent); outline-offset:-2px; }

+2591

.git-log .git-row { scroll-margin-top:40px; min-height:32px; padding:0 12px 0 6px; gap:10px; text-align:left; }

+2592

    .git-log-graph { display:inline-block; height:32px; flex:none; background:var(--accent); mask-size:100% 100%; mask-repeat:no-repeat; }

+2593

.git-log .git-commit-oid { color:var(--accent); font-size:.85em; }

+2594

.git-log-summary { display:flex; align-items:center; gap:8px; flex:1; min-width:0; }

+2595

.git-log-subject { overflow:hidden; text-overflow:ellipsis; white-space:nowrap; }

+2596

    .git-log-refs { color:var(--ok); border:1px solid color-mix(in srgb,var(--ok) 35%,transparent); padding:1px 5px; border-radius:4px; font-size:.75em; max-width:20ch; overflow:hidden; text-overflow:ellipsis; white-space:nowrap; }

+2597

    .git-log-author { color:var(--fg-2); font-size:.8em; max-width:16ch; overflow:hidden; text-overflow:ellipsis; white-space:nowrap; }

+2598

    .git-log-review { border-top:1px solid var(--edge-1); min-width:0; min-height:0; display:flex; flex-direction:column; overflow:hidden; }

+2599

    .git-log-empty { display:flex; flex-direction:column; align-items:center; justify-content:center; gap:16px; color:var(--fg-2); padding:48px 20px; text-align:center; }

+2600

.git-log-empty strong { color:var(--fg-0); }

+2601

.git-log-commit-header { padding:22px; }

+2602

    .git-log-commit-header h2 { font:600 1.2em var(--font-code); line-height:1.5; margin:10px 0; overflow-wrap:anywhere; }

+2603

.git-log-metadata { display:flex; flex-wrap:wrap; gap:12px; color:var(--fg-2); font-size:.85em; }

+2604

.git-log-oid { overflow-wrap:anywhere; color:var(--accent); font-size:.8em; margin:12px 0; }

+2605

    .git-log-parents { display:flex; flex-wrap:wrap; gap:8px; align-items:center; margin-top:12px; font-size:.85em; color:var(--fg-2); }

+2606

.git-log-message { overflow-wrap:anywhere; margin-top:18px; }

+2607

.git-log-message .md-body { max-width:none; margin:0; font:inherit; font-size:.9em; line-height:1.6; }

Showing the first 500 of 2683 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate/assets/sw.jsmodified

@@ -17,7 +17,7 @@

17

// caches.match resolve them against self.location, and the fetch router keys

18

// off path SUFFIXES rather than absolute pathnames.

19

−20

const VERSION = '2026-09-08-agent-shared-node-1';

+20

const VERSION = '2026-09-08-agent-shared-node-merge-1';

21

const CACHE_NAME = `slate-shell-${VERSION}`;

22

23

// The app shell — exactly what the built index.html loads at runtime (verified

@@ -46,6 +46,10 @@ const SHELL_FILES = [

46

'vendor/browser_wasi_shim/debug.js',

47

'vendor/browser_wasi_shim/wasi_defs.js',

48

'slate-registry.mjs',

+49

'terminal-prediction.mjs',

+50

'terminal-compose.mjs',

+51

'terminal-copy.mjs',

+52

'folder-browser.mjs',

53

// The WASM must be cached with its server Content-Type intact —

54

// application/wasm lets compileStreaming accept the cached Response offline.

55

// Bytecode builds fetch lib.bundle through buildFs(); the runtime fetch handler

@@ -96,20 +100,26 @@ self.addEventListener('install', (ev) => {

100

}

101

}),

102

);

−99

self.skipWaiting();

+103

// Do not activate over a running Slate client. The installed worker waits

+104

// until the user explicitly invokes Slate: Update Client, whose message

+105

// handler below is the sole skipWaiting() path.

106

});

107

108

self.addEventListener('activate', (ev) => {

109

ev.waitUntil(

110

caches.keys().then((names) => Promise.all(

111

names.filter((n) => n !== CACHE_NAME).map((n) => caches.delete(n)),

−106

)).then(() => self.clients.claim()),

+112

)),

113

);

114

});

115

116

// Let the page ask a waiting SW to activate immediately (update flow).

117

self.addEventListener('message', (ev) => {

118

if (ev && ev.data && ev.data.type === 'skip-waiting') self.skipWaiting();

+119

if (ev && ev.data && ev.data.type === 'slate-client-diagnostics' &&

+120

ev.ports && ev.ports[0]) {

+121

ev.ports[0].postMessage({ version: VERSION, cache: CACHE_NAME });

+122

}

123

});

124

125

self.addEventListener('fetch', (ev) => {

packages/slate/assets/terminal-compose.mjsadded

@@ -0,0 +1,221 @@

+1

// Native draft editing stays outside Slate's live key router. Drafts belong to

+2

// individual terminals and survive page/view switches for this browser session.

+3

export function createTerminalDeck({ document, modifier, send, focusKeys, cancelKey }) {

+4

const drafts = new Map();

+5

const histories = new Map();

+6

let historyPanel, historyItems;

+7

let historyOpen = false, historyHintShown = false;

+8

let deck, input, target = '', page = 'keys', composing = false;

+9

let gesture = null, clickGuard = null, shiftEnter = false, compositionEnter = false;

+10

const closest = (node, selector) => node?.closest?.(selector);

+11

const field = node => closest(node, '.terminal-compose-input');

+12

const mod = node => closest(node, '[data-slate-click^="sticky-mod:"]');

+13

const focused = () => !!input && document.activeElement === input;

+14

function save() {

+15

if (target && input) drafts.set(target, { text: input.value, page,

+16

start: input.selectionStart, end: input.selectionEnd });

+17

}

+18

function visibility(node, hide) { if (node && node.hidden !== hide) node.hidden = hide; }

+19

function sync() {

+20

const nextDeck = document.querySelector('.accessory-key-deck');

+21

const nextInput = nextDeck?.querySelector('.terminal-compose-input');

+22

const nextTarget = nextDeck?.getAttribute('data-compose-target') || '';

+23

if (target !== nextTarget || input !== nextInput) {

+24

save(); target = nextTarget; input = nextInput; composing = false; historyOpen = false;

+25

const status = nextDeck?.querySelector('.terminal-compose-status');

+26

if (status) status.textContent = '';

+27

const draft = drafts.get(target);

+28

page = target ? (draft?.page || 'keys') : 'keys';

+29

if (input) {

+30

input.value = draft?.text || '';

+31

if (draft) input.setSelectionRange(draft.start, draft.end);

+32

}

+33

}

+34

deck = nextDeck;

+35

if (!deck) return;

+36

visibility(deck.querySelector('.terminal-key-page'), page === 'compose');

+37

visibility(deck.querySelector('.terminal-compose-page'), page !== 'compose');

+38

syncHistory();

+39

}

+40

function syncHistory() {

+41

if (!deck || !input) return;

+42

const items = histories.get(target) || [];

+43

const empty = !input.value;

+44

const button = deck.querySelector('.terminal-compose-send');

+45

const disabled = empty && !items.length;

+46

if (button.disabled !== disabled) button.disabled = disabled;

+47

const description = empty ? 'Text history' : 'Send text without Enter';

+48

if (button.getAttribute('aria-label') !== description) button.setAttribute('aria-label', description);

+49

if (button.title !== description) button.title = description;

+50

const label = empty ? '◷' : 'Send';

+51

if (button.textContent !== label) button.textContent = label;

+52

button.classList.toggle('history', empty);

+53

if (!empty) historyOpen = false;

+54

const panel = deck.querySelector('.terminal-compose-history');

+55

visibility(panel, !historyOpen);

+56

    if (panel && historyOpen && (panel !== historyPanel || items !== historyItems || panel.children.length !== items.length + 1)) {

+57

historyPanel = panel; historyItems = items;

+58

panel.replaceChildren();

+59

const title = document.createElement('div');

+60

title.className = 'terminal-history-title'; title.textContent = 'Recent text';

+61

panel.appendChild(title);

+62

items.forEach((text, index) => {

+63

const entry = document.createElement('button');

+64

entry.type = 'button'; entry.dataset.terminalHistory = String(index);

+65

entry.textContent = text.length > 160 ? text.slice(0, 160) + '…' : text;

+66

panel.appendChild(entry);

+67

});

+68

}

+69

}

+70

function recall(index) {

+71

// Typing while the list is open must never replace a newer draft.

+72

if (!target || input.value) return;

+73

const text = (histories.get(target) || [])[index];

+74

if (text === undefined) return;

+75

input.value = text; input.setSelectionRange(text.length, text.length);

+76

historyOpen = false; save(); syncHistory(); input.focus({ preventScroll: true });

+77

}

+78

function show(next) {

+79

sync(); if (!target) return;

+80

page = next; historyOpen = false; save(); sync();

+81

if (page === 'compose') input.focus({ preventScroll: true });

+82

else focusKeys();

+83

}

+84

function submit() {

+85

// A view switch can render before the host's reconciliation callback runs.

+86

// Do not reinterpret that stale field's Enter as permission to send another

+87

// terminal's draft. The next explicit send can use the newly selected one.

+88

const previous = target; sync();

+89

if (!target || previous !== target || composing || !input.value) return false;

+90

const text = input.value;

+91

let accepted = false;

+92

try { accepted = send(target, text); } catch (_) {}

+93

const status = deck.querySelector('.terminal-compose-status');

+94

const message = accepted ? '' : 'Not sent. Return to the live terminal or reconnect, then try again.';

+95

if (status.textContent !== message) status.textContent = message;

+96

if (accepted) {

+97

histories.set(target, [text, ...(histories.get(target) || [])].slice(0, 5));

+98

input.value = '';

+99

if (!historyHintShown) {

+100

const hint = 'Text history — tap the clock to recall';

+101

status.textContent = hint; historyHintShown = true;

+102

setTimeout(() => { if (status.textContent === hint) status.textContent = ''; }, 5000);

+103

}

+104

}

+105

save(); syncHistory(); return accepted;

+106

}

+107

function changeModifier(node) {

+108

const which = node.getAttribute('data-slate-click').slice('sticky-mod:'.length);

+109

const state = modifier(which);

+110

if (!['off', 'once', 'locked'].includes(state)) return;

+111

for (const chip of document.querySelectorAll(`[data-slate-click="sticky-mod:${which}"]`)) {

+112

for (const value of ['off', 'once', 'locked']) chip.classList.toggle(value, value === state);

+113

chip.setAttribute('aria-pressed', state === 'off' ? 'false' : 'true');

+114

}

+115

const armed = !!document.querySelector('.acc-mod.once, .acc-mod.locked, .term-key-mod.once, .term-key-mod.locked');

+116

for (const chip of document.querySelectorAll('.acc-kbd-chip')) chip.classList.toggle('live', armed);

+117

}

+118

function guardClick(event) {

+119

clickGuard = { x: event.clientX, y: event.clientY };

+120

}

+121

document.addEventListener('pointerdown', event => {

+122

clickGuard = null;

+123

if (closest(event.target, '[data-slate-host-action="terminal-compose:open"]')) {

+124

event.preventDefault(); event.stopImmediatePropagation(); return;

+125

}

+126

    if (historyOpen && !closest(event.target, '.terminal-compose-history, .terminal-compose-send')) { historyOpen = false; syncHistory(); }

+127

if (field(event.target)) { event.stopImmediatePropagation(); return; }

+128

const modifierNode = mod(event.target);

+129

const bar = closest(event.target, '.accessory-key-deck');

+130

if ((!bar && !modifierNode) || event.button !== 0 || event.isPrimary === false) return;

+131

gesture = { id: event.pointerId, x: event.clientX, y: event.clientY,

+132

bar, modifierNode, moved: false };

+133

if (modifierNode) {

+134

// Keep any native editing surface focused, including the rendered editor.

+135

// Dispatch on pointerup so horizontal swipes cannot arm a modifier.

+136

event.preventDefault(); event.stopImmediatePropagation();

+137

} else if (closest(event.target, 'button')) event.preventDefault();

+138

}, true);

+139

document.addEventListener('pointermove', event => {

+140

if (!gesture || event.pointerId !== gesture.id) return;

+141

if (Math.abs(event.clientX - gesture.x) > 10 || Math.abs(event.clientY - gesture.y) > 10) {

+142

gesture.moved = true; cancelKey();

+143

}

+144

}, true);

+145

document.addEventListener('pointercancel', () => { gesture = null; cancelKey(); }, true);

+146

document.addEventListener('pointerup', event => {

+147

const pending = gesture; gesture = null;

+148

if (!pending || event.pointerId !== pending.id) return;

+149

const dx = event.clientX - pending.x, dy = event.clientY - pending.y;

+150

if (pending.bar && Math.abs(dx) >= 40 && Math.abs(dx) > Math.abs(dy)) {

+151

cancelKey(); guardClick(event); event.preventDefault(); event.stopImmediatePropagation();

+152

show(dx < 0 ? 'compose' : 'keys');

+153

} else if (pending.modifierNode) {

+154

guardClick(event); event.preventDefault(); event.stopImmediatePropagation();

+155

if (!pending.moved) changeModifier(pending.modifierNode);

+156

} else if (pending.moved) guardClick(event);

+157

}, true);

+158

document.addEventListener('click', event => {

+159

if (clickGuard && (event.detail !== 0 || event.pointerType === 'touch' || event.pointerType === 'pen') &&

+160

Math.abs(event.clientX - clickGuard.x) < 32 && Math.abs(event.clientY - clickGuard.y) < 32) {

+161

clickGuard = null; event.preventDefault(); event.stopImmediatePropagation(); return;

+162

}

+163

const historyEntry = closest(event.target, '[data-terminal-history]');

+164

if (historyEntry) {

+165

      event.preventDefault(); event.stopImmediatePropagation(); recall(Number(historyEntry.dataset.terminalHistory)); return;

+166

}

+167

const modifierNode = mod(event.target);

+168

if (modifierNode) {

+169

event.preventDefault(); event.stopImmediatePropagation(); changeModifier(modifierNode); return;

+170

}

+171

    const button = closest(event.target, '[data-slate-host-action="terminal-compose:open"], .terminal-compose-back, .terminal-compose-send');

+172

if (button) {

+173

event.preventDefault(); event.stopImmediatePropagation();

+174

if (button.matches('.terminal-compose-send')) {

+175

sync();

+176

if (input.value) submit();

+177

else { historyOpen = !historyOpen; syncHistory(); }

+178

input?.focus({ preventScroll: true });

+179

}

+180

else show(button.matches('.terminal-compose-back') ? 'keys' : 'compose');

+181

} else if (field(event.target)) event.stopImmediatePropagation();

+182

}, true);

+183

// Capture before the frame and host shortcuts. Do not prevent native editing

+184

// defaults: selection, clipboard shortcuts, autocorrect and IME remain local.

+185

document.addEventListener('keydown', event => {

+186

if (!field(event.target)) return;

+187

event.stopImmediatePropagation();

+188

if (event.key === 'Escape' && historyOpen) { event.preventDefault(); historyOpen = false; syncHistory(); return; }

+189

if (event.key !== 'Enter') return;

+190

if (event.isComposing || composing || event.keyCode === 229) { compositionEnter = true; return; }

+191

shiftEnter = event.shiftKey;

+192

if (!shiftEnter) { event.preventDefault(); submit(); }

+193

}, true);

+194

document.addEventListener('keyup', event => {

+195

if (!field(event.target)) return;

+196

event.stopImmediatePropagation(); shiftEnter = false; compositionEnter = false;

+197

}, true);

+198

document.addEventListener('beforeinput', event => {

+199

if (!field(event.target)) return;

+200

event.stopImmediatePropagation();

+201

if (event.inputType === 'insertParagraph' || event.inputType === 'insertLineBreak') {

+202

if (shiftEnter) return;

+203

event.preventDefault();

+204

if (!event.isComposing && !composing && !compositionEnter) submit();

+205

compositionEnter = false;

+206

}

+207

}, true);

+208

document.addEventListener('input', event => {

+209

if (field(event.target)) { event.stopImmediatePropagation(); save(); syncHistory(); }

+210

}, true);

+211

for (const type of ['paste', 'copy', 'cut']) document.addEventListener(type, event => {

+212

if (field(event.target)) event.stopImmediatePropagation();

+213

}, true);

+214

for (const type of ['compositionstart', 'compositionupdate', 'compositionend']) {

+215

document.addEventListener(type, event => {

+216

if (!field(event.target)) return;

+217

event.stopImmediatePropagation(); composing = type !== 'compositionend'; save();

+218

}, true);

+219

}

+220

return { sync, ownsFocus: focused };

+221

}

packages/slate/assets/terminal-copy.mjsadded

@@ -0,0 +1,351 @@

+1

// Selection coordinates refer to frozen terminal rows, never recycled DOM nodes.

+2

export class TerminalCopySelection {

+3

constructor({ html, rows, cols, top, point }) {

+4

this.html = html;

+5

this.lines = rows.map(text => [...text.replace(/ +$/, '')]);

+6

this.cols = cols; this.height = 1; this.top = top;

+7

this.point = this.clamp(point); this.mark = null;

+8

}

+9

clamp({ row, col }) {

+10

row = Math.max(0, Math.min(this.lines.length - 1, row));

+11

return { row, col: Math.max(0, Math.min(this.lines[row].length, col)) };

+12

}

+13

setPoint(row, col, reveal = false) {

+14

this.point = this.clamp({ row, col });

+15

if (reveal) {

+16

if (this.point.row < this.top) this.top = this.point.row;

+17

if (this.point.row >= this.top + this.height) this.top = this.point.row - this.height + 1;

+18

}

+19

this.scroll(0);

+20

}

+21

scroll(delta) { this.top = Math.max(0, Math.min(Math.max(0, this.lines.length - this.height), this.top + delta)); }

+22

setMark() { this.mark = { ...this.point }; }

+23

region() {

+24

if (!this.mark) return null;

+25

const a = this.mark, b = this.point;

+26

return a.row < b.row || (a.row === b.row && a.col <= b.col) ? [a, b] : [b, a];

+27

}

+28

text() {

+29

const range = this.region(); if (!range) return '';

+30

const [a, b] = range, out = [];

+31

    for (let row = a.row; row <= b.row; row++) out.push(this.lines[row].slice(row === a.row ? a.col : 0, row === b.row ? b.col : undefined).join(''));

+32

return out.join('\n');

+33

}

+34

step(direction) {

+35

let { row, col } = this.point;

+36

if (direction > 0) {

+37

if (col < this.lines[row].length) col++;

+38

else if (row + 1 < this.lines.length) { row++; col = 0; }

+39

} else if (col > 0) col--;

+40

else if (row > 0) { row--; col = this.lines[row].length; }

+41

this.setPoint(row, col, true);

+42

}

+43

word(direction) {

+44

const isWord = ch => !!ch && /[\p{L}\p{N}_]/u.test(ch);

+45

const char = () => this.lines[this.point.row][this.point.col - (direction < 0 ? 1 : 0)];

+46

const advance = () => {

+47

const old = this.point; this.step(direction);

+48

return old.row !== this.point.row || old.col !== this.point.col;

+49

};

+50

while (!isWord(char())) if (!advance()) return;

+51

while (isWord(char())) if (!advance()) return;

+52

}

+53

key(spec) {

+54

const { row, col } = this.point;

+55

if (['C-Space', 'C- ', 'C-@', 'C-Spacebar'].includes(spec)) this.setMark();

+56

else if (['ArrowLeft', 'C-b'].includes(spec)) this.step(-1);

+57

else if (['ArrowRight', 'C-f'].includes(spec)) this.step(1);

+58

else if (['ArrowUp', 'C-p'].includes(spec)) this.setPoint(row - 1, col, true);

+59

else if (['ArrowDown', 'C-n'].includes(spec)) this.setPoint(row + 1, col, true);

+60

else if (['Home', 'C-a'].includes(spec)) this.setPoint(row, 0, true);

+61

else if (['End', 'C-e'].includes(spec)) this.setPoint(row, this.lines[row].length, true);

+62

else if (['PageUp', 'M-v'].includes(spec)) this.setPoint(row - Math.max(1, this.height - 1), col, true);

+63

else if (['PageDown', 'C-v'].includes(spec)) this.setPoint(row + Math.max(1, this.height - 1), col, true);

+64

else if (['M-<', 'C-Home'].includes(spec)) this.setPoint(0, 0, true);

+65

else if (['M->', 'C-End'].includes(spec)) this.setPoint(this.lines.length - 1, this.lines.at(-1).length, true);

+66

else if (spec === 'M-b') this.word(-1);

+67

else if (spec === 'M-f') this.word(1);

+68

}

+69

}

+70

+71

// Report clipboard failure truthfully and retain the selection/staged payload.

+72

export async function writeTerminalClipboard(document, navigator, text) {

+73

if (navigator.clipboard?.writeText) {

+74

try { await navigator.clipboard.writeText(text); return true; } catch (_) {}

+75

}

+76

const active = document.activeElement;

+77

const start = active?.selectionStart, end = active?.selectionEnd;

+78

const field = document.createElement('textarea');

+79

field.value = text; field.style.cssText = 'position:fixed;opacity:0;left:0;top:0';

+80

document.body.appendChild(field); field.select();

+81

let copied = false;

+82

try { copied = document.execCommand('copy'); } catch (_) {}

+83

field.remove(); active?.focus({ preventScroll: true });

+84

if (typeof start === 'number') active.setSelectionRange(start, end);

+85

return copied;

+86

}

+87

+88

export function createTerminalCopy({ document, snapshot, end, peek, acknowledge, clipboard, focusKeys, focusPane, consumeSticky, invalidate }) {

+89

const copies = new Map();

+90

const closest = (node, selector) => node?.closest?.(selector);

+91

let gesture = null, clickGuard = null;

+92

const menuSelector = '.acc-actions[data-accessory-category="terminal-copy"]';

+93

const messages = new Map();

+94

// These controls sit outside the terminal's DOM-owned grid. Rewriting an

+95

// unchanged attribute schedules afterRender again through the app observer.

+96

const attribute = (node, name, value) => {

+97

if (node && node.getAttribute(name) !== value) node.setAttribute(name, value);

+98

};

+99

const textContent = (node, text) => { if (node.textContent !== text) node.textContent = text; };

+100

const hidden = (node, value) => { if (node && node.hidden !== value) node.hidden = value; };

+101

  const actions = { start: 'Enter copy mode', mark: 'Mark', copy: 'Copy selection', cancel: 'Cancel', received: 'Copy received text' };

+102

  const focusedGrid = () => document.querySelector('.pane.focused .tmux-pane.active .term-content, .pane.focused .tmux-pane.focused .term-content') || document.querySelector('.pane.focused .term-content');

+103

const gridFor = tools => {

+104

const pane = tools?.closest('.pane');

+105

    return pane ? (pane.querySelector('.tmux-pane.active .term-content, .tmux-pane.focused .term-content') || pane.querySelector('.term-content')) : focusedGrid();

+106

};

+107

const nameFor = grid => grid?.getAttribute('data-term') || '';

+108

const current = () => copies.get(nameFor(focusedGrid()));

+109

const toolsFor = copy => {

+110

const menu = document.querySelector(menuSelector);

+111

    return menu?.dataset.copyTarget === copy.name ? menu : copy.el?.closest('.pane')?.querySelector('.terminal-copy-header-tools');

+112

};

+113

function status(tools, message) {

+114

const name = tools?.dataset.copyTarget || nameFor(focusedGrid());

+115

messages.set(name, message);

+116

for (const node of document.querySelectorAll('.terminal-copy-status')) {

+117

if (node.parentElement.dataset.copyTarget === name) textContent(node, message);

+118

}

+119

}

+120

function sync() {

+121

// Desktop controls occupy the existing mode line. Mobile uses only the

+122

// normal accessory category; opening it does not create a snapshot.

+123

for (const header of document.querySelectorAll('.terminal-copy-header-tools')) {

+124

if (!header.querySelector('[data-terminal-copy]')) {

+125

for (const [action, label] of Object.entries(actions)) {

+126

const button = document.createElement('button');

+127

button.type = 'button'; button.dataset.terminalCopy = action;

+128

button.textContent = action === 'start' ? 'Copy' : label;

+129

header.appendChild(button);

+130

}

+131

}

+132

}

+133

const menu = document.querySelector(menuSelector);

+134

for (const node of document.querySelectorAll('.accessory-bar .terminal-copy-status')) {

+135

if (node.parentElement !== menu) {

+136

textContent(node, ''); node.classList.remove('terminal-copy-status');

+137

}

+138

}

+139

for (const row of document.querySelectorAll('.acc-actions.terminal-copy-tools')) {

+140

if (row === menu) continue;

+141

row.classList.remove('terminal-copy-tools');

+142

row.querySelector('.terminal-copy-status')?.remove();

+143

}

+144

if (menu) {

+145

if (!menu.classList.contains('terminal-copy-tools')) menu.classList.add('terminal-copy-tools');

+146

for (const button of menu.querySelectorAll('[data-slate-host-action]'))

+147

attribute(button, 'data-terminal-copy', button.dataset.slateHostAction.slice('terminal-copy:'.length));

+148

}

+149

for (const tools of document.querySelectorAll(`${menuSelector}, .terminal-copy-header-tools`)) {

+150

const el = gridFor(tools), name = nameFor(el), copy = copies.get(name);

+151

attribute(tools, 'data-copy-target', name);

+152

const visible = (action, show) => {

+153

const button = tools.querySelector(`[data-terminal-copy="${action}"]`);

+154

hidden(button, !show);

+155

};

+156

for (const action of ['mark', 'copy', 'cancel']) visible(action, !!copy);

+157

visible('start', !copy);

+158

const outer = el?.closest('[data-tmux-outer]')?.getAttribute('data-tmux-outer');

+159

const clipTarget = peek(name) ? name : (outer || name);

+160

attribute(tools, 'data-clip-target', clipTarget);

+161

visible('received', !!peek(clipTarget));

+162

      attribute(tools.querySelector('[data-terminal-copy="mark"]'), 'aria-pressed', copy?.model.mark ? 'true' : 'false');

+163

const take = tools.querySelector('[data-terminal-copy="copy"]');

+164

const disabled = !copy?.model.text();

+165

if (take && take.disabled !== disabled) take.disabled = disabled;

+166

let message = tools.querySelector('.acc-host-status, .terminal-copy-status');

+167

if (!message && tools.matches('.terminal-copy-header-tools')) {

+168

message = document.createElement('span'); message.className = 'terminal-copy-status';

+169

message.setAttribute('role', 'status'); tools.appendChild(message);

+170

}

+171

if (message) {

+172

if (!message.classList.contains('terminal-copy-status')) message.classList.add('terminal-copy-status');

+173

textContent(message, messages.get(name) || '');

+174

}

+175

}

+176

for (const label of document.querySelectorAll('.terminal-copy-label')) {

+177

const pane = label.closest('.pane');

+178

const frozen = [...pane.querySelectorAll('.term-content')].some(el => copies.has(nameFor(el)));

+179

hidden(label, !frozen); textContent(label, frozen ? 'Copy mode' : '');

+180

attribute(label, 'title', 'Frozen terminal snapshot');

+181

}

+182

const chip = document.querySelector('[data-slate-click="acc-cat:terminal-copy"]');

+183

if (chip) {

+184

const el = focusedGrid(), name = nameFor(el);

+185

const outer = el?.closest('[data-tmux-outer]')?.getAttribute('data-tmux-outer');

+186

const received = !!(peek(name) || (outer && peek(outer)));

+187

chip.classList.toggle('copy-received', received);

+188

attribute(chip, 'aria-label', received ? 'Copy — received text available' : 'Copy');

+189

attribute(chip, 'title', received ? 'Received terminal text is ready to copy' : 'Terminal copy actions');

+190

}

+191

for (const [name, copy] of copies) {

+192

const el = [...document.querySelectorAll('.term-content')].find(el => nameFor(el) === name);

+193

if (el) { copy.el = el; render(copy); }

+194

}

+195

}

+196

function render(copy) {

+197

const el = copy.el; if (!el?.isConnected) return;

+198

const model = copy.model, style = getComputedStyle(el);

+199

const height = parseFloat(style.getPropertyValue('--cell-h')) || 16;

+200

const width = parseFloat(style.getPropertyValue('--cell-w')) || 8;

+201

    model.height = Math.max(1, Math.floor((el.clientHeight - parseFloat(style.paddingTop) - parseFloat(style.paddingBottom)) / height));

+202

model.scroll(0);

+203

if (!el.classList.contains('terminal-copy-active')) el.classList.add('terminal-copy-active');

+204

const signature = JSON.stringify([model.top, model.height, model.point, model.mark, width, height]);

+205

if (copy.signature === signature && copy.firstRow === el.firstChild && el.children.length === copy.rowCount) return;

+206

copy.signature = signature;

+207

const fragment = document.createDocumentFragment();

+208

const region = model.region();

+209

for (let i = model.top; i < Math.min(model.lines.length, model.top + model.height); i++) {

+210

const row = document.createElement('div'); row.className = 'tr'; row.dataset.copyRow = String(i);

+211

row.innerHTML = model.html[i];

+212

if (region && i >= region[0].row && i <= region[1].row) {

+213

const start = i === region[0].row ? region[0].col : 0;

+214

const end = i === region[1].row ? region[1].col : Math.max(model.lines[i].length, model.cols);

+215

if (end > start) {

+216

const selection = document.createElement('span'); selection.className = 'terminal-copy-region';

+217

selection.style.left = `${start * width}px`; selection.style.width = `${(end - start) * width}px`;

+218

row.appendChild(selection);

+219

}

+220

}

+221

if (i === model.point.row) {

+222

const point = document.createElement('span'); point.className = 'terminal-copy-point';

+223

point.style.left = `${model.point.col * width}px`; row.appendChild(point);

+224

}

+225

fragment.appendChild(row);

+226

}

+227

el.replaceChildren(fragment); copy.firstRow = el.firstChild; copy.rowCount = el.children.length;

+228

}

+229

function start(el) {

+230

const name = nameFor(el); if (!name || copies.has(name)) return;

+231

const payload = snapshot(name); if (!payload) return;

+232

try {

+233

const [header, ...html] = payload.split('\n');

+234

const [cols, height, top, row, col] = header.split(' ').map(Number);

+235

if (!html.length || ![cols, height, top, row, col].every(Number.isFinite)) throw Error('Invalid snapshot');

+236

const template = document.createElement('template');

+237

const rows = html.map(line => { template.innerHTML = line; return template.content.textContent; });

+238

const model = new TerminalCopySelection({ html, rows, cols, top, point: { row, col } });

+239

model.height = height; copies.set(name, { name, el, model });

+240

sync(); status(toolsFor(copies.get(name)), 'Tap a start, Mark, then tap an end.');

+241

focusKeys();

+242

} catch (error) { end(name); throw error; }

+243

}

+244

function cancel(copy) {

+245

if (!copy) return;

+246

copies.delete(copy.name); copy.el?.classList.remove('terminal-copy-active');

+247

end(copy.name); status(toolsFor(copy), ''); sync(); invalidate();

+248

}

+249

async function copyRegion(copy) {

+250

if (!copy) return;

+251

    const text = copy.model.text(); if (!text) { status(toolsFor(copy), 'Set Mark, then move to the end of the text.'); return; }

+252

const ok = await clipboard(text);

+253

// A late clipboard result cannot close a subsequently opened copy session.

+254

if (copies.get(copy.name) !== copy) return;

+255

if (ok) { const tools = toolsFor(copy); cancel(copy); status(tools, 'Copied'); }

+256

else status(toolsFor(copy), 'Copy failed. Selection retained; tap Copy to retry.');

+257

}

+258

async function received(tools) {

+259

const text = peek(tools?.dataset.clipTarget || ''); if (!text) return;

+260

if (await clipboard(text)) { acknowledge(text); sync(); status(tools, 'Copied'); }

+261

else status(tools, 'Copy failed. Received text retained; tap to retry.');

+262

}

+263

function key(spec) {

+264

const copy = current(); if (!copy) return false;

+265

spec = consumeSticky(spec);

+266

if (spec === 'Escape' || spec === 'C-g') cancel(copy);

+267

else if (spec === 'M-w' || spec === 'C-S-c' || spec === 'C-S-C') void copyRegion(copy);

+268

else { copy.model.key(spec); render(copy); sync(); }

+269

return true; // Unbound input is also local while frozen.

+270

}

+271

const isField = node => closest(node, 'textarea, input:not(#slate-key-capture), [contenteditable]');

+272

document.addEventListener('keydown', event => {

+273

if (isField(event.target) || !current()) return;

+274

if (['Control', 'Alt', 'Shift', 'Meta'].includes(event.key)) return;

+275

if (event.isComposing || event.keyCode === 229 || event.key === 'Unidentified') return;

+276

const spec = (event.ctrlKey || event.metaKey ? 'C-' : '') + (event.altKey ? 'M-' : '') +

+277

      (event.ctrlKey && event.shiftKey && /^[cC]$/.test(event.key) ? 'S-' : '') + ((event.ctrlKey || event.altKey) && /^[A-Z]$/.test(event.key) ? event.key.toLowerCase() : event.key);

+278

event.preventDefault(); event.stopImmediatePropagation(); key(spec);

+279

}, true);

+280

document.addEventListener('pointerdown', event => {

+281

clickGuard = null;

+282

    const tools = closest(event.target, '.terminal-copy-tools, .terminal-copy-header-tools, [data-slate-click="acc-cat:terminal-copy"]');

+283

if (tools) { event.preventDefault(); event.stopImmediatePropagation(); return; }

+284

const el = closest(event.target, '.term-content');

+285

const copy = copies.get(nameFor(el)); if (!copy || event.button !== 0) return;

+286

event.preventDefault(); event.stopImmediatePropagation();

+287

focusPane(el);

+288

    gesture = { copy, id: event.pointerId, x: event.clientX, y: event.clientY, last: event.clientY, moved: false, remainder: 0 };

+289

copy.el.setPointerCapture(event.pointerId);

+290

}, true);

+291

document.addEventListener('pointermove', event => {

+292

if (!gesture || gesture.id !== event.pointerId) return;

+293

event.preventDefault(); event.stopImmediatePropagation();

+294

const g = gesture, height = parseFloat(getComputedStyle(g.copy.el).getPropertyValue('--cell-h')) || 16;

+295

if (Math.abs(event.clientX - g.x) + Math.abs(event.clientY - g.y) > 10) g.moved = true;

+296

if (!g.moved) return;

+297

g.remainder += g.last - event.clientY; g.last = event.clientY;

+298

const rows = Math.trunc(g.remainder / height); g.remainder -= rows * height;

+299

g.copy.model.scroll(rows); render(g.copy);

+300

}, true);

+301

document.addEventListener('pointerup', event => {

+302

const g = gesture; if (!g || g.id !== event.pointerId) return;

+303

gesture = null; event.preventDefault(); event.stopImmediatePropagation();

+304

clickGuard = true;

+305

if (!g.moved) {

+306

const el = g.copy.el, rect = el.getBoundingClientRect(), style = getComputedStyle(el);

+307

      const width = parseFloat(style.getPropertyValue('--cell-w')) || 8, height = parseFloat(style.getPropertyValue('--cell-h')) || 16;

+308

const row = g.copy.model.top + Math.floor((event.clientY - rect.top - parseFloat(style.paddingTop)) / height);

+309

const col = Math.round((event.clientX - rect.left - parseFloat(style.paddingLeft)) / width);

+310

g.copy.model.setPoint(row, col); render(g.copy); sync();

+311

}

+312

}, true);

+313

document.addEventListener('pointercancel', () => { gesture = null; }, true);

+314

document.addEventListener('click', event => {

+315

const button = closest(event.target, '[data-terminal-copy]');

+316

if (button) {

+317

event.preventDefault(); event.stopImmediatePropagation();

+318

      const tools = button.closest('.terminal-copy-tools, .terminal-copy-header-tools'), el = gridFor(tools), copy = copies.get(nameFor(el));

+319

focusPane(el);

+320

switch (button.dataset.terminalCopy) {

+321

case 'start': start(el); break;

+322

case 'mark': if (copy) { copy.model.setMark(); sync(); focusKeys(); } break;

+323

case 'copy': void copyRegion(copy); break;

+324

case 'cancel': cancel(copy); break;

+325

case 'received': void received(tools); break;

+326

}

+327

} else if (clickGuard || copies.has(nameFor(closest(event.target, '.term-content')))) {

+328

clickGuard = null; event.preventDefault(); event.stopImmediatePropagation();

+329

}

+330

}, true);

+331

  for (const type of ['mousedown', 'mouseup', 'mousemove', 'touchstart', 'touchmove', 'touchend', 'contextmenu', 'wheel']) {

+332

document.addEventListener(type, event => {

+333

const copy = copies.get(nameFor(closest(event.target, '.term-content'))); if (!copy) return;

+334

if (event.cancelable) event.preventDefault(); event.stopImmediatePropagation();

+335

if (type === 'wheel') {

+336

const height = parseFloat(getComputedStyle(copy.el).getPropertyValue('--cell-h')) || 16;

+337

        const delta = event.deltaMode === 1 ? event.deltaY : event.deltaMode === 2 ? event.deltaY * copy.model.height : event.deltaY / height;

+338

copy.model.scroll(Math.sign(delta) * Math.max(1, Math.round(Math.abs(delta)))); render(copy);

+339

}

+340

}, { capture: true, passive: false });

+341

}

+342

document.addEventListener('copy', event => {

+343

const copy = current(); if (!copy || isField(event.target)) return;

+344

const text = copy.model.text(); if (!text || !event.clipboardData) return;

+345

event.preventDefault(); event.stopImmediatePropagation(); event.clipboardData.setData('text/plain', text);

+346

}, true);

+347

return { sync, key, focused: () => !!current(), active: name => copies.has(name), paint(name, el) {

+348

const copy = copies.get(name); if (!copy) return false;

+349

copy.el = el; render(copy); return true;

+350

  }, received, report: () => [...copies.values()].map(c => ({ name: c.name, top: c.model.top, point: c.model.point, mark: c.model.mark, text: c.model.text() })) };

+351

}

packages/slate/assets/terminal-prediction.mjsadded

@@ -0,0 +1,109 @@

+1

// Disposable UI state. Frames are copies of server-authoritative VT state;

+2

// this model never writes into the emulator or sends terminal input.

+3

export class TerminalPrediction {

+4

constructor() {

+5

this.frame = null;

+6

this.pending = [];

+7

this.armed = false;

+8

this.slow = 0;

+9

this.fast = 0;

+10

this.backoffUntil = 0;

+11

this.stats = { confirmed: 0, mismatches: 0, expired: 0, arms: 0, disarms: 0 };

+12

}

+13

+14

reset(now, mismatch = false) {

+15

this.pending = [];

+16

if (this.armed) this.stats.disarms++;

+17

this.armed = false;

+18

this.slow = this.fast = 0;

+19

if (mismatch) {

+20

this.stats.mismatches++;

+21

this.backoffUntil = now + 1000;

+22

}

+23

}

+24

+25

safe(frame) {

+26

// Codex uses a single-cell › prompt. Permit that fixed glyph in the

+27

// authoritative prefix; predicted input remains printable ASCII. Do not

+28

// admit arbitrary Unicode here: string offsets must still match VT cells.

+29

return frame && frame.safe && Number.isInteger(frame.cols) &&

+30

frame.cols > 1 && Number.isInteger(frame.row) && frame.row >= 0 &&

+31

Number.isInteger(frame.col) && frame.col >= 0 && frame.col < frame.cols - 1 &&

+32

Number.isInteger(frame.serial) && frame.serial >= 0 &&

+33

typeof frame.text === 'string' && frame.text.length === frame.cols &&

+34

/^[\x20-\x7e\u203a]*$/.test(frame.text) && /^ *$/.test(frame.text.slice(frame.col));

+35

}

+36

+37

noteLatency(ms, now) {

+38

// Count independent confirmed frames, not several keys in one output burst.

+39

if (ms > 150) {

+40

this.slow++;

+41

this.fast = 0;

+42

if (!this.armed && this.slow >= 2 && now >= this.backoffUntil) {

+43

this.armed = true;

+44

this.stats.arms++;

+45

}

+46

} else if (ms < 80) {

+47

this.fast++;

+48

this.slow = 0;

+49

if (this.armed && this.fast >= 2) {

+50

this.armed = false;

+51

this.stats.disarms++;

+52

}

+53

} else this.slow = this.fast = 0;

+54

}

+55

+56

update(next, now) {

+57

this.expire(now);

+58

const before = this.frame;

+59

if (!this.safe(next)) this.reset(now);

+60

else if (before && this.pending.length) {

+61

const count = next.col - before.col;

+62

const expected = before.text.slice(0, before.col) +

+63

this.pending.slice(0, count).map(item => item.key).join('') +

+64

before.text.slice(before.col + count);

+65

if (next.row === before.row && next.cols === before.cols &&

+66

count > 0 && count <= this.pending.length && next.serial > before.serial &&

+67

next.text === expected) {

+68

const done = this.pending.splice(0, count);

+69

this.stats.confirmed += count;

+70

this.noteLatency(now - done[0].at, now);

+71

} else if (next.row !== before.row || next.col !== before.col ||

+72

next.cols !== before.cols || next.text !== before.text ||

+73

next.serial !== before.serial) this.reset(now, true);

+74

} else if (before && (next.row !== before.row || next.col !== before.col ||

+75

next.cols !== before.cols || next.text !== before.text ||

+76

next.serial !== before.serial)) this.reset(now);

+77

this.frame = { ...next };

+78

}

+79

+80

input(key, serial, now) {

+81

this.expire(now);

+82

const frame = this.frame;

+83

if (!this.safe(frame) || frame.serial !== serial || !/^[\x20-\x7e]$/.test(key) ||

+84

this.pending.length >= 64 || frame.col + this.pending.length >= frame.cols - 1) {

+85

this.reset(now);

+86

return;

+87

}

+88

const predicted = this.armed && now >= this.backoffUntil &&

+89

this.pending.every(item => item.predicted);

+90

this.pending.push({ key, at: now, predicted });

+91

}

+92

+93

expire(now) {

+94

if (this.pending.length && now - this.pending[0].at >= 2000) {

+95

this.stats.expired++;

+96

this.reset(now, true);

+97

}

+98

}

+99

+100

overlay(now) {

+101

this.expire(now);

+102

if (!this.armed || !this.pending.length || !this.pending.every(item => item.predicted))

+103

return null;

+104

const age = now - this.pending[0].at;

+105

return { row: this.frame.row, col: this.frame.col,

+106

text: this.pending.map(item => item.key).join(''), stale: age >= 250,

+107

wakeIn: Math.max(1, (age < 250 ? 250 : 2000) - age) };

+108

}

+109

}

packages/slate/package.sglmodified

@@ -13,7 +13,7 @@

13

name: "slate"

14

;; version inherited from the workspace (../../package.sgl) — member packages

15

;; do not declare their own version.

−16

sigil: "0.20.1"

+16

sigil: "0.20.3"

17

description: "Slate — a live, hackable Sigil environment"

18

authors: (list "David Wilson <david@daviwil.com>")

19

entry: '(slate main)

@@ -24,16 +24,19 @@

24

;; app with `sigil build slate --config web`; `sigil test slate` uses `dev`.

25

26

dependencies: (list

+27

;; Resolve this first: Sigil workspace dependencies share one runtime.

+28

;; Keep independent read/write waiters on the same socket until the next Sigil release.

+29

(from-git url: "codeberg:sigil/sigil" package: "sigil-stdlib"

+30

commit: "9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95")

31

;; (sigil language), used below by Slate's alternate-language support,

32

;; landed after v0.18.3 and shipped in v0.18.6, so the commit pin this

33

;; entry carried is retired and it resolves by range like its siblings.

−30

(from-git url: "codeberg:sigil/sigil" package: "sigil-wasm-runtime" version: "^0.20")

−31

(from-git url: "codeberg:sigil/sigil" package: "sigil-stdlib" version: "^0.20")

+34

(from-git url: "codeberg:sigil/sigil" package: "sigil-wasm-runtime" version: ">=0.20")

35

;; Sigil syntax highlighting: the positioned tokenizer that backs `sigil

36

;; format` / paren inference. Its `tokenize` is pure string->tokens (no

37

;; fs/io on that path); library-level (sigil io)/(sigil fs) imports resolve

38

;; via sigil-stdlib, already in the wasm build. (Phase-1 highlighting.)

−36

(from-git url: "codeberg:sigil/sigil" package: "sigil-format" version: "^0.20")

+39

(from-git url: "codeberg:sigil/sigil" package: "sigil-format" version: ">=0.20")

40

;; Markdown → sxml for the rendered markdown view. Pure Sigil (no native);

41

;; markdown->sxml is a string->sxml transform used by (slate modes markdown-view).

42

(from-git url: "codeberg:sigil/sigil-markdown" package: "sigil-markdown" version: "^0.9.1")

@@ -41,35 +44,43 @@

44

;; children, so the per-render focus re-seat band-aid is gone from

45

;; index.html and focus correctness DEPENDS on this version. (^0.15.1

46

;; brought the on-*: closure event wiring the keyboard model rides on.)

+47

;; 0.15.4 adds lazy memoized subtrees for bounded diff row groups.

48

(from-git url: "codeberg:sigil/sigil-web-client" package: "sigil-web-client" version: "^0.15.4")

−45

(from-git url: "codeberg:sigil/sigil" package: "sigil-wasm-dom" version: "^0.20")

+49

(from-git url: "codeberg:sigil/sigil" package: "sigil-wasm-dom" version: ">=0.20")

50

;; Browser API bridge: localStorage (the offline, zero-infra file provider for

51

;; dired + find-file — the `localstorage` provider's real backing store). Its

52

;; wasm bridge (assets/sigil-browser.js, global SigilBrowser) is copied into the

53

;; web build and wired in index.html alongside the dom/net bridges.

−50

(from-git url: "codeberg:sigil/sigil" package: "sigil-browser" version: "^0.20")

+54

(from-git url: "codeberg:sigil/sigil" package: "sigil-browser" version: ">=0.20")

55

;; Live-inspect transport: the enclave-rpc browser client rides

56

;; sigil-irc-websocket -> sigil-websocket -> sigil-wasm-net (the browser

57

;; WebSocket bridge). enclave-rpc is a package in the enclave monorepo,

58

;; tagged at the monorepo version — first published at v0.3.0, so ^0.3.

59

(from-git url: "codeberg:sigil/enclave" package: "enclave-rpc" version: "^0.3")

−56

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc" version: "^0.16")

−57

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc-websocket" version: "^0.16")

+60

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc" version: "^0.16.5")

+61

(from-git url: "codeberg:sigil/sigil-irc" package: "sigil-irc-websocket" version: "^0.16.5")

62

;; ^0.10.7, AND THE PATCH DIGIT IS LOAD-BEARING. `(slate providers

63

;; enclave-node)`'s stream pump calls `ws-receive-nowait` EXCLUSIVELY, which

64

;; is what Fable's 2026-08-12 binding rule requires of a gated leg. That

65

;; symbol exists in 0.10.6 — but 0.10.6's version is BUFFER-ONLY, draining a

66

;; buffer that nothing ever fills, so a nowait-exclusive caller goes DEAF

67

;; rather than failing loudly. The one non-blocking socket read that makes it

−64

;; usable landed in 0.10.7. A floor of ^0.10.6 would name a version this

−65

;; package silently does not work on, which is worse than naming none.

−66

(from-git url: "codeberg:sigil/sigil-websocket" package: "sigil-websocket" version: "^0.10.7")

−67

(from-git url: "codeberg:sigil/sigil" package: "sigil-wasm-net" version: "^0.20")

+68

;; usable landed in 0.10.7; complete native bulk-frame writes landed in

+69

;; 0.10.8; bounded native connection setup landed in 0.10.9. Version

+70

;; 0.10.13 also completes TLS frame writes under backpressure, preventing

+71

;; truncated remote file and image transfers.

+72

(from-git url: "codeberg:sigil/sigil-websocket" package: "sigil-websocket" version: "^0.10.13")

+73

(from-git url: "codeberg:sigil/sigil" package: "sigil-wasm-net" version: ">=0.20")

74

;; sigil-wire: the binary value codec. The `node:` provider decodes the

75

;; daemon's bulk (0x10) frames — fs/read-dir listings + fs/read-file bodies

76

;; arrive as wire-encoded bytes on the node WS. Pure Scheme (no native/C),

77

;; so it links into the wasm bytecode build unchanged.

78

(from-git url: "codeberg:sigil/sigil-wire" package: "sigil-wire" version: "^0.1")

+79

;; Direct-carrier requests emit structured, secret-free route diagnostics.

+80

;; This is a production import of (sigil log), so the web linker must see

+81

;; the dependency directly rather than inheriting it from another workspace

+82

;; package that is not in the PWA closure.

+83

(from-git url: "codeberg:sigil/sigil-log" package: "sigil-log" version: "^0.17")

84

;; sigil-vt: the native VT/ANSI core. (slate term) is a thin façade over it

85

;; (the M2 cutover). Native library (int32[4] grid + C parser) — links into

86

;; both the native test harness and the wasm build (wasm-bridge).

@@ -89,8 +100,8 @@

100

(from-git url: "codeberg:sigil/sigil-doc" package: "sigil-doc" version: "^0.1.3"))

101

102

dev-dependencies: (list

−92

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: "^0.20")

−93

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: "^0.20"))

+103

(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: ">=0.20")

+104

(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: ">=0.20"))

105

106

tasks: (list

107

(task

@@ -100,6 +111,10 @@

111

(compile-sigil-modules

112

sources: "src/**/*.sgl")

113

(link-web-application

−103

name: "slate")

+114

name: "slate"

+115

;; Slate owns its complete PWA shell in assets/index.html. Without

+116

;; manual mode the linker also writes a generic index.html, racing

+117

;; copy-assets and making the final loading page nondeterministic.

+118

html: 'manual)

119

(copy-assets

120

source-dir: "assets")))))

packages/slate/scripts/deploy-pwa-r2.shmodified

@@ -190,7 +190,7 @@ count=0

190

# Deterministic order; upload slate.wasm and sw.js LAST so a visitor never sees

191

# a new shell pointing at not-yet-uploaded assets mid-deploy.

192

mapfile -t files < <(cd "$web_dir" \

−193

&& find . -type d -name native -prune -o -type f \

+193

&& find . -type d $ -name native -o -name .sigil-package-cache $ -prune -o -type f \

194

! -name '*.suspend' ! -name '*.o' ! -name '*.native-codegen.key' \

195

-printf '%P\n' \

196

| grep -vxE 'slate.wasm|sw.js' | sort; echo slate.wasm; echo sw.js)

packages/slate/sigil.lockmodified

@@ -2,28 +2,28 @@

2

(lock

3

(package name: "sigil-wasm-runtime"

4

url: "codeberg:sigil/sigil"

−5

ref: "^0.19"

−6

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+5

ref: "^0.20.3"

+6

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

7

package-selector: "sigil-wasm-runtime"

−8

version: "0.19.3")

+8

version: "0.20.3")

9

(package name: "sigil-lib"

10

url: "codeberg:sigil/sigil"

11

ref: "^0.19"

−12

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+12

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

13

package-selector: "sigil-lib"

−14

version: "0.19.3")

+14

version: "0.20.3")

15

(package name: "sigil-stdlib"

16

url: "codeberg:sigil/sigil"

−17

ref: "^0.19"

−18

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+17

ref: "^0.20.3"

+18

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

19

package-selector: "sigil-stdlib"

−20

version: "0.19.3")

+20

version: "0.20.3")

21

(package name: "sigil-format"

22

url: "codeberg:sigil/sigil"

−23

ref: "^0.19"

−24

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+23

ref: "^0.20.3"

+24

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

25

package-selector: "sigil-format"

−26

version: "0.19.3")

+26

version: "0.20.3")

27

(package name: "sigil-markdown"

28

url: "codeberg:sigil/sigil-markdown"

29

ref: "^0.9.1"

@@ -33,21 +33,21 @@

33

(package name: "sigil-web-client"

34

url: "codeberg:sigil/sigil-web-client"

35

ref: "^0.15.2"

−36

sha: "1b039fe62d7e51d70bee20b10830e9e064b2da01"

+36

sha: "0d608eff6a1ba2150ca3e35a1e79a7f0eea74a13"

37

package-selector: "sigil-web-client"

−38

version: "0.15.3")

+38

version: "0.15.4")

39

(package name: "sigil-wasm-dom"

40

url: "codeberg:sigil/sigil"

−41

ref: "^0.19"

−42

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+41

ref: "^0.20.3"

+42

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

43

package-selector: "sigil-wasm-dom"

−44

version: "0.19.3")

+44

version: "0.20.3")

45

(package name: "sigil-browser"

46

url: "codeberg:sigil/sigil"

−47

ref: "^0.19"

−48

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+47

ref: "^0.20.3"

+48

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

49

package-selector: "sigil-browser"

−50

version: "0.19.3")

+50

version: "0.20.3")

51

(package name: "enclave-rpc"

52

url: "codeberg:sigil/enclave"

53

ref: "^0.3"

@@ -68,16 +68,16 @@

68

version: "0.16.4")

69

(package name: "sigil-websocket"

70

url: "codeberg:sigil/sigil-websocket"

−71

ref: "^0.10.7"

−72

sha: "6c181e52c71a2838980fc376e1e062176ee9dd45"

+71

ref: "^0.10.8"

+72

sha: "be7e261e4dfe799821132a7fcde9cc5f46bfa706"

73

package-selector: "sigil-websocket"

−74

version: "0.10.7")

+74

version: "0.10.8")

75

(package name: "sigil-wasm-net"

76

url: "codeberg:sigil/sigil"

−77

ref: "^0.19"

−78

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+77

ref: "^0.20.3"

+78

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

79

package-selector: "sigil-wasm-net"

−80

version: "0.19.3")

+80

version: "0.20.3")

81

(package name: "sigil-wire"

82

url: "codeberg:sigil/sigil-wire"

83

ref: "^0.1"

@@ -98,16 +98,16 @@

98

version: "0.1.4")

99

(package name: "sigil-test"

100

url: "codeberg:sigil/sigil"

−101

ref: "^0.19"

−102

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+101

ref: "^0.20.3"

+102

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

103

package-selector: "sigil-test"

−104

version: "0.19.3")

+104

version: "0.20.3")

105

(package name: "sigil-test-runner"

106

url: "codeberg:sigil/sigil"

−107

ref: "^0.19"

−108

sha: "fe8ff55d07455c78796a7f172f18549ee771c7d8"

+107

ref: "^0.20.3"

+108

sha: "2e452e2f641fcf63be4e88a2748b34791543be8f"

109

package-selector: "sigil-test-runner"

−110

version: "0.19.3")

+110

version: "0.20.3")

111

(package name: "sigil-json"

112

url: "codeberg:sigil/sigil-json"

113

ref: "^0.16.0"

packages/slate/src/slate/accessory.sglmodified

@@ -37,12 +37,11 @@

37

;;; retires that JS shim).

38

39

(define-library (slate accessory)

−40

(import (sigil core)

−41

(sigil dict)

+40

(import (sigil dict)

41

(slate view)

42

(slate mode)

43

(slate components))

−45

(export accessory-bar resolve-actions actions-resolve action-resolve action-resolve-from action-trace->text

+44

  (export accessory-bar accessory-keyboard-deck resolve-actions actions-resolve action-resolve action-resolve-from action-trace->text

45

frame-categories spec->props

46

action-reference-valid?

47

tier-of sort-by-tier accessory-category-ids)

@@ -252,7 +251,9 @@

251

#{ id: 'hist-back label: "◀ Layout" command: "pane-history-back" tier: 'tertiary }

252

#{ id: 'hist-forward label: "Layout ▶" command: "pane-history-forward" tier: 'tertiary }

253

;; mirror the bar for the other thumb (design §5)

−255

#{ id: 'flip-thumb label: "⇄ Hand" command: "flip-thumb-side" tier: 'tertiary }) }))

+254

#{ id: 'flip-thumb label: "⇄ Hand" command: "flip-thumb-side" tier: 'tertiary }) }

+255

#{ id: 'help label: "Help" glyph: "?" tier: 'tertiary

+256

items: (list #{ id: 'key-bindings label: "Key Bindings" key: "C-?" tier: 'tertiary }) }))

257

258

;; ---- render: the two-row ribbon (design §4, basic form) ------------------

259

;; A category row (glyph-first chips; the active chip expands to glyph+label,

@@ -287,16 +288,19 @@

288

((dict-ref h command: #f) (list `(data-slate-hold-cmd ,(dict-ref h command: ""))))

289

(else '()))))

290

;; Action behavior is late-bound data. Re-registering a command must update

−290

;; every button that names it, so an item carries exactly one command name or

−291

;; key spec—not a captured procedure. The same rule applies to hold:.

+291

;; every button that names it, so an item carries exactly one command name,

+292

;; key spec, or host action. Host actions keep browser capabilities (such as

+293

;; clipboard writes) inside the originating user gesture.

294

(define (action-reference-valid? it)

295

(let* ((cmd (dict-ref it command: #f))

296

(key (dict-ref it key: #f))

+297

(host (dict-ref it host-action: #f))

298

(hold (dict-ref it hold: #f))

299

(hold-cmd (and hold (dict-ref hold command: #f)))

300

(hold-key (and hold (dict-ref hold key: #f))))

−298

(and (or (and (string? cmd) (not key))

−299

(and (string? key) (not cmd)))

+301

(and (or (and (string? cmd) (not key) (not host))

+302

(and (string? key) (not cmd) (not host))

+303

(and (string? host) (not cmd) (not key) (not hold)))

304

(or (not hold)

305

(and (dict? hold)

306

(or (and (string? hold-cmd) (not hold-key))

@@ -304,10 +308,13 @@

308

(define (action-btn it)

309

(let ((cmd (dict-ref it command: #f))

310

(key (dict-ref it key: #f))

+311

(host (dict-ref it host-action: #f))

312

(label (dict-ref it label: "")))

313

(unless (action-reference-valid? it)

−309

(error 'accessory "action behavior must be exactly one command: name or key: spec"))

+314

(error 'accessory "action behavior must be exactly one command:, key:, or host-action:"))

315

(cond

+316

(host `(button (@ (class ,(btn-class it)) (type "button")

+317

(data-slate-host-action ,host)) ,label))

318

(cmd `(div (@ (class ,(btn-class it)) (data-slate-click ,cmd) ,@(hold-attrs it)) ,label))

319

;; a repeat: item carries data-slate-repeat so the JS press-and-hold

320

;; auto-repeats it (design §13); the tap path is unchanged. hold: adds a

@@ -372,9 +379,9 @@

379

(let ((live? (or (not (eq? (dict-ref sticky ctrl: 'off) 'off))

380

(not (eq? (dict-ref sticky alt: 'off) 'off)))))

381

`(div (@ (class ,(string-append "acc-kbd-chip"

−375

(if open? " open" "")

382

(if live? " live" "")))

−377

(data-slate-click "acc-kbd-menu-toggle"))

+383

;; Direct OSK toggle: the fixed key deck replaced the popup.

+384

(data-kbd-toggle "1"))

385

"⌨")))

386

;; The directional cluster, to the RIGHT of [C]/[M] in the SAME row (David,

387

;; 2026-08-11: "directional keys to the right of those keys so that they can

@@ -430,6 +437,65 @@

437

(div (@ (class "acc-kbd-arrows"))

438

,@(map action-btn kbd-arrow-items)))))

439

+440

;; The keyboard deck is infrastructure, not an action category. Keep its

+441

;; complete two-row layout visible between the Ledge and system keyboard.

+442

(define accessory-key-row-1

+443

(list #{ label: "ESC" key: "Escape" }

+444

#{ label: "/" key: "/" }

+445

#{ label: "-" key: "-" }

+446

#{ label: "HOME" key: "Home" repeat: #t }

+447

#{ label: "↑" key: "ArrowUp" repeat: #t }

+448

#{ label: "END" key: "End" repeat: #t }

+449

#{ label: "PGUP" key: "PageUp" repeat: #t }))

+450

(define accessory-key-row-2

+451

(list #{ label: "TAB" key: "Tab" }

+452

#{ label: "CTRL" modifier: "ctrl" }

+453

#{ label: "ALT" modifier: "alt" }

+454

#{ label: "←" key: "ArrowLeft" repeat: #t }

+455

#{ label: "↓" key: "ArrowDown" repeat: #t }

+456

#{ label: "→" key: "ArrowRight" repeat: #t }

+457

#{ label: "PGDN" key: "PageDown" repeat: #t }))

+458

(define (accessory-key-button it sticky)

+459

(let ((mod (dict-ref it modifier: #f)))

+460

(if mod

+461

`(div (@ (class ,(string-append "term-key term-key-mod "

+462

(symbol->string

+463

(dict-ref sticky

+464

(if (string=? mod "ctrl") ctrl: alt:) 'off))))

+465

(data-slate-click ,(string-append "sticky-mod:" mod)))

+466

,(dict-ref it label: ""))

+467

`(div (@ (class "term-key")

+468

(data-slate-key ,(dict-ref it key: ""))

+469

,@(if (dict-ref it repeat: #f) '((data-slate-repeat "1")) '()))

+470

,(dict-ref it label: "")))))

+471

(define (accessory-keyboard-deck v sticky . compose-target)

+472

(if v

+473

`(div (@ (class "accessory-key-deck") (key "accessory-key-deck")

+474

(data-compose-target ,(if (pair? compose-target) (or (car compose-target) "") "")))

+475

(div (@ (class "terminal-key-page") (key "keys"))

+476

(div (@ (class "terminal-key-rows"))

+477

(div (@ (class "terminal-key-row"))

+478

,@(map (lambda (it) (accessory-key-button it sticky)) accessory-key-row-1))

+479

(div (@ (class "terminal-key-row"))

+480

,@(map (lambda (it) (accessory-key-button it sticky)) accessory-key-row-2))))

+481

(div (@ (class "terminal-compose-page") (key "compose"))

+482

(button (@ (class "terminal-compose-back") (type "button")

+483

(aria-label "Show terminal keys")) "❮")

+484

;; The browser owns this draft and its IME selection. Never

+485

;; render a value: unrelated output must not rewrite it.

+486

(textarea (@ (class "terminal-compose-input") (key "terminal-compose-input")

+487

(rows "2") (aria-label "Compose terminal text")

+488

(placeholder "Compose text… Enter sends text only")

+489

(autocorrect "on") (autocapitalize "sentences")

+490

(autocomplete "off") (spellcheck "true")

+491

(enterkeyhint "send")))

+492

(button (@ (class "terminal-compose-send") (type "button")

+493

(aria-label "Send text without Enter")) "Send")

+494

(div (@ (class "terminal-compose-history") (key "history")

+495

(role "group") (aria-label "Recent terminal text") (hidden "hidden")))

+496

(span (@ (class "terminal-compose-status") (role "status")))))

+497

""))

+498

499

(define (bar-class active? thumb-side)

500

(string-append "accessory-bar"

501

(if active? "" " collapsed")

@@ -448,16 +514,24 @@

514

(let ((active (find-active cats active-cat)))

515

`(div (@ (class ,(bar-class active thumb-side)))

516

;; the ⌨ menu popover (when open) floats above the bar.

−451

,@(if kbd-menu-open? (list (kbd-menu sticky)) '())

+517

;; The fixed deck below the Ledge replaces the old

+518

;; floating keyboard/modifier popover.

519

,@(if active

−453

(list `(div (@ (class "acc-actions"))

−454

,@(map action-btn (sort-by-tier (dict-ref active items: '())))))

+520

(list `(div (@ (class "acc-actions")

+521

(key ,(string-append "acc-actions-" (symbol->string (cat-id active))))

+522

(data-accessory-category ,(symbol->string (cat-id active))))

+523

,@(map action-btn (sort-by-tier (dict-ref active items: '())))

+524

;; Explicit browser-owned status slot: an

+525

;; unmanaged sibling can outlive this row

+526

;; when the menu collapses or changes.

+527

(span (@ (class "acc-host-status") (key "host-status")

+528

(role "status")))))

529

'())

530

;; category row: the ⌨ chip (pinned thumb-near — opens the

531

;; keyboard/sticky menu), the category chips, then the view

532

;; switcher pinned at the thumb-FAR end (§6 + §8).

−459

(div (@ (class "acc-cats"))

−460

,(kbd-chip sticky kbd-menu-open?)

+533

(div (@ (class "acc-cats") (key "acc-cats"))

+534

,(kbd-chip sticky #f)

535

,@(map (lambda (c)

536

(cat-chip c (and active (eq? (cat-id c) (cat-id active)))))

537

cats)

packages/slate/src/slate/agent/remote.sglmodified

@@ -2,10 +2,18 @@

2

;;; One stream per node multiplexes requests and live subscriptions.

3

(define-library (slate agent remote)

4

(import (sigil io) (sigil json) (sigil websocket) (sigil time)

−5

(slate providers enclave-node) (slate enclave-account session))

+5

(slate enclave-account session))

6

(export agent-remote-request! agent-remote-poll! agent-remote-on-event!

−7

agent-remote-ready? agent-remote-reset!)

+7

agent-remote-ready? agent-remote-reset! agent-remote-configure!)

8

(begin

+9

;; The Enclave provider also uses the local node provider. Inject its

+10

;; ticket transport to avoid node -> agent -> Enclave -> node imports.

+11

(define *ticket-request*

+12

(lambda (host ready failed) (failed "Agent transport is not configured")))

+13

(define *retry-delay* (lambda (attempt) 1000))

+14

(define (agent-remote-configure! ticket-request retry-delay)

+15

(set! *ticket-request* ticket-request)

+16

(set! *retry-delay* retry-delay))

17

(define *nodes* #{})

18

(define *next-id* 0)

19

(define *account-generation* #f)

@@ -31,7 +39,7 @@

39

;; waiting for data. Its next connection must refresh those views.

40

(vector-set! node 7 #t)

41

(vector-set! node 5 (+ (current-second)

−34

(/ (reattach-backoff-ms (vector-ref node 6)) 1000)))

+42

(/ (*retry-delay* (vector-ref node 6)) 1000)))

43

(vector-set! node 6 (+ 1 (vector-ref node 6)))

44

(when ws (ws-close ws))

45

(for-each

@@ -51,7 +59,7 @@

59

(vector-set! node 2 'ticket)

60

(vector-set! node 8 (current-second))

61

(let ((generation (vector-ref node 11)))

−54

(enclave-node-stream-ticket! host

+62

(*ticket-request* host

63

(lambda (ticket url)

64

(when (and (eq? node (dict-ref *nodes* host #f))

65

(= generation (vector-ref node 11))

packages/slate/src/slate/bindings.sglmodified

@@ -52,6 +52,7 @@

52

;; C-c to interrupt, …). That is the correct split.

53

"C-c" #{}

54

"C-x" #{ "3" "split-right"

+55

"g" "git-status"

56

"2" "split-down"

57

"1" "delete-other-windows"

58

"o" "other-pane"

packages/slate/src/slate/boot.sglmodified

@@ -153,6 +153,10 @@

153

;; terminal: on a tmux-less node the ladder returns a marked downgrade

154

;; carrying a sentence, and every caller renders it.

155

slate/terminals-use-tmux: #t

+156

slate/terminal-predictive-echo: #f

+157

;; Client-side Screen Wake Lock intent. Off by default; the browser

+158

;; bridge acquires it only while this document is visible.

+159

slate/keep-screen-awake: #f

160

;; Focus-follows-mouse: hovering a pane focuses it. Global toggle, default

161

;; ON (desktop); the JS hover handler no-ops on touch. Persisted + boot-

162

;; restored; init.sgl-settable.

@@ -180,11 +184,13 @@

184

slate/face-overrides: #{}

185

slate/echo: "ready"

186

;; Echo lifecycle (slate-ux-sweep #2): echo messages auto-clear + fade.

−183

;; slate/echo-age counts slate-echo-tick ticks since the current message

−184

;; was written (with-echo resets it to 0); slate/echo-fading? flags the

−185

;; ledge-echo to run its CSS fade-out animation once the linger elapses.

+187

;; Legacy lifecycle fields remain in the state shape for init/state

+188

;; compatibility; the browser now owns dismissal with one CSS animation.

189

slate/echo-age: 0

190

slate/echo-fading?: #f

+191

;; Monotonic identity for the host-owned echo dismissal animation.

+192

;; Repeating the same text still restarts its full visible lifetime.

+193

slate/echo-generation: 0

194

;; The Ledge is DATA: a LIST of ledge-item records projected into the

195

;; bottom strip (mirrors Emacs's mode-line-format-as-a-list). The

196

;; built-ins (space chip, echo, clock, ≡ glyph, connection dot) are just

packages/slate/src/slate/commands/appearance.sglmodified

@@ -140,6 +140,10 @@

140

(lambda (s) (toggle s slate/translucent: #f "transparency ")))

141

(exact "terminals-use-tmux:toggle" "Terminal: Toggle Tmux"

142

"toggle tmux for newly opened terminals" tmux-toggle)

+143

(exact "terminal-predictive-echo:toggle" "Terminal: Toggle Predictive Echo"

+144

"preview simple typing while waiting for terminal output"

+145

(lambda (s) (toggle s slate/terminal-predictive-echo: #f

+146

"terminal predictive echo ")))

147

(exact "opacity:dec" "Content Opacity: Decrease" "more see-through"

148

(lambda (s) (amount-adjust s "dec" slate/opacity: 10 100 5

149

(content-opacity s) "content opacity" "%")))

packages/slate/src/slate/commands/folder.sglmodified

@@ -1,8 +1,9 @@

1

;;; (slate commands folder) — folder navigation, marking, and provider operations.

2

(define-library (slate commands folder)

−3

(import (sigil core) (slate command) (slate findfile) (slate foldernav) (slate modes folder)

−4

(slate list) (slate prompt) (slate prompt candidates)

−5

(slate provider) (slate providers slate-meta) (slate root) (slate space)

+3

(import (slate command) (slate findfile) (slate foldernav) (slate modes folder)

+4

(slate list) (slate pane) (slate prompt) (slate prompt candidates)

+5

(slate provider) (slate providers localstorage) (slate providers slate-meta)

+6

(slate root) (slate space)

7

(slate state) (slate view))

8

(export install-folder-commands! configure-folder-commands! kickoff-folder-load!

9

open-folder-reusing)

@@ -53,21 +54,47 @@

54

k))

55

"folder-pattern" (list "folder-pattern")))

56

+57

(define *folder-loads* '())

58

(define (kickoff-folder-load! source view-name)

59

(let ((async-op (provider-async-op source)))

60

(when async-op

−59

(async-op source

−60

(lambda (entries)

−61

((required set-state:) (update-view ((required state:)) view-name

−62

(lambda (v) (if (folder? v) (folder-set-entries v entries) v))))

−63

((required refresh:)))

−64

(lambda (err)

−65

((required set-state:) (with-echo ((required state:)) "folder load failed"))

−66

((required refresh:)))))))

+61

(let* ((ticket (vector #t))

+62

(pending? (lambda ()

+63

(let ((found (assoc view-name *folder-loads*)))

+64

(and found (eq? (cdr found) ticket)))))

+65

(forget! (lambda ()

+66

(set! *folder-loads*

+67

(filter (lambda (pair) (not (string=? (car pair) view-name)))

+68

*folder-loads*)))))

+69

(forget!)

+70

(set! *folder-loads* (cons (cons view-name ticket) *folder-loads*))

+71

(async-op source

+72

(lambda (entries)

+73

(when (pending?)

+74

(forget!)

+75

((required set-state:)

+76

(update-view ((required state:)) view-name

+77

(lambda (v)

+78

(if (and (folder? v) (equal? source (view-source v)))

+79

(folder-set-entries v entries) v))))

+80

((required refresh:))))

+81

(lambda (err)

+82

(when (pending?)

+83

(forget!)

+84

((required set-state:)

+85

(with-echo

+86

(update-view ((required state:)) view-name

+87

(lambda (v)

+88

(when (and (folder? v) (equal? source (view-source v)))

+89

(folder-detail-set! v load-error: #t))

+90

v))

+91

"folder load failed"))

+92

((required refresh:)))))))))

93

94

(define (open-folder-reusing state from-view source keep?)

−69

(let* ((opened ((required open-source:) state source))

−70

(new-name (source-root-display-name source))

+95

(let* ((new-name (source-root-display-name source))

+96

(opened (update-view ((required open-source:) state source) new-name

+97

(lambda (v) (folder-inherit-settings from-view v))))

98

(from-folder? (and from-view (folder? from-view) #t)))

99

(if (and from-folder?

100

(reuse-drops-from?

@@ -207,7 +234,7 @@

234

(begin (ff-cache-reset!)

235

((required drill-query:)

236

(dict-set state slate/findfile-provider: (view-fs-provider state))

−210

"findfolder" (view-default-directory state)))))

+237

"findfolder" (dir-path (view-default-directory state))))))

238

239

(define (folder-mark-pattern-command state)

240

(let ((view (active-view state)))

@@ -267,11 +294,12 @@

294

295

(define (folder-open-index-command state suffix)

296

(let ((index (string->number suffix)) (view (active-view state)))

−270

(if (and (folder? view) index)

+297

(if (and (folder? view) (integer? index) (>= index 0)

+298

(< index (folder-count view)))

299

(let* ((moved (folder-set-point view index))

300

(next (update-active state (lambda (_) moved)))

301

(entry (folder-entry-at moved)))

−274

(if entry ((required open-source:) next (folder-child-source moved entry)) next))

+302

(if entry (folder-open-entry-command next) next))

303

state)))

304

305

(define (folder-rename-command state)

@@ -351,7 +379,41 @@

379

(when (= remaining 0) (all-error failed))))) sources))

380

(if (= (length sources) 1) "restored entry" "restored marked entries"))))))

381

+382

(define (folder-select-index-command state suffix)

+383

(let ((index (string->number suffix)))

+384

(if (and (integer? index) (>= index 0))

+385

(on-folder state (lambda (v) (folder-set-point v index)))

+386

state)))

+387

+388

(define (folder-mark-index-command state suffix)

+389

(let* ((index (string->number suffix))

+390

(v (active-view state)))

+391

(if (not (and (folder? v) (integer? index) (>= index 0)

+392

(< index (folder-count v))))

+393

state

+394

(on-folder state

+395

(lambda (v)

+396

(let* ((point (folder-point v))

+397

(at (folder-set-point v index))

+398

(marked? (folder-marked? at (folder-entry-at at))))

+399

(folder-set-point (if marked? (folder-unmark at) (folder-mark at)) point)))))))

+400

401

(define (install-folder-commands!)

+402

(for-each

+403

(lambda (entry)

+404

(exact (car entry) (cadr entry) (cadr entry)

+405

(lambda (state) (on-folder state (caddr entry)))))

+406

(list (list "folder-preview" "Folder: Toggle Preview" folder-toggle-preview)

+407

(list "folder-hidden" "Folder: Hidden" folder-toggle-hidden)

+408

(list "folder-compact" "Folder: Compact Rows" folder-toggle-compact)

+409

(list "folder-sort-name" "Folder: Sort by Name" (lambda (v) (folder-set-sort v name:)))

+410

(list "folder-sort-size" "Folder: Sort by Size" (lambda (v) (folder-set-sort v size:)))

+411

(list "folder-sort-newest" "Folder: Most Recently Modified" (lambda (v) (folder-set-sort v newest:)))

+412

(list "folder-sort-oldest" "Folder: Least Recently Modified" (lambda (v) (folder-set-sort v oldest:)))))

+413

(install-builtin-command-family! "folder-select-index:" "select a directory entry"

+414

source-module folder-select-index-command)

+415

(install-builtin-command-family! "folder-mark-index:" "toggle an entry mark"

+416

source-module folder-mark-index-command)

417

(exact "open-folder" "Folder: Open" "open a folder" open-folder-command)

418

(exact "folder-next" "Folder: Next" "select next entry" (lambda (s) (on-folder s (lambda (v) (folder-move v 1)))))

419

      (exact "folder-prev" "Folder: Previous" "select previous entry" (lambda (s) (on-folder s (lambda (v) (folder-move v -1)))))

packages/slate/src/slate/commands/git.sgladded

@@ -0,0 +1,629 @@

+1

;;; (slate commands git) — commands shared by Git status keys and controls.

+2

(define-library (slate commands git)

+3

(import (sigil core) (sigil string)

+4

(slate command) (slate commands git branch) (slate commands project) (slate components diff) (slate git model)

+5

(slate git status-view) (slate git review) (slate git diff-model) (slate git diff-view)

+6

(slate git log-model) (slate git log-view)

+7

(slate extend) (slate mode) (slate state) (slate view))

+8

(export install-git-commands! configure-git-commands!)

+9

(begin

+10

(define source-module '(slate commands git))

+11

(define *ops* #{})

+12

(define (op key) (or (dict-ref *ops* key #f) (error 'git-command "Git command op is not configured")))

+13

(define (configure-git-commands! ops)

+14

(set! *ops* ops)

+15

(configure-git-branch-commands! ops)

+16

#t)

+17

(define (status-view? v) (and v (git-status-model v) #t))

+18

(define (diff-view? v) (and v (git-diff-model v) #t))

+19

(define (git-view? v) (or (status-view? v) (diff-view? v)))

+20

(define (make-status-view source model)

+21

(let* ((desc (mode-descriptor 'git-status-mode))

+22

(ctor (and (dict? desc) (dict-ref desc ctor: #f))))

+23

(if ctor

+24

(ctor slate/name: (git-status-view-name source)

+25

slate/source: source slate/git-model: model

+26

slate/git-row-cache: (make-git-status-row-cache)

+27

slate/git-selected: #f

+28

slate/git-folded: (list "section:recent-commits")

+29

slate/git-inline-models: '() slate/git-hunk-folded: '())

+30

(error 'git-status "Git status mode is not installed"))))

+31

(define (make-diff-view source model name commit)

+32

(let* ((desc (mode-descriptor 'git-diff-mode))

+33

(ctor (and (dict? desc) (dict-ref desc ctor: #f))))

+34

(if ctor

+35

(ctor slate/name: name slate/source: source

+36

slate/git-diff-model: model slate/git-selected: #f

+37

slate/git-commit: commit)

+38

(error 'git-diff "Git diff mode is not installed"))))

+39

(define (log-view? v) (and v (git-log-model v) #t))

+40

(define (open-log state)

+41

(let* ((v (active-view state))

+42

(repo (cond ((status-view? v)

+43

(dict-ref (dict-ref (git-status-model-state (git-status-model v)) data: #{}) repo: #f))

+44

((diff-view? v) (git-diff-model-repo (git-diff-model v)))

+45

(else #f)))

+46

(name (and repo (git-log-view-name repo))))

+47

(if (not name) state

+48

(if (find-view (views state) name) (focus-view state name)

+49

(let* ((source (view-source v))

+50

(model (make-git-log-model source repo (lambda (ignored) ((op refresh:)))))

+51

(desc (mode-descriptor 'git-log-mode))

+52

(ctor (and (dict? desc) (dict-ref desc ctor: #f)))

+53

(next (ensure-view state name

+54

(lambda () (ctor slate/name: name slate/source: source

+55

slate/git-log-model: model slate/git-selected: #f

+56

slate/git-return-view: (view-name v))))))

+57

((op set-state:) next)

+58

(git-log-model-load! model)

+59

((op state:)))))))

+60

(define (on-log state fn)

+61

(let ((v (active-view state)))

+62

(if (log-view? v) (fn state v (git-log-model v)) state)))

+63

(define (log-focus state region)

+64

(on-log state (lambda (state v model)

+65

(update-active state (lambda (v) (dict-set v slate/git-log-focus: region))))))

+66

(define (log-scroll amount)

+67

(lambda (state)

+68

(on-log state

+69

(lambda (state v model)

+70

(if (eq? (dict-ref v slate/git-log-focus: 'list) 'review)

+71

(update-active state

+72

(lambda (v)

+73

(dict-set (dict-set v slate/git-log-scroll: amount)

+74

slate/git-log-scroll-revision:

+75

(+ 1 (dict-ref v slate/git-log-scroll-revision: 0)))))

+76

state)))))

+77

(define (log-move delta)

+78

(lambda (state)

+79

(on-log state

+80

(lambda (state v model)

+81

(if (eq? (dict-ref v slate/git-log-focus: 'list) 'review)

+82

((log-scroll (if (> delta 0) "line-down" "line-up")) state)

+83

(update-active state (lambda (v) (git-log-move v delta))))))))

+84

(define (log-select state oid)

+85

(on-log state (lambda (state v model)

+86

(if (find (lambda (commit) (equal? oid (dict-ref commit oid: #f)))

+87

(git-log-commits model))

+88

(update-active state (lambda (v) (dict-set v slate/git-selected: oid)))

+89

state))))

+90

(define (log-load! model oid)

+91

;; Moving focus or clicking the current commit must retain its patch and

+92

;; scroll position. An explicit retry still works after either load fails.

+93

(let* ((review (or (dict-ref (git-log-model-state model) review: #f) #{}))

+94

(diff (dict-ref review diff: #f)))

+95

(unless (and (equal? oid (dict-ref review oid: #f))

+96

(not (eq? (dict-ref review state: #f) error:))

+97

(not (and diff (eq? (dict-ref (git-diff-model-state diff) state: #f) error:))))

+98

(git-log-model-inspect! model oid))))

+99

(define (log-open state oid)

+100

(on-log state

+101

(lambda (state v model)

+102

(if (find (lambda (commit) (equal? oid (dict-ref commit oid: #f)))

+103

(git-log-commits model))

+104

(begin

+105

(log-load! model oid)

+106

(log-focus (log-select state oid) 'list))

+107

state))))

+108

(define (log-inspect-oid state oid)

+109

(on-log state (lambda (state v model)

+110

(log-load! model oid) (log-focus state 'review))))

+111

(define (log-inspect state)

+112

(on-log state (lambda (state v model)

+113

(let ((commit (git-log-selected v)))

+114

(when commit (log-load! model (dict-ref commit oid: #f))))

+115

(log-focus state 'review))))

+116

(define (log-switch-pane state)

+117

(on-log state

+118

(lambda (state v model)

+119

(if (eq? (dict-ref v slate/git-log-focus: 'list) 'review)

+120

(log-focus state 'list)

+121

(log-inspect state)))))

+122

(define (log-page direction)

+123

(lambda (state)

+124

(on-log state (lambda (state v model)

+125

(git-log-model-page! model direction) (log-focus state 'list)))))

+126

(define (log-refresh state)

+127

(on-log state (lambda (state v model) (unless (eq? (dict-ref (git-log-model-state model) state: #f) loading:)

+128

(git-log-model-load! model)) state)))

+129

(define (log-copy review?)

+130

(lambda (state)

+131

(on-log state

+132

(lambda (state v model)

+133

(let* ((review (dict-ref (git-log-model-state model) review: #f))

+134

(commit (if review? (and review (dict-ref review commit: #f)) (git-log-selected v)))

+135

(oid (and commit (dict-ref commit oid: #f))))

+136

(if oid (dict-set (dict-set state slate/kill: oid) slate/clip-stage: oid) state))))))

+137

(define (log-diff-more state)

+138

(on-log state (lambda (state v model)

+139

(let* ((review (dict-ref (git-log-model-state model) review: #f))

+140

(diff (and review (dict-ref review diff: #f))))

+141

(when diff (git-diff-model-more! diff))) state)))

+142

(define (log-quit state)

+143

(on-log state (lambda (state v model)

+144

(git-log-model-dispose! model)

+145

(let* ((name (dict-ref v slate/git-return-view: #f))

+146

(next ((op close-view:) state)))

+147

(if (and name (find-view (views next) name))

+148

(focus-view next name) next)))))

+149

(define (on-git state fn) (update-active state (lambda (v) (if (git-view? v) (fn v) v))))

+150

+151

;; Discovery is asynchronous, so the loading shell initially has a

+152

;; source-qualified provisional name. As soon as the node supplies its

+153

;; canonical repository identity, rename that shell or discard it in favor

+154

;; of the already-open canonical view. The model object is the stable

+155

;; handle across that rename.

+156

(define (view-for-model state model)

+157

(let loop ((rest (views state)))

+158

(cond ((null? rest) #f)

+159

((eq? (git-status-model (car rest)) model) (car rest))

+160

(else (loop (cdr rest))))))

+161

(define (canonicalize-view state model data)

+162

(let* ((current (view-for-model state model))

+163

(old-name (and current (view-name current)))

+164

(name (git-status-repository-view-name (dict-ref data repo: #{})))

+165

(existing (and name (find-view (views state) name))))

+166

(cond ((or (not current) (not name) (string=? old-name name)) state)

+167

(existing

+168

(focus-view

+169

(dict-set state slate/views:

+170

(filter (lambda (v) (not (eq? (git-status-model v) model))) (views state)))

+171

name))

+172

(else

+173

(focus-view

+174

(update-view state old-name (lambda (v) (dict-set v slate/name: name)))

+175

name)))))

+176

+177

(define (selected-owner v)

+178

(let ((row (git-status-selected-row v)))

+179

(and row (dict-ref row owner:

+180

(and (eq? (dict-ref row kind: #f) entry:) (dict-ref row id: #f))))))

+181

(define (resume-selected! v)

+182

(let ((model (inline-model v (selected-owner v))))

+183

(when model (git-diff-model-resume! model)))

+184

v)

+185

(define (accept-status! model data mutated? changed-id)

+186

(let* ((state ((op state:)))

+187

(v (view-for-model state model)))

+188

(when v

+189

(let* ((old-data (dict-ref v slate/git-data: #{}))

+190

(changed (find (lambda (entry) (equal? changed-id (dict-ref entry id: #f)))

+191

(as-list (dict-ref old-data entries: '()))))

+192

(path (and changed (entry-path changed)))

+193

(next (git-review-status v data))

+194

(models (dict-ref next slate/git-inline-models: '()))

+195

(repo (dict-ref data repo: #{}))

+196

(snapshot (dict-ref data snapshot: #{})))

+197

;; Publish new identities before diff listeners run. A closed

+198

;; review must never be resurrected by a late page.

+199

((op set-state:)

+200

(canonicalize-view

+201

(update-view state (view-name v) (lambda (ignored) next)) model data))

+202

(for-each

+203

(lambda (pair)

+204

(unless (assoc (car pair) models)

+205

(git-diff-model-invalidate! (cdr pair))))

+206

(dict-ref v slate/git-inline-models: '()))

+207

(for-each

+208

(lambda (pair)

+209

(let ((diff (cdr pair)))

+210

(when (or (not mutated?)

+211

(not (git-snapshot=? (git-diff-model-snapshot diff) snapshot)))

+212

(git-diff-model-defer! diff repo snapshot)

+213

(when (or (not mutated?)

+214

(equal? path (git-diff-model-target diff))

+215

(equal? (car pair) (selected-owner next)))

+216

(git-diff-model-resume! diff)))))

+217

models)))))

+218

(define (inline-listener status-model id diff)

+219

(let ((previous (git-diff-model-state diff)))

+220

(lambda (state)

+221

(let ((old previous)

+222

(v (view-for-model ((op state:)) status-model)))

+223

(set! previous state)

+224

(when (and v (eq? diff (inline-model v id)))

+225

(when (and (eq? (dict-ref state state: #f) ready:)

+226

(pair? (dict-ref old pages: '())))

+227

((op set-state:)

+228

(update-view ((op state:)) (view-name v)

+229

(lambda (current) (git-review-diff current id old)))))

+230

((op refresh:)))))))

+231

+232

(define (load-view! source name model)

+233

(git-status-model-load! model source (current-project ((op state:))))

+234

((op refresh:))

+235

#t)

+236

(define (open-status state)

+237

(let* ((source (view-source (active-view state)))

+238

(name (and source (git-status-view-name source))))

+239

(if (not name) state

+240

(let ((existing (find-view (views state) name)))

+241

(if existing

+242

(begin (git-status-model-refresh! (git-status-model existing) source (current-project state))

+243

(focus-view state name))

+244

(letrec ((model (make-git-status-model

+245

(lambda (model-state)

+246

;; A pending mutation still contains the old

+247

;; authoritative snapshot. Rendering it makes

+248

;; the diff flash unchanged before the mutation

+249

;; response arrives, which looks like a failed

+250

;; stage/unstage followed by a second refresh.

+251

;; Keep the current frame intact until the node

+252

;; returns either fresh status or an error.

+253

(unless (eq? (dict-ref model-state mutation: #f) pending:)

+254

(when (eq? (dict-ref model-state state: #f) ready:)

+255

(let ((data (dict-ref model-state data: #{})))

+256

(accept-status! model data

+257

(eq? (dict-ref model-state mutation: #f) complete:)

+258

(dict-ref model-state changed-entry: #f))

+259

(git-status-model-watch! model source

+260

(current-project ((op state:)))

+261

(dict-ref data repo: #{}))))

+262

((op refresh:)))))))

+263

(let ((next (ensure-view state name (lambda () (make-status-view source model)))))

+264

((op set-state:) next)

+265

(load-view! source name model)

+266

((op state:)))))))))

+267

(define (move delta)

+268

(lambda (state)

+269

(on-git state (lambda (v) (if (diff-view? v) (git-diff-move v delta)

+270

(resume-selected! (git-status-move v delta)))))))

+271

(define (inline-model v id)

+272

(let ((found (assoc id (dict-ref v slate/git-inline-models: '()))))

+273

(and found (cdr found))))

+274

(define (row-by-id v id)

+275

(let loop ((rows (git-status-rows v)))

+276

(cond ((null? rows) #f)

+277

((string=? id (dict-ref (car rows) id: "")) (car rows))

+278

(else (loop (cdr rows))))))

+279

(define (remove-inline models id)

+280

(filter (lambda (pair) (not (string=? (car pair) id))) models))

+281

(define (toggle state)

+282

(on-git state

+283

(lambda (v)

+284

(if (not (status-view? v)) v

+285

(let* ((row (git-status-selected-row v)) (kind (and row (dict-ref row kind: #f))))

+286

(cond

+287

((eq? kind section:) (git-status-toggle v))

+288

((diff-kind=? (diff-row-kind row) hunk:)

+289

(let* ((id (dict-ref row id: ""))

+290

(folded (dict-ref v slate/git-hunk-folded: '())))

+291

(dict-set v slate/git-hunk-folded:

+292

(if (member id folded)

+293

(filter (lambda (x) (not (string=? x id))) folded)

+294

(cons id folded)))))

+295

((eq? kind entry:)

+296

(let* ((id (dict-ref row id: ""))

+297

(models (dict-ref v slate/git-inline-models: '()))

+298

(existing (inline-model v id)))

+299

(if existing

+300

(begin (git-diff-model-invalidate! existing)

+301

(dict-set v slate/git-inline-models: (remove-inline models id)))

+302

(let ((spec (diff-spec v row)))

+303

(letrec ((model (make-git-diff-model (view-source v)

+304

(dict-ref spec repo: #{}) (dict-ref spec snapshot: #{})

+305

(dict-ref spec kind: "worktree") (dict-ref spec target: #f)

+306

(lambda (state) (listener state))))

+307

(listener (inline-listener (git-status-model v) id model)))

+308

(git-diff-model-load! model)

+309

(dict-set v slate/git-inline-models: (cons (cons id model) models)))))))

+310

(else v)))))))

+311

(define (refresh state)

+312

(let ((v (active-view state)))

+313

(if (status-view? v)

+314

(begin

+315

(git-status-model-refresh! (git-status-model v) (view-source v) (current-project state)) state)

+316

state)))

+317

(define (select state suffix)

+318

(on-git state (lambda (v)

+319

(let ((next (dict-set v slate/git-selected: suffix)))

+320

(if (status-view? next) (resume-selected! next) next)))))

+321

(define (set-layout state suffix)

+322

(if (not (member suffix '("auto" "inline" "split"))) state

+323

(let ((layout (string->symbol suffix)))

+324

(set-option! slate/git-layout: layout)

+325

(dict-set state slate/git-layout: layout))))

+326

(define (cycle-layout state)

+327

(let ((layout (dict-ref state slate/git-layout: 'auto)))

+328

(set-layout state

+329

(cond ((eq? layout 'auto) "inline")

+330

((eq? layout 'inline) "split")

+331

(else "auto")))))

+332

(define (select-toggle state suffix)

+333

(toggle (select state suffix)))

+334

(define (diff-spec v row)

+335

(let* ((state (git-status-model-state (git-status-model v)))

+336

(data (dict-ref state data: #{}))

+337

(repo (dict-ref data repo: #{})) (snapshot (dict-ref data snapshot: #{}))

+338

(row-kind (dict-ref row kind: #f)))

+339

(cond

+340

((eq? row-kind entry:)

+341

(let* ((entry (dict-ref row entry: #{}) )

+342

(section (dict-ref row section: unstaged:)))

+343

#{ repo: repo snapshot: snapshot

+344

kind: (cond ((eq? section staged:) "staged")

+345

((eq? section untracked:) "untracked")

+346

(else "worktree"))

+347

target: (dict-ref entry path: #f) }))

+348

((and (eq? row-kind section:) (eq? (dict-ref row section: #f) staged:))

+349

#{ repo: repo snapshot: snapshot kind: "staged" target: #f })

+350

((eq? row-kind commit:)

+351

#{ repo: repo snapshot: snapshot kind: "commit"

+352

target: (dict-ref (dict-ref row commit: #{}) oid: #f) })

+353

(else #f))))

+354

(define (open-diff state)

+355

(let* ((v (active-view state))

+356

(row (and (status-view? v) (git-status-selected-row v)))

+357

(spec (and row (diff-spec v row))))

+358

(if (not spec) state

+359

(let* ((source (view-source v))

+360

(repo (dict-ref spec repo: #{}))

+361

(kind (dict-ref spec kind: "worktree"))

+362

(target (dict-ref spec target: #f))

+363

(commit (and (eq? (dict-ref row kind: #f) commit:)

+364

(dict-ref row commit: #f)))

+365

(name (git-diff-view-name repo kind target))

+366

(existing (and name (find-view (views state) name))))

+367

(if existing

+368

(focus-view state name)

+369

(letrec ((model (make-git-diff-model source repo (dict-ref spec snapshot: #{})

+370

kind target

+371

(lambda (ignored) ((op refresh:))))))

+372

(let ((next (ensure-view state name (lambda () (make-diff-view source model name commit)))))

+373

((op set-state:) next)

+374

(git-diff-model-load! model)

+375

((op state:)))))))))

+376

(define (open-conflict-stage stage)

+377

(lambda (state suffix)

+378

(let* ((v (active-view state)) (row (and (status-view? v) (row-by-id v suffix)))

+379

(entry (and row (dict-ref row entry: #f)))

+380

(data (and v (dict-ref (git-status-model-state (git-status-model v)) data: #{})))

+381

(repo (and data (dict-ref data repo: #{})))

+382

(snapshot (and data (dict-ref data snapshot: #{})))

+383

(path (and entry (entry-path entry))))

+384

(if (not path) state

+385

(let* ((target #{ path: path stage: stage })

+386

(name (git-diff-view-name repo "conflict-stage" target))

+387

(model (make-git-diff-model (view-source v) repo snapshot

+388

"conflict-stage" target (lambda (ignored) ((op refresh:)))))

+389

(next (ensure-view state name (lambda () (make-diff-view (view-source v) model name #f)))))

+390

((op set-state:) next) (git-diff-model-load! model) ((op state:)))))))

+391

(define (diff-more state)

+392

(let ((v (active-view state)))

+393

(when (diff-view? v) (git-diff-model-more! (git-diff-model v))) state))

+394

(define (inline-more state suffix)

+395

(let ((v (active-view state)))

+396

(when (status-view? v)

+397

(let ((model (inline-model v suffix))) (when model (git-diff-model-more! model))))

+398

state))

+399

(define (inline-refresh state suffix)

+400

(let* ((v (active-view state))

+401

(model (and (status-view? v) (inline-model v suffix))))

+402

(when model

+403

(let ((data (dict-ref (git-status-model-state (git-status-model v)) data: #{})))

+404

(git-diff-model-reload! model (dict-ref data repo: #{})

+405

(dict-ref data snapshot: #{}))))

+406

state))

+407

(define (diff-refresh state)

+408

(let ((v (active-view state)))

+409

(when (diff-view? v) (git-diff-model-load! (git-diff-model v))) state))

+410

(define (visit state)

+411

(let* ((v (active-view state))

+412

(row (cond ((status-view? v) (git-status-selected-row v))

+413

((diff-view? v) (git-diff-selected-row v))

+414

(else #f))))

+415

(cond ((diff-view? v)

+416

(let* ((line (git-diff-selected-row v))

+417

(model (git-diff-model v))

+418

(path (git-diff-model-target model))

+419

(repo (git-diff-model-repo model))

+420

(source (git-diff-model-source model)))

+421

(if (and line path (not (string=? (git-diff-model-kind model) "commit")))

+422

((op open-source:) state

+423

#{ kind: file: root: (dict-ref source root: #f)

+424

provider: (dict-ref source provider: #f)

+425

host: (dict-ref source host: #f)

+426

address: (string-append (dict-ref repo worktree: "") "/" path)

+427

line: (or (dict-ref line new-line: #f) (dict-ref line old-line: 1)) })

+428

state)))

+429

((not row) state)

+430

((eq? (dict-ref row kind: #f) commit:) (open-diff state))

+431

((eq? (dict-ref row kind: #f) section:) (toggle state))

+432

((eq? (dict-ref row kind: #f) entry:)

+433

(let* ((entry (dict-ref row entry: #{}) ) (path (dict-ref entry path: #f))

+434

(repo (dict-ref (dict-ref (git-status-model-state (git-status-model v)) data: #{}) repo: #{})))

+435

(if path ((op open-source:) state #{ kind: file:

+436

root: (dict-ref (view-source v) root: #f)

+437

provider: (dict-ref (view-source v) provider: #f)

+438

host: (dict-ref (view-source v) host: #f)

+439

                                                      address: (string-append (dict-ref repo worktree: "") "/" path) }) state)))

+440

((dict-ref row owner: #f)

+441

(let* ((entry-row (row-by-id v (dict-ref row owner: "")))

+442

(entry (and entry-row (dict-ref entry-row entry: #{})))

+443

(path (and entry (dict-ref entry path: #f)))

+444

(repo (dict-ref (dict-ref (git-status-model-state (git-status-model v)) data: #{}) repo: #{})))

+445

(if path ((op open-source:) state #{ kind: file:

+446

root: (dict-ref (view-source v) root: #f)

+447

provider: (dict-ref (view-source v) provider: #f)

+448

host: (dict-ref (view-source v) host: #f)

+449

address: (string-append (dict-ref repo worktree: "") "/" path)

+450

line: (or (dict-ref row new-line: #f)

+451

(dict-ref row old-line: 1)) }) state)))

+452

(else state))))

+453

(define (select-visit state suffix) (visit (select state suffix)))

+454

(define (select-diff state suffix) (open-diff (select state suffix)))

+455

(define (as-list value)

+456

(cond ((array? value) (array->list value)) ((list? value) value) (else '())))

+457

(define (entry-path entry) (dict-ref entry path: (dict-ref entry original-path: #f)))

+458

(define (mutation-rows v stage? allow-section?)

+459

(let* ((selected (git-status-selected-row v))

+460

(kind (and selected (dict-ref selected kind: #f)))

+461

(wanted (if stage? (list unstaged: untracked:) (list staged:))))

+462

(cond

+463

((and (eq? kind entry:) (member (dict-ref selected section: #f) wanted))

+464

(list selected))

+465

((and allow-section? (eq? kind section:)

+466

(member (dict-ref selected section: #f) wanted))

+467

(filter (lambda (row)

+468

(and (eq? (dict-ref row kind: #f) entry:)

+469

(eq? (dict-ref row section: #f) (dict-ref selected section: #f))))

+470

(git-status-rows v)))

+471

(else '()))))

+472

(define (fresh-entry data path)

+473

(find (lambda (entry)

+474

(let ((current (dict-ref entry path: #f))

+475

(original (dict-ref entry original-path: #f)))

+476

(or (and (string? current) (string=? current path))

+477

(and (string? original) (string=? original path)))))

+478

(as-list (dict-ref data entries: '()))))

+479

(define (run-mutation-queue! model source verb paths)

+480

(if (null? paths)

+481

#t

+482

(let* ((data (dict-ref (git-status-model-state model) data: #{}))

+483

(entry (fresh-entry data (car paths))))

+484

(if (not entry)

+485

(begin

+486

(git-status-model-refresh! model source (current-project ((op state:))))

+487

#f)

+488

(git-status-model-mutate! model source verb (dict-ref entry id: "")

+489

(lambda (fresh)

+490

(run-mutation-queue! model source verb (cdr paths)))

+491

(lambda (error)

+492

;; Stale and all other named failures converge on an

+493

;; immediate authoritative refresh; no remaining path runs.

+494

(git-status-model-refresh! model source (current-project ((op state:))))))))))

+495

(define (mutate-selected stage? allow-section?)

+496

(lambda (state)

+497

(let ((v (active-view state)))

+498

(if (not (status-view? v)) state

+499

(let* ((selected (git-status-selected-row v))

Showing the first 500 of 630 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate/src/slate/commands/git/branch.sgladded

@@ -0,0 +1,242 @@

+1

;;; Branch prompts and commands; Git stays on the source's owning node.

+2

(define-library (slate commands git branch)

+3

(import (sigil io) (sigil json) (sigil string)

+4

(slate command) (slate prompt) (slate provider) (slate state) (slate view)

+5

(slate git model) (slate git status-view) (slate git log-model)

+6

(slate git log-view) (slate git diff-model) (slate git diff-view))

+7

(export configure-git-branch-commands! git-branch-prompt)

+8

(begin

+9

(define *ops* #{})

+10

(define *pending* '())

+11

(define menu

+12

#{ "b" "git-branch-switch" "c" "git-branch-create-switch"

+13

"n" "git-branch-create-selected" })

+14

(define (configure-git-branch-commands! ops)

+15

(set! *ops* ops))

+16

(define (op key) (dict-ref *ops* key #f))

+17

(define (as-list value)

+18

(cond ((array? value) (array->list value)) ((list? value) value) (else '())))

+19

(define (model v)

+20

(and v (or (git-status-model v) (git-log-model v) (git-diff-model v))))

+21

(define (repository v)

+22

(cond ((not v) #f)

+23

((git-status-model v)

+24

(dict-ref (dict-ref (git-status-model-state (git-status-model v)) data: #{}) repo: #f))

+25

((git-log-model v) (git-log-model-repo (git-log-model v)))

+26

((git-diff-model v) (git-diff-model-repo (git-diff-model v)))

+27

(else #f)))

+28

(define (selected-oid v)

+29

(let ((commit

+30

(cond ((git-log-model v)

+31

(if (eq? (dict-ref v slate/git-log-focus: 'list) 'review)

+32

(dict-ref (or (dict-ref (git-log-model-state (git-log-model v)) review: #f) #{}) commit: #f)

+33

(git-log-selected v)))

+34

((git-status-model v)

+35

(dict-ref (or (git-status-selected-row v) #{}) commit: #f))

+36

(else (dict-ref v slate/git-commit: #f)))))

+37

(and commit (dict-ref commit oid: #f))))

+38

(define (context-owner? state ctx)

+39

(let ((v (find-view (views state) (vector-ref ctx 2))))

+40

(and (eq? (dict-ref state slate/git-branch-context: #f) ctx)

+41

v (eq? (model v) (vector-ref ctx 3)))))

+42

(define (context-live? state ctx)

+43

(and (context-owner? state ctx)

+44

(equal? (dict-ref state slate/minibuffer: #f) "git-branch")))

+45

(define (close-branch-prompt state)

+46

(dict-set (close-prompt state) slate/git-branch-context: #f))

+47

(define (cancellable prompt)

+48

(dict-set prompt on-cancel:

+49

(lambda (state) (dict-set state slate/git-branch-context: #f))))

+50

(define (request state source verb args ready fail)

+51

;; A provider may answer synchronously in tests or from a cache. Preserve

+52

;; the reducer return in that case; asynchronous replies use live state.

+53

(let ((sync? #t) (next state))

+54

(define (deliver handler value)

+55

(if sync?

+56

(set! next (handler next value))

+57

(begin

+58

((op set-state:) (handler ((op state:)) value))

+59

((op refresh:)))))

+60

(source-git-request source verb args

+61

(lambda (reply) (deliver ready reply))

+62

(lambda (error) (deliver fail error)))

+63

(set! sync? #f)

+64

next))

+65

(define (message error)

+66

(if (dict? error)

+67

(dict-ref error message: "Branch operation failed; refresh before retrying")

+68

"Branch operation failed; refresh before retrying"))

+69

(define (valid-list? reply repo)

+70

(and (dict? reply) (= (dict-ref reply version: 0) 1)

+71

(git-repository=? repo (dict-ref reply repo: #f))

+72

(git-snapshot-key (dict-ref reply snapshot: #f))

+73

(dict? (dict-ref reply branch: #f))

+74

(string? (dict-ref (dict-ref reply branch: #{}) head: #f))

+75

(or (list? (dict-ref reply branches: #f)) (array? (dict-ref reply branches: #f)))

+76

(<= (bytevector-length (string->utf8 (json-encode reply))) 262144)

+77

(<= (length (as-list (dict-ref reply branches: '()))) 500)

+78

(let loop ((rows (as-list (dict-ref reply branches: '()))))

+79

(or (null? rows)

+80

(and (dict? (car rows))

+81

(string? (dict-ref (car rows) name: #f))

+82

(git-history-oid? (dict-ref (car rows) oid: #f))

+83

(loop (cdr rows)))))))

+84

(define (related-status-models state repo)

+85

(map git-status-model

+86

(filter (lambda (v)

+87

(and (git-status-model v) (git-repository=? repo (repository v))))

+88

(views state))))

+89

(define (busy? state repo)

+90

(or (member (git-repository-key repo) *pending*)

+91

(any (lambda (m)

+92

(let ((s (git-status-model-state m)))

+93

(or (eq? (dict-ref s state: #f) loading:)

+94

(and (eq? (dict-ref s state: #f) stale:)

+95

(not (dict-ref s external-change?: #f)))

+96

(eq? (dict-ref s mutation: #f) pending:))))

+97

(related-status-models state repo))))

+98

(define (refresh-reviews state repo switched?)

+99

(fold-left

+100

(lambda (next v)

+101

(if (not (git-repository=? repo (repository v))) next

+102

(cond

+103

((git-log-model v)

+104

(if switched?

+105

(begin

+106

(git-log-model-load! (git-log-model v))

+107

(update-view next (view-name v)

+108

(lambda (current)

+109

(dict-set (dict-set current slate/git-selected: #f) slate/git-log-focus: 'list))))

+110

(begin

+111

(git-log-model-refresh! (git-log-model v))

+112

next)))

+113

((not switched?) next)

+114

((git-status-model v)

+115

(for-each (lambda (pair) (git-diff-model-invalidate! (cdr pair)))

+116

(dict-ref v slate/git-inline-models: '()))

+117

(update-view next (view-name v)

+118

(lambda (current)

+119

(dict-set (dict-set current slate/git-inline-models: '()) slate/git-hunk-folded: '()))))

+120

((git-diff-model v)

+121

(git-diff-model-invalidate! (git-diff-model v))

+122

next)

+123

(else next))))

+124

state (views state)))

+125

(define (perform state ctx action name target)

+126

(let* ((repo (vector-ref ctx 1))

+127

(data (vector-ref ctx 5))

+128

(switch? (not (eq? action 'selected)))

+129

(key (git-repository-key repo)))

+130

(cond

+131

((not (context-owner? state ctx)) (close-branch-prompt state))

+132

((busy? state repo) (with-echo (close-branch-prompt state) "Wait for the current Git operation"))

+133

(else

+134

(let* ((locks (map git-status-model-lock! (related-status-models state repo)))

+135

(args #{ repo: repo expected-snapshot: (dict-ref data snapshot: #{})

+136

expected-branch: (dict-ref (dict-ref data branch: #{}) head: "")

+137

name: name })

+138

(args (if (eq? action 'switch)

+139

(dict-set args target-oid: target)

+140

(dict-set (dict-set args start-oid: target) switch: switch?))))

+141

(define (settle! fresh)

+142

(set! *pending* (filter (lambda (k) (not (equal? k key))) *pending*))

+143

(for-each (lambda (lock) (git-status-model-unlock! lock fresh)) locks))

+144

(set! *pending* (cons key *pending*))

+145

(request (with-echo (close-branch-prompt state) (string-append "Git: updating branch " name "…"))

+146

(vector-ref ctx 0)

+147

(if (eq? action 'switch) "git/switch-branch" "git/create-branch") args

+148

(lambda (current reply)

+149

(if (and (dict? reply) (= (dict-ref reply version: 0) 1)

+150

(git-repository=? repo (dict-ref reply repo: #f))

+151

(eq? (dict-ref reply applied: #f) #t)

+152

(equal? name (dict-ref reply name: #f)))

+153

(let ((fresh (dict-ref reply status: #f)))

+154

;; Clear old inline reviews before status listeners see

+155

;; fresh data, so a branch switch never eagerly reloads

+156

;; patches belonging to the previous checkout.

+157

((op set-state:) (refresh-reviews current repo switch?))

+158

(settle! fresh)

+159

(with-echo ((op state:))

+160

(string-append (if switch? "Switched to " "Created branch ") name

+161

(if fresh "" "; refresh status to update this repository"))))

+162

(begin

+163

(settle! #f)

+164

(with-echo current "Could not verify the branch result; refresh before retrying"))))

+165

(lambda (current error)

+166

(settle! #f)

+167

(with-echo current (message error)))))))))

+168

(define (loaded-prompt ctx action)

+169

(let* ((data (vector-ref ctx 5))

+170

(head (dict-ref (dict-ref data snapshot: #{}) head-oid: ""))

+171

(current (dict-ref (dict-ref data branch: #{}) head: ""))

+172

(start (if (eq? action 'selected) (vector-ref ctx 4) head)))

+173

(if (eq? action 'switch)

+174

(completing-read-prompt (string-append "Switch local branch · " current)

+175

(lambda (state)

+176

(map (lambda (branch)

+177

#{ label: (dict-ref branch name: "")

+178

annotation: (if (equal? current (dict-ref branch name: #f))

+179

"current" (substring (dict-ref branch oid: "") 0 7))

+180

action: "noop" branch: branch })

+181

(as-list (dict-ref data branches: '()))))

+182

(lambda (state candidate)

+183

(let ((branch (dict-ref candidate branch: #{})))

+184

(perform state ctx action (dict-ref branch name: "") (dict-ref branch oid: #f)))))

+185

(string-prompt

+186

(if (eq? action 'selected)

+187

(string-append "Create branch at " (substring start 0 7) " · keep current checkout")

+188

(string-append "Create and switch from " current))

+189

(lambda (state name)

+190

                (cond ((or (string=? name "") (> (string-length name) 240)) "Enter a branch name (up to 240 characters)")

+191

((find (lambda (b) (equal? name (dict-ref b name: #f)))

+192

(as-list (dict-ref data branches: '()))) "That branch already exists")

+193

(else #t)))

+194

(lambda (state name) (perform state ctx action name start))))))

+195

(define (open-branch-prompt action)

+196

(lambda (state)

+197

(let* ((v (active-view state))

+198

(repo (repository v))

+199

(selected (and v (selected-oid v))))

+200

(cond

+201

((not repo) (with-echo state "Open Git status or history first"))

+202

((busy? state repo) (with-echo state "Wait for the current Git operation"))

+203

((and (eq? action 'selected) (not (git-history-oid? selected)))

+204

(with-echo state "Select a commit in history before creating a branch from it"))

+205

(else

+206

(let* ((ctx (vector (view-source v) repo (view-name v) (model v) selected #f))

+207

;; The loading placeholder must not become this prompt

+208

;; session's candidate snapshot. Snapshot the loaded list.

+209

(loading (dict-set

+210

(completing-read-prompt "Loading branches…"

+211

(lambda (s) '()) (lambda (s c) s))

+212

candidate-policy: live:))

+213

(next (open-prompt

+214

(dict-set (dict-set state slate/git-branch-context: ctx)

+215

slate/git-branch-prompt: (cancellable loading))

+216

"git-branch" (list "git-branch"))))

+217

(request next (view-source v) "git/branches" #{ repo: repo }

+218

(lambda (current reply)

+219

(if (not (context-live? current ctx)) current

+220

(if (valid-list? reply repo)

+221

(begin

+222

(vector-set! ctx 5 reply)

+223

(dict-set current slate/git-branch-prompt: (cancellable (loaded-prompt ctx action))))

+224

(with-echo (close-branch-prompt current) "Invalid branch listing from this root"))))

+225

(lambda (current error)

+226

(if (context-live? current ctx)

+227

(with-echo (close-branch-prompt current) (message error)) current)))))))))

+228

(define (git-branch-prompt state)

+229

(dict-ref state slate/git-branch-prompt:

+230

(completing-read-prompt "Branches" (lambda (s) '()) (lambda (s c) s))))

+231

(define (open-menu state)

+232

(if (not (repository (active-view state)))

+233

(with-echo state "Open Git status or history first")

+234

(dict-set (dict-set (with-echo state "b-") slate/pending-prefix: menu)

+235

slate/which-key: #{ title: "Branches" map: menu

+236

labels: #{ "b" "Switch local branch"

+237

"c" "Create and switch branch"

+238

"n" "Branch from selected commit" } })))

+239

    (install-builtin-command! "git-branch-menu" "Git: Branches" "switch or create a branch" '(slate commands git branch) open-menu)

+240

    (install-builtin-command! "git-branch-switch" "Git: Switch branch" "choose a local branch" '(slate commands git branch) (open-branch-prompt 'switch))

+241

    (install-builtin-command! "git-branch-create-switch" "Git: Create and switch branch" "start a branch from HEAD" '(slate commands git branch) (open-branch-prompt 'create-switch))

+242

    (install-builtin-command! "git-branch-create-selected" "Git: Branch from selected commit" "create a branch without switching" '(slate commands git branch) (open-branch-prompt 'selected))))

packages/slate/src/slate/commands/help.sglmodified

@@ -195,12 +195,15 @@

195

(close-prompt

196

(with-echo state (describe-hook (dict-ref candidate hook: #f)))))))

197

((string=? id "describe-command")

−198

(completing-read-prompt

−199

"Describe command" describe-command-candidates

−200

(lambda (state candidate)

−201

(close-prompt

−202

(with-echo state

−203

(describe-command state (dict-ref candidate command-name: "")))))))

+198

;; Concrete family commands are synthesized from the current query.

+199

(dict-set

+200

(completing-read-prompt

+201

"Describe command" describe-command-candidates

+202

(lambda (state candidate)

+203

(close-prompt

+204

(with-echo state

+205

(describe-command state (dict-ref candidate command-name: ""))))))

+206

candidate-policy: live:))

207

(else #f)))

208

209

(define (install-help-commands!)

packages/slate/src/slate/commands/navigation.sglmodified

@@ -13,6 +13,7 @@

13

(slate modes terminal)

14

(slate modes web)

15

(slate modes welcome)

+16

(slate modes node-status)

17

(slate view))

18

(export install-navigation-commands! configure-navigation-commands!)

19

(begin

@@ -37,6 +38,24 @@

38

(with-echo

39

(close-prompt (ensure-view state welcome-view-name make-welcome-view))

40

"welcome"))

+41

(define (open-node-status-command state)

+42

(with-echo

+43

(close-prompt

+44

(ensure-view state node-status-view-name make-node-status-view))

+45

"local node status"))

+46

(define (refresh-node-status-command state)

+47

(close-prompt

+48

(update-view state node-status-view-name

+49

(lambda (view)

+50

(if (node-status? view) (node-status-loading view) view)))))

+51

(define (update-client-command state)

+52

(call update-client: (close-prompt state)))

+53

(define (wake-lock-command state)

+54

(call wake-lock: (close-prompt state)))

+55

(define (performance-start-command state)

+56

((cap performance-capture:) "start" (close-prompt state)))

+57

(define (performance-save-command state)

+58

((cap performance-capture:) "save" (close-prompt state)))

59

(define (close-view-command state)

60

(let ((view (active-view state)))

61

(cond

@@ -138,6 +157,24 @@

157

"open the scratchpad view" source-module open-scratchpad-command)

158

(install-builtin-command! "welcome" "View: Welcome"

159

"open the welcome view" source-module open-welcome-command)

+160

(install-builtin-command! "node-status" "Slate: Node Status"

+161

"show this local node's lifecycle and listener status"

+162

source-module open-node-status-command)

+163

(install-builtin-command! "node-status-refresh" "Node: Refresh Status"

+164

"refresh this local node's lifecycle and listener status"

+165

source-module refresh-node-status-command)

+166

(install-builtin-command! "slate-update-client" "Slate: Update Client"

+167

"activate Slate's waiting web client update, then reload once"

+168

source-module update-client-command)

+169

(install-builtin-command! "slate-keep-screen-awake" "Slate: Keep Screen Awake"

+170

"toggle keeping the screen awake while Slate is visible"

+171

source-module wake-lock-command)

+172

(install-builtin-command! "slate-performance-start" "Slate: Start Performance Capture"

+173

"begin a bounded client input and paint timing capture"

+174

source-module performance-start-command)

+175

(install-builtin-command! "slate-performance-save" "Slate: Save Performance Capture"

+176

"stop the client timing capture and download its JSON report"

+177

source-module performance-save-command)

178

(install-builtin-command! "close-view" "View: Close"

179

"close the focused view" source-module close-view-command)

180

(install-builtin-command! "clear" "View: Clear"

packages/slate/src/slate/commands/project.sglmodified

@@ -229,7 +229,7 @@

229

(ff-cache-reset!)

230

((required drill-query:)

231

(dict-set next slate/findfile-provider: context)

−232

"findfile" address)))))

+232

"findfile" (dir-path address))))))

233

234

(define (project-terminal-command state)

235

(with-current-project state

packages/slate/src/slate/commands/search.sglmodified

@@ -120,14 +120,16 @@

120

(dict-set

121

(dict-set

122

(dict-set

+123

(dict-set

124

(dict-set

125

(dict-set (completing-read-prompt "Search in buffer"

126

search-candidates search-goto)

127

rank: search-rank)

128

completes-query?: #f)

129

empty-action: search-empty-action)

−129

preview: search-preview)

−130

on-cancel: search-cancel))

+130

preview: search-preview)

+131

on-cancel: search-cancel)

+132

candidate-policy: live:))

133

134

(define (install-search-commands!)

135

(install-builtin-command-family! "search-goto:"

packages/slate/src/slate/commands/terminal.sglmodified

@@ -1,12 +1,15 @@

1

;;; (slate commands terminal) — terminal and tmux command surface.

2

(define-library (slate commands terminal)

3

(import (sigil core)

+4

(sigil array)

5

(sigil math)

+6

(slate components)

7

(sigil string)

8

(slate command)

9

(slate list)

10

(slate main preferences)

11

(slate modes terminal)

+12

(slate pane)

13

(slate prompt)

14

(slate prompt candidates)

15

(slate provider)

@@ -22,7 +25,7 @@

25

terminal-char-mode-active? terminal-key! terminal-send-binding?

26

tmux-caps-clear-inflight! tmux-caps-fetch! tmux-caps-for

27

tmux-client-of tmux-close! tmux-detach! tmux-reattach!

−25

next-term-name)

+28

next-term-name terminal-session-candidates)

29

(begin

30

(define source-module '(slate commands terminal))

31

(define *ops* #{})

@@ -43,10 +46,11 @@

46

(for-each (lambda (row) (exact (car row) (cadr row) (caddr row) (cadddr row)))

47

(list

48

(list "open-terminal" "Terminal: Open" "open a terminal" open-terminal-command)

+49

          (list "terminal-reattach" "Terminal: Reattach" "choose a running terminal to reattach" terminal-reattach-command)

50

(list "terminal-close" "Terminal: Close" "close the terminal" terminal-close-command)

51

(list "terminal-live" "Terminal: Scroll to Live" "scroll to live output" terminal-live-command)

52

(list "terminal-toggle-mode" "Terminal: Toggle Mode" "toggle char/line mode" terminal-toggle-command)

−49

          (list "terminal-reconnect" "Terminal: Reconnect" "request a fresh terminal session" (lambda (s) (terminal-reconnect-command s #f)))

+53

          (list "terminal-reconnect" "Terminal: New Session" "replace a disconnected terminal with a new session" (lambda (s) (terminal-reconnect-command s #f)))

54

(list "tmux-next-window" "Tmux: Next Window" "select next tmux window" (lambda (s) (tmux-step-command s #t)))

55

          (list "tmux-prev-window" "Tmux: Previous Window" "select previous tmux window" (lambda (s) (tmux-step-command s #f)))

56

(list "tmux-split-right" "Tmux: Split Right" "split tmux pane right" (lambda (s) (tmux-split-command s 'row)))

@@ -58,13 +62,110 @@

62

          (list "tmux-rename-window" "Tmux: Rename Window" "rename tmux window" (lambda (s) (tmux-rename-command s "tmux-rename-window")))

63

          (list "tmux-rename-session" "Tmux: Rename Session" "rename tmux session" (lambda (s) (tmux-rename-command s "tmux-rename-session")))

64

(list "tmux-sessions" "Tmux: Switch Session" "choose tmux session" tmux-sessions-command)))

+65

(family "terminal-attach:" "reattach a selected terminal" terminal-attach-command)

66

(family "tmux-select-window:" "select tmux window" tmux-select-window-command)

67

(family "tmux-select-pane:" "select tmux pane" tmux-select-pane-command)

68

(family "tmux-inner-resize:" "resize inner tmux pane" tmux-inner-resize-command)

69

(family "session-switch:" "switch tmux session" tmux-session-switch-command)

−65

(family "terminal-reconnect-pane:" "reconnect a pane terminal" terminal-reconnect-command)

+70

      (family "terminal-reconnect-pane:" "open a new session in a disconnected terminal pane" terminal-reconnect-command)

71

(family "term-mode-toggle-pane:" "toggle a pane terminal mode" terminal-toggle-pane-command)

72

#t)

+73

(define *terminal-picker-generation* 0)

+74

+75

(define (terminal-session-candidates state)

+76

(let loop ((rows (dict-ref state slate/terminal-sessions: '())) (index 0))

+77

(if (null? rows) '()

+78

(let* ((row (car rows))

+79

(sid (dict-ref row sid: ""))

+80

(command (dict-ref row command: "shell"))

+81

(cwd (dict-ref row cwd: ""))

+82

(idle (dict-ref row idle: 0)))

+83

(cons

+84

(cand (string-append command " · " sid)

+85

(string-append

+86

(if (dict-ref row attached: #f) "attached" "detached")

+87

" · idle " (age-phrase (* 1000 idle))

+88

(if (string=? cwd "") "" (string-append " · " cwd)))

+89

(string-append "terminal-attach:" (number->string index)))

+90

(loop (cdr rows) (+ index 1)))))))

+91

+92

(define (terminal-reattach-command state)

+93

(set! *terminal-picker-generation* (+ *terminal-picker-generation* 1))

+94

(let* ((generation *terminal-picker-generation*)

+95

(host (active-terminal-host state))

+96

(request (if (string=? host "") node-list-sessions!

+97

(lambda (ok err) (enclave-node-list-sessions! host ok err))))

+98

(next (drill-prompt

+99

(dict-set (dict-set state slate/terminal-sessions: '())

+100

slate/terminal-picker-host: host)

+101

"terminal-session"))

+102

(prompt-session (dict-ref next slate/prompt-session: 0))

+103

(issuing? #t))

+104

(define (current?)

+105

(and (= generation *terminal-picker-generation*)

+106

(= prompt-session (dict-ref (root-state) slate/prompt-session: 0))

+107

(equal? (dict-ref (root-state) slate/minibuffer: #f) "terminal-session")))

+108

(define (update! change)

+109

;; A disconnected provider may answer before dispatch installs next.

+110

(if issuing?

+111

(set! next (change next))

+112

(when (current?)

+113

(set-root-state! (change (root-state)))

+114

(slate-refresh))))

+115

(set! next (with-echo next "Listing running terminals…"))

+116

(request

+117

(lambda (result)

+118

(let* ((raw (dict-ref result sessions: '()))

+119

(rows (filter

+120

(lambda (row)

+121

(and (dict? row) (equal? (dict-ref row kind: #f) "pty")

+122

(dict-ref row alive: #f) (string? (dict-ref row sid: #f))))

+123

(cond ((array? raw) (array->list raw))

+124

((list? raw) raw)

+125

(else '()))))

+126

(message (cond

+127

((not (dict-ref result catalog-version: #f))

+128

"Update this node to discover all retained terminals")

+129

((> (dict-ref result unavailable: 0) 0)

+130

"Some terminals could not be listed; their node processes may need updating")

+131

((null? rows) "No running terminals on this node")

+132

(else "Select a terminal to reattach"))))

+133

(update! (lambda (state)

+134

(with-echo (dict-set state slate/terminal-sessions: rows) message)))))

+135

(lambda (reason)

+136

(update! (lambda (state)

+137

(with-echo state

+138

(string-append "Cannot list terminals: " (error->text reason)))))))

+139

(set! issuing? #f)

+140

next))

+141

+142

(define (terminal-attach-command state arg)

+143

(let* ((index (and (string? arg) (string->number arg)))

+144

(rows (dict-ref state slate/terminal-sessions: '()))

+145

(host (dict-ref state slate/terminal-picker-host: "")))

+146

(if (not (and (integer? index) (>= index 0) (< index (length rows))))

+147

(with-echo state "That terminal is no longer in the list")

+148

(let* ((row (list-ref rows index))

+149

(sid (dict-ref row sid: ""))

+150

(existing

+151

(let loop ((vs (views state)))

+152

(and (pair? vs)

+153

(let* ((view (car vs)) (source (view-source view)))

+154

(if (and (terminal? view)

+155

(equal? host (dict-ref source host: ""))

+156

(equal? sid (terminal-remote-id (view-name view))))

+157

(view-name view)

+158

(loop (cdr vs))))))))

+159

(if existing

+160

(focus-view (close-prompt state) existing)

+161

(let* ((name (next-term-name))

+162

(source #{ kind: pty: provider: (if (string=? host "") local: node:)

+163

host: host attach: sid

+164

attach-route: (dict-ref row route: #f) })

+165

(view (make-terminal-view name source)))

+166

(with-echo (focus-view (add-view (close-prompt state) view) name)

+167

"Reattaching terminal…")))))))

+168

169

(define (open-terminal-command state)

170

(cond

171

;; ---- a discovered Enclave machine root -------------------------

packages/slate/src/slate/components/diff.sgladded

@@ -0,0 +1,147 @@

+1

;;; (slate components diff) — reusable normalized diff presentation.

+2

(define-library (slate components diff)

+3

(import (sigil core) (sigil string) (sigil web client))

+4

(export diff-normalize-unified diff-kind=? diff-row-kind diff-row-class diff-row-render diff-control-render)

+5

(begin

+6

(define (number-text value) (if (number? value) (number->string value) ""))

+7

(define (kind-text value)

+8

(cond ((keyword? value) (keyword->string value))

+9

((symbol? value) (symbol->string value))

+10

((string? value) value)

+11

(else "context")))

+12

(define (diff-kind=? value expected)

+13

(or (eq? value expected)

+14

(string=? (kind-text value) (keyword->string expected))))

+15

;; Some older node decoders preserve keyword-shaped JSON values as opaque

+16

;; atoms. Patch text is not mutation authority, but its first column is a

+17

;; safe presentation fallback for classifying those already-structured rows.

+18

(define (diff-row-kind row)

+19

(let ((kind (dict-ref row kind: #f)) (text (dict-ref row text: "")))

+20

(cond ((memq kind '(addition: deletion: hunk: file: loading: continuation: context:)) kind)

+21

((diff-kind=? kind addition:) addition:)

+22

((diff-kind=? kind deletion:) deletion:)

+23

((diff-kind=? kind hunk:) hunk:)

+24

((diff-kind=? kind file:) file:)

+25

((diff-kind=? kind loading:) loading:)

+26

((diff-kind=? kind continuation:) continuation:)

+27

((and (string? text) (string-starts-with? text "+")) addition:)

+28

((and (string? text) (string-starts-with? text "-")) deletion:)

+29

((and (string? text) (string-starts-with? text "@@")) hunk:)

+30

((and (string? text) (string-starts-with? text "diff --git ")) file:)

+31

(else context:))))

+32

(define (diff-row-class row)

+33

(kind-class (diff-row-kind row)))

+34

(define (kind-class kind)

+35

(cond ((eq? kind addition:) "slate-diff-row slate-diff-addition")

+36

((eq? kind deletion:) "slate-diff-row slate-diff-deletion")

+37

((eq? kind hunk:) "slate-diff-row slate-diff-hunk")

+38

((eq? kind file:) "slate-diff-row slate-diff-file")

+39

((eq? kind loading:) "slate-diff-row slate-diff-loading")

+40

((eq? kind continuation:) "slate-diff-row slate-diff-continuation")

+41

(else "slate-diff-row slate-diff-context")))

+42

(define (diff-row-render row selected? command)

+43

(let* ((kind (diff-row-kind row))

+44

(class (string-append (kind-class kind) (if selected? " selected" "")))

+45

(action? (or (eq? kind hunk:) (eq? kind continuation:)))

+46

(text (dict-ref row text: ""))

+47

(display-text (if (and (or (eq? kind addition:) (eq? kind deletion:))

+48

(> (string-length text) 0))

+49

(substring text 1 (string-length text)) text)))

+50

`(div (@ (class ,class) (role "row")

+51

(data-diff-kind ,(kind-text kind))

+52

,@(if command `((data-slate-click ,command)) '()))

+53

(span (@ (class "slate-diff-gutter slate-diff-old") (aria-hidden "true"))

+54

,(if (and command (eq? kind hunk:))

+55

`(button (@ (class "slate-diff-hunk-toggle")

+56

(aria-label "Toggle hunk")

+57

(aria-expanded ,(if (dict-ref row folded?: #f) "false" "true"))

+58

(data-slate-click ,command))

+59

,(if (dict-ref row folded?: #f) "▸" "▾"))

+60

(number-text (dict-ref row old-line: #f))))

+61

(span (@ (class "slate-diff-gutter slate-diff-new") (aria-hidden "true"))

+62

,(number-text (dict-ref row new-line: #f)))

+63

(span (@ (class "slate-diff-marker") (aria-hidden "true"))

+64

,(cond ((eq? kind addition:) "+") ((eq? kind deletion:) "−")

+65

((eq? kind hunk:) "@@") (else " ")))

+66

(span (@ (class "slate-diff-code")) ,display-text)

+67

,@(if (and command action? (not (eq? kind hunk:)))

+68

`((button (@ (class "slate-diff-action") (aria-label "Toggle diff row")

+69

(data-slate-click ,command)) "▾"))

+70

'())

+71

,@(let ((mutation (dict-ref row mutation-command: #f)))

+72

(if mutation

+73

`((button (@ (class "slate-diff-mutation")

+74

(aria-label ,(dict-ref row mutation-label: "Apply hunk mutation"))

+75

(title ,(dict-ref row mutation-label: "Apply hunk mutation"))

+76

(data-slate-click ,mutation))

+77

(span (@ (class ,(string-append "icon i-"

+78

(dict-ref row mutation-icon: "plus")))))))

+79

'()))

+80

,@(let ((discard (dict-ref row discard-command: #f)))

+81

(if discard

+82

`((button (@ (class "slate-diff-discard")

+83

(aria-label "Discard hunk permanently")

+84

(title "Discard hunk")

+85

(data-slate-click ,discard))

+86

(span (@ (class "icon i-trash-2")))))

+87

'())))))

+88

(define (diff-control-render rows selected command-for (keys: (revision #f) (prepare-row #f)))

+89

;; Bound sibling fanout: the DOM reconciler scans sibling records when

+90

;; matching and removing children. Row groups preserve document order,

+91

;; native scrolling, and the full bounded review without a flat hot list.

+92

;; A supplied revision covers all row content, commands and attributes.

+93

;; Only a group's own selection enters its memo revision: moving point

+94

;; skips constructing and reconciling every unaffected group.

+95

(define (render-group rows)

+96

`(div (@ (role "rowgroup"))

+97

,@(map (lambda (raw)

+98

(let* ((row (if prepare-row (prepare-row raw) raw))

+99

(id (dict-ref row id: #f)))

+100

(diff-row-render row (and selected id (string=? selected id))

+101

(and command-for (command-for row))))) rows)))

+102

(define (groups rest index)

+103

(if (null? rest) '()

+104

(let chunk ((tail rest) (n 0) (point #f) (out '()))

+105

(if (or (null? tail) (= n 32))

+106

(let ((group (reverse out)))

+107

(cons (if revision

+108

(web-client-memo (string-append "diff-group:" (number->string index))

+109

(format "~s" (list revision point))

+110

(lambda () (render-group group)))

+111

(render-group group))

+112

(groups tail (+ index 1))))

+113

(let ((row (car tail)))

+114

(chunk (cdr tail) (+ n 1)

+115

(if (equal? selected (dict-ref row id: #f)) selected point)

+116

(cons row out)))))))

+117

`(div (@ (class "slate-diff-control") (role "table") (aria-label "Diff"))

+118

,@(groups rows 0)))

+119

(define (range-start token)

+120

(let* ((body (if (> (string-length token) 1) (substring token 1 (string-length token)) ""))

+121

(parts (string-split body ",")))

+122

(and (not (null? parts)) (string->number (car parts)))))

+123

(define (hunk-starts line)

+124

(let ((parts (string-split line " ")))

+125

(if (>= (length parts) 3)

+126

(cons (range-start (list-ref parts 1)) (range-start (list-ref parts 2)))

+127

(cons #f #f))))

+128

(define (line-kind line)

+129

(cond ((and (>= (string-length line) 2) (string=? (substring line 0 2) "@@")) hunk:)

+130

((and (> (string-length line) 0) (char=? (string-ref line 0) #\+)) addition:)

+131

((and (> (string-length line) 0) (char=? (string-ref line 0) #\-)) deletion:)

+132

((and (>= (string-length line) 4) (string=? (substring line 0 4) "diff")) file:)

+133

(else context:)))

+134

(define (diff-normalize-unified text)

+135

(let loop ((lines (string-split text "\n")) (old #f) (new #f) (index 0) (out '()))

+136

(if (null? lines) (reverse out)

+137

(let* ((line (car lines)) (kind (line-kind line))

+138

(starts (and (eq? kind hunk:) (hunk-starts line)))

+139

(old* (if starts (car starts) old)) (new* (if starts (cdr starts) new))

+140

(old-line (if (or (eq? kind context:) (eq? kind deletion:)) old* #f))

+141

(new-line (if (or (eq? kind context:) (eq? kind addition:)) new* #f))

+142

(row #{ id: (string-append "raw-diff:" (number->string index))

+143

kind: kind text: line old-line: old-line new-line: new-line }))

+144

(loop (cdr lines)

+145

(if old-line (+ old* 1) old*)

+146

(if new-line (+ new* 1) new*)

+147

(+ index 1) (cons row out))))))))

packages/slate/src/slate/enclave-account/session.sglmodified

@@ -895,7 +895,7 @@

895

purpose: (dict-ref record purpose: "device") })

896

897

(define (account-on-ready!)

−898

(account-session-on-message! ((required node-message:)))

+898

(account-session-on-message! (required node-message:))

899

((required node-persist-error:)

900

(lambda (path error)

901

((required set-state:)

packages/slate/src/slate/findfile.sglmodified

@@ -91,7 +91,7 @@

91

;; Completing to nothing is the right answer for a path that isn't readable; the

92

;; caller's empty-action then offers to create it.

93

(define (make-listing-cache on-change)

−94

(let ((cache #{}))

+94

(let ((cache #{}) (row-cache #{}))

95

#{ entries:

96

(lambda (key start-read!)

97

(let ((hit (dict-ref cache key #f)))

@@ -104,10 +104,21 @@

104

'loading))))

105

loading?:

106

(lambda (key) (eq? (dict-ref cache key #f) 'loading))

+107

;; Candidate dictionaries are a pure projection of one directory's

+108

;; entries. Cache that projection too: the listing itself was already

+109

;; stable for this prompt invocation, so rebuilding hundreds of rows

+110

;; for every leaf-character edit only burns the UI thread.

+111

rows:

+112

(lambda (key build)

+113

(let ((hit (dict-ref row-cache key #f)))

+114

(or hit

+115

(let ((rows (build)))

+116

(set! row-cache (dict-set row-cache key rows))

+117

rows))))

118

;; Reset when the prompt OPENS: fresh listings per invocation, cached

119

;; within one. So typing never re-reads, but a new C-x C-f sees new files.

120

reset!:

−110

(lambda () (set! cache #{})) }))

+121

(lambda () (set! cache #{}) (set! row-cache #{})) }))

122

123

;; The candidate shape (slate selector) ranks and renders. Same three fields

124

;; (slate main)'s `cand` builds — the shape is already a contract between main

@@ -181,18 +192,19 @@

192

;; instead (common-prefix eats the trailing "/"). ⏎ on a file opens it in an

193

;; editor view.

194

(define (entry-rows dir entries dirs-only?)

−184

(fold-left

−185

(lambda (acc e)

−186

(let* ((name (dict-ref e name: ""))

−187

(dir? (eq? (dict-ref e kind: file:) dir:))

−188

(path (fs-join dir name)))

−189

(cond

−190

((findfile-marker-entry? e) acc)

−191

(dir? (append acc (list (cand (string-append path "/") ""

−192

(string-append "openfolder:" path)))))

−193

(dirs-only? acc)

−194

(else (append acc (list (cand path "" (string-append "openpath:" path))))))))

−195

'() entries))

+195

(reverse

+196

(fold-left

+197

(lambda (acc e)

+198

(let* ((name (dict-ref e name: ""))

+199

(dir? (eq? (dict-ref e kind: file:) dir:))

+200

(path (fs-join dir name)))

+201

(cond

+202

((findfile-marker-entry? e) acc)

+203

(dir? (cons (cand (string-append path "/") ""

+204

(string-append "openfolder:" path)) acc))

+205

(dirs-only? acc)

+206

(else (cons (cand path "" (string-append "openpath:" path)) acc)))))

+207

'() entries)))

208

209

;; The full candidate list for a query over an already-read listing.

210

(define (findfile-rows query entries dirs-only?)

@@ -239,14 +251,17 @@

251

((eq? kind file:) (dir-path (fs-parent addr)))

252

(else "/"))))

253

−242

;; The provider a prompt should complete against, given the view's source: that

−243

;; source's own provider IS "the context" in the Emacs sense, so find-file from a

−244

;; local: buffer completes local: and from a browser: buffer completes browser:.

−245

;; Falls back when the source names nothing usable. Which provider is the DEFAULT

−246

;; is the caller's business — this never names one.

+254

;; The filesystem context a prompt should complete against, given the view's

+255

;; source. Prefer its registered ROOT: a multi-machine provider such as node:

+256

;; is not enough to route a read, while the matching root retains host:. The

+257

;; built-in single-tree roots share their provider's name, so this preserves

+258

;; their spelling. Fall back to the provider only when no root matches.

259

(define (source-fs-provider src fallback)

−248

(let ((prov (and src (dict-ref src provider: #f))))

−249

(if (and prov (provider-registered? prov)) prov fallback)))

+260

(let ((root (and src (source-root src)))

+261

(prov (and src (dict-ref src provider: #f))))

+262

(cond (root root)

+263

((and prov (provider-registered? prov)) prov)

+264

(else fallback))))

265

266

;; ---- rooted queries ------------------------------------------------------

267

;; Wired in (slate main): state-with-prompt-query (typing + Tab) applies the

@@ -298,7 +313,7 @@

313

(cand (rooted-path n "/")

314

(root-annotation n)

315

(string-append "openroot:" (root-name-string n))))

−301

(filter nav-root? (root-names))))

+316

(filter nav-root? (root-visible-names))))

317

318

;; ---- reading a directory through the seam --------------------------------

319

;; A SYNCHRONOUS provider (browser:) materializes INLINE, exactly as find-file

@@ -366,4 +381,9 @@

381

(entries (entries-for cache prov dir)))

382

(if (eq? entries 'loading)

383

(list (cand (string-append dir " — reading…") "" "noop"))

−369

(findfile-rows query entries dirs-only?)))))))))

+384

(append

+385

(self-row query)

+386

((dict-ref cache rows:)

+387

(string-append (listing-key prov dir)

+388

(if dirs-only? "|dirs" "|all"))

+389

(lambda () (entry-rows dir entries dirs-only?))))))))))))

packages/slate/src/slate/folder/enrichment.sgladded

@@ -0,0 +1,202 @@

+1

;;; (slate folder enrichment) — optional reads after the listing is ready.

+2

;;; The view owns a cache; callbacks can only fill that cache while it is alive.

+3

;;; Neither enrichment replaces directory rows nor changes point/marks.

+4

(define-library (slate folder enrichment)

+5

(import (sigil string)

+6

(slate folder model)

+7

(slate git model)

+8

(slate modes folder)

+9

(slate modes image)

+10

(slate pane)

+11

(slate space)

+12

(slate provider)

+13

(slate state)

+14

(slate view))

+15

(export refresh-folder-enrichment! folder-preview-request-token flush-folder-preview!)

+16

(begin

+17

(define *tracked* '())

+18

(define *refreshing?* #f)

+19

+20

(define (dispose! v)

+21

(clear-image! v)

+22

(folder-detail-set! v preview-start: #f)

+23

(folder-detail-set! v alive?: #f)

+24

(folder-detail-set! v preview-key: #f)

+25

(let ((model (folder-detail v git-model: #f)))

+26

(when model (git-status-model-dispose! model))))

+27

+28

(define (directory-excerpt entries)

+29

(let ((entries (if (vector? entries) (vector->list entries) entries)))

+30

(let loop ((rest entries) (n 0) (text ""))

+31

(cond

+32

((null? rest) (if (= n 0) "Empty directory" text))

+33

((>= n 20) (string-append text "…"))

+34

(else

+35

(loop (cdr rest) (+ n 1)

+36

(string-append text (dict-ref (car rest) name: "")

+37

(if (eq? (dict-ref (car rest) kind: file:) dir:) "/" "")

+38

"\n")))))))

+39

+40

;; A trailing browser timer starts the latest request after 500 ms at point.

+41

;; One request across folder views can be in flight, so even a slow or stuck

+42

;; node cannot accumulate a queue of obsolete file reads during navigation.

+43

(define *preview-serial* 0)

+44

(define *preview-busy?* #f)

+45

+46

(define (release-image! source url)

+47

(when (and source url)

+48

(let ((release (dict-ref (provider-for source) image-release: #f)))

+49

(when release

+50

(guard (error (else #f)) (release source url))))))

+51

+52

(define (clear-image! v)

+53

(release-image! (folder-detail v preview-image-source: #f)

+54

(folder-detail v preview-image-url: #f))

+55

(folder-detail-set! v preview-image-url: #f)

+56

(folder-detail-set! v preview-image-source: #f))

+57

+58

(define (folder-preview-request-token)

+59

(if (and (not *preview-busy?*)

+60

(any (lambda (v) (folder-detail v preview-start: #f)) *tracked*))

+61

(number->string *preview-serial*)

+62

""))

+63

+64

(define (flush-folder-preview! token)

+65

(when (and (not (string=? token ""))

+66

(string=? token (folder-preview-request-token)))

+67

(let loop ((remaining *tracked*))

+68

(unless (null? remaining)

+69

(let ((start (folder-detail (car remaining) preview-start: #f)))

+70

(if start

+71

(begin

+72

(folder-detail-set! (car remaining) preview-start: #f)

+73

(set! *preview-busy?* #t)

+74

(start))

+75

(loop (cdr remaining))))))))

+76

+77

(define (preview-start v entry source key generation notify)

+78

(lambda ()

+79

(let* ((returned? #f)

+80

(completed? #f)

+81

(current? (lambda ()

+82

(and (folder-detail v alive?: #f)

+83

(= generation (folder-detail v preview-generation: 0))

+84

(equal? key (folder-detail v preview-key: #f)))))

+85

(finish (lambda (text)

+86

(unless completed?

+87

(set! completed? #t)

+88

(set! *preview-busy?* #f)

+89

(when (current?)

+90

(folder-detail-set! v preview-text: text))

+91

;; Even an obsolete response releases the request slot

+92

;; and lets the browser arm the latest pending preview.

+93

(when (and returned? (not *refreshing?*)) (notify)))))

+94

(failed (lambda (error) (finish "Preview unavailable")))

+95

(ready (lambda (value)

+96

(finish (if (eq? (dict-ref source kind: file:) dir:)

+97

(directory-excerpt value)

+98

(folder-preview-excerpt value)))))

+99

(read! (lambda ()

+100

(guard (error (else (failed error)))

+101

(let ((async (provider-async-op source)))

+102

(if async (async source ready failed)

+103

(ready (source-materialize source)))))))

+104

(check-size (lambda (stat)

+105

(let ((size (and stat (dict-ref stat size: #f))))

+106

(cond

+107

((not (current?)) (finish ""))

+108

((not (number? size)) (finish "Size unavailable · open to inspect"))

+109

((> size 262144) (finish "Large file · open to inspect"))

+110

(else (read!)))))))

+111

(folder-detail-set! v preview-text: "Loading…")

+112

(guard (error (else (failed error)))

+113

(cond

+114

((not (current?)) (finish ""))

+115

((eq? (dict-ref source kind: file:) dir:) (read!))

+116

((image-extension? (dict-ref entry name: ""))

+117

(let ((image-op (dict-ref (provider-for source) image-url: #f)))

+118

(if (not image-op)

+119

(finish "Image preview unavailable")

+120

(image-op source

+121

(lambda (url)

+122

(if (and (not completed?) (current?))

+123

(begin

+124

(folder-detail-set! v preview-image-source: source)

+125

(folder-detail-set! v preview-image-url: url))

+126

(release-image! source url))

+127

(finish ""))

+128

failed))))

+129

((number? (dict-ref entry size: #f)) (check-size entry))

+130

(else (source-stat source check-size failed))))

+131

(set! returned? #t))))

+132

+133

(define (preview! v visible? notify)

+134

(let* ((entry (folder-entry-at v))

+135

(enabled? (and visible? (dict-ref v slate/folder-preview?: #f)))

+136

(source (and entry enabled? (folder-child-source v entry)))

+137

(key (and source (list source (dict-ref v slate/folder-revision: 0)))))

+138

(unless (equal? key (folder-detail v preview-key: #f))

+139

(clear-image! v)

+140

(set! *preview-serial* (+ *preview-serial* 1))

+141

(folder-detail-set! v preview-key: key)

+142

(folder-detail-set! v preview-generation:

+143

(+ 1 (folder-detail v preview-generation: 0)))

+144

(folder-detail-set! v preview-text: "Waiting…")

+145

(folder-detail-set! v preview-start:

+146

(and source

+147

(preview-start v entry source key

+148

(folder-detail v preview-generation: 0) notify))))))

+149

+150

(define (git! v notify)

+151

(let* ((source (view-source v))

+152

(provider (provider-for source))

+153

(revision (dict-ref v slate/folder-revision: 0)))

+154

(when (and (dict-ref provider git-request: #f)

+155

(not (equal? revision (folder-detail v git-revision: #f))))

+156

(folder-detail-set! v git-revision: revision)

+157

(folder-detail-set! v git-capable?: #t)

+158

(let* ((returned? #f)

+159

(model

+160

(or (folder-detail v git-model: #f)

+161

(make-git-status-model

+162

(lambda (state)

+163

(when (folder-detail v alive?: #f)

+164

(let* ((error (dict-ref state error: #f))

+165

(code (and (dict? error) (dict-ref error code: #f))))

+166

(when (or (equal? code "not-a-repository")

+167

(eq? code not-a-repository:)

+168

(eq? (dict-ref state state: #f) unavailable:))

+169

(folder-detail-set! v git-capable?: #f)

+170

(folder-detail-set! v git-overlay: #{})))

+171

(folder-detail-set! v git-state: state)

+172

(let ((data (dict-ref state data: #f)))

+173

(when (and data (not (eq? data (folder-detail v git-data: #f))))

+174

(folder-detail-set! v git-data: data)

+175

(folder-detail-set! v git-overlay:

+176

(folder-git-overlay (folder-address v) data))))

+177

(when (and returned? (not *refreshing?*)) (notify))))))))

+178

(folder-detail-set! v git-model: model)

+179

(git-status-model-load! model source #f)

+180

(set! returned? #t)))))

+181

+182

(define (refresh-folder-enrichment! state now notify)

+183

(let* ((folders (filter folder? (views state)))

+184

(space (active-space state))

+185

(visible (if space (map leaf-view (space-leaves space)) (list))))

+186

(set! *refreshing?* #t)

+187

(for-each

+188

(lambda (old)

+189

(unless (any (lambda (v) (eq? (folder-cache old) (folder-cache v))) folders)

+190

(dispose! old)))

+191

*tracked*)

+192

(set! *tracked* folders)

+193

(for-each

+194

(lambda (v)

+195

(folder-detail-set! v alive?: #t)

+196

(folder-detail-set! v now: now)

+197

(when (folder-detail v listing-ready?: #f)

+198

(guard (error (else (folder-detail-set! v git-state: #{ state: error: })))

+199

(git! v notify))

+200

(preview! v (member (view-name v) visible) notify)))

+201

folders)

+202

(set! *refreshing?* #f)))))

packages/slate/src/slate/folder/model.sgladded

@@ -0,0 +1,107 @@

+1

;;; (slate folder model) — directory projection and optional metadata.

+2

(define-library (slate folder model)

+3

(import (sigil list)

+4

(sigil math)

+5

(sigil string)

+6

(slate providers localstorage))

+7

(export folder-project-entries folder-entry-hidden? folder-modified-text

+8

folder-git-overlay folder-preview-excerpt)

+9

(begin

+10

(define (folder-entry-hidden? entry)

+11

(dict-ref entry hidden:

+12

(string-starts-with? (dict-ref entry name: "") ".")))

+13

+14

(define (folder-project-entries entries sort hidden?)

+15

(list->vector

+16

(list-sort

+17

(lambda (a b)

+18

(let* ((ad (eq? (dict-ref a kind: file:) dir:))

+19

(bd (eq? (dict-ref b kind: file:) dir:))

+20

(field (if (eq? sort size:) size: mtime:))

+21

(av (dict-ref a field #f))

+22

(bv (dict-ref b field #f)))

+23

(cond

+24

((not (eq? ad bd)) ad)

+25

((and (not (eq? sort name:))

+26

(not (eq? (number? av) (number? bv))))

+27

(number? av))

+28

((and (not (eq? sort name:)) (number? av) (number? bv)

+29

(not (= av bv)))

+30

(if (eq? sort oldest:) (< av bv) (> av bv)))

+31

(else

+32

(string<? (dict-ref a name: "") (dict-ref b name: ""))))))

+33

(filter (lambda (entry) (or hidden? (not (folder-entry-hidden? entry))))

+34

(vector->list entries)))))

+35

+36

(define (folder-modified-text entry now)

+37

(let ((mtime (dict-ref entry mtime: #f)))

+38

(if (not (and (number? mtime) (number? now)))

+39

"—"

+40

(let ((age (max 0 (- now mtime))))

+41

(cond

+42

((< age 60) "just now")

+43

((< age 3600) (string-append (number->string (floor (/ age 60))) "m ago"))

+44

((< age 86400) (string-append (number->string (floor (/ age 3600))) "h ago"))

+45

(else (string-append (number->string (floor (/ age 86400))) "d ago")))))))

+46

+47

(define (git-badge entry)

+48

(let* ((kind (dict-ref entry kind: "ordinary"))

+49

(index (dict-ref entry index-state: "."))

+50

(worktree (dict-ref entry worktree-state: "."))

+51

(conflict? (or (string=? kind "conflict")

+52

(string=? index "U") (string=? worktree "U")))

+53

(untracked? (string=? kind "untracked"))

+54

(label (cond (conflict? "!") (untracked? "?")

+55

((not (string=? worktree ".")) worktree)

+56

(else index))))

+57

#{ label: label

+58

class: (cond (conflict? "conflict") (untracked? "untracked")

+59

((string=? label "A") "added") (else "modified"))

+60

priority: (cond (conflict? 4) (untracked? 1) (else 2))

+61

detail: (cond (conflict? "Conflict") (untracked? "Untracked")

+62

(else (string-append "Index: " index " · Worktree: " worktree))) }))

+63

+64

;; Build one name-keyed overlay per Git response. Directory aggregates are

+65

;; derived from descendants, without inserting deleted paths into the listing.

+66

(define (folder-git-overlay address data)

+67

(let* ((repo (dict-ref data repo: #{}))

+68

(root (dict-ref repo worktree: "/"))

+69

(prefix (string-append (if (string=? address "/") "" address) "/"))

+70

(raw (dict-ref data entries: '()))

+71

(entries (if (array? raw) (array->list raw) raw)))

+72

(fold-left

+73

(lambda (out entry)

+74

(let ((full (fs-join root (dict-ref entry path: ""))))

+75

(if (not (string-starts-with? full prefix))

+76

out

+77

(let* ((relative (substring full (string-length prefix) (string-length full)))

+78

(parts (string-split relative "/"))

+79

(name (car parts))

+80

(badge (git-badge entry))

+81

(badge (if (null? (cdr parts)) badge

+82

(dict-set badge detail:

+83

(string-append "Contains changes · "

+84

(dict-ref badge detail: "")))))

+85

(old (dict-ref out name #f)))

+86

(if (and old (> (dict-ref old priority: 0)

+87

(dict-ref badge priority: 0)))

+88

out

+89

(dict-set out name badge))))))

+90

#{} entries)))

+91

+92

;; Bound rendered text even for providers returning unusually long lines.

+93

;; NUL-bearing data is treated as binary, never interpreted as HTML.

+94

(define (folder-preview-excerpt text)

+95

(if (not (string? text))

+96

"Preview unavailable"

+97

(let ((limit (min 12000 (string-length text))))

+98

(let loop ((i 0) (lines 0))

+99

(cond

+100

((or (>= i limit) (>= lines 80))

+101

(string-append (substring text 0 i)

+102

(if (< i (string-length text)) "\n…" "")))

+103

((= (char->integer (string-ref text i)) 0) "Binary file")

+104

(else

+105

(loop (+ i 1)

+106

(if (char=? (string-ref text i) #\newline)

+107

(+ lines 1) lines))))))))))

packages/slate/src/slate/git/diff-model.sgladded

@@ -0,0 +1,149 @@

+1

;;; (slate git diff-model) — provider-neutral, generation-safe diff paging.

+2

(define-library (slate git diff-model)

+3

(import (sigil core) (sigil io) (sigil json)

+4

(slate provider) (slate git model))

+5

(export make-git-diff-model git-diff-model? git-diff-model-state

+6

git-diff-model-generation git-diff-model-load! git-diff-model-more!

+7

git-diff-model-invalidate! git-diff-model-reload! git-diff-reduce git-diff-lines

+8

git-diff-model-defer! git-diff-model-resume!

+9

git-diff-model-source git-diff-model-repo git-diff-model-snapshot

+10

git-diff-model-kind git-diff-model-target)

+11

(begin

+12

;; [tag state generation source repo snapshot kind target listener]

+13

(define (make-git-diff-model source repo snapshot kind target on-change)

+14

(vector 'git-diff-model #{ state: idle: pages: '() next-cursor: #f complete: #f }

+15

0 source repo snapshot kind target on-change))

+16

(define (git-diff-model? value)

+17

(and (vector? value) (= (vector-length value) 9)

+18

(eq? (vector-ref value 0) 'git-diff-model)))

+19

(define (git-diff-model-state model) (vector-ref model 1))

+20

(define (git-diff-model-generation model) (vector-ref model 2))

+21

(define (git-diff-model-source model) (vector-ref model 3))

+22

(define (git-diff-model-repo model) (vector-ref model 4))

+23

(define (git-diff-model-snapshot model) (vector-ref model 5))

+24

(define (git-diff-model-kind model) (vector-ref model 6))

+25

(define (git-diff-model-target model) (vector-ref model 7))

+26

(define (emit! model state)

+27

(vector-set! model 1 state)

+28

(let ((listener (vector-ref model 8))) (when listener (listener state)))

+29

state)

+30

(define (as-list value)

+31

(cond ((array? value) (array->list value)) ((list? value) value) (else '())))

+32

(define (git-diff-lines state)

+33

(fold-left

+34

(lambda (out page)

+35

(fold-left

+36

(lambda (lines file) (append lines (as-list (dict-ref file hunks: '()))))

+37

out (as-list (dict-ref page files: '()))))

+38

'() (as-list (dict-ref state pages: '()))))

+39

(define (git-diff-reduce state event)

+40

(case (dict-ref event event: error:)

+41

((begin:)

+42

(dict-set (dict-set state state: (if (null? (dict-ref state pages: '())) loading: stale:))

+43

generation: (dict-ref event generation: 0)))

+44

((page:)

+45

(let* ((page (dict-ref event page: #{}))

+46

(all-pages (append (if (dict-ref state rebasing: #f) '()

+47

(dict-ref state pages: '())) (list page)))

+48

;; Two v1 pages are the complete client-side render window.

+49

;; Older pages are discarded instead of making state grow with

+50

;; a multi-megabyte patch.

+51

(pages (if (> (length all-pages) 2)

+52

(list (list-ref all-pages (- (length all-pages) 2))

+53

(list-ref all-pages (- (length all-pages) 1)))

+54

all-pages)))

+55

#{ state: ready: generation: (dict-ref event generation: 0)

+56

pages: pages

+57

next-cursor: (dict-ref page next-cursor: #f)

+58

complete: (dict-ref page complete: #f) }))

+59

(else

+60

(dict-set (dict-set state state: error:)

+61

error: (dict-ref event error: operation-failed:)))))

+62

+63

(define (valid-page? model page)

+64

(and (dict? page) (= (dict-ref page version: 0) 1)

+65

(git-repository=? (dict-ref page repo: #{}) (vector-ref model 4))

+66

(git-snapshot=? (dict-ref page snapshot: #{}) (vector-ref model 5))

+67

(<= (dict-ref page payload-bytes: 262145) 262144)

+68

(<= (bytevector-length (string->utf8 (json-encode page))) 262144)

+69

(<= (length (fold-left

+70

(lambda (out file) (append out (as-list (dict-ref file hunks: '()))))

+71

'() (as-list (dict-ref page files: '())))) 400)))

+72

(define (cancel-current! model)

+73

(let ((cursor (dict-ref (git-diff-model-state model) next-cursor: #f)))

+74

(when cursor

+75

(source-git-request

+76

(vector-ref model 3) "git/diff"

+77

#{ repo: (vector-ref model 4) snapshot: (vector-ref model 5)

+78

kind: (vector-ref model 6) target: (vector-ref model 7)

+79

cursor: cursor cancel: #t max-lines: 400 max-bytes: 262144 }

+80

(lambda (ignored) #t) (lambda (ignored) #t)))))

+81

(define (cancel-page! model page repo snapshot)

+82

(let ((cursor (and (dict? page) (dict-ref page next-cursor: #f))))

+83

(when cursor

+84

(source-git-request

+85

(vector-ref model 3) "git/diff"

+86

#{ repo: repo snapshot: snapshot

+87

kind: (vector-ref model 6) target: (vector-ref model 7)

+88

cursor: cursor cancel: #t max-lines: 400 max-bytes: 262144 }

+89

(lambda (ignored) #t) (lambda (ignored) #t)))))

+90

(define (request! model cursor reset?)

+91

(let* ((generation (+ 1 (git-diff-model-generation model)))

+92

(repo (git-diff-model-repo model))

+93

(snapshot (git-diff-model-snapshot model))

+94

(state (if reset?

+95

#{ state: idle: pages: '() next-cursor: #f complete: #f }

+96

(git-diff-model-state model))))

+97

(vector-set! model 2 generation)

+98

(emit! model (git-diff-reduce state #{ event: begin: generation: generation }))

+99

(source-git-request

+100

(vector-ref model 3) "git/diff"

+101

#{ repo: (vector-ref model 4) snapshot: (vector-ref model 5)

+102

kind: (vector-ref model 6) target: (vector-ref model 7)

+103

cursor: cursor max-lines: 400 max-bytes: 262144 }

+104

(lambda (page)

+105

(if (= generation (git-diff-model-generation model))

+106

(if (valid-page? model page)

+107

(emit! model (git-diff-reduce (git-diff-model-state model)

+108

#{ event: page: generation: generation page: page }))

+109

(emit! model (git-diff-reduce (git-diff-model-state model)

+110

#{ event: error: error: operation-failed: })))

+111

(cancel-page! model page repo snapshot)))

+112

(lambda (error)

+113

(when (= generation (git-diff-model-generation model))

+114

(emit! model (git-diff-reduce (git-diff-model-state model)

+115

#{ event: error: error: error })))))

+116

generation))

+117

(define (git-diff-model-load! model)

+118

(cancel-current! model)

+119

(request! model #f #t))

+120

(define (git-diff-model-more! model)

+121

(let ((state (git-diff-model-state model)))

+122

(if (or (dict-ref state rebasing: #f)

+123

(eq? (dict-ref state state: #f) stale:)

+124

(dict-ref state complete: #f) (not (dict-ref state next-cursor: #f)))

+125

(git-diff-model-generation model)

+126

(request! model (dict-ref state next-cursor: #f) #f))))

+127

(define (git-diff-model-invalidate! model)

+128

(cancel-current! model)

+129

(vector-set! model 2 (+ 1 (git-diff-model-generation model)))

+130

(emit! model #{ state: idle: pages: '() next-cursor: #f complete: #f })

+131

(git-diff-model-generation model))

+132

;; Keep a bounded presentation while revoking its authority and cursor.

+133

;; A hidden review can wait until selected; no patch request is needed here.

+134

(define (git-diff-model-defer! model repo snapshot)

+135

(cancel-current! model)

+136

(vector-set! model 2 (+ 1 (git-diff-model-generation model)))

+137

(vector-set! model 4 repo)

+138

(vector-set! model 5 snapshot)

+139

(emit! model

+140

(dict-set (dict-set (dict-set (git-diff-model-state model)

+141

state: deferred:)

+142

next-cursor: #f)

+143

rebasing: #t)))

+144

(define (git-diff-model-resume! model)

+145

(when (eq? (dict-ref (git-diff-model-state model) state: #f) deferred:)

+146

(request! model #f #f)))

+147

(define (git-diff-model-reload! model repo snapshot)

+148

(git-diff-model-defer! model repo snapshot)

+149

(git-diff-model-resume! model))))

packages/slate/src/slate/git/diff-view.sgladded

@@ -0,0 +1,45 @@

+1

;;; (slate git diff-view) — pure bounded projection and navigation.

+2

(define-library (slate git diff-view)

+3

(import (sigil core) (sigil math) (slate git diff-model) (slate git model))

+4

(export git-diff-model git-diff-rows git-diff-selected-row git-diff-move

+5

git-diff-view-name)

+6

(begin

+7

(define mounted-row-ceiling 800)

+8

(define (git-diff-model v) (dict-ref v slate/git-diff-model: #f))

+9

(define (take xs n)

+10

(if (or (= n 0) (null? xs)) '() (cons (car xs) (take (cdr xs) (- n 1)))))

+11

(define (git-diff-rows v)

+12

(let* ((model (git-diff-model v))

+13

(state (if model (git-diff-model-state model) #{ pages: '() }))

+14

(lines (take (git-diff-lines state) (- mounted-row-ceiling 1)))

+15

(rows (let loop ((rest lines) (i 0) (out '()))

+16

(if (null? rest) (reverse out)

+17

(loop (cdr rest) (+ i 1)

+18

(cons (dict-set (car rest) id: (string-append "diff-line:" (number->string i))) out))))))

+19

(if (and (not (dict-ref state complete: #f)) (dict-ref state next-cursor: #f))

+20

(append rows (list #{ id: "diff-more" kind: continuation: text: "Load more…" }))

+21

rows)))

+22

(define (git-diff-selected-row v)

+23

(let ((id (dict-ref v slate/git-selected: #f)))

+24

(let loop ((rows (git-diff-rows v)))

+25

(cond ((null? rows) #f)

+26

((and id (string=? id (dict-ref (car rows) id: ""))) (car rows))

+27

(else (loop (cdr rows)))))))

+28

(define (git-diff-move v delta)

+29

(let* ((rows (git-diff-rows v)) (selected (dict-ref v slate/git-selected: #f)))

+30

(if (null? rows) v

+31

(let loop ((rest rows) (i 0) (found 0))

+32

(cond ((null? rest)

+33

(dict-set v slate/git-selected:

+34

(dict-ref (list-ref rows (max 0 (min (- (length rows) 1) (+ found delta)))) id: "")))

+35

((and selected (string=? selected (dict-ref (car rest) id: "")))

+36

(loop (cdr rest) (+ i 1) i))

+37

(else (loop (cdr rest) (+ i 1) found)))))))

+38

(define (git-diff-view-name repo kind target)

+39

(let ((key (git-repository-key repo)))

+40

(and key (string-append "*git-diff:" key ":" kind ":"

+41

(cond ((string? target) target)

+42

((dict? target)

+43

(string-append (dict-ref target path: "?") "@"

+44

(number->string (dict-ref target stage: 0))))

+45

(else "*")) "*"))))))

packages/slate/src/slate/git/log-model.sgladded

@@ -0,0 +1,134 @@

+1

;;; (slate git log-model) — one bounded history page and one lazy review.

+2

(define-library (slate git log-model)

+3

(import (sigil io) (sigil math) (sigil string) (sigil json) (slate provider) (slate git model)

+4

(slate git diff-model))

+5

(export make-git-log-model git-log-model-state git-log-model-repo git-log-model-revision

+6

git-log-model-load! git-log-model-refresh! git-log-model-page! git-log-model-inspect!

+7

git-log-model-dispose! git-history-oid? git-log-commits)

+8

(begin

+9

(define *revision* 0)

+10

(define (git-log-model-revision model) (vector-ref model 7))

+11

;; tag, state, page generation, source, repository, listener, show generation

+12

(define (make-git-log-model source repo listener)

+13

(vector 'git-log #{ state: idle: commits: '() offset: 0 review: #f }

+14

0 source repo listener 0 0 #f #f))

+15

(define (git-log-model-state model) (vector-ref model 1))

+16

(define (git-log-model-repo model) (vector-ref model 4))

+17

(define (as-list value)

+18

(cond ((array? value) (array->list value)) ((list? value) value) (else '())))

+19

(define (git-log-commits model)

+20

(as-list (dict-ref (git-log-model-state model) commits: '())))

+21

(define (git-history-oid? value)

+22

(and (string? value) (member (string-length value) '(40 64))

+23

(let loop ((i 0))

+24

(or (= i (string-length value))

+25

(and (string-contains? "0123456789abcdef" (substring value i (+ i 1)))

+26

(loop (+ i 1)))))))

+27

(define (emit! model state)

+28

(set! *revision* (+ *revision* 1))

+29

(vector-set! model 7 *revision*)

+30

(vector-set! model 1 state)

+31

(let ((listener (vector-ref model 5))) (when listener (listener state)))

+32

state)

+33

(define (valid-reply? model reply)

+34

(and (dict? reply) (= (dict-ref reply version: 0) 1)

+35

(git-repository=? (git-log-model-repo model) (dict-ref reply repo: #{}))

+36

(dict? (dict-ref reply snapshot: #f))

+37

(<= (bytevector-length (string->utf8 (json-encode reply))) 262144)))

+38

(define (valid-commit? commit)

+39

(and (dict? commit) (git-history-oid? (dict-ref commit oid: #f))

+40

(string? (dict-ref commit subject: #f))

+41

(let loop ((parents (as-list (dict-ref commit parents: '()))))

+42

(or (null? parents)

+43

(and (git-history-oid? (car parents)) (loop (cdr parents)))))))

+44

(define (cancel-review! model)

+45

(vector-set! model 9 #f)

+46

(vector-set! model 6 (+ 1 (vector-ref model 6)))

+47

(let* ((review (dict-ref (git-log-model-state model) review: #f))

+48

(diff (and review (dict-ref review diff: #f))))

+49

(when diff (git-diff-model-invalidate! diff))))

+50

(define (request! model cursor)

+51

(let ((generation (+ 1 (vector-ref model 2))))

+52

(vector-set! model 2 generation)

+53

(emit! model (dict-set (git-log-model-state model) state: loading:))

+54

(source-git-request (vector-ref model 3) "git/log"

+55

#{ repo: (git-log-model-repo model) limit: 50 cursor: cursor }

+56

(lambda (reply)

+57

(when (= generation (vector-ref model 2))

+58

(let ((commits (as-list (dict-ref reply commits: '()))))

+59

(if (and (valid-reply? model reply) (<= (length commits) 50)

+60

(let loop ((rest commits))

+61

(or (null? rest) (and (valid-commit? (car rest)) (loop (cdr rest))))))

+62

(emit! model

+63

(dict-set (dict-set reply state: ready:)

+64

review: (dict-ref (git-log-model-state model) review: #f)))

+65

(emit! model (dict-set (git-log-model-state model) state: error:))))))

+66

(lambda (error)

+67

(when (= generation (vector-ref model 2))

+68

(emit! model (dict-set (dict-set (git-log-model-state model)

+69

state: error:) error: error)))))))

+70

(define (git-log-model-load! model)

+71

(cancel-review! model)

+72

(emit! model (dict-set (git-log-model-state model) review: #f))

+73

(request! model #f))

+74

;; Ref-only mutations keep the page and explicitly opened commit review.

+75

(define (git-log-model-refresh! model)

+76

(let* ((state (git-log-model-state model))

+77

(offset (dict-ref state offset: 0)))

+78

(request! model

+79

(and (> offset 0)

+80

#{ head-oid: (dict-ref (dict-ref state snapshot: #{}) head-oid: "")

+81

offset: offset }))))

+82

(define (git-log-model-page! model direction)

+83

(let* ((state (git-log-model-state model))

+84

(offset (dict-ref state offset: 0))

+85

(cursor (if (> direction 0) (dict-ref state next-cursor: #f)

+86

(and (> offset 0)

+87

#{ head-oid: (dict-ref (dict-ref state snapshot: #{}) head-oid: "")

+88

offset: (max 0 (- offset 50)) }))))

+89

(when (and cursor (not (eq? (dict-ref state state: #f) loading:)))

+90

(request! model cursor))))

+91

;; At most one metadata request is in flight; rapid inspection retains

+92

;; only the newest requested commit. Generation checks still guard replies.

+93

(define (git-log-model-inspect! model oid)

+94

(when (git-history-oid? oid)

+95

(cancel-review! model)

+96

(vector-set! model 9 oid)

+97

(emit! model (dict-set (git-log-model-state model) review:

+98

#{ state: loading: oid: oid }))

+99

(inspect-next! model)))

+100

(define (inspect-next! model)

+101

(when (and (not (vector-ref model 8)) (vector-ref model 9))

+102

(let ((generation (vector-ref model 6)) (oid (vector-ref model 9)))

+103

(vector-set! model 8 #t)

+104

(vector-set! model 9 #f)

+105

(source-git-request (vector-ref model 3) "git/show"

+106

#{ repo: (git-log-model-repo model) oid: oid }

+107

(lambda (reply)

+108

(vector-set! model 8 #f)

+109

(when (= generation (vector-ref model 6))

+110

(let ((commit (dict-ref reply commit: #f)))

+111

(if (and (valid-reply? model reply) (valid-commit? commit)

+112

(equal? oid (dict-ref commit oid: #f)))

+113

(let ((diff

+114

(make-git-diff-model (vector-ref model 3) (git-log-model-repo model)

+115

(dict-ref reply snapshot: #{}) "commit" oid

+116

(lambda (ignored)

+117

(when (= generation (vector-ref model 6))

+118

(emit! model (git-log-model-state model)))))))

+119

(emit! model (dict-set (git-log-model-state model) review:

+120

#{ state: ready: oid: oid commit: commit diff: diff }))

+121

(git-diff-model-load! diff))

+122

(emit! model (dict-set (git-log-model-state model) review:

+123

#{ state: error: oid: oid })))))

+124

(inspect-next! model))

+125

(lambda (error)

+126

(vector-set! model 8 #f)

+127

(when (= generation (vector-ref model 6))

+128

(emit! model (dict-set (git-log-model-state model) review:

+129

#{ state: error: oid: oid error: error })))

+130

(inspect-next! model))))))

+131

(define (git-log-model-dispose! model)

+132

(vector-set! model 2 (+ 1 (vector-ref model 2)))

+133

(cancel-review! model)

+134

(emit! model #{ state: idle: commits: '() offset: 0 review: #f }))))

packages/slate/src/slate/git/log-view.sgladded

@@ -0,0 +1,56 @@

+1

;;; (slate git log-view) — stable selection and bounded ancestry lanes.

+2

(define-library (slate git log-view)

+3

(import (sigil math) (slate git model) (slate git log-model))

+4

(export git-log-model git-log-selected git-log-move git-log-view-name git-log-graph)

+5

(begin

+6

(define (git-log-model v) (dict-ref v slate/git-log-model: #f))

+7

(define (git-log-view-name repo)

+8

(let ((key (git-repository-key repo)))

+9

(and key (string-append "*git-log:" key "*"))))

+10

(define (git-log-selected v)

+11

(let* ((model (git-log-model v))

+12

(commits (if model (git-log-commits model) '()))

+13

(selected (dict-ref v slate/git-selected: #f)))

+14

(or (find (lambda (commit) (equal? selected (dict-ref commit oid: #f))) commits)

+15

(and (pair? commits) (car commits)))))

+16

(define (git-log-move v delta)

+17

(let* ((commits (git-log-commits (git-log-model v)))

+18

(selected (git-log-selected v)))

+19

(if (not selected) v

+20

(let loop ((rest commits) (i 0))

+21

(if (eq? (car rest) selected)

+22

(dict-set v slate/git-selected:

+23

(dict-ref (list-ref commits (max 0 (min (- (length commits) 1) (+ i delta)))) oid: ""))

+24

(loop (cdr rest) (+ i 1)))))))

+25

(define (index-of value values)

+26

(let loop ((rest values) (i 0))

+27

(cond ((null? rest) #f) ((equal? value (car rest)) i)

+28

(else (loop (cdr rest) (+ i 1))))))

+29

(define (take values n)

+30

(if (or (null? values) (= n 0)) '() (cons (car values) (take (cdr values) (- n 1)))))

+31

(define (unique values)

+32

(let loop ((rest values) (out '()))

+33

(cond ((null? rest) (reverse out))

+34

((member (car rest) out) (loop (cdr rest) out))

+35

(else (loop (cdr rest) (cons (car rest) out))))))

+36

;; Graph lanes are bounded to 12; full parent IDs remain available in the

+37

;; inspector when an unusually wide topology exceeds the visual lanes.

+38

(define (git-log-graph commits)

+39

(let loop ((rest commits) (lanes '()) (out '()))

+40

(if (null? rest) (reverse out)

+41

(let* ((commit (car rest)) (oid (dict-ref commit oid: ""))

+42

(parents-value (dict-ref commit parents: '()))

+43

(parents (if (array? parents-value) (array->list parents-value) parents-value))

+44

(before (if (member oid lanes) lanes (append lanes (list oid))))

+45

(lane (index-of oid before))

+46

(next (take (unique (fold-left

+47

(lambda (xs id) (append xs (if (equal? id oid) parents (list id))))

+48

'() before)) 12))

+49

(edges (filter (lambda (edge) (number? (cdr edge)))

+50

(append

+51

(map (lambda (id) (cons (index-of id before) (index-of id next)))

+52

(filter (lambda (id) (not (equal? id oid))) before))

+53

(map (lambda (id) (cons lane (index-of id next))) parents)))))

+54

(loop (cdr rest) next

+55

(cons #{ commit: commit lane: lane before: (length before)

+56

after: (length next) edges: edges } out))))))))

packages/slate/src/slate/git/model.sgladded

@@ -0,0 +1,354 @@

+1

;;; (slate git model) — provider-neutral Git repository/status client state.

+2

;;;

+3

;;; This module owns no transport and no view. A source selects its registered

+4

;;; root/provider, and the provider lowers `git/discover` / `git/status` onto the

+5

;;; node which owns that root. Request generations make late callbacks inert.

+6

+7

(define-library (slate git model)

+8

(import (sigil string)

+9

(slate provider)

+10

(slate root)

+11

(slate project))

+12

(export make-git-status-model git-status-model-state git-status-model-generation

+13

git-status-model-load! git-status-model-refresh!

+14

git-status-model-watch! git-status-model-watch-event! git-status-model-dispose!

+15

git-status-model-mutate! git-status-model-mutate-hunk!

+16

git-status-model-lock! git-status-model-unlock!

+17

git-status-reduce git-repository-key git-repository=?

+18

git-snapshot=? git-snapshot-key git-row-id)

+19

(begin

+20

+21

;; A model is [tag state generation listener]. State values are immutable

+22

;; dicts, so transitions stay independently testable through the reducer.

+23

(define (make-git-status-model on-change)

+24

;; [tag state generation listener refresh-in-flight? dirty? source project

+25

;; unsubscribe-thunks watched-repository-key]

+26

(vector 'git-status-model #{ state: idle: generation: 0 } 0 on-change

+27

#f #f #f #f '() #f))

+28

(define (git-status-model-state model) (vector-ref model 1))

+29

(define (git-status-model-generation model) (vector-ref model 2))

+30

+31

(define (emit! model state)

+32

(vector-set! model 1 state)

+33

(let ((listener (vector-ref model 3)))

+34

(when listener (listener state)))

+35

state)

+36

+37

(define (git-status-reduce state event)

+38

(let ((kind (dict-ref event event: error:)))

+39

(cond

+40

((eq? kind begin:)

+41

(let ((previous (dict-ref state data: #f)))

+42

(if previous

+43

#{ state: stale: generation: (dict-ref event generation: 0)

+44

data: previous }

+45

#{ state: loading: generation: (dict-ref event generation: 0) })))

+46

((eq? kind ready:)

+47

#{ state: ready: generation: (dict-ref event generation: 0)

+48

data: (dict-ref event data: #{}) })

+49

((eq? kind unavailable:)

+50

#{ state: unavailable: generation: (dict-ref event generation: 0)

+51

reason: (dict-ref event reason: git-unavailable:) })

+52

(else

+53

(let ((previous (dict-ref state data: #f)))

+54

(if previous

+55

#{ state: error: generation: (dict-ref event generation: 0)

+56

error: (dict-ref event error: operation-failed:)

+57

data: previous }

+58

#{ state: error: generation: (dict-ref event generation: 0)

+59

error: (dict-ref event error: operation-failed:) }))))))

+60

+61

(define (string-field d key)

+62

(let ((value (and (dict? d) (dict-ref d key #f))))

+63

(and (string? value) value)))

+64

+65

(define (git-repository-key repo)

+66

(let ((root (and (dict? repo) (dict-ref repo root: #f)))

+67

(worktree (string-field repo worktree:))

+68

(common-dir (string-field repo common-dir:)))

+69

(and root worktree common-dir

+70

(string-append (if (keyword? root) (keyword->string root) root)

+71

":" worktree "\n" common-dir))))

+72

+73

(define (git-repository=? a b)

+74

(let ((ak (git-repository-key a)) (bk (git-repository-key b)))

+75

(and ak bk (string=? ak bk))))

+76

+77

(define (git-snapshot=? a b)

+78

(and (dict? a) (dict? b)

+79

(equal? (dict-ref a head-oid: #f) (dict-ref b head-oid: #f))

+80

(equal? (dict-ref a index-id: #f) (dict-ref b index-id: #f))

+81

(equal? (dict-ref a worktree-id: #f) (dict-ref b worktree-id: #f))))

+82

+83

(define (git-snapshot-key snapshot)

+84

(and (dict? snapshot)

+85

(let ((head (dict-ref snapshot head-oid: #f))

+86

(index (dict-ref snapshot index-id: #f))

+87

(worktree (dict-ref snapshot worktree-id: #f)))

+88

(and (string? head) (string? index) (string? worktree)

+89

(string-append head "\n" index "\n" worktree)))))

+90

+91

(define (git-row-id repo snapshot entry)

+92

(let ((rk (git-repository-key repo))

+93

(eid (and (dict? entry) (dict-ref entry path: (dict-ref entry id: #f)))))

+94

;; Node entry IDs include the snapshot and are mutation authority.

+95

;; Presentation instead follows the repository-relative path. The host

+96

;; adds its section so staged and worktree rows remain independent.

+97

(and rk (string? eid) (string-append rk "\n" eid))))

+98

+99

(define (path-normalize path)

+100

(cond ((or (not path) (string=? path "")) "/")

+101

((string=? path "/") "/")

+102

((char=? (string-ref path (- (string-length path) 1)) #\/)

+103

(path-normalize (substring path 0 (- (string-length path) 1))))

+104

(else path)))

+105

+106

(define (path-parent path)

+107

(let ((path (path-normalize path)))

+108

(if (string=? path "/") "/"

+109

(let loop ((i (- (string-length path) 1)))

+110

(cond ((<= i 0) "/")

+111

((char=? (string-ref path i) #\/) (substring path 0 i))

+112

(else (loop (- i 1))))))))

+113

+114

(define (source-directory source)

+115

(let ((address (and source (dict-ref source address: #f))))

+116

(and (string? address)

+117

(dict-set

+118

(dict-set source kind: dir:)

+119

address:

+120

(if (eq? (dict-ref source kind: file:) dir:)

+121

(path-normalize address)

+122

(path-parent address))))))

+123

+124

(define (discovery-source source current-project)

+125

(if (and current-project (project-source? current-project source))

+126

(project-root current-project)

+127

(source-directory source)))

+128

+129

(define (git-capable? source)

+130

(let* ((provider-name (and source (dict-ref source provider: #f)))

+131

(provider (and provider-name (provider-ref provider-name))))

+132

(and provider (dict-ref provider git-request: #f) #t)))

+133

+134

(define (error-code error)

+135

(if (dict? error) (dict-ref error code: operation-failed:) error))

+136

+137

(define (unavailable-error? error)

+138

(let ((code (error-code error)))

+139

(or (eq? code git-unavailable:)

+140

(and (string? code) (string=? code "git-unavailable")))))

+141

+142

(define (valid-discovery? result)

+143

(let ((node-repo (and (dict? result) (dict-ref result node-repo: #f))))

+144

(and (= (dict-ref result version: 0) 1)

+145

(string-field node-repo worktree:)

+146

(string-field node-repo common-dir:))))

+147

+148

(define (valid-status? result repo)

+149

(and (dict? result)

+150

(= (dict-ref result version: 0) 1)

+151

(git-repository=? (dict-ref result repo: #{}) repo)

+152

(git-snapshot-key (dict-ref result snapshot: #f))))

+153

+154

(define (transition-error! model generation error)

+155

(when (= generation (git-status-model-generation model))

+156

(emit! model

+157

(git-status-reduce

+158

(git-status-model-state model)

+159

(if (unavailable-error? error)

+160

#{ event: unavailable: generation: generation reason: git-unavailable: }

+161

#{ event: error: generation: generation error: error })))

+162

(watch-settle! model)))

+163

+164

(define (watch-settle! model)

+165

(when (vector-ref model 4)

+166

(vector-set! model 4 #f)

+167

(when (vector-ref model 5)

+168

(vector-set! model 5 #f)

+169

;; An event can arrive after Git read its snapshot. Keep the returned

+170

;; data, but conservatively mark it stale without starting more work.

+171

(when (eq? (dict-ref (git-status-model-state model) state: #f) ready:)

+172

(git-status-model-watch-event! model

+173

(vector-ref model 6) (vector-ref model 7))))))

+174

+175

(define (git-status-model-load! model source current-project)

+176

(let* ((generation (+ 1 (git-status-model-generation model)))

+177

(target (discovery-source source current-project))

+178

(root (and target (source-root target))))

+179

(vector-set! model 2 generation)

+180

(emit! model

+181

(git-status-reduce (git-status-model-state model)

+182

#{ event: begin: generation: generation }))

+183

(if (or (not target) (not root) (not (git-capable? target)))

+184

(begin

+185

(emit! model

+186

(git-status-reduce (git-status-model-state model)

+187

#{ event: unavailable: generation: generation

+188

reason: git-unavailable: }))

+189

(watch-settle! model))

+190

(source-git-request

+191

target "git/discover" #{ path: (dict-ref target address: "/") }

+192

(lambda (discovery)

+193

(when (= generation (git-status-model-generation model))

+194

(if (not (valid-discovery? discovery))

+195

(transition-error! model generation operation-failed:)

+196

(let* ((node-repo (dict-ref discovery node-repo: #{}))

+197

(repo #{ root: (root-name-string root)

+198

worktree: (dict-ref node-repo worktree: "")

+199

common-dir: (dict-ref node-repo common-dir: "") }))

+200

(source-git-request

+201

target "git/status" #{ repo: repo recent-limit: 20 }

+202

(lambda (status)

+203

(when (= generation (git-status-model-generation model))

+204

(if (valid-status? status repo)

+205

(begin (emit! model

+206

(git-status-reduce

+207

(git-status-model-state model)

+208

#{ event: ready: generation: generation data: status }))

+209

(watch-settle! model))

+210

(transition-error! model generation operation-failed:))))

+211

(lambda (error) (transition-error! model generation error)))))))

+212

(lambda (error) (transition-error! model generation error))))

+213

generation))

+214

+215

(define (git-status-model-refresh! model source current-project)

+216

(let ((state (git-status-model-state model)))

+217

(if (or (vector-ref model 4)

+218

(eq? (dict-ref state state: #f) loading:)

+219

(eq? (dict-ref state mutation: #f) pending:))

+220

(git-status-model-generation model)

+221

(begin

+222

(vector-set! model 4 #t)

+223

(vector-set! model 5 #f)

+224

(vector-set! model 6 source)

+225

(vector-set! model 7 current-project)

+226

(git-status-model-load! model source current-project)))))

+227

+228

;; Watchers are advisory. External filesystem activity marks the current

+229

;; snapshot stale, but only an explicit user refresh starts Git work. This

+230

;; preserves expansion/selection during review and prevents build-output

+231

;; storms from monopolizing the node request lane.

+232

(define (git-status-model-watch-event! model source current-project)

+233

(vector-set! model 6 source)

+234

(vector-set! model 7 current-project)

+235

;; A mutation response already contains an authoritative fresh status.

+236

;; Ignore watcher noise caused by that mutation while it is pending: a

+237

;; competing load would advance the generation and make the mutation

+238

;; response inert, leaving stage/unstage apparently stuck.

+239

(cond

+240

((eq? (dict-ref (git-status-model-state model) mutation: #f) pending:)

+241

#t)

+242

((vector-ref model 4)

+243

;; Preserve the refreshing mode line until the explicit request ends.

+244

(vector-set! model 5 #t))

+245

(else

+246

(let* ((state (git-status-model-state model))

+247

(data (dict-ref state data: #f)))

+248

(when data

+249

(emit! model #{ state: stale: generation: (git-status-model-generation model)

+250

data: data external-change?: #t })))))

+251

#t)

+252

+253

(define (git-status-model-watch! model source current-project repo)

+254

(let ((key (git-repository-key repo)))

+255

(unless (and key (equal? key (vector-ref model 9)))

+256

(for-each (lambda (stop) (when stop (stop))) (vector-ref model 8))

+257

(vector-set! model 9 key)

+258

(vector-set! model 8

+259

(if (not key) '()

+260

(map (lambda (path)

+261

(source-subscribe (dict-set (dict-set source kind: dir:) address: path)

+262

(lambda (event)

+263

(git-status-model-watch-event! model source current-project))))

+264

(list (dict-ref repo worktree: "")

+265

(dict-ref repo common-dir: "")))))))

+266

#t)

+267

+268

(define (git-status-model-dispose! model)

+269

(for-each (lambda (stop) (when stop (stop))) (vector-ref model 8))

+270

(vector-set! model 8 '()) (vector-set! model 9 #f)

+271

(vector-set! model 4 #f) (vector-set! model 5 #f)

+272

(vector-set! model 2 (+ 1 (vector-ref model 2))) #t)

+273

+274

;; Repository operations (such as switching branches) share the model's

+275

;; mutation exclusion and install their authoritative returned status.

+276

(define (git-status-model-lock! model)

+277

(let ((before (git-status-model-state model)))

+278

(if (or (vector-ref model 4)

+279

(eq? (dict-ref before state: #f) loading:)

+280

(eq? (dict-ref before mutation: #f) pending:))

+281

#f

+282

(let ((token (vector model (git-status-model-generation model) before)))

+283

(emit! model (dict-set before mutation: pending:))

+284

token))))

+285

(define (git-status-model-unlock! token fresh)

+286

(when token

+287

(let* ((model (vector-ref token 0))

+288

(generation (vector-ref token 1))

+289

(before (vector-ref token 2))

+290

(repo (dict-ref (dict-ref before data: #{}) repo: #f)))

+291

(when (= generation (git-status-model-generation model))

+292

(if (valid-status? fresh repo)

+293

(emit! model #{ state: ready: generation: generation data: fresh mutation: complete: })

+294

(emit! model

+295

(dict-set (dict-set (dict-set before state: stale:)

+296

external-change?: #t) mutation: operation-failed:)))))))

+297

+298

(define (git-status-model-mutate! model source verb entry-id on-ready on-error)

+299

(let* ((generation (git-status-model-generation model))

+300

(state (git-status-model-state model))

+301

(data (dict-ref state data: #f))

+302

(repo (and data (dict-ref data repo: #f)))

+303

(snapshot (and data (dict-ref data snapshot: #f))))

+304

(if (or (vector-ref model 4)

+305

(eq? (dict-ref state mutation: #f) pending:)

+306

(not repo) (not snapshot) (not (string? entry-id)))

+307

(when on-error (on-error operation-failed:))

+308

(begin

+309

(emit! model (dict-set state mutation: pending:))

+310

(source-git-request source verb

+311

#{ repo: repo expected-snapshot: snapshot entry-id: entry-id }

+312

(lambda (fresh)

+313

(when (= generation (git-status-model-generation model))

+314

(if (valid-status? fresh repo)

+315

(begin

+316

(emit! model #{ state: ready: generation: generation data: fresh mutation: complete:

+317

changed-entry: entry-id })

+318

(when on-ready (on-ready fresh)))

+319

(begin

+320

(emit! model (dict-set state mutation: operation-failed:))

+321

(when on-error (on-error operation-failed:))))))

+322

(lambda (error)

+323

(when (= generation (git-status-model-generation model))

+324

(emit! model (dict-set state mutation: (error-code error)))

+325

(when on-error (on-error error)))))))))

+326

+327

(define (git-status-model-mutate-hunk! model source verb hunk-id on-ready on-error)

+328

(let* ((generation (git-status-model-generation model))

+329

(state (git-status-model-state model))

+330

(data (dict-ref state data: #f))

+331

(repo (and data (dict-ref data repo: #f)))

+332

(snapshot (and data (dict-ref data snapshot: #f))))

+333

(if (or (vector-ref model 4)

+334

(eq? (dict-ref state mutation: #f) pending:)

+335

(not repo) (not snapshot) (not (dict? hunk-id)))

+336

(when on-error (on-error operation-failed:))

+337

(begin

+338

(emit! model (dict-set state mutation: pending:))

+339

(source-git-request source verb

+340

#{ repo: repo expected-snapshot: snapshot hunk-id: hunk-id }

+341

(lambda (fresh)

+342

(when (= generation (git-status-model-generation model))

+343

(if (valid-status? fresh repo)

+344

(begin

+345

(emit! model #{ state: ready: generation: generation data: fresh mutation: complete:

+346

changed-entry: (dict-ref hunk-id file-id: #f) })

+347

(when on-ready (on-ready fresh)))

+348

(begin

+349

(emit! model (dict-set state mutation: operation-failed:))

+350

(when on-error (on-error operation-failed:))))))

+351

(lambda (error)

+352

(when (= generation (git-status-model-generation model))

+353

(emit! model (dict-set state mutation: (error-code error)))

+354

(when on-error (on-error error)))))))))))

packages/slate/src/slate/git/review.sgladded

@@ -0,0 +1,115 @@

+1

;;; Review continuity is presentation policy, independent of request authority.

+2

(define-library (slate git review)

+3

(import (sigil math) (sigil string) (slate components diff) (slate git status-view))

+4

(export git-review-status git-review-diff)

+5

(begin

+6

(define (row-id row) (dict-ref row id: #f))

+7

(define (row-for rows id)

+8

(and id (find (lambda (row) (equal? id (row-id row))) rows)))

+9

(define (owner row)

+10

(dict-ref row owner: (and (eq? (dict-ref row kind: #f) entry:) (row-id row))))

+11

(define (hunk? row) (diff-kind=? (diff-row-kind row) hunk:))

+12

(define (same-text? a b)

+13

(and (eq? (diff-row-kind a) (diff-row-kind b))

+14

(equal? (dict-ref a text: #f) (dict-ref b text: #f))))

+15

(define (position rows id)

+16

(let loop ((rest rows) (i 0))

+17

(cond ((null? rest) 0)

+18

((equal? id (row-id (car rest))) i)

+19

(else (loop (cdr rest) (+ i 1))))))

+20

(define (near rows old-rows id)

+21

(and (pair? rows)

+22

(list-ref rows (min (- (length rows) 1) (position old-rows id)))))

+23

;; Prefer the same hunk/line, then a nearby hunk in that file. When the

+24

;; file leaves its section, continue with the next file in that section.

+25

;; This operates on the current view, so navigation during a request wins.

+26

(define (reselect v before)

+27

(let* ((wanted (dict-ref v slate/git-selected: #f))

+28

(old (row-for before wanted))

+29

(rows (git-status-rows v))

+30

(exact (row-for rows wanted))

+31

(own (and old (owner old)))

+32

(entry (and own (row-for before own)))

+33

(section (and entry (dict-ref entry section: #f)))

+34

(same-owner (lambda (row) (and own (equal? own (owner row)))))

+35

(same-section (lambda (row)

+36

(and (eq? (dict-ref row kind: #f) entry:)

+37

(equal? section (dict-ref row section: #f)))))

+38

(hunks (filter (lambda (row) (and (same-owner row) (hunk? row))) rows))

+39

(old-hunks (filter (lambda (row) (and (same-owner row) (hunk? row))) before))

+40

(target

+41

(or (and exact (or (not own) (not (dict-ref old owner: #f))

+42

(same-text? old exact)) exact)

+43

(and old own

+44

(find (lambda (row) (and (same-owner row) (same-text? old row))) rows))

+45

(and (dict-ref (or old #{}) owner: #f)

+46

(near hunks old-hunks wanted))

+47

(row-for rows own)

+48

(and section (near (filter same-section rows)

+49

(filter same-section before) own))

+50

(and entry

+51

(find (lambda (row)

+52

(and (eq? (dict-ref row kind: #f) entry:)

+53

(equal? (dict-ref (dict-ref row entry: #{}) path: #f)

+54

(dict-ref (dict-ref entry entry: #{}) path: #f)))) rows))

+55

(and wanted (near (filter (lambda (row) (dict-ref row meaningful?: #f)) rows)

+56

(filter (lambda (row) (dict-ref row meaningful?: #f)) before)

+57

wanted)))))

+58

(dict-set (dict-set v slate/git-selected: (and target (row-id target)))

+59

slate/git-review-version: (+ 1 (dict-ref v slate/git-review-version: 0)))))

+60

(define (git-review-status v data)

+61

(let* ((before (git-status-rows v))

+62

(next (dict-set v slate/git-data: data))

+63

;; Section folding hides rows, but does not close their reviews.

+64

(entries (git-status-rows

+65

(dict-set (dict-set next slate/git-folded: '())

+66

slate/git-inline-models: '())))

+67

(models (filter (lambda (pair) (row-for entries (car pair)))

+68

(dict-ref v slate/git-inline-models: '())))

+69

(folded (filter (lambda (id)

+70

(any (lambda (pair)

+71

(string-starts-with? id (string-append (car pair) ":hunk:")))

+72

models))

+73

(dict-ref v slate/git-hunk-folded: '()))))

+74

(reselect (dict-set (dict-set next slate/git-inline-models: models)

+75

slate/git-hunk-folded: folded) before)))

+76

(define (hunk-body rows id)

+77

(let loop ((rest rows))

+78

(cond ((null? rest) '())

+79

((equal? id (row-id (car rest)))

+80

(let collect ((tail (cdr rest)) (out '()))

+81

(if (or (null? tail) (hunk? (car tail))

+82

(not (equal? (owner (car rest)) (owner (car tail)))))

+83

(reverse out)

+84

(collect (cdr tail) (cons (dict-ref (car tail) text: "") out)))))

+85

(else (loop (cdr rest))))))

+86

(define (git-review-diff v id previous)

+87

(let* ((old-view (dict-set v slate/git-diff-state: (cons id previous)))

+88

(before (git-status-rows old-view))

+89

(unfolded-old (git-status-rows (dict-set old-view slate/git-hunk-folded: '())))

+90

(unfolded-new (git-status-rows (dict-set v slate/git-hunk-folded: '())))

+91

(hunks (filter (lambda (row) (and (equal? id (owner row)) (hunk? row))) unfolded-new))

+92

(selected (row-for unfolded-old (dict-ref v slate/git-selected: #f)))

+93

(selected-match

+94

(and selected (hunk? selected) (equal? id (owner selected))

+95

(matching-hunk unfolded-old unfolded-new hunks (row-id selected))))

+96

(folded

+97

(filter string?

+98

(map (lambda (fold)

+99

(let ((old (row-for unfolded-old fold)))

+100

(cond ((not (and old (equal? id (owner old)))) fold)

+101

((row-for unfolded-new fold) fold)

+102

(else

+103

(let ((match (matching-hunk unfolded-old unfolded-new hunks fold)))

+104

(and match (row-id match)))))))

+105

(dict-ref v slate/git-hunk-folded: '())))))

+106

(reselect (dict-set (if selected-match

+107

(dict-set v slate/git-selected: (row-id selected-match)) v)

+108

slate/git-hunk-folded: folded) before)))

+109

(define (matching-hunk before after hunks id)

+110

(or (row-for after id)

+111

(let* ((body (hunk-body before id))

+112

(matches (filter (lambda (row)

+113

(equal? body (hunk-body after (row-id row)))) hunks)))

+114

;; Repeated or partial bodies are ambiguous.

+115

(and (pair? body) (= (length matches) 1) (car matches)))))))

packages/slate/src/slate/git/status-view.sgladded

@@ -0,0 +1,247 @@

+1

;;; (slate git status-view) — pure row, selection, and folding projection.

+2

(define-library (slate git status-view)

+3

(import (sigil core) (sigil math) (sigil string) (slate components diff)

+4

(slate git diff-model) (slate git model))

+5

(export git-status-model git-status-rows git-status-move git-status-toggle

+6

git-status-selected-row git-status-view-name git-status-repository-view-name

+7

make-git-status-row-cache git-status-row-revision)

+8

(begin

+9

(define mounted-row-ceiling 800)

+10

(define (take xs n)

+11

(if (or (= n 0) (null? xs)) '() (cons (car xs) (take (cdr xs) (- n 1)))))

+12

(define (git-status-view-name source)

+13

(let ((root (dict-ref source root: (dict-ref source provider: unknown:))))

+14

(string-append "*git-status:"

+15

(if (keyword? root) (keyword->string root)

+16

(if (string? root) root "unknown"))

+17

":" (dict-ref source address: "/") "*")))

+18

(define (git-status-repository-view-name repo)

+19

(let ((key (git-repository-key repo)))

+20

(and key (string-append "*git-status:" key "*"))))

+21

(define (git-status-model v) (dict-ref v slate/git-model: #f))

+22

(define (model-state v)

+23

(let ((model (git-status-model v)))

+24

(if model (git-status-model-state model) #{ state: loading: })))

+25

(define (status-data v)

+26

(dict-ref v slate/git-data: (dict-ref (model-state v) data: #{})))

+27

(define (as-list value)

+28

(cond ((array? value) (array->list value))

+29

((list? value) value)

+30

(else '())))

+31

(define (entry-section entry)

+32

(let ((kind (dict-ref entry kind: "ordinary"))

+33

(index (dict-ref entry index-state: "."))

+34

(worktree (dict-ref entry worktree-state: ".")))

+35

(cond ((or (string=? kind "conflict") (string=? index "U") (string=? worktree "U")) conflicts:)

+36

((string=? kind "untracked") untracked:)

+37

((not (string=? index ".")) staged:)

+38

(else unstaged:))))

+39

(define (entry-in-section? entry key)

+40

(let ((kind (dict-ref entry kind: "ordinary"))

+41

(index (dict-ref entry index-state: "."))

+42

(worktree (dict-ref entry worktree-state: ".")))

+43

(cond ((eq? key conflicts:)

+44

(or (string=? kind "conflict") (string=? index "U") (string=? worktree "U")))

+45

((eq? key untracked:) (string=? kind "untracked"))

+46

((or (string=? kind "conflict") (string=? kind "untracked")) #f)

+47

((eq? key staged:) (not (string=? index ".")))

+48

((eq? key unstaged:) (not (string=? worktree ".")))

+49

(else #f))))

+50

(define sections

+51

(list (cons conflicts: "Conflicts") (cons untracked: "Untracked")

+52

(cons unstaged: "Unstaged") (cons staged: "Staged")))

+53

(define (section-id key) (string-append "section:" (keyword->string key)))

+54

(define (row-id data entry section)

+55

(string-append

+56

(or (git-row-id (dict-ref data repo: #{}) (dict-ref data snapshot: #{}) entry)

+57

(dict-ref entry id: (dict-ref entry path: "entry")))

+58

"\n" (keyword->string section)))

+59

(define (entries-for entries key)

+60

(filter (lambda (entry) (entry-in-section? entry key)) entries))

+61

(define (inline-model v id)

+62

(let ((found (assoc id (dict-ref v slate/git-inline-models: '()))))

+63

(and found (cdr found))))

+64

(define (range-parts token)

+65

(let* ((body (substring token 1 (string-length token)))

+66

(parts (string-split body ",")))

+67

(cons (or (string->number (car parts)) 0)

+68

(if (null? (cdr parts)) 1 (or (string->number (cadr parts)) 0)))))

+69

(define (hunk-identity entry-id side line)

+70

(let* ((header (dict-ref line text: "")) (parts (string-split header " "))

+71

(old (and (>= (length parts) 3) (range-parts (list-ref parts 1))))

+72

(new (and old (range-parts (list-ref parts 2)))))

+73

(and old new

+74

#{ file-id: entry-id side: side

+75

old-start: (dict-ref line old-start: (car old))

+76

old-lines: (dict-ref line old-lines: (cdr old))

+77

new-start: (dict-ref line new-start: (car new))

+78

new-lines: (dict-ref line new-lines: (cdr new))

+79

context-hash: (dict-ref line context-hash: header) })))

+80

(define (hunk-row-id owner identity)

+81

(and identity

+82

(string-append owner ":hunk:"

+83

(dict-ref identity side: "") ":"

+84

(number->string (dict-ref identity old-start: 0)) ":"

+85

(number->string (dict-ref identity new-start: 0)) ":"

+86

(dict-ref identity context-hash: ""))))

+87

(define (inline-rows v entry-id file-id side)

+88

(let ((model (inline-model v entry-id)))

+89

(if (not model) '()

+90

(let* ((override (dict-ref v slate/git-diff-state: #f))

+91

(state (if (and override (equal? (car override) entry-id))

+92

(cdr override) (git-diff-model-state model)))

+93

(kind (dict-ref state state: idle:))

+94

(authoritative? (and (not (dict-ref state rebasing: #f))

+95

(member kind (list ready: stale:))

+96

(git-snapshot=? (git-diff-model-snapshot model)

+97

(dict-ref (status-data v) snapshot: #{}))))

+98

(folded (dict-ref v slate/git-hunk-folded: '())))

+99

(cond

+100

((or (eq? kind idle:) (eq? kind loading:)

+101

(and (eq? kind deferred:) (null? (git-diff-lines state))))

+102

(list #{ id: (string-append entry-id ":loading") kind: loading:

+103

text: "Loading diff…" meaningful?: #f owner: entry-id }))

+104

((and (eq? kind error:) (null? (git-diff-lines state)))

+105

(list #{ id: (string-append entry-id ":error") kind: error:

+106

text: "Diff failed or became stale." meaningful?: #f owner: entry-id

+107

review-state: error: }))

+108

(else

+109

(let loop ((lines (git-diff-lines state)) (index 0) (hidden? #f) (out '()))

+110

(if (null? lines)

+111

(reverse

+112

(if (and (not (dict-ref state complete: #f))

+113

(dict-ref state next-cursor: #f))

+114

(cons #{ id: (string-append entry-id ":more") kind: continuation:

+115

text: "Load more…" meaningful?: #t owner: entry-id } out)

+116

out))

+117

(let* ((line (car lines)) (line-kind (diff-row-kind line))

+118

(identity (and (diff-kind=? line-kind hunk:)

+119

(hunk-identity file-id side line)))

+120

(hid (hunk-row-id entry-id identity))

+121

(next-hidden (if hid (if (member hid folded) #t #f) hidden?))

+122

(id (or hid (string-append entry-id ":line:" (number->string index))))

+123

(row (dict-set

+124

                                     (dict-set (dict-set (dict-set (dict-set line kind: line-kind) id: id) owner: entry-id)

+125

hunk-id: (and authoritative? identity))

+126

meaningful?: #t))

+127

(row (dict-set row review-state: kind))

+128

(row (if hid (dict-set row folded?: next-hidden) row)))

+129

(loop (cdr lines) (+ index 1) next-hidden

+130

(if (and next-hidden (not hid)) out (cons row out))))))))))))

+131

(define (git-status-rows-base v)

+132

(let* ((data (status-data v)) (entries (as-list (dict-ref data entries: '())))

+133

(folded (dict-ref v slate/git-folded: '())))

+134

(take

+135

(append

+136

(fold-left

+137

(lambda (out pair)

+138

(let* ((key (car pair)) (members (entries-for entries key)) (sid (section-id key)))

+139

(if (null? members) out

+140

(append out

+141

(list #{ id: sid kind: section: section: key label: (cdr pair)

+142

count: (length members) meaningful?: #t })

+143

(if (member sid folded) '()

+144

(fold-left

+145

(lambda (rows entry)

+146

(let ((id (row-id data entry key)))

+147

(append rows

+148

(list #{ id: id kind: entry: section: key meaningful?: #t entry: entry

+149

expanded: (if (inline-model v id) #t #f) })

+150

'())))

+151

'() members))))))

+152

'() sections)

+153

(let ((commits (as-list (dict-ref data recent-commits: '())))

+154

(sid "section:recent-commits"))

+155

(if (null? commits) '()

+156

(append (list #{ id: sid kind: section: section: recent-commits:

+157

label: "Recent commits" count: (length commits) meaningful?: #t })

+158

(if (member sid folded) '()

+159

(map (lambda (commit) #{ id: (string-append "commit:" (dict-ref commit oid: "unknown"))

+160

kind: commit: meaningful?: #t commit: commit }) commits))))))

+161

mounted-row-ceiling)))

+162

;; A view owns its bounded projection cache. Selection is deliberately not

+163

;; an input: moving point changes neither rows nor mutation authority.

+164

;; Models are mutable, so compare their current states and snapshots too.

+165

;; Revisions are unique across view lifetimes, including replacing a view

+166

;; for the same repository in a retained pane.

+167

(define *row-revision* 0)

+168

(define (make-git-status-row-cache) (vector #f '() #f))

+169

(define (git-status-row-revision v)

+170

(git-status-rows v)

+171

(let ((cache (dict-ref v slate/git-row-cache: #f)))

+172

(and cache (vector-ref cache 2))))

+173

(define (row-inputs v)

+174

(append

+175

(list (status-data v)

+176

(dict-ref v slate/git-folded: '())

+177

(dict-ref v slate/git-hunk-folded: '())

+178

(dict-ref v slate/git-inline-models: '())

+179

(dict-ref v slate/git-diff-state: #f))

+180

(fold-right

+181

(lambda (pair out)

+182

(cons (git-diff-model-state (cdr pair))

+183

(cons (git-diff-model-snapshot (cdr pair)) out)))

+184

'() (dict-ref v slate/git-inline-models: '()))))

+185

(define (same-inputs? a b)

+186

(and (list? b)

+187

(cond ((null? a) (null? b))

+188

((null? b) #f)

+189

(else (and (eq? (car a) (car b))

+190

(same-inputs? (cdr a) (cdr b)))))))

+191

(define (git-status-rows v)

+192

(let ((cache (dict-ref v slate/git-row-cache: #f)))

+193

(if (not cache) (project-rows v)

+194

(let ((inputs (row-inputs v)))

+195

(if (same-inputs? inputs (vector-ref cache 0))

+196

(vector-ref cache 1)

+197

(let ((rows (project-rows v)))

+198

(set! *row-revision* (+ *row-revision* 1))

+199

(vector-set! cache 0 inputs)

+200

(vector-set! cache 1 rows)

+201

(vector-set! cache 2 *row-revision*)

+202

rows))))))

+203

(define (project-rows v)

+204

(let* ((base (git-status-rows-base v))

+205

(expanded

+206

(fold-left

+207

(lambda (out row)

+208

(append out (list row)

+209

(if (and (eq? (dict-ref row kind: #f) entry:)

+210

(dict-ref row expanded: #f))

+211

(inline-rows v (dict-ref row id: "")

+212

(dict-ref (dict-ref row entry: #{}) id: "")

+213

(if (eq? (dict-ref row section: #f) staged:) "staged" "worktree")) '())))

+214

'() base)))

+215

(take expanded mounted-row-ceiling)))

+216

(define (git-status-selected-row v)

+217

(let ((wanted (dict-ref v slate/git-selected: #f)))

+218

(let loop ((rows (git-status-rows v)))

+219

(cond ((null? rows) #f)

+220

((and wanted (string=? wanted (dict-ref (car rows) id: ""))) (car rows))

+221

(else (loop (cdr rows)))))))

+222

(define (select-valid v)

+223

(if (git-status-selected-row v) v

+224

(let ((rows (filter (lambda (row) (dict-ref row meaningful?: #f))

+225

(git-status-rows v))))

+226

(if (null? rows) v (dict-set v slate/git-selected: (dict-ref (car rows) id: #f))))))

+227

(define (git-status-move v delta)

+228

(let* ((v (select-valid v))

+229

(rows (filter (lambda (row) (dict-ref row meaningful?: #f))

+230

(git-status-rows v)))

+231

(wanted (dict-ref v slate/git-selected: #f)))

+232

(let loop ((rest rows) (index 0) (found 0))

+233

(cond ((null? rest)

+234

(if (null? rows) v

+235

(dict-set v slate/git-selected:

+236

(dict-ref (list-ref rows (max 0 (min (- (length rows) 1) (+ found delta)))) id: #f))))

+237

((and wanted (string=? wanted (dict-ref (car rest) id: "")))

+238

(loop (cdr rest) (+ index 1) index))

+239

(else (loop (cdr rest) (+ index 1) found))))))

+240

(define (git-status-toggle v)

+241

(let ((row (git-status-selected-row v)))

+242

(if (and row (eq? (dict-ref row kind: #f) section:))

+243

(let* ((id (dict-ref row id: "")) (folded (dict-ref v slate/git-folded: '())))

+244

(dict-set v slate/git-folded:

+245

(if (member id folded)

+246

(filter (lambda (x) (not (string=? x id))) folded)

+247

(cons id folded)))) v)))))

packages/slate/src/slate/ledge.sglmodified

@@ -88,8 +88,10 @@

88

(span (@ (class "ledge-sep")) " ▸"))))

89

(ledge-item id: 'echo slot: 'center order: 0

90

render: (lambda (s)

−91

`(span (@ (class ,(if (dict-ref s slate/echo-fading?: #f)

−92

"ledge-echo fading" "ledge-echo")))

+91

`(span (@ (class "ledge-echo")

+92

(data-echo-generation

+93

,(number->string

+94

(dict-ref s slate/echo-generation: 0))))

95

,(dict-ref s slate/echo: ""))))

96

;; The first LIVE item: a wall-clock/date. mobile-hidden? by default (the

97

;; phone has its own clock — David). refresh-ms drives the metronome tick.

packages/slate/src/slate/list.sglmodified

@@ -1,9 +1,11 @@

1

;;; (slate list) — small shared list operations missing from the pinned stdlib.

2

(define-library (slate list)

3

(import (sigil core))

−4

(export list-last)

+4

(export list-last drop-last)

5

(begin

6

;; Callers establish non-empty input; match the historical Slate helpers'

7

;; behavior rather than inventing an empty-list sentinel.

8

(define (list-last xs)

−9

(if (null? (cdr xs)) (car xs) (list-last (cdr xs))))))

+9

(if (null? (cdr xs)) (car xs) (list-last (cdr xs))))

+10

(define (drop-last xs)

+11

(if (null? (cdr xs)) '() (cons (car xs) (drop-last (cdr xs)))))))

packages/slate/src/slate/main.sglmodified

@@ -12,10 +12,12 @@

12

(define-library (slate main)

13

(import (sigil core)

14

(sigil io)

+15

(sigil list)

16

(sigil math)

17

(sigil dict)

18

(sigil string)

19

(sigil json)

+20

(sigil time)

21

(sigil web client)

22

(slate theme)

23

(slate face)

@@ -23,6 +25,9 @@

25

(slate command)

26

(slate list)

27

(slate hooks)

+28

(slate modes git-status)

+29

(slate modes git-diff)

+30

(slate modes git-log)

31

(slate commands accessory)

32

(slate commands appearance)

33

(slate commands display)

@@ -34,6 +39,8 @@

39

(slate commands enclave)

40

(slate commands file)

41

(slate commands folder)

+42

(slate folder enrichment)

+43

(slate commands git) (slate commands git branch)

44

(slate commands help)

45

(slate commands image)

46

(slate commands pane)

@@ -80,6 +87,7 @@

87

(slate modes web)

88

(slate modes image)

89

(slate modes welcome)

+90

(slate modes node-status)

91

(slate notifications)

92

(slate modes notifications)

93

(slate modes agent-session)

@@ -111,22 +119,25 @@

119

(slate boot)

120

(slate main preferences))

121

(export main slate-refresh slate-dispatch notify slate-set-text slate-rehighlight

+122

slate-folder-take-motion slate-folder-preview-token slate-folder-preview-flush

123

slate-rehighlight-window

124

slate-editor-underlay-html slate-faces-css

125

slate-editor-lines-html slate-editor-lines-text

126

slate-buffer-line-count slate-editor-rev

−118

slate-editor-sync slate-unfold-at slate-test-fill

+127

slate-editor-sync slate-unfold-at slate-test-fill slate-test-agent-diff

128

slate-compose-begin slate-compose-end slate-auto-pairs?

129

slate-line-numbers

130

slate-buffer-input slate-buffer-set-all slate-buffer-length

131

slate-editor-value slate-editor-caret slate-editor-anchor

132

slate-assist slate-set-cursor

−124

slate-accessory-key

+133

slate-accessory-key slate-accessory-modifier slate-copy-modifiers

134

slate-test-key-event

−126

slate-selector-set

+135

slate-selector-set slate-selector-set-profile

136

slate-term-take-frame slate-term-resize slate-term-scroll

−128

slate-term-paste slate-term-send-mouse slate-term-mouse-active

+137

slate-term-prediction-enabled slate-term-take-prediction-input

+138

slate-term-paste slate-term-compose slate-term-send-mouse slate-term-mouse-active

139

slate-term-scroll-gesture

+140

slate-term-copy-snapshot slate-term-copy-end slate-term-received-clip

141

slate-tmux-size

142

;; OSC-52 staged clipboard (§10): JS reads the staged text (take gesture)

143

;; and confirms a successful system-clipboard write.

@@ -136,6 +147,11 @@

147

;; the WEB kernel's entry points (the embedded-iframe view)

148

slate-web-set-engaged slate-web-set-load-state slate-web-set-title

149

slate-eval-to-string

+150

slate-client-update-take slate-client-update-available

+151

slate-performance-capture-take slate-performance-capture-report

+152

slate-performance-trace-set slate-performance-trace-poll

+153

slate-wake-lock-wanted slate-wake-lock-report

+154

slate-node-status-deliver

155

slate-enclave-tick slate-enclave-active? slate-set-enclave-ws-url

156

;; R3a. Exported for the SAME reason as slate-node-retry below: the JS

157

;; bridge reaches these only through the eval channel, so without an

@@ -143,7 +159,7 @@

159

;; time in the shipped build only.

160

slate-enclave-retry slate-enclave-link-state slate-enclave-set-ping-enabled

161

slate-enclave-diag

−146

slate-echo-tick slate-ledge-tick

+162

slate-echo-animation-done slate-ledge-tick

163

;; the Lantern host bridge: JS glue entry points + the boot hook

164

slate-lantern-available! slate-lantern-poll

165

slate-lantern-deliver slate-lantern-event slate-lantern-boot

@@ -156,7 +172,7 @@

172

slate-node-request-pair slate-node-retry slate-node-pair-exchange

173

slate-node-connected?

174

slate-agent-provider-secret-submit

−159

slate-node-blob-poll slate-node-blob-bytes slate-node-blob-ready

+175

slate-node-blob-poll slate-node-blob-bytes slate-node-blob-ready slate-node-blob-mime

176

slate-node-image-via-blob

177

;; the browser-fs bridge (OPFS + FSAPI): JS glue entry points. Same

178

;; queue/tick/dispatch shape as the Lantern bridge, Resource plane only.

@@ -549,6 +565,15 @@

565

566

;; ---- sticky modifiers (design §6): fold armed [C]/[M] into the props -------

567

(define (sticky-mods state) (dict-ref state slate/sticky-mods: #{ ctrl: 'off alt: 'off }))

+568

;; Use the normal modifier reducer without replacing focused DOM. The host

+569

;; updates the chips, just as it does when consuming a one-shot modifier.

+570

(define (slate-accessory-modifier which)

+571

(if (or (string=? which "ctrl") (string=? which "alt"))

+572

(begin

+573

(set! *state* (handle *state* (string-append "sticky-mod:" which)))

+574

(symbol->string (dict-ref (sticky-mods *state*)

+575

(if (string=? which "ctrl") ctrl: alt:) 'off)))

+576

""))

577

(define (sticky-armed? s k) (let ((v (dict-ref s k 'off))) (or (eq? v 'once) (eq? v 'locked))))

578

;; Fold armed sticky mods into a props dict (OR with any real modifier) so a

579

;; hardware, bar, or OSK key composes with them. Called at the slate-handle-key

@@ -571,6 +596,14 @@

596

(s2 (if (eq? (dict-ref s2 alt: 'off) 'once) (dict-set s2 alt: 'off) s2)))

597

(set! *state* (dict-set *state* slate/sticky-mods: s2))))

598

+599

(define (slate-copy-modifiers)

+600

(let* ((mods (sticky-mods *state*))

+601

(prefix (string-append

+602

(if (sticky-armed? mods ctrl:) "C-" "")

+603

(if (sticky-armed? mods alt:) "M-" ""))))

+604

(clear-once-sticky!)

+605

prefix))

+606

607

;; Prompt text input is owned here, at the same key-event boundary as prompt

608

;; commands. Relying on the browser's default insertion made the frame bridge

609

;; return fall-through without ever updating the app-db query. Editor typing

@@ -707,7 +740,16 @@

740

(else (slate-dispatch res) #t))))))))))))

741

742

(define (slate-handle-key props)

−710

(slate-handle-key/core props slate-refresh))

+743

;; Direct prompt editing (printable keys, Backspace, confirm reminders)

+744

;; changes only selector state. Commands still call slate-dispatch and take

+745

;; the full refresh path, so accept/close/drill and every broader mutation

+746

;; update both the frame and palette mounts.

+747

(slate-handle-key/core

+748

props

+749

(lambda ()

+750

(if (minibuffer-open? *state*)

+751

(slate-selector-refresh)

+752

(slate-refresh)))))

753

754

;; The accessory bar's key path (design §3.3): a `key:` button whose spec the

755

;; JS shim couldn't self-insert (a named key or a modifier chord) is routed

@@ -715,13 +757,27 @@

757

;; (slate accessory)) and enter the SAME slate-handle-key — so a bound chord

758

;; runs its command, an armed prefix arms, and a terminal's `default:` catch-all

759

;; sends Esc/Tab/C-c/arrows to the pty with zero terminal-specific bar code.

−718

;; Returns: "2" when a prefix is now ARMED (the JS routes the NEXT OSK key

−719

;; through here too, so a chord like C-x 2 completes on a phone keyboard); "1"

−720

;; when handled + done; "" on a fall-through (an unbound printable — the shim

−721

;; self-inserts it). The prefix check comes first because arming returns #t too.

+760

;; Returns a compact damage contract to the browser shim:

+761

;; "1" handled without a Slate render (terminal byte delivery is the hot path)

+762

;; "2" prefix armed without a render

+763

;; "3" handled and Slate rendered

+764

;; "4" prefix armed and Slate rendered

+765

;; "5" handled without a Slate render, with terminal grid damage

+766

;; "" unbound fall-through (the shim self-inserts it)

+767

;; The distinction is load-bearing on mobile: treating every terminal character

+768

;; as a render makes JS afterRender invalidate and repaint the entire terminal.

769

(define (slate-accessory-key spec)

−723

(let ((r (slate-handle-key (spec->props spec))))

−724

(cond ((dict-ref *state* slate/pending-prefix: #f) "2")

+770

(let* ((before *refresh-count*)

+771

(r (slate-handle-key (spec->props spec)))

+772

(prefix? (dict-ref *state* slate/pending-prefix: #f))

+773

(rendered? (> *refresh-count* before))

+774

(v (active-view *state*))

+775

(term-damage? (and r (not rendered?) v (terminal? v)

+776

(terminal-frame-pending? (view-name v)))))

+777

(cond ((and prefix? rendered?) "4")

+778

(prefix? "2")

+779

((and r rendered?) "3")

+780

(term-damage? "5")

781

(r "1")

782

(else ""))))

783

@@ -1061,14 +1117,11 @@

1117

(equal? reason "CONNECT_TIMEOUT")))

1118

1119

(define (note-link-lost!)

−1064

(enclave-node-fail-inflight! "connection lost")

−1065

;; Ruling 4's process/node row: flip to UNKNOWN immediately, never keep

−1066

;; showing last-known-good as current. Every remote root rides the account

−1067

;; plane, so losing it means we can no longer see ANY of them -- and a dead

−1068

;; node displayed as alive is what invites a destructive act against it.

−1069

;; The rows keep their age ("machine · unknown · as of 40s ago") rather

−1070

;; than merely changing word.

−1071

(roots-mark-unknown! node: (dict-ref *state* slate/now-ms: 0)))

+1120

;; Direct carriers are independent of the account plane. Fail and mark

+1121

;; only work which still depends on Enclave; a ready direct peer remains

+1122

;; current until that carrier itself reports closure.

+1123

(enclave-node-account-lost!

+1124

"connection lost" (dict-ref *state* slate/now-ms: 0)))

1125

1126

(define (pairing-on-error! reason)

1127

;; The session's own refusal dict when it has one (it carries the SERVER's

@@ -1209,6 +1262,7 @@

1262

;; continuation, so it cannot be a static table entry (see open-confirm).

1263

(define (prompt-desc state id)

1264

(cond

+1265

((string=? id "git-branch") (git-branch-prompt state))

1266

((or (string=? id "describe-hook")

1267

(string=? id "describe-face")

1268

(string=? id "describe-action")

@@ -1232,6 +1286,9 @@

1286

(if (and (> (string-length (string-trim value)) 0) (<= (string-length value) 120))

1287

#t "Use a title of 1–120 characters."))

1288

(lambda (st value) (agent-settings-command st #{ title: value }))))

+1289

((string=? id "terminal-session")

+1290

(dict-set (cr-prompt "Reattach terminal" terminal-session-candidates)

+1291

candidate-policy: live:))

1292

((string=? id "agent-session")

1293

(cr-prompt "Open agent session" agent-session-candidates))

1294

((string=? id "theme") (cr-prompt "Switch theme" theme-candidates))

@@ -1247,11 +1304,15 @@

1304

(dict-set (cr-prompt "Open web view" web-url-candidates)

1305

empty-action: weburl-empty-action))

1306

((string=? id "opacity")

−1250

(cr-prompt "Set content opacity"

−1251

(lambda (s) (amount-set-candidates s "opacity:" "%" (list 100 85 72 60 45)))))

+1307

(dict-set

+1308

(cr-prompt "Set content opacity"

+1309

(lambda (s) (amount-set-candidates s "opacity:" "%" (list 100 85 72 60 45))))

+1310

candidate-policy: live:))

1311

((string=? id "chrome-opacity")

−1253

(cr-prompt "Set chrome opacity"

−1254

(lambda (s) (amount-set-candidates s "chrome-opacity:" "%" (list 100 90 86 78 65)))))

+1312

(dict-set

+1313

(cr-prompt "Set chrome opacity"

+1314

(lambda (s) (amount-set-candidates s "chrome-opacity:" "%" (list 100 90 86 78 65))))

+1315

candidate-policy: live:))

1316

;; A server URL you retype every time you re-pair. Not a secret, and

1317

;; recalling it is most of the value of this prompt.

1318

((string=? id "enclave-host")

@@ -1599,10 +1660,32 @@

1660

;; standard completion ranker; a prompt carrying its own `rank:` (today only

1661

;; incremental search) uses that instead — see prompt-rank for why search cannot

1662

;; ride rank-candidates.

+1663

;;

+1664

;; A completing-read snapshots its candidates by default. The cache is bounded

+1665

;; to ONE active prompt session: open-prompt increments slate/prompt-session:,

+1666

;; and the first render replaces the previous session's rows. File prompts use

+1667

;; their directory cache; explicitly live prompts rebuild from the query.

+1668

(define *candidate-snapshot-token* #f)

+1669

(define *candidate-snapshot-rows* '())

+1670

+1671

(define (effective-prompt-candidates state desc)

+1672

(if (not (eq? (prompt-candidate-policy desc) snapshot:))

+1673

(prompt-candidates desc state)

+1674

(let ((token (string-append

+1675

(dict-ref state slate/minibuffer: "command") ":"

+1676

(number->string (dict-ref state slate/prompt-session: 0)))))

+1677

(if (and *candidate-snapshot-token*

+1678

(string=? token *candidate-snapshot-token*))

+1679

*candidate-snapshot-rows*

+1680

(let ((rows (prompt-candidates desc state)))

+1681

(set! *candidate-snapshot-token* token)

+1682

(set! *candidate-snapshot-rows* rows)

+1683

rows)))))

+1684

1685

(define (ranked-candidates state)

1686

(let* ((desc (prompt-desc state (dict-ref state slate/minibuffer: "command")))

1687

(query (dict-ref state slate/selector-query: ""))

−1605

(cands (prompt-candidates desc state))

+1688

(cands (effective-prompt-candidates state desc))

1689

(rank (prompt-rank desc)))

1690

(if rank

1691

(rank query cands)

@@ -1620,7 +1703,11 @@

1703

;; see the FULL ranked set (a subset's common prefix is never shorter, so a capped

1704

;; one would over-complete past the cap). Completing to the selection removed that

1705

;; coupling — you cannot select a row you cannot see.

−1623

(define *selector-max-rows* 200)

+1706

;; Rank the COMPLETE candidate set first, then materialize only a useful

+1707

;; navigation window. Fifty is already 5–7 mobile screens (and several

+1708

;; desktop panels); rendering 200 highlighted rows made the broad first few

+1709

;; query characters pay for 150 nodes nobody could see.

+1710

(define *selector-max-rows* 50)

1711

1712

(define (visible-candidates state)

1713

(take-at-most *selector-max-rows* (ranked-candidates state)))

@@ -1645,25 +1732,29 @@

1732

;; candidates, so it renders its question and nothing else (and deliberately

1733

;; not as a `.palette` — see render-confirm for why that would make it

1734

;; unanswerable). Everything else is the text+list selector.

+1735

(define (palette-ranked state desc query ranked)

+1736

(let* ((id (dict-ref state slate/minibuffer: "command"))

+1737

(idx (selector-clamp (dict-ref state slate/selector-index: 0) (length ranked)))

+1738

(ea (prompt-empty-action desc state query)))

+1739

(render-selector (prompt-crumbs state) query ranked idx ea id

+1740

(let ((ring (prompt-history desc)))

+1741

(and ring

+1742

(> (history-count (history-rings state) ring) 0))))))

+1743

1744

(define (palette state)

1745

(let* ((id (dict-ref state slate/minibuffer: "command"))

1746

(desc (prompt-desc state id)))

1747

(if (prompt-confirm? desc)

1748

(render-confirm (prompt-label desc))

1749

(let* ((query (dict-ref state slate/selector-query: ""))

−1654

(ranked (visible-candidates state))

−1655

(idx (selector-clamp (dict-ref state slate/selector-index: 0) (length ranked)))

−1656

(ea (prompt-empty-action desc state query)))

+1750

(ranked (visible-candidates state)))

1751

;; Show the history control only when there is a ring AND it holds

1752

;; something. Both halves matter: a prompt with history: #f (the

1753

;; pairing code) must never advertise a history it is forbidden to

1754

;; have, and a ring that is merely EMPTY would offer a button that

1755

;; opens nothing — which teaches the user the control is useless

1756

;; before they ever reach a prompt where it is not.

−1663

(render-selector (prompt-crumbs state) query ranked idx ea id

−1664

(let ((ring (prompt-history desc)))

−1665

(and ring

−1666

(> (history-count (history-rings state) ring) 0))))))))

+1757

(palette-ranked state desc query ranked)))))

1758

1759

;; The Ledge: the always-present bottom strip, now DATA-DRIVEN. The whole

1760

;; strip is `slate/ledge-items:` (a list of ledge-item records); here we just

@@ -1740,10 +1831,13 @@

1831

#f

1832

(dict-ref state slate/acc-kbd-menu: #f))

1833

,(ledge state)

−1743

,@(if (dict-ref state slate/minibuffer: #f) (list (palette state)) '())

+1834

,(accessory-keyboard-deck (active-view state) (sticky-mods state)

+1835

(let ((v (active-view state)))

+1836

(and v (terminal? v) (view-name v))))

1837

,@(let ((wk (dict-ref state slate/which-key: #f)))

1838

(if wk

−1746

(list (render-which-key (dict-ref wk title: "") (dict-ref wk map: #{})))

+1839

(list (render-which-key (dict-ref wk title: "") (dict-ref wk map: #{})

+1840

(dict-ref wk labels: #{})))

1841

'())))))

1842

1843

;; ---- the render subscription --------------------------------------------

@@ -1753,13 +1847,211 @@

1847

;; afterRender post-pass — TERM.ensure/faces/etc.). Read by slate-node-tick to

1848

;; decide its return signal; cheap (one integer bump per render).

1849

(define *refresh-count* 0)

+1850

+1851

;; The palette is a sibling mount, not a second state machine. It reads the

+1852

;; same *state*, uses the same pure palette renderer and routes keys through

+1853

;; the same slate-handle-key closure. Its own theme-variable boundary keeps

+1854

;; the overlay visually identical now that it no longer inherits .frame.

+1855

(define (render-palette-mount/content state content)

+1856

`(div (@ (class "palette-host")

+1857

(style ,(string-append (theme->css-vars (active-theme state))

+1858

(translucency-css-vars state)

+1859

(text-css-vars state)

+1860

(font-css-vars state)))

+1861

(on-key: ,slate-handle-key))

+1862

,@content))

+1863

+1864

(define (render-palette-mount state)

+1865

(render-palette-mount/content

+1866

state

+1867

(if (dict-ref state slate/minibuffer: #f)

+1868

(list (palette state))

+1869

'())))

+1870

+1871

(define (slate-selector-refresh)

+1872

(web-client-update "#palette-root"

+1873

(lambda () (render-palette-mount *state*)))

+1874

"")

+1875

+1876

;; Folder point motion updates only the two row markers in the DOM. The

+1877

;; listing remains owned by the normal renderer, rebuilt when point leaves

+1878

;; its rendered window or anything besides point changes.

+1879

(define *folder-motion* #f)

+1880

+1881

(define (folder-motion-state? before after old new)

+1882

(and (= (length (dict-keys before)) (length (dict-keys after)))

+1883

(list-all? (lambda (key)

+1884

(or (eq? key slate/views:) (eq? key slate/command-mru:)

+1885

(eq? (dict-ref before key #f) (dict-ref after key #f))))

+1886

(dict-keys before))

+1887

(let loop ((a (views before)) (b (views after)))

+1888

(cond

+1889

((null? a) (null? b))

+1890

((null? b) #f)

+1891

((or (eq? (car a) (car b))

+1892

(and (eq? (car a) old) (eq? (car b) new)))

+1893

(loop (cdr a) (cdr b)))

+1894

(else #f)))))

+1895

+1896

(define (folder-motion-refresh! before after event)

+1897

(let ((old (active-view before)) (new (active-view after)))

+1898

(and (or (string=? event "folder-next") (string=? event "folder-prev"))

+1899

(not (minibuffer-open? before))

+1900

(not (dict-ref before slate/prefix-arg: #f))

+1901

(folder-point-only-change? old new)

+1902

(folder-point-rendered? new)

+1903

(folder-motion-state? before after old new)

+1904

(begin

+1905

(refresh-folder-enrichment! after (current-second) slate-refresh)

+1906

(set! *folder-motion*

+1907

#{ name: (view-name new) point: (folder-point new)

+1908

pending: (if (folder-detail new preview-start: #f) #t #f) })

+1909

#t))))

+1910

+1911

(define (slate-folder-take-motion)

+1912

(let ((motion *folder-motion*))

+1913

(set! *folder-motion* #f)

+1914

(if motion (json-encode motion) "")))

+1915

+1916

(define (slate-folder-preview-token) (folder-preview-request-token))

+1917

+1918

(define (slate-folder-preview-flush token)

+1919

(flush-folder-preview! token)

+1920

(slate-refresh))

+1921

1922

(define (slate-refresh)

+1923

(set! *folder-motion* #f)

+1924

(refresh-folder-enrichment! *state* (current-second) slate-refresh)

1925

(set! *refresh-count* (+ *refresh-count* 1))

1926

(web-client-update "#app" (lambda () (render *state*)))

+1927

(slate-selector-refresh)

1928

;; "" not #t: the JS boot calls this via eval_string_length, and a

1929

;; non-string result logs a benign runtime "not a string" warning.

1930

"")

1931

+1932

;; Browser delivery seam for the read-only loopback /node/status endpoint.

+1933

;; The view owns no transport and consumes the same schema on desktop and

+1934

;; Termux. Invalid or unavailable responses become an honest error state.

+1935

(define *node-status-transport-url* "unknown")

+1936

(define *client-update-requested?* #f)

+1937

(define *performance-capture-request* #f)

+1938

+1939

(define (request-performance-capture action state)

+1940

(set! *performance-capture-request* action)

+1941

(with-echo state

+1942

(if (string=? action "start")

+1943

"performance capture started"

+1944

"saving performance capture…")))

+1945

+1946

(define (slate-performance-capture-take)

+1947

(let ((request *performance-capture-request*))

+1948

(set! *performance-capture-request* #f)

+1949

(or request "")))

+1950

+1951

(define (slate-performance-capture-report ok path)

+1952

(set! *state*

+1953

(with-echo *state*

+1954

(if ok

+1955

(string-append "performance capture saved: " path)

+1956

(string-append "performance capture save failed"

+1957

(if (string=? path "") "" (string-append ": " path))))))

+1958

(slate-refresh))

+1959

+1960

(define (slate-performance-trace-set enabled)

+1961

(enclave-node-performance-trace! enabled)

+1962

"")

+1963

+1964

(define (slate-performance-trace-poll)

+1965

(json-encode (enclave-node-performance-trace-poll)))

+1966

+1967

(define (toggle-wake-lock state)

+1968

(let* ((next (not (dict-ref state slate/keep-screen-awake: #f)))

+1969

(saved? (save-option! slate/keep-screen-awake: next)))

+1970

(with-echo

+1971

(dict-set state slate/keep-screen-awake: next)

+1972

(string-append "keep screen awake: " (if next "on" "off")

+1973

(if saved? "" " (preference was not saved)")))))

+1974

+1975

;; Browser wake-lock bridge. Strings keep the eval boundary unambiguous.

+1976

(define (slate-wake-lock-wanted)

+1977

(if (dict-ref *state* slate/keep-screen-awake: #f) "1" ""))

+1978

(define (slate-wake-lock-report status message)

+1979

(when (and (string? status) (not (string=? status "active")))

+1980

(set! *state*

+1981

(with-echo *state*

+1982

(string-append "keep screen awake: " status

+1983

(if (and (string? message) (> (string-length message) 0))

+1984

(string-append " — " message) ""))))

+1985

(slate-refresh))

+1986

"")

+1987

+1988

(define (request-client-update state)

+1989

(set! *client-update-requested?* #t)

+1990

;; The action consumes old update notices before the persistent inbox is

+1991

;; restored by the next client; an activated version must not reappear as

+1992

;; though it were another available update.

+1993

(let ((next (dict-set state slate/notifications:

+1994

(filter

+1995

(lambda (n)

+1996

(let ((source (notification-source n)))

+1997

(not (and (string? source)

+1998

(>= (string-length source) 20)

+1999

(string=? (substring source 0 20)

+2000

"slate/client-update:")))))

+2001

(dict-ref state slate/notifications: '())))))

+2002

(notifications-save! next)

+2003

(with-echo next "updating Slate web client…")))

+2004

Showing the first 500 of 1051 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate/src/slate/main/preferences.sglmodified

@@ -77,6 +77,11 @@

77

default: #t type: boolean doc: "Focus panes under the pointer" group: appearance)

78

(define-option slate/terminals-use-tmux:

79

default: #t type: boolean doc: "Open terminals through tmux" group: terminal)

+80

(define-option slate/terminal-predictive-echo:

+81

default: #f type: boolean

+82

doc: "Preview simple terminal typing while waiting for remote echo" group: terminal)

+83

(define-option slate/keep-screen-awake:

+84

default: #f type: boolean doc: "Keep the screen awake while Slate is visible" group: appearance)

85

(define-option slate/opacity:

86

default: 72 type: (integer 10 100) doc: "Content surface opacity" group: appearance)

87

(define-option slate/chrome-opacity:

packages/slate/src/slate/modes/folder.sglmodified

@@ -2,7 +2,7 @@

2

;;;

3

;;; A mode over a DIRECTORY source (kind: dir:). It materializes the source's

4

;;; listing through the provider seam and renders it keyboard-first: one entry per

−5

;;; line (name, a dir/file rune, a size column), a point/cursor highlight, and a

+5

;;; line (name, Git status, size, modification time), a point highlight, and a

6

;;; keymap for fast movement — n/p (or arrows) to move, RET to open, ^ to go to the

7

;;; parent, g to refresh. "Open an entry" is not special-cased: it just builds a

8

;;; new SOURCE (a child dir-source to descend, or a file-source to find-file) and

@@ -17,11 +17,14 @@

17

;;; come from (slate providers localstorage) but are pure string ops, not a backend.

18

19

(define-library (slate modes folder)

−20

(import (sigil core)

−21

(sigil string)

+20

(import (sigil string)

+21

(slate folder model)

+22

(sigil list)

23

(sigil math) ; quotient (human-size, for files >= 1 KiB)

24

(sigil record)

25

(slate mode)

+26

(slate option)

+27

(slate root)

28

(slate view)

29

(slate provider)

30

(slate providers localstorage))

@@ -29,12 +32,19 @@

32

folder-reload folder-move folder-point folder-entries

33

folder-count folder-entry-at folder-child-source folder-parent-source

34

folder-set-point folder-set-entries folder-address

+35

folder-all-entries folder-set-sort folder-toggle-hidden folder-toggle-preview

+36

folder-toggle-compact folder-cache folder-detail folder-detail-set!

+37

folder-point-only-change? folder-point-rendered? folder-inherit-settings

38

folder-marks folder-marked? folder-mark folder-unmark

39

folder-toggle-marks folder-clear-marks folder-operation-entries

40

folder-glob-match? folder-mark-matching

41

;; display helper, exported for its unit tests (dotfiles, .tar.gz, dirs)

42

split-extension)

43

(begin

+44

(define-option slate/folder-preview:

+45

default: #f type: boolean

+46

doc: "Show previews when opening a new folder browser"

+47

group: folder)

48

49

;; ---- view-state accessors (data under slate/ keys) ----------------------

50

;; Entries are stored as a VECTOR: with a 10k-entry capped listing (e.g.

@@ -49,6 +59,14 @@

59

(else (list->vector es))))

60

61

(define (folder-entries v) (dict-ref v slate/entries: (vector)))

+62

(define (folder-all-entries v) (dict-ref v slate/all-entries: (folder-entries v)))

+63

(define (folder-cache v) (dict-ref v slate/folder-cache: #f))

+64

(define (folder-detail v key fallback)

+65

(let ((cache (folder-cache v)))

+66

(if cache (dict-ref (vector-ref cache 0) key fallback) fallback)))

+67

(define (folder-detail-set! v key value)

+68

(let ((cache (folder-cache v)))

+69

(when cache (vector-set! cache 0 (dict-set (vector-ref cache 0) key value)))))

70

(define (folder-point v) (dict-ref v slate/point: 0))

71

(define (folder-count v) (vector-length (folder-entries v)))

72

;; Marks are entry NAMES rather than row indices: sorting/reloading may move a

@@ -68,11 +86,19 @@

86

;; Materialize the directory listing through the seam at construction; the

87

;; listing is a list of entry dicts #{ name: kind: size? } (see fs-read-dir).

88

(define (make-folder-view name source)

−71

(folder slate/name: name

−72

slate/source: source

−73

slate/entries: (->entry-vector (source-materialize source))

−74

slate/point: 0

−75

slate/marks: '()))

+89

(let ((v (folder-set-entries

+90

(folder slate/name: name

+91

slate/source: source

+92

slate/entries: (vector)

+93

slate/point: 0

+94

slate/marks: '()

+95

slate/folder-cache: (vector #{})

+96

slate/folder-sort: name:

+97

slate/folder-hidden?: #f

+98

slate/folder-preview?: (option-ref slate/folder-preview: #f))

+99

(source-materialize source))))

+100

(folder-detail-set! v listing-ready?: (not (provider-async-op source)))

+101

v))

102

103

(define (entry-name entry) (dict-ref entry name: ""))

104

@@ -93,27 +119,65 @@

119

(let ((present (entry-name-set entries)))

120

(filter (lambda (mark) (dict-ref present mark #f)) marks)))

121

−96

;; Re-materialize (g / refresh), clamping point into the new listing.

+122

;; Reproject only when the listing, sorting, or visibility changes. Point

+123

;; and marks follow names; the complete listing remains mutation authority.

+124

(define (folder-reproject v)

+125

(let* ((at (folder-entry-at v))

+126

(name (and at (entry-name at)))

+127

(entries (folder-project-entries

+128

(folder-all-entries v)

+129

(dict-ref v slate/folder-sort: name:)

+130

(dict-ref v slate/folder-hidden?: #f)))

+131

(point (let loop ((i 0))

+132

(cond ((>= i (vector-length entries))

+133

(clamp (folder-point v) (vector-length entries)))

+134

((equal? name (entry-name (vector-ref entries i))) i)

+135

(else (loop (+ i 1)))))))

+136

(dict-set (dict-set v slate/entries: entries) slate/point: point)))

+137

+138

(define (folder-set-sort v sort)

+139

(folder-reproject (dict-set v slate/folder-sort: sort)))

+140

(define (folder-toggle-hidden v)

+141

(folder-reproject

+142

(dict-set v slate/folder-hidden?: (not (dict-ref v slate/folder-hidden?: #f)))))

+143

(define (folder-toggle-preview v)

+144

(dict-set v slate/folder-preview?: (not (dict-ref v slate/folder-preview?: #f))))

+145

(define (folder-toggle-compact v)

+146

(dict-set v slate/folder-compact?: (not (dict-ref v slate/folder-compact?: #f))))

+147

+148

;; Navigation carries the user's current toggle; an independently opened

+149

;; browser starts from the declared option instead.

+150

(define (folder-inherit-settings from to)

+151

(if (and (folder? from) (folder? to))

+152

(dict-set to slate/folder-preview?:

+153

(dict-ref from slate/folder-preview?: #f))

+154

to))

+155

+156

(define (folder-point-only-change? before after)

+157

(and (folder? before) (folder? after)

+158

(= (length (dict-keys before)) (length (dict-keys after)))

+159

(list-all? (lambda (key)

+160

(or (eq? key slate/point:)

+161

(eq? (dict-ref before key #f) (dict-ref after key #f))))

+162

(dict-keys before))))

+163

+164

(define (folder-point-rendered? v)

+165

(and (>= (folder-point v) (folder-detail v render-from: 0))

+166

(< (folder-point v) (folder-detail v render-to: 0))))

+167

168

(define (folder-reload v)

−98

(let ((entries (->entry-vector (source-materialize (view-source v)))))

−99

(dict-set

−100

(dict-set

−101

(dict-set v slate/entries: entries)

−102

slate/point: (clamp (folder-point v) (vector-length entries)))

−103

slate/marks: (marks-in-entries (folder-marks v) entries))))

−104

−105

;; Install a listing delivered ASYNCHRONOUSLY (an async provider's

−106

;; materialize-async: result, wired in (slate main)) — same clamping as reload,

−107

;; but the entries come from the caller instead of a synchronous materialize.

−108

;; A synchronous provider never needs this (make-folder-view materializes at

−109

;; construction); it exists purely for the async-load path.

+169

(folder-set-entries v (source-materialize (view-source v))))

+170

171

(define (folder-set-entries v entries)

+172

(folder-detail-set! v listing-ready?: #t)

+173

(folder-detail-set! v load-error: #f)

174

(let ((es (->entry-vector entries)))

−112

(dict-set

+175

(folder-reproject

176

(dict-set

−114

(dict-set v slate/entries: es)

−115

slate/point: (clamp (folder-point v) (vector-length es)))

−116

slate/marks: (marks-in-entries (folder-marks v) es))))

+177

(dict-set

+178

(dict-set v slate/all-entries: es)

+179

slate/folder-revision: (+ 1 (dict-ref v slate/folder-revision: 0)))

+180

slate/marks: (marks-in-entries (folder-marks v) es)))))

181

182

(define (folder-move v delta)

183

(dict-set v slate/point: (clamp (+ (folder-point v) delta) (folder-count v))))

@@ -177,11 +241,11 @@

241

(if (null? (folder-marks v))

242

(let ((entry (folder-entry-at v))) (if entry (list entry) '()))

243

(filter (lambda (entry) (folder-marked? v entry))

−180

(vector->list (folder-entries v)))))

+244

(vector->list (folder-all-entries v)))))

245

246

(define (folder-toggle-marks v)

247

(let ((old (name-set (folder-marks v)))

−184

(entries (folder-entries v)))

+248

(entries (folder-all-entries v)))

249

(let loop ((i 0) (marks '()))

250

(if (>= i (vector-length entries))

251

(dict-set v slate/marks: (reverse marks))

@@ -209,7 +273,7 @@

273

(else #f)))))

274

275

(define (folder-mark-matching v pattern)

−212

(let* ((entries (folder-entries v))

+276

(let* ((entries (folder-all-entries v))

277

(existing (name-set (folder-marks v))))

278

(let loop ((i 0) (new-marks '()))

279

(if (>= i (vector-length entries))

@@ -299,78 +363,148 @@

363

(cons (substring name 0 i) (substring name i n)))

364

(else (loop (- i 1))))))))

365

−302

;; A minimal, Emacs-dired-like row: just the name (dirs get a trailing "/"),

−303

;; with a small right-aligned size for files. No bullets, no chrome — the

−304

;; point line is the only decoration.

−305

(define (folder-row entry idx selected? marked?)

+366

;; Rows retain filename keys as metadata arrives. Only the name visits a

+367

;; source; the rest of the row moves point, and the blank gutter toggles marks.

+368

(define (folder-row v entry idx selected? marked?)

369

(let* ((name (dict-ref entry name: ""))

370

(dir? (eq? (dict-ref entry kind: file:) dir:))

371

(parts (split-extension name dir?))

−309

(size (if dir? "" (human-size (dict-ref entry size: 0)))))

+372

(bytes (dict-ref entry size: #f))

+373

(badge (dict-ref (folder-detail v git-overlay: #{}) name #{}))

+374

(index (number->string idx)))

375

`(div (@ (class ,(string-append "folder-row"

−311

(if dir? " is-dir" " is-file")

−312

(if marked? " marked" "")

−313

(if selected? " selected" "")))

−314

(data-slate-click ,(string-append "folder-open-index:" (number->string idx))))

−315

(span (@ (class "folder-mark")) ,(if marked? "◆" " "))

−316

(span (@ (class "folder-name"))

−317

(span (@ (class "folder-stem")) ,(car parts))

−318

,@(if (equal? (cdr parts) "") '()

−319

(list `(span (@ (class "folder-ext")) ,(cdr parts)))))

−320

,@(if (equal? size "") '() (list `(span (@ (class "folder-size")) ,size))))))

−321

−322

;; The view: just the plain listing. The dired-style path header was removed

−323

;; (slate-ux-sweep #1) — it duplicated the view's mode-line title, so the

−324

;; provider-qualified path now lives only in the mode line / title bar.

−325

;;

−326

;; The render is WINDOWED around the point (±folder-window-half): every row

−327

;; costs ~1ms of interpreted sxml→vdom per frame, and the whole frame

−328

;; re-renders on every point move — an unwindowed 1000-entry dir cost

−329

;; ~0.8-1.3s per open AND per n/p. Rows outside the window collapse into

−330

;; "⋯ N more" indicator lines; the window follows the point, so keyboard

−331

;; motion always has context. (Mouse-wheel browsing past the window edge

−332

;; needs the point to move — the dired-virtualization follow-up lifts this.)

+376

(if dir? " is-dir" " is-file")

+377

(if marked? " marked" "")))

+378

(key ,name)

+379

(role "option")

+380

(aria-selected "false")

+381

(aria-label ,(string-append name (if marked? ", marked" "")))

+382

(data-slate-click ,(string-append "folder-select-index:" index)))

+383

(button (@ (class "folder-mark")

+384

(aria-label ,(string-append (if marked? "Unmark " "Mark ") name))

+385

(data-slate-click ,(string-append "folder-mark-index:" index)))

+386

,(if marked? "◆" ""))

+387

(button (@ (class "folder-name") (title ,name)

+388

(data-slate-click ,(string-append "folder-open-index:" index)))

+389

(span (@ (class "folder-stem")) ,(car parts))

+390

(span (@ (class "folder-ext")) ,(cdr parts)))

+391

(span (@ (class ,(string-append "folder-git " (dict-ref badge class: "")))

+392

(title ,(dict-ref badge detail: "")))

+393

,(dict-ref badge label: ""))

+394

(span (@ (class "folder-size"))

+395

,(if (and (not dir?) (number? bytes)) (human-size bytes) "—"))

+396

(span (@ (class "folder-modified"))

+397

,(folder-modified-text entry (folder-detail v now: #f))))))

+398

+399

;; Windowing stays bounded; each continuation is a real navigation command.

400

(define folder-window-half 100)

−334

−335

(define (more-row n where)

−336

`(div (@ (class "folder-more"))

−337

,(string-append "⋯ " (number->string n) " more "

−338

(if (eq? where above:) "above" "below"))))

−339

−340

;; The empty state: a quiet centered hint instead of a blank void (polish item

−341

;; 4). Inlined (not (slate components)'s empty-hint) to keep folder's import set

−342

;; minimal on the boot path.

−343

(define (folder-empty-hint)

+401

(define (more-row n where target)

+402

`(button (@ (class "folder-more")

+403

(data-slate-click ,(string-append "folder-select-index:"

+404

(number->string target))))

+405

,(string-append (if (eq? where above:) "↑ " "↓ ")

+406

(number->string n) " more "

+407

(if (eq? where above:) "above" "below")

+408

" · show more")))

+409

+410

(define (folder-empty-hint v)

411

`(div (@ (class "empty-hint"))

−345

(div (@ (class "empty-hint-glyph")) "▢")

−346

(div (@ (class "empty-hint-title")) "This folder is empty")

−347

(div (@ (class "empty-hint-sub")) "C-x C-f find a file")))

−348

−349

(define (folder-render v)

+412

(div (@ (class "empty-hint-title"))

+413

,(cond ((folder-detail v load-error: #f) "Directory unavailable")

+414

((not (folder-detail v listing-ready?: #f)) "Loading directory…")

+415

((> (vector-length (folder-all-entries v)) 0) "Only hidden entries")

+416

(else "This folder is empty")))

+417

,(if (folder-detail v load-error: #f)

+418

`(button (@ (data-slate-click "folder-refresh")) "Retry")

+419

`(div (@ (class "empty-hint-sub")) "C-x C-f find a file"))))

+420

+421

(define (folder-listing v)

422

(let* ((entries (folder-entries v))

423

(point (folder-point v))

−352

(n (vector-length entries)))

−353

`(div (@ (class "view folder"))

−354

,@(cond

−355

((= n 0)

−356

(list (folder-empty-hint)))

−357

((<= n (* 2 folder-window-half))

−358

(map-range (lambda (e i)

−359

(folder-row e i (= i point) (folder-marked? v e)))

−360

entries 0 n))

−361

(else

−362

(let* ((from (max 0 (- point folder-window-half)))

−363

(to (min n (+ point folder-window-half 1)))

−364

(from (max 0 (min from (- to (* 2 folder-window-half)))))

−365

(rows (map-range

−366

(lambda (e idx)

−367

(folder-row e idx (= idx point)

−368

(folder-marked? v e)))

−369

entries from to)))

−370

(append

−371

(if (> from 0) (list (more-row from above:)) '())

−372

rows

−373

(if (< to n) (list (more-row (- n to) below:)) '()))))))))

+424

(n (vector-length entries))

+425

(to (min n (+ point folder-window-half 1)))

+426

(from (max 0 (min (- point folder-window-half)

+427

(- to (* 2 folder-window-half))))))

+428

(folder-detail-set! v render-from: from)

+429

(folder-detail-set! v render-to: (if (<= n (* 2 folder-window-half)) n to))

+430

(if (= n 0)

+431

(list (folder-empty-hint v))

+432

(let ((from (if (<= n (* 2 folder-window-half)) 0 from))

+433

(to (if (<= n (* 2 folder-window-half)) n to)))

+434

(append

+435

(if (> from 0) (list (more-row from above: (- from 1))) '())

+436

(map-range (lambda (e i)

+437

(folder-row v e i (= i point) (folder-marked? v e)))

+438

entries from to)

+439

(if (< to n) (list (more-row (- n to) below: to)) '()))))))

+440

+441

(define (folder-preview-render v)

+442

(let* ((entry (folder-entry-at v))

+443

(name (and entry (dict-ref entry name: "")))

+444

(bytes (and entry (dict-ref entry size: #f)))

+445

(badge (and name (dict-ref (folder-detail v git-overlay: #{}) name #f))))

+446

`(aside (@ (class ,(string-append "folder-preview"

+447

(if (folder-detail v preview-start: #f) " pending" ""))))

+448

(div (@ (class "folder-preview-label"))

+449

(span "Preview")

+450

(button (@ (aria-label "Close preview (P)")

+451

(data-slate-click "folder-preview")) "×"))

+452

,@(if (not entry)

+453

'((div (@ (class "empty-hint")) "No entry at point"))

+454

`((div (@ (class "folder-preview-header"))

+455

(button (@ (class "folder-preview-name")

+456

(data-slate-click "folder-open")) ,name)

+457

(dl

+458

(dt "Size") (dd ,(if (number? bytes) (human-size bytes) "—"))

+459

(dt "Modified")

+460

(dd ,(folder-modified-text entry (folder-detail v now: #f)))

+461

,@(if badge `((dt "Git") (dd ,(dict-ref badge detail: ""))) '())))

+462

,(let ((url (folder-detail v preview-image-url: #f)))

+463

(if url

+464

`(div (@ (class "folder-preview-content folder-preview-image"))

+465

(img (@ (src ,url) (alt ,name))))

+466

`(pre (@ (class "folder-preview-content"))

+467

,(folder-detail v preview-text: "Waiting…")))))))))

+468

+469

(define (folder-render v)

+470

(let* ((source (view-source v))

+471

(address (folder-address v))

+472

(root (source-root source))

+473

(host (if root

+474

(or (dict-ref (root-ref root) label: #f) (root-name-string root))

+475

(dict-ref source host: (dict-ref source provider: ""))))

+476

(show-git? (folder-detail v git-capable?: #f)))

+477

(folder-detail-set! v render-generation: (+ 1 (folder-detail v render-generation: 0)))

+478

`(div (@ (class ,(string-append "view folder"

+479

(if (dict-ref v slate/folder-preview?: #f) " with-preview" "")

+480

(if (dict-ref v slate/folder-compact?: #f) " compact" "")

+481

(if show-git? " with-git" "")))

+482

(data-folder-view ,(view-name v))

+483

(data-folder-render ,(number->string (folder-detail v render-generation: 0)))

+484

(data-folder-point ,(number->string (folder-point v))))

+485

(header (@ (class "folder-header"))

+486

(button (@ (class "folder-parent") (aria-label "Parent directory")

+487

(data-slate-click "folder-parent")) "↑")

+488

(span (@ (class "folder-path") (title ,address))

+489

(span (@ (class "folder-ancestry"))

+490

,(if (string=? address "/") ""

+491

(let ((parent (fs-parent address)))

+492

(string-append parent (if (string=? parent "/") "" "/")))))

+493

(strong ,(if (string=? address "/") "/" (fs-basename address))))

+494

(span (@ (class "folder-host"))

+495

,(cond ((string? host) host)

+496

((keyword? host) (keyword->string host)) (else ""))))

+497

(div (@ (class "folder-workbench"))

+498

(div (@ (class "folder-directory"))

+499

(div (@ (class "folder-columns"))

+500

(span "") (span "Name")

+501

(span (@ (class "folder-git")) "Git")

+502

(span "Size") (span (@ (class "folder-modified")) "Modified"))

+503

(div (@ (class "folder-listing") (role "listbox")

+504

(aria-label "Directory entries"))

+505

,@(folder-listing v)))

+506

,@(if (dict-ref v slate/folder-preview?: #f)

+507

(list (folder-preview-render v)) '())))))

508

509

;; ---- the mode: define-mode installs each aspect as a view method ---------

510

;; keymap is a per-mode LAYER: bare n/p/g/^ bind to folder commands (there is

@@ -409,6 +543,7 @@

543

;; Home/End and the editor's Emacs-style M-</M-> aliases jump to the listing

544

;; edges, so buffer-extent muscle memory works on both primary view types.

545

keymap: #{ "n" "folder-next" "p" "folder-prev"

+546

"P" "folder-preview"

547

"ArrowDown" "folder-next" "ArrowUp" "folder-prev"

548

"PageDown" "folder-page-down" "PageUp" "folder-page-up"

549

"Home" "folder-begin" "End" "folder-end"

@@ -424,7 +559,14 @@

559

"^" "folder-parent" "b" "folder-parent"

560

"g" "folder-refresh" "q" "folder-quit" }

561

commands: (lambda (v)

−427

(list (make-cand "Folder: Refresh" "g" "folder-refresh")

+562

(list (make-cand "Folder: Toggle Preview" "P" "folder-preview")

+563

(make-cand "Folder: Hidden" "" "folder-hidden")

+564

(make-cand "Folder: Compact Rows" "" "folder-compact")

+565

(make-cand "Folder: Sort by Name" "" "folder-sort-name")

+566

(make-cand "Folder: Sort by Size" "" "folder-sort-size")

+567

(make-cand "Folder: Most Recently Modified" "" "folder-sort-newest")

+568

(make-cand "Folder: Least Recently Modified" "" "folder-sort-oldest")

+569

(make-cand "Folder: Refresh" "g" "folder-refresh")

570

(make-cand "Folder: Open Parent" "b / ^" "folder-parent")

571

(make-cand "Folder: Mark Entry" "m" "folder-mark")

572

(make-cand "Folder: Unmark Entry" "u" "folder-unmark")

@@ -447,6 +589,13 @@

589

actions: (list

590

#{ id: 'folder label: "Folder" glyph: "▤" tier: 'primary

591

items: (list

+592

#{ id: 'preview label: "Preview" command: "folder-preview" tier: 'primary }

+593

#{ id: 'hidden label: "Hidden" command: "folder-hidden" tier: 'secondary }

+594

#{ id: 'sort-name label: "Name ↑" command: "folder-sort-name" tier: 'secondary }

+595

#{ id: 'sort-size label: "Size ↓" command: "folder-sort-size" tier: 'secondary }

+596

#{ id: 'sort-newest label: "Newest" command: "folder-sort-newest" tier: 'secondary }

+597

#{ id: 'sort-oldest label: "Oldest" command: "folder-sort-oldest" tier: 'secondary }

+598

#{ id: 'compact label: "Compact" command: "folder-compact" tier: 'secondary }

599

#{ id: 'up label: "↑" key: "ArrowUp" tier: 'primary repeat: #t }

600

#{ id: 'down label: "↓" key: "ArrowDown" tier: 'primary repeat: #t }

601

#{ id: 'open label: "Open" command: "folder-open" tier: 'primary }

packages/slate/src/slate/modes/git-diff.sgladded

@@ -0,0 +1,75 @@

+1

;;; (slate modes git-diff) — bounded structured diff review surface.

+2

(define-library (slate modes git-diff)

+3

(import (sigil core) (sigil record) (sigil string) (slate components) (slate components diff)

+4

(slate git diff-model) (slate git diff-view) (slate mode) (slate view))

+5

(export git-diff? git-diff-model git-diff-rows git-diff-selected-row

+6

git-diff-move git-diff-render git-diff-view-name)

+7

(begin

+8

(define (icon-button icon label command)

+9

`(button (@ (class "git-header-icon") (aria-label ,label) (title ,label)

+10

(data-slate-click ,command))

+11

(span (@ (class ,(string-append "icon i-" icon))))))

+12

(define (line-class kind selected?)

+13

(string-append "git-diff-row git-diff-"

+14

(if (keyword? kind) (keyword->string kind) "meta")

+15

(if selected? " selected" "")))

+16

(define (git-diff-render v)

+17

(let* ((model (git-diff-model v))

+18

(state (if model (git-diff-model-state model) #{ state: loading: }))

+19

(kind (dict-ref state state: loading:))

+20

(commit (dict-ref v slate/git-commit: #f))

+21

(selected (dict-ref v slate/git-selected: #f)))

+22

(let ((header

+23

`(header (@ (class "git-buffer-header"))

+24

(div (@ (class "git-header-line"))

+25

(span (@ (class "git-header-label")) "Diff")

+26

(span (@ (class "git-header-value"))

+27

,(if (eq? kind loading:) "Loading…"

+28

(if (eq? kind error:) "Diff failed or became stale."

+29

(string-append (git-diff-model-kind model) " "

+30

(or (git-diff-model-target model) "all staged changes"))))))

+31

,@(if commit

+32

`((div (@ (class "git-header-line"))

+33

(span (@ (class "git-header-label")) "Subject")

+34

(span (@ (class "git-header-value")) ,(dict-ref commit subject: "")))

+35

(div (@ (class "git-header-line"))

+36

(span (@ (class "git-header-label")) "Commit")

+37

(span (@ (class "git-header-value")) ,(dict-ref commit oid: "")))

+38

(div (@ (class "git-header-line"))

+39

(span (@ (class "git-header-label")) "Parents")

+40

(span (@ (class "git-header-value"))

+41

,(string-join

+42

(let ((parents (dict-ref commit parents: '())))

+43

(if (array? parents) (array->list parents) parents)) " "))))

+44

'())

+45

(div (@ (class "git-header-actions"))

+46

,(icon-button "git-branch" "Branches" "git-branch-menu")

+47

,(icon-button "history" "Refresh diff" "git-diff-refresh")

+48

,(icon-button "x" "Close diff" "git-quit"))))

+49

(control

+50

(diff-control-render (git-diff-rows v) selected

+51

(lambda (row)

+52

(let ((id (dict-ref row id: "")))

+53

(if (eq? (dict-ref row kind: #f) continuation:)

+54

"git-diff-more" (string-append "git-diff-select:" id)))))))

+55

`(div (@ (class "view git-diff git-buffer")) ,header ,control))))

+56

(define-mode git-diff-mode

+57

glyph: "Δ" icon: "diff" lighter: "Diff"

+58

keymap: #{ "b" "git-branch-menu" "n" "git-next" "ArrowDown" "git-next"

+59

"p" "git-prev" "ArrowUp" "git-prev"

+60

"Enter" "git-visit" "g" "git-diff-refresh"

+61

"l" "git-log" "?" "git-help" "q" "git-quit" }

+62

commands: (lambda (v)

+63

(list (make-cand "Git: Branches" "b" "git-branch-menu")

+64

(make-cand "Diff: Visit line" "RET" "git-visit")

+65

(make-cand "Diff: Load more" "" "git-diff-more")

+66

(make-cand "Diff: Refresh" "g" "git-diff-refresh")

+67

(make-cand "Diff: Close" "q" "git-quit")))

+68

actions: (list #{ id: 'git-diff label: "Diff" glyph: "Δ" tier: 'primary

+69

items: (list #{ id: 'up label: "↑" key: "ArrowUp" tier: 'primary repeat: #t }

+70

#{ id: 'down label: "↓" key: "ArrowDown" tier: 'primary repeat: #t }

+71

#{ id: 'visit label: "Open" command: "git-visit" tier: 'primary }

+72

#{ id: 'more label: "Load more" command: "git-diff-more" tier: 'secondary }

+73

#{ id: 'quit label: "Close" command: "git-quit" tier: 'tertiary }) })

+74

render: git-diff-render)

+75

(define (git-diff? v) (git-diff-mode? v))))

packages/slate/src/slate/modes/git-log.sgladded

@@ -0,0 +1,175 @@

+1

;;; (slate modes git-log) — keyboard-first history with lazy commit review.

+2

(define-library (slate modes git-log)

+3

(import (sigil record) (sigil math) (sigil string) (sigil web client)

+4

(slate components) (slate components diff) (slate mode) (slate option)

+5

(slate view) (slate modes markdown-view) (slate git log-model) (slate git log-view)

+6

(slate git diff-model) (slate git diff-view))

+7

(export git-log-render)

+8

(begin

+9

(define (button label command)

+10

`(button (@ (data-slate-click ,command)) ,label))

+11

(define (hint key label command)

+12

`(button (@ (data-slate-click ,command)) (kbd ,key) ,label))

+13

(define (x lane) (number->string (+ 9 (* lane 14))))

+14

(define (graph row)

+15

;; The current DOM bridge creates HTML elements only. Use a themed SVG

+16

;; mask on an ordinary span, as Slate's existing icon system does.

+17

(let* ((lane (dict-ref row lane: 0))

+18

(width (+ 4 (* 14 (max 1 (dict-ref row before: 1) (dict-ref row after: 1)))))

+19

(drawing

+20

(string-append

+21

"<svg xmlns='http://www.w3.org/2000/svg' viewBox='0 0 " (number->string width) " 32'>"

+22

"<g fill='none' stroke='black' stroke-width='1.3'>"

+23

(string-join

+24

(map (lambda (edge)

+25

(string-append "<path d='M " (x (car edge)) " "

+26

(if (= (car edge) lane) "16" "0") " L "

+27

(x (car edge)) " 16 L " (x (cdr edge)) " 32'/>"))

+28

(dict-ref row edges: '())) "")

+29

"<path d='M " (x lane) " 0 V 16'/></g>"

+30

"<circle cx='" (x lane) "' cy='16' r='3.5'/></svg>"))

+31

(encoded (string-replace

+32

(string-replace (string-replace drawing "<" "%3C") ">" "%3E") " " "%20")))

+33

`(span (@ (class "git-log-graph") (aria-hidden "true")

+34

(style ,(string-append "width:" (number->string width)

+35

"px;mask-image:url(\"data:image/svg+xml," encoded "\")"))))))

+36

(define (commit-row row selected)

+37

(let* ((commit (dict-ref row commit: #{})) (oid (dict-ref commit oid: ""))

+38

(refs (dict-ref commit refs: "")))

+39

`(button (@ (class ,(string-append "git-row git-log-row" (if (equal? oid selected) " selected" "")))

+40

(key ,oid) (data-oid ,oid) (aria-pressed ,(if (equal? oid selected) "true" "false"))

+41

(data-slate-click ,(string-append "git-log-open:" oid)))

+42

,(graph row)

+43

(span (@ (class "git-commit-oid")) ,(substring oid 0 7))

+44

(span (@ (class "git-log-summary"))

+45

,@(if (string=? refs "") '() `((span (@ (class "git-log-refs")) ,refs)))

+46

(span (@ (class "git-log-subject")) ,(dict-ref commit subject: "")))

+47

(span (@ (class "git-log-author")) ,(dict-ref commit author: "")))))

+48

(define (review-content review)

+49

(cond

+50

((not review)

+51

`(div (@ (class "git-log-empty"))

+52

(span (@ (class "icon i-git-commit-horizontal")))

+53

(strong "Explore this history")

+54

(span "Select a commit, then press Enter to inspect it.")

+55

,(hint "RET" "Inspect commit" "git-log-inspect")))

+56

((eq? (dict-ref review state: #f) loading:)

+57

`(div (@ (class "git-log-empty") (role "status")) "Loading commit…"))

+58

((eq? (dict-ref review state: #f) error:)

+59

`(div (@ (class "git-log-empty") (role "alert"))

+60

"Commit could not be loaded." ,(button "Retry selected commit" "git-log-inspect")))

+61

(else

+62

(let* ((commit (dict-ref review commit: #{}))

+63

(diff (dict-ref review diff: #f))

+64

(state (git-diff-model-state diff))

+65

(parents-value (dict-ref commit parents: '()))

+66

(parents (if (array? parents-value) (array->list parents-value) parents-value)))

+67

`(div (@ (class "git-log-inspection"))

+68

(header (@ (class "git-log-commit-header"))

+69

(div (@ (class "git-eyebrow")) "COMMIT")

+70

(h2 ,(dict-ref commit subject: ""))

+71

(div (@ (class "git-log-metadata"))

+72

(span ,(dict-ref commit author: ""))

+73

(span ,(dict-ref commit date: "")))

+74

(div (@ (class "git-log-oid")) ,(dict-ref commit oid: ""))

+75

,(button "Copy commit ID" "git-log-copy-review")

+76

,@(if (pair? parents)

+77

`((div (@ (class "git-log-parents"))

+78

(span "Parents ")

+79

,@(map (lambda (oid)

+80

(button (substring oid 0 7) (string-append "git-log-inspect:" oid))) parents))) '())

+81

(div (@ (class "git-log-message"))

+82

,(markdown-render-body-sxml (dict-ref commit body: "")))

+83

,@(if (> (length parents) 1)

+84

`((p (@ (class "git-log-note")) "Merge changes compared with the first parent.")) '()))

+85

,@(cond ((eq? (dict-ref state state: #f) loading:)

+86

`((p (@ (role "status")) "Loading changes…")))

+87

((eq? (dict-ref state state: #f) error:)

+88

`((p (@ (role "alert")) "Changes could not be loaded. Open the commit again to retry.")))

+89

(else '()))

+90

,(diff-control-render (git-diff-rows #{ slate/git-diff-model: diff }) #f

+91

(lambda (row) (and (eq? (dict-ref row kind: #f) continuation:) "git-log-diff-more"))))))))

+92

(define (git-log-render v)

+93

(let* ((model (git-log-model v)) (state (git-log-model-state model))

+94

(commits (git-log-commits model)) (selected (git-log-selected v))

+95

(repo (git-log-model-repo model)) (kind (dict-ref state state: idle:))

+96

(offset (dict-ref state offset: 0))

+97

(review-focused? (eq? (dict-ref v slate/git-log-focus: 'list) 'review))

+98

(layout (view-option v slate/git-layout: 'auto)))

+99

`(div (@ (class "view git-log git-buffer") (data-layout ,(symbol->string layout))

+100

(data-focus ,(if review-focused? "review" "list"))

+101

(data-review-oid ,(dict-ref (or (dict-ref state review: #f) #{}) oid: ""))

+102

(data-scroll-revision ,(number->string (dict-ref v slate/git-log-scroll-revision: 0)))

+103

(data-scroll ,(dict-ref v slate/git-log-scroll: "")))

+104

(header (@ (class "git-log-header"))

+105

(div (div (@ (class "git-eyebrow")) "HISTORY")

+106

(h1 ,(dict-ref (dict-ref state branch: #{}) head: "Repository"))

+107

(div (@ (class "git-log-path")) ,(dict-ref repo worktree: "")))

+108

(div (@ (class "git-header-actions"))

+109

,(button "Refresh" "git-log-refresh") ,(button "Close" "git-log-quit"))

+110

(div (@ (class "git-layout-control") (role "group") (aria-label "History layout"))

+111

,@(map (lambda (pair)

+112

`(button (@ (data-slate-click ,(string-append "git-layout:" (car pair)))

+113

(aria-pressed ,(if (string=? (symbol->string layout) (car pair)) "true" "false")))

+114

,(cdr pair))) '(("auto" . "Auto") ("inline" . "Stacked") ("split" . "Split")))))

+115

(div (@ (class "git-log-workbench"))

+116

(section (@ (class "git-log-list") (aria-label "Commits"))

+117

(div (@ (class "git-log-pane-label"))

+118

,(hint "ESC" "Commits" "git-log-focus-list")

+119

(span ,(if review-focused? "" "n / p move")))

+120

(div (@ (class "git-log-pagination"))

+121

(span ,(cond ((eq? kind loading:) "Loading history…")

+122

((eq? kind error:) "History unavailable or changed. Refresh to retry.")

+123

((null? commits) "No commits yet")

+124

(else (string-append (number->string (+ offset 1)) "–"

+125

(number->string (+ offset (length commits))) " · current branch"))))

+126

,@(if (> offset 0) (list (button "Newer" "git-log-newer")) '())

+127

,@(if (dict-ref state next-cursor: #f) (list (button "Older" "git-log-older")) '()))

+128

,@(map (lambda (row) (commit-row row (and selected (dict-ref selected oid: #f))))

+129

(git-log-graph commits)))

+130

(section (@ (class "git-log-review") (aria-label "Commit review"))

+131

(div (@ (class "git-log-pane-label"))

+132

,(hint "TAB" "Review" "git-log-switch-pane")

+133

(span ,(if review-focused? "n / p scroll · PgUp / PgDn" "Tab to enter")))

+134

(div (@ (class "git-log-review-body") (tabindex "-1"))

+135

,(web-client-memo "history-review" (number->string (git-log-model-revision model))

+136

(lambda () (review-content (dict-ref state review: #f)))))))

+137

(footer (@ (class "git-command-strip"))

+138

,(hint "n / p" (if review-focused? "Scroll" "Move") "git-log-next")

+139

,(hint "TAB" (if review-focused? "Back to commits" "Enter review") "git-log-switch-pane")

+140

,(hint "w" "Copy ID" "git-log-copy")

+141

,(hint "b" "Branches" "git-branch-menu")

+142

,(hint "g" "Refresh" "git-log-refresh")

+143

,(hint "?" "Commands" "git-help")))))

+144

(define-mode git-log-mode

+145

glyph: "◉" icon: "history" lighter: "History"

+146

info: (lambda (v) (string-append "History · "

+147

(number->string (length (git-log-commits (git-log-model v)))) " commits"))

+148

keymap: #{ "b" "git-branch-menu" "n" "git-log-next" "ArrowDown" "git-log-next"

+149

"p" "git-log-prev" "ArrowUp" "git-log-prev"

+150

"Enter" "git-log-inspect" "Tab" "git-log-switch-pane"

+151

"Escape" "git-log-focus-list"

+152

"PageDown" "git-log-page-down" "PageUp" "git-log-page-up"

+153

"Home" "git-log-top" "End" "git-log-bottom"

+154

"g" "git-log-refresh" "w" "git-log-copy"

+155

"]" "git-log-older" "[" "git-log-newer"

+156

"v" "git-layout" "?" "git-help" "q" "git-log-quit" }

+157

commands: (lambda (v)

+158

(list (make-cand "Git: Branches" "b" "git-branch-menu")

+159

(make-cand "History: Switch pane" "TAB" "git-log-switch-pane")

+160

(make-cand "History: Back to commits" "ESC" "git-log-focus-list")

+161

(make-cand "History: Scroll review down" "PgDn" "git-log-page-down")

+162

(make-cand "History: Scroll review up" "PgUp" "git-log-page-up")

+163

(make-cand "History: Inspect commit" "RET" "git-log-inspect")

+164

(make-cand "History: Copy commit ID" "w" "git-log-copy")

+165

(make-cand "History: Older commits" "]" "git-log-older")

+166

(make-cand "History: Newer commits" "[" "git-log-newer")

+167

(make-cand "History: Refresh" "g" "git-log-refresh")

+168

(make-cand "History: Close" "q" "git-log-quit")))

+169

actions: (list #{ id: 'history label: "History" glyph: "◉" tier: 'primary

+170

items: (list #{ id: 'up label: "↑" key: "ArrowUp" tier: 'primary repeat: #t }

+171

#{ id: 'down label: "↓" key: "ArrowDown" tier: 'primary repeat: #t }

+172

#{ id: 'inspect label: "Inspect" command: "git-log-inspect" tier: 'primary }

+173

#{ id: 'more label: "Older" command: "git-log-older" tier: 'secondary }

+174

#{ id: 'quit label: "Close" command: "git-log-quit" tier: 'tertiary }) })

+175

render: git-log-render)))

packages/slate/src/slate/modes/git-status.sgladded

@@ -0,0 +1,399 @@

+1

;;; (slate modes git-status) — structured, read-only Git status presentation.

+2

+3

(define-library (slate modes git-status)

+4

(import (sigil core)

+5

(sigil math)

+6

(sigil record)

+7

(sigil string)

+8

(slate components)

+9

(slate components diff)

+10

(slate git model)

+11

(slate git status-view)

+12

(slate mode)

+13

(slate option)

+14

(slate view))

+15

(export git-status? git-status-model

+16

git-status-rows git-status-move git-status-toggle

+17

git-status-selected-row git-status-render git-status-view-name

+18

git-status-repository-view-name)

+19

(begin

+20

(define-option slate/git-layout:

+21

default: auto type: (enum auto inline split)

+22

doc: "Git review layout: automatic by pane width, inline, or split"

+23

group: git)

+24

+25

(define (model-state v)

+26

(let ((model (git-status-model v)))

+27

(if model (git-status-model-state model) #{ state: loading: })))

+28

(define (status-data v) (dict-ref (model-state v) data: #{}))

+29

+30

(define (value-text value)

+31

(cond ((not value) "—") ((string? value) value)

+32

((keyword? value) (keyword->string value))

+33

(else (call-with-output-string (lambda (p) (write value p))))))

+34

(define (entry-label entry)

+35

(or (dict-ref entry path: #f) (dict-ref entry original-path: #f) "(unknown path)"))

+36

(define (as-list value)

+37

(cond ((array? value) (array->list value))

+38

((list? value) value)

+39

(else '())))

+40

(define (short-oid oid)

+41

(if (not (string? oid)) "—"

+42

(substring oid 0 (min 7 (string-length oid)))))

+43

(define (count-if pred values)

+44

(length (filter pred values)))

+45

(define (git-status-info v)

+46

(let* ((state (model-state v))

+47

(kind (dict-ref state state: loading:))

+48

(data (dict-ref state data: #{}))

+49

(entries (as-list (dict-ref data entries: '())))

+50

(staged (count-if (lambda (entry)

+51

(let ((kind (dict-ref entry kind: "ordinary"))

+52

(index (dict-ref entry index-state: "."))

+53

(worktree (dict-ref entry worktree-state: ".")))

+54

(and (not (string=? kind "conflict"))

+55

(not (string=? kind "untracked"))

+56

(not (string=? index "U"))

+57

(not (string=? worktree "U"))

+58

(not (string=? index ".")))))

+59

entries))

+60

(untracked (count-if (lambda (entry)

+61

(string=? (dict-ref entry kind: "") "untracked"))

+62

entries))

+63

(counts (string-append (number->string (length entries)) " changed · "

+64

(number->string staged) " staged · "

+65

(number->string untracked) " untracked")))

+66

(cond ((eq? kind loading:) "Git · loading…")

+67

((and (eq? kind stale:) (not (dict-ref state external-change?: #f)))

+68

(string-append "Git · refreshing… · " counts))

+69

((eq? kind stale:) (string-append "Git · refresh needed · " counts))

+70

((eq? kind error:) (string-append "Git · refresh failed · " counts))

+71

((eq? (dict-ref state mutation: #f) pending:)

+72

(string-append "Git · updating… · " counts))

+73

(else (string-append "Git · " counts)))))

+74

(define (icon-button icon label command class)

+75

`(button (@ (class ,class) (aria-label ,label) (title ,label)

+76

(data-slate-click ,command))

+77

(span (@ (class ,(string-append "icon i-" icon))))))

+78

+79

(define (render-row row selected? folded)

+80

(let ((kind (dict-ref row kind: #f))

+81

(id (dict-ref row id: "")))

+82

(cond

+83

((eq? kind section:)

+84

(let ((section (dict-ref row section: #f)))

+85

`(div (@ (class ,(if selected? "git-row git-section selected" "git-row git-section"))

+86

(key ,id)

+87

(data-slate-click ,(string-append "git-select-toggle:" id))

+88

(aria-expanded ,(if (member id folded) "false" "true")))

+89

(button (@ (class "git-section-toggle")

+90

(data-slate-click ,(string-append "git-select-toggle:" id))

+91

(aria-expanded ,(if (member id folded) "false" "true")))

+92

(span (@ (class "git-chevron") (aria-hidden "true"))

+93

,(if (member id folded) "▸" "▾"))

+94

,(dict-ref row label: "")

+95

(span (@ (class "git-section-count"))

+96

,(number->string (dict-ref row count: 0)))

+97

(span (@ (class "git-section-rule") (aria-hidden "true"))))

+98

,@(cond ((or (eq? section unstaged:) (eq? section untracked:))

+99

(list `(button (@ (class "git-entry-mutation")

+100

(data-slate-click ,(string-append "git-select-stage:" id))) "Stage all")))

+101

((eq? section staged:)

+102

(list `(button (@ (class "git-entry-mutation")

+103

(data-slate-click ,(string-append "git-select-unstage:" id))) "Unstage all")))

+104

(else '())))))

+105

((eq? kind entry:)

+106

(let ((entry (dict-ref row entry: #{})))

+107

`(div (@ (class ,(string-append

+108

"git-row git-entry git-"

+109

(keyword->string (dict-ref row section: unstaged:))

+110

(if selected? " selected" "")))

+111

(key ,id)

+112

(data-slate-click ,(string-append "git-select:" id)))

+113

(span (@ (class "git-entry-state"))

+114

,(string-append (dict-ref entry index-state: ".")

+115

(dict-ref entry worktree-state: ".")))

+116

(button (@ (class "git-entry-toggle")

+117

(aria-label ,(string-append "Toggle diff " (entry-label entry)))

+118

(aria-expanded ,(if (dict-ref row expanded: #f) "true" "false"))

+119

(data-slate-click ,(string-append "git-select-toggle:" id)))

+120

,(if (dict-ref row expanded: #f) "▾" "▸"))

+121

(button (@ (class "git-entry-path")

+122

(title ,(entry-label entry))

+123

(data-slate-click ,(string-append "git-visit:" id)))

+124

,@(path-label (entry-label entry)))

+125

,(icon-button "code" (string-append "Diff " (entry-label entry))

+126

(string-append "git-select-diff:" id) "git-entry-diff")

+127

,@(if (eq? (dict-ref row section: #f) conflicts:)

+128

(let ((stages (dict-ref entry conflict-stages: #{})))

+129

(list

+130

`(span (@ (class "git-conflict-stages"))

+131

,(string-append "base " (value-text (dict-ref stages stage-1: #f))

+132

" ours " (value-text (dict-ref stages stage-2: #f))

+133

" theirs " (value-text (dict-ref stages stage-3: #f))))

+134

`(span (@ (class "git-conflict-actions"))

+135

(button (@ (class "git-conflict-stage")

+136

(data-slate-click ,(string-append "git-conflict-base:" id))) "Base")

+137

(button (@ (class "git-conflict-stage")

+138

(data-slate-click ,(string-append "git-conflict-ours:" id))) "Ours")

+139

(button (@ (class "git-conflict-stage")

+140

(data-slate-click ,(string-append "git-conflict-theirs:" id))) "Theirs"))))

+141

'())

+142

,@(cond ((or (eq? (dict-ref row section: #f) unstaged:)

+143

(eq? (dict-ref row section: #f) untracked:))

+144

(list (icon-button "plus" (string-append "Stage " (entry-label entry))

+145

(string-append "git-select-stage:" id) "git-entry-mutation")

+146

(icon-button "trash-2" (string-append "Discard " (entry-label entry) " permanently")

+147

(string-append "git-select-discard:" id) "git-entry-discard")))

+148

((eq? (dict-ref row section: #f) staged:)

+149

(list (icon-button "corner-down-left" (string-append "Unstage " (entry-label entry))

+150

(string-append "git-select-unstage:" id) "git-entry-mutation")))

+151

(else '())))))

+152

((dict-ref row owner: #f)

+153

(diff-row-render

+154

(with-hunk-mutation row)

+155

selected?

+156

(cond ((diff-kind=? (diff-row-kind row) hunk:) (string-append "git-select-toggle:" id))

+157

                   ((diff-kind=? (diff-row-kind row) continuation:) (string-append "git-inline-more:" (dict-ref row owner: "")))

+158

(else (string-append "git-select:" id)))))

+159

(else

+160

(let ((commit (dict-ref row commit: #{})))

+161

`(button (@ (class ,(if selected? "git-row git-commit selected" "git-row git-commit"))

+162

(key ,id)

+163

(data-slate-click ,(string-append "git-select:" id)))

+164

(span (@ (class "git-commit-oid")) ,(short-oid (dict-ref commit oid: #f)))

+165

(span (@ (class "git-commit-subject"))

+166

,(dict-ref commit subject: "(no subject)"))))))))

+167

+168

(define (inline-command row)

+169

(let ((id (dict-ref row id: "")))

+170

(cond ((diff-kind=? (diff-row-kind row) hunk:) (string-append "git-select-toggle:" id))

+171

((diff-kind=? (diff-row-kind row) continuation:)

+172

(string-append "git-inline-more:" (dict-ref row owner: "")))

+173

(else (string-append "git-select:" id)))))

+174

(define (with-hunk-mutation row)

+175

(if (not (dict-ref row hunk-id: #f)) row

+176

(let* ((id (dict-ref row id: ""))

+177

(side (dict-ref (dict-ref row hunk-id: #{}) side: ""))

+178

(staged? (string=? side "staged"))

+179

(next (dict-set row mutation-command:

+180

(string-append (if staged? "git-select-unstage:" "git-select-stage:") id)))

+181

;; Labels are host policy; opaque row IDs can contain action

+182

;; names in a directory, filename, or section suffix.

+183

(next (dict-set next mutation-label: (if staged? "Unstage hunk" "Stage hunk")))

+184

(next (dict-set next mutation-icon: (if staged? "corner-down-left" "plus"))))

+185

(if (string=? side "worktree")

+186

(dict-set next discard-command: (string-append "git-select-discard:" id))

+187

next))))

+188

(define (path-label path)

+189

(let loop ((i (- (string-length path) 1)))

+190

(cond ((< i 0) (list path))

+191

((char=? (string-ref path i) #\/)

+192

(list `(span (@ (class "git-path-directory")) ,(substring path 0 (+ i 1)))

+193

(substring path (+ i 1) (string-length path))))

+194

(else (loop (- i 1))))))

+195

(define (path-name path)

+196

(let ((parts (string-split path "/")))

+197

(if (null? parts) path (list-ref parts (- (length parts) 1)))))

+198

(define (row-for rows id)

+199

(cond ((or (not id) (null? rows)) #f)

+200

((equal? id (dict-ref (car rows) id: #f)) (car rows))

+201

(else (row-for (cdr rows) id))))

+202

(define (review-title row)

+203

(let ((entry (dict-ref row entry: #{})))

+204

`(div (@ (class "git-review-title"))

+205

(span (@ (class "git-review-path") (title ,(entry-label entry)))

+206

,(entry-label entry))

+207

(span (@ (class "git-review-side"))

+208

,(if (eq? (dict-ref row section: #f) staged:)

+209

"HEAD → index" "index → worktree")))))

+210

(define (render-status-rows rows selected folded active all-rows revision)

+211

(if (null? rows) '()

+212

(let ((owner (dict-ref (car rows) owner: #f)))

+213

(if (not owner)

+214

(cons (render-row (car rows)

+215

(and selected (string=? selected (dict-ref (car rows) id: ""))) folded)

+216

(render-status-rows (cdr rows) selected folded active all-rows revision))

+217

(let collect ((rest rows) (group '()))

+218

(if (and (not (null? rest))

+219

(equal? owner (dict-ref (car rest) owner: #f)))

+220

(collect (cdr rest) (cons (car rest) group))

+221

(cons

+222

`(div (@ (class ,(string-append "git-inline-diff"

+223

(if (equal? owner active) " active" "")))

+224

(key ,(string-append "review:" owner))

+225

(data-review-owner ,owner))

+226

,(review-title (or (row-for all-rows owner) #{}))

+227

,@(let ((state (dict-ref (car group) review-state: #f)))

+228

(cond

+229

((or (eq? state deferred:) (eq? state error:))

+230

(list `(button (@ (class "git-review-refresh")

+231

(data-slate-click ,(string-append "git-inline-refresh:" owner)))

+232

"Refresh this review")))

+233

((eq? state stale:)

+234

(list `(div (@ (class "git-review-refresh") (role "status"))

+235

"Updating review…")))

+236

(else '())))

+237

,(diff-control-render (reverse group) selected inline-command

+238

revision: revision prepare-row: with-hunk-mutation))

+239

(render-status-rows rest selected folded active all-rows revision))))))))

+240

(define (layout-control v)

+241

(let ((layout (view-option v slate/git-layout: 'auto)))

+242

`(div (@ (class "git-layout-control") (role "group")

+243

(aria-label "Git review layout"))

+244

,@(map (lambda (choice)

+245

`(button (@ (data-slate-click ,(string-append "git-layout:" (car choice)))

+246

(aria-pressed ,(if (eq? layout (string->symbol (car choice)))

+247

"true" "false"))

+248

(title ,(cdr choice)))

+249

,(cond ((string=? (car choice) "auto") "Auto")

+250

((string=? (car choice) "inline") "Inline")

+251

(else "Split"))))

+252

'(("auto" . "Follow the Git pane width")

+253

("inline" . "Review diffs in the status outline")

+254

("split" . "Review beside the status outline"))))))

+255

(define (command-hint key label command)

+256

`(button (@ (data-slate-click ,command)) (kbd ,key) ,label))

+257

(define (command-strip row)

+258

(let* ((kind (and row (dict-ref row kind: #f)))

+259

(hunk (and row (dict-ref row hunk-id: #f)))

+260

(section (and row (dict-ref row section: #f)))

+261

(staged? (or (eq? section staged:)

+262

(and hunk (string=? (dict-ref hunk side: "") "staged"))))

+263

(work? (or (eq? section unstaged:) (eq? section untracked:)

+264

(and hunk (string=? (dict-ref hunk side: "") "worktree")))))

+265

`(nav (@ (class "git-command-strip") (aria-label "Git commands"))

+266

,(command-hint "n / p" "Move" "git-next")

+267

,(command-hint "Tab" "Fold" "git-toggle")

+268

,(command-hint "↵" "Open" "git-visit")

+269

,@(cond (staged? (list (command-hint "u" "Unstage" "git-unstage")))

+270

(work? (list (command-hint "s" "Stage" "git-stage")))

+271

(else '()))

+272

,@(if (and work? (not (eq? kind section:)))

+273

(list (command-hint "k" "Discard" "git-discard")) '())

+274

,(command-hint "g" "Refresh" "git-refresh")

+275

,(command-hint "?" "Commands" "git-help")

+276

(span (@ (class "git-selection-scope"))

+277

,(cond (hunk "Hunk selected")

+278

((eq? kind entry:) "File selected")

+279

((eq? kind section:) "Section selected")

+280

((eq? kind commit:) "Commit selected")

+281

(else ""))))))

+282

(define (render-ready v data)

+283

(let* ((repo (dict-ref data repo: #{}))

+284

(branch (dict-ref data branch: #{}))

+285

(selected (dict-ref v slate/git-selected: #f))

+286

(folded (dict-ref v slate/git-folded: '()))

+287

(rows (git-status-rows v))

+288

(row (row-for rows selected))

+289

(owner (and row (or (dict-ref row owner: #f)

+290

(and (eq? (dict-ref row kind: #f) entry:) selected))))

+291

(entry-row (row-for rows owner))

+292

(open? (and entry-row (dict-ref entry-row expanded: #f)))

+293

(source (view-source v))

+294

(commits (as-list (dict-ref data recent-commits: '())))

+295

(latest (and (pair? commits) (car commits)))

+296

(operation (dict-ref data operation: #f))

+297

(path (dict-ref repo worktree: "")))

+298

`(div (@ (class "view git-status git-buffer")

+299

(data-review-version ,(number->string (dict-ref v slate/git-review-version: 0)))

+300

(data-layout ,(symbol->string (view-option v slate/git-layout: 'auto))))

+301

(header (@ (class "git-repository-header"))

+302

(div (@ (class "git-repository-title"))

+303

(span (@ (class "git-repository-name") (title ,path) (aria-label "Repository"))

+304

,(path-name path))

+305

(span (@ (class "git-repository-origin") (aria-label "Root / node"))

+306

,(string-append

+307

(value-text (or (dict-ref source host: #f)

+308

(dict-ref source provider: #f)))

+309

" / " (value-text (dict-ref repo root: #f))))

+310

,(icon-button "git-branch" "Branches (b)" "git-branch-menu" "git-header-icon")

+311

,(icon-button "history" "History (l)" "git-log" "git-header-icon")

+312

,(icon-button "history" "Refresh Git status" "git-refresh" "git-header-icon")

+313

,(icon-button "x" "Close Git status" "git-quit" "git-header-icon"))

+314

(div (@ (class "git-branch-line"))

+315

(span (@ (class "icon i-git-branch") (aria-hidden "true")))

+316

(span (@ (class "git-branch-name"))

+317

,(value-text (dict-ref branch head: (dict-ref branch oid: #f))))

+318

,@(if (dict-ref branch upstream: #f)

+319

`((span (@ (class "git-upstream"))

+320

"→ " ,(dict-ref branch upstream: ""))) '())

+321

(span (@ (class "git-ahead")) "↑ " ,(number->string (dict-ref branch ahead: 0)))

+322

(span (@ (class "git-behind")) "↓ " ,(number->string (dict-ref branch behind: 0))))

+323

(div (@ (class "git-repository-detail"))

+324

(span (@ (class "git-repository-path") (title ,path)) ,path)

+325

,@(if latest

+326

`((span (@ (class "git-latest-commit") (aria-label "Latest commit"))

+327

(span (@ (class "git-commit-oid")) ,(short-oid (dict-ref latest oid: #f)))

+328

" " ,(dict-ref latest subject: "(no subject)"))) '()))

+329

,@(if operation

+330

`((div (@ (class "git-operation") (role "status"))

+331

"Operation in progress · " ,(value-text operation))) '())

+332

(div (@ (class "git-review-toolbar"))

+333

(span (@ (class "git-review-label")) "Changes")

+334

,(layout-control v)))

+335

(div (@ (class "git-workbench"))

+336

(div (@ (class "git-outline") (aria-label "Git status outline"))

+337

,@(if (null? (as-list (dict-ref data entries: '())))

+338

`((div (@ (class "git-clean-state"))

+339

(strong "Working tree clean")

+340

(span "No uncommitted changes."))) '())

+341

,@(render-status-rows rows selected folded owner rows (git-status-row-revision v)))

+342

,@(if open? '()

+343

(list

+344

`(aside (@ (class "git-review-empty") (aria-label "Selected file review"))

+345

,@(if entry-row (list (review-title entry-row)) '())

+346

(div (@ (class "git-review-prompt"))

+347

(span (@ (class "icon i-code") (aria-hidden "true")))

+348

(strong ,(if entry-row "Ready to review" "Select a change"))

+349

(p ,(if entry-row "Expand this file to review its diff."

+350

"Use n and p to move through files and hunks."))

+351

,@(if entry-row

+352

(list (command-hint "Tab" "Open diff" "git-toggle")) '()))))))

+353

,(command-strip row))))

+354

+355

(define (git-status-render v)

+356

(let* ((state (model-state v)) (kind (dict-ref state state: loading:))

+357

(data (dict-ref state data: #f)))

+358

(cond ((eq? kind loading:) `(div (@ (class "view git-status loading")) ,(card "Git status" "Loading…")))

+359

              ((eq? kind unavailable:) `(div (@ (class "view git-status unavailable")) ,(card "Git unavailable" "This root has no node-backed Git service.")))

+360

((and (or (eq? kind stale:) (eq? kind error:)) data)

+361

(render-ready v data))

+362

              ((eq? kind error:) `(div (@ (class "view git-status error")) ,(card "Git status failed" "The node could not load this repository.")))

+363

(else (render-ready v data)))))

+364

+365

(define-mode git-status-mode

+366

glyph: "±" icon: "source-control" lighter: "Git" info: git-status-info

+367

keymap: #{ "b" "git-branch-menu" "n" "git-next" "ArrowDown" "git-next"

+368

"p" "git-prev" "ArrowUp" "git-prev"

+369

"Tab" "git-toggle" "Enter" "git-visit"

+370

"s" "git-stage" "u" "git-unstage" "k" "git-discard"

+371

"l" "git-log" "g" "git-refresh" "d" "git-diff" "v" "git-layout" "?" "git-help" "q" "git-quit" }

+372

commands: (lambda (v)

+373

(list (make-cand "Git: Branches" "b" "git-branch-menu")

+374

(make-cand "Git: Cycle layout" "v" "git-layout")

+375

(make-cand "Git: Refresh" "g" "git-refresh")

+376

(make-cand "Git: Toggle" "TAB" "git-toggle")

+377

(make-cand "Git: Visit" "RET" "git-visit")

+378

(make-cand "Git: History" "l" "git-log")

+379

(make-cand "Git: Diff" "d" "git-diff")

+380

(make-cand "Git: Stage" "s" "git-stage")

+381

(make-cand "Git: Unstage" "u" "git-unstage")

+382

(make-cand "Git: Discard" "k" "git-discard")

+383

(make-cand "Git: Close" "q" "git-quit")))

+384

actions: (list #{ id: 'git label: "Git" glyph: "±" tier: 'primary

+385

items: (list #{ id: 'up label: "↑" key: "ArrowUp" tier: 'primary repeat: #t }

+386

#{ id: 'down label: "↓" key: "ArrowDown" tier: 'primary repeat: #t }

+387

#{ id: 'toggle label: "Fold" command: "git-toggle" tier: 'primary }

+388

#{ id: 'visit label: "Open" command: "git-visit" tier: 'primary }

+389

#{ id: 'branches label: "Branches" command: "git-branch-menu" tier: 'primary }

+390

#{ id: 'history label: "History" command: "git-log" tier: 'primary }

+391

#{ id: 'diff label: "Diff" command: "git-diff" tier: 'primary }

+392

#{ id: 'stage label: "Stage" command: "git-stage" tier: 'primary }

+393

#{ id: 'unstage label: "Unstage" command: "git-unstage" tier: 'primary }

+394

#{ id: 'discard label: "Discard" command: "git-discard" tier: 'primary }

+395

#{ id: 'refresh label: "Refresh" command: "git-refresh" tier: 'secondary }

+396

#{ id: 'quit label: "Close" command: "git-quit" tier: 'tertiary }) })

+397

render: git-status-render)

+398

+399

(define (git-status? v) (git-status-mode? v))))

packages/slate/src/slate/modes/node-status.sgladded

@@ -0,0 +1,189 @@

+1

;;; (slate modes node-status) — local node lifecycle facts from /node/status.

+2

+3

(define-library (slate modes node-status)

+4

(import (sigil core)

+5

(sigil record)

+6

(slate mode)

+7

(slate components)

+8

(slate view))

+9

(export make-node-status-view node-status? node-status-view-name

+10

node-status-loading node-status-ready node-status-failed

+11

node-status-connection)

+12

(begin

+13

(define node-status-view-name "slate:/node-status")

+14

+15

(define (text value fallback)

+16

(cond ((string? value) value)

+17

((number? value) (number->string value))

+18

((eq? value #t) "yes")

+19

((eq? value #f) "no")

+20

(else fallback)))

+21

+22

(define (field record key fallback)

+23

(text (and (dict? record) (dict-ref record key #f)) fallback))

+24

+25

(define (status-summary status)

+26

(let* ((listener (dict-ref status listener: #{}))

+27

(process (dict-ref status process: #{}))

+28

(healthy? (dict-ref listener healthy: #f))

+29

(live? (dict-ref process live: #f)))

+30

(cond (healthy? (cons "Reachable" 'ok))

+31

(live? (cons "Process live; listener unavailable" 'warn))

+32

(else (cons "Unavailable" 'err)))))

+33

+34

(define (capability-state capability)

+35

(if (dict-ref capability available: #f) "available" "unavailable"))

+36

+37

(define (node-status-render v)

+38

(let ((phase (dict-ref v slate/node-status-phase: loading:))

+39

(status (dict-ref v slate/node-status: #{}))

+40

(error-text (dict-ref v slate/node-status-error: ""))

+41

(connected? (dict-ref v slate/node-connected?: #f))

+42

(transport-url (dict-ref v slate/node-transport-url: "unknown")))

+43

`(div (@ (class "view welcome node-status-view")

+44

(data-node-status-phase ,(keyword->string phase)))

+45

(div (@ (class "welcome-page"))

+46

,(section "Local node"

+47

`(p (@ (class "welcome-tagline"))

+48

"Lifecycle and listener facts for the node serving this Slate app.")

+49

(button "Refresh" "node-status-refresh" 'ghost))

+50

,(cond

+51

((eq? phase loading:)

+52

(card "Checking" `(p "Reading the loopback node status…")))

+53

((eq? phase error:)

+54

(card "Unavailable"

+55

`(p ,error-text)

+56

`(p (@ (class "welcome-note"))

+57

"This is expected when Slate is not being served by a local node.")))

+58

(else

+59

(let* ((platform (dict-ref status platform: #{}))

+60

(identity (dict-ref status identity: #{}))

+61

(posture (dict-ref status capability-posture: #{}))

+62

(resource (dict-ref posture resource: #{}))

+63

(session (dict-ref posture session: #{}))

+64

(agent (dict-ref posture agent: #{}))

+65

(renderer (dict-ref posture renderer: #{}))

+66

(remote-manager

+67

(dict-ref posture remote-transport-manager: #{}))

+68

(upgrade (dict-ref status upgrade: #{}))

+69

(upgrade-check (dict-ref upgrade check: #{}))

+70

(upgrade-apply (dict-ref upgrade apply: #{}))

+71

(upgrade-rollback (dict-ref upgrade rollback: #{}))

+72

(upgrade-installation

+73

(dict-ref upgrade installation: #{}))

+74

(installation (dict-ref status installation: #{}))

+75

(supervision (dict-ref status supervision: #{}))

+76

(process (dict-ref status process: #{}))

+77

(listener (dict-ref status listener: #{}))

+78

(lifecycle (dict-ref status lifecycle: #{}))

+79

(autostart (dict-ref status autostart: #{}))

+80

(app (dict-ref status app: #{}))

+81

(client (dict-ref status web-client: #{}))

+82

(summary (status-summary status)))

+83

(cols

+84

(card "Current connection"

+85

(h-stack (icon-dot (if connected? 'on 'off))

+86

(badge (if connected? "Connected" "Not connected")

+87

(if connected? 'ok 'warn)))

+88

(kv-table

+89

(list (cons "Transport" transport-url)

+90

(cons "Status endpoint" "same origin /node/status"))))

+91

(card "Runtime"

+92

(h-stack (icon-dot (if (eq? (cdr summary) 'ok) 'on 'off))

+93

(badge (car summary) (cdr summary)))

+94

(kv-table

+95

(list (cons "Platform" (field platform kind: "unknown"))

+96

(cons "Environment" (field platform environment: "unknown"))

+97

(cons "PID" (field process pid: "absent"))

+98

(cons "PID state" (field process pid-state: "unknown")))))

+99

(card "Role and capabilities"

+100

(kv-table

+101

(list (cons "Role" (field identity role: "unknown"))

+102

(cons "Scope" (field identity scope: "unknown"))

+103

(cons "Resource" (capability-state resource))

+104

(cons "Session" (capability-state session))

+105

(cons "Agent" (capability-state agent))

+106

(cons "Renderer" (capability-state renderer))

+107

(cons "Remote transport manager"

+108

(capability-state remote-manager))

+109

(cons "Remote transport reason"

+110

(field remote-manager reason: "unknown"))))

+111

`(p (@ (class "welcome-note"))

+112

"Capability availability does not grant the current origin permission to use it."))

+113

(card "Persistent installation"

+114

(kv-table

+115

(list (cons "Installation" (field installation posture: "unknown"))

+116

(cons "Supervisor" (field supervision kind: "none"))

+117

(cons "Supervisor running" (field supervision running: "unknown"))

+118

(cons "Configured listener" (field listener url: "unknown"))

+119

(cons "Autostart" (field autostart posture: "unknown"))

+120

(cons "Record" (field lifecycle state: "missing"))

+121

(cons "Restarts" (field lifecycle restart-count: "0")))))

+122

(card "Node upgrade"

+123

(kv-table

+124

(list

+125

(cons "Current version"

+126

(field upgrade current-version: "unknown"))

+127

(cons "Available version"

+128

(field upgrade available-version: "not checked"))

+129

(cons "State" (field upgrade state: "unknown"))

+130

(cons "Check endpoint"

+131

(field upgrade-check endpoint: "unavailable"))

+132

(cons "Install strategy"

+133

(field upgrade-installation strategy: "unknown"))

+134

(cons "Apply"

+135

(if (dict-ref upgrade-apply available: #f)

+136

"available"

+137

(field upgrade-apply reason: "unavailable")))

+138

(cons "Rollback"

+139

(if (dict-ref upgrade-rollback available: #f)

+140

"available"

+141

(field upgrade-rollback reason: "unavailable")))))

+142

`(p (@ (class "welcome-note"))

+143

                                 "Upgrade checks are read-only. Applying or rolling back an upgrade is not implemented yet."))

+144

(card "Web client"

+145

(kv-table

+146

(list (cons "Running version" (field client running-version: "unknown"))

+147

(cons "Controlling worker" (field client controlled-version: "unknown"))

+148

(cons "Served worker" (field client served-version: "unknown"))

+149

(cons "Worker state" (field client controller-state: "unknown"))

+150

(cons "Worker script" (field client controller-script: "unknown"))

+151

(cons "Worker cache" (field client controlled-cache: "unknown"))

+152

(cons "Slate caches" (field client cache-names: "unknown"))

+153

(cons "Origin" (field client origin: "unknown"))))

+154

(button "Update client" "slate-update-client" 'ghost))

+155

(card "Application"

+156

(kv-table

+157

(list (cons "Selection" (field app selection: "unknown"))

+158

(cons "Upstream" (field app url: "unknown"))

+159

(cons "Schema" (field status schema-version: "unknown")))))))))))))

+160

+161

(define-mode node-status

+162

glyph: "●" icon: "activity" lighter: "node"

+163

info: (lambda (v) "local node status")

+164

render: node-status-render)

+165

+166

(define (make-node-status-view)

+167

(node-status slate/name: node-status-view-name

+168

slate/source: #{ kind: file: provider: slate: address: "/node-status" }

+169

slate/node-status-phase: loading:

+170

slate/node-status: #{}

+171

slate/node-status-error: ""

+172

slate/node-connected?: #f

+173

slate/node-transport-url: "unknown"))

+174

+175

(define (node-status-loading v)

+176

(dict-set (dict-set v slate/node-status-phase: loading:)

+177

slate/node-status-error: ""))

+178

(define (node-status-ready v status . connection)

+179

(let ((ready (dict-set (dict-set v slate/node-status-phase: ready:)

+180

slate/node-status: status)))

+181

(if (null? connection) ready

+182

(node-status-connection ready (car connection)

+183

(if (null? (cdr connection)) "unknown" (cadr connection))))))

+184

(define (node-status-connection v connected? transport-url)

+185

(dict-set (dict-set v slate/node-connected?: connected?)

+186

slate/node-transport-url: transport-url))

+187

(define (node-status-failed v message)

+188

(dict-set (dict-set v slate/node-status-phase: error:)

+189

slate/node-status-error: message))))

packages/slate/src/slate/modes/terminal.sglmodified

@@ -46,9 +46,11 @@

46

(slate base64) ; OSC-52 payload is base64 (§10)

47

(slate tmux opener)) ; tmux-render for the CC "better terminal" pane

48

(export make-terminal-view terminal? terminal

−49

terminal-send-key! terminal-paste! terminal-scroll!

−50

terminal-set-size! terminal-close! terminal-live?

−51

terminal-take-frame terminal-registered? terminal-window

+49

terminal-send-key! terminal-paste! terminal-compose! terminal-scroll!

+50

terminal-set-size! terminal-close! terminal-live? terminal-remote-id

+51

terminal-copy-snapshot terminal-copy-active? terminal-copy-end!

+52

terminal-take-frame terminal-frame-pending? terminal-registered? terminal-window

+53

terminal-set-prediction-enabled! terminal-take-prediction-input!

54

key-event->bytes

55

;; the ONE cursor-key spelling (DECCKM + xterm modifier parameter) and

56

;; the ONE scroll-gesture decision (wheel + touch-drag share both)

@@ -90,6 +92,7 @@

92

;; uncovered by any unit test, and is now SAID rather than implied, is

93

;; this module's wiring of that decision to the DOM and the gesture.

94

terminal-note-time! terminal-mark-connected!

+95

terminal-take-visual-damage!

96

terminal-disconnected? disconnect-ribbon terminal-redial!

97

terminal-note-clock-live! term-mode-badge)

98

(begin

@@ -102,6 +105,11 @@

105

;; term inside is the mutable machine.

106

(define *terminals* #{})

107

+108

(define (terminal-remote-id name)

+109

(let ((e (term-entry name)))

+110

(and e (session-live? (dict-ref e handle: #{}))

+111

(session-remote-id (dict-ref e handle: #{})))))

+112

113

(define (term-entry name) (dict-ref *terminals* name #f))

114

(define (set-entry! name e) (set! *terminals* (dict-set *terminals* name e)))

115

(define (update-entry! name k v)

@@ -159,8 +167,13 @@

167

;; backings) is R3b's.

168

(define (disconnect-ribbon name)

169

(let ((label (ribbon-label name)))

−162

(if label

−163

(list

+170

;; Keep this keyed slot in the pane in both connected and disconnected

+171

;; states. The sibling .term-content is a foreign subtree owned by the

+172

;; JS terminal kernel; inserting a new sibling ahead of it let the vdom

+173

;; reconcile through that node and erase the retained terminal grid.

+174

(list

+175

`(div (@ (class "term-ribbon-slot") (key "term-ribbon-slot"))

+176

,(if label

177

;; A REAL <button>, not a styled span. A span has no tab stop, no

178

;; Enter/Space activation and no button role, so the only recovery

179

;; gesture this phase ships would have been reachable by POINTER

@@ -176,8 +189,8 @@

189

(data-term-ribbon-action ,name)

190

(data-slate-click

191

,(string-append "terminal-reconnect-pane:" name)))

−179

"Reconnect")))

−180

'())))

+192

"New Session"))

+193

"")))))

194

195

;; The ribbon's clock. Fed from the same metronome as everything else, and

196

;; kept OUT of the app-db deliberately: the terminal registry is not state,

@@ -190,6 +203,16 @@

203

;; because someone is on a bad mobile link).

204

(define *now-ms* #f)

205

(define *ribbon-signature* "")

+206

;; Async session events mutate the terminal registry outside Slate's normal

+207

;; dispatch/render path. Remember transitions that change DOM chrome so the

+208

;; owning metronome can render them explicitly. The terminal canvas pump is

+209

;; insufficient here: the disconnected dimmer and ribbon live in the Slate

+210

;; tree, not in the emulator canvas.

+211

(define *visual-damage?* #f)

+212

(define (terminal-take-visual-damage!)

+213

(let ((damaged? *visual-damage?*))

+214

(set! *visual-damage?* #f)

+215

damaged?))

216

217

;; IS EITHER METRONOME ARMED? A FACT, NOT A CLOCK READING, and the distinction

218

;; is the whole repair of this surface's worst defect.

@@ -325,10 +348,24 @@

348

;; grid, which is the mirror image of the lie it exists to prevent. Leaving

349

;; the stale signature in place is precisely what triggers the removal.

350

(define (terminal-mark-connected! name)

−328

(let ((e (term-entry name)))

+351

;; Keep the registry read behind a multi-incoming merge. In optimized

+352

;; WASM, reading *terminals* through term-entry/update-entry and then

+353

;; replacing that same cell was flow-insensitively aliased to the value

+354

;; being written. The emitted function consequently kept the guard and

+355

;; discarded BOTH field updates: the remote session reattached, but its

+356

;; pane stayed dimmed until an unrelated view switch forced a render.

+357

;; `or` is the established barrier used by the two latches immediately

+358

;; above; every dict is truthy, so it changes the CFG but not the value.

+359

;; Build the complete replacement from that snapshot and set the registry

+360

;; once, which also makes the state transition atomic to event readers.

+361

(let* ((registry (or *terminals* #{}))

+362

(e (dict-ref registry name #f)))

363

(when (and e (dict-ref e disconnected?: #f))

−330

(update-entry! name disconnected?: #f)

−331

(update-entry! name disconnected-at: #f))))

+364

(set! *terminals*

+365

(dict-set registry name

+366

(dict-set (dict-set e disconnected?: #f)

+367

disconnected-at: #f)))

+368

(set! *visual-damage?* #t))))

369

370

;; ---- OSC-52 staged clipboard (§10) ---------------------------------------

371

;; An inner program (or tmux copy-mode via the opener) that writes the OSC 52

@@ -432,6 +469,32 @@

469

(define default-cols 80)

470

(define default-rows 24)

471

+472

;; Only actual terminal key writes enter this UI handoff. Key bindings,

+473

;; sticky modifiers and the mobile input route have already resolved here.

+474

;; A single pending item suffices: the browser drains after each key event.

+475

(define *prediction-enabled?* #f)

+476

(define *prediction-input* "")

+477

+478

(define (terminal-set-prediction-enabled! enabled)

+479

(unless (eq? enabled *prediction-enabled?*)

+480

(set! *prediction-input* ""))

+481

(set! *prediction-enabled?* enabled))

+482

+483

(define (terminal-take-prediction-input!)

+484

(let ((input *prediction-input*))

+485

(set! *prediction-input* "")

+486

input))

+487

+488

(define (note-prediction-input! name bytes)

+489

(when *prediction-enabled?*

+490

(let ((printable

+491

(and (= (string-length bytes) 1)

+492

(<= 32 (char->integer (string-ref bytes 0)) 126))))

+493

(set! *prediction-input*

+494

(string-append name "\n"

+495

(number->string (dict-ref (term-entry name) output-serial: 0)) "\n"

+496

(if printable bytes ""))))))

+497

498

;; Feed a chunk + drain any queued emulator replies (DSR/DA) back to the

499

;; pty, then replenish the credit window by exactly what we consumed.

500

;; Chunks that arrive BEFORE the session handle exists (a provider that

@@ -474,6 +537,9 @@

537

;; user's clear way back is unchanged: any keystroke snaps to live

538

;; (terminal-send-key!), Shift-PageDown/End walk forward.

539

(define (feed-pinned! name t bytes)

+540

(when *prediction-enabled?*

+541

(update-entry! name output-serial:

+542

(+ 1 (dict-ref (term-entry name) output-serial: 0))))

543

(let ((off (dict-ref (term-entry name) offset: 0)))

544

(if (or (= off 0) (term-alt? t))

545

(term-feed! t bytes)

@@ -490,6 +556,13 @@

556

;; (dict-ref ev code: #f) would silently drop a SIGKILL'd process's exit.

557

(define exit-missing (list 'no-exit)) ; a unique sentinel

558

(define (on-session-event name ev)

+559

;; Preserve lifecycle invalidation until a frame consumes it. A lost

+560

;; connection and successful reattach can both arrive before the next

+561

;; paint; the final connected flag alone would hide that interruption.

+562

(when (and *prediction-enabled?*

+563

(not (dict-ref ev bytes: #f))

+564

(term-entry name))

+565

(update-entry! name prediction-reset?: #t))

566

(cond

567

;; data chunk. Bytes arriving ARE the reconnection: whatever the pane

568

;; was told earlier, a stream that is delivering is not disconnected, so

@@ -532,7 +605,19 @@

605

;; calls `slate-refresh`. This module cannot call it anyway -- (slate

606

;; main) imports this one.

607

((dict-ref ev reattached: #f)

−535

(terminal-mark-connected! name))

+608

(let ((e (term-entry name))

+609

(replayed (dict-ref ev replayed-bytes: #f)))

+610

;; A non-empty replay is the node's authoritative bounded terminal

+611

;; history, not new output. Clear the retained emulator before the

+612

;; provider emits that ordered frame, otherwise every reconnect

+613

;; appends the same history and makes old commands appear to run

+614

;; again. Zero deliberately preserves the retained screen because

+615

;; no replay frame follows; #f is a legacy/unknown node and cannot

+616

;; safely authorize a destructive reset.

+617

(when (and e (number? replayed) (> replayed 0))

+618

(term-reset! (dict-ref e term: #f))

+619

(update-entry! name offset: 0))

+620

(terminal-mark-connected! name)))

621

;; exit: mark + paint a closing line into the grid (visible history)

622

((not (eq? (dict-ref ev code: exit-missing) exit-missing))

623

(let ((e (term-entry name))

@@ -836,6 +921,7 @@

921

(shift? (dict-ref props shift-key: #f))

922

(t (dict-ref e term: #f)))

923

(cond

+924

((dict-ref e copy-active?: #f) #t)

925

;; Cmd/Meta chords belong to the BROWSER/OS (Cmd+C copy,

926

;; Cmd+V paste, Cmd+W…): never encode Meta as Ctrl here —

927

;; sending ^C on Cmd+C would kill the user's foreground job,

@@ -863,6 +949,7 @@

949

(when (> (dict-ref e offset: 0) 0) ; snap to live

950

(update-entry! name offset: 0)

951

(mark-view-all! name))

+952

(note-prediction-input! name bytes)

953

(session-write (dict-ref e handle: #{}) bytes)

954

#t))))))))))

955

@@ -880,7 +967,7 @@

967

968

(define (terminal-paste! name text)

969

(let ((e (term-entry name)))

−883

(when e

+970

(when (and e (not (dict-ref e copy-active?: #f)))

971

(let ((t (dict-ref e term: #f))

972

(h (dict-ref e handle: #{}))

973

(s (normalize-paste text)))

@@ -889,6 +976,17 @@

976

(session-write h s)))))

977

#t)

978

+979

;; Compose is a paste, never a key chord or an implicit command submission.

+980

;; Refuse a known disconnected/dead target so the host can retain its draft.

+981

(define (terminal-compose! name text)

+982

(and (string? text) (> (string-length text) 0)

+983

(terminal-live? name)

+984

(not (terminal-disconnected? name))

+985

(not (terminal-copy-active? name))

+986

(guard (e (#t #f))

+987

(update-entry! name prediction-reset?: #t)

+988

(terminal-paste! name text))))

+989

990

;; ---- mouse forwarding (pointer events -> pty) --------------------------------

991

;; The RECEIVE half lives in the emulator: DECSET ?1000/1002/1003/1006/1007

992

;; set term-mouse-flags (sigil-vt native core). This is the SEND half,

@@ -975,7 +1073,7 @@

1073

;; otherwise, so the caller keeps its local no-forward behaviour.

1074

(define (terminal-send-mouse! name kind button col row shift? alt? ctrl?)

1075

(let ((e (term-entry name)))

−978

(and e

+1076

(and e (not (dict-ref e copy-active?: #f))

1077

(let ((flags (term-mouse-flags (dict-ref e term: #f))))

1078

(and (> (bitwise-and flags mouse-track-mask) 0)

1079

;; motion is only reported under button-event (1002) /

@@ -1083,7 +1181,7 @@

1181

1182

(define (terminal-scroll-gesture! name lines notches col row shift? alt? ctrl?)

1183

(let ((e (term-entry name)))

−1086

(if (not e)

+1184

(if (or (not e) (dict-ref e copy-active?: #f))

1185

""

1186

(let* ((t (dict-ref e term: #f))

1187

(case- (scroll-gesture-case (term-alt? t) (term-mouse-flags t))))

@@ -1323,9 +1421,68 @@

1421

;; history row (ring index 0) is distance 1.

1422

(term-scrollback-runs t (- (- off i) 1) cursor-col))))

1423

+1424

;; A one-shot snapshot of the retained rows, oldest first. HTML uses the

+1425

;; same escaped renderer as live output. The host owns selection over these

+1426

;; immutable rows while incoming bytes continue feeding the live emulator.

+1427

(define (terminal-copy-snapshot name)

+1428

(let ((e (term-entry name)))

+1429

(if (not e)

+1430

""

+1431

(let* ((t (dict-ref e term: #f))

+1432

(history (if (term-alt? t) 0 (term-scrollback-count t)))

+1433

(rows (term-rows t))

+1434

(top (max 0 (- history (dict-ref e offset: 0))))

+1435

(text

+1436

(call-with-output-string

+1437

(lambda (port)

+1438

(display (term-cols t) port)

+1439

(display " " port)

+1440

(display rows port)

+1441

(display " " port)

+1442

(display top port)

+1443

(display " " port)

+1444

(display (if (= top history)

+1445

(+ history (term-cursor-row t)) top) port)

+1446

(display " " port)

+1447

(display (if (= top history) (term-cursor-col t) 0) port)

+1448

(let loop ((i 0))

+1449

(when (< i (+ history rows))

+1450

(newline port)

+1451

(write-string

+1452

(row-html

+1453

(if (< i history)

+1454

(term-scrollback-runs t (- history i 1) #f)

+1455

(term-row-runs t (- i history) #f)))

+1456

port)

+1457

(loop (+ i 1))))))))

+1458

(update-entry! name copy-active?: #t)

+1459

text))))

+1460

+1461

(define (terminal-copy-active? name)

+1462

(let ((e (term-entry name)))

+1463

(and e (dict-ref e copy-active?: #f))))

+1464

+1465

(define (terminal-copy-end! name)

+1466

(when (term-entry name)

+1467

(update-entry! name copy-active?: #f)

+1468

(update-entry! name offset: 0)

+1469

(mark-view-all! name))

+1470

#t)

+1471

1472

;; ---- the frame protocol (drained by the JS TERM kernel at rAF pace) -------------

+1473

;; Non-destructive damage probe for the browser input shim. A synchronous

+1474

;; provider (echo-pty) can feed the emulator during session-write, whereas a

+1475

;; remote provider cannot produce damage until a later socket event. Keeping

+1476

;; this beside terminal-take-frame lets the accessory-key contract distinguish

+1477

;; those cases without naming or special-casing either transport.

+1478

(define (terminal-frame-pending? name)

+1479

(let ((e (term-entry name)))

+1480

(and e (term-damaged? (dict-ref e term: #f)))))

+1481

1482

;; Returns "" when nothing changed. Otherwise:

1483

;; line 0: cols rows cursor-row cursor-col cursor-vis(0/1) offset exited(0/1)

+1484

;; prediction-safe(0/1) output-serial

+1485

;; optional p line: p\t<authoritative cursor-row text>

1486

;; line N: <viewport-row-index>\t<row inner-HTML>

1487

;; `full?` forces a complete repaint (kernel adoption / vdom wipe).

1488

(define (terminal-take-frame name full?)

@@ -1351,10 +1508,29 @@

1508

(cur-vis (and (term-cursor-visible? t)

1509

(= off 0)

1510

(not (dict-ref e exited?: #f))))

+1511

;; R4 predictive echo is an OVERLAY decision, but its safety

+1512

;; posture belongs beside the authoritative VT state. The

+1513

;; browser never infers these modes from rendered cells.

+1514

;; Tmux uses alternate screen, mouse tracking and application

+1515

;; cursors even at a shell prompt. Those modes do not imply

+1516

;; no echo: the predictor must learn exact row/cursor echoes

+1517

;; before previewing any text, just as on the main screen.

+1518

(prediction-safe

+1519

(and cur-vis

+1520

(not (dict-ref e disconnected?: #f))

+1521

(not (dict-ref e prediction-reset?: #f))

+1522

(< cur-col (- (term-cols t) 1))))

+1523

(serial (dict-ref e output-serial: 0))

+1524

(prediction-state (list prediction-safe serial))

+1525

(prediction-changed

+1526

(and *prediction-enabled?*

+1527

(not (equal? prediction-state

+1528

(dict-ref e last-prediction-state: #f)))))

1529

(last-cur (dict-ref e last-cursor: (list -1 -1 #f)))

1530

(cur-moved (not (equal? last-cur (list cur-row cur-col cur-vis))))

1531

(drows (dict-ref dmg rows: '())))

−1357

(if (and (not all?) (null? drows) (not cur-moved))

+1532

(if (and (not all?) (null? drows) (not cur-moved)

+1533

(not prediction-changed))

1534

""

1535

(let* ((dirty

1536

(if all?

@@ -1368,6 +1544,9 @@

1544

(cons (+ off cur-row) base))

1545

base)))))

1546

(update-entry! name last-cursor: (list cur-row cur-col cur-vis))

+1547

(update-entry! name last-prediction-state: prediction-state)

+1548

(when (dict-ref e prediction-reset?: #f)

+1549

(update-entry! name prediction-reset?: #f))

1550

(call-with-output-string

1551

(lambda (port)

1552

(write-string (number->string (term-cols t)) port)

@@ -1383,6 +1562,16 @@

1562

(write-string (number->string off) port)

1563

(write-string " " port)

1564

(write-string (if (dict-ref e exited?: #f) "1" "0") port)

+1565

(write-string " " port)

+1566

(write-string (if prediction-safe "1" "0") port)

+1567

(write-string " " port)

+1568

(write-string (number->string serial) port)

+1569

;; This is the authoritative row, not DOM text or a

+1570

;; guessed suffix. The browser rejects non-ASCII rows,

+1571

;; so byte, character and cell positions cannot diverge.

+1572

(when *prediction-enabled?*

+1573

(write-string "\np\t" port)

+1574

(write-string (term-row-text t cur-row) port))

1575

;; emit each dirty viewport row once, in-range only

1576

(let ((seen (make-vector rows #f)))

1577

(for-each

@@ -1508,11 +1697,11 @@

1697

commands: (lambda (v)

1698

(list (make-cand "Terminal: Toggle Char/Line Mode" "C-M-t" "terminal-toggle-mode")

1699

(make-cand "Terminal: Close" "" "terminal-close")

−1511

;; The ribbon's Reconnect affordance, reachable with no

+1700

;; The ribbon's New Session affordance, reachable with no

1701

;; pointer. The ribbon only appears on a bad link, which

1702

;; is exactly when a touch target may be the thing the

1703

;; user cannot manage.

−1515

(make-cand "Terminal: Reconnect (Fresh Session)" "" "terminal-reconnect")

+1704

(make-cand "Terminal: New Session" "" "terminal-reconnect")

1705

(make-cand "Terminal: Scroll to Live" "" "terminal-live")

1706

(make-cand "Tmux: Next Window" "M-}" "tmux-next-window")

1707

(make-cand "Tmux: Previous Window" "M-{" "tmux-prev-window")

@@ -1528,19 +1717,23 @@

1717

;; The accessory-bar Terminal category — the §3.3 payoff: every key here is a

1718

;; plain `key:` SPEC. A tap synthesizes the keydown and enters slate-handle-key,

1719

;; where the terminal's `default: "terminal:send-key"` catch-all routes it to

−1531

;; the pty — Esc/Tab/C-c/arrows/C-d/C-r "just work" with ZERO terminal-specific

−1532

;; bar code. Close is the one declarative command.

+1720

;; the pty. Esc, Tab and arrows live in the fixed key grid; this menu keeps

+1721

;; composition, common control chords and Close.

1722

actions: (list

1723

#{ id: 'terminal label: "Term" glyph: "⌁" tier: 'primary

1724

items: (list

−1536

#{ id: 'esc label: "Esc" key: "Escape" tier: 'primary }

−1537

#{ id: 'tab label: "Tab" key: "Tab" tier: 'primary }

+1725

#{ id: 'compose label: "Compose Input" host-action: "terminal-compose:open" tier: 'primary }

1726

#{ id: 'ctrl-c label: "C-c" key: "C-c" tier: 'primary }

−1539

#{ id: 'up label: "↑" key: "ArrowUp" tier: 'secondary repeat: #t }

−1540

#{ id: 'down label: "↓" key: "ArrowDown" tier: 'secondary repeat: #t }

1727

#{ id: 'ctrl-d label: "C-d" key: "C-d" tier: 'secondary }

1728

#{ id: 'ctrl-r label: "C-r" key: "C-r" tier: 'tertiary }

−1543

#{ id: 'close label: "Close" command: "terminal-close" tier: 'tertiary }) }))

+1729

#{ id: 'close label: "Close" command: "terminal-close" tier: 'tertiary }) }

+1730

#{ id: 'terminal-copy label: "Copy" glyph: "▣" tier: 'secondary

+1731

items: (list

+1732

#{ id: 'start label: "Enter copy mode" host-action: "terminal-copy:start" tier: 'primary }

+1733

#{ id: 'mark label: "Mark" host-action: "terminal-copy:mark" tier: 'primary }

+1734

#{ id: 'copy label: "Copy selection" host-action: "terminal-copy:copy" tier: 'primary }

+1735

#{ id: 'cancel label: "Cancel" host-action: "terminal-copy:cancel" tier: 'secondary }

+1736

                           #{ id: 'received label: "Copy received text" host-action: "terminal-copy:received" tier: 'secondary }) }))

1737

(define (term-mode-badge v leaf)

1738

(if (terminal? v)

1739

(let ((char? (terminal-char-mode? (view-name v))))

@@ -1551,6 +1744,11 @@

1744

(title ,(if char?

1745

"CHAR mode — keys go to the app · click or C-M-t → LINE"

1746

"LINE mode — Slate keybindings active · click or C-M-t → CHAR")))

−1554

,(if char? "CHAR" "LINE"))))

+1747

,(if char? "CHAR" "LINE"))

+1748

`(span (@ (class "terminal-copy-label") (hidden "hidden")))

+1749

;; Empty browser-owned controls keep desktop copying available

+1750

;; inline in the existing header, without a dedicated row.

+1751

`(span (@ (class "terminal-copy-header-tools")

+1752

(key "terminal-copy-header-tools")))))

1753

'()))

1754

))

packages/slate/src/slate/modes/welcome.sglmodified

@@ -173,7 +173,7 @@

173

(string-append "openroot:" (root-name-string name)))))

174

175

(define (navigable-roots)

−176

(filter (lambda (n) (not (eq? n slate:))) (root-names)))

+176

(filter (lambda (n) (not (eq? n slate:))) (root-visible-names)))

177

178

;; "Connect this computer" — the primary node-pairing affordance

179

;; ([[topics/slate-distribution-architecture]] §1.1). Shown only until the

@@ -183,7 +183,9 @@

183

;; event round-trip through wasm would lose the user-gesture context the

184

;; popup requires). No-op in a build with no node bridge (plain browser).

185

(define (node-connect-card)

−186

(if (root-registered? local:)

+186

(if (any (lambda (name)

+187

(dict-ref (root-ref name) local?: #f))

+188

(root-names))

189

'()

190

(list `(div (@ (class "welcome-connect"))

191

(button (@ (class "node-pair-btn") (type "button"))

packages/slate/src/slate/prompt.sglmodified

@@ -90,20 +90,21 @@

90

prompt-type prompt-label prompt-candidates prompt-normalize

91

prompt-validate prompt-empty-action prompt-on-accept

92

prompt-confirm? prompt-completes? prompt-rank prompt-completes-query?

−93

prompt-preview prompt-on-cancel prompt-history

+93

prompt-preview prompt-on-cancel prompt-history prompt-candidate-policy

94

prompt-accept confirm-reminder open-prompt close-prompt)

95

(begin

96

97

;; Prompt activation lifecycle belongs to the prompt domain. State remains

98

;; an opaque value: these helpers only maintain the prompt-owned fields.

99

(define (open-prompt state prompt stack)

−100

(dict-set (dict-set

−101

(dict-set (dict-set (dict-set (dict-set state slate/minibuffer: prompt)

−102

slate/prompt-stack: stack)

−103

slate/selector-query: "")

−104

slate/selector-index: 0)

−105

slate/history-pos: #f)

−106

slate/history-stash: ""))

+100

(let* ((s1 (dict-set state slate/minibuffer: prompt))

+101

(s2 (dict-set s1 slate/prompt-session:

+102

(+ 1 (dict-ref state slate/prompt-session: 0))))

+103

(s3 (dict-set s2 slate/prompt-stack: stack))

+104

(s4 (dict-set s3 slate/selector-query: ""))

+105

(s5 (dict-set s4 slate/selector-index: 0))

+106

(s6 (dict-set s5 slate/history-pos: #f)))

+107

(dict-set s6 slate/history-stash: "")))

108

109

(define (close-prompt state)

110

(dict-set (dict-set (dict-set (dict-set state slate/minibuffer: #f)

@@ -127,6 +128,7 @@

128

normalize: query-verbatim

129

validate: always-valid

130

empty-action: #f

+131

candidate-policy: live:

132

rank: #f

133

preview: #f

134

on-cancel: #f

@@ -140,9 +142,11 @@

142

;; wants free text supplies an `empty-action:`; that is exactly what find-file

143

;; and the web-url prompt are.

144

(define (completing-read-prompt label candidates on-accept)

−143

(dict-set (dict-set (base-prompt 'completing-read label)

−144

candidates: candidates)

−145

on-accept: on-accept))

+145

(dict-set

+146

(dict-set (dict-set (base-prompt 'completing-read label)

+147

candidates: candidates)

+148

candidate-policy: snapshot:)

+149

on-accept: on-accept))

150

151

;; read-file-name: completing-read over a directory listing, plus the two things

152

;; only a path prompt needs.

@@ -160,9 +164,11 @@

164

;; Built ON completing-read (it IS one, with a path table), so it must restate

165

;; its own `type:` — the base it extends carries 'completing-read.

166

(define (file-prompt label candidates on-accept normalize empty-action)

−163

(dict-set (dict-set (dict-set (completing-read-prompt label candidates on-accept)

−164

type: 'file)

−165

normalize: normalize)

+167

(dict-set (dict-set (dict-set

+168

(dict-set (completing-read-prompt label candidates on-accept)

+169

type: 'file)

+170

normalize: normalize)

+171

candidate-policy: directory:)

172

empty-action: empty-action))

173

174

;; read-string: free text, no candidate list, and the QUERY itself is the result

@@ -223,6 +229,8 @@

229

;; ranker. Search's is the identity: its `candidates:` closure has already matched

230

;; against the query and returned rows in buffer order.

231

(define (prompt-rank p) (dict-ref p rank: #f))

+232

(define (prompt-candidate-policy p)

+233

(dict-ref p candidate-policy: live:))

234

235

;; Does Tab COMPLETE THE QUERY toward the selected row's label?

236

;;

packages/slate/src/slate/prompt/candidates.sglmodified

@@ -78,6 +78,8 @@

78

(list (cand "View: Switch" "C-x b" "prompt:view")

79

(cand "Root: Switch…" "C-x r" "prompt:root")

80

(cand "Slate: Welcome" "the home base · slate:/welcome" "welcome")

+81

(cand "Slate: Node Status" "local lifecycle and listener facts" "node-status")

+82

(cand "Slate: Keep Screen Awake" "toggle the client wake lock" "slate-keep-screen-awake")

83

(cand "Notifications: Open" "the notification inbox · slate:/notifications" "show-notifications")

84

(cand "Scratchpad: Open" "slate:/scratchpad" "scratchpad")

85

(cand "Folder: Open" "C-x d" "open-folder")

@@ -227,7 +229,7 @@

229

(root-annotation n)

230

(string-append "openroot:" (root-name-string n))

231

(or (and r (dict-ref r glyph: #f)) "▸"))))

−230

(root-names)))

+232

(root-visible-names)))

233

234

;; Theme switcher candidates: the whole catalog, filterable by name; the glyph

235

;; marks the scheme (● dark / ○ light) and the active theme reads "current".

packages/slate/src/slate/provider.sglmodified

@@ -44,10 +44,11 @@

44

source-materialize source-persist source-subscribe

45

source-stat

46

source-copy source-rename source-mkdir source-trash source-restore source-delete

+47

source-git-request

48

;; Session plane: opening + the live-session handle ops

49

source-session-open

50

session-write session-resize session-signal session-detach session-attach session-close

−50

session-credit session-open? session-live? session-window session-retire

+51

session-credit session-open? session-live? session-remote-id session-window session-retire

52

;; default initial credit window (bytes)

53

*default-window*)

54

(begin

@@ -170,6 +171,10 @@

171

((provider-op source restore:) source on-ready on-error))

172

(define (source-delete source on-ready on-error)

173

((provider-op source delete:) source on-ready on-error))

+174

;; Provider-neutral Git request. The selected source/root owns naming and

+175

;; destination; providers lower the verb onto their correlated node lane.

+176

(define (source-git-request source verb args on-ready on-error)

+177

((provider-op source git-request:) source verb args on-ready on-error))

178

179

;; ---- Session plane: registry + credit flow control -----------------------

180

;; Sessions are STATEFUL, so unlike the coarse ops they get a registry. Each

@@ -341,13 +346,17 @@

346

;; succeeded, and if that ever happens it is a defect to surface rather than

347

;; a state to quietly repair.

348

(define (make-reattached sid)

−344

(lambda (replayed-bytes at-ms)

+349

(lambda (replayed-bytes at-ms . maybe-transport)

350

(let ((s (session-unclosed sid)))

351

(when s

352

(let ((on-event (dict-ref s on-event: #f)))

353

(when on-event

−349

(on-event #{ session: sid reattached: #t

−350

replayed-bytes: replayed-bytes at-ms: at-ms })))))))

+354

(let ((event #{ session: sid reattached: #t

+355

replayed-bytes: replayed-bytes at-ms: at-ms }))

+356

(on-event

+357

(if (pair? maybe-transport)

+358

(dict-set event transport: (car maybe-transport))

+359

event)))))))))

360

361

;; Open a session on a stream-source. `on-event` receives data / exit / err

362

;; event dicts (§2.2). `opts` may carry `window:` (initial credit) — default

@@ -397,6 +406,9 @@

406

(if (and s (not (dict-ref s closed?: #f)))

407

(dict-ref s obj: #{})

408

#{})))

+409

(define (session-remote-id handle)

+410

(let ((op (session-op handle remote-id:))) (and op (op))))

+411

412

(define (session-op handle key) (dict-ref (session-obj handle) key #f))

413

414

(define (session-write handle bytes)

packages/slate/src/slate/providers/enclave-node.sglmodified

@@ -1,23 +1,35 @@

1

;;; (slate providers enclave-node) — remote node resource provider over Enclave.

2

3

(define-library (slate providers enclave-node)

−4

(import (sigil core)

−5

(sigil math)

+4

(import (sigil math)

5

(sigil io)

6

(sigil json)

7

(sigil string)

8

(sigil async)

9

(sigil wire)

10

(sigil websocket)

+11

(sigil browser local-storage)

12

(sigil irc message)

+13

(sigil log)

14

(slate base64)

15

(slate provider)

+16

(slate resource transfer)

17

(slate root)

+18

(slate agent remote)

+19

(slate providers node)

+20

(slate providers enclave-node carrier)

+21

(slate providers enclave-node resource)

22

(slate enclave-account session))

23

(export enclave-node-register! enclave-node-on-message! enclave-node-poll!

−18

enclave-node-on-persist-error! enclave-node-reset!

+24

enclave-node-set-local-identity!

+25

enclave-node-register-local-root!

+26

enclave-node-register-pairings!

+27

enclave-node-on-persist-error! enclave-node-on-transfer-progress!

+28

enclave-node-transfer-count

+29

enclave-node-reset!

30

;; R3a: callback deadlines, and failing in-flight work on a lost link

31

enclave-node-tick! enclave-node-fail-inflight!

+32

enclave-node-account-lost!

33

enclave-node-rpc-timeout-ms enclave-node-pending-count

34

;; Pure, and exported on the same grounds as open-reply-binding above:

35

;; a unit with its own contract, not a transport seam opened for a

@@ -54,6 +66,8 @@

66

;; cannot distinguish "never came due" from "issued, reply lost".

67

enclave-node-reattach-debug

68

enclave-node-stream-count

+69

enclave-node-carrier-transport

+70

enclave-node-performance-trace! enclave-node-performance-trace-poll

71

;; TWO nouns, deliberately — see the block above `*handles*`.

72

enclave-node-held-sids enclave-node-stream-sids

73

;; Pure, exported on the same grounds: the LOWERING of a source's

@@ -67,7 +81,10 @@

81

;; the leg that makes the capability set worth having: a client with

82

;; several discovered nodes cannot probe each one for a fact the node

83

;; already knows.

−70

enclave-node-sys-info! enclave-node-stream-ticket!

+84

enclave-node-sys-info!

+85

discovery-pending-after-registration

+86

registry-cache->json registry-cache<-json

+87

enclave-node-stream-ticket!

88

;; The pump's LOSS path, exported on exactly the grounds

89

;; `remote-session-open` is: "the tick calls these; tests call

90

;; directly". This is where a dead stream ARMS the re-attach ladder,

@@ -134,18 +151,269 @@

151

;; module isolation — provider-test.sgl already poisons whatever runs

152

;; after it by exactly that mechanism. A test for a refusal should not

153

;; be able to redden an unrelated file.

−137

remote-session-open)

+154

remote-session-open enclave-node-list-sessions!)

155

(begin

156

(define *next-id* 0)

157

(define *callbacks* #{})

+158

(define *resource-transfers* (make-resource-transfer-registry))

+159

(define *on-transfer-progress* #f)

+160

(define *subscriptions* #{})

+161

(define *carriers* (make-carrier-registry))

162

(define *streams* '())

+163

(define *performance-trace?* #f)

+164

(define *performance-trace-seq* 0)

+165

(define *performance-trace-results* '())

166

(define *discovered-roots* '())

167

(define *discovery-roots* '())

+168

;; Roots learned from the authenticated local node's durable pairing

+169

;; ledger survive an unavailable account catalog. Keep the set separate:

+170

;; ENCLAVE-NODES snapshots are authoritative for account membership, but

+171

;; cannot be authoritative for a machine-local relationship they cannot

+172

;; observe while the hub is down.

+173

(define *paired-roots* '())

+174

(define *pairing-generation* 0)

175

(define *on-discovery* (lambda () #f))

+176

(define *discovery-pending* 0)

+177

(define *discovery-ended?* #f)

+178

(define *discovery-generation* 0)

179

(define *on-persist-error* #f)

+180

(define *local-node-identity* #f)

+181

+182

;; Machine-local, best-effort discovery snapshot. This is deliberately not

+183

;; the Slate store directory: the catalog is needed before any named node is

+184

;; reachable and is scoped to this browser installation, like account and

+185

;; loopback credentials. It contains no tickets, pairing keys or endpoints.

+186

(define registry-cache-key "slate.node/catalog-v1")

+187

+188

(define (cache-entry-valid? entry)

+189

(and (dict? entry)

+190

(string? (dict-ref entry label: #f))

+191

(> (string-length (dict-ref entry label: "")) 0)

+192

(string? (dict-ref entry nick: #f))

+193

(> (string-length (dict-ref entry nick: "")) 0)))

+194

+195

(define (registry-cache->json entries)

+196

(json-encode #{ version: 1 entries: entries }))

+197

+198

(define (registry-cache<-json text)

+199

(guard (e (#t '()))

+200

(let* ((doc (and (string? text) (> (string-length text) 0)

+201

(json-decode text)))

+202

(raw (and (dict? doc) (= (dict-ref doc version: 0) 1)

+203

(dict-ref doc entries: '()))))

+204

(filter cache-entry-valid?

+205

(cond ((array? raw) (array->list raw))

+206

((list? raw) raw)

+207

(else '()))))))

+208

+209

(define (registry-cache-load)

+210

(registry-cache<-json

+211

(guard (e (#t #f)) (local-storage-get registry-cache-key))))

+212

+213

(define (registry-cache-save!)

+214

(let ((entries

+215

(filter-map

+216

(lambda (name)

+217

(let ((root (root-ref name)))

+218

(and root

+219

(eq? (dict-ref root class: #f) machine:)

+220

(string? (dict-ref root host: #f))

+221

#{ label: (dict-ref root label: (root-name-string name))

+222

nick: (dict-ref root host: "")

+223

home: (dict-ref root home: "")

+224

online: (eq? (dict-ref root status: #f) online:) })))

+225

(append *discovery-roots* *paired-roots*))))

+226

(guard (e (#t #f))

+227

(local-storage-set! registry-cache-key (registry-cache->json entries)))))

+228

+229

(define (register-cached-roots!)

+230

(for-each

+231

(lambda (entry)

+232

(let* ((label (dict-ref entry label: ""))

+233

(nick (dict-ref entry nick: ""))

+234

(home (dict-ref entry home: ""))

+235

(name (string->keyword label)))

+236

(unless (root-registered? name)

+237

(register-root! name

+238

(let ((root

+239

#{ provider: (if (local-node-identity? nick) local: node:)

+240

host: nick label: label glyph: "⌂" class: machine:

+241

local?: (local-node-identity? nick) status: unknown:

+242

planes: (list resource: session:) }))

+243

(if (and (string? home) (> (string-length home) 0))

+244

(dict-set root home: home)

+245

root))))

+246

(unless (member name *discovered-roots*)

+247

(set! *discovered-roots* (cons name *discovered-roots*)))))

+248

(registry-cache-load)))

249

250

(define *now-ms* 0)

251

+252

(define (local-node-identity? nick)

+253

(and (string? *local-node-identity*) (string? nick)

+254

(not (string=? *local-node-identity* ""))

+255

(string=? *local-node-identity* nick)))

+256

+257

;;; Locality is attested by the authenticated loopback node, not by the

+258

;;; account catalog. Once that node has published its canonical machine

+259

;;; root, a later discovery snapshot may refresh its presence and label but

+260

;;; must not replace its provider/host/home with catalog data. Requiring

+261

;;; both the remembered opaque identity and the existing local root keeps a

+262

;;; mere display-label collision from claiming locality.

+263

(define (canonical-local-root? name)

+264

(let ((root (root-ref name)))

+265

(and root

+266

(eq? (dict-ref root class: #f) machine:)

+267

(eq? (dict-ref root provider: #f) local:)

+268

(dict-ref root local?: #f)

+269

(local-node-identity? (dict-ref root host: #f)))))

+270

+271

;;; Identity, not display label, decides locality. Reclassify an already

+272

;;; discovered root too because the account and loopback sockets race at

+273

;;; startup and either answer may arrive first.

+274

(define (enclave-node-set-local-identity! identity)

+275

(when (and (string? identity) (not (string=? identity "")))

+276

(set! *local-node-identity* identity)

+277

(for-each

+278

(lambda (name)

+279

(let ((root (root-ref name)))

+280

(when (and root

+281

(local-node-identity? (dict-ref root host: #f)))

+282

(register-root! name

+283

(dict-set (dict-set (dict-set root provider: local:)

+284

local?: #t)

+285

glyph: "⌂"))

+286

(when (root-registered? local:)

+287

(root-set! local: hidden?: #t)))))

+288

(root-names)))

+289

#t)

+290

+291

;;; Publish the enrolled local machine without waiting for account-plane

+292

;;; discovery. The loopback node supplies all three facts: opaque identity,

+293

;;; owner-facing registered label, and the already grant-checked home.

+294

;;; Later ENCLAVE-NODES discovery refreshes this same name in place.

+295

(define (enclave-node-register-local-root! identity label home)

+296

(and (string? identity) (not (string=? identity ""))

+297

(string? label) (not (string=? label ""))

+298

(string? home) (not (string=? home ""))

+299

(let ((name (string->keyword label)))

+300

(enclave-node-set-local-identity! identity)

+301

(register-root! name

+302

#{ provider: local: host: identity label: label glyph: "⌂"

+303

class: machine: local?: #t status: online: home: home

+304

planes: (list resource: session:) })

+305

(when (and (not (eq? name local:)) (root-registered? local:))

+306

(root-set! local: hidden?: #t))

+307

name)))

+308

+309

(define (sequence->list value)

+310

(cond ((list? value) value)

+311

((array? value) (array->list value))

+312

(else '())))

+313

+314

(define (first-map proc items)

+315

(and (pair? items)

+316

(or (proc (car items))

+317

(first-map proc (cdr items)))))

+318

+319

;; Prefer an already registered or cached owner-facing label. A pairing

+320

;; record intentionally contains only transport identity, never account

+321

;; profile metadata, so the opaque nick is the honest cold-start fallback.

+322

;; In particular, never manufacture the misleading label "unknown".

+323

(define (paired-root-label nick)

+324

(or (first-map

+325

(lambda (name)

+326

(let ((root (root-ref name)))

+327

(and root (equal? (dict-ref root host: #f) nick)

+328

(dict-ref root label: #f))))

+329

(root-names))

+330

(first-map

+331

(lambda (entry)

+332

(and (equal? (dict-ref entry nick: #f) nick)

+333

(dict-ref entry label: #f)))

+334

(registry-cache-load))

+335

nick))

+336

+337

(define (paired-root-home nick)

+338

(or (first-map

+339

(lambda (name)

+340

(let ((root (root-ref name)))

+341

(and root (equal? (dict-ref root host: #f) nick)

+342

(dict-ref root home: #f))))

+343

(root-names))

+344

(first-map

+345

(lambda (entry)

+346

(and (equal? (dict-ref entry nick: #f) nick)

+347

(let ((home (dict-ref entry home: #f)))

+348

(and (string? home) (> (string-length home) 0) home))))

+349

(registry-cache-load))))

+350

+351

;; Publish durable peers from local sys/info without waiting for Enclave.

+352

;; Each actionable record is immediately retained in the root catalog and

+353

;; then verified by fs/home through request!'s ordinary selector. With the

+354

;; account lane down that selector can only succeed via paired-direct.

+355

(define (enclave-node-register-pairings! pairings)

+356

(set! *pairing-generation* (+ *pairing-generation* 1))

+357

(let* ((generation *pairing-generation*)

+358

(records (filter

+359

(lambda (pairing)

+360

(let ((nick (and (dict? pairing)

+361

(dict-ref pairing transport-nick: #f))))

+362

(and (string? nick) (> (string-length nick) 0)

+363

(not (dict-ref pairing revoked: #t))

+364

(dict-ref pairing offline-ready?: #f)

+365

(not (local-node-identity? nick)))))

+366

(sequence->list pairings)))

+367

(names (map (lambda (pairing)

+368

(string->keyword

+369

(paired-root-label

+370

(dict-ref pairing transport-nick: ""))))

+371

records)))

+372

(for-each

+373

(lambda (name)

+374

(unless (or (member name names) (member name *discovery-roots*))

+375

(unregister-root! name)

+376

(set! *discovered-roots*

+377

(filter (lambda (found) (not (eq? found name)))

+378

*discovered-roots*))))

+379

*paired-roots*)

+380

(set! *paired-roots* names)

+381

(for-each

+382

(lambda (pairing)

+383

(let ((nick (and (dict? pairing)

+384

(dict-ref pairing transport-nick: #f))))

+385

(when (and (string? nick) (> (string-length nick) 0)

+386

(not (dict-ref pairing revoked: #t))

+387

(dict-ref pairing offline-ready?: #f)

+388

(not (local-node-identity? nick)))

+389

(let* ((label (paired-root-label nick))

+390

(name (string->keyword label))

+391

(home (paired-root-home nick)))

+392

(register-root! name

+393

(let ((root

+394

#{ provider: node: host: nick label: label glyph: "⌂"

+395

class: machine: local?: #f status: unknown:

+396

planes: (list resource: session:) }))

+397

(if home (dict-set root home: home) root)))

+398

(unless (member name *discovered-roots*)

+399

(set! *discovered-roots* (cons name *discovered-roots*)))

+400

(request! nick "fs/home" #{}

+401

(lambda (result)

+402

(when (= generation *pairing-generation*)

+403

(let ((path (and (dict? result)

+404

(dict-ref result path: #f))))

+405

(root-set! name status: online:)

+406

(when (and (string? path) (> (string-length path) 0))

+407

(root-set! name home: path))

+408

(registry-cache-save!)

+409

(*on-discovery*))))

+410

(lambda (_error)

+411

(when (= generation *pairing-generation*)

+412

(root-set! name status: offline:)

+413

(*on-discovery*))))))))

+414

records))

+415

#t)

+416

417

;; How long an unanswered request may sit before its caller is told.

418

;;

419

;; Generous, because bulk reads ride this path and a large file over a slow

@@ -175,6 +443,32 @@

443

;; thing that can see it.

444

(define (enclave-node-pending-count) (length (dict-keys *callbacks*)))

445

+446

;; Secret-free routing status for diagnostics and live gates. The carrier

+447

;; registry deliberately retains only the selected transport and stable

+448

;; fallback class; endpoint advertisements and rendezvous material never

+449

;; reach this surface.

+450

(define (enclave-node-carrier-transport host)

+451

(let ((entry (and (string? host)

+452

(carrier-find-target *carriers* host))))

+453

(and entry (eq? (dict-ref entry state: #f) 'ready)

+454

(dict-ref entry transport: #f))))

+455

+456

;; A root's owner-facing keyword and its opaque transport identity are not

+457

;; interchangeable. Discovery stores the latter in host:, so carrier

+458

;; liveness must join on that field (never `(string->keyword host)`).

+459

(define (roots-for-host host)

+460

(filter

+461

(lambda (name)

+462

(let ((root (root-ref name)))

+463

(and root (equal? (dict-ref root host: #f) host))))

+464

(root-names)))

+465

+466

(define (direct-carrier-ready? host)

+467

(eq? (enclave-node-carrier-transport host) 'direct))

+468

+469

(define (mark-direct-host-online! host)

+470

(for-each root-mark-online! (roots-for-host host)))

+471

472

;; Hand every in-flight request its error and clear the table.

473

;;

474

;; THE LEAK THIS CLOSES IS THE ONE THAT MATTERED. Nothing walked this table

@@ -190,18 +484,61 @@

484

(define (enclave-node-fail-inflight! reason)

485

(let ((pending *callbacks*))

486

(set! *callbacks* #{})

+487

(for-each

+488

(lambda (id)

+489

(resource-transfer-cancel! *resource-transfers* id reason))

+490

(dict-keys pending))

491

(for-each

492

(lambda (id)

493

(let* ((cb (dict-ref pending id #f))

494

(err (and cb (dict-ref cb err: #f)))

495

(host (and cb (dict-ref cb host: ""))))

−198

(when err

+496

(when (and err (not (dict-ref cb transfer-direction: #f)))

497

(err (if (and (string? host) (> (string-length host) 0))

498

(string-append "connection lost to " host)

499

reason)))))

500

(dict-keys pending)))

501

"")

502

+503

;; Account loss is narrower than provider loss now that a companion can

+504

;; hold hub-independent direct carriers. Preserve callbacks already bound

+505

;; to those carriers and preserve the online state of roots whose direct

+506

;; socket is still ready. Relay/account work still fails immediately.

+507

(define (enclave-node-account-lost! reason now-ms)

+508

(let* ((pending *callbacks*)

+509

(lost-ids

+510

(filter

+511

(lambda (id)

+512

(let ((cb (dict-ref pending id #f)))

+513

(and cb (not (eq? (dict-ref cb backend: #f) 'carrier)))))

+514

(dict-keys pending))))

+515

(for-each retire! lost-ids)

+516

(for-each

+517

(lambda (id)

+518

(resource-transfer-cancel! *resource-transfers* id reason)

+519

(let* ((cb (dict-ref pending id #f))

+520

(err (and cb (dict-ref cb err: #f)))

+521

(host (and cb (dict-ref cb host: ""))))

+522

(when (and err (not (dict-ref cb transfer-direction: #f)))

+523

(err (if (and (string? host) (> (string-length host) 0))

+524

(string-append "connection lost to " host)

+525

reason)))))

+526

lost-ids))

+527

(for-each

+528

(lambda (name)

+529

(let* ((root (root-ref name))

+530

(host (and root (dict-ref root host: #f)))

+531

(entry (and (string? host)

+532

(carrier-find-target *carriers* host)))

+533

(direct-ready?

+534

(and entry (eq? (dict-ref entry state: #f) 'ready)

+535

(eq? (dict-ref entry transport: #f) 'direct))))

+536

(when (and root (eq? (dict-ref root provider: #f) node:)

+537

(not direct-ready?))

+538

(root-mark-unknown! name now-ms))))

+539

(root-names))

+540

"")

+541

542

;; THE SWEEP DECISION, as a pure function over the table.

543

;;

544

;; Extracted for the same reason open-reply-binding was, and not as a

@@ -254,9 +591,12 @@

591

(lambda (pair)

592

(let ((err (dict-ref (cdr pair) err: #f))

593

(host (dict-ref (cdr pair) host: "")))

−257

(when err

−258

(guard (e (#t #f))

−259

(err (string-append "no reply from " host))))))

+594

(if (dict-ref (cdr pair) transfer-direction: #f)

+595

(resource-transfer-cancel! *resource-transfers*

+596

(car pair) "transfer timed out")

+597

(when err

+598

(guard (e (#t #f))

+599

(err (string-append "no reply from " host)))))))

600

expired))

601

;; R3b — the re-attach ladder, driven by the same metronome that already

602

;; carries this provider's clock. It runs AFTER the sweep above, and the

@@ -275,12 +615,8 @@

615

(else plain))))

616

(base64-decode padded)))

617

−278

(define (request! host verb args on-ready on-error)

−279

(let* ((id (next-id!))

−280

(payload (json-encode #{ id: id args: args })))

−281

(set! *callbacks* (dict-set *callbacks* id

−282

#{ ok: on-ready err: on-error host: host

−283

at: (and (> *now-ms* 0) *now-ms*) }))

+618

(define (enclave-request! id host verb args on-ready on-error)

+619

(let ((payload (json-encode #{ id: id args: args })))

620

(if (account-session-send-command!

621

"ENCLAVE-RPC" host (number->string id) verb payload)

622

id

@@ -294,41 +630,410 @@

630

(define (enclave-node-stream-ticket! host ready error)

631

(let ((id (next-id!)))

632

(set! *callbacks* (dict-set *callbacks* id

−297

#{ ticket-ready: ready err: error host: host

+633

#{ agent-ticket-ready: ready err: error host: host

634

at: (and (> *now-ms* 0) *now-ms*) }))

635

(unless (account-session-send-command! "ENCLAVE-RPC" host

636

(number->string id) "stream/open" (json-encode #{ id: id args: #{} }))

637

(retire! id)

638

(error "Enclave account is not connected"))))

+639

(define (carrier-request-send! id host verb args on-ready on-error)

+640

(log-info* "remote carrier requested"

+641

mod: "enclave-node" host: host request-id: id verb: verb)

+642

(carrier-ensure! *carriers* host

+643

(lambda (open)

+644

(node-send-raw-text! open)

+645

#t)

+646

(lambda (entry)

+647

(let ((carrier (dict-ref entry carrier: #f))

+648

(cb (dict-ref *callbacks* id #f)))

+649

(when cb

+650

(set! *callbacks* (dict-set *callbacks* id

+651

(dict-set (dict-set cb carrier: carrier)

+652

phase: 'awaiting-control)))

+653

(let ((direction (dict-ref cb transfer-direction: #f))

+654

(send (lambda (bytes)

+655

(node-send-raw-binary!

+656

(carrier-frame-encode carrier bytes)))))

+657

(cond

+658

((eq? direction 'upload)

+659

(resource-transfer-upload! *resource-transfers* id carrier

+660

(dict-ref cb transfer-bytes: #f)

+661

(dict-ref entry transport: #f) send

+662

(lambda (result)

+663

(retire! id)

+664

(let ((ok (dict-ref cb ok: #f))) (when ok (ok result))))

+665

(lambda (reason)

+666

(retire! id)

+667

(let ((err (dict-ref cb err: #f))) (when err (err reason))))

+668

(lambda (progress)

+669

(when *on-transfer-progress*

Showing the first 500 of 1755 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate/src/slate/providers/enclave-node/carrier.sgladded

@@ -0,0 +1,234 @@

+1

;;; (slate providers enclave-node carrier) — browser side of the companion's

+2

;;; remote carrier multiplex. Pure state and framing; the loopback node provider

+3

;;; owns the actual WebSocket.

+4

+5

(define-library (slate providers enclave-node carrier)

+6

(import (sigil core) (sigil math))

+7

(export GATEWAY-FRAME make-carrier-registry carrier-open!

+8

carrier-ensure! carrier-disconnect-all!

+9

carrier-on-control! carrier-ref carrier-find-target carrier-remove!

+10

carrier-open-request carrier-close-request

+11

carrier-text-envelope carrier-frame-encode carrier-frame-decode)

+12

(begin

+13

(define GATEWAY-FRAME #x11)

+14

(define max-u32 4294967295)

+15

+16

(define (valid-id? value)

+17

(and (integer? value) (> value 0) (<= value max-u32)))

+18

+19

(define (write-u32-be! bytes offset value)

+20

(bytevector-u8-set! bytes offset

+21

(modulo (quotient value 16777216) 256))

+22

(bytevector-u8-set! bytes (+ offset 1)

+23

(modulo (quotient value 65536) 256))

+24

(bytevector-u8-set! bytes (+ offset 2)

+25

(modulo (quotient value 256) 256))

+26

(bytevector-u8-set! bytes (+ offset 3) (modulo value 256)))

+27

+28

(define (read-u32-be bytes offset)

+29

(+ (* (bytevector-u8-ref bytes offset) 16777216)

+30

(* (bytevector-u8-ref bytes (+ offset 1)) 65536)

+31

(* (bytevector-u8-ref bytes (+ offset 2)) 256)

+32

(bytevector-u8-ref bytes (+ offset 3))))

+33

+34

;; Entries remain keyed locally until remote/opened supplies the companion's

+35

;; carrier id. Callbacks are browser-local and never serialized.

+36

;; Carrier-open request ids share the loopback node socket with ordinary

+37

;; local requests. Keep them in the disjoint upper half of the u32 space.

+38

(define (make-carrier-registry) (vector 2147483647 '()))

+39

(define (entries registry) (vector-ref registry 1))

+40

+41

(define (carrier-ref registry carrier)

+42

(let loop ((rest (entries registry)))

+43

(and (pair? rest)

+44

(let ((entry (car rest)))

+45

(if (equal? carrier (dict-ref entry carrier: #f))

+46

entry

+47

(loop (cdr rest)))))))

+48

+49

(define (carrier-find-target registry target)

+50

(let loop ((rest (entries registry)))

+51

(and (pair? rest)

+52

(let ((entry (car rest)))

+53

(if (equal? target (dict-ref entry target: #f))

+54

entry

+55

(loop (cdr rest)))))))

+56

+57

(define (replace! registry local-id replacement)

+58

(vector-set! registry 1

+59

(map (lambda (entry)

+60

(if (= local-id (dict-ref entry local-id: 0))

+61

replacement entry))

+62

(entries registry)))

+63

replacement)

+64

+65

(define (opening-ref registry request)

+66

(and (number? request)

+67

(let loop ((rest (entries registry)))

+68

(and (pair? rest)

+69

(let ((entry (car rest)))

+70

(if (and (eq? (dict-ref entry state: #f) 'opening)

+71

(= request (dict-ref entry local-id: 0)))

+72

entry

+73

(loop (cdr rest))))))))

+74

+75

(define (remove-entry! registry entry)

+76

(vector-set! registry 1

+77

(filter (lambda (item) (not (eq? item entry))) (entries registry)))

+78

entry)

+79

+80

(define (carrier-open! registry target on-ready on-error)

+81

(vector-set! registry 0

+82

(+ 2147483648 (modulo (+ (vector-ref registry 0) 1) 2147483648)))

+83

(let ((entry #{ local-id: (vector-ref registry 0) target: target

+84

carrier: #f state: 'opening transport: #f

+85

fallback-reason: #f ready: on-ready error: on-error }))

+86

(vector-set! registry 1 (cons entry (entries registry)))

+87

entry))

+88

+89

;;; Reuse one carrier per target. Opening callers join the entry's waiter

+90

;;; list; ready callers settle synchronously. SEND receives the ordinary

+91

;;; authenticated node request envelope.

+92

(define (carrier-ensure! registry target send on-ready on-error . route)

+93

(let ((existing (carrier-find-target registry target)))

+94

(cond

+95

((and existing (eq? (dict-ref existing state: #f) 'ready))

+96

(when on-ready (on-ready existing))

+97

existing)

+98

((and existing (eq? (dict-ref existing state: #f) 'opening))

+99

(replace! registry (dict-ref existing local-id: 0)

+100

(dict-set existing waiters:

+101

(append (dict-ref existing waiters: '())

+102

(list #{ ready: on-ready error: on-error })))))

+103

(else

+104

(let* ((entry (carrier-open! registry target on-ready on-error))

+105

(with-waiters

+106

(replace! registry (dict-ref entry local-id: 0)

+107

(dict-set entry waiters:

+108

(list #{ ready: on-ready error: on-error })))))

+109

(if (send (carrier-open-request

+110

(dict-ref with-waiters local-id: 0) target

+111

(and (pair? route) (car route))))

+112

with-waiters

+113

(begin

+114

(vector-set! registry 1

+115

(filter (lambda (item) (not (eq? item with-waiters)))

+116

(entries registry)))

+117

(when on-error (on-error "local node is unavailable"))

+118

#f)))))))

+119

+120

(define (notify-waiters entry key value)

+121

(let ((waiters (dict-ref entry waiters: #f)))

+122

(if waiters

+123

(for-each

+124

(lambda (waiter)

+125

(let ((callback (dict-ref waiter key #f)))

+126

(when callback (callback value))))

+127

waiters)

+128

(let ((callback (dict-ref entry key #f)))

+129

(when callback (callback value))))))

+130

+131

(define (carrier-remove! registry carrier)

+132

(let ((entry (carrier-ref registry carrier)))

+133

(when entry

+134

(vector-set! registry 1

+135

(filter (lambda (item)

+136

(not (equal? carrier (dict-ref item carrier: #f))))

+137

(entries registry))))

+138

entry))

+139

+140

;;; Atomically invalidate the loopback connection's whole carrier set.

+141

;;; Clear first: waiter callbacks may immediately request replacement work,

+142

;;; and that new work belongs to the next connection generation.

+143

(define (carrier-disconnect-all! registry reason)

+144

(let ((lost (entries registry)))

+145

(vector-set! registry 1 '())

+146

(for-each

+147

(lambda (entry)

+148

(when (eq? (dict-ref entry state: #f) 'opening)

+149

(notify-waiters entry error: reason)))

+150

lost)

+151

lost))

+152

+153

(define (carrier-open-request request target . route)

+154

#{ t: "req" id: request verb: "remote/open"

+155

args: (let ((sid (and (pair? route) (car route))))

+156

(if (and (string? sid) (> (string-length sid) 0))

+157

#{ target: target sid: sid }

+158

#{ target: target })) })

+159

+160

(define (carrier-close-request carrier)

+161

#{ t: "remote/close" carrier: carrier })

+162

+163

(define (carrier-on-control! registry message)

+164

(and (dict? message) (equal? (dict-ref message t: #f) "ev")

+165

(let ((event (dict-ref message event: #f))

+166

(carrier (dict-ref message carrier: #f)))

+167

(cond

+168

((equal? event "remote/opened")

+169

(let ((opening

+170

(opening-ref registry (dict-ref message request: #f))))

+171

(and opening (valid-id? carrier)

+172

(let* ((transport-text (dict-ref message transport: #f))

+173

(transport

+174

(cond ((equal? transport-text "direct") 'direct)

+175

((equal? transport-text "relay") 'relay)

+176

(else #f))))

+177

(and transport

+178

(let ((ready

+179

(replace! registry

+180

(dict-ref opening local-id: 0)

+181

(dict-set

+182

(dict-set

+183

(dict-set opening carrier: carrier)

+184

state: 'ready)

+185

transport: transport))))

+186

(notify-waiters ready ready: ready)

+187

;; Opening waiters are one-shot. A later carrier

+188

;; loss belongs to active request/session state,

+189

;; not to the operation that originally opened it.

+190

(replace! registry

+191

(dict-ref ready local-id: 0)

+192

(if (dict-ref ready waiters: #f)

+193

(dict-set ready waiters: '())

+194

ready))))))))

+195

((or (equal? event "remote/failed")

+196

(equal? event "remote/closed"))

+197

;; A failed open has no usable carrier yet. Correlate it with

+198

;; the request ticket; established-carrier closure still uses

+199

;; the carrier id.

+200

(let ((entry (or (carrier-ref registry carrier)

+201

(and (equal? event "remote/failed")

+202

(opening-ref registry

+203

(dict-ref message request: #f))))))

+204

(and entry

+205

(begin

+206

(remove-entry! registry entry)

+207

(notify-waiters entry error:

+208

(if (equal? event "remote/closed")

+209

"remote transport closed"

+210

"remote transport unavailable"))

+211

entry))))

+212

(else #f)))))

+213

+214

(define (carrier-text-envelope carrier payload)

+215

#{ t: "remote/text" carrier: carrier payload: payload })

+216

+217

(define (carrier-frame-encode carrier payload)

+218

(unless (and (valid-id? carrier) (bytevector? payload))

+219

(error "invalid remote carrier frame"))

+220

(let* ((length (bytevector-length payload))

+221

(out (make-bytevector (+ length 5) 0)))

+222

(bytevector-u8-set! out 0 GATEWAY-FRAME)

+223

(write-u32-be! out 1 carrier)

+224

(bytevector-copy! out 5 payload 0 length)

+225

out))

+226

+227

(define (carrier-frame-decode bytes)

+228

(and (bytevector? bytes) (>= (bytevector-length bytes) 5)

+229

(= (bytevector-u8-ref bytes 0) GATEWAY-FRAME)

+230

(let ((carrier (read-u32-be bytes 1)))

+231

(and (valid-id? carrier)

+232

#{ carrier: carrier

+233

payload: (bytevector-copy bytes 5

+234

(bytevector-length bytes)) }))))))

packages/slate/src/slate/providers/enclave-node/resource.sgladded

@@ -0,0 +1,104 @@

+1

;;; Binary downloads for browsers without a local companion. Only the small

+2

;;; ticket request travels over account RPC; file bodies use /stream.

+3

(define-library (slate providers enclave-node resource)

+4

(import (sigil io)

+5

(sigil json)

+6

(sigil wire)

+7

(sigil websocket)

+8

(slate resource transfer))

+9

(export enclave-resource-download! enclave-resource-poll! enclave-resource-reset!

+10

enclave-resource-count)

+11

(begin

+12

(define *downloads* '())

+13

+14

(define (ref stream key fallback)

+15

(dict-ref (vector-ref stream 0) key fallback))

+16

(define (put! stream key value)

+17

(vector-set! stream 0 (dict-set (vector-ref stream 0) key value)))

+18

(define (enclave-resource-count) (length *downloads*))

+19

+20

(define (settle! stream success? result)

+21

(unless (ref stream done: #f)

+22

(put! stream done: #t)

+23

(guard (error (else #f)) (ws-close (ref stream socket: #f)))

+24

(resource-transfer-remove-owner! (ref stream transfers: #f) stream "download closed")

+25

(let ((callback (ref stream (if success? ready: error:) #f)))

+26

(when callback (callback result)))))

+27

+28

(define (enclave-resource-download! url ticket source ready error now)

+29

(let ((socket (and (string? ticket) (ws-connect url))))

+30

(if (not socket)

+31

(when error (error "image stream connection failed"))

+32

(let* ((registry (make-resource-transfer-registry))

+33

(stream (vector #{ socket: socket ticket: ticket source: source

+34

ready: ready error: error transfers: registry

+35

last-activity: now sent: #f done: #f })))

+36

(resource-transfer-download! registry 1 stream 'relay

+37

(lambda (bytes) (ws-send-binary socket bytes))

+38

(lambda (bytes) (settle! stream #t bytes))

+39

(lambda (reason) (settle! stream #f reason))

+40

#f)

+41

(set! *downloads* (cons stream *downloads*)))))

+42

#t)

+43

+44

(define (receive! stream bytes)

+45

(let ((frame (transfer-frame-decode bytes)))

+46

(when frame

+47

(let ((type (dict-ref frame type: 0))

+48

(payload (dict-ref frame payload: #f))

+49

(registry (ref stream transfers: #f)))

+50

(cond

+51

((= type 1)

+52

(let ((control (json-decode (utf8->string payload))))

+53

(when (= (dict-ref control id: -1) 1)

+54

(resource-transfer-control! registry control))))

+55

;; Older nodes may answer the same read with one bulk frame.

+56

;; It still stays binary and never enters the bounded RPC lane.

+57

((and (= type 16) (= (dict-ref frame id: -1) 1))

+58

(let ((value (wire-decode payload)))

+59

(if (bytevector? value)

+60

(settle! stream #t value)

+61

(settle! stream #f "image stream did not return bytes"))))

+62

((resource-transfer-frame? bytes)

+63

(resource-transfer-frame! registry bytes)))))))

+64

+65

(define (poll! stream now)

+66

(let ((socket (ref stream socket: #f)))

+67

(when (and (not (ref stream sent: #f)) (ws-connected? socket))

+68

(ws-send socket (ref stream ticket: ""))

+69

(put! stream ticket: #f)

+70

(put! stream sent: #t)

+71

(ws-send-binary socket

+72

(transfer-frame-encode 1 0

+73

(string->utf8

+74

(json-encode

+75

#{ t: "req" pv: 2 id: 1 verb: "fs/read-file"

+76

args: #{ path: (dict-ref (ref stream source: #{}) address: "")

+77

transfer: #t } })))))

+78

(let drain ((remaining 32))

+79

(when (and (> remaining 0) (not (ref stream done: #f)))

+80

(let ((message (ws-receive-nowait socket)))

+81

(cond

+82

((eq? message 'closed) (settle! stream #f "image stream disconnected"))

+83

((ws-message? message)

+84

(put! stream last-activity: now)

+85

(when (eq? (ws-message-type message) 'binary)

+86

(receive! stream (ws-message-data message)))

+87

(drain (- remaining 1)))))))

+88

(when (and (not (ref stream done: #f))

+89

(number? now) (number? (ref stream last-activity: #f))

+90

(> (- now (ref stream last-activity: now)) 30000))

+91

(settle! stream #f "image stream timed out"))))

+92

+93

(define (enclave-resource-poll! now)

+94

(for-each

+95

(lambda (stream)

+96

(guard (error (else (settle! stream #f "image stream failed")))

+97

(poll! stream now)))

+98

*downloads*)

+99

(set! *downloads* (filter (lambda (stream) (not (ref stream done: #f))) *downloads*)))

+100

+101

(define (enclave-resource-reset!)

+102

(let ((pending *downloads*))

+103

(set! *downloads* '())

+104

(for-each (lambda (stream) (settle! stream #f "image stream closed")) pending)))))

packages/slate/src/slate/providers/node.sglmodified

@@ -58,13 +58,15 @@

58

(sigil wire) ; wire-decode (bulk 0x10 payloads)

59

(sigil websocket) ; ws-connect / ws-send / ws-send-binary / ws-receive-nowait

60

(slate base64) ; base64-encode (image bytes → data: URL)

−61

(slate provider) (slate agent remote)) ; register-provider!

+61

(slate agent remote)

+62

(slate resource transfer)

+63

(slate provider)) ; register-provider!

64

(export node-register! node-available?

65

;; connect FSM + the JS-facing tick (wrapped in (slate main))

66

node-connect! node-connect-with! node-poll! node-disconnect!

67

node-phase node-ready? node-connected? node-grants node-instance

68

node-set-token! node-token node-request-pair node-request-retry

−67

node-pair-exchange! node-live-sessions node-fetch-home! node-on-sessions!

+69

node-pair-exchange! node-live-sessions node-list-sessions! node-fetch-home! node-on-sessions!

70

node-run! node-sys-info!

71

;; agent-session control plane (agent wire v1)

72

          node-agent-fleet! node-agent-settings! node-agent-open! node-agent-list! node-agent-attach! node-agent-child-close!

@@ -90,13 +92,18 @@

92

node-drained-output?

93

;; WS-bytevector binary lane (fs/read-file bytes → JS Blob URL)

94

node-image-via-blob! node-blob-poll node-blob-bytes node-blob-ready

−93

node-blob-waiting?

+95

node-blob-waiting? node-queue-image! node-blob-mime

96

;; inbound frame delivery (the tick calls these; tests call directly)

−95

node-deliver-text! node-deliver-binary!

+97

node-deliver-text! node-deliver-binary! node-deliver-disconnect!

+98

;; Authenticated loopback carrier extension. These preserve the local

+99

;; node protocol while handing only remote/* envelopes to its owner.

+100

node-send-raw-text! node-send-raw-binary!

+101

node-on-remote-control! node-on-remote-binary!

+102

node-on-remote-disconnect!

103

;; UI hooks — (slate main) wires these to refresh / surface pairing /

104

;; persist the durable token to origin storage

105

node-on-ready! node-on-pair-needed! node-on-close! node-on-persist-error!

−99

node-on-token!

+106

node-on-token! node-on-transfer-progress!

107

;; test / introspection surface

108

node-reset! node-set-transport! node-sent-text node-sent-binary

109

node-clear-sent! node-session-count node-pending-count

@@ -169,6 +176,9 @@

176

(define *drained-output* #f) ; did THIS poll deliver pty bytes? (repaint hint)

177

(define *next-id* 0) ; req-id allocator (Resource plane, 32-bit)

178

(define *req-cbs* #{}) ; req-id -> #{ ok: err: }

+179

(define *subscriptions* #{}) ; fs/watch req-id -> change callback

+180

(define *resource-transfers* (make-resource-transfer-registry))

+181

(define *on-transfer-progress* #f)

182

(define *bulk-waiters* #{}) ; req-id -> ok-callback awaiting its 0x10 frame

183

(define *sessions* #{}) ; daemon sid -> #{ emit: exit: err: carry: closed?: }

184

@@ -208,6 +218,10 @@

218

(define *on-pair-needed* #f)

219

(define *on-close* #f)

220

(define *on-token* #f) ; (tok-or-#f) -> persist to / clear origin storage

+221

(define *on-remote-control* #f)

+222

(define *on-remote-binary* #f)

+223

(define *on-remote-disconnect* #f)

+224

(define *transport-generation* 0)

225

226

(define (node-available?) *available*)

227

(define (node-phase) *phase*)

@@ -226,6 +240,10 @@

240

(define (node-on-pair-needed! f) (set! *on-pair-needed* f) "")

241

(define (node-on-close! f) (set! *on-close* f) "")

242

(define (node-on-token! f) (set! *on-token* f) "")

+243

(define (node-on-remote-control! f) (set! *on-remote-control* f) "")

+244

(define (node-on-remote-binary! f) (set! *on-remote-binary* f) "")

+245

(define (node-on-remote-disconnect! f)

+246

(set! *on-remote-disconnect* f) "")

247

248

;; ---- outbound helpers ----------------------------------------------------

249

(define (send-text! s)

@@ -234,10 +252,15 @@

252

(when *transport* ((dict-ref *transport* send-binary: (lambda (_) #f)) bv)))

253

254

(define (send-control! dict) (send-text! (json-encode dict)))

+255

(define (node-send-raw-text! value)

+256

(send-text! (if (string? value) value (json-encode value))))

+257

(define (node-send-raw-binary! bytes) (send-binary! bytes))

258

259

;; Allocate a Resource-plane request id (0 <= id < 2^32) and store callbacks.

260

(define (alloc-req! on-ok on-err)

−240

(set! *next-id* (modulo (+ *next-id* 1) 4294967296))

+261

;; The lower half is reserved for the local node protocol. Companion

+262

;; carrier-open requests use the upper half on this same socket.

+263

(set! *next-id* (modulo (+ *next-id* 1) 2147483648))

264

(let ((id *next-id*))

265

(set! *req-cbs* (dict-set *req-cbs* id #{ ok: on-ok err: on-err }))

266

id))

@@ -295,6 +318,28 @@

318

(send-control! #{ t: "req" id: id verb: verb args: args })

319

id))

320

+321

(define (request-transfer! verb args direction bytes on-ok on-err)

+322

(let* ((id (alloc-req! on-ok on-err))

+323

(owner *transport-generation*)

+324

(complete (lambda (value)

+325

(set! *req-cbs* (dict-set *req-cbs* id #f))

+326

(when on-ok (on-ok value))))

+327

(error (lambda (reason)

+328

(set! *req-cbs* (dict-set *req-cbs* id #f))

+329

(when on-err (on-err reason))))

+330

(progress (lambda (value)

+331

(when *on-transfer-progress*

+332

(*on-transfer-progress* value)))))

+333

(set! *req-cbs* (dict-set *req-cbs* id

+334

#{ ok: on-ok err: on-err transfer: #t }))

+335

(if (eq? direction 'upload)

+336

(resource-transfer-upload! *resource-transfers* id owner bytes

+337

'local send-binary! complete error progress)

+338

(resource-transfer-download! *resource-transfers* id owner

+339

'local send-binary! complete error progress))

+340

(send-control! #{ t: "req" id: id verb: verb args: args })

+341

id))

+342

343

;; ---- inbound: text control frames ----------------------------------------

344

(define (node-deliver-text! json-str)

345

(let ((msg (guard (e (#t #f)) (json-decode json-str))))

@@ -308,6 +353,13 @@

353

((equal? t "pair/err") (on-pair-err msg))

354

((equal? t "ok") (on-ok msg))

355

((equal? t "err") (on-err msg))

+356

((and (equal? t "ev")

+357

(let ((event (dict-ref msg event: "")))

+358

(and (string? event)

+359

(string-starts-with? event "remote/"))))

+360

(when *on-remote-control* (*on-remote-control* msg)))

+361

((equal? t "remote/text")

+362

(when *on-remote-control* (*on-remote-control* msg)))

363

((equal? t "ev") (on-ev msg))

364

((equal? t "pong") #t)

365

(else #t)))))

@@ -406,6 +458,10 @@

458

;; recreates a terminal view per live pty and reattaches it (scrollback).

459

(when *on-sessions* (*on-sessions* sessions))))

460

(define (node-live-sessions) *live-sessions*)

+461

(define (node-list-sessions! ok err)

+462

(if (node-ready?)

+463

(request! "session/list" #{} ok err)

+464

(err "local node is not connected")))

465

466

;; ---- inbound: ok / err / ev ----------------------------------------------

467

(define (on-ok msg)

@@ -413,6 +469,8 @@

469

(bulk? (dict-ref msg bulk: #f))

470

(cb (dict-ref *req-cbs* id #f)))

471

(cond

+472

((and cb (dict-ref cb transfer: #f))

+473

(resource-transfer-control! *resource-transfers* msg))

474

;; bulk: the result body is the next 0x10 frame for this id. Park the

475

;; ok-callback until that frame lands.

476

(bulk?

@@ -430,11 +488,14 @@

488

(let* ((id (dict-ref msg id: #f))

489

(cb (dict-ref *req-cbs* id #f)))

490

(when cb

+491

(if (dict-ref cb transfer: #f)

+492

(resource-transfer-control! *resource-transfers* msg)

+493

(begin

494

(set! *req-cbs* (dict-set *req-cbs* id #f))

495

(set! *bulk-waiters* (dict-set *bulk-waiters* id #f))

496

(let ((f (dict-ref cb err: #f)))

497

(when f (f #{ code: (dict-ref msg code: "error")

−437

message: (dict-ref msg message: "") }))))))

+498

message: (dict-ref msg message: "") }))))))))

499

500

(define (on-ev msg)

501

(when (equal? (dict-ref msg verb: #f) "agent/service-disconnected")

@@ -449,6 +510,8 @@

510

(dict-keys *req-cbs*)))

511

(let ((sub (dict-ref msg sub: #f)))

512

(cond

+513

((dict-ref *subscriptions* sub #f)

+514

((dict-ref *subscriptions* sub #f) (dict-ref msg event: #{})))

515

((equal? sub "session/exit")

516

;; CONTROL lane: this `ev` carries the durable STRING sid, so it

517

;; resolves rather than indexing. Named at the call site so the two

@@ -623,19 +686,31 @@

686

687

;; ---- inbound: binary frames ----------------------------------------------

688

(define (node-deliver-binary! bv)

−626

(let ((f (frame-decode bv)))

−627

(when f

−628

(let ((type (dict-ref f type: 0))

−629

(id (dict-ref f id: 0))

−630

(payload (dict-ref f payload: (make-bytevector 0 0))))

−631

(cond

−632

((= type FRAME-DATA-OUT) (on-data-out id payload))

−633

((= type FRAME-BULK) (on-bulk id payload))

−634

;; BINARY lane: `id` is the u32 chan out of the frame header, which

−635

;; is what `*sessions*` is keyed by, so this indexes directly.

−636

((= type FRAME-CLOSE) (deliver-exit-by-chan! id #f))

−637

((= type FRAME-ERROR) (on-frame-error id payload))

−638

(else #t)))))

+689

(cond

+690

((and (bytevector? bv) (> (bytevector-length bv) 0)

+691

(= (bytevector-u8-ref bv 0) #x11))

+692

;; A direct carrier is drained inside this node poll, but its nested

+693

;; stream frame is decoded by enclave-node. Carry its terminal-data

+694

;; result back into the same repaint latch used by native node PTYs.

+695

(when (and *on-remote-binary* (*on-remote-binary* bv))

+696

(set! *drained-output* #t)))

+697

(else

+698

(let ((f (frame-decode bv)))

+699

(when f

+700

(let ((type (dict-ref f type: 0))

+701

(id (dict-ref f id: 0))

+702

(payload (dict-ref f payload: (make-bytevector 0 0))))

+703

(cond

+704

((and (dict-ref *req-cbs* id #f)

+705

(dict-ref (dict-ref *req-cbs* id #{}) transfer: #f)

+706

(resource-transfer-frame? bv))

+707

(resource-transfer-frame! *resource-transfers* bv))

+708

((= type FRAME-DATA-OUT) (on-data-out id payload))

+709

((= type FRAME-BULK) (on-bulk id payload))

+710

;; The binary lane indexes sessions by its u32 channel.

+711

((= type FRAME-CLOSE) (deliver-exit-by-chan! id #f))

+712

((= type FRAME-ERROR) (on-frame-error id payload))

+713

(else #t)))))))

714

"")

715

716

;; A bulk result frame: decode the sigil-wire payload and hand it to the

@@ -752,7 +827,10 @@

827

(define (stat->entry st)

828

#{ name: (dict-ref st name: "")

829

kind: (wire-type->kind (dict-ref st type: ""))

−755

size: (dict-ref st size: 0) })

+830

size: (dict-ref st size: #f)

+831

mtime: (dict-ref st mtime: #f)

+832

hidden: (dict-ref st hidden:

+833

(string-starts-with? (dict-ref st name: "") ".")) })

834

835

(define (node-materialize-async source on-ready on-error)

836

(let ((kind (dict-ref source kind: file:))

@@ -762,7 +840,8 @@

840

(lambda (entries) (on-ready (map stat->entry (grants->list entries))))

841

(lambda (e) (on-error e)))

842

;; a file body decodes to a bytevector; the editor wants a string.

−765

(request! "fs/read-file" #{ path: addr }

+843

(request-transfer! "fs/read-file" #{ path: addr transfer: #t }

+844

'download #f

845

(lambda (bytes)

846

(on-ready (if (bytevector? bytes) (utf8->string bytes) (or bytes ""))))

847

(lambda (e) (on-error e))))))

@@ -781,24 +860,34 @@

860

;; an error surface, matching the lantern provider.

861

(define *on-persist-error* #f)

862

(define (node-on-persist-error! f) (set! *on-persist-error* f) "")

+863

(define (node-on-transfer-progress! f) (set! *on-transfer-progress* f) "")

864

(define (node-persist source value)

−785

(request! "fs/write-file"

+865

(let ((bytes (string->utf8 value)))

+866

((if (>= (bytevector-length bytes) resource-transfer-threshold)

+867

(lambda (verb args ok err)

+868

(request-transfer! verb

+869

#{ path: (dict-ref args path: "") transfer: #t

+870

size: (bytevector-length bytes) }

+871

'upload bytes ok err))

+872

request!)

+873

"fs/write-file"

874

#{ path: (dict-ref source address: "") content: value }

875

#f

876

(lambda (e)

877

(when *on-persist-error*

−790

(*on-persist-error* (dict-ref source address: "") e))))

+878

(*on-persist-error* (dict-ref source address: "") e)))))

879

value)

880

881

;; Ask the node for its $HOME once, on ready, so the "This computer" root can

882

;; land dired at home (the daemon does NOT expand "~" in a path, and grants

−795

;; are home-scoped, so an absolute home path is what dired needs). Uses

−796

;; proc/run (an exec grant); on-home gets the trimmed path. The local: Lantern

−797

;; root does the analogous fs.home fetch — this is its node twin.

+883

;; are home-scoped, so an absolute home path is what dired needs). This is a

+884

;; filesystem fact and uses fs/home, not proc/run: resource-only grants must

+885

;; be sufficient to enter a node, and a shell probe made root discovery

+886

;; depend on an unrelated execution grant.

887

(define (node-fetch-home! on-home)

−799

(request! "proc/run" #{ argv: (list "sh" "-c" "printf %s \"$HOME\"") }

+888

(request! "fs/home" #{}

889

(lambda (result)

−801

(let ((home (dict-ref result stdout: "")))

+890

(let ((home (dict-ref result path: "")))

891

(when (and (string? home) (> (string-length home) 0))

892

(on-home home))))

893

(lambda (e) #f)))

@@ -831,6 +920,9 @@

920

(lambda (e) (when on-err (on-err e))))

921

#t)

922

+923

(define (node-git-request source verb args on-ready on-error)

+924

(request! verb args on-ready on-error))

+925

926

;; ---- image serving: parity with the local: (lantern) provider -----------

927

;; The image mode holds a loadable URL STRING and lets the browser <img>

928

;; decode it (see (slate modes image)); it resolves that URL through the

@@ -882,21 +974,41 @@

974

;; index.html (node-blob-poll / node-blob-bytes / node-blob-ready).

975

(define (node-read-file-blob source on-ready on-error)

976

(request! "fs/read-file" #{ path: (dict-ref source address: "") }

−885

(lambda (bytes)

−886

(if (bytevector? bytes)

−887

(begin

−888

(set! *blob-seq* (+ *blob-seq* 1))

−889

(let ((token (string-append "b" (number->string *blob-seq*))))

−890

(set! *blob-inflight*

−891

(dict-set *blob-inflight* token

−892

#{ on-ready: on-ready on-error: on-error }))

−893

(set! *blob-pending*

−894

(append *blob-pending* (list #{ token: token bytes: bytes })))))

−895

(when on-error

−896

(on-error #{ code: "not-bytes"

−897

message: "fs/read-file did not return bytes" }))))

+977

(lambda (bytes) (node-queue-image! source bytes on-ready on-error))

978

(lambda (e) (when on-error (on-error e)))))

979

+980

;; Shared binary handoff for local and Enclave transports. Keep bytes intact;

+981

;; the browser decodes the image, including SVGs that require a MIME type.

+982

(define (node-queue-image! source bytes on-ready on-error)

+983

(if (bytevector? bytes)

+984

(begin

+985

(set! *blob-seq* (+ *blob-seq* 1))

+986

(let* ((token (string-append "b" (number->string *blob-seq*)))

+987

(path (string-downcase (dict-ref source address: "")))

+988

(mime

+989

(cond

+990

((string-ends-with? path ".svg") "image/svg+xml")

+991

((string-ends-with? path ".png") "image/png")

+992

((or (string-ends-with? path ".jpg")

+993

(string-ends-with? path ".jpeg")) "image/jpeg")

+994

((string-ends-with? path ".gif") "image/gif")

+995

((string-ends-with? path ".webp") "image/webp")

+996

((string-ends-with? path ".bmp") "image/bmp")

+997

(else "application/octet-stream"))))

+998

(set! *blob-inflight*

+999

(dict-set *blob-inflight* token

+1000

#{ on-ready: on-ready on-error: on-error }))

+1001

(set! *blob-pending*

+1002

(append *blob-pending*

+1003

(list #{ token: token bytes: bytes mime: mime })))))

+1004

(when on-error

+1005

(on-error #{ code: "not-bytes"

+1006

message: "fs/read-file did not return bytes" }))))

+1007

+1008

(define (node-blob-mime)

+1009

(if *blob-cur* (dict-ref *blob-cur* mime: "application/octet-stream")

+1010

"application/octet-stream"))

+1011

1012

;; JS drain (called each node tick, bounded): pop the next pending blob into

1013

;; *blob-cur* and return its token (or "" if none). JS then reads the bytes via

1014

;; node-blob-bytes and delivers the minted URL via node-blob-ready.

@@ -919,7 +1031,9 @@

1031

(define (node-blob-ready token url)

1032

(let ((slot (dict-ref *blob-inflight* token #f)))

1033

(when slot

−922

(set! *blob-inflight* (dict-set *blob-inflight* token #f))

+1034

(set! *blob-inflight* (dict-remove *blob-inflight* token))

+1035

(when (and *blob-cur* (equal? token (dict-ref *blob-cur* token: #f)))

+1036

(set! *blob-cur* #f))

1037

(if (and (string? url) (> (string-length url) 0))

1038

(let ((f (dict-ref slot on-ready: #f))) (when f (f url)))

1039

(let ((f (dict-ref slot on-error: #f)))

@@ -983,6 +1097,7 @@

1097

(let ((emit (dict-ref ctx emit: #f))

1098

(exit (dict-ref ctx exit: #f))

1099

(err (dict-ref ctx err: #f))

+1100

(reattached (dict-ref ctx reattached: #f))

1101

;; slot 0 = daemon CHAN, the u32 the binary lane addresses

1102

;; (#f until session/open resolves)

1103

;; slot 1 = reversed list of buffered outbound byte frames

@@ -1057,7 +1172,14 @@

1172

(lambda (result)

1173

(let ((b (session-binding result)))

1174

(if b

−1060

(correlate! (car b) (cdr b))

+1175

(begin

+1176

;; The ack precedes the ordered replay frame. Tell

+1177

;; the consumer whether it must reseed its retained

+1178

;; emulator before correlating and draining bytes.

+1179

(when reattached

+1180

(reattached (dict-ref result replay-bytes: #f)

+1181

#f 'local))

+1182

(correlate! (car b) (cdr b)))

1183

(when err (err "session/attach reply did not carry a usable chan and sid")))))

1184

(lambda (e) (when err (err e))))

1185

(request! "session/open"

@@ -1078,6 +1200,7 @@

1200

(lambda (e) (when err (err e))))))

1201

;; the per-session op object the seam drives

1202

#{ write: (lambda (bytes) (write-bytes bytes))

+1203

remote-id: (lambda () (vector-ref st 2))

1204

resize: (lambda (cols rows)

1205

(let ((p (make-bytevector 4 0)))

1206

(write-u16-be! p 0 cols) (write-u16-be! p 2 rows)

@@ -1124,6 +1247,7 @@

1247

1248

(define (node-open-socket!)

1249

(let ((conn (guard (e (#t #f)) (ws-connect *url*))))

+1250

(set! *transport-generation* (+ *transport-generation* 1))

1251

(set! *conn* conn)

1252

(set! *saw-open* #f)

1253

(set! *handshake-ticks* 0)

@@ -1140,6 +1264,7 @@

1264

;; Connect with an INJECTED transport (tests): capture outbound frames and

1265

;; feed inbound via node-deliver-*!, no real socket.

1266

(define (node-connect-with! transport)

+1267

(set! *transport-generation* (+ *transport-generation* 1))

1268

(set! *transport* transport)

1269

(set! *conn* 'injected)

1270

(set! *phase* 'connecting)

@@ -1147,26 +1272,38 @@

1272

#t)

1273

1274

(define (node-disconnect!)

−1150

(when (and *transport* (dict-ref *transport* close: #f))

−1151

((dict-ref *transport* close: #f)))

−1152

(set! *conn* #f)

−1153

(set! *transport* #f)

−1154

(set! *available* #f)

−1155

(set! *phase* 'closed))

+1275

(let ((was-live (or *conn* *transport*)))

+1276

(when (and *transport* (dict-ref *transport* close: #f))

+1277

((dict-ref *transport* close: #f)))

+1278

(set! *conn* #f)

+1279

(set! *transport* #f)

+1280

(set! *available* #f)

+1281

(set! *phase* 'closed)

+1282

(when (and was-live *on-remote-disconnect*)

+1283

(*on-remote-disconnect* *transport-generation*))))

1284

1285

(define (schedule-reconnect!)

1286

(set! *reconnect-in* *backoff-ticks*)

1287

;; exponential backoff: double each attempt, cap ~30s (200 ticks @150ms).

1288

(set! *backoff-ticks* (min 200 (* *backoff-ticks* 2))))

1289

+1290

(define (node-deliver-disconnect! generation)

+1291

(resource-transfer-remove-owner! *resource-transfers* generation

+1292

"node connection lost")

+1293

(when (and (= generation *transport-generation*)

+1294

(or *conn* *transport*))

+1295

(set! *conn* #f)

+1296

(set! *transport* #f)

+1297

(set! *available* #f)

+1298

(set! *phase* 'closed)

+1299

(when *on-remote-disconnect*

+1300

(*on-remote-disconnect* generation))

+1301

(when *on-close* (*on-close*))

+1302

(when *url* (schedule-reconnect!)))

+1303

"")

+1304

1305

(define (on-socket-closed!)

−1163

(set! *conn* #f)

−1164

(set! *transport* #f)

−1165

(set! *available* #f)

−1166

(set! *phase* 'closed)

−1167

(set! *handshake-ticks* 0)

−1168

(when *on-close* (*on-close*))

−1169

(when *url* (schedule-reconnect!)))

+1306

(node-deliver-disconnect! *transport-generation*))

1307

1308

;; The tick: drain ready frames, advance reconnect. Called ~every 16ms by the

1309

;; JS metronome (slate-node-tick) and directly by tests. Resets the

@@ -1257,6 +1394,7 @@

1394

;; Install a capturing transport (tests). Returns the transport dict.

1395

(define (node-set-transport! . maybe)

1396

(let ((tr (if (null? maybe) (capture-transport) (car maybe))))

+1397

(set! *transport-generation* (+ *transport-generation* 1))

1398

(set! *transport* tr)

1399

(set! *conn* 'injected)

1400

tr))

@@ -1266,10 +1404,13 @@

1404

(define (node-clear-sent!) (set! *sent-text* '()) (set! *sent-binary* '()) "")

1405

1406

(define (node-reset!)

+1407

(resource-transfer-remove-owner! *resource-transfers*

+1408

*transport-generation* "node provider reset")

1409

(set! *available* #f) (set! *phase* 'idle) (set! *url* #f)

1410

(set! *instance* #f) (set! *grants* '()) (set! *token* #f)

1411

(set! *conn* #f) (set! *saw-open* #f) (set! *drained-output* #f) (set! *next-id* 0)

1412

(set! *req-cbs* #{}) (set! *bulk-waiters* #{}) (set! *sessions* #{})

+1413

(set! *subscriptions* #{})

1414

(set! *blob-seq* 0) (set! *blob-pending* '()) (set! *blob-inflight* #{})

1415

(set! *blob-cur* #f) (set! *image-via-blob?* #f)

1416

(set! *transport* #f)

@@ -1278,6 +1419,9 @@

1419

(set! *on-sessions* #f)

1420

(set! *on-ready* #f) (set! *on-pair-needed* #f) (set! *on-close* #f)

1421

(set! *on-token* #f) (set! *on-persist-error* #f)

+1422

(set! *on-transfer-progress* #f)

+1423

(set! *on-remote-control* #f) (set! *on-remote-binary* #f)

+1424

(set! *on-remote-disconnect* #f) (set! *transport-generation* 0)

1425

(set! *sent-text* '()) (set! *sent-binary* '())

1426

"")

1427

@@ -1301,9 +1445,18 @@

1445

(node-rename source target on-ready on-error))

1446

delete: (lambda (source on-ready on-error)

1447

(node-delete source on-ready on-error))

−1304

subscribe: (lambda (source cb) (lambda () 'unsubscribed))

+1448

subscribe: (lambda (source cb)

Showing the first 500 of 514 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate/src/slate/providers/slate-meta.sglmodified

@@ -94,7 +94,7 @@

94

;; extra key rides along untouched until child-source reads it back.

95

(define (root-entries)

96

(map (lambda (n) #{ name: (root-name-string n) kind: dir: root: n })

−97

(filter (lambda (n) (not (eq? n slate:))) (root-names))))

+97

(filter (lambda (n) (not (eq? n slate:))) (root-visible-names))))

98

99

;; The top level: doorway directory + content tenants. `welcome` and

100

;; `scratchpad` are COMPOSED views, not byte files: (slate main)'s

packages/slate/src/slate/resource/transfer.sgladded

@@ -0,0 +1,294 @@

+1

;;; (slate resource transfer) — renderer-side credited Resource transfers.

+2

+3

(define-library (slate resource transfer)

+4

(import (sigil core) (sigil math))

+5

(export resource-transfer-threshold resource-transfer-chunk-bytes

+6

make-resource-transfer-registry resource-transfer-count

+7

resource-transfer-upload! resource-transfer-download!

+8

resource-transfer-control! resource-transfer-frame!

+9

resource-transfer-cancel! resource-transfer-remove-owner!

+10

resource-transfer-frame? transfer-frame-encode transfer-frame-decode)

+11

(begin

+12

(define resource-transfer-threshold 3145728)

+13

(define resource-transfer-chunk-bytes 65536)

+14

(define initial-credit (* resource-transfer-chunk-bytes 4))

+15

(define frame-batch #x20)

+16

(define frame-end #x21)

+17

(define frame-cancel #x22)

+18

(define frame-transfer-credit #x23)

+19

+20

(define (put-u32! bytes at n)

+21

(bytevector-u8-set! bytes at (modulo (quotient n 16777216) 256))

+22

(bytevector-u8-set! bytes (+ at 1) (modulo (quotient n 65536) 256))

+23

(bytevector-u8-set! bytes (+ at 2) (modulo (quotient n 256) 256))

+24

(bytevector-u8-set! bytes (+ at 3) (modulo n 256)))

+25

(define (get-u32 bytes at)

+26

(+ (* (bytevector-u8-ref bytes at) 16777216)

+27

(* (bytevector-u8-ref bytes (+ at 1)) 65536)

+28

(* (bytevector-u8-ref bytes (+ at 2)) 256)

+29

(bytevector-u8-ref bytes (+ at 3))))

+30

+31

(define (transfer-frame-encode type id payload)

+32

(let* ((n (bytevector-length payload))

+33

(out (make-bytevector (+ n 5) 0)))

+34

(bytevector-u8-set! out 0 type) (put-u32! out 1 id)

+35

(when (> n 0) (bytevector-copy! out 5 payload 0 n)) out))

+36

(define (transfer-frame-decode bytes)

+37

(and (bytevector? bytes) (>= (bytevector-length bytes) 5)

+38

#{ type: (bytevector-u8-ref bytes 0) id: (get-u32 bytes 1)

+39

payload: (bytevector-copy bytes 5 (bytevector-length bytes)) }))

+40

(define (resource-transfer-frame? bytes)

+41

(let ((f (transfer-frame-decode bytes)))

+42

(and f (member (dict-ref f type: 0)

+43

(list frame-batch frame-end frame-cancel

+44

frame-transfer-credit)))))

+45

(define (batch-frame id seq bytes)

+46

(let* ((n (bytevector-length bytes)) (p (make-bytevector (+ n 4) 0)))

+47

(put-u32! p 0 seq) (bytevector-copy! p 4 bytes 0 n)

+48

(transfer-frame-encode frame-batch id p)))

+49

(define (end-frame id seq total)

+50

(let ((p (make-bytevector 8 0)))

+51

(put-u32! p 0 seq) (put-u32! p 4 total)

+52

(transfer-frame-encode frame-end id p)))

+53

(define (credit-frame id amount)

+54

(let ((p (make-bytevector 4 0)))

+55

(put-u32! p 0 amount)

+56

(transfer-frame-encode frame-transfer-credit id p)))

+57

+58

(define (make-resource-transfer-registry) (vector '()))

+59

(define (entries r) (vector-ref r 0))

+60

(define (resource-transfer-count r) (length (entries r)))

+61

(define (find-entry r id)

+62

(let loop ((xs (entries r)))

+63

(and (pair? xs)

+64

(if (= id (dict-ref (car xs) id: -1)) (car xs)

+65

(loop (cdr xs))))))

+66

(define (replace! r id value)

+67

(vector-set! r 0

+68

(map (lambda (e) (if (= id (dict-ref e id: -1)) value e)) (entries r)))

+69

value)

+70

(define (remove! r id)

+71

(let ((old (find-entry r id)))

+72

(vector-set! r 0

+73

(filter (lambda (e) (not (= id (dict-ref e id: -1)))) (entries r)))

+74

old))

+75

+76

(define (emit-progress! entry state completed)

+77

(let ((f (dict-ref entry progress: #f)))

+78

(when f

+79

(f #{ id: (dict-ref entry id: 0)

+80

direction: (dict-ref entry direction: 'unknown)

+81

completed: completed total: (dict-ref entry total: 0)

+82

outstanding: (transfer-outstanding entry)

+83

peak-outstanding: (dict-ref entry peak-outstanding: 0)

+84

peak-frame-bytes: (dict-ref entry peak-frame-bytes: 0)

+85

transport: (dict-ref entry transport: #f) state: state }))))

+86

(define (transfer-outstanding entry)

+87

(if (eq? (dict-ref entry direction: #f) 'upload)

+88

(- (dict-ref entry sent: 0) (dict-ref entry acknowledged: 0))

+89

(- (dict-ref entry granted: 0) (dict-ref entry received: 0))))

+90

(define (with-high-water entry frame-bytes)

+91

(let ((outstanding (transfer-outstanding entry)))

+92

(dict-set

+93

(dict-set entry peak-outstanding:

+94

(max outstanding (dict-ref entry peak-outstanding: 0)))

+95

peak-frame-bytes:

+96

(max frame-bytes (dict-ref entry peak-frame-bytes: 0)))))

+97

(define (fail! r entry reason)

+98

(remove! r (dict-ref entry id: 0))

+99

(emit-progress! entry 'failed

+100

(if (eq? (dict-ref entry direction: #f) 'download)

+101

(dict-ref entry received: 0)

+102

(dict-ref entry acknowledged: 0)))

+103

(let ((f (dict-ref entry error: #f))) (when f (f reason)))

+104

#f)

+105

+106

(define (register! r entry)

+107

(if (find-entry r (dict-ref entry id: -1)) #f

+108

(begin (vector-set! r 0 (cons entry (entries r))) entry)))

+109

+110

(define (resource-transfer-upload! r id owner bytes transport send complete error progress)

+111

(and (bytevector? bytes)

+112

(register! r

+113

#{ id: id owner: owner direction: 'upload phase: 'negotiating

+114

bytes: bytes total: (bytevector-length bytes) sent: 0

+115

acknowledged: 0 credit: 0 seq: 0 end-sent?: #f

+116

peak-outstanding: 0 peak-frame-bytes: 0

+117

transport: transport send: send complete: complete

+118

error: error progress: progress })))

+119

+120

(define (resource-transfer-download! r id owner transport send complete error progress)

+121

(register! r

+122

#{ id: id owner: owner direction: 'download phase: 'negotiating

+123

total: 0 received: 0 granted: 0 credit: 0 seq: 0 destination: #f

+124

peak-outstanding: 0 peak-frame-bytes: 0

+125

transport: transport send: send complete: complete

+126

error: error progress: progress }))

+127

+128

(define (send-upload! r entry)

+129

(let loop ((e entry))

+130

(let ((credit (dict-ref e credit: 0))

+131

(sent (dict-ref e sent: 0))

+132

(total (dict-ref e total: 0)))

+133

(cond

+134

((and (= sent total) (not (dict-ref e end-sent?: #f)))

+135

((dict-ref e send: #f) (end-frame (dict-ref e id: 0)

+136

(dict-ref e seq: 0) total))

+137

(replace! r (dict-ref e id: 0)

+138

(dict-set (dict-set e end-sent?: #t) phase: 'awaiting-final)))

+139

((or (= credit 0) (= sent total)) e)

+140

(else

+141

(let* ((remaining (- total sent))

+142

(n (cond ((< credit resource-transfer-chunk-bytes)

+143

(if (< credit remaining) credit remaining))

+144

((< resource-transfer-chunk-bytes remaining)

+145

resource-transfer-chunk-bytes)

+146

(else remaining)))

+147

(chunk (bytevector-copy (dict-ref e bytes: #f) sent (+ sent n)))

+148

(seq (dict-ref e seq: 0)))

+149

((dict-ref e send: #f) (batch-frame (dict-ref e id: 0) seq chunk))

+150

(let ((next (with-high-water

+151

(dict-set

+152

(dict-set

+153

(dict-set e sent: (+ sent n))

+154

credit: (- credit n))

+155

seq: (+ seq 1))

+156

n)))

+157

(replace! r (dict-ref e id: 0) next)

+158

(loop next))))))))

+159

+160

(define (resource-transfer-control! r message)

+161

(let* ((id (dict-ref message id: #f))

+162

(entry (and (integer? id) (find-entry r id))))

+163

(when entry

+164

(cond

+165

((equal? (dict-ref message t: #f) "err")

+166

(fail! r entry (dict-ref message message: "transfer failed")))

+167

((and (equal? (dict-ref message t: #f) "ok")

+168

(dict-ref message transfer: #f)

+169

(eq? (dict-ref entry phase: #f) 'negotiating))

+170

(let* ((info (dict-ref message transfer: #{}) )

+171

(direction (dict-ref info direction: ""))

+172

(total (dict-ref info size: #f)))

+173

(cond

+174

((and (eq? (dict-ref entry direction: #f) 'upload)

+175

(equal? direction "upload")

+176

(integer? total)

+177

(= total (dict-ref entry total: -1)))

+178

(replace! r id (dict-set entry phase: 'active)))

+179

((and (eq? (dict-ref entry direction: #f) 'download)

+180

(equal? direction "download") (integer? total)

+181

(>= total 0))

+182

(let ((next (dict-set

+183

(dict-set

+184

(dict-set entry total: total)

+185

destination: (make-bytevector total 0))

+186

phase: 'active)))

+187

(set! next (with-high-water

+188

(dict-set next granted: initial-credit) 0))

+189

(replace! r id next)

+190

((dict-ref next send: #f) (credit-frame id initial-credit))))

+191

(else (fail! r entry "invalid transfer negotiation")))))

+192

((and (equal? (dict-ref message t: #f) "ok")

+193

(eq? (dict-ref entry direction: #f) 'upload)

+194

(eq? (dict-ref entry phase: #f) 'awaiting-final))

+195

(remove! r id)

+196

(emit-progress! entry 'complete (dict-ref entry total: 0))

+197

(let ((f (dict-ref entry complete: #f)))

+198

(when f (f (dict-ref message result: #{})))))

+199

(else #f)))))

+200

+201

(define (handle-credit! r entry payload)

+202

(if (not (= (bytevector-length payload) 4))

+203

(fail! r entry "malformed transfer credit")

+204

(let* ((amount (get-u32 payload 0))

+205

(unacked (- (dict-ref entry sent: 0)

+206

(dict-ref entry acknowledged: 0)))

+207

(acked (+ (dict-ref entry acknowledged: 0)

+208

(if (< amount unacked) amount unacked)))

+209

(next (dict-set

+210

(dict-set entry acknowledged: acked)

+211

credit: (+ (dict-ref entry credit: 0) amount))))

+212

(replace! r (dict-ref entry id: 0) next)

+213

(emit-progress! next 'active acked)

+214

(send-upload! r next))))

+215

+216

(define (handle-download-batch! r entry payload)

+217

(if (< (bytevector-length payload) 4)

+218

(fail! r entry "malformed transfer batch")

+219

(let* ((seq (get-u32 payload 0))

+220

(bytes (bytevector-copy payload 4 (bytevector-length payload)))

+221

(n (bytevector-length bytes))

+222

(at (dict-ref entry received: 0)))

+223

(if (or (not (= seq (dict-ref entry seq: 0)))

+224

(> (+ at n) (dict-ref entry total: 0)))

+225

(fail! r entry "invalid transfer sequence or size")

+226

(begin

+227

(bytevector-copy! (dict-ref entry destination: #f) at bytes 0 n)

+228

(let* ((credit (min n

+229

(max 0 (- (dict-ref entry total: 0)

+230

(dict-ref entry granted: 0)))))

+231

(next (with-high-water

+232

(dict-set

+233

(dict-set

+234

(dict-set entry received: (+ at n))

+235

granted: (+ (dict-ref entry granted: 0) credit))

+236

seq: (+ seq 1))

+237

n)))

+238

(replace! r (dict-ref entry id: 0) next)

+239

(emit-progress! next 'active (+ at n))

+240

;; Once all remaining bytes are credited the sender may

+241

;; finish and close. Do not write more credit into that

+242

;; completed stream while receiving its final window.

+243

(when (> credit 0)

+244

((dict-ref next send: #f)

+245

(credit-frame (dict-ref next id: 0) credit)))))))))

+246

+247

(define (handle-download-end! r entry payload)

+248

(if (not (= (bytevector-length payload) 8))

+249

(fail! r entry "malformed transfer end")

+250

(let ((seq (get-u32 payload 0)) (total (get-u32 payload 4)))

+251

(if (or (not (= seq (dict-ref entry seq: 0)))

+252

(not (= total (dict-ref entry total: 0)))

+253

(not (= total (dict-ref entry received: 0))))

+254

(fail! r entry "incomplete transfer")

+255

(begin

+256

(remove! r (dict-ref entry id: 0))

+257

(emit-progress! entry 'complete total)

+258

(let ((f (dict-ref entry complete: #f)))

+259

(when f (f (dict-ref entry destination: #f)))))))))

+260

+261

(define (resource-transfer-frame! r bytes)

+262

(let* ((frame (transfer-frame-decode bytes))

+263

(entry (and frame (find-entry r (dict-ref frame id: -1)))))

+264

(and entry

+265

(let ((type (dict-ref frame type: 0))

+266

(payload (dict-ref frame payload: #f)))

+267

(cond

+268

((and (= type frame-transfer-credit)

+269

(eq? (dict-ref entry direction: #f) 'upload))

+270

(handle-credit! r entry payload))

+271

((and (= type frame-batch)

+272

(eq? (dict-ref entry direction: #f) 'download))

+273

(handle-download-batch! r entry payload))

+274

((and (= type frame-end)

+275

(eq? (dict-ref entry direction: #f) 'download))

+276

(handle-download-end! r entry payload))

+277

((= type frame-cancel) (fail! r entry "peer cancelled transfer"))

+278

(else (fail! r entry "unexpected transfer frame")))))))

+279

+280

(define (resource-transfer-cancel! r id reason)

+281

(let ((entry (find-entry r id)))

+282

(and entry

+283

(begin

+284

((dict-ref entry send: #f)

+285

(transfer-frame-encode frame-cancel id (make-bytevector 0)))

+286

(fail! r entry reason)))))

+287

(define (resource-transfer-remove-owner! r owner reason)

+288

(let ((ids (map (lambda (e) (dict-ref e id: 0))

+289

(filter (lambda (e) (equal? owner (dict-ref e owner: #f)))

+290

(entries r)))))

+291

(for-each (lambda (id)

+292

(let ((e (find-entry r id))) (when e (fail! r e reason)))) ids)

+293

(length ids)))

+294

))

packages/slate/src/slate/root.sglmodified

@@ -44,10 +44,10 @@

44

; two surfaces cannot drift apart

45

(slate provider))

46

(export ;; registry

−47

          register-root! register-root-silent! unregister-root! root-ref root-registered? root-names root-set! root-named

+47

          register-root! register-root-silent! unregister-root! root-ref root-registered? root-names root-visible-names root-set! root-named

48

set-root-registered-handler! notify-root-registered!

49

;; metadata accessors

−50

root-home root-name-string root-annotation

+50

root-home root-name-string root-annotation canonical-root-name

51

;; R3a: ruling 4's `unknown:` state, and ruling 6's age on it

52

;; R3b: `root-mark-unknown!` — the per-root flip a failed per-node

53

;; re-attach fires (the dot's second source of `unknown:`)

@@ -122,6 +122,13 @@

122

(let ((e (assoc name *roots*))) (and e (cdr e))))

123

(define (root-registered? name) (and (root-ref name) #t))

124

(define (root-names) (map car *roots*))

+125

;; Internal aliases (notably `local:`) may remain registered so persisted

+126

;; sources and provider dispatch stay compatible while a canonical enrolled

+127

;; machine root is what navigation surfaces show.

+128

(define (root-visible-names)

+129

(filter (lambda (name)

+130

(not (dict-ref (root-ref name) hidden?: #f)))

+131

(root-names)))

132

133

;; Update one field of a registered root in place — the async fills (a

134

;; machine's `home:` landing from its fs.home RPC, presence flipping

@@ -134,6 +141,21 @@

141

(define (root-home name)

142

(let ((r (root-ref name))) (and r (dict-ref r home: #f))))

143

+144

;; `local:` is accepted forever at input/provider boundaries, but once an

+145

;; enrolled (or otherwise canonically named) root identifies this machine,

+146

;; every identity we WRITE uses that root. There may be only one local

+147

;; machine in a client; the first distinct local root is therefore the

+148

;; canonical target. With no such root, pure-local Slate keeps `local:`.

+149

(define (canonical-root-name name)

+150

(if (not (eq? name local:))

+151

name

+152

(let loop ((names (root-names)))

+153

(cond ((null? names) local:)

+154

((and (not (eq? (car names) local:))

+155

(dict-ref (root-ref (car names)) local?: #f))

+156

(car names))

+157

(else (loop (cdr names)))))))

+158

159

;; The registered root whose name prints as `s` ("browser" -> browser:), or #f.

160

;; For action strings ("openroot:browser") — the reverse of root-name-string

161

;; without needing a string->keyword primitive.

@@ -154,8 +176,10 @@

176

""

177

(let* ((class (dict-ref r class: #f))

178

(status (dict-ref r status: #f))

+179

(local? (dict-ref r local?: #f))

180

(age (root-age-phrase r)))

181

(string-append

+182

(if local? "local · " "")

183

(cond ((and class status)

184

(string-append (keyword->string class) " · "

185

(keyword->string status)))

@@ -334,7 +358,7 @@

358

(cond ((null? es) #f)

359

((and (eq? (dict-ref (cdr (car es)) provider: #f) prov)

360

(equal? (dict-ref (cdr (car es)) host: #f) host))

−337

(car (car es)))

+361

(canonical-root-name (car (car es))))

362

(else (loop (cdr es)))))))

363

364

;; Root-aware display name: "<root>:<addr>", except a root registered with

@@ -355,13 +379,14 @@

379

(else (rooted-path name addr)))))

380

381

;; ---- the path grammar ----------------------------------------------------

−358

;; The full rooted spelling ("zerocool:/etc") — parse-rooted-path's inverse,

−359

;; and the ONE place the spelling is defined (labels, display names and cache

−360

;; keys all call this, so they can never drift apart). Display policy

+382

;; The full rooted spelling ("zerocool:/etc") and the ONE write-time

+383

;; canonicalization point (labels, persisted addresses and cache keys all call

+384

;; this, so they can never drift apart). `local:` remains parseable, but when

+385

;; a canonical local machine is known it is never emitted. Display policy

386

;; (local:'s bareness) is source-root-display-name's business, not this; the

387

;; rooted spelling is the SWITCHING gesture and is always explicit.

388

(define (rooted-path name path)

−364

(string-append (root-name-string name) ":" path))

+389

(string-append (root-name-string (canonical-root-name name)) ":" path))

390

391

;; "zerocool:/etc" -> #{ root: zerocool: path: "/etc" } when "zerocool" names

392

;; a registered root AND the remainder is absolute; #f otherwise. Matching is

packages/slate/src/slate/selector.sglmodified

@@ -492,8 +492,11 @@

492

;; PEEK that must not steal focus — the frame keeps it so the NEXT chord key

493

;; still reaches the on-key: handler. That is the whole point David specified:

494

;; `?` must not break the chord.

−495

(define (render-which-key title km)

−496

(let ((keys (msort key-before? (dict-keys km))))

+495

(define (render-which-key title km . rest)

+496

;; Callers can supply human-readable labels to make a command menu

+497

;; tappable through the same canonical key path as the accessory bar.

+498

(let ((keys (msort key-before? (dict-keys km)))

+499

(labels (if (pair? rest) (car rest) #{})))

500

`(div (@ (class "which-key-scrim"))

501

(div (@ (class "which-key-panel"))

502

(div (@ (class "wk-title"))

@@ -501,12 +504,15 @@

504

(span (@ (class "wk-hint")) "press a key · ? for this list · esc to cancel"))

505

(div (@ (class "wk-grid"))

506

,@(map (lambda (k)

−504

(let ((v (dict-ref km k #f)))

−505

`(div (@ (class ,(if (dict? v) "wk-row wk-row-prefix" "wk-row")))

+507

(let ((v (dict-ref km k #f))

+508

(label (dict-ref labels k #f)))

+509

`(,(if label 'button 'div)

+510

(@ (class ,(if (dict? v) "wk-row wk-row-prefix" "wk-row"))

+511

,@(if label `((data-slate-key ,k)) '()))

512

(span (@ (class "wk-key")) ,k)

513

(span (@ (class "wk-arrow")) "→")

514

(span (@ (class "wk-cmd"))

−509

,(if (dict? v) "▸ prefix" v)))))

+515

,(or label (if (dict? v) "▸ prefix" v))))))

516

keys))))))

517

518

;; Order the panel rows: plain keys before prefixed (C-/M-) ones, then by the

packages/slate/src/slate/state.sglmodified

@@ -78,9 +78,12 @@

78

(update-view state "*messages*" (lambda (m) (view-add-line m msg)))))

79

80

(define (echo-transient state msg)

−81

(dict-set (dict-set (dict-set state slate/echo: msg)

−82

slate/echo-age: 0)

−83

slate/echo-fading?: #f))

+81

(dict-set

+82

(dict-set (dict-set (dict-set state slate/echo: msg)

+83

slate/echo-age: 0)

+84

slate/echo-fading?: #f)

+85

slate/echo-generation:

+86

(+ 1 (dict-ref state slate/echo-generation: 0))))

87

88

;; Show a message in the echo area and tee it into *messages* immediately.

89

(define (with-echo state msg)

packages/slate/src/slate/theme.sglmodified

@@ -916,11 +916,18 @@

916

;; Non-string values (e.g. the `faces:` sub-dict, which (slate face) lowers

917

;; separately into the faces <style>) are skipped — they are not palette vars.

918

(define (theme->css-vars theme)

−919

(string-join

−920

(map (lambda (p)

−921

(let ((k (car p)) (v (cdr p)))

−922

(cond ((eq? k 'scheme) (string-append "color-scheme:" v ";"))

−923

((string? v) (string-append "--" (symbol->string k) ":" v ";"))

−924

(else ""))))

−925

(dict->alist theme))

−926

""))))

+919

(string-append

+920

;; A theme-derived surface specifically for the phone keyboard deck. Dark

+921

;; themes use their deepest content background; light themes use their

+922

;; darkest background step, keeping the deck below the Ledge visually.

+923

"--key-deck-bg:"

+924

(dict-ref theme (if (string=? (dict-ref theme scheme: "dark") "light")

+925

bg-3: bg-0:) "#08090a") ";"

+926

(string-join

+927

(map (lambda (p)

+928

(let ((k (car p)) (v (cdr p)))

+929

(cond ((eq? k 'scheme) (string-append "color-scheme:" v ";"))

+930

((string? v) (string-append "--" (symbol->string k) ":" v ";"))

+931

(else ""))))

+932

(dict->alist theme))

+933

"")))))

packages/slate/src/slate/tmux/ladder.sglmodified

@@ -56,7 +56,8 @@

56

;;; them to ignore the line that matters in rows 2 and 3.

57

58

(define-library (slate tmux ladder)

−59

(import (sigil core))

+59

(import (sigil core)

+60

(slate root))

61

(export

62

tmux-ladder

63

ladder-backing ladder-downgraded? ladder-reason

@@ -70,12 +71,20 @@

71

;; reading a node's answer

72

;; ================================================================

73

−73

;; How to NAME a node in a degrade sentence. "" is the local node — the same

−74

;; convention every remote verb uses, where an absent `host:` means the

−75

;; directly-attached daemon — and an empty string would read as a hole in

−76

;; the middle of a sentence.

+74

;; How to NAME a node in a degrade sentence. Discovery deliberately keeps

+75

;; the owner-facing root label separate from the opaque transport nick, so

+76

;; resolve the latter back through the registry before it reaches UI copy.

+77

;; Unknown hosts retain the legacy fallback and "" remains the local node.

78

(define (tmux-node-label host)

−78

(if (and (string? host) (> (string-length host) 0)) host "this computer"))

+79

(if (and (string? host) (> (string-length host) 0))

+80

(let loop ((names (root-names)))

+81

(if (null? names) host

+82

(let* ((name (car names))

+83

(root (root-ref name)))

+84

(if (and root (equal? (dict-ref root host: #f) host))

+85

(dict-ref root label: (root-name-string name))

+86

(loop (cdr names))))))

+87

"this computer"))

88

89

;; Pull the `tmux:` capability out of a `sys/info` reply.

90

;;

packages/slate/src/slate/ui/diff.sglmodified

@@ -1,7 +1,7 @@

1

;;; Unified diff presentation shared by Slate views. Legacy patches without

2

;;; numbered hunks remain readable, but never acquire invented line numbers.

3

(define-library (slate ui diff)

−4

(import (sigil string))

+4

(import (sigil string) (slate components diff))

5

(export diff-rows diff-statistics diff-render)

6

(begin

7

(define (range-start token sign)

@@ -62,18 +62,5 @@

62

(define (diff-render text)

63

`(div (@ (class "agent-diff") (tabindex "0")

64

(role "region") (aria-label "Unified diff"))

−65

,@(map

−66

(lambda (row)

−67

(let ((kind (dict-ref row kind:)))

−68

(if (member kind '("hunk" "meta"))

−69

`(div (@ (class ,(string-append "agent-diff-" kind)))

−70

,(dict-ref row text:))

−71

`(div (@ (class ,(string-append "agent-diff-line agent-diff-" kind)))

−72

(span (@ (class "agent-line-number") (aria-hidden "true"))

−73

,(if (dict-ref row old:) (number->string (dict-ref row old:)) ""))

−74

(span (@ (class "agent-line-number") (aria-hidden "true"))

−75

,(if (dict-ref row new:) (number->string (dict-ref row new:)) ""))

−76

(span (@ (class "agent-line-sign") (aria-hidden "true"))

−77

,(dict-ref row sign:))

−78

(code ,(dict-ref row text:))))))

−79

(diff-rows text))))))

+65

,(diff-control-render (diff-normalize-unified text) #f #f)))

+66

))

packages/slate/test/agent-session-test.sglmodified

@@ -282,8 +282,10 @@

282

diff: "--- a/src/main.sgl\n+++ b/src/main.sgl\n@@\n-old\n+new\n" }))

283

(text (format "~s" node)))

284

(assert-true (string-contains? text "details"))

−285

(assert-true (string-contains? text "agent-diff-remove"))

−286

(assert-true (string-contains? text "agent-diff-add"))

+285

(assert-true (string-contains? text "slate-diff-deletion"))

+286

(assert-true (string-contains? text "slate-diff-addition"))

+287

(assert-true (string-contains? text "slate-diff-old"))

+288

(assert-true (string-contains? text "slate-diff-new"))

289

(assert-true (string-contains? text "src/main.sgl"))))

290

291

(test "file changes without bodies retain the compact fallback"

@@ -310,7 +312,7 @@

312

(rendered (format "~s" (force-memo-content (agent-session-render ended)))))

313

(assert-equal (- (length (string-split rendered "agent-open-file:src/main.sgl")) 1) 2)

314

(assert-true (string-contains? rendered "agent-tool-change"))

−313

(assert-true (string-contains? rendered "agent-diff-add"))

+315

(assert-true (string-contains? rendered "slate-diff-addition"))

316

(assert-false (string-contains? rendered "class \"agent-file-change\""))))

317

318

(test "message updates render partial text before completion and final replaces it"

packages/slate/test/agent-session-ui-browser-gate.mjsmodified

@@ -173,7 +173,7 @@ try {

173

  await push('tool-execution-start', '#{ tool: "edit" tool-execution-id: "edit-ui" arguments: #{ path: "src/session.sgl" } }');

174

  await push('file-change', '#{ tool-execution-id: "edit-ui" operation: "edit" path: "src/session.sgl" diff: "--- a/src/session.sgl\n+++ b/src/session.sgl\n@@ -8,1 +8,2 @@\n-old\n+new\n+extra\n" }');

175

await push('tool-execution-end', '#{ tool-execution-id: "edit-ui" result: #{ ok: #t } }');

−176

assert.equal(await evaluate('document.querySelectorAll(".agent-tool-change .agent-diff-add").length'), 2);

+176

assert.equal(await evaluate('document.querySelectorAll(".agent-tool-change .slate-diff-addition").length'), 2);

177

  assert.equal(await evaluate('document.querySelector(".agent-tool-change .agent-open-file").getAttribute("data-slate-click")'),'agent-open-file:src/session.sgl');

178

  assert.equal(await evaluate('document.querySelector(".agent-review-file .agent-open-file").getAttribute("data-slate-click")'),'agent-open-file:src/session.sgl');

179

  await evaluate('document.querySelector(".agent-session-head [data-agent-ui=review]").click();window.uiReview=document.querySelector(".agent-change-review");window.uiFile=uiReview.querySelector(".agent-review-file");uiFile.open=false');

packages/slate/test/appearance-command-test.sglmodified

@@ -30,7 +30,7 @@

30

31

(define exact-events

32

(list "flip-thumb-side" "theme:toggle" "effects:toggle" "ffm-toggle"

−33

"translucency:toggle" "terminals-use-tmux:toggle"

+33

"translucency:toggle" "terminals-use-tmux:toggle" "terminal-predictive-echo:toggle"

34

"opacity:dec" "opacity:inc" "chrome-opacity:dec"

35

"chrome-opacity:inc" "text-size:dec" "text-size:inc"))

36

@@ -52,6 +52,12 @@

52

(list "theme:set:slate-light" "opacity:set:72"

53

"chrome-opacity:set:90" "text-size:noop")))

54

+55

(test "predictive echo defaults off and toggles both ways"

+56

(let* ((on (command-run base "terminal-predictive-echo:toggle"))

+57

(off (command-run on "terminal-predictive-echo:toggle")))

+58

(assert-true (dict-ref on slate/terminal-predictive-echo: #f))

+59

(assert-false (dict-ref off slate/terminal-predictive-echo: #t))))

+60

61

(test "theme commands preserve state, prompt-close, and echo behavior"

62

(let* ((open (dict-set base slate/minibuffer: #{}))

63

(toggled (command-run open "theme:toggle"))

packages/slate/test/client-update-policy-test.mjsadded

@@ -0,0 +1,35 @@

+1

import assert from 'node:assert/strict';

+2

import fs from 'node:fs';

+3

+4

const sw = fs.readFileSync(new URL('../assets/sw.js', import.meta.url), 'utf8');

+5

const html = fs.readFileSync(new URL('../assets/index.html', import.meta.url), 'utf8');

+6

+7

// Node Status must identify the bytes actually executing, not an independently

+8

// maintained historical label. Every client release gives the document and its

+9

// cache-owning worker the same version.

+10

const workerVersion = sw.match(/const VERSION = '([^']+)'/)?.[1];

+11

const clientVersion = html.match(/const SLATE_WEB_CLIENT_VERSION = '([^']+)'/)?.[1];

+12

assert.ok(workerVersion, 'service worker version is missing');

+13

assert.equal(clientVersion, workerVersion, 'document and service worker versions diverged');

+14

+15

// A replacement may be fetched and installed in the background, but the sole

+16

// activation authority is the explicit page -> waiting-worker message.

+17

assert.equal((sw.match(/self\.skipWaiting/g) || []).length, 1);

+18

assert.match(sw, /data\.type === 'skip-waiting'\) self\.skipWaiting/);

+19

assert.doesNotMatch(sw, /clients\.claim\(/);

+20

+21

// The command activates in place and lets controllerchange perform one reload.

+22

// It must not use the old unregister -> reload -> claim -> reload sequence.

+23

assert.match(html, /if $!window\.__slateClientUpdateReloadArmed$ return;/);

+24

assert.match(html, /window\.__slateClientUpdateReloadArmed = true;\s*worker\.postMessage\(\{ type: 'skip-waiting' \}\);/);

+25

assert.doesNotMatch(html, /\.unregister/);

+26

assert.doesNotMatch(html, /searchParams\.set\('slate-update'/);

+27

+28

// Existing and newly installed waiting workers raise the same in-app notice.

+29

// Detection itself never arms activation; the action uses the explicit command.

+30

assert.match(html, /if $registration\.waiting$ announceWaitingClient$registration\.waiting$;/);

+31

assert.match(html, /installing\.state === 'installed'.*navigator\.serviceWorker\.controller \|\| registration\.active/s);

+32

assert.match(html, /slate-client-update-available/);

+33

assert.match(html, /'registration-waiting-state'/);

+34

+35

console.log('client update policy: notification, manual activation, and one reload');

packages/slate/test/diff-control-test.sgladded

@@ -0,0 +1,71 @@

+1

;;; Shared embedded diff normalization and presentation.

+2

(import (sigil core) (sigil string) (sigil test) (slate components diff)

+3

(slate modes agent-session))

+4

+5

(define ROWS (diff-normalize-unified "@@ -10,2 +20,2 @@\n same\n-old\n+new"))

+6

+7

(test "memoized diff construction is lazy and selection changes only affected groups"

+8

(let* ((rows (let loop ((i 0) (out '()))

+9

(if (= i 70) (reverse out)

+10

(loop (+ i 1)

+11

(cons #{ id: (number->string i) kind: addition: text: "+line" } out)))))

+12

(prepared 0)

+13

(prepare (lambda (row) (set! prepared (+ prepared 1)) row))

+14

(before (cddr (diff-control-render rows "31" #f revision: 1 prepare-row: prepare)))

+15

(after (cddr (diff-control-render rows "32" #f revision: 1 prepare-row: prepare)))

+16

(changed (cddr (diff-control-render rows "32" #f revision: 2 prepare-row: prepare))))

+17

(assert-equal 0 prepared)

+18

;; The lazy boundary carries key, revision and producer in its descriptor.

+19

(assert-false (equal? (vector-ref (car before) 2) (vector-ref (car after) 2)))

+20

(assert-false (equal? (vector-ref (cadr before) 2) (vector-ref (cadr after) 2)))

+21

(assert-equal (vector-ref (caddr before) 2) (vector-ref (caddr after) 2))

+22

(assert-false (equal? (vector-ref (caddr after) 2) (vector-ref (caddr changed) 2)))

+23

((vector-ref (car before) 3))

+24

(assert-equal 32 prepared)))

+25

+26

(test "unified adapter derives editor line-number coordinates"

+27

(assert-equal hunk: (dict-ref (list-ref ROWS 0) kind: #f))

+28

(assert-equal 10 (dict-ref (list-ref ROWS 1) old-line: #f))

+29

(assert-equal 20 (dict-ref (list-ref ROWS 1) new-line: #f))

+30

(assert-equal 11 (dict-ref (list-ref ROWS 2) old-line: #f))

+31

(assert-equal #f (dict-ref (list-ref ROWS 2) new-line: #f))

+32

(assert-equal #f (dict-ref (list-ref ROWS 3) old-line: #f))

+33

(assert-equal 21 (dict-ref (list-ref ROWS 3) new-line: #f)))

+34

+35

(test "shared control renders semantic color classes and copy-safe gutters"

+36

(let ((rendered (format "~s" (diff-control-render ROWS #f #f))))

+37

(assert-true (string-contains? rendered "slate-diff-addition"))

+38

(assert-true (string-contains? rendered "slate-diff-deletion"))

+39

(assert-true (string-contains? rendered "slate-diff-hunk"))

+40

(assert-true (string-contains? rendered "aria-hidden"))

+41

(assert-true (string-contains? rendered "slate-diff-code"))))

+42

+43

(test "structured Git rows use the same host-independent renderer"

+44

(let ((node (diff-row-render #{ kind: addition: text: "+added" old-line: #f new-line: 7 }

+45

#t #f)))

+46

(assert-true (string-contains? (format "~s" node) "slate-diff-addition selected"))))

+47

+48

(test "only expandable diff rows render disclosure actions"

+49

(let ((line (format "~s" (diff-row-render #{ kind: addition: text: "+added" }

+50

#f "select-line")))

+51

(hunk (format "~s" (diff-row-render #{ kind: hunk: text: "@@ -1 +1 @@" }

+52

#f "toggle-hunk"))))

+53

(assert-true (string-contains? line "data-slate-click"))

+54

(assert-false (string-contains? line "slate-diff-action"))

+55

(assert-true (string-contains? hunk "slate-diff-hunk-toggle"))))

+56

+57

(test "dedicated change marker is not duplicated in diff text"

+58

(let ((added (format "~s" (diff-row-render #{ kind: addition: text: "+added" } #f #f)))

+59

(removed (format "~s" (diff-row-render #{ kind: deletion: text: "-removed" } #f #f))))

+60

(assert-false (string-contains? added "\"+added\""))

+61

(assert-false (string-contains? removed "\"-removed\""))

+62

(assert-true (string-contains? added "\"added\""))

+63

(assert-true (string-contains? removed "\"removed\""))))

+64

+65

(test "agent file changes normalize through the shared diff control"

+66

(let ((rendered (format "~s" (agent-file-change-node

+67

#{ operation: "edit" path: "a.sgl"

+68

diff: "@@ -3 +4 @@\n-old\n+new" }))))

+69

(assert-true (string-contains? rendered "slate-diff-control"))

+70

(assert-true (string-contains? rendered "slate-diff-old"))

+71

(assert-true (string-contains? rendered "slate-diff-addition"))))

packages/slate/test/enclave-account-session-test.sglmodified

@@ -52,6 +52,23 @@

52

(account-session-set-transport! (mock-transport)))

53

54

(test-group "Enclave account session"

+55

(test "account integration installs the node message handler without calling it"

+56

(reset-fixture!)

+57

(let ((state #{}) (messages 0) (registered #f))

+58

(configure-account-session!

+59

#{ state: (lambda () state)

+60

set-state: (lambda (next) (set! state next))

+61

refresh: (lambda () #t)

+62

recoverable?: (lambda () #f)

+63

node-message: (lambda (message) (set! messages (+ messages 1)))

+64

node-persist-error: (lambda (callback) #t)

+65

node-register: (lambda (refresh) (set! registered #t))

+66

pairing-ready: (lambda () #t)

+67

pairing-error: (lambda (reason) #t) })

+68

(account-on-ready!)

+69

(assert-equal 0 messages)

+70

(assert-true registered)))

+71

72

(test "PAIR persists once, reconnects, proves SASL, and reaches ready"

73

(reset-fixture!)

74

(let* ((credential (make-string 64 #\c))

packages/slate/test/enclave-node-carrier-resource-test.sgladded

@@ -0,0 +1,341 @@

+1

(import (sigil core) (sigil test) (sigil json) (sigil wire)

+2

(slate provider)

+3

(slate root)

+4

(slate providers node)

+5

(slate providers enclave-node)

+6

(slate providers enclave-node carrier))

+7

+8

(define (ready-loopback!)

+9

(node-reset!)

+10

(node-set-transport!)

+11

(node-set-token! "paired")

+12

(node-deliver-text! "{\"t\":\"hello\",\"instance\":\"local\"}")

+13

(node-deliver-text! "{\"t\":\"auth-ok\",\"grants\":[]}")

+14

(enclave-node-reset!)

+15

(enclave-node-register!)

+16

(node-clear-sent!))

+17

+18

(define (complete-open! carrier transport)

+19

(let* ((raw (car (node-sent-text)))

+20

(_string (assert-true (string? raw)))

+21

(open (json-decode raw))

+22

(request (dict-ref open id: #f)))

+23

(node-deliver-text!

+24

(json-encode #{ t: "ev" event: "remote/opened"

+25

carrier: carrier request: request

+26

transport: transport }))

+27

(assert-equal 2 (length (node-sent-text)))

+28

request))

+29

+30

(define (last-carrier-request)

+31

(let* ((raw (car (reverse (node-sent-text))))

+32

(outer (if (string? raw) (json-decode raw) raw))

+33

(payload (dict-ref outer payload: #f))

+34

(inner (if (string? payload) (json-decode payload) payload)))

+35

#{ outer: outer inner: inner }))

+36

+37

(define (sent-json-texts)

+38

(filter-map

+39

(lambda (raw)

+40

(and (string? raw) (guard (e (#t #f)) (json-decode raw))))

+41

(node-sent-text)))

+42

+43

(define (open-request-for target)

+44

(find

+45

(lambda (message)

+46

(and (equal? (dict-ref message verb: #f) "remote/open")

+47

(equal? target

+48

(dict-ref (dict-ref message args: #{}) target: #f))))

+49

(sent-json-texts)))

+50

+51

(define (carrier-request-for carrier)

+52

(find

+53

(lambda (message)

+54

(and (equal? (dict-ref message t: #f) "remote/text")

+55

(equal? (dict-ref message carrier: #f) carrier)))

+56

(sent-json-texts)))

+57

+58

(test-group "enclave-node coarse requests over companion carriers"

+59

(test "issues a carrier open for a coarse request"

+60

(ready-loopback!)

+61

(enclave-node-sys-info! "phone" (lambda (_) #t) (lambda (_) #f))

+62

(assert-equal 1 (length (node-sent-text)))

+63

(let ((open (json-decode (car (node-sent-text)))))

+64

(assert-equal "remote/open" (dict-ref open verb: #f))

+65

(assert-true (number? (dict-ref open id: #f)))

+66

(assert-equal 2147483648 (dict-ref open id: #f)))

+67

(complete-open! 5 "direct")

+68

(assert-equal 'direct (enclave-node-carrier-transport "phone"))

+69

(assert-false (enclave-node-carrier-transport "tablet"))

+70

(assert-equal 2 (length (node-sent-text))))

+71

+72

(test "ready direct carrier promotes an offline root by opaque host identity"

+73

(ready-loopback!)

+74

(register-root! zerocool:

+75

#{ provider: node: host: "phone" label: "zerocool" class: machine:

+76

status: offline: planes: (list resource: session:) })

+77

(enclave-node-sys-info! "phone" (lambda (_) #t) (lambda (_) #f))

+78

(complete-open! 6 "direct")

+79

(assert-equal online: (dict-ref (root-ref zerocool:) status: #f)))

+80

+81

(test "inline coarse reply uses the selected direct carrier"

+82

(ready-loopback!)

+83

(let ((result #f) (failure #f))

+84

(enclave-node-sys-info! "phone"

+85

(lambda (value) (set! result value))

+86

(lambda (error) (set! failure error)))

+87

(assert-true (node-ready?))

+88

(assert-equal 1 (length (node-sent-text)))

+89

(complete-open! 7 "direct")

+90

(let* ((sent (last-carrier-request))

+91

(outer (dict-ref sent outer: #{}))

+92

(inner (dict-ref sent inner: #{}))

+93

(id (dict-ref inner id: #f)))

+94

(assert-equal "remote/text" (dict-ref outer t: #f))

+95

(assert-equal "sys/info" (dict-ref inner verb: #f))

+96

(node-deliver-text!

+97

(json-encode

+98

(carrier-text-envelope 7

+99

(json-encode #{ t: "ok" id: id

+100

result: #{ node: "phone" } })))))

+101

(assert-false failure)

+102

(assert-equal "phone" (dict-ref result node: #f))))

+103

+104

(test "account loss preserves a ready direct root and its in-flight request"

+105

(ready-loopback!)

+106

(register-root! phone:

+107

#{ provider: node: host: "phone" label: "phone" class: machine:

+108

status: online: planes: (list resource: session:) })

+109

(let ((result #f) (failure #f))

+110

(enclave-node-sys-info! "phone"

+111

(lambda (value) (set! result value))

+112

(lambda (error) (set! failure error)))

+113

(complete-open! 8 "direct")

+114

(let* ((sent (last-carrier-request))

+115

(inner (dict-ref sent inner: #{}))

+116

(id (dict-ref inner id: #f)))

+117

(enclave-node-account-lost! "connection lost" 1000)

+118

(assert-equal 1 (enclave-node-pending-count))

+119

(assert-equal online: (dict-ref (root-ref phone:) status: #f))

+120

(assert-false failure)

+121

(node-deliver-text!

+122

(json-encode

+123

(carrier-text-envelope 8

+124

(json-encode #{ t: "ok" id: id

+125

result: #{ node: "phone" } }))))

+126

(assert-equal "phone" (dict-ref result node: #f))

+127

(assert-equal 0 (enclave-node-pending-count)))

+128

(unregister-root! phone:)

+129

(node-reset!)))

+130

+131

(test "failed carrier acquisition retries the compatibility backend"

+132

(ready-loopback!)

+133

(let ((failure #f))

+134

(enclave-node-sys-info! "phone" (lambda (_) #f)

+135

(lambda (error) (set! failure error)))

+136

(let* ((open (json-decode (car (node-sent-text))))

+137

(request (dict-ref open id: #f)))

+138

(node-deliver-text!

+139

(json-encode #{ t: "ev" event: "remote/failed"

+140

request: request

+141

message: "direct and relay unavailable" })))

+142

(assert-equal "Enclave account is not connected" failure)

+143

(assert-equal 0 (enclave-node-pending-count))))

+144

+145

(test "bulk file reply is correlated by carrier and request id"

+146

(ready-loopback!)

+147

(let ((result #f) (failure #f))

+148

(enclave-node-sys-info! "phone"

+149

(lambda (value) (set! result value))

+150

(lambda (error) (set! failure error)))

+151

(assert-true (node-ready?))

+152

(assert-equal 1 (length (node-sent-text)))

+153

(complete-open! 11 "relay")

+154

(assert-equal 'relay (enclave-node-carrier-transport "phone"))

+155

(let* ((sent (last-carrier-request))

+156

(inner (dict-ref sent inner: #{}))

+157

(id (dict-ref inner id: #f)))

+158

(node-deliver-text!

+159

(json-encode

+160

(carrier-text-envelope 11

+161

(json-encode #{ t: "ok" id: id bulk: #t }))))

+162

;; Wrong-carrier bulk is ignored.

+163

(node-deliver-binary!

+164

(carrier-frame-encode 12

+165

(frame-encode FRAME-BULK id (wire-encode "bad"))))

+166

(assert-false result)

+167

(node-deliver-binary!

+168

(carrier-frame-encode 11

+169

(frame-encode FRAME-BULK id (wire-encode "hello"))))

+170

(assert-false failure)

+171

(assert-equal "hello" result)

+172

;; Return the shared loopback singleton to idle for later test files.

+173

(node-reset!)))))

+174

+175

(test "directory mutations use the selected carrier and canonical verbs"

+176

(ready-loopback!)

+177

(let ((done 0) (failure #f)

+178

(dir #{ provider: node: kind: dir: host: "phone" address: "/root/new" })

+179

(moved #{ provider: node: kind: dir: host: "phone" address: "/root/moved" }))

+180

(source-mkdir dir (lambda (_) (set! done (+ done 1)))

+181

(lambda (e) (set! failure e)))

+182

(complete-open! 13 "direct")

+183

(let* ((sent (last-carrier-request))

+184

(inner (dict-ref sent inner: #{}))

+185

(id (dict-ref inner id: #f)))

+186

(assert-equal "fs/mkdir" (dict-ref inner verb: #f))

+187

(assert-equal "/root/new"

+188

(dict-ref (dict-ref inner args: #{}) path: #f))

+189

(node-deliver-text!

+190

(json-encode (carrier-text-envelope 13

+191

(json-encode #{ t: "ok" id: id result: #{ ok: #t } })))))

+192

(source-rename dir moved (lambda (_) (set! done (+ done 1)))

+193

(lambda (e) (set! failure e)))

+194

(let* ((sent (last-carrier-request))

+195

(inner (dict-ref sent inner: #{}))

+196

(id (dict-ref inner id: #f))

+197

(args (dict-ref inner args: #{})))

+198

(assert-equal "fs/rename" (dict-ref inner verb: #f))

+199

(assert-equal "/root/new" (dict-ref args from: #f))

+200

(assert-equal "/root/moved" (dict-ref args to: #f))

+201

(node-deliver-text!

+202

(json-encode (carrier-text-envelope 13

+203

(json-encode #{ t: "ok" id: id result: #{ ok: #t } })))))

+204

(source-delete moved (lambda (_) (set! done (+ done 1)))

+205

(lambda (e) (set! failure e)))

+206

(let* ((sent (last-carrier-request))

+207

(inner (dict-ref sent inner: #{}))

+208

(id (dict-ref inner id: #f))

+209

(args (dict-ref inner args: #{})))

+210

(assert-equal "fs/delete" (dict-ref inner verb: #f))

+211

(assert-equal "/root/moved" (dict-ref args path: #f))

+212

(assert-true (dict-ref args recursive: #f))

+213

(node-deliver-text!

+214

(json-encode (carrier-text-envelope 13

+215

(json-encode #{ t: "ok" id: id result: #{ ok: #t } })))))

+216

(assert-false failure)

+217

(assert-equal 3 done)

+218

(assert-equal 'direct (enclave-node-carrier-transport "phone"))

+219

(node-reset!)))

+220

+221

(test "one root's carrier loss cannot settle or retire another root's work"

+222

(ready-loopback!)

+223

(let ((phone-result #f) (phone-error #f)

+224

(laptop-result #f) (laptop-error #f))

+225

(enclave-node-sys-info! "phone"

+226

(lambda (value) (set! phone-result value))

+227

(lambda (error) (set! phone-error error)))

+228

(enclave-node-sys-info! "laptop"

+229

(lambda (value) (set! laptop-result value))

+230

(lambda (error) (set! laptop-error error)))

+231

(let ((phone-open (open-request-for "phone"))

+232

(laptop-open (open-request-for "laptop")))

+233

(assert-true phone-open)

+234

(assert-true laptop-open)

+235

;; Complete in the opposite order from issuance to prove request

+236

;; correlation, then keep both roots concurrently ready.

+237

(node-deliver-text!

+238

(json-encode #{ t: "ev" event: "remote/opened" carrier: 42

+239

request: (dict-ref laptop-open id: #f)

+240

transport: "relay" }))

+241

(node-deliver-text!

+242

(json-encode #{ t: "ev" event: "remote/opened" carrier: 41

+243

request: (dict-ref phone-open id: #f)

+244

transport: "direct" })))

+245

(let* ((phone-outer (carrier-request-for 41))

+246

(laptop-outer (carrier-request-for 42))

+247

(phone-inner (json-decode (dict-ref phone-outer payload: "")))

+248

(laptop-inner (json-decode (dict-ref laptop-outer payload: ""))))

+249

(node-deliver-text!

+250

(json-encode #{ t: "ev" event: "remote/closed" carrier: 41 }))

+251

(assert-equal "connection lost to phone" phone-error)

+252

(assert-false phone-result)

+253

(assert-false (enclave-node-carrier-transport "phone"))

+254

(assert-equal 'relay (enclave-node-carrier-transport "laptop"))

+255

(assert-false laptop-error)

+256

(node-deliver-text!

+257

(json-encode

+258

(carrier-text-envelope 42

+259

(json-encode #{ t: "ok" id: (dict-ref laptop-inner id: #f)

+260

result: #{ node: "laptop" } }))))

+261

;; A late phone reply, even with its correct request id, cannot cross

+262

;; the surviving laptop carrier and resurrect retired work.

+263

(node-deliver-text!

+264

(json-encode

+265

(carrier-text-envelope 42

+266

(json-encode #{ t: "ok" id: (dict-ref phone-inner id: #f)

+267

result: #{ node: "wrong" } }))))

+268

(assert-equal "laptop" (dict-ref laptop-result node: #f))

+269

(assert-equal "connection lost to phone" phone-error)

+270

(assert-equal 0 (enclave-node-pending-count))

+271

(node-reset!))))

+272

+273

(test "remote image operation streams binary bytes into the browser Blob handoff"

+274

(ready-loopback!)

+275

(let ((url #f) (failure #f)

+276

(image-op (dict-ref (provider-ref node:) image-url: #f)))

+277

(assert-true (procedure? image-op))

+278

(image-op #{ provider: node: host: "phone" kind: file: address: "/photos/TEST.PNG" }

+279

(lambda (value) (set! url value))

+280

(lambda (error) (set! failure error)))

+281

(complete-open! 77 "direct")

+282

(let* ((inner (dict-ref (last-carrier-request) inner: #{}))

+283

(id (dict-ref inner id: #f)))

+284

(assert-equal "fs/read-file" (dict-ref inner verb: #f))

+285

(assert-equal "/photos/TEST.PNG" (dict-ref (dict-ref inner args: #{}) path: #f))

+286

(assert-true (dict-ref (dict-ref inner args: #{}) transfer: #f))

+287

(node-deliver-text!

+288

(json-encode

+289

(carrier-text-envelope 77

+290

(json-encode

+291

#{ t: "ok" id: id

+292

transfer: #{ direction: "download" size: 4 chunk-bytes: 65536 } }))))

+293

(node-deliver-binary!

+294

(carrier-frame-encode 77 (frame-encode #x20 id (bytevector 0 0 0 0 137 80 0 255))))

+295

(assert-false (node-blob-waiting?))

+296

(node-deliver-binary!

+297

(carrier-frame-encode 77 (frame-encode #x21 id (bytevector 0 0 0 1 0 0 0 4))))

+298

(assert-false url)

+299

(assert-true (node-blob-waiting?))

+300

(let ((token (node-blob-poll)))

+301

(assert-equal (bytevector 137 80 0 255) (node-blob-bytes))

+302

(assert-equal "image/png" (node-blob-mime))

+303

(node-blob-ready token "blob:remote-image")

+304

(assert-equal "blob:remote-image" url)

+305

(assert-equal 0 (bytevector-length (node-blob-bytes))))

+306

(assert-false failure)

+307

(assert-equal 0 (enclave-node-transfer-count)))))

+308

+309

(test "remote image failures reach the preview without queuing a Blob"

+310

(ready-loopback!)

+311

(let ((failure #f))

+312

((dict-ref (provider-ref node:) image-url:)

+313

#{ provider: node: host: "phone" kind: file: address: "/missing.svg" }

+314

(lambda (_) (error "unexpected image"))

+315

(lambda (error) (set! failure error)))

+316

(complete-open! 78 "direct")

+317

(let ((id (dict-ref (dict-ref (last-carrier-request) inner: #{}) id: #f)))

+318

(node-deliver-text!

+319

(json-encode

+320

(carrier-text-envelope 78

+321

(json-encode #{ t: "err" id: id code: "not-found" message: "image missing" })))))

+322

(assert-true failure)

+323

(assert-false (node-blob-waiting?))))

+324

+325

(test "remote Git requests preserve structured repository errors"

+326

(ready-loopback!)

+327

(let ((failure #f))

+328

((dict-ref (provider-ref node:) git-request:)

+329

#{ provider: node: host: "phone" kind: dir: address: "/photos" }

+330

"git/discover" #{ path: "/photos" }

+331

(lambda (_) (error "unexpected Git result"))

+332

(lambda (error) (set! failure error)))

+333

(complete-open! 79 "direct")

+334

(let ((id (dict-ref (dict-ref (last-carrier-request) inner: #{}) id: #f)))

+335

(node-deliver-text!

+336

(json-encode

+337

(carrier-text-envelope 79

+338

(json-encode #{ t: "err" id: id code: "not-a-repository"

+339

message: "not a Git repository" })))))

+340

(assert-equal "not-a-repository" (dict-ref failure code: #f))

+341

(assert-equal "not a Git repository" (dict-ref failure message: #f))))

packages/slate/test/enclave-node-carrier-session-test.sgladded

@@ -0,0 +1,180 @@

+1

(import (sigil core) (sigil test) (sigil io) (sigil json)

+2

(slate provider)

+3

(slate providers node)

+4

(slate providers enclave-node)

+5

(slate providers enclave-node carrier))

+6

+7

(define (ready-session-loopback!)

+8

(node-reset!)

+9

(node-set-transport!)

+10

(node-set-token! "paired")

+11

(node-deliver-text! "{\"t\":\"hello\",\"instance\":\"local\"}")

+12

(node-deliver-text! "{\"t\":\"auth-ok\",\"grants\":[]}")

+13

(enclave-node-reset!)

+14

(enclave-node-register!)

+15

(node-clear-sent!))

+16

+17

(define (decode-last-text)

+18

(json-decode (car (reverse (node-sent-text)))))

+19

+20

(define (complete-session-carrier! carrier)

+21

(let* ((open (json-decode (car (node-sent-text))))

+22

(request (dict-ref open id: #f)))

+23

(node-deliver-text!

+24

(json-encode #{ t: "ev" event: "remote/opened"

+25

carrier: carrier request: request

+26

transport: "direct" }))))

+27

+28

(test-group "remote sessions over companion carriers"

+29

(test "open, queued input, output credit, and close keep the inner protocol"

+30

(ready-session-loopback!)

+31

(let ((emitted #f) (lost #f) (failure #f))

+32

(let ((ops

+33

(remote-session-open

+34

#{ host: "phone" kind: pty: cwd: "/tmp"

+35

argv: (list "bash" "-l") cols: 90 rows: 30 }

+36

#{ sid: "seam-1"

+37

emit: (lambda (text) (set! emitted text))

+38

lost: (lambda (at) (set! lost #t))

+39

err: (lambda (error) (set! failure error)) })))

+40

(assert-equal "remote/open" (dict-ref (json-decode (car (node-sent-text))) verb: #f))

+41

(complete-session-carrier! 17)

+42

(let* ((outer (decode-last-text))

+43

(inner (json-decode (dict-ref outer payload: "")))

+44

(rid (dict-ref inner id: #f)))

+45

(assert-equal "session/open" (dict-ref inner verb: #f))

+46

(assert-equal "/tmp" (dict-ref (dict-ref inner args: #{}) cwd: #f))

+47

;; Input before the open reply is queued and rebound to the assigned

+48

;; channel when the reply arrives.

+49

((dict-ref ops write:) "hello")

+50

(node-deliver-text!

+51

(json-encode

+52

(carrier-text-envelope 17

+53

(json-encode #{ t: "ok" id: rid

+54

result: #{ chan: 42 sid: "node-session" } }))))

+55

(let* ((sent (carrier-frame-decode (car (node-sent-binary))))

+56

(inner-frame (dict-ref sent payload: #f))

+57

(decoded (frame-decode inner-frame)))

+58

(assert-equal 2 (bytevector-u8-ref inner-frame 0))

+59

(assert-equal 42 (dict-ref decoded id: #f))

+60

(assert-equal "hello"

+61

(utf8->string

+62

(bytevector-copy inner-frame 5 (bytevector-length inner-frame)))))

+63

(node-clear-sent!)

+64

(node-poll!)

+65

(assert-false (node-drained-output?))

+66

(node-deliver-binary!

+67

(carrier-frame-encode 17

+68

(frame-encode 3 42 (string->utf8 "world"))))

+69

(assert-equal "world" emitted)

+70

(assert-true (node-drained-output?))

+71

(let* ((credit (carrier-frame-decode (car (node-sent-binary))))

+72

(inner-frame (dict-ref credit payload: #f))

+73

(decoded (frame-decode inner-frame)))

+74

(assert-equal 7 (bytevector-u8-ref inner-frame 0))

+75

(assert-equal 42 (dict-ref decoded id: #f)))

+76

((dict-ref ops close:))

+77

(assert-equal 0 (enclave-node-stream-count))

+78

(assert-false failure)

+79

(assert-false lost)))))

+80

+81

(test "carrier closure retires and reports only its bound session"

+82

(ready-session-loopback!)

+83

(let ((lost #f))

+84

(remote-session-open #{ host: "phone" kind: pty: }

+85

#{ sid: "seam-2" lost: (lambda (_) (set! lost #t)) })

+86

(complete-session-carrier! 19)

+87

(let* ((outer (decode-last-text))

+88

(inner (json-decode (dict-ref outer payload: "")))

+89

(rid (dict-ref inner id: #f)))

+90

(node-deliver-text!

+91

(json-encode

+92

(carrier-text-envelope 19

+93

(json-encode #{ t: "ok" id: rid

+94

result: #{ chan: 44 sid: "node-session-2" } })))))

+95

(assert-equal 1 (enclave-node-stream-count))

+96

(node-deliver-text!

+97

(json-encode #{ t: "ev" event: "remote/closed" carrier: 19 }))

+98

(assert-true lost)

+99

(assert-equal 0 (enclave-node-stream-count))

+100

(node-reset!)))

+101

+102

(test "the bounded ladder reattaches over a fresh carrier"

+103

(ready-session-loopback!)

+104

(let ((events '()))

+105

(let ((handle

+106

(source-session-open

+107

#{ provider: node: host: "phone" kind: pty: }

+108

(lambda (event) (set! events (cons event events))) #{})))

+109

(complete-session-carrier! 21)

+110

(let* ((outer (decode-last-text))

+111

(inner (json-decode (dict-ref outer payload: "")))

+112

(rid (dict-ref inner id: #f)))

+113

(node-deliver-text!

+114

(json-encode

+115

(carrier-text-envelope 21

+116

(json-encode #{ t: "ok" id: rid

+117

result: #{ chan: 51 sid: "durable-1" } })))))

+118

(node-clear-sent!)

+119

(node-deliver-text!

+120

(json-encode #{ t: "ev" event: "remote/closed" carrier: 21 }))

+121

(assert-equal 1 (enclave-node-reattach-count))

+122

;; First tick stamps the floor; the second issues exactly one attach.

+123

(enclave-node-tick! 1000)

+124

(enclave-node-tick! 2000)

+125

(assert-equal 1 (length (node-sent-text)))

+126

(assert-equal "remote/open"

+127

(dict-ref (json-decode (car (node-sent-text))) verb: #f))

+128

(assert-equal "durable-1"

+129

(dict-ref

+130

(dict-ref (json-decode (car (node-sent-text))) args: #{})

+131

sid: #f))

+132

(complete-session-carrier! 22)

+133

(let* ((outer (decode-last-text))

+134

(inner (json-decode (dict-ref outer payload: "")))

+135

(rid (dict-ref inner id: #f)))

+136

(assert-equal "session/attach" (dict-ref inner verb: #f))

+137

(assert-equal "durable-1"

+138

(dict-ref (dict-ref inner args: #{}) sid: #f))

+139

(node-deliver-text!

+140

(json-encode

+141

(carrier-text-envelope 22

+142

(json-encode #{ t: "ok" id: rid

+143

result: #{ chan: 52 sid: "durable-1" } })))))

+144

(assert-equal 0 (enclave-node-reattach-count))

+145

;; complete-session-carrier! explicitly reports a direct selection;

+146

;; the reattach event must preserve that transport rather than infer it.

+147

(assert-equal 'direct

+148

(dict-ref (car events) transport: #f))

+149

(assert-true (dict-ref (car events) reattached: #f))

+150

(session-close handle)

+151

(node-reset!))))

+152

+153

(test "loopback loss fails pinned resources and arms bound sessions"

+154

(ready-session-loopback!)

+155

(let ((lost? #f) (resource-error #f))

+156

(let ((handle

+157

(source-session-open

+158

#{ provider: node: host: "phone" kind: pty: }

+159

(lambda (event)

+160

(when (dict-ref event disconnected: #f) (set! lost? #t))) #{})))

+161

(complete-session-carrier! 31)

+162

(let* ((outer (decode-last-text))

+163

(inner (json-decode (dict-ref outer payload: "")))

+164

(rid (dict-ref inner id: #f)))

+165

(node-deliver-text!

+166

(json-encode

+167

(carrier-text-envelope 31

+168

(json-encode #{ t: "ok" id: rid

+169

result: #{ chan: 61 sid: "durable-loss" } })))))

+170

(enclave-node-sys-info! "phone" (lambda (_) #f)

+171

(lambda (error) (set! resource-error error)))

+172

(assert-equal 1 (enclave-node-pending-count))

+173

(node-deliver-disconnect! 1)

+174

(assert-equal "connection lost to phone" resource-error)

+175

(assert-true lost?)

+176

(assert-equal 0 (enclave-node-stream-count))

+177

(assert-equal 0 (enclave-node-pending-count))

+178

(assert-equal 1 (enclave-node-reattach-count))

+179

(session-close handle)

+180

(node-reset!)))))

packages/slate/test/enclave-node-carrier-test.sgladded

@@ -0,0 +1,133 @@

+1

(import (sigil core) (sigil test)

+2

(slate providers enclave-node carrier)

+3

(slate providers node))

+4

+5

(test-group "companion remote carrier adapter"

+6

(test "open completion binds one serialized request and exposes transport"

+7

(let* ((registry (make-carrier-registry))

+8

(seen #f)

+9

(_entry (carrier-open! registry "phone"

+10

(lambda (entry) (set! seen entry))

+11

(lambda (error) #f)))

+12

(ready (carrier-on-control! registry

+13

#{ t: "ev" event: "remote/opened" carrier: 7

+14

request: 2147483648 transport: "direct"

+15

fallback-reason: #f })))

+16

(assert-equal 'ready (dict-ref ready state: #f))

+17

(assert-equal 'direct (dict-ref seen transport: #f))

+18

(assert-equal "phone"

+19

(dict-ref (carrier-find-target registry "phone") target: #f))))

+20

+21

(test "text and binary envelopes preserve opaque node frames"

+22

(let* ((payload (bytevector 2 0 0 0 9 65 66))

+23

(decoded (carrier-frame-decode (carrier-frame-encode 42 payload)))

+24

(text (carrier-text-envelope 42 "{\"t\":\"req\"}")))

+25

(assert-equal 42 (dict-ref decoded carrier: 0))

+26

(assert-equal payload (dict-ref decoded payload: #f))

+27

(assert-equal "remote/text" (dict-ref text t: #f))

+28

(assert-equal "{\"t\":\"req\"}" (dict-ref text payload: #f))))

+29

+30

(test "close removes the carrier before reporting loss"

+31

(let* ((registry (make-carrier-registry))

+32

(removed? #f)

+33

(_entry (carrier-open! registry "phone" (lambda (_) #f)

+34

(lambda (_)

+35

(set! removed?

+36

(not (carrier-ref registry 7)))))))

+37

(carrier-on-control! registry

+38

#{ t: "ev" event: "remote/opened" carrier: 7 request: 2147483648

+39

transport: "relay" })

+40

(carrier-on-control! registry

+41

#{ t: "ev" event: "remote/closed" carrier: 7 })

+42

(assert-true removed?)))

+43

+44

(test "malformed and unmatched events fail closed"

+45

(let ((registry (make-carrier-registry)))

+46

(assert-false

+47

(carrier-on-control! registry

+48

#{ t: "ev" event: "remote/opened" carrier: 0 transport: "direct" }))

+49

(assert-false

+50

(carrier-frame-decode (bytevector #x11 0 0 0 0)))))

+51

+52

(test "ensure coalesces same-target opens and correlates concurrent targets"

+53

(let ((registry (make-carrier-registry))

+54

(sent '()) (phone-ready 0) (laptop-ready 0))

+55

(define (send value) (set! sent (cons value sent)) #t)

+56

(carrier-ensure! registry "phone" send

+57

(lambda (_) (set! phone-ready (+ phone-ready 1))) (lambda (_) #f))

+58

(carrier-ensure! registry "phone" send

+59

(lambda (_) (set! phone-ready (+ phone-ready 1))) (lambda (_) #f))

+60

(carrier-ensure! registry "laptop" send

+61

(lambda (_) (set! laptop-ready (+ laptop-ready 1))) (lambda (_) #f))

+62

(assert-equal 2 (length sent))

+63

(carrier-on-control! registry

+64

#{ t: "ev" event: "remote/opened" carrier: 9 request: 2147483649

+65

transport: "relay" })

+66

(assert-equal 0 phone-ready)

+67

(assert-equal 1 laptop-ready)

+68

(carrier-on-control! registry

+69

#{ t: "ev" event: "remote/opened" carrier: 8 request: 2147483648

+70

transport: "direct" })

+71

(assert-equal 2 phone-ready)))

+72

+73

(test "failed opens correlate by request before a carrier exists"

+74

(let ((registry (make-carrier-registry))

+75

(failure #f))

+76

(carrier-ensure! registry "phone" (lambda (_) #t)

+77

(lambda (_) #f) (lambda (reason) (set! failure reason)))

+78

(carrier-on-control! registry

+79

#{ t: "ev" event: "remote/failed" request: 2147483648

+80

message: "direct and relay unavailable" })

+81

(assert-equal "remote transport unavailable" failure)

+82

(assert-false (carrier-find-target registry "phone"))))

+83

+84

(test "disconnect drains before callbacks and preserves replacement work"

+85

(let ((registry (make-carrier-registry))

+86

(failed 0) (empty-before-callback? #f))

+87

(carrier-ensure! registry "phone" (lambda (_) #t)

+88

(lambda (_) #f)

+89

(lambda (_)

+90

(set! empty-before-callback?

+91

(not (carrier-find-target registry "phone")))

+92

(set! failed (+ failed 1))

+93

(carrier-ensure! registry "replacement" (lambda (_) #t)

+94

(lambda (_) #f) (lambda (_) #f))))

+95

(carrier-disconnect-all! registry "loopback lost")

+96

(assert-true empty-before-callback?)

+97

(assert-equal 1 failed)

+98

(assert-false (carrier-find-target registry "phone"))

+99

(assert-true (carrier-find-target registry "replacement"))))

+100

+101

(test "loopback disconnect ignores stale generations and is idempotent"

+102

(node-reset!)

+103

(node-set-transport!)

+104

(node-set-token! "paired")

+105

(node-deliver-text! "{\"t\":\"hello\",\"instance\":\"local\"}")

+106

(node-deliver-text! "{\"t\":\"auth-ok\",\"grants\":[]}")

+107

(let ((closed 0))

+108

(node-on-remote-disconnect! (lambda (_) (set! closed (+ closed 1))))

+109

(node-deliver-disconnect! 0)

+110

(assert-true (node-ready?))

+111

(node-deliver-disconnect! 1)

+112

(node-deliver-disconnect! 1)

+113

(assert-equal 1 closed)

+114

(assert-false (node-ready?))))

+115

+116

(test "loopback node reserves remote envelopes for the carrier adapter"

+117

(node-reset!)

+118

(node-set-transport!)

+119

(let ((control #f) (binary #f))

+120

(node-on-remote-control! (lambda (message) (set! control message)))

+121

(node-on-remote-binary! (lambda (bytes) (set! binary bytes)))

+122

(node-send-raw-text! (carrier-open-request 2147483648 "phone"))

+123

(node-send-raw-binary!

+124

(carrier-frame-encode 4 (bytevector 3 0 0 0 1 65)))

+125

(node-deliver-text!

+126

"{\"t\":\"ev\",\"event\":\"remote/opened\",\"carrier\":4,\"request\":2147483648,\"transport\":\"direct\"}")

+127

(node-deliver-binary!

+128

(carrier-frame-encode 4 (bytevector 3 0 0 0 1 66)))

+129

(assert-equal "remote/opened" (dict-ref control event: #f))

+130

(assert-equal 4

+131

(dict-ref (carrier-frame-decode binary) carrier: 0))

+132

(assert-equal 1 (length (node-sent-text)))

+133

(assert-equal 1 (length (node-sent-binary))))))

packages/slate/test/enclave-node-kind-test.sglmodified

@@ -31,6 +31,14 @@

31

(sigil string)

32

(slate providers enclave-node))

33

+34

(test-group "remote root home discovery barrier"

+35

(test "offline registration cannot settle an online home request"

+36

(assert-equal 1 (discovery-pending-after-registration 1 #f)))

+37

(test "an online home reply settles exactly one request"

+38

(assert-equal 1 (discovery-pending-after-registration 2 #t)))

+39

(test "a duplicate completion cannot underflow the barrier"

+40

(assert-equal 0 (discovery-pending-after-registration 0 #t))))

+41

42

;; ============================================================

43

;; 1. The lowering: source keyword -> wire string

44

;; ============================================================

@@ -100,9 +108,17 @@

108

(assert-equal 200 (dict-ref a cols: #f))

109

(assert-equal 60 (dict-ref a rows: #f))))

110

+111

(test "a remote terminal preserves its selected working directory"

+112

(assert-equal "/Users/daviwil"

+113

(dict-ref

+114

(session-open-args

+115

#{ kind: pty: argv: (list "bash" "-l") cwd: "/Users/daviwil" })

+116

cwd: #f)))

+117

118

(test "defaults apply per-field when the source omits them"

119

(let ((a (session-open-args #{ kind: pty: })))

120

(assert-equal (list "bash" "-l") (dict-ref a argv: #f))

+121

(assert-false (dict-ref a cwd: #f))

122

(assert-equal 80 (dict-ref a cols: #f))

123

(assert-equal 24 (dict-ref a rows: #f)))))

124

packages/slate/test/enclave-node-reattach-tick-test.sglmodified

@@ -157,11 +157,14 @@

157

;; with slot 10 hardwired `#f`, a future re-MEANING of that slot (say to

158

;; `not-mine?`) would invert what every arm tests and stay green. The

159

;; "REFUSALS" group below drives both.

−160

(define (make-lost-stream!* ctx sid mine?)

+160

(define (make-lost-stream!* ctx sid mine? . carrier?)

161

(let* ((state (vector sid #f))

162

(cb #{ source: test-source ctx: ctx state: state })

−163

(st (vector 'no-socket "ticket" #t 7 cb #f '() state

−164

"session/open" sid mine? #f)))

+163

(st (if (and (pair? carrier?) (car carrier?))

+164

(vector 'no-socket "ticket" #t 7 cb #f '() state

+165

"session/open" sid mine? #f 'carrier 41)

+166

(vector 'no-socket "ticket" #t 7 cb #f '() state

+167

"session/open" sid mine? #f))))

168

(vector-set! state 1 st)

169

st))

170

@@ -321,6 +324,31 @@

324

(assert-equal 0 (stream-opens-sent))

325

(assert-true (field=? (only-entry) "attempts" "0")))))

326

+327

(test-group "a replacement companion preserves the session's principal"

+328

(test "a carrier-backed loss never falls through to the account relay"

+329

;; A durable sid is scoped to the node principal that opened its holder.

+330

;; The account relay may be healthy while the companion restarts, but it is

+331

;; not an equivalent acquisition path: issuing there changes the principal

+332

;; and produces `no-session` against a surviving direct holder.

+333

(fresh-armed-entry!)

+334

(reach-ready!)

+335

(let ((carrier-st (make-lost-stream!* *session-ctx* node-sid #f #t)))

+336

(notify-stream-lost! carrier-st)

+337

(enclave-node-tick! t0)

+338

(enclave-node-tick! (+ t0 floor-ms))

+339

(assert-equal 0 (stream-opens-sent))

+340

(assert-true (field=? (only-entry) "attempts" "0"))

+341

(assert-true (field=? (only-entry) "next-at-ms"

+342

(number->string (+ t0 (* 2 floor-ms)))))

+343

(enclave-node-tick! (+ t0 (* 2 floor-ms)))

+344

(assert-equal 0 (stream-opens-sent))

+345

(assert-true (field=? (only-entry) "attempts" "0"))

+346

(assert-true (field=? (only-entry) "next-at-ms"

+347

(number->string (+ t0 (* 3 floor-ms)))))

+348

(enclave-node-tick! (+ t0 (* 10 floor-ms)))

+349

(assert-equal 0 (stream-opens-sent))

+350

(assert-true (field=? (only-entry) "attempts" "0")))))

+351

352

(test-group "the shell's bounds, through the tick rather than through the decision"

353

(test "AN OUTSTANDING ATTACH IS NOT RE-ISSUED while its RPC is still alive"

354

;; `in-flight?:` is the bound that makes "no duplicates" true. It is SET by

@@ -516,6 +544,20 @@

544

;; unexercised, and a future RE-MEANING of slot 10 (say to `not-mine?`) would

545

;; invert what the whole file tests while staying green.

546

+547

(test "a superseded stream cannot overwrite a successful reattach with lost"

+548

(fresh-armed-entry!)

+549

(reach-ready!)

+550

(let* ((lost-events 0)

+551

(ctx #{ lost: (lambda (at) (set! lost-events (+ lost-events 1))) })

+552

(old (make-lost-stream! ctx))

+553

(state (vector-ref old 7)))

+554

;; Model the field ordering: a successful attach installs its replacement

+555

;; first, then the old carrier reports its delayed close.

+556

(vector-set! state 1 'replacement-stream)

+557

(notify-stream-lost! old)

+558

(assert-equal 0 lost-events)

+559

(assert-equal 0 (enclave-node-reattach-count))))

+560

561

(test "A STREAM WE CLOSED OURSELVES ARMS NOTHING — slot 10 driven as #t"

562

;; `session-detach!`'s ok path closes its own socket, after which the pump

563

;; lands here. Arming would re-attach exactly what the caller asked to

packages/slate/test/enclave-remote-live.sglmodified

@@ -8,6 +8,7 @@

8

9

(import (sigil core) (sigil io) (sigil process) (sigil string) (sigil time) (sigil async) (sigil test)

10

(slate provider) (slate enclave-account session)

+11

(slate providers node) (slate providers enclave-node resource)

12

(slate providers enclave-node))

13

14

(define endpoint (getenv "P3S_ENCLAVE_WS"))

@@ -16,6 +17,7 @@

17

(define node-name (getenv "P3S_NODE"))

18

(define readable-path (getenv "P3S_READABLE_PATH"))

19

(define denied-path (getenv "P3S_DENIED_PATH"))

+20

(define image-path (getenv "P3S_IMAGE_PATH"))

21

(define pty-marker (getenv "P3S_PTY_MARKER"))

22

(define session-sentinel (getenv "P3T_SESSION_SENTINEL"))

23

@@ -73,6 +75,26 @@

75

(unless (and (string? file-text) (string-contains? file-text "p3s-readable-marker"))

76

(error "remote file returned the wrong content" file-value))

77

+78

;; No local companion: the image must bypass the account RPC payload limit.

+79

(assert-false (node-ready?))

+80

(define image-result #f)

+81

(define image-error #f)

+82

((dict-ref (provider-ref node:) image-url:)

+83

#{ provider: node: kind: file: host: node-name address: image-path }

+84

(lambda (url) (set! image-result url))

+85

(lambda (reason) (set! image-error reason)))

+86

(pump-until "large image uses the real binary relay without a companion"

+87

(lambda () (or image-error (node-blob-waiting?))) 3000)

+88

(when image-error (error "remote image failed" image-error))

+89

(let ((token (node-blob-poll)))

+90

(assert-equal 1600000 (bytevector-length (node-blob-bytes)))

+91

(assert-equal 137 (bytevector-u8-ref (node-blob-bytes) 0))

+92

(assert-equal 0 (bytevector-u8-ref (node-blob-bytes) 1599999))

+93

(assert-equal "image/png" (node-blob-mime))

+94

(node-blob-ready token "blob:live-image"))

+95

(assert-equal "blob:live-image" image-result)

+96

(assert-equal 0 (enclave-resource-count))

+97

98

(set! failure #f)

99

(let* ((source #{ provider: node: kind: file: host: node-name address: denied-path })

100

(op (provider-async-op source)))

packages/slate/test/findfile-test.sglmodified

@@ -13,7 +13,27 @@

13

14

(import (sigil core)

15

(sigil test)

−16

(slate findfile))

+16

(slate findfile)

+17

(slate provider)

+18

(slate root))

+19

+20

;; A source on a multi-machine provider must keep the root that carries its

+21

;; routing host. Returning only `node:` sends the initial find-file read to an

+22

;; empty hostname; selecting the same root manually then appears to fix it.

+23

(test "source-fs-provider preserves the matching remote root and host context"

+24

(register-provider! ff-shared-node: #{})

+25

(register-root-silent! ff-cereal:

+26

#{ provider: ff-shared-node: host: "cereal" class: machine: })

+27

(register-root-silent! ff-nynex:

+28

#{ provider: ff-shared-node: host: "nynex" class: machine: })

+29

(let ((actual

+30

(source-fs-provider

+31

#{ provider: ff-shared-node: host: "cereal" kind: dir:

+32

address: "/Users/daviwil" }

+33

browser:)))

+34

(unregister-root! ff-cereal:)

+35

(unregister-root! ff-nynex:)

+36

(assert-equal ff-cereal: actual)))

37

38

;; ---- the completion boundary ---------------------------------------------

39

;; findfile-dir answers "which directory is this query completing in": everything

@@ -174,7 +194,7 @@

194

(let loop ((i 0) (acc '()))

195

(if (< i 10000)

196

(loop (+ i 1) (cons i acc))

−177

(assert-equal (length (take-at-most 200 acc)) 200))))

+197

(assert-equal (length (take-at-most 50 acc)) 50))))

198

199

;; ---- the listing cache ----------------------------------------------------

200

;; Driven over a FAKE read that counts calls and defers delivery, so the same code

@@ -202,6 +222,20 @@

222

(define (cache-entries cache key reader)

223

((dict-ref cache entries:) key (dict-ref reader read!:)))

224

+225

(test "listing cache reuses derived rows per directory and resets them together"

+226

(let ((cache (make-listing-cache (lambda () #t))) (builds 0))

+227

(define (rows)

+228

((dict-ref cache rows:) "local:/work/|all"

+229

(lambda ()

+230

(set! builds (+ builds 1))

+231

(list (entry "a.sgl" file:)))))

+232

(rows)

+233

(rows)

+234

(assert-equal builds 1)

+235

((dict-ref cache reset!:))

+236

(rows)

+237

(assert-equal builds 2)))

+238

239

(test "listing cache: a miss reports 'loading and kicks off exactly one read"

240

(let* ((cache (make-listing-cache (lambda () #t)))

241

(r (make-fake-reader)))

packages/slate/test/folder-command-test.sglmodified

@@ -1,6 +1,7 @@

1

(import (sigil core) (sigil test) (slate command) (slate commands folder)

−2

(slate foldernav) (slate pane) (slate providers slate-meta)

−3

(slate space) (slate view))

+2

(slate modes folder) (slate pane) (slate provider) (slate root)

+3

(slate foldernav) (slate providers slate-meta)

+4

(slate space) (slate state) (slate view))

5

(test "the complete folder family resolves from one module"

6

(for-each (lambda (event)

7

(assert-equal (command-module (command-resolve event)) '(slate commands folder)))

@@ -19,6 +20,84 @@

20

slate/spaces: (list (make-space "main" (make-leaf 0 "plain") 0 1))

21

slate/active-space: "main" }))

22

(assert-equal (command-run state "folder-open") state)))

+23

(register-provider! folder-fixture:

+24

#{ materialize: (lambda (source) (list #{ name: "child" kind: dir: })) })

+25

(define (fixture-folder address)

+26

(let ((source #{ provider: folder-fixture: kind: dir: address: address }))

+27

(make-folder-view (source-root-display-name source) source)))

+28

(define (fixture-state folder)

+29

#{ slate/views: (list folder)

+30

slate/spaces: (list (make-space "main" (make-leaf 0 (view-name folder)) 0 1))

+31

slate/active-space: "main" })

+32

(define (fixture-open-source state source)

+33

(ensure-view state (source-root-display-name source)

+34

(lambda () (make-folder-view (source-root-display-name source) source))))

+35

(define (configure-fixture!)

+36

(configure-folder-commands!

+37

#{ open-source: fixture-open-source

+38

prefix-arg?: (lambda (state) #f)

+39

same-source-place?: (lambda (a b) #t) }))

+40

+41

(test "folder descent reuses the current view and parent navigation returns"

+42

(configure-fixture!)

+43

(let* ((origin (folder-toggle-preview (fixture-folder "/from")))

+44

(next (command-run (fixture-state origin) "folder-open"))

+45

(parent (command-run next "folder-parent")))

+46

(assert-equal (folder-address (active-view next)) "/from/child")

+47

(assert-true (dict-ref (active-view next) slate/folder-preview?: #f))

+48

(assert-equal (length (views next)) 1)

+49

(assert-equal (folder-address (active-view parent)) "/from")

+50

(assert-true (dict-ref (active-view parent) slate/folder-preview?: #f))

+51

(assert-equal (length (views parent)) 1)))

+52

+53

(test "folder reuse preserves explicit keep and views displayed in another pane"

+54

(configure-fixture!)

+55

(let* ((origin (fixture-folder "/from"))

+56

(state (fixture-state origin))

+57

(source #{ provider: folder-fixture: kind: dir: address: "/to" })

+58

(kept (open-folder-reusing state origin source #t))

+59

(split (update-active-space state (lambda (space) (space-split space 'row))))

+60

(reused (open-folder-reusing split origin source #f)))

+61

(assert-equal (length (views kept)) 2)

+62

(assert-equal (length (views reused)) 2)

+63

(assert-equal (folder-address (active-view reused)) "/to")

+64

(assert-true (find-view (views reused) (view-name origin)))))

+65

+66

(test "folder parent at the root opens the root directory listing"

+67

(let ((target #f) (origin (fixture-folder "/")))

+68

(configure-folder-commands!

+69

#{ prefix-arg?: (lambda (state) #f)

+70

open-source: (lambda (state source) (set! target source) state) })

+71

(command-run (fixture-state origin) "folder-parent")

+72

(assert-equal (dict-ref target provider:) slate:)

+73

(assert-equal (dict-ref target address:) "/roots")))

+74

+75

(test "folder copy and rename prompts use the other pane without mutating files"

+76

(configure-fixture!)

+77

(let* ((origin (fixture-folder "/from"))

+78

(other (fixture-folder "/to"))

+79

(state #{ slate/views: (list origin other)

+80

slate/spaces:

+81

(list (make-space "main"

+82

(make-split 'row (make-leaf 0 (view-name origin))

+83

(make-leaf 1 (view-name other))) 0 2))

+84

slate/active-space: "main" }))

+85

(for-each

+86

(lambda (event)

+87

(let ((next (command-run state event)))

+88

(assert-equal (dict-ref next slate/minibuffer:) "folder-input")

+89

(assert-equal (dict-ref next slate/selector-query:) "/to/child")

+90

(assert-equal (views next) (views state))))

+91

(list "folder-copy" "folder-rename"))))

+92

+93

(test "closing a folder returns to the remaining view"

+94

(let* ((origin (fixture-folder "/from"))

+95

(plain (view slate/name: "plain"))

+96

(state (dict-set (fixture-state origin) slate/views: (list plain origin)))

+97

(next (command-run state "folder-quit")))

+98

(assert-equal (views next) (list plain))

+99

(assert-equal (view-name (active-view next)) "plain")))

+100

(configure-folder-commands! #{})

101

(test "open-folder reaches the shared filesystem candidate layer without an unbound call"

102

(let* ((plain (view slate/name: "plain"))

103

(state #{ slate/views: (list plain)

packages/slate/test/folder-display-test.sglmodified

@@ -136,11 +136,11 @@

136

(v2 (folder-mark v1))

137

(v3 (folder-unmark (folder-set-point v2 0)))

138

(v4 (folder-toggle-marks v3)))

−139

(assert-equal (folder-marks v1) (list "one.txt"))

+139

(assert-equal (folder-marks v1) (list "three"))

140

(assert-equal (folder-point v1) 1)

−141

(assert-equal (folder-marks v2) (list "one.txt" "two.txt"))

+141

(assert-equal (folder-marks v2) (list "three" "one.txt"))

142

(assert-equal (folder-point v2) 2)

−143

(assert-equal (folder-marks v3) (list "two.txt"))

+143

(assert-equal (folder-marks v3) (list "one.txt"))

144

(assert-equal (folder-point v3) 1)

−145

(assert-equal (folder-marks v4) (list "one.txt" "three"))

+145

(assert-equal (folder-marks v4) (list "two.txt" "three"))

146

(assert-equal (folder-marks (folder-clear-marks v4)) '())))

packages/slate/test/folder-image-relay-browser-live.mjsadded

@@ -0,0 +1,158 @@

+1

// Isolated real Enclave + built node + compiled browser image test.

+2

// Run with OpenSSL on PATH (guix shell openssl -- node <this-file>), or OPENSSL.

+3

// SLATE_IMAGE_FIXTURE selects a local PNG; the default uses generated test bytes.

+4

// SLATE_SHORT_WRITE_LIBRARY points at the compiled sigil-websocket test

+5

// instrument test/integration/short-socket-writes.c (Linux only).

+6

import fs from 'node:fs';

+7

import os from 'node:os';

+8

import path from 'node:path';

+9

import net from 'node:net';

+10

import tls from 'node:tls';

+11

import crypto from 'node:crypto';

+12

import {spawn, spawnSync} from 'node:child_process';

+13

+14

const root = path.resolve(import.meta.dirname, '../../..');

+15

const enclave = process.env.ENCLAVE_BIN || path.resolve(root, '../enclave/build/dev/bin/enclave');

+16

const node = path.resolve(process.env.SLATE_BIN || path.join(root, 'build/node-release/bin/slate'));

+17

const dir = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-image-relay-'));

+18

const children = [];

+19

const relaySockets = new Set();

+20

let tlsRelay;

+21

const secrets = [];

+22

const redact = text => secrets.reduce((s, secret) => s.split(secret).join('[redacted]'), text);

+23

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+24

const port = () => new Promise(resolve => {

+25

const s = net.createServer();

+26

s.listen(0, '127.0.0.1', () => { const p = s.address().port; s.close(() => resolve(p)); });

+27

});

+28

function start(executable, args, env) {

+29

  const child = spawn(executable, args, {cwd:root, env:{...process.env, ...env}, detached:true, stdio:['ignore','pipe','pipe']});

+30

child.output = '';

+31

child.stdout.on('data', data => { child.output += data; });

+32

child.stderr.on('data', data => { child.output += data; });

+33

  child.done = new Promise(resolve => { child.once('exit', resolve); child.once('error', e => { child.output += e.message; resolve(-1); }); });

+34

children.push(child);

+35

return child;

+36

}

+37

async function ready(child, marker) {

+38

for(let i=0;i<600;i++) {

+39

    const output = child.output + (child.logFile && fs.existsSync(child.logFile) ? fs.readFileSync(child.logFile,'utf8') : '');

+40

if(new RegExp(marker).test(output)) return;

+41

if(child.exitCode !== null) break;

+42

await sleep(100);

+43

}

+44

throw Error('Service failed to become ready: '+redact(child.output));

+45

}

+46

try {

+47

const irc = await port(), ws = await port();

+48

const state = path.join(dir,'state'), db = path.join(dir,'enclave.db');

+49

fs.mkdirSync(path.join(state,'slate'), {recursive:true, mode:0o700});

+50

const credential = crypto.randomBytes(32).toString('hex');

+51

secrets.push(credential);

+52

const run = args => {

+53

const r = spawnSync(enclave,args,{env:{...process.env,ENCLAVE_DB_PATH:db},encoding:'utf8'});

+54

if(r.status !== 0) throw Error('Enclave setup failed: '+redact(r.stderr));

+55

return r.stdout;

+56

};

+57

run(['user','add','gate-owner','--password',credential]);

+58

const registration = run(['bot','register','gate-node','--owner','gate-owner']);

+59

const token = registration.match(/Token $one-time display$: ([0-9a-f]{64})/)?.[1];

+60

if(!token) throw Error('Node registration did not return a token');

+61

secrets.push(token);

+62

const image = path.join(dir,'preview.png');

+63

const bytes = process.env.SLATE_IMAGE_FIXTURE

+64

? fs.readFileSync(process.env.SLATE_IMAGE_FIXTURE) : crypto.randomBytes(1600000);

+65

if(!process.env.SLATE_IMAGE_FIXTURE)

+66

    Buffer.from('iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAQAAAC1HAwCAAAAC0lEQVR42mP8/x8AAwMCAO+a4HcAAAAASUVORK5CYII=','base64').copy(bytes);

+67

if(bytes.subarray(0,8).toString('hex') !== '89504e470d0a1a0a') throw Error('Image fixture must be PNG');

+68

fs.writeFileSync(image,bytes);

+69

  const server = start(enclave,['dev'],{ENCLAVE_DB_PATH:db,ENCLAVE_PORT:String(irc),ENCLAVE_WS_PORT:String(ws),ENCLAVE_LOG_LEVEL:'info'});

+70

await ready(server,'WebSocket listening|ws-listener-ready');

+71

// Exercise the node's deployed WSS path. Plain loopback WS cannot catch

+72

// TLS buffering, partial writes, or binary corruption in encrypted reads.

+73

const certificate = path.join(dir,'cert.pem');

+74

const key = path.join(dir,'key.pem');

+75

const certResult = spawnSync(process.env.OPENSSL || 'openssl',['req','-x509','-newkey','rsa:2048','-nodes',

+76

'-keyout',key,'-out',certificate,'-days','1','-subj','/CN=localhost',

+77

'-addext','subjectAltName=IP:127.0.0.1,DNS:localhost'],{stdio:'ignore'});

+78

if(certResult.status !== 0) throw Error('Could not create the isolated TLS certificate');

+79

tlsRelay = tls.createServer({key:fs.readFileSync(key),cert:fs.readFileSync(certificate)}, socket => {

+80

const upstream = net.connect(ws,'127.0.0.1');

+81

for(const peer of [socket,upstream]) {

+82

relaySockets.add(peer);

+83

peer.on('close',()=>relaySockets.delete(peer));

+84

peer.on('error',()=>{socket.destroy();upstream.destroy();});

+85

}

+86

socket.pipe(upstream).pipe(socket);

+87

});

+88

tlsRelay.on('tlsClientError', error => console.log('Test TLS handshake: '+error.message));

+89

await new Promise(resolve=>tlsRelay.listen(0,'127.0.0.1',resolve));

+90

const securePort = tlsRelay.address().port;

+91

  fs.writeFileSync(path.join(state,'slate','enclave-node.json'),JSON.stringify({version:1,origin:`https://localhost:${securePort}`,'websocket-url':`wss://localhost:${securePort}/ws`,'node-name':'gate-node','bot-id':'1',token}),{mode:0o600});

+92

const logFile = path.join(dir,'node.log');

+93

const shortWriteLog = path.join(dir,'short-writes.log');

+94

const daemon = start(node,['node','run','--app-upstream','','--log-level','debug','--log',logFile],{

+95

XDG_STATE_HOME:state, SLATE_NODE_GRANTS:`fs:ro:${image},pty:on,exec:full`,

+96

// The test certificate is private to this disposable loopback relay.

+97

// sigil-tls currently prefers system roots over SSL_CERT_FILE.

+98

SLATE_MAX_HOLDERS:'1', SIGIL_LOG_LEVEL:'debug', SIGIL_TLS_INSECURE:'1',

+99

...(process.env.SLATE_SHORT_WRITE_LIBRARY ? {

+100

LD_PRELOAD:path.resolve(process.env.SLATE_SHORT_WRITE_LIBRARY),

+101

SIGIL_SHORT_WRITE_LOG:shortWriteLog

+102

} : {})

+103

});

+104

daemon.logFile = logFile;

+105

await ready(daemon,'Slate node connected to Enclave as gate-node|enclave session ready');

+106

console.log('Isolated Enclave and node are ready; starting browser regression');

+107

  const browser = start(process.execPath,[process.env.SLATE_BROWSER_GATE || 'packages/slate/test/folder-redesign-browser-gate.mjs'],{

+108

    P3S_ENCLAVE_WS:`ws://127.0.0.1:${ws}/ws`,P3S_ACCOUNT:'gate-owner',P3S_CREDENTIAL:credential,P3S_NODE:'gate-node',P3S_IMAGE_PATH:image,

+109

P3S_STATE_DIR:path.join(state,'slate'), P3S_IMAGE_SIZE:String(bytes.length),

+110

P3S_IMAGE_WIDTH:String(bytes.readUInt32BE(16)),

+111

P3S_IMAGE_SHA256:crypto.createHash('sha256').update(bytes).digest('hex'),

+112

P3S_IMAGE_WAKE_DELAY_MS:process.env.P3S_IMAGE_WAKE_DELAY_MS || '100'

+113

});

+114

browser.stdout.on('data', data => process.stdout.write(redact(String(data))));

+115

let deadline;

+116

const result = await Promise.race([

+117

browser.done,

+118

new Promise(resolve => { deadline = setTimeout(() => resolve('timeout'),300000); })

+119

]);

+120

clearTimeout(deadline);

+121

let nodeLogs = daemon.output;

+122

for(const name of fs.readdirSync(dir).filter(name => name.startsWith('node.log')))

+123

nodeLogs += fs.readFileSync(path.join(dir,name),'utf8');

+124

  if(result !== 0) throw Error('Live browser gate failed: '+result+'\n'+redact(browser.output)+'\n'+redact(nodeLogs)+'\n'+redact(server.output.split('\n').filter(line => /remote-rpc|stream|disconnect|closing|ERROR|WARN/.test(line)).slice(-60).join('\n')));

+125

if(!/max holders reached/.test(nodeLogs))

+126

throw Error('The regression did not exercise an exhausted holder quota');

+127

if(process.env.SLATE_SHORT_WRITE_LIBRARY) {

+128

const counts = fs.readFileSync(shortWriteLog,'utf8').trim().split('\n')

+129

.map(line=>line.split(' ').map(Number));

+130

const short = counts.reduce((n,row)=>n+row[1],0);

+131

const blocked = counts.reduce((n,row)=>n+row[2],0);

+132

if(!(short > 0 && blocked > 0))

+133

throw Error('The regression did not force short writes and EAGAIN');

+134

console.log(`PASS TLS backpressure: ${short} short writes, ${blocked} would-block responses`);

+135

}

+136

} catch(error) {

+137

console.error(redact(error.message));

+138

process.exitCode = 1;

+139

} finally {

+140

for(const child of children.reverse()) {

+141

try { process.kill(-child.pid,'SIGTERM'); } catch {}

+142

await Promise.race([child.done,sleep(1000)]);

+143

try { process.kill(-child.pid,'SIGKILL'); } catch {}

+144

}

+145

for(const socket of relaySockets) socket.destroy();

+146

if(tlsRelay) await new Promise(resolve=>tlsRelay.close(resolve));

+147

// Terminal owners deliberately survive their node's process group. Only

+148

// retire owners whose argv names this test's unique private state directory.

+149

for(const entry of fs.readdirSync('/proc').filter(name => /^\d+$/.test(name))) {

+150

try {

+151

if(fs.readFileSync(`/proc/${entry}/comm`,'utf8').trim() !== path.basename(node)) continue;

+152

const args = fs.readFileSync(`/proc/${entry}/cmdline`,'utf8').split('\0');

+153

if(args.includes('_terminal-owner') && args.includes(path.join(dir,'state/slate')))

+154

process.kill(-Number(entry),'SIGTERM');

+155

} catch { /* Processes may exit while inspecting this test's owners. */ }

+156

}

+157

fs.rmSync(dir,{recursive:true,force:true});

+158

}

packages/slate/test/folder-redesign-browser-gate.mjsadded

@@ -0,0 +1,462 @@

+1

// Drive the folder redesign through the shipped WASM and real browser events.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import http from 'node:http';

+5

import os from 'node:os';

+6

import path from 'node:path';

+7

import { spawn } from 'node:child_process';

+8

+9

const root = path.resolve(import.meta.dirname, '../../..');

+10

const webRoot = path.resolve(process.env.SLATE_WEB_ROOT || path.join(root, 'build/web'));

+11

assert.ok(fs.existsSync(path.join(webRoot, 'slate.wasm')), 'build/web/slate.wasm is required');

+12

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+13

const types = { '.html': 'text/html', '.js': 'text/javascript', '.mjs': 'text/javascript',

+14

'.wasm': 'application/wasm', '.json': 'application/json', '.svg': 'image/svg+xml',

+15

'.woff2': 'font/woff2' };

+16

const server = http.createServer((req, res) => {

+17

const relative = req.url.split('?')[0] === '/' ? 'index.html' : req.url.split('?')[0].slice(1);

+18

const target = path.resolve(webRoot, relative);

+19

if (!target.startsWith(webRoot + path.sep) || !fs.existsSync(target)) {

+20

res.writeHead(404).end(); return;

+21

}

+22

res.setHeader('content-type', types[path.extname(target)] || 'application/octet-stream');

+23

fs.createReadStream(target).pipe(res);

+24

});

+25

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+26

+27

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-folder-redesign-chrome-'));

+28

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+29

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+30

{ stdio: ['ignore', 'ignore', 'pipe'] });

+31

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+32

let socket;

+33

const errors = [];

+34

const consoleMessages = [];

+35

try {

+36

const activePort = path.join(profile, 'DevToolsActivePort');

+37

for (let i = 0; i < 120 && !fs.existsSync(activePort); i++) await sleep(50);

+38

assert.ok(fs.existsSync(activePort), 'Chrome did not expose DevTools');

+39

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+40

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+41

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+42

let nextId = 0;

+43

const pending = new Map();

+44

socket.onmessage = event => {

+45

const message = JSON.parse(event.data);

+46

if (message.method === 'Runtime.exceptionThrown')

+47

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+48

if (message.method === 'Runtime.consoleAPICalled')

+49

consoleMessages.push(message.params.args.map(arg => arg.value ?? arg.description).join(' '));

+50

if (message.method === 'Log.entryAdded')

+51

consoleMessages.push(message.params.entry.text);

+52

if (message.id && pending.has(message.id)) {

+53

const pair = pending.get(message.id); pending.delete(message.id);

+54

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

+55

}

+56

};

+57

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+58

const id = ++nextId; pending.set(id, { resolve, reject });

+59

socket.send(JSON.stringify({ id, method, params, ...(sessionId ? { sessionId } : {}) }));

+60

});

+61

const target = await send('Target.createTarget', { url: 'about:blank' });

+62

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+63

const session = attached.sessionId;

+64

await send('Runtime.enable', {}, session);

+65

await send('Log.enable', {}, session);

+66

await send('Emulation.setEmulatedMedia', {features:[{name:'prefers-color-scheme',value:'dark'}]}, session);

+67

  await send('Page.navigate', { url: `http://127.0.0.1:${server.address().port}/?rbdebug&folder-redesign-gate` }, session);

+68

const evaluate = async expression => {

+69

const result = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, session);

+70

    if (result.exceptionDetails) throw new Error(result.exceptionDetails.exception?.description || result.exceptionDetails.text);

+71

return result.result.value;

+72

};

+73

async function waitFor(expression, label, timeoutMs = 36000) {

+74

for (let i = 0; i < Math.ceil(timeoutMs / 100); i++) {

+75

if (await evaluate(expression)) return;

+76

await sleep(100);

+77

}

+78

const status = await evaluate('document.getElementById("status")?.textContent');

+79

const preview = await evaluate('document.querySelector(".folder-preview")?.textContent');

+80

    throw new Error(`timeout waiting for ${label}; status=${status}; preview=${preview}; errors=${errors.join(' | ')}; console=${consoleMessages.slice(-10).join(' | ')}`);

+81

}

+82

  const sgl = code => evaluate('(() => { const result = window.slateEval(' + JSON.stringify(code) + '); window.slateAfterRender(); return result; })()');

+83

const dispatch = event => sgl('(slate-dispatch "' + event + '")');

+84

const readCount = () => sgl('(number->string (length folder-gate-reads))').then(Number);

+85

+86

await waitFor(`document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+87

await waitFor('window.__slateUnveilReason !== undefined', 'initial workspace restoration');

+88

await waitFor(`window.slateEval('(slate-preferences-settled?)') === '1'`, 'startup preferences');

+89

const now = Math.floor(Date.now()/1000);

+90

await send('Emulation.setDeviceMetricsOverride', {width:1440,height:1000,deviceScaleFactor:1,mobile:false}, session);

+91

await sgl('(import (slate provider) (slate root) (slate command) (slate state) (slate modes folder))');

+92

await sgl('(define folder-gate-reads (list))');

+93

await sgl('(define folder-gate-git (list))');

+94

await sgl('(define folder-gate-images (list))');

+95

await sgl('(define folder-gate-released (list))');

+96

await sgl(`(register-provider! folder-gate:

+97

#{ materialize: (lambda (source) (if (eq? (dict-ref source kind: file:) dir:) (list) ""))

+98

image-url: (lambda (source ok error)

+99

(set! folder-gate-images (append folder-gate-images (list ok))))

+100

image-release: (lambda (source url)

+101

(set! folder-gate-released (cons url folder-gate-released)))

+102

materialize-async: (lambda (source ok error)

+103

(set! folder-gate-reads (append folder-gate-reads (list (cons source ok)))))

+104

git-request: (lambda (source verb args ok error)

+105

(set! folder-gate-git (append folder-gate-git (list (list verb args ok))))) })`);

+106

  await sgl('(register-root! folder-gate: #{ provider: folder-gate: class: local: home: "/repo" host: "slate-node-opaque" label: "zerocool" })');

+107

await dispatch('openroot:folder-gate');

+108

assert.equal(await sgl('(number->string (length folder-gate-git))'), '0', 'Git waits for listing');

+109

await sgl(`((cdr (car folder-gate-reads))

+110

(list #{ name: "src" kind: dir: mtime: ${now-300} }

+111

#{ name: "alpha.sgl" kind: file: size: 20 mtime: ${now-120} }

+112

#{ name: "beta.sgl" kind: file: size: 15 mtime: ${now-60} }

+113

#{ name: ".hidden" kind: file: size: 2 mtime: ${now-600} }))`);

+114

await waitFor('document.querySelectorAll(".folder-row").length === 3', 'directory listing');

+115

assert.equal(await sgl('(number->string (length folder-gate-git))'), '1');

+116

assert.equal(await evaluate('document.querySelector(".folder-host").textContent'), 'zerocool');

+117

assert.equal(await evaluate('Boolean(document.querySelector(".folder-preview"))'), false, 'preview defaults off');

+118

await dispatch('folder-select-index:1');

+119

await dispatch('folder-mark-index:2');

+120

await evaluate('window.folderGateRow=document.querySelector(".folder-row.selected");');

+121

await sgl(`((caddr (car folder-gate-git))

+122

#{ version: 1 node-repo: #{ worktree: "/repo" common-dir: "/repo/.git" } })`);

+123

await sgl(`((caddr (cadr folder-gate-git))

+124

#{ version: 1 repo: (dict-ref (cadr (cadr folder-gate-git)) repo:)

+125

snapshot: #{ head-oid: "abc" index-id: "i" worktree-id: "w" }

+126

entries: (list #{ path: "alpha.sgl" kind: "ordinary" index-state: "." worktree-state: "M" }) })`);

+127

assert.equal(await evaluate('document.querySelector(".folder-row.selected")===window.folderGateRow'),true,

+128

    'Git retains the keyed row: '+JSON.stringify(await evaluate('({before:window.folderGateRow?.outerHTML,after:document.querySelector(".folder-row.selected")?.outerHTML,body:document.getElementById("app")?.textContent})'))+'; console='+consoleMessages.slice(-10).join(' | '));

+129

assert.equal(await evaluate('document.querySelector(".folder-row.selected .folder-git")?.textContent'),'M',

+130

    'Git marker: '+await evaluate('document.getElementById("app").textContent')+'; '+consoleMessages.slice(-10).join(' | '));

+131

await dispatch('folder-preview');

+132

assert.equal(await readCount(), 1, 'no immediate preview read');

+133

await waitFor(`window.slateEval('(number->string (length folder-gate-reads))') === '2'`, 'delayed preview read');

+134

await sgl('((cdr (cadr folder-gate-reads)) "(define alpha 42)\n")');

+135

  await waitFor('document.querySelector(".folder-preview-content")?.textContent.includes("define alpha")', 'preview content');

+136

const pressPreviewKey = async () => {

+137

await send('Input.dispatchKeyEvent', {type:'keyDown',key:'P',code:'KeyP',modifiers:8,text:'P'}, session);

+138

await send('Input.dispatchKeyEvent', {type:'keyUp',key:'P',code:'KeyP',modifiers:8}, session);

+139

};

+140

await pressPreviewKey();

+141

assert.equal(await evaluate('document.querySelector(".folder-preview")'),null,'capital P closes preview');

+142

await pressPreviewKey();

+143

assert.equal(await evaluate('Boolean(document.querySelector(".folder-preview"))'),true,'capital P opens preview');

+144

await waitFor(`window.slateEval('(number->string (length folder-gate-reads))') === '3'`, 'reopened preview read');

+145

await sgl('((cdr (car (reverse folder-gate-reads))) "(define alpha 42)")');

+146

  assert.equal(await evaluate('document.querySelector(".view.folder .acc-row, .view.folder .command-strip, .folder-preview .preview-open")'),null);

+147

await dispatch('folder-copy');

+148

await sgl(`(install-builtin-command! "folder-gate-prompt" "Prompt state" "Test fixture"

+149

'(test folder) (lambda (state) (with-echo state (dict-ref state slate/minibuffer: ""))))`);

+150

assert.equal(await dispatch('folder-gate-prompt'),'folder-input');

+151

await dispatch('selector-escape');

+152

await dispatch('folder-rename');

+153

assert.equal(await dispatch('folder-gate-prompt'),'folder-input');

+154

await dispatch('selector-escape');

+155

await dispatch('folder-sort-newest');

+156

  assert.equal(await evaluate('[...document.querySelectorAll(".folder-name")].map(n=>n.textContent).join(",")'),'src/,beta.sgl,alpha.sgl');

+157

await dispatch('folder-sort-oldest');

+158

  assert.equal(await evaluate('[...document.querySelectorAll(".folder-name")].map(n=>n.textContent).join(",")'),'src/,alpha.sgl,beta.sgl');

+159

await dispatch('folder-hidden');

+160

assert.equal(await evaluate('document.querySelectorAll(".folder-row").length'),4);

+161

await dispatch('folder-hidden');

+162

await sgl(`(install-builtin-command! "folder-gate-screenshot" "Screenshot directory" "Test fixture"

+163

'(test folder)

+164

(lambda (state)

+165

(update-active state

+166

(lambda (v)

+167

(folder-set-sort

+168

(folder-set-entries v

+169

(append (vector->list (folder-all-entries v))

+170

(list #{ name: "assets" kind: dir: mtime: ${now-7200} }

+171

#{ name: "docs" kind: dir: mtime: ${now-86400} }

+172

#{ name: "test" kind: dir: mtime: ${now-3600} }

+173

#{ name: "README.md" kind: file: size: 4896 mtime: ${now-172800} }

+174

#{ name: "package.sgl" kind: file: size: 2860 mtime: ${now-10800} }

+175

#{ name: "sigil.lock" kind: file: size: 12890 mtime: ${now-86400} }

+176

#{ name: "workspace-notes.md" kind: file: size: 1456 mtime: ${now-600} })))

+177

name:)))))`);

+178

const beforeScreenshot = await readCount();

+179

await dispatch('folder-gate-screenshot');

+180

  await waitFor(`Number(window.slateEval('(number->string (length folder-gate-reads))')) > ${beforeScreenshot}`, 'screenshot preview read');

+181

  await sgl('((cdr (car (reverse folder-gate-reads))) "(define-library (project alpha)\\n  (export greet)\\n  (begin\\n    (define (greet name)\\n      (string-append \\"Hello, \\" name))))\\n")');

+182

await send('Page.enable',{},session);

+183

const screenshot=await send('Page.captureScreenshot',{format:'png'},session);

+184

fs.writeFileSync('/tmp/slate-folder-implemented-desktop.png',Buffer.from(screenshot.data,'base64'));

+185

await send('Emulation.setDeviceMetricsOverride',{width:390,height:844,deviceScaleFactor:1,mobile:true},session);

+186

await send('Emulation.setTouchEmulationEnabled',{enabled:true,maxTouchPoints:1},session);

+187

await dispatch('folder-preview');

+188

assert.equal(await evaluate('document.documentElement.scrollWidth <= innerWidth'),true,'mobile page width');

+189

  assert.ok(await evaluate('document.querySelector(".folder-header").getBoundingClientRect().height <= 46'),'compact mobile header');

+190

const mobile=await send('Page.captureScreenshot',{format:'png'},session);

+191

fs.writeFileSync('/tmp/slate-folder-implemented-mobile.png',Buffer.from(mobile.data,'base64'));

+192

await sgl(`(install-builtin-command! "folder-gate-large" "Large directory" "Test fixture"

+193

'(test folder) (lambda (state) (update-active state (lambda (v)

+194

(folder-set-entries v (let loop ((i 0) (out (list)))

+195

(if (= i 600) out

+196

(loop (+ i 1) (cons #{ name: (string-append "file-" (number->string i)) kind: file: size: 1 } out)))))))))`);

+197

await dispatch('folder-gate-large');

+198

await dispatch('folder-begin');

+199

const motion = await evaluate(`(() => {

+200

const view = document.querySelector('.view.folder');

+201

const render = view.dataset.folderRender;

+202

const times = [];

+203

for (let i = 0; i < 40; i++) {

+204

const start = performance.now();

+205

window.slateEval('(slate-dispatch "folder-next")');

+206

window.slateAfterRender();

+207

times.push(performance.now() - start);

+208

}

+209

times.sort((a,b) => a-b);

+210

return {median:times[20], p95:times[38], total:times.reduce((a,b)=>a+b,0),

+211

sameRender:render === view.dataset.folderRender,

+212

selected:view.querySelector('.folder-row.selected')?.getAttribute('data-slate-click')};

+213

})()`);

+214

assert.equal(motion.sameRender, true, 'point motion does not rebuild the listing');

+215

assert.equal(motion.selected, 'folder-select-index:40');

+216

console.log('FOLDER MOTION '+JSON.stringify(motion));

+217

await evaluate('window.slateRefresh()');

+218

assert.equal(await evaluate('document.querySelector(".folder-row.selected").getAttribute("data-slate-click")'),

+219

'folder-select-index:40', 'a later full render preserves point');

+220

await send('Input.dispatchKeyEvent', {type:'keyDown',key:'p',code:'KeyP',text:'p'}, session);

+221

await send('Input.dispatchKeyEvent', {type:'keyUp',key:'p',code:'KeyP'}, session);

+222

  await waitFor('document.querySelector(".folder-row.selected")?.getAttribute("data-slate-click") === "folder-select-index:39"', 'real p key');

+223

+224

const beforeBurst = await readCount();

+225

await dispatch('folder-preview');

+226

await evaluate(`(() => {

+227

for (let i=0; i<30; i++) {

+228

window.slateEval('(slate-dispatch "folder-next")');

+229

window.slateAfterRender();

+230

}

+231

})()`);

+232

await sleep(250);

+233

assert.equal(await readCount(), beforeBurst, 'movement postpones the preview read');

+234

  await waitFor(`Number(window.slateEval('(number->string (length folder-gate-reads))')) === ${beforeBurst+1}`, 'one settled preview request');

+235

await evaluate(`(() => {

+236

for (let i=0; i<20; i++) {

+237

window.slateEval('(slate-dispatch "folder-prev")');

+238

window.slateAfterRender();

+239

}

+240

})()`);

+241

await sleep(650);

+242

assert.equal(await readCount(), beforeBurst+1, 'slow preview does not accumulate requests');

+243

await sgl('((cdr (car (reverse folder-gate-reads))) "obsolete contents")');

+244

  await waitFor(`Number(window.slateEval('(number->string (length folder-gate-reads))')) === ${beforeBurst+2}`, 'latest point after old request completes');

+245

await sgl('((cdr (car (reverse folder-gate-reads))) "latest contents")');

+246

assert.equal(await evaluate('document.querySelector(".folder-preview-content").textContent'), 'latest contents');

+247

await dispatch('folder-preview');

+248

await dispatch('folder-begin');

+249

+250

let rounds=0;

+251

while(await evaluate('[...document.querySelectorAll(".folder-more")].some(n=>n.textContent.includes("below"))')) {

+252

await evaluate('[...document.querySelectorAll(".folder-more")].find(n=>n.textContent.includes("below")).click()');

+253

if(++rounds>10)throw Error('continuation failed to advance');

+254

}

+255

assert.ok(rounds>0,'clicked continuation');

+256

assert.ok(await evaluate('document.querySelectorAll(".folder-row").length <= 201'),'bounded rendering');

+257

await evaluate('[...document.querySelectorAll(".folder-more")].find(n=>n.textContent.includes("above")).click()');

+258

  assert.equal(await evaluate('[...document.querySelectorAll(".folder-more")].some(n=>n.textContent.includes("below"))'),true);

+259

await sgl(`(install-builtin-command! "folder-gate-image-directory" "Image directory" "Test fixture"

+260

'(test folder) (lambda (state) (update-active state (lambda (v)

+261

(folder-set-entries v

+262

(list #{ name: "child" kind: dir: }

+263

#{ name: "photo.PNG" kind: file: size: 900000 }

+264

#{ name: "z.sgl" kind: file: size: 10 }))))))`);

+265

await dispatch('folder-gate-image-directory');

+266

await dispatch('folder-select-index:1');

+267

const beforeImage = await readCount();

+268

await dispatch('folder-preview');

+269

await waitFor(`window.slateEval('(number->string (length folder-gate-images))') === '1'`, 'image URL request');

+270

assert.equal(await readCount(), beforeImage, 'images bypass text materialization');

+271

  const imageUrl = 'data:image/svg+xml,'+encodeURIComponent('<svg xmlns="http://www.w3.org/2000/svg" width="96" height="64"><rect width="96" height="64" fill="#dba957"/></svg>');

+272

await sgl('((car folder-gate-images) '+JSON.stringify(imageUrl)+')');

+273

await waitFor('document.querySelector(".folder-preview img")?.naturalWidth === 96', 'decoded image preview');

+274

await dispatch('folder-preview');

+275

assert.equal(await sgl('(number->string (length folder-gate-released))'), '1', 'preview image URL released on close');

+276

+277

await dispatch('folder-select-index:0');

+278

await dispatch('folder-preview');

+279

await dispatch('folder-open');

+280

  assert.equal(await evaluate('Boolean(document.querySelector(".folder-preview"))'), true, 'preview stays open on descent');

+281

await sgl('((cdr (car (reverse folder-gate-reads))) (list #{ name: "leaf.sgl" kind: file: size: 10 }))');

+282

await dispatch('folder-parent');

+283

  assert.equal(await evaluate('Boolean(document.querySelector(".folder-preview"))'), true, 'preview stays open in parent');

+284

await dispatch('folder-preview');

+285

+286

// Drive the actual remote provider through its captured transport, then let

+287

// the normal browser tick turn the binary reply into a decoded image.

+288

  await sgl('(import (sigil json) (sigil io) (slate view) (slate providers node) (slate providers enclave-node) (slate providers enclave-node carrier))');

+289

await sgl('(node-reset!)');

+290

await sgl('(node-set-transport!)');

+291

await sgl('(node-set-token! "fixture-token")');

+292

const deliver = async message => sgl('(node-deliver-text! '+JSON.stringify(JSON.stringify(message))+')');

+293

await deliver({t:'hello',instance:'fixture-local'});

+294

await deliver({t:'auth-ok',grants:[]});

+295

await sgl('(enclave-node-reset!)');

+296

await sgl('(enclave-node-register!)');

+297

await sgl('(node-clear-sent!)');

+298

await sgl('(register-root! remote-image-gate: #{provider: node: host: "fixture-remote" label: "zerocool"})');

+299

await sgl(`(install-builtin-command! "folder-gate-real-image" "Remote image" "Fixture"

+300

'(test folder) (lambda (state) (update-active state (lambda (old)

+301

(folder-toggle-preview

+302

(folder-set-entries

+303

(make-folder-view (view-name old)

+304

#{provider: node: host: "fixture-remote" kind: dir: address: "/photos"})

+305

(list #{name: "preview.SVG" kind: file: size: 200})))))))`);

+306

await dispatch('folder-gate-real-image');

+307

const sent = async () => JSON.parse(await sgl('(json-encode (node-sent-text))')).map(JSON.parse);

+308

const open = (await sent()).find(m=>m.verb==='remote/open');

+309

assert.ok(open, 'real provider acquires a remote carrier');

+310

await deliver({t:'ev',event:'remote/opened',carrier:91,request:open.id,transport:'direct'});

+311

const innerMessages = async () => (await sent()).filter(m=>m.t==='remote/text').map(m=>JSON.parse(m.payload));

+312

const discovery = (await innerMessages()).find(m=>m.verb==='git/discover');

+313

assert.ok(discovery,'Git discovery uses the real provider');

+314

  await deliver({t:'remote/text',carrier:91,payload:JSON.stringify({t:'err',id:discovery.id,code:'not-a-repository',message:'not a Git repository'})});

+315

  assert.equal(await evaluate('document.querySelector(".folder-header").textContent.includes("Git unavailable")'),false);

+316

  assert.equal(await evaluate('document.querySelector(".view.folder").classList.contains("with-git")'),false,'non-repository has no Git column');

+317

let request;

+318

for(let i=0;i<50&&!request;i++){

+319

request=(await innerMessages()).find(m=>m.verb==='fs/read-file');

+320

if(!request) await sleep(100);

+321

}

+322

assert.ok(request,'real provider requests the image after debounce');

+323

assert.equal(request.args.path,'/photos/preview.SVG');

+324

assert.equal(request.args.transfer,true);

+325

  const svg='<svg xmlns="http://www.w3.org/2000/svg" width="73" height="41"><rect width="73" height="41" fill="#dba957"/></svg>';

+326

  await deliver({t:'remote/text',carrier:91,payload:JSON.stringify({t:'ok',id:request.id,transfer:{direction:'download',size:svg.length,'chunk-bytes':65536}})});

+327

  await sgl('(node-deliver-binary! (carrier-frame-encode 91 (frame-encode 32 '+request.id+' (bytevector-append (bytevector 0 0 0 0) (string->utf8 '+JSON.stringify(svg)+')))))');

+328

  await sgl('(node-deliver-binary! (carrier-frame-encode 91 (frame-encode 33 '+request.id+' (bytevector 0 0 0 1 0 0 0 '+svg.length+'))))');

+329

  await waitFor('document.querySelector(".folder-preview img")?.naturalWidth === 73','real remote image decoded from a Blob');

+330

assert.match(await evaluate('document.querySelector(".folder-preview img").src'),/^blob:/);

+331

const remoteShot = await send('Page.captureScreenshot', {format:'png'}, session);

+332

fs.writeFileSync('/tmp/slate-folder-remote-image.png', Buffer.from(remoteShot.data, 'base64'));

+333

await dispatch('folder-preview');

+334

await sgl('(node-reset!)');

+335

+336

if (process.env.P3S_IMAGE_PATH) {

+337

const wakeDelay = Number(process.env.P3S_IMAGE_WAKE_DELAY_MS || 0);

+338

if(wakeDelay > 0) {

+339

// Delay both socket wakes and async browser-bridge resumptions, as on a

+340

// busy client. Keep the normal polling timer active throughout.

+341

await evaluate(`window.queueMicrotask = callback => setTimeout(callback, ${wakeDelay})`);

+342

}

+343

// Optional live gate: authenticate a disposable browser against real

+344

// Enclave and an installed node, with NO local companion connection.

+345

await sgl('(import (slate enclave-account session))');

+346

await sgl('(enclave-node-reset!)');

+347

await sgl('(define folder-relay-ready #f)');

+348

await sgl('(define folder-relay-error #f)');

+349

await sgl(`(account-session-start-saved!

+350

#{version: 1 url: ${JSON.stringify(process.env.P3S_ENCLAVE_WS)}

+351

nick: ${JSON.stringify(process.env.P3S_ACCOUNT)}

+352

credential: ${JSON.stringify(process.env.P3S_CREDENTIAL)}}

+353

(lambda ()

+354

(account-session-on-message! enclave-node-on-message!)

+355

(enclave-node-register!)

+356

(set! folder-relay-ready #t))

+357

(lambda (reason) (set! folder-relay-error reason)))`);

+358

    await waitFor(`window.slateEval('(if folder-relay-ready "ready" "waiting")') === 'ready'`, 'real Enclave authentication');

+359

assert.equal(await sgl('(if (node-ready?) "companion" "browser-only")'), 'browser-only');

+360

await sgl('(define folder-relay-image-errors (list))');

+361

await sgl(`(let* ((provider (provider-for #{provider: node:}))

+362

(image-op (dict-ref provider image-url: #f)))

+363

(register-provider! node: (dict-set provider image-url:

+364

(lambda (source ready failed)

+365

(image-op source ready (lambda (reason)

+366

(set! folder-relay-image-errors (cons reason folder-relay-image-errors))

+367

(failed reason)))))))`);

+368

// Occupy the single holder with a live terminal, then prove another

+369

// terminal is refused before testing resource transfers independently.

+370

await sgl('(define folder-relay-output "")');

+371

await sgl('(define folder-relay-events (list))');

+372

await sgl(`(define folder-relay-terminal

+373

(source-session-open

+374

#{provider: node: kind: pty: host: ${JSON.stringify(process.env.P3S_NODE)}

+375

argv: (list "sh" "-c" "printf READY; cat") cols: 80 rows: 24}

+376

(lambda (event)

+377

(set! folder-relay-events (cons event folder-relay-events))

+378

(when (dict-ref event bytes: #f)

+379

(set! folder-relay-output

+380

(string-append folder-relay-output (dict-ref event bytes: "")))))

+381

#{window: 65536}))`);

+382

try {

+383

      await waitFor(`window.slateEval('folder-relay-output').includes('READY')`, 'live terminal occupying the holder quota');

+384

} catch(error) {

+385

throw Error(error.message + '; terminal events=' + await sgl('(json-encode folder-relay-events)'));

+386

}

+387

console.log('PASS real relay terminal opened');

+388

await sgl('(define folder-relay-refused #f)');

+389

await sgl(`(source-session-open

+390

#{provider: node: kind: pty: host: ${JSON.stringify(process.env.P3S_NODE)}

+391

argv: (list "sh") cols: 80 rows: 24}

+392

(lambda (event)

+393

(when (dict-ref event error: #f) (set! folder-relay-refused #t)))

+394

#{window: 65536})`);

+395

    await waitFor(`window.slateEval('(if folder-relay-refused "refused" "waiting")') === 'refused'`, 'session quota refusal');

+396

const remotePath = process.env.P3S_IMAGE_PATH;

+397

const imageSize = Number(process.env.P3S_IMAGE_SIZE || 1600000);

+398

const imageWidth = Number(process.env.P3S_IMAGE_WIDTH || 1);

+399

const previewAttempts = Number(process.env.P3S_IMAGE_ATTEMPTS || 10);

+400

assert.ok(Number.isInteger(previewAttempts) && previewAttempts > 0 && previewAttempts <= 20);

+401

const imageTimeout = imageSize > 4194304 ? 120000 : 36000;

+402

async function verifyImage(selector) {

+403

const result = await evaluate(`(async () => {

+404

const bytes = await (await fetch(document.querySelector(${JSON.stringify(selector)}).src)).arrayBuffer();

+405

const hash = Array.from(new Uint8Array(await crypto.subtle.digest('SHA-256', bytes)))

+406

.map(byte => byte.toString(16).padStart(2, '0')).join('');

+407

return {size: bytes.byteLength, hash};

+408

})()`);

+409

assert.equal(result.size, imageSize);

+410

      if(process.env.P3S_IMAGE_SHA256) assert.equal(result.hash, process.env.P3S_IMAGE_SHA256, 'image bytes remain intact');

+411

}

+412

await sgl(`(install-builtin-command! "folder-gate-live-relay" "Live relay" "Fixture"

+413

'(test folder) (lambda (state) (update-active state (lambda (old)

+414

(folder-toggle-preview

+415

(folder-set-entries

+416

(make-folder-view (view-name old)

+417

#{provider: node: host: ${JSON.stringify(process.env.P3S_NODE)}

+418

kind: dir: address: ${JSON.stringify(path.dirname(remotePath))}})

+419

(list #{name: ${JSON.stringify(path.basename(remotePath))} kind: file: size: ${imageSize}})))))))`);

+420

const previewUrls = new Set();

+421

for(let attempt=0;attempt<previewAttempts;attempt++) {

+422

await dispatch('folder-gate-live-relay');

+423

try {

+424

        await waitFor(`document.querySelector(".folder-preview img")?.naturalWidth === ${imageWidth}`, `image preview ${attempt+1} with full holder quota`, imageTimeout);

+425

} catch(error) {

+426

throw Error(error.message + '; image errors=' + await sgl('(json-encode folder-relay-image-errors)') +

+427

'; account phase=' + await sgl('(symbol->string (account-session-phase))'));

+428

}

+429

console.log(`PASS image preview ${attempt+1}`);

+430

previewUrls.add(await evaluate('document.querySelector(".folder-preview img").src'));

+431

await verifyImage('.folder-preview img');

+432

await dispatch('folder-preview');

+433

if(process.env.P3S_STATE_DIR) {

+434

const resources = path.join(process.env.P3S_STATE_DIR,'resources');

+435

const remaining = () => fs.existsSync(resources)

+436

? fs.readdirSync(resources).filter(name => name.endsWith('.sock')) : [];

+437

for(let wait=0;wait<50 && remaining().length;wait++) await sleep(100);

+438

assert.deepEqual(remaining(), [], 'completed image transfer retires its worker');

+439

}

+440

}

+441

assert.equal(previewUrls.size, previewAttempts, 'each preview completed a fresh binary transfer');

+442

await send('Input.dispatchKeyEvent', {type:'keyDown',key:'Enter',code:'Enter',windowsVirtualKeyCode:13}, session);

+443

await send('Input.dispatchKeyEvent', {type:'keyUp',key:'Enter',code:'Enter',windowsVirtualKeyCode:13}, session);

+444

    await waitFor(`document.querySelector(".image-img")?.naturalWidth === ${imageWidth}`, 'Enter opens image with full holder quota', imageTimeout);

+445

await verifyImage('.image-img');

+446

await sgl('(session-write folder-relay-terminal "STILL-ALIVE\\n")');

+447

    await waitFor(`window.slateEval('folder-relay-output').includes('STILL-ALIVE')`, 'existing terminal survives all image transfers');

+448

await sgl('(session-close folder-relay-terminal)');

+449

await sgl('(account-session-close!)');

+450

    console.log(`PASS live relay: full holder quota, ${previewAttempts} ${imageSize}-byte previews, Enter image decoding, existing terminal remains responsive`);

+451

}

+452

+453

assert.deepEqual(errors, [], 'runtime errors');

+454

  console.log('PASS folder browser: fast point motion, debounced bounded previews, real remote image decoding, silent non-repository state, image release, registered names, preview persistence, async listing/Git/preview, keyed DOM continuity, marks, existing copy/move prompts, sorting, hidden, responsive layout, clickable continuations');

+455

} finally {

+456

if (socket) socket.close();

+457

chrome.kill('SIGTERM');

+458

await Promise.race([chromeExit, sleep(2000)]);

+459

await new Promise(resolve => server.close(resolve));

+460

try { fs.rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); }

+461

catch (_) { /* Chrome helpers may finish touching the disposable profile late. */ }

+462

}

packages/slate/test/folder-redesign-test.sgladded

@@ -0,0 +1,203 @@

+1

(import (sigil test)

+2

(sigil string)

+3

(slate command)

+4

(slate commands folder)

+5

(slate folder model)

+6

(slate folder enrichment)

+7

(slate modes folder)

+8

(slate option)

+9

(slate pane)

+10

(slate provider)

+11

(slate root)

+12

(slate space)

+13

(slate state)

+14

(slate view))

+15

+16

(define listing

+17

(list #{ name: "old.txt" kind: file: size: 2 mtime: 10 }

+18

#{ name: "new.txt" kind: file: size: 4 mtime: 30 }

+19

#{ name: "unknown.txt" kind: file: size: 1 }

+20

#{ name: "src" kind: dir: mtime: 20 }

+21

#{ name: "assets" kind: dir: mtime: 5 }

+22

#{ name: ".hidden" kind: file: size: 2 mtime: 15 }

+23

#{ name: "private" kind: file: hidden: #t size: 1 }))

+24

(register-provider! folder-redesign:

+25

#{ materialize: (lambda (source)

+26

(if (eq? (dict-ref source kind: file:) dir:) listing "hello")) })

+27

(define (fixture)

+28

(make-folder-view "directory" #{ provider: folder-redesign: kind: dir: address: "/repo" }))

+29

(define (state-for v)

+30

#{ slate/views: (list v)

+31

slate/spaces: (list (make-space "main" (make-leaf 0 (view-name v)) 0 1))

+32

slate/active-space: "main" })

+33

(define (names v)

+34

(map (lambda (e) (dict-ref e name:)) (vector->list (folder-entries v))))

+35

+36

(test "sorting keeps folders first, missing times last, and point by name"

+37

(let* ((v (folder-set-point (fixture) 3))

+38

(newest (folder-set-sort v newest:))

+39

(oldest (folder-set-sort v oldest:)))

+40

(assert-equal (names newest) '("src" "assets" "new.txt" "old.txt" "unknown.txt"))

+41

(assert-equal (names oldest) '("assets" "src" "old.txt" "new.txt" "unknown.txt"))

+42

(assert-equal (dict-ref (folder-entry-at newest) name:) "old.txt")

+43

(assert-equal (dict-ref (folder-entry-at oldest) name:) "old.txt")))

+44

+45

(test "marks on hidden entries remain mutation targets and survive refresh"

+46

(let* ((all (folder-toggle-hidden (fixture)))

+47

(marked (folder-mark-matching all ".*"))

+48

(hidden (folder-toggle-hidden marked))

+49

(refreshed (folder-set-entries hidden listing)))

+50

(assert-equal (folder-marks refreshed) '(".hidden"))

+51

(assert-equal (map (lambda (e) (dict-ref e name:)) (folder-operation-entries refreshed))

+52

'(".hidden"))

+53

(assert-false (member "private" (names refreshed)))))

+54

+55

(define (actions tree)

+56

(cond ((not (pair? tree)) '())

+57

((and (eq? (car tree) 'data-slate-click) (pair? (cdr tree))) (list (cadr tree)))

+58

(else (append (actions (car tree)) (actions (cdr tree))))))

+59

+60

(test "continuations are clickable, reach the end, and keep rendering bounded"

+61

(let* ((large (let loop ((i 0) (out '()))

+62

(if (= i 600) out

+63

(loop (+ i 1) (cons #{ name: (string-append "file-" (number->string i))

+64

kind: file: size: 1 } out)))))

+65

(v (folder-set-entries (fixture) large))

+66

(first-actions (actions (view-render v)))

+67

(next (active-view (command-run (state-for v) "folder-select-index:101")))

+68

(last (active-view (command-run (state-for next) "folder-select-index:599"))))

+69

(assert-true (member "folder-select-index:101" first-actions))

+70

(assert-equal (folder-point next) 101)

+71

(assert-equal (folder-point last) 599)

+72

(assert-true (member "folder-select-index:399" (actions (view-render last))))

+73

(assert-true (< (length (filter (lambda (x) (string-starts-with? x "folder-open-index:"))

+74

(actions (view-render last)))) 202))))

+75

+76

(test "Git overlay maps immediate children and aggregates conflicts in directories"

+77

(let ((overlay (folder-git-overlay "/repo/src"

+78

#{ repo: #{ worktree: "/repo" }

+79

entries: (list

+80

#{ path: "src/a.sgl" kind: "ordinary" index-state: "M" worktree-state: "." }

+81

#{ path: "src/lib/a.sgl" kind: "untracked" }

+82

#{ path: "src/lib/b.sgl" kind: "conflict" }

+83

#{ path: "src-other/wrong.sgl" kind: "untracked" }) })))

+84

(assert-equal (dict-ref (dict-ref overlay "a.sgl") label:) "M")

+85

(assert-equal (dict-ref (dict-ref overlay "lib") label:) "!")

+86

(assert-false (dict-ref overlay "wrong.sgl" #f))))

+87

+88

(test "preview coalesces motion, debounces reads, and bounds in-flight work"

+89

(let ((held '()) (notifications 0))

+90

(register-provider! preview-held:

+91

#{ materialize: (lambda (source) '())

+92

materialize-async:

+93

(lambda (source ok error) (set! held (append held (list ok)))) })

+94

(let* ((v (folder-set-entries

+95

(make-folder-view "held" #{ provider: preview-held: kind: dir: address: "/" })

+96

(list #{ name: "a" kind: file: size: 1 }

+97

#{ name: "b" kind: file: size: 1 })))

+98

(notify (lambda () (set! notifications (+ notifications 1)))))

+99

(refresh-folder-enrichment! (state-for v) 100 notify)

+100

(assert-equal (folder-preview-request-token) "")

+101

(set! v (folder-toggle-preview v))

+102

(refresh-folder-enrichment! (state-for v) 100 notify)

+103

(assert-equal held '())

+104

(let ((obsolete (folder-preview-request-token)))

+105

(set! v (folder-set-point v 1))

+106

(refresh-folder-enrichment! (state-for v) 100 notify)

+107

(flush-folder-preview! obsolete)

+108

(assert-equal held '()))

+109

(flush-folder-preview! (folder-preview-request-token))

+110

(assert-equal (length held) 1)

+111

(set! v (folder-set-point v 0))

+112

(refresh-folder-enrichment! (state-for v) 100 notify)

+113

(assert-equal (folder-preview-request-token) "")

+114

((car held) "obsolete B")

+115

(assert-equal (folder-detail v preview-text: #f) "Waiting…")

+116

(flush-folder-preview! (folder-preview-request-token))

+117

(assert-equal (length held) 2)

+118

((cadr held) "current A")

+119

(assert-equal (folder-detail v preview-text: #f) "current A")

+120

(assert-equal notifications 2)

+121

(set! v (folder-toggle-preview v))

+122

(refresh-folder-enrichment! (state-for v) 100 notify)

+123

(assert-equal (folder-preview-request-token) ""))))

+124

+125

(test "image previews use image URLs and release current and obsolete results"

+126

(let ((image-ready '()) (reads 0) (released '()))

+127

(register-provider! preview-images:

+128

#{ materialize: (lambda (source) '())

+129

materialize-async: (lambda (source ok error) (set! reads (+ reads 1)))

+130

image-url: (lambda (source ok error)

+131

(set! image-ready (append image-ready (list ok))))

+132

image-release: (lambda (source url) (set! released (cons url released))) })

+133

(let* ((v (folder-toggle-preview

+134

(folder-set-entries

+135

(make-folder-view "images" #{ provider: preview-images: kind: dir: address: "/" })

+136

(list #{ name: "a.PNG" kind: file: size: 900000 }

+137

#{ name: "b.jpg" kind: file: size: 500000 }))))

+138

(refresh (lambda () (refresh-folder-enrichment! (state-for v) 100 (lambda () #f)))))

+139

(refresh)

+140

(flush-folder-preview! (folder-preview-request-token))

+141

((car image-ready) "blob:first")

+142

(assert-equal (folder-detail v preview-image-url: #f) "blob:first")

+143

(assert-equal reads 0)

+144

(set! v (folder-set-point v 1))

+145

(refresh)

+146

(assert-equal released '("blob:first"))

+147

(flush-folder-preview! (folder-preview-request-token))

+148

(set! v (folder-toggle-preview v))

+149

(refresh)

+150

((cadr image-ready) "blob:obsolete")

+151

(assert-equal released '("blob:obsolete" "blob:first"))

+152

(assert-false (folder-detail v preview-image-url: #f))

+153

(assert-equal reads 0))))

+154

+155

(test "point-only changes reuse the rendered window without accepting content changes"

+156

(let* ((v (fixture))

+157

(tree (view-render v))

+158

(next (folder-move v 1)))

+159

(assert-true (folder-point-only-change? v next))

+160

(assert-true (folder-point-rendered? next))

+161

(assert-false (folder-point-only-change? v (folder-mark v)))

+162

(assert-false (folder-point-only-change? v (folder-toggle-preview v)))

+163

(assert-false (folder-point-only-change? v (folder-set-entries v listing)))))

+164

+165

(test "folder header uses the root's registered display name"

+166

(register-root! registered-test:

+167

#{ provider: folder-redesign: host: "slate-node-opaque" label: "zerocool" })

+168

(let* ((v (make-folder-view "remote"

+169

#{ provider: folder-redesign: host: "slate-node-opaque" kind: dir: address: "/repo" }))

+170

(tree (view-render v)))

+171

(define (contains? x text)

+172

(cond ((string? x) (string=? x text))

+173

((pair? x) (or (contains? (car x) text) (contains? (cdr x) text)))

+174

(else #f)))

+175

(assert-true (contains? tree "zerocool"))

+176

(assert-false (contains? tree "slate-node-opaque")))

+177

(unregister-root! registered-test:))

+178

+179

(test "new folder previews default off and honor the declared option"

+180

(assert-false (dict-ref (fixture) slate/folder-preview?: #t))

+181

(let ((previous-global (set-option-live-global-reader!

+182

(lambda (name) (eq? name slate/folder-preview:))))

+183

(previous (set-option-live-reader!

+184

(lambda (name default)

+185

(if (eq? name slate/folder-preview:) #t default)))))

+186

(assert-true (dict-ref (fixture) slate/folder-preview?: #f))

+187

(set-option-live-global-reader! previous-global)

+188

(set-option-live-reader! previous)))

+189

+190

(test "preview excerpts are bounded and binary-safe"

+191

(assert-equal (folder-preview-excerpt (string-append "a" (string (integer->char 0)) "b"))

+192

"Binary file")

+193

(assert-true (< (string-length (folder-preview-excerpt (make-string 20000 #\a))) 12010)))

+194

+195

(test "Git errors do not add a misleading folder header warning"

+196

(let ((v (fixture)))

+197

(folder-detail-set! v git-capable?: #t)

+198

(folder-detail-set! v git-state: #{ state: error: error: #{ code: "not-a-repository" } })

+199

(define (contains-warning? x)

+200

(cond ((string? x) (string-contains? x "Git unavailable"))

+201

((pair? x) (or (contains-warning? (car x)) (contains-warning? (cdr x))))

+202

(else #f)))

+203

(assert-false (contains-warning? (view-render v)))))

packages/slate/test/git-branch-browser-gate.mjsadded

@@ -0,0 +1,98 @@

+1

import assert from 'node:assert/strict';

+2

import fs from 'node:fs';

+3

import path from 'node:path';

+4

+5

export async function branchGate({tab,send,sgl,evalIn,waitFor,key,sentFrames,runGit,

+6

branchListReleaseFile,branchSwitchReleaseFile,gateRoot}) {

+7

const count=verb=>sentFrames.filter(f=>f.includes(verb)).length;

+8

const branch=()=>runGit(['symbolic-ref','--short','HEAD']).trim();

+9

const click=async selector=>{

+10

    const p=await evalIn(tab,`(()=>{const e=document.querySelector(${JSON.stringify(selector)});e.scrollIntoView({block:'nearest'});const r=e.getBoundingClientRect();return {x:r.x+r.width/2,y:r.y+r.height/2}})()`);

+11

await send('Input.dispatchMouseEvent',{type:'mousePressed',button:'left',clickCount:1,...p},tab.sessionId);

+12

await send('Input.dispatchMouseEvent',{type:'mouseReleased',button:'left',clickCount:1,...p},tab.sessionId);

+13

};

+14

const type=async text=>{

+15

await waitFor(tab,`!!document.querySelector('.pal-input')`,'branch input');

+16

await evalIn(tab,`document.querySelector('.pal-input').focus()`);

+17

await send('Input.insertText',{text},tab.sessionId);

+18

};

+19

const label=text=>`document.querySelector('.palette')?.textContent.includes(${JSON.stringify(text)})`;

+20

const screenshot=async name=>{

+21

if(!process.env.GIT_BRANCH_SCREENSHOTS)return;

+22

fs.mkdirSync(process.env.GIT_BRANCH_SCREENSHOTS,{recursive:true});

+23

const r=await send('Page.captureScreenshot',{format:'png'},tab.sessionId);

+24

fs.writeFileSync(path.join(process.env.GIT_BRANCH_SCREENSHOTS,name+'.png'),Buffer.from(r.data,'base64'));

+25

};

+26

await key('b');

+27

await waitFor(tab,`document.querySelectorAll('.which-key-panel button.wk-row').length===3`,'branch menu');

+28

  assert.ok(await evalIn(tab,`[...document.querySelectorAll('.which-key-panel .wk-cmd')].every(e=>e.scrollWidth<=e.clientWidth)`),'branch menu labels are truncated');

+29

await screenshot('menu');

+30

await key('b');

+31

await waitFor(tab,label('Loading branches'),'held branch listing');

+32

const held=count('git/branches');

+33

await key('Escape');

+34

fs.writeFileSync(branchListReleaseFile,'release\n');

+35

await key('b'); await key('b');

+36

await waitFor(tab,label('Switch local branch'),'fresh branch listing');

+37

assert.equal(count('git/branches'),held+1);

+38

await screenshot('switch');

+39

await key('Escape');

+40

assert.equal(count('git/switch-branch'),0,'cancelling a branch prompt mutated Git');

+41

+42

// The visible menu's touch/pointer route uses the same armed key map.

+43

await click('.git-status [data-slate-click="git-branch-menu"]');

+44

await click('.which-key-panel [data-slate-key="c"]');

+45

await waitFor(tab,label('Create and switch'),'create branch prompt');

+46

await type('feature/browser'); await key('Enter');

+47

await waitFor(tab,`document.body.textContent.includes('updating branch feature/browser')`,'pending branch switch');

+48

assert.equal(branch(),'main','held switch ran early');

+49

const mutations=count('git/create-branch');

+50

await key('n'); await key('p');

+51

await key('b'); await key('c');

+52

assert.equal(count('git/create-branch'),mutations,'pending branch mutation was duplicated');

+53

fs.writeFileSync(branchSwitchReleaseFile,'release\n');

+54

  await waitFor(tab,`document.querySelector('.git-branch-name')?.textContent==='feature/browser'`,'fresh branch status');

+55

assert.equal(branch(),'feature/browser');

+56

+57

await key('b'); await key('b');

+58

await waitFor(tab,label('Switch local branch'),'switch back prompt');

+59

await type('main'); await key('Enter');

+60

await waitFor(tab,`document.querySelector('.git-branch-name')?.textContent==='main'`,'switch back to main');

+61

assert.equal(branch(),'main');

+62

+63

await key('l');

+64

await waitFor(tab,`document.querySelectorAll('.git-log-row').length===50`,'history for branching');

+65

await key('n'); await key('Enter');

+66

await waitFor(tab,`!!document.querySelector('.git-log-inspection')`,'selected commit review');

+67

const selected=await evalIn(tab,`document.querySelector('.git-log').dataset.reviewOid`);

+68

const head=runGit(['rev-parse','HEAD']).trim();

+69

assert.notEqual(selected,head,'fixture did not select an older commit');

+70

await evalIn(tab,`window.__branchReview=document.querySelector('.git-log-inspection');true`);

+71

await key('b'); await key('n');

+72

await waitFor(tab,label('keep current checkout'),'selected commit branch prompt');

+73

await type('review/from-history'); await key('Enter');

+74

  await waitFor(tab,`document.body.textContent.includes('Created branch review/from-history')`,'created selected-commit ref');

+75

assert.equal(runGit(['rev-parse','refs/heads/review/from-history']).trim(),selected);

+76

assert.equal(runGit(['rev-parse','HEAD']).trim(),head);

+77

assert.equal(branch(),'main');

+78

  assert.equal(await evalIn(tab,`document.querySelector('.git-log').dataset.reviewOid`),selected,'creation lost inspected commit');

+79

  assert.ok(await evalIn(tab,`window.__branchReview===document.querySelector('.git-log-inspection')`),'ref creation replaced commit review');

+80

await screenshot('created');

+81

+82

await key('b'); await key('b');

+83

await waitFor(tab,label('Switch local branch'),'history switch prompt');

+84

await type('feature/browser'); await key('Enter');

+85

  await waitFor(tab,`document.querySelector('.git-log-header h1')?.textContent==='feature/browser'`,'history follows switched branch');

+86

  assert.equal(await evalIn(tab,`document.querySelector('.git-log').dataset.reviewOid`),'','switch retained old checkout review');

+87

await key('q');

+88

  await waitFor(tab,`document.querySelector('.git-branch-name')?.textContent==='feature/browser'`,'status updated while history was active');

+89

  assert.ok(sentFrames.filter(f=>/git\/(branches|switch-branch|create-branch)/.test(f)).every(f=>f.includes(gateRoot)),'branch operations lost root identity');

+90

+91

await send('Emulation.setDeviceMetricsOverride',{width:390,height:844,deviceScaleFactor:1,mobile:true},tab.sessionId);

+92

await click('.git-status [data-slate-click="git-branch-menu"]');

+93

await waitFor(tab,`!!document.querySelector('.which-key-panel button.wk-row')`,'mobile branch menu');

+94

  assert.ok(await evalIn(tab,`(()=>{const p=document.querySelector('.which-key-panel');return p.scrollWidth<=p.clientWidth})()`),'branch menu overflows mobile');

+95

await screenshot('mobile');

+96

await key('Escape');

+97

  console.log(JSON.stringify({branches:'PASS',root:gateRoot,pointer:true,cancel:true,heldMutation:true,selectedCommit:true,preservedReview:true}));

+98

}

packages/slate/test/git-branch-command-test.sgladded

@@ -0,0 +1,125 @@

+1

(import (sigil test) (slate command) (slate commands git) (slate commands git branch) (slate commands prompt)

+2

(slate git model) (slate git log-model) (slate git log-view)

+3

(slate modes git-status) (slate modes git-log) (slate pane)

+4

(slate prompt) (slate provider) (slate root) (slate space) (slate state) (slate view))

+5

(define STATE #{})

+6

(define REQUESTS '())

+7

(define HELD '())

+8

(define OID (make-string 40 #\a))

+9

(define OLD (make-string 40 #\b))

+10

(define REPO #{ root: "branches" worktree: "/repo" common-dir: "/repo/.git" })

+11

(define SNAP #{ head-oid: OID index-id: "i" worktree-id: "w" })

+12

(define DATA #{ version: 1 repo: REPO snapshot: SNAP branch: #{ head: "main" }

+13

entries: '() recent-commits: '() })

+14

(define LISTING #{ version: 1 repo: REPO snapshot: SNAP branch: #{ head: "main" }

+15

branches: (list #{ name: "main" oid: OID } #{ name: "old" oid: OLD }) })

+16

(register-provider! branch-test:

+17

#{ git-request: (lambda (source verb args ready fail)

+18

(set! REQUESTS (append REQUESTS (list (dict-set args verb: verb))))

+19

(cond ((string=? verb "git/discover") (ready #{ version: 1 node-repo: REPO }))

+20

((string=? verb "git/status") (ready DATA))

+21

((dict-ref args cancel: #f) #t)

+22

(else (set! HELD (append HELD (list (cons ready fail)))))))

+23

subscribe: (lambda (source callback) (lambda () #t)) })

+24

(register-root! branches: #{ provider: branch-test: host: "remote-branch-node" class: machine: })

+25

(define (run command) (set! STATE (command-run STATE command)))

+26

(define (setup!)

+27

(set! REQUESTS '())

+28

(set! HELD '())

+29

(let ((v (view slate/name: "plain" slate/source: (root->source branches: file: "/repo/a.sgl"))))

+30

(set! STATE #{ slate/views: (list v)

+31

slate/spaces: (list (make-space "main" (make-leaf 0 "plain") 0 1))

+32

slate/active-space: "main" }))

+33

(configure-git-commands!

+34

#{ state: (lambda () STATE) set-state: (lambda (state) (set! STATE state))

+35

refresh: (lambda () #t) })

+36

(configure-prompt-commands!

+37

#{ desc: (lambda (state id) (git-branch-prompt state))

+38

visible: (lambda (state) (prompt-candidates (git-branch-prompt state) state)) })

+39

(run "git-status"))

+40

(define (ready value) ((car (car (reverse HELD))) value))

+41

(define (accept value)

+42

(if (string? value)

+43

(set! STATE (dict-set STATE slate/selector-query: value))

+44

(let loop ((rows (prompt-candidates (git-branch-prompt STATE) STATE)) (i 0))

+45

(if (equal? (car rows) value)

+46

(set! STATE (dict-set STATE slate/selector-index: i))

+47

(loop (cdr rows) (+ i 1)))))

+48

(set! STATE (accept-prompt STATE)))

+49

(test "branch menu arms keyboard and pointer commands without fetching"

+50

(setup!)

+51

(let ((before (length REQUESTS)))

+52

(run "git-branch-menu")

+53

(assert-equal "git-branch-switch" (dict-ref (dict-ref STATE slate/pending-prefix: #{}) "b" #f))

+54

(assert-equal before (length REQUESTS))))

+55

(test "late and wrong-root branch listings cannot reopen a cancelled prompt"

+56

(setup!)

+57

(run "git-branch-switch")

+58

(assert-equal "Loading branches…" (prompt-label (git-branch-prompt STATE)))

+59

(set! STATE (close-prompt (cancel-prompt STATE)))

+60

(ready LISTING)

+61

(assert-false (dict-ref STATE slate/minibuffer: #f))

+62

(run "git-branch-switch")

+63

(ready (dict-set LISTING repo: (dict-set REPO root: "wrong")))

+64

(assert-false (dict-ref STATE slate/minibuffer: #f)))

+65

(test "switch carries the captured snapshot, root, and target and excludes other mutations"

+66

(setup!)

+67

(run "git-branch-switch")

+68

(assert-equal live: (prompt-candidate-policy (git-branch-prompt STATE)))

+69

(ready LISTING)

+70

(assert-equal snapshot: (prompt-candidate-policy (git-branch-prompt STATE)))

+71

(let* ((m (git-status-model (active-view STATE)))

+72

(candidate (cadr (prompt-candidates (git-branch-prompt STATE) STATE))))

+73

(accept candidate)

+74

(let ((sent (car (reverse REQUESTS))) (before (length REQUESTS)))

+75

(assert-equal "git/switch-branch" (dict-ref sent verb: #f))

+76

(assert-equal REPO (dict-ref sent repo: #f))

+77

(assert-equal SNAP (dict-ref sent expected-snapshot: #f))

+78

(assert-equal OLD (dict-ref sent target-oid: #f))

+79

(assert-equal pending: (dict-ref (git-status-model-state m) mutation: #f))

+80

(run "git-branch-create-switch")

+81

(run "git-refresh")

+82

(assert-equal before (length REQUESTS)))

+83

(ready #{ version: 1 repo: REPO name: "old" applied: #t switched: #t

+84

status: (dict-set DATA branch: #{ head: "old" }) })

+85

(assert-equal "old" (dict-ref (dict-ref (dict-ref (git-status-model-state m) data: #{}) branch: #{}) head: #f))

+86

(assert-false (dict-ref STATE slate/minibuffer: #f))))

+87

(test "create prompts validate duplicates and carry HEAD without switching early"

+88

(setup!)

+89

(run "git-branch-create-switch")

+90

(ready LISTING)

+91

(assert-true (string? (prompt-validate (git-branch-prompt STATE) STATE "main")))

+92

(assert-equal 3 (length REQUESTS))

+93

(accept "feature/new")

+94

(let ((sent (car (reverse REQUESTS))))

+95

(assert-equal "git/create-branch" (dict-ref sent verb: #f))

+96

(assert-equal OID (dict-ref sent start-oid: #f))

+97

(assert-true (dict-ref sent switch: #f)))

+98

((cdr (car (reverse HELD))) #{ message: "Branch exists" })

+99

(assert-equal "Branch exists" (dict-ref STATE slate/echo: #f))

+100

(assert-false (eq? pending: (dict-ref (git-status-model-state (git-status-model (active-view STATE))) mutation: #f))))

+101

(test "selected history commit is captured before prompting and creates without switching"

+102

(setup!)

+103

(run "git-log")

+104

(ready #{ version: 1 repo: REPO snapshot: SNAP branch: #{ head: "main" }

+105

commits: (list #{ oid: OLD subject: "Older" parents: '() }) offset: 0 complete: #t })

+106

(run "git-branch-create-selected")

+107

(ready LISTING)

+108

(accept "review/old")

+109

(let ((sent (car (reverse REQUESTS))))

+110

(assert-equal OLD (dict-ref sent start-oid: #f))

+111

(assert-false (dict-ref sent switch: #t)))

+112

(ready #{ version: 1 repo: REPO name: "review/old" applied: #t switched: #f status: DATA })

+113

(assert-true (vector? (git-log-model (active-view STATE))))

+114

(assert-equal "git/log" (dict-ref (car (reverse REQUESTS)) verb: #f)))

+115

(test "invalid mutation receipts release the pending state without adopting another root"

+116

(setup!)

+117

(run "git-branch-create-switch")

+118

(ready LISTING)

+119

(accept "new")

+120

(ready #{ version: 1 repo: (dict-set REPO root: "other") name: "new" applied: #t status: DATA })

+121

(assert-equal stale: (dict-ref (git-status-model-state (git-status-model (active-view STATE))) state: #f))

+122

(run "git-branch-switch")

+123

(assert-equal "git/branches" (dict-ref (car (reverse REQUESTS)) verb: #f)))

+124

(configure-git-commands! #{})

+125

(test-summary)

packages/slate/test/git-contract-gate.mjsadded

@@ -0,0 +1,255 @@

+1

import assert from 'node:assert/strict';

+2

import { execFileSync, spawnSync } from 'node:child_process';

+3

import { chmodSync, mkdirSync, readFileSync, writeFileSync } from 'node:fs';

+4

import { join, resolve } from 'node:path';

+5

+6

const [contractPath, fixtureRoot] = process.argv.slice(2);

+7

if (!contractPath || !fixtureRoot) {

+8

console.error('SETUP-FAILED git-contract: expected declaration and fixture root');

+9

process.exit(2);

+10

}

+11

+12

const fail = message => { throw new Error(message); };

+13

let contract;

+14

try {

+15

contract = JSON.parse(readFileSync(contractPath, 'utf8'));

+16

} catch (error) {

+17

console.error(`SETUP-FAILED git-contract: cannot read declaration: ${error.message}`);

+18

process.exit(2);

+19

}

+20

+21

const gitEnv = {

+22

...process.env,

+23

LC_ALL: 'C',

+24

LANG: 'C',

+25

GIT_CONFIG_NOSYSTEM: '1',

+26

GIT_AUTHOR_NAME: 'Slate Contract',

+27

GIT_AUTHOR_EMAIL: 'slate-contract@example.invalid',

+28

GIT_COMMITTER_NAME: 'Slate Contract',

+29

GIT_COMMITTER_EMAIL: 'slate-contract@example.invalid',

+30

GIT_TERMINAL_PROMPT: '0',

+31

};

+32

+33

function git(cwd, ...args) {

+34

return execFileSync('git', args, { cwd, env: gitEnv, encoding: 'utf8', stdio: ['ignore', 'pipe', 'pipe'] });

+35

}

+36

+37

function initRepo(name, initial = true) {

+38

const dir = join(fixtureRoot, name);

+39

mkdirSync(dir, { recursive: true });

+40

git(dir, 'init', '-q', '--initial-branch=main');

+41

if (initial) {

+42

writeFileSync(join(dir, 'base.txt'), 'one\ntwo\nthree\nfour\nfive\n');

+43

git(dir, 'add', '--', 'base.txt');

+44

git(dir, 'commit', '-q', '-m', 'initial');

+45

}

+46

return dir;

+47

}

+48

+49

function buildFixtures() {

+50

const fixtures = new Map();

+51

+52

fixtures.set('clean', initRepo('clean'));

+53

fixtures.set('unborn', initRepo('unborn', false));

+54

+55

const mixed = initRepo('mixed');

+56

writeFileSync(join(mixed, 'base.txt'), 'ONE\ntwo\nthree\nfour\nfive\n');

+57

git(mixed, 'add', '--', 'base.txt');

+58

writeFileSync(join(mixed, 'base.txt'), 'ONE\ntwo\nthree\nfour\nFIVE\n');

+59

writeFileSync(join(mixed, 'untracked.txt'), 'new\n');

+60

fixtures.set('mixed', mixed);

+61

+62

const rename = initRepo('rename');

+63

writeFileSync(join(rename, 'old name.txt'), 'rename me\n');

+64

git(rename, 'add', '--', 'old name.txt');

+65

git(rename, 'commit', '-q', '-m', 'rename base');

+66

git(rename, 'mv', '--', 'old name.txt', 'new -> name.txt');

+67

fixtures.set('rename', rename);

+68

+69

const binary = initRepo('binary');

+70

writeFileSync(join(binary, 'blob.bin'), Buffer.from([0, 1, 2, 0, 255]));

+71

git(binary, 'add', '--', 'blob.bin');

+72

fixtures.set('binary', binary);

+73

+74

const mode = initRepo('mode');

+75

writeFileSync(join(mode, 'run.sh'), '#!/bin/sh\nexit 0\n');

+76

git(mode, 'add', '--', 'run.sh');

+77

git(mode, 'commit', '-q', '-m', 'mode base');

+78

chmodSync(join(mode, 'run.sh'), 0o755);

+79

fixtures.set('mode-change', mode);

+80

+81

const special = initRepo('special-names');

+82

const names = ['space name.txt', 'tab\tname.txt', 'line\nname.txt', 'naïve.txt', '-leading.txt', 'from -> to.txt'];

+83

for (const name of names) writeFileSync(join(special, name), `${name}\n`);

+84

git(special, 'add', '--', ...names);

+85

fixtures.set('special-names', special);

+86

+87

const detached = initRepo('detached');

+88

git(detached, 'checkout', '-q', '--detach', 'HEAD');

+89

fixtures.set('detached', detached);

+90

+91

const divergence = initRepo('ahead-behind');

+92

git(divergence, 'branch', 'upstream-base');

+93

git(divergence, 'branch', '--set-upstream-to=upstream-base', 'main');

+94

writeFileSync(join(divergence, 'ahead.txt'), 'ahead\n');

+95

git(divergence, 'add', '--', 'ahead.txt');

+96

git(divergence, 'commit', '-q', '-m', 'ahead');

+97

git(divergence, 'checkout', '-q', 'upstream-base');

+98

writeFileSync(join(divergence, 'behind.txt'), 'behind\n');

+99

git(divergence, 'add', '--', 'behind.txt');

+100

git(divergence, 'commit', '-q', '-m', 'behind');

+101

git(divergence, 'checkout', '-q', 'main');

+102

fixtures.set('ahead-behind', divergence);

+103

+104

const conflict = initRepo('conflict');

+105

git(conflict, 'checkout', '-q', '-b', 'other');

+106

writeFileSync(join(conflict, 'base.txt'), 'other\n');

+107

git(conflict, 'commit', '-qam', 'other');

+108

git(conflict, 'checkout', '-q', 'main');

+109

writeFileSync(join(conflict, 'base.txt'), 'main\n');

+110

git(conflict, 'commit', '-qam', 'main');

+111

try { git(conflict, 'merge', 'other'); } catch { /* expected conflict keeps MERGE_HEAD */ }

+112

fixtures.set('conflict', conflict);

+113

fixtures.set('in-progress', conflict);

+114

+115

const multi = initRepo('multi-hunk');

+116

const lines = Array.from({ length: 80 }, (_, i) => `line ${i + 1}`);

+117

writeFileSync(join(multi, 'many.txt'), `${lines.join('\n')}\n`);

+118

git(multi, 'add', '--', 'many.txt');

+119

git(multi, 'commit', '-q', '-m', 'many base');

+120

lines[2] = 'changed first hunk';

+121

lines[70] = 'changed second hunk';

+122

writeFileSync(join(multi, 'many.txt'), `${lines.join('\n')}\n`);

+123

fixtures.set('multi-hunk', multi);

+124

+125

const large = initRepo('large-diff');

+126

const huge = Array.from({ length: 90000 }, (_, i) => `old ${String(i).padStart(6, '0')} ${'x'.repeat(32)}`);

+127

writeFileSync(join(large, 'huge.txt'), `${huge.join('\n')}\n`);

+128

git(large, 'add', '--', 'huge.txt');

+129

git(large, 'commit', '-q', '-m', 'large base');

+130

const changed = huge.map((line, i) => i % 2 === 0 ? line.replace('old', 'new') : line);

+131

writeFileSync(join(large, 'huge.txt'), `${changed.join('\n')}\n`);

+132

fixtures.set('large-diff', large);

+133

+134

return fixtures;

+135

}

+136

+137

const typeChecks = {

+138

string: value => typeof value === 'string',

+139

number: value => typeof value === 'number' && Number.isFinite(value),

+140

boolean: value => typeof value === 'boolean',

+141

object: value => value !== null && typeof value === 'object' && !Array.isArray(value),

+142

array: Array.isArray,

+143

'nullable-object': value => value === null || typeChecks.object(value),

+144

'nullable-string': value => value === null || typeof value === 'string',

+145

  repo: value => typeChecks.object(value) && ['root', 'worktree', 'common_dir'].every(k => typeof value[k] === 'string'),

+146

  'node-repo': value => typeChecks.object(value) && ['worktree', 'common_dir'].every(k => typeof value[k] === 'string') && !Object.hasOwn(value, 'root'),

+147

  snapshot: value => typeChecks.object(value) && ['head_oid', 'index_id', 'worktree_id'].every(k => typeof value[k] === 'string'),

+148

hunk: value => typeChecks.object(value) && typeof value.file_id === 'string' &&

+149

['old_start', 'old_lines', 'new_start', 'new_lines'].every(k => Number.isInteger(value[k])) &&

+150

typeof value.side === 'string' && typeof value.context_hash === 'string',

+151

'diff-kind': value => ['worktree-file', 'index-file', 'staged-all', 'commit'].includes(value),

+152

};

+153

+154

function validateSchema(schema, value, label) {

+155

assert(typeChecks.object(value), `${label}: value is not an object`);

+156

assert(typeChecks.object(schema) && typeChecks.object(schema.required), `${label}: required schema missing`);

+157

for (const [field, type] of Object.entries(schema.required)) {

+158

assert(typeChecks[type], `${label}: unknown field type ${type}`);

+159

assert(Object.hasOwn(value, field), `${label}: missing ${field}`);

+160

assert(typeChecks[type](value[field]), `${label}: ${field} is not ${type}`);

+161

}

+162

return value;

+163

}

+164

+165

const repoValue = { root: 'home', worktree: '/work/app', common_dir: '/work/app/.git' };

+166

const snapshotValue = { head_oid: 'a'.repeat(40), index_id: 'index-1', worktree_id: 'worktree-1' };

+167

const hunkValue = { file_id: 'file-1', side: 'worktree', old_start: 1, old_lines: 2, new_start: 1, new_lines: 2, context_hash: 'ctx-1' };

+168

+169

function requestExample(verb) {

+170

if (verb === 'git/discover') return { path: '/work/app' };

+171

if (verb === 'git/status') return { repo: repoValue, recent_limit: 20 };

+172

  if (verb === 'git/diff') return { repo: repoValue, snapshot: snapshotValue, kind: 'worktree-file', target: 'file-1', cursor: null, max_lines: 400, max_bytes: 262144 };

+173

if (verb.endsWith('-file')) return { repo: repoValue, expected_snapshot: snapshotValue, entry_id: 'file-1' };

+174

return { repo: repoValue, expected_snapshot: snapshotValue, hunk_id: hunkValue };

+175

}

+176

+177

function resultExample(verb) {

+178

const base = { version: 1, repo: repoValue };

+179

  if (verb === 'git/discover') return { version: 1, node_repo: { worktree: '/work/app', common_dir: '/work/app/.git' }, bare: false, object_format: 'sha1' };

+180

  if (verb === 'git/status') return { ...base, snapshot: snapshotValue, branch: {}, operation: null, entries: [], recent_commits: [], capabilities: {} };

+181

  if (verb === 'git/diff') return { ...base, snapshot: snapshotValue, files: [], next_cursor: null, complete: true, truncation: null };

+182

return { ...base, snapshot: snapshotValue };

+183

}

+184

+185

class FakeNodeLane {

+186

constructor() { this.records = []; this.held = []; this.active = 0; this.peak = 0; }

+187

request(destination, verb, args, onReady) {

+188

    const record = { id: this.records.length + 1, destination, verb, args, bytes: Buffer.byteLength(JSON.stringify(args)), outcome: 'held' };

+189

this.records.push(record);

+190

this.held.push(() => {

+191

this.active += 1;

+192

this.peak = Math.max(this.peak, this.active);

+193

const result = resultExample(verb);

+194

record.reply_bytes = Buffer.byteLength(JSON.stringify(result));

+195

record.outcome = 'ok';

+196

onReady(result, record);

+197

this.active -= 1;

+198

});

+199

return record.id;

+200

}

+201

release(index = 0) { const deliver = this.held.splice(index, 1)[0]; assert(deliver, 'no held reply'); deliver(); }

+202

}

+203

+204

try {

+205

assert.equal(contract.version, 1, 'contract version must be 1');

+206

  assert.deepEqual(contract.errors, ['not-a-repository', 'git-unavailable', 'grant-denied', 'stale-snapshot', 'conflict', 'operation-failed'], 'error vocabulary drifted');

+207

  assert.deepEqual(contract.limits, { diff_page_lines: 400, diff_page_bytes: 262144, diff_concurrency: 2, mounted_rows: 800, recent_commits: 50, error_bytes: 4096 }, 'v1 ceilings drifted');

+208

+209

const fixtures = buildFixtures();

+210

  for (const required of ['clean', 'unborn', 'mixed', 'rename', 'binary', 'mode-change', 'conflict', 'detached', 'ahead-behind', 'in-progress', 'special-names', 'multi-hunk', 'large-diff']) {

+211

assert(fixtures.has(required), `fixture missing: ${required}`);

+212

}

+213

  assert(git(fixtures.get('mixed'), 'status', '--porcelain=v2', '-z').includes('base.txt'), 'mixed fixture has no status records');

+214

  assert(git(fixtures.get('conflict'), 'status', '--porcelain=v2', '-z').startsWith('u '), 'conflict fixture has no unmerged record');

+215

const detachedProbe = spawnSync('git', ['symbolic-ref', '-q', 'HEAD'], {

+216

cwd: fixtures.get('detached'), env: gitEnv, encoding: 'utf8'

+217

});

+218

assert.equal(detachedProbe.status, 1, 'detached fixture is attached');

+219

  assert(git(fixtures.get('ahead-behind'), 'rev-list', '--count', 'upstream-base..main').trim() === '1', 'ahead fixture is not ahead');

+220

  assert(git(fixtures.get('ahead-behind'), 'rev-list', '--count', 'main..upstream-base').trim() === '1', 'ahead fixture is not behind');

+221

  assert(readFileSync(join(fixtures.get('large-diff'), 'huge.txt')).byteLength > 3 * 1024 * 1024, 'large diff fixture is not multi-megabyte');

+222

const specialStatus = git(fixtures.get('special-names'), 'status', '--porcelain=v2', '-z');

+223

  for (const name of ['space name.txt', 'tab\tname.txt', 'line\nname.txt', 'naïve.txt', '-leading.txt', 'from -> to.txt']) assert(specialStatus.includes(name), `special filename missing: ${JSON.stringify(name)}`);

+224

+225

const verbs = Object.entries(contract.verbs || {});

+226

assert(verbs.length > 0, 'contract declares no verbs');

+227

for (const [verb, spec] of verbs) {

+228

assert(typeChecks.object(spec.request), `${verb}: missing request validation`);

+229

assert(spec.fixture && fixtures.has(spec.fixture), `${verb}: missing fixture`);

+230

if (!typeChecks.object(spec.decoder)) fail(`${verb}: missing decoder`);

+231

assert(Array.isArray(spec.errors) && spec.errors.length > 0, `${verb}: missing error arm`);

+232

for (const code of spec.errors) assert(contract.errors.includes(code), `${verb}: unknown error arm ${code}`);

+233

validateSchema(spec.request, requestExample(verb), `${verb} request`);

+234

validateSchema(spec.decoder, resultExample(verb), `${verb} decoder`);

+235

const missing = { ...requestExample(verb) };

+236

delete missing[Object.keys(spec.request.required)[0]];

+237

    assert.throws(() => validateSchema(spec.request, missing, `${verb} invalid request`), /missing/, `${verb}: validator accepted missing field`);

+238

}

+239

+240

const lane = new FakeNodeLane();

+241

const results = [];

+242

lane.request('node-local', 'git/status', requestExample('git/status'), result => results.push(result));

+243

lane.request('node-remote', 'git/status', requestExample('git/status'), result => results.push(result));

+244

assert.equal(results.length, 0, 'held reply delivered synchronously');

+245

lane.release(1); // Deliberately deliver remote before local.

+246

lane.release(0);

+247

assert.deepEqual(results[0], results[1], 'local/remote semantic results differ');

+248

  assert.deepEqual(lane.records.map(r => r.destination), ['node-local', 'node-remote'], 'root destinations were not distinct');

+249

  assert(lane.records.every(r => r.id && r.bytes > 0 && r.reply_bytes > 0 && r.outcome === 'ok'), 'correlation/accounting record incomplete');

+250

+251

console.log(`PASS git-contract: ${verbs.length}/${verbs.length} verbs; local/remote root matrix 2/2`);

+252

} catch (error) {

+253

console.error(`git-contract: FAIL -- ${error.message}`);

+254

process.exit(1);

+255

}

packages/slate/test/git-contract-v1.jsonadded

@@ -0,0 +1,63 @@

+1

{

+2

"version": 1,

+3

"limits": {

+4

"diff_page_lines": 400,

+5

"diff_page_bytes": 262144,

+6

"diff_concurrency": 2,

+7

"mounted_rows": 800,

+8

"recent_commits": 50,

+9

"error_bytes": 4096

+10

},

+11

"errors": [

+12

"not-a-repository",

+13

"git-unavailable",

+14

"grant-denied",

+15

"stale-snapshot",

+16

"conflict",

+17

"operation-failed"

+18

],

+19

"verbs": {

+20

"git/discover": {

+21

"request": {"required": {"path": "string"}},

+22

"fixture": "clean",

+23

      "decoder": {"required": {"version": "number", "node_repo": "node-repo", "bare": "boolean", "object_format": "string"}},

+24

"errors": ["not-a-repository", "git-unavailable", "grant-denied", "operation-failed"]

+25

},

+26

"git/status": {

+27

"request": {"required": {"repo": "repo", "recent_limit": "number"}},

+28

"fixture": "mixed",

+29

      "decoder": {"required": {"version": "number", "repo": "repo", "snapshot": "snapshot", "branch": "object", "operation": "nullable-object", "entries": "array", "recent_commits": "array", "capabilities": "object"}},

+30

"errors": ["not-a-repository", "git-unavailable", "grant-denied", "conflict", "operation-failed"]

+31

},

+32

"git/diff": {

+33

      "request": {"required": {"repo": "repo", "snapshot": "snapshot", "kind": "diff-kind", "target": "nullable-string", "cursor": "nullable-string", "max_lines": "number", "max_bytes": "number"}},

+34

"fixture": "large-diff",

+35

      "decoder": {"required": {"version": "number", "repo": "repo", "snapshot": "snapshot", "files": "array", "next_cursor": "nullable-string", "complete": "boolean", "truncation": "nullable-object"}},

+36

      "errors": ["not-a-repository", "git-unavailable", "grant-denied", "stale-snapshot", "conflict", "operation-failed"]

+37

},

+38

"git/stage-file": {

+39

"request": {"required": {"repo": "repo", "expected_snapshot": "snapshot", "entry_id": "string"}},

+40

"fixture": "mixed",

+41

"decoder": {"required": {"version": "number", "repo": "repo", "snapshot": "snapshot"}},

+42

      "errors": ["not-a-repository", "git-unavailable", "grant-denied", "stale-snapshot", "conflict", "operation-failed"]

+43

},

+44

"git/unstage-file": {

+45

"request": {"required": {"repo": "repo", "expected_snapshot": "snapshot", "entry_id": "string"}},

+46

"fixture": "mixed",

+47

"decoder": {"required": {"version": "number", "repo": "repo", "snapshot": "snapshot"}},

+48

      "errors": ["not-a-repository", "git-unavailable", "grant-denied", "stale-snapshot", "conflict", "operation-failed"]

+49

},

+50

"git/stage-hunk": {

+51

"request": {"required": {"repo": "repo", "expected_snapshot": "snapshot", "hunk_id": "hunk"}},

+52

"fixture": "multi-hunk",

+53

"decoder": {"required": {"version": "number", "repo": "repo", "snapshot": "snapshot"}},

+54

      "errors": ["not-a-repository", "git-unavailable", "grant-denied", "stale-snapshot", "conflict", "operation-failed"]

+55

},

+56

"git/unstage-hunk": {

+57

"request": {"required": {"repo": "repo", "expected_snapshot": "snapshot", "hunk_id": "hunk"}},

+58

"fixture": "multi-hunk",

+59

"decoder": {"required": {"version": "number", "repo": "repo", "snapshot": "snapshot"}},

+60

      "errors": ["not-a-repository", "git-unavailable", "grant-denied", "stale-snapshot", "conflict", "operation-failed"]

+61

}

+62

}

+63

}

packages/slate/test/git-diff-browser-gate.mjsadded

@@ -0,0 +1,4 @@

+1

// A4 shipped-artifact drive builds on the A3 user-door fixture and enables

+2

// held, paged diff review assertions.

+3

process.env.A4_DIFF_GATE = '1';

+4

await import('./git-status-browser-gate.mjs');

packages/slate/test/git-diff-view-test.sgladded

@@ -0,0 +1,110 @@

+1

;;; A4 provider-neutral diff model, bounded view and late-page rejection.

+2

(import (sigil core) (sigil test) (slate provider) (slate root)

+3

(slate git diff-model) (slate git diff-view) (slate mode)

+4

(slate modes git-diff) (slate view))

+5

+6

(define HELD '())

+7

(define REQUESTS '())

+8

(define (held-git source verb args on-ready on-error)

+9

(set! REQUESTS (append REQUESTS (list args)))

+10

(set! HELD (append HELD (list (lambda ()

+11

(on-ready #{ version: 1 repo: (dict-ref args repo: #{})

+12

snapshot: (dict-ref args snapshot: #{})

+13

files: (list #{ id: "f" kind: "worktree" target: "a.sgl"

+14

hunks: (list #{ kind: hunk: text: "@@ -1 +1 @@" old-line: #f new-line: #f }

+15

#{ kind: deletion: text: "-old" old-line: 1 new-line: #f }

+16

#{ kind: addition: text: "+new" old-line: #f new-line: 1 }) })

+17

payload-bytes: 1024

+18

next-cursor: (if (dict-ref args cursor: #f) #f "diff:3")

+19

complete: (if (dict-ref args cursor: #f) #t #f) truncation: #f }))))))

+20

(register-provider! diff-held: #{ git-request: held-git })

+21

(register-root! diff-held: #{ provider: diff-held: host: "remote" class: machine: })

+22

(define SOURCE (root->source diff-held: file: "/repo/a.sgl"))

+23

(define REPO #{ root: diff-held: worktree: "/repo" common-dir: "/repo/.git" })

+24

(define SNAPSHOT #{ head-oid: "h" index-id: "i" worktree-id: "w" })

+25

(define (model) (make-git-diff-model SOURCE REPO SNAPSHOT "worktree" "a.sgl" #f))

+26

+27

(test "diff shell loads before a held remote page"

+28

(set! HELD '()) (set! REQUESTS '())

+29

(let ((m (model)))

+30

(git-diff-model-load! m)

+31

(assert-equal loading: (dict-ref (git-diff-model-state m) state: #f))

+32

(assert-equal 1 (length REQUESTS))

+33

((car HELD))

+34

(assert-equal ready: (dict-ref (git-diff-model-state m) state: #f))))

+35

+36

(test "late page after invalidation cannot mutate current view"

+37

(set! HELD '()) (set! REQUESTS '())

+38

(let ((m (model)))

+39

(git-diff-model-load! m)

+40

(git-diff-model-invalidate! m)

+41

((car HELD))

+42

(assert-equal #t (dict-ref (cadr REQUESTS) cancel: #f))

+43

(assert-equal "diff:3" (dict-ref (cadr REQUESTS) cursor: #f))

+44

(assert-equal idle: (dict-ref (git-diff-model-state m) state: #f))

+45

(assert-equal '() (dict-ref (git-diff-model-state m) pages: '(bad)))))

+46

+47

(test "continuation is explicit and mounted rows stay bounded"

+48

(set! HELD '())

+49

(let ((m (model)))

+50

(git-diff-model-load! m) ((car HELD))

+51

(let ((v #{ slate/git-diff-model: m slate/git-selected: #f }))

+52

(assert-equal 4 (length (git-diff-rows v)))

+53

(assert-equal continuation: (dict-ref (list-ref (git-diff-rows v) 3) kind: #f))

+54

(assert-true (<= (length (git-diff-rows v)) 800)))))

+55

+56

(test "load more is cursor based and appends a bounded page"

+57

(set! HELD '()) (set! REQUESTS '())

+58

(let ((m (model)))

+59

(git-diff-model-load! m) ((car HELD))

+60

(git-diff-model-more! m)

+61

(assert-equal "diff:3" (dict-ref (cadr REQUESTS) cursor: #f))

+62

((cadr HELD))

+63

(assert-equal #t (dict-ref (git-diff-model-state m) complete: #f))))

+64

+65

(test "client state retains only the two-page render window"

+66

(let* ((base #{ state: idle: pages: '() })

+67

(one (git-diff-reduce base #{ event: page: generation: 1

+68

page: #{ files: '() next-cursor: "1" complete: #f } }))

+69

(two (git-diff-reduce one #{ event: page: generation: 2

+70

page: #{ files: '() next-cursor: "2" complete: #f } }))

+71

(three (git-diff-reduce two #{ event: page: generation: 3

+72

page: #{ files: '() next-cursor: "3" complete: #f } })))

+73

(assert-equal 2 (length (dict-ref three pages: '())))))

+74

+75

(test "diff mode and root-qualified name are registered"

+76

(assert-true (dict? (mode-descriptor 'git-diff-mode)))

+77

(assert-true (string? (git-diff-view-name REPO "worktree" "a.sgl"))))

+78

+79

(test "deferred review retains presentation but revokes its cursor without fetching"

+80

(set! HELD '()) (set! REQUESTS '())

+81

(let ((m (model)))

+82

(git-diff-model-load! m) ((car HELD))

+83

(let ((lines (git-diff-lines (git-diff-model-state m))))

+84

(git-diff-model-defer! m REPO #{ head-oid: "h" index-id: "fresh" worktree-id: "w" })

+85

(assert-equal 2 (length REQUESTS))

+86

(assert-true (dict-ref (cadr REQUESTS) cancel: #f))

+87

(assert-equal SNAPSHOT (dict-ref (cadr REQUESTS) snapshot: #f))

+88

(assert-equal lines (git-diff-lines (git-diff-model-state m)))

+89

(assert-false (dict-ref (git-diff-model-state m) next-cursor: #f))

+90

(git-diff-model-more! m)

+91

(assert-equal 2 (length REQUESTS))

+92

(git-diff-model-resume! m)

+93

(git-diff-model-resume! m)

+94

(assert-equal 3 (length REQUESTS))

+95

(assert-equal lines (git-diff-lines (git-diff-model-state m)))

+96

((list-ref HELD 2))

+97

(assert-equal 1 (length (dict-ref (git-diff-model-state m) pages: '())))

+98

(assert-false (dict-ref (git-diff-model-state m) rebasing: #f)))))

+99

+100

(test "late page cancellation keeps the original snapshot after rebase"

+101

(set! HELD '()) (set! REQUESTS '())

+102

(let ((m (model)))

+103

(git-diff-model-load! m)

+104

(git-diff-model-reload! m REPO #{ head-oid: "h" index-id: "fresh" worktree-id: "w" })

+105

((car HELD))

+106

(assert-equal SNAPSHOT (dict-ref (list-ref REQUESTS 2) snapshot: #f))

+107

(assert-true (dict-ref (list-ref REQUESTS 2) cancel: #f))

+108

(assert-equal '() (git-diff-lines (git-diff-model-state m)))

+109

((cadr HELD))

+110

(assert-equal ready: (dict-ref (git-diff-model-state m) state: #f))))

packages/slate/test/git-discard-refresh-browser-gate.mjsadded

@@ -0,0 +1,8 @@

+1

import { spawnSync } from 'node:child_process';

+2

const gate = new URL('./git-status-browser-gate.mjs', import.meta.url);

+3

const result = spawnSync(process.execPath, [gate.pathname], {

+4

cwd: process.cwd(), env: { ...process.env, B3_DISCARD_REFRESH_GATE: '1' }, encoding: 'utf8'

+5

});

+6

process.stdout.write(result.stdout || '');

+7

process.stderr.write(result.stderr || '');

+8

process.exit(result.status ?? 1);

packages/slate/test/git-hunk-browser-gate.mjsadded

@@ -0,0 +1,8 @@

+1

import { spawnSync } from 'node:child_process';

+2

const gate = new URL('./git-status-browser-gate.mjs', import.meta.url);

+3

const result = spawnSync(process.execPath, [gate.pathname], {

+4

cwd: process.cwd(), env: { ...process.env, B2_HUNK_GATE: '1' }, encoding: 'utf8'

+5

});

+6

process.stdout.write(result.stdout || '');

+7

process.stderr.write(result.stderr || '');

+8

process.exit(result.status ?? 1);

packages/slate/test/git-log-browser-gate.mjsadded

@@ -0,0 +1,105 @@

+1

import assert from 'node:assert/strict';

+2

import fs from 'node:fs';

+3

import path from 'node:path';

+4

+5

export async function historyGate({tab, send, sgl, evalIn, waitFor, key, sentFrames,

+6

diffReleaseFile, historyReleaseFile, gateRoot}) {

+7

const dispatch = command => sgl(`(slate-dispatch ${JSON.stringify(command)})`);

+8

const count = verb => sentFrames.filter(frame => frame.includes(verb)).length;

+9

const screenshot = async name => {

+10

if (!process.env.GIT_HISTORY_SCREENSHOTS) return;

+11

fs.mkdirSync(process.env.GIT_HISTORY_SCREENSHOTS, {recursive:true});

+12

const result = await send('Page.captureScreenshot', {format:'png'}, tab.sessionId);

+13

fs.writeFileSync(path.join(process.env.GIT_HISTORY_SCREENSHOTS, name+'.png'), Buffer.from(result.data,'base64'));

+14

};

+15

await send('Emulation.setDeviceMetricsOverride',

+16

{width:1280,height:900,deviceScaleFactor:1,mobile:false},tab.sessionId);

+17

await dispatch('git-layout:auto');

+18

const before = count('git/log');

+19

await key('l');

+20

  await waitFor(tab, `document.querySelector('.git-log')?.textContent.includes('Loading history')`, 'responsive history shell');

+21

await key('g');

+22

assert.equal(count('git/log'),before+1,'refresh duplicated held history request');

+23

await key('q');

+24

await waitFor(tab, `!!document.querySelector('.git-status')`, 'close pending history');

+25

fs.writeFileSync(historyReleaseFile,'release\n');

+26

await key('l');

+27

await waitFor(tab, `document.querySelectorAll('.git-log-row').length === 50`, 'first bounded history page');

+28

assert.ok(sentFrames.filter(f=>f.includes('git/log')).every(f=>f.includes(gateRoot)),

+29

'history request lost root identity');

+30

assert.equal(count('git/show'),0,'history list eagerly inspected a commit');

+31

const first = await evalIn(tab, `document.querySelector('.git-log-row').dataset.oid`);

+32

const requests = sentFrames.length;

+33

await key('n'); await key('p');

+34

assert.equal(await evalIn(tab, `document.querySelector('.git-log-row.selected').dataset.oid`),first);

+35

assert.equal(sentFrames.length,requests,'history navigation started network work');

+36

fs.writeFileSync(diffReleaseFile,'release\n');

+37

// A real pointer click both selects and loads, without an extra Enter.

+38

  const point = await evalIn(tab, `(()=>{const r=document.querySelector('.git-log-row').getBoundingClientRect();return {x:r.x+r.width/2,y:r.y+r.height/2}})()`);

+39

await send('Input.dispatchMouseEvent',{type:'mousePressed',button:'left',clickCount:1,...point},tab.sessionId);

+40

await send('Input.dispatchMouseEvent',{type:'mouseReleased',button:'left',clickCount:1,...point},tab.sessionId);

+41

  await waitFor(tab, `[...document.querySelectorAll('.git-log-review .slate-diff-addition')].some(row=>row.textContent.includes('history inspection marker'))`,

+42

'selected commit patch');

+43

assert.ok(sentFrames.filter(f=>/git\/(show|diff)/.test(f)).every(f=>f.includes(gateRoot)),

+44

'commit inspection routing identity mismatch');

+45

assert.equal(await evalIn(tab, `getComputedStyle(document.querySelector('.git-log-workbench')).display`),'grid');

+46

await evalIn(tab, `window.__historyReview=document.querySelector('.git-log-inspection'); true`);

+47

const loadedRequests = sentFrames.length;

+48

await key('n'); await key('p');

+49

assert.ok(await evalIn(tab, `window.__historyReview===document.querySelector('.git-log-inspection')`),

+50

'history selection replaced the memoized review');

+51

assert.equal(sentFrames.length,loadedRequests,'moving with an open review fetched data');

+52

  assert.ok(await evalIn(tab, `document.querySelector('.git-log-message strong')?.textContent==='committed change' && !!document.querySelector('.git-log-message li code') && !!document.querySelector('.git-log-message pre code')`), 'commit Markdown was not rendered');

+53

  assert.equal(await evalIn(tab, `getComputedStyle(document.querySelector('.git-log-review .slate-diff-control')).borderLeftWidth`),'0px');

+54

await key('Enter');

+55

assert.equal(await evalIn(tab, `document.querySelector('.git-log').dataset.focus`),'review');

+56

await key('PageDown');

+57

await waitFor(tab, `document.querySelector('.git-log-review-body').scrollTop>100`, 'keyboard review page scroll');

+58

const pageScroll = await evalIn(tab, `document.querySelector('.git-log-review-body').scrollTop`);

+59

await key('n');

+60

await waitFor(tab, `document.querySelector('.git-log-review-body').scrollTop>${pageScroll}`, 'review n scroll');

+61

  assert.equal(await evalIn(tab, `document.querySelector('.git-log-row.selected').dataset.oid`),first,'review scroll moved commit selection');

+62

  assert.ok(await evalIn(tab, `window.__historyReview===document.querySelector('.git-log-inspection')`), 'review scroll rebuilt patch DOM');

+63

assert.equal(sentFrames.length,loadedRequests,'focus or scroll fetched data');

+64

await key('Home');

+65

await waitFor(tab, `document.querySelector('.git-log-review-body').scrollTop===0`, 'review Home');

+66

await key('Tab');

+67

assert.equal(await evalIn(tab, `document.querySelector('.git-log').dataset.focus`),'list');

+68

await key('Tab');

+69

assert.equal(await evalIn(tab, `document.querySelector('.git-log').dataset.focus`),'review');

+70

await key('Escape');

+71

assert.equal(await evalIn(tab, `document.querySelector('.git-log').dataset.focus`),'list');

+72

await screenshot('split');

+73

// Real keyboard clipboard uses the existing single-shot command clipboard seam.

+74

await evalIn(tab, `window.__historyClipboard=''; Object.defineProperty(navigator,'clipboard',

+75

{configurable:true,value:{writeText:async text=>{window.__historyClipboard=text;}}}); true`);

+76

await key('w');

+77

assert.equal(await evalIn(tab, `window.__historyClipboard`),first,'keyboard Copy ID failed');

+78

await key(']');

+79

  await waitFor(tab, `document.querySelector('.git-log-pagination')?.textContent.includes('51–')`, 'older history page');

+80

  assert.ok(await evalIn(tab, `document.querySelectorAll('.git-log-row').length <= 50`),'history DOM grew beyond its page');

+81

await key('[');

+82

  await waitFor(tab, `document.querySelector('.git-log-row')?.dataset.oid===${JSON.stringify(first)}`, 'newer history page');

+83

await dispatch('git-layout:inline');

+84

  assert.ok(await evalIn(tab, `(()=>{const l=document.querySelector('.git-log-list').getBoundingClientRect(),r=document.querySelector('.git-log-review').getBoundingClientRect(),w=document.querySelector('.git-log-workbench').getBoundingClientRect();return r.top>=l.bottom-1 && r.bottom<=w.bottom+1 && r.height>150})()`),'stacked review is not visible alongside list');

+85

await key('Enter');

+86

await waitFor(tab, `!!document.querySelector('.git-log-inspection')`, 'reopen review after paging');

+87

await screenshot('stacked');

+88

await dispatch('git-layout:auto');

+89

await send('Emulation.setDeviceMetricsOverride',

+90

{width:390,height:844,deviceScaleFactor:1,mobile:true},tab.sessionId);

+91

  await waitFor(tab, `(()=>{const l=document.querySelector('.git-log-list').getBoundingClientRect(),r=document.querySelector('.git-log-review').getBoundingClientRect(),v=document.querySelector('.git-log').getBoundingClientRect();return r.top>=l.bottom-1 && r.bottom<=v.bottom && r.height>100})()`, 'mobile inline history');

+92

  assert.ok(await evalIn(tab, `(()=>{const v=document.querySelector('.git-log');return v.scrollWidth<=v.clientWidth})()`),

+93

'history overflows mobile width');

+94

assert.ok(await evalIn(tab, `document.querySelector('.git-log-row').getBoundingClientRect().height>=44`),

+95

'history touch targets too small');

+96

await key('PageDown');

+97

await waitFor(tab, `document.querySelector('.git-log-review-body').scrollTop>50`, 'mobile keyboard review scroll');

+98

await key('Home');

+99

await screenshot('mobile');

+100

await send('Emulation.setDeviceMetricsOverride',

+101

{width:1280,height:900,deviceScaleFactor:1,mobile:false},tab.sessionId);

+102

await key('q');

+103

await waitFor(tab, `!!document.querySelector('.git-status')`, 'return to status');

+104

console.log(JSON.stringify({history:'PASS',root:gateRoot,boundedPages:true,lazyReview:true,clipboard:true}));

+105

}

packages/slate/test/git-log-test.sgladded

@@ -0,0 +1,107 @@

+1

(import (sigil test) (slate provider) (slate root) (slate git log-model) (slate git log-view))

+2

(define OID-A (make-string 40 #\a))

+3

(define OID-B (make-string 40 #\b))

+4

(define OID-C (make-string 40 #\c))

+5

(define REPO #{ root: "history" worktree: "/same/repo" common-dir: "/same/repo/.git" })

+6

(define SNAP #{ head-oid: OID-A index-id: "i" worktree-id: "w" })

+7

(define REQUESTS '())

+8

(define HELD '())

+9

(register-provider! history-test:

+10

#{ git-request: (lambda (source verb args ready error)

+11

(set! REQUESTS (append REQUESTS (list (list (dict-ref source host: #f) verb args))))

+12

(set! HELD (append HELD (list ready)))) })

+13

(register-root! history: #{ provider: history-test: host: "remote-a" class: machine: })

+14

(define (model)

+15

(set! REQUESTS '()) (set! HELD '())

+16

(make-git-log-model (root->source history: dir: "/same/repo") REPO #f))

+17

(define (commit oid parents) #{ oid: oid subject: "Subject" parents: parents })

+18

(define (page commits offset cursor)

+19

#{ version: 1 repo: REPO snapshot: SNAP commits: commits offset: offset next-cursor: cursor complete: (not cursor) })

+20

(test "history opens asynchronously and only requests its selected root"

+21

(let ((m (model)))

+22

(git-log-model-load! m)

+23

(assert-equal loading: (dict-ref (git-log-model-state m) state: #f))

+24

(assert-equal "remote-a" (caar REQUESTS))

+25

(assert-equal "git/log" (cadar REQUESTS))

+26

((car HELD) (page (list (commit OID-A (list OID-B)) (commit OID-B '())) 0 #f))

+27

(let* ((v #{ slate/git-log-model: m }) (next (git-log-move v 1)))

+28

(assert-equal OID-B (dict-ref (git-log-selected next) oid: #f))

+29

(assert-equal 1 (length REQUESTS)))))

+30

(test "held older page coalesces and replaces the current window"

+31

(let ((m (model)))

+32

(git-log-model-load! m)

+33

((car HELD) (page (list (commit OID-A '())) 0 #{ head-oid: OID-A offset: 50 }))

+34

(git-log-model-page! m 1) (git-log-model-page! m 1)

+35

(assert-equal 2 (length REQUESTS))

+36

((cadr HELD) (page (list (commit OID-B '())) 50 #f))

+37

(assert-equal 1 (length (git-log-commits m)))

+38

(assert-equal OID-B (dict-ref (car (git-log-commits m)) oid: #f))

+39

(git-log-model-page! m -1)

+40

(assert-equal 0 (dict-ref (dict-ref (caddr (list-ref REQUESTS 2)) cursor: #{}) offset: -1))))

+41

(test "refresh rejects out-of-order pages and close rejects late replies"

+42

(let ((m (model)))

+43

(git-log-model-load! m) (git-log-model-load! m)

+44

((car HELD) (page (list (commit OID-A '())) 0 #f))

+45

(assert-equal loading: (dict-ref (git-log-model-state m) state: #f))

+46

(git-log-model-dispose! m)

+47

((cadr HELD) (page (list (commit OID-B '())) 0 #f))

+48

(assert-equal '() (git-log-commits m))))

+49

(test "same paths on the wrong root cannot supply history"

+50

(let ((m (model)))

+51

(git-log-model-load! m)

+52

((car HELD) (dict-set (page (list (commit OID-A '())) 0 #f) repo: (dict-set REPO root: "other-root")))

+53

(assert-equal error: (dict-ref (git-log-model-state m) state: #f))))

+54

(test "inspection is lazy and late metadata cannot start an obsolete patch"

+55

(let ((m (model)))

+56

(git-log-model-inspect! m OID-A)

+57

(git-log-model-inspect! m OID-B)

+58

(assert-equal 1 (length REQUESTS))

+59

((car HELD) #{ version: 1 repo: REPO snapshot: SNAP commit: (commit OID-A '()) })

+60

(assert-equal 2 (length REQUESTS))

+61

((cadr HELD) #{ version: 1 repo: REPO snapshot: SNAP commit: (commit OID-B '()) })

+62

(assert-equal "git/diff" (cadr (list-ref REQUESTS 2)))

+63

(assert-equal OID-B (dict-ref (caddr (list-ref REQUESTS 2)) target: #f))))

+64

(test "wrong-root show reply never starts a patch"

+65

(let ((m (model)))

+66

(git-log-model-inspect! m OID-A)

+67

((car HELD) #{ version: 1 repo: (dict-set REPO root: "other-root") snapshot: SNAP commit: (commit OID-A '()) })

+68

(assert-equal 1 (length REQUESTS))

+69

(assert-equal error: (dict-ref (dict-ref (git-log-model-state m) review: #{}) state: #f))))

+70

(test "merge lanes connect both parents and converge"

+71

(let ((rows (git-log-graph (list (commit OID-A (list OID-B OID-C))

+72

(commit OID-B (list OID-C)) (commit OID-C '())))))

+73

(assert-equal 2 (length (dict-ref (car rows) edges: '())))

+74

(assert-equal 1 (dict-ref (cadr rows) after: -1))

+75

(assert-equal 0 (dict-ref (caddr rows) after: -1))))

+76

+77

(import (slate modes git-log))

+78

(test "history shell and loaded rows render through the shipped mode"

+79

(let ((m (model)))

+80

(git-log-model-load! m)

+81

(assert-true (pair? (git-log-render #{ slate/git-log-model: m })))

+82

((car HELD) (page (list (commit OID-A (list OID-B))) 0 #f))

+83

(assert-true (pair? (git-log-render #{ slate/git-log-model: m })))))

+84

+85

(test "oversized history pages are rejected before mounting rows"

+86

(let ((m (model)))

+87

(git-log-model-load! m)

+88

((car HELD) (page (make-list 51 (commit OID-A '())) 0 #f))

+89

(assert-equal error: (dict-ref (git-log-model-state m) state: #f))

+90

(assert-equal '() (git-log-commits m))))

+91

(test "closing a queued inspection cannot start another metadata request"

+92

(let ((m (model)))

+93

(git-log-model-inspect! m OID-A)

+94

(git-log-model-inspect! m OID-B)

+95

(git-log-model-dispose! m)

+96

((car HELD) #{ version: 1 repo: REPO snapshot: SNAP commit: (commit OID-A '()) })

+97

(assert-equal 1 (length REQUESTS))))

+98

(test "ref refresh preserves the selected history page and open review"

+99

(let ((m (model)))

+100

(git-log-model-load! m)

+101

((car HELD) (page (list (commit OID-A '())) 50 #f))

+102

(git-log-model-inspect! m OID-A)

+103

(let ((review (dict-ref (git-log-model-state m) review: #f)))

+104

(git-log-model-refresh! m)

+105

(assert-equal 50 (dict-ref (dict-ref (caddr (car (reverse REQUESTS))) cursor: #{}) offset: 0))

+106

((car (reverse HELD)) (page (list (commit OID-A '())) 50 #f))

+107

(assert-true (eq? review (dict-ref (git-log-model-state m) review: #f))))))

packages/slate/test/git-mutation-browser-gate.mjsadded

@@ -0,0 +1,8 @@

+1

import { spawnSync } from 'node:child_process';

+2

const gate = new URL('./git-status-browser-gate.mjs', import.meta.url);

+3

const result = spawnSync(process.execPath, [gate.pathname], {

+4

cwd: process.cwd(), env: { ...process.env, B1_MUTATION_GATE: '1' }, encoding: 'utf8'

+5

});

+6

process.stdout.write(result.stdout || '');

+7

process.stderr.write(result.stderr || '');

+8

process.exit(result.status ?? 1);

packages/slate/test/git-navigation-browser-gate.mjsadded

@@ -0,0 +1,93 @@

+1

// Real keyboard navigation through a paged HTML patch, including row groups.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

+5

export async function navigationGate({tab, send, sgl, evalIn, waitFor, key,

+6

sentFrames, diffReleaseFile}) {

+7

if (process.env.GIT_MEMO_GATE === '1') await memoBoundaryGate({tab, sgl, evalIn});

+8

fs.writeFileSync(diffReleaseFile, 'release\n');

+9

await send('Emulation.setDeviceMetricsOverride',

+10

{width:1280, height:900, deviceScaleFactor:1, mobile:false}, tab.sessionId);

+11

const dispatch = command => sgl(`(slate-dispatch ${JSON.stringify(command)})`);

+12

const expand = await evalIn(tab, `[...document.querySelectorAll('.git-unstaged')]

+13

    .find(e=>e.textContent.includes('navigation.html'))?.querySelector('.git-entry-toggle')?.getAttribute('data-slate-click')`);

+14

assert.ok(expand, 'HTML fixture is absent');

+15

await dispatch(expand);

+16

await waitFor(tab, `document.querySelectorAll('.slate-diff-row').length > 300`, 'HTML diff page');

+17

  const more = await evalIn(tab, `document.querySelector('.slate-diff-continuation')?.getAttribute('data-slate-click')`);

+18

assert.ok(more, 'large HTML diff has no continuation');

+19

await dispatch(more);

+20

await waitFor(tab, `document.querySelectorAll('.slate-diff-row').length > 650`, 'second HTML diff page');

+21

if (process.env.GIT_NAVIGATION_BASELINE !== '1') {

+22

assert.ok(await evalIn(tab, `(() => {

+23

const groups=[...document.querySelectorAll('.slate-diff-control > [role="rowgroup"]')];

+24

return groups.length > 1 && groups.every(g=>g.children.length <= 32);

+25

})()`), 'diff sibling fanout is unbounded');

+26

}

+27

const requestCount = sentFrames.filter(f=>f.includes('git/diff')).length;

+28

for (const layout of ['split', 'inline']) {

+29

await dispatch(`git-layout:${layout}`);

+30

const commands = await evalIn(tab, `[...document.querySelectorAll('.slate-diff-row')]

+31

.map(e=>e.getAttribute('data-slate-click'))`);

+32

// Cross a row-group boundary, then return across it with real n/p events.

+33

await dispatch(commands[28]);

+34

await evalIn(tab, `window.__navigationRows=[...document.querySelectorAll('.slate-diff-row')]; true`);

+35

const durations=[];

+36

let point=28;

+37

for (let i=0;i<24;i++) {

+38

const direction=i<12 ? 1 : -1;

+39

const started=performance.now();

+40

await key(direction>0 ? 'n' : 'p');

+41

durations.push(performance.now()-started);

+42

point+=direction;

+43

      assert.equal(await evalIn(tab, `document.querySelector('.slate-diff-row.selected')?.getAttribute('data-slate-click')`),

+44

commands[point], 'keyboard point skipped or repeated a line');

+45

}

+46

assert.ok(await evalIn(tab, `window.__navigationRows.every((row,i)=>

+47

row===document.querySelectorAll('.slate-diff-row')[i])`), 'navigation replaced unchanged diff nodes');

+48

const sorted=[...durations].sort((a,b)=>a-b);

+49

console.log(JSON.stringify({navigation:layout, rows:commands.length,

+50

medianMs:sorted[Math.floor(sorted.length/2)], p95Ms:sorted[Math.floor(sorted.length*0.95)]}));

+51

}

+52

assert.equal(sentFrames.filter(f=>f.includes('git/diff')).length, requestCount,

+53

'navigation fetched a diff');

+54

}

+55

+56

// Exercise the actual lazy renderer, including how much row preparation runs.

+57

// Keep this root outside Slate's frame and remove it before the navigation gate.

+58

async function memoBoundaryGate({tab, sgl, evalIn}) {

+59

await evalIn(tab, `(() => {const root=document.createElement('div');

+60

root.id='diff-memo-gate'; document.body.append(root); return true;})()`);

+61

try {

+62

await sgl(`(begin (import (sigil web client) (slate components diff))

+63

(define memo-prepared 0)

+64

(define memo-point "31")

+65

(define memo-revision 1)

+66

(define memo-rows

+67

(let loop ((i 0) (out '()))

+68

(if (= i 70) (reverse out)

+69

(loop (+ i 1) (cons #{ id: (number->string i) kind: addition: text: "+line" } out)))))

+70

(define (memo-draw)

+71

(set! memo-prepared 0)

+72

(web-client-update "#diff-memo-gate"

+73

(lambda () (diff-control-render memo-rows memo-point #f revision: memo-revision

+74

prepare-row: (lambda (row) (set! memo-prepared (+ memo-prepared 1)) row))))

+75

(number->string memo-prepared)))`);

+76

assert.equal(await sgl('(memo-draw)'), '70', 'initial groups were not produced');

+77

assert.equal(await sgl('(memo-draw)'), '0', 'unchanged groups were reconstructed');

+78

assert.equal(await sgl('(begin (set! memo-point "32") (memo-draw))'), '64',

+79

'crossing a group boundary did not update exactly two groups');

+80

assert.equal(await sgl('(begin (set! memo-point "33") (memo-draw))'), '32',

+81

'moving within a group rebuilt unrelated rows');

+82

assert.equal(await sgl('(begin (set! memo-revision 2) (memo-draw))'), '70',

+83

'changed content did not invalidate memoized groups');

+84

assert.ok(await evalIn(tab, `!document.querySelector('#diff-memo-gate [memo], #diff-memo-gate [key]')`),

+85

'memo metadata leaked into DOM attributes');

+86

await sgl('(web-client-clear "#diff-memo-gate")');

+87

assert.equal(await sgl('(memo-draw)'), '70', 'cleared groups reused obsolete DOM records');

+88

console.log(JSON.stringify({memoBoundaries:'PASS', unchangedRowsPrepared:0, withinGroup:32, acrossGroups:64}));

+89

} finally {

+90

await sgl('(web-client-clear "#diff-memo-gate")');

+91

await evalIn(tab, `document.getElementById('diff-memo-gate')?.remove(); true`);

+92

}

+93

}

packages/slate/test/git-provider-routing-test.sgladded

@@ -0,0 +1,30 @@

+1

;;; A1 provider/root parity: one operation contract, distinct destinations.

+2

(import (sigil core) (sigil test) (slate provider) (slate root))

+3

+4

(define DESTINATIONS '())

+5

(define (recording-op destination)

+6

(lambda (source verb args on-ready on-error)

+7

(set! DESTINATIONS (append DESTINATIONS (list destination)))

+8

(on-ready #{ version: 1 semantic: "same" verb: verb })))

+9

+10

(register-provider! git-local-test:

+11

#{ git-request: (recording-op "node-local") })

+12

(register-provider! git-remote-test:

+13

#{ git-request: (recording-op "node-remote") })

+14

(register-root! git-local-root:

+15

#{ provider: git-local-test: class: local: })

+16

(register-root! git-remote-root:

+17

#{ provider: git-remote-test: host: "remote" class: machine: })

+18

+19

(test "local and remote roots return identical semantics on distinct nodes"

+20

(set! DESTINATIONS '())

+21

(let* ((results '())

+22

(ready (lambda (value) (set! results (append results (list value))))))

+23

(source-git-request

+24

(root->source git-local-root: dir: "/same/repo")

+25

"git/status" #{} ready (lambda (e) (error e)))

+26

(source-git-request

+27

(root->source git-remote-root: dir: "/same/repo")

+28

"git/status" #{} ready (lambda (e) (error e)))

+29

(assert-equal (car results) (cadr results))

+30

(assert-equal (list "node-local" "node-remote") DESTINATIONS)))

packages/slate/test/git-review-browser-gate.mjsadded

@@ -0,0 +1,141 @@

+1

// Real transport and post-boot rendering checks for Git review continuity.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import path from 'node:path';

+5

+6

export async function reviewContinuityGate({tab, send, sgl, evalIn, waitFor, key,

+7

sentFrames, repo, diffReleaseFile, heldFile, releaseFile, sleep, runGit}) {

+8

fs.writeFileSync(diffReleaseFile, 'release\n');

+9

await send('Emulation.setDeviceMetricsOverride',

+10

{width:1280, height:900, deviceScaleFactor:1, mobile:false}, tab.sessionId);

+11

await sgl('(slate-dispatch "git-layout:split")');

+12

const dispatch = command => sgl(`(slate-dispatch ${JSON.stringify(command)})`);

+13

const entry = (file, side = 'unstaged') =>

+14

    `[...document.querySelectorAll('.git-${side}')].find(e=>e.querySelector('.git-entry-path')?.textContent===${JSON.stringify(file)})`;

+15

const review = (file, side = 'unstaged') => `(${entry(file, side)})?.nextElementSibling`;

+16

const expandSection = async side => {

+17

    await evalIn(tab, `document.querySelector('.git-section-toggle[aria-expanded="false"][data-slate-click="git-select-toggle:section:${side}"]')?.click()`);

+18

};

+19

const choose = async (file, side = 'unstaged') => {

+20

await expandSection(side);

+21

const command = await evalIn(tab, `(${entry(file, side)})?.getAttribute('data-slate-click')`);

+22

assert.ok(command, `missing ${side} file ${file}`);

+23

await dispatch(command);

+24

};

+25

const open = async (file, side = 'unstaged') => {

+26

await choose(file, side);

+27

    if (await evalIn(tab, `(${entry(file, side)})?.querySelector('.git-entry-toggle')?.getAttribute('aria-expanded') !== 'true'`))

+28

await key('Tab');

+29

await waitFor(tab, `(${review(file, side)})?.querySelector('.slate-diff-mutation') &&

+30

!(${review(file, side)})?.querySelector('.git-review-refresh')`, `ready review ${side}/${file}`);

+31

assert.equal(await evalIn(tab, `(${review(file, side)})?.querySelector('.slate-diff-mutation')?.title`),

+32

side === 'staged' ? 'Unstage hunk' : 'Stage hunk', 'hunk label disagrees with its action');

+33

};

+34

const requests = file => sentFrames.filter(frame => frame.includes('git/diff') &&

+35

frame.includes(`"target":"${file}"`) && !frame.includes('"cancel":true')).length;

+36

const hunks = file => `(${review(file)})?.querySelectorAll('.slate-diff-hunk').length`;

+37

const hunkCommand = (file, side, index = 0) => evalIn(tab,

+38

    `(${review(file, side)})?.querySelectorAll('.slate-diff-hunk')[${index}]?.getAttribute('data-slate-click')?.replace('git-select-toggle:', 'git-select:')`);

+39

  const isExpanded = file => `(${entry(file)})?.querySelector('.git-entry-toggle')?.getAttribute('aria-expanded') === 'true'`;

+40

+41

assert.ok(await evalIn(tab, `document.querySelector('.mode-line')?.textContent.includes('1 staged')`),

+42

'untracked entries were counted as staged');

+43

await open('large-diff.sgl');

+44

await dispatch(await hunkCommand('large-diff.sgl', 'unstaged'));

+45

await key('Tab');

+46

const largeRequests = requests('large-diff.sgl');

+47

  const foldedLarge = `(${review('large-diff.sgl')})?.querySelector('.slate-diff-hunk-toggle')?.getAttribute('aria-expanded') === 'false'`;

+48

assert.ok(await evalIn(tab, foldedLarge), 'large hunk did not initially fold');

+49

await open('hunks.sgl');

+50

await waitFor(tab, `${hunks('hunks.sgl')} === 2`, 'two initial hunks');

+51

const initialRequests = requests('hunks.sgl');

+52

await dispatch(await hunkCommand('hunks.sgl', 'unstaged'));

+53

await key('s');

+54

await waitFor(tab, `${hunks('hunks.sgl')} === 1 &&

+55

!(${review('hunks.sgl')})?.querySelector('.git-review-refresh') &&

+56

(${review('hunks.sgl')})?.querySelector('.slate-diff-hunk.selected')`, 'stage keeps next hunk selected and open');

+57

assert.equal(requests('hunks.sgl'), initialRequests + 1, 'stage did not refresh only the affected open side');

+58

assert.equal(requests('large-diff.sgl'), largeRequests, 'stage eagerly reloaded an unrelated review');

+59

assert.ok(await evalIn(tab, isExpanded('large-diff.sgl')), 'unrelated file collapsed');

+60

assert.ok(await evalIn(tab, foldedLarge), 'unrelated hunk unfolded');

+61

assert.equal(await evalIn(tab, `(${review('large-diff.sgl')})?.querySelectorAll('.slate-diff-mutation').length`), 0,

+62

'retained stale patch still has mutation controls');

+63

+64

await open('hunks.sgl', 'staged');

+65

await dispatch(await hunkCommand('hunks.sgl', 'staged'));

+66

await key('u');

+67

await waitFor(tab, `!(${entry('hunks.sgl', 'staged')}) && ${hunks('hunks.sgl')} === 2 &&

+68

!(${review('hunks.sgl')})?.querySelector('.git-review-refresh')`, 'unstage preserves the open worktree review');

+69

assert.equal(requests('large-diff.sgl'), largeRequests, 'unstage reloaded an unrelated review');

+70

await choose('hunks.sgl');

+71

await dispatch(await hunkCommand('hunks.sgl', 'unstaged'));

+72

await key('k');

+73

await waitFor(tab, `document.querySelector('.confirm-panel')`, 'discard hunk confirmation');

+74

await key('y');

+75

await waitFor(tab, `${hunks('hunks.sgl')} === 1 &&

+76

(${review('hunks.sgl')})?.querySelector('.slate-diff-hunk.selected') &&

+77

!(${review('hunks.sgl')})?.querySelector('.git-review-refresh')`, 'discard preserves the next hunk');

+78

const text = fs.readFileSync(path.join(repo, 'hunks.sgl'), 'utf8');

+79

assert.ok(!text.includes('hunk changed first') && text.includes('hunk changed second'),

+80

'discard changed the wrong hunk');

+81

assert.ok(await evalIn(tab, foldedLarge), 'discard changed another hunk fold');

+82

assert.equal(requests('large-diff.sgl'), largeRequests);

+83

+84

// Returning to a retained review refreshes it once; layout changes remain pure.

+85

await choose('large-diff.sgl');

+86

await waitFor(tab, `!(${review('large-diff.sgl')})?.querySelector('.git-review-refresh')`, 'deferred review refresh');

+87

assert.equal(requests('large-diff.sgl'), largeRequests + 1);

+88

assert.ok(await evalIn(tab, foldedLarge), 'deferred refresh lost the hunk fold');

+89

await dispatch(await hunkCommand('large-diff.sgl', 'unstaged'));

+90

await key('Tab');

+91

await evalIn(tab, `(${review('large-diff.sgl')}).scrollTop=460`);

+92

const anchor = await evalIn(tab, `(() => {

+93

const port=${review('large-diff.sgl')}, r=port.getBoundingClientRect();

+94

const row=document.elementFromPoint(r.left+r.width/2,r.top+44)?.closest('.slate-diff-row');

+95

return {text:row?.querySelector('.slate-diff-code')?.textContent, offset:row?.getBoundingClientRect().top-r.top};

+96

})()`);

+97

assert.ok(anchor.text, 'scrolled review has no visible anchor');

+98

await key('g');

+99

await waitFor(tab, `!document.querySelector('.mode-line')?.textContent.includes('refreshing') &&

+100

!(${review('large-diff.sgl')})?.querySelector('.git-review-refresh')`, 'refresh keeps review position');

+101

const offset = await evalIn(tab, `(() => { const port=${review('large-diff.sgl')};

+102

    const row=[...port.querySelectorAll('.slate-diff-row')].find(row=>row.querySelector('.slate-diff-code')?.textContent===${JSON.stringify(anchor.text)});

+103

return row?.getBoundingClientRect().top-port.getBoundingClientRect().top; })()`);

+104

assert.ok(Math.abs(offset-anchor.offset)<4, `review scrolled after refresh: ${anchor.offset} -> ${offset}`);

+105

await sgl('(slate-dispatch "git-layout:inline")');

+106

await send('Emulation.setDeviceMetricsOverride',

+107

{width:390, height:844, deviceScaleFactor:1, mobile:true}, tab.sessionId);

+108

await choose('hunks.sgl');

+109

assert.ok(await evalIn(tab, isExpanded('hunks.sgl')), 'mobile layout lost the surviving review');

+110

await dispatch(await hunkCommand('hunks.sgl', 'unstaged'));

+111

await key('s');

+112

  await waitFor(tab, `!(${entry('hunks.sgl')}) && (${entry('hunks.sgl', 'staged')})`, 'mobile file leaves source section');

+113

  const selected = await evalIn(tab, `document.querySelector('.git-entry.selected')?.querySelector('.git-entry-path')?.textContent`);

+114

assert.equal(selected, 'large-diff.sgl', 'completed file did not continue at the next file');

+115

+116

// Hold the real node's next status read inside a file mutation. Navigation

+117

// must remain live, and completing that mutation must honor the new point.

+118

await waitFor(tab, `!(${review('large-diff.sgl')})?.querySelector('.git-review-refresh')`,

+119

'settled review before held mutation');

+120

await choose('untracked-exact.sgl', 'untracked');

+121

fs.rmSync(heldFile, {force:true});

+122

fs.rmSync(releaseFile);

+123

try {

+124

await key('s');

+125

for (let i = 0; i < 600 && !fs.existsSync(heldFile); i++) await sleep(50);

+126

assert.ok(fs.existsSync(heldFile), 'file mutation never reached its held status read');

+127

await choose('visit-target.sgl');

+128

await key('n');

+129

await key('p');

+130

    assert.equal(await evalIn(tab, `document.querySelector('.git-entry.selected')?.querySelector('.git-entry-path')?.textContent`),

+131

'visit-target.sgl', 'navigation stopped during a held mutation');

+132

fs.writeFileSync(releaseFile, 'release\n');

+133

await waitFor(tab, `(${entry('untracked-exact.sgl', 'staged')})`, 'held mutation completed');

+134

    assert.equal(await evalIn(tab, `document.querySelector('.git-entry.selected')?.querySelector('.git-entry-path')?.textContent`),

+135

'visit-target.sgl', 'mutation completion stole the later selection');

+136

} finally {

+137

fs.writeFileSync(releaseFile, 'release\n');

+138

}

+139

runGit(['diff', '--check']);

+140

return true;

+141

}

packages/slate/test/git-review-command-test.sgladded

@@ -0,0 +1,166 @@

+1

(import (sigil test) (slate command) (slate commands git)

+2

(slate git status-view) (slate git log-view) (slate modes git-log)

+3

(slate modes git-status) (slate pane) (slate provider) (slate root)

+4

(slate space) (slate state) (slate view))

+5

+6

(define STATE #{})

+7

(define REQUESTS '())

+8

(define HELD '())

+9

(define CONFIRM #f)

+10

(define REPO #{ root: "review-test" worktree: "/repo" common-dir: "/repo/.git" })

+11

(define SNAP #{ head-oid: "h" index-id: "i" worktree-id: "w" })

+12

(define FRESH #{ head-oid: "h" index-id: "fresh" worktree-id: "w" })

+13

(define (entry path id index work)

+14

#{ id: id path: path kind: "ordinary" index-state: index worktree-state: work })

+15

(define ENTRIES (list (entry "a.sgl" "old-a" "." "M")

+16

(entry "b.sgl" "old-b" "." "M")

+17

(entry "c.sgl" "old-c" "." "M")))

+18

(define (status entries snapshot)

+19

#{ version: 1 repo: REPO snapshot: snapshot branch: #{} entries: entries

+20

recent-commits: '() capabilities: #{} })

+21

(define (request source verb args ready fail)

+22

(set! REQUESTS (append REQUESTS (list (dict-set args verb: verb))))

+23

(cond ((string=? verb "git/discover")

+24

(ready #{ version: 1 node-repo: REPO bare: #f object-format: "sha1" }))

+25

((string=? verb "git/status") (ready (status ENTRIES SNAP)))

+26

((dict-ref args cancel: #f) #t)

+27

(else (set! HELD (append HELD (list ready))))))

+28

(register-provider! review-test:

+29

#{ git-request: request subscribe: (lambda (source callback) (lambda () #t)) })

+30

(register-root! review-test: #{ provider: review-test: class: machine: })

+31

(define (run command) (set! STATE (command-run STATE command)))

+32

(define (setup!)

+33

(set! REQUESTS '()) (set! HELD '()) (set! CONFIRM #f)

+34

(let ((plain (view slate/name: "plain"

+35

slate/source: (root->source review-test: file: "/repo/a.sgl"))))

+36

(set! STATE #{ slate/views: (list plain)

+37

slate/spaces: (list (make-space "main" (make-leaf 0 "plain") 0 1))

+38

slate/active-space: "main" }))

+39

(configure-git-commands!

+40

#{ state: (lambda () STATE) set-state: (lambda (state) (set! STATE state))

+41

refresh: (lambda () #t)

+42

close-view: (lambda (state)

+43

(let ((name (view-name (active-view state))))

+44

(focus-view

+45

(dict-set state slate/views:

+46

(filter (lambda (v) (not (equal? name (view-name v)))) (views state)))

+47

"plain")))

+48

confirm: (lambda (state question reply) (set! CONFIRM reply) state) })

+49

(run "git-status"))

+50

(define (file-row path section)

+51

(find (lambda (row)

+52

(and (eq? (dict-ref row kind: #f) entry:)

+53

(eq? (dict-ref row section: #f) section)

+54

(equal? path (dict-ref (dict-ref row entry: #{}) path: #f))))

+55

(git-status-rows (active-view STATE))))

+56

(define (choose path section)

+57

(run (string-append "git-select:" (dict-ref (file-row path section) id: ""))))

+58

(define (reply-diff ready path snapshot)

+59

(ready #{ version: 1 repo: REPO snapshot: snapshot payload-bytes: 500 complete: #t

+60

files: (list #{ hunks: (list #{ kind: hunk: text: "@@ -1 +1 @@" }

+61

#{ kind: addition: text: (string-append "+" path) }) }) }))

+62

(define (open-review path)

+63

(choose path unstaged:)

+64

(run "git-toggle")

+65

(reply-diff (car (reverse HELD)) path SNAP))

+66

(define (diff-count)

+67

(length (filter (lambda (args)

+68

(and (equal? "git/diff" (dict-ref args verb: #f))

+69

(not (dict-ref args cancel: #f)))) REQUESTS)))

+70

+71

(test "mutation refreshes affected reviews and preserves unrelated open folds without fetching them"

+72

(setup!)

+73

(open-review "b.sgl")

+74

(run "git-next")

+75

(run "git-toggle")

+76

(let ((folds (dict-ref (active-view STATE) slate/git-hunk-folded: '())))

+77

(open-review "a.sgl")

+78

(choose "a.sgl" unstaged:)

+79

(run "git-stage")

+80

(let ((reply (car (reverse HELD))))

+81

(choose "c.sgl" unstaged:)

+82

(reply (status (list (entry "a.sgl" "new-a" "M" "M")

+83

(entry "b.sgl" "new-b" "." "M")

+84

(entry "c.sgl" "new-c" "." "M")) FRESH)))

+85

(assert-equal "c.sgl" (dict-ref (dict-ref (git-status-selected-row (active-view STATE)) entry: #{}) path: #f))

+86

(assert-equal 2 (length (dict-ref (active-view STATE) slate/git-inline-models: '())))

+87

(assert-equal folds (dict-ref (active-view STATE) slate/git-hunk-folded: '()))

+88

(assert-equal 3 (diff-count))

+89

(choose "b.sgl" unstaged:)

+90

(assert-equal 4 (diff-count))

+91

(choose "b.sgl" unstaged:)

+92

(assert-equal 4 (diff-count))

+93

(reply-diff (car (reverse HELD)) "b.sgl" FRESH)

+94

(assert-equal folds (dict-ref (active-view STATE) slate/git-hunk-folded: '()))))

+95

+96

(test "stale hunk commands never broaden into file discard and closed reviews stay closed"

+97

(setup!)

+98

(open-review "b.sgl")

+99

(run "git-next")

+100

(let ((hunk-id (dict-ref (git-status-selected-row (active-view STATE)) id: "")))

+101

(choose "a.sgl" unstaged:)

+102

(run "git-stage")

+103

((car (reverse HELD))

+104

(status (list (entry "a.sgl" "new-a" "M" ".")

+105

(entry "b.sgl" "new-b" "." "M")

+106

(entry "c.sgl" "new-c" "." "M")) FRESH))

+107

(let ((before (length REQUESTS)))

+108

(run (string-append "git-select-discard:" hunk-id))

+109

(assert-false CONFIRM)

+110

(assert-equal before (length REQUESTS)))

+111

(choose "b.sgl" unstaged:)

+112

(let ((reply (car (reverse HELD))))

+113

(run "git-toggle")

+114

(reply-diff reply "b.sgl" FRESH)

+115

(assert-equal '() (dict-ref (active-view STATE) slate/git-inline-models: '())))))

+116

+117

(test "discard confirmation cannot reuse a newer snapshot"

+118

(setup!)

+119

(choose "a.sgl" unstaged:)

+120

(run "git-discard")

+121

(assert-true (procedure? CONFIRM))

+122

(let ((model (git-status-model (active-view STATE))))

+123

(vector-set! model 1 #{ state: ready: data: (status ENTRIES FRESH) })

+124

(CONFIRM STATE #t)

+125

(assert-false (any (lambda (args) (equal? "git/discard-file" (dict-ref args verb: #f))) REQUESTS))))

+126

+127

+128

(test "history quit returns to its opener while a page is held"

+129

(setup!)

+130

(let ((opener (view-name (active-view STATE))))

+131

(run "git-log")

+132

(assert-true (vector? (git-log-model (active-view STATE))))

+133

(let ((count (length REQUESTS)))

+134

(run "git-log-refresh")

+135

(assert-equal count (length REQUESTS)))

+136

(run "git-log-quit")

+137

(assert-equal opener (view-name (active-view STATE)))))

+138

+139

(test "history clicks load once and review keys retain commit selection"

+140

(setup!)

+141

(run "git-log")

+142

(let* ((oid (make-string 40 #\a))

+143

(other (make-string 40 #\b))

+144

(commit #{ oid: oid subject: "First" parents: '() }))

+145

((car (reverse HELD))

+146

#{ version: 1 repo: REPO snapshot: SNAP offset: 0 complete: #t

+147

commits: (list commit #{ oid: other subject: "Second" parents: '() }) })

+148

(run (string-append "git-log-open:" oid))

+149

(assert-equal "git/show" (dict-ref (car (reverse REQUESTS)) verb: #f))

+150

(assert-equal 'list (dict-ref (active-view STATE) slate/git-log-focus: #f))

+151

(let ((before (length REQUESTS)))

+152

(run "git-log-inspect")

+153

(run "git-log-next")

+154

(assert-equal 'review (dict-ref (active-view STATE) slate/git-log-focus: #f))

+155

(assert-equal "line-down" (dict-ref (active-view STATE) slate/git-log-scroll: #f))

+156

(assert-equal oid (dict-ref (git-log-selected (active-view STATE)) oid: #f))

+157

(run "git-log-page-down")

+158

(assert-equal 2 (dict-ref (active-view STATE) slate/git-log-scroll-revision: 0))

+159

(run "git-log-switch-pane")

+160

(run "git-log-next")

+161

(assert-equal other (dict-ref (git-log-selected (active-view STATE)) oid: #f))

+162

(assert-equal before (length REQUESTS)))

+163

(run "git-log-quit")))

+164

+165

(configure-git-commands! #{})

+166

(test-summary)

packages/slate/test/git-status-browser-gate.mjsadded

@@ -0,0 +1,867 @@

+1

// A3 live gate: real Slate node transport renders this repository's Git status.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import os from 'node:os';

+5

import path from 'node:path';

+6

import net from 'node:net';

+7

import {reviewContinuityGate} from './git-review-browser-gate.mjs';

+8

import {branchGate} from './git-branch-browser-gate.mjs';

+9

import {historyGate} from './git-log-browser-gate.mjs';

+10

import {navigationGate} from './git-navigation-browser-gate.mjs';

+11

import { spawn, spawnSync } from 'node:child_process';

+12

+13

const workspace = process.env.A3_WORKSPACE || process.cwd();

+14

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+15

// The local node's owner grant covers the home tree. Keep the disposable Git

+16

// fixture there so the browser gate exercises the same fs-write authorization

+17

// as a real owner session instead of relying on test-only grant injection.

+18

const fixture = fs.mkdtempSync(path.join(os.homedir(), '.slate-git-status-fixture-'));

+19

const shimDir = path.join(fixture, 'bin');

+20

const repo = path.join(fixture, 'repo');

+21

const heldFile = path.join(fixture, 'status-held');

+22

const releaseFile = path.join(fixture, 'status-release');

+23

const branchListReleaseFile = path.join(fixture, 'branch-list-release');

+24

const branchSwitchReleaseFile = path.join(fixture, 'branch-switch-release');

+25

const historyReleaseFile = path.join(fixture, 'history-release');

+26

const diffHeldFile = path.join(fixture, 'diff-held');

+27

const diffReleaseFile = path.join(fixture, 'diff-release');

+28

fs.mkdirSync(shimDir);

+29

fs.mkdirSync(repo);

+30

const git = spawnSync('which', ['git'], { encoding: 'utf8' }).stdout.trim();

+31

const runGit = args => {

+32

const result = spawnSync(git, args, { cwd: repo, encoding: 'utf8' });

+33

assert.equal(result.status, 0, `fixture git ${args.join(' ')}: ${result.stderr}`);

+34

return result.stdout;

+35

};

+36

runGit(['init', '-q', '--initial-branch=main']);

+37

runGit(['config', 'user.name', 'Slate Gate']);

+38

runGit(['config', 'user.email', 'slate-gate@example.invalid']);

+39

fs.writeFileSync(path.join(repo, 'visit-target.sgl'), 'base\n');

+40

if (process.env.GIT_NAVIGATION_GATE === '1') {

+41

fs.writeFileSync(path.join(repo, 'navigation.html'), '<!doctype html>\n');

+42

runGit(['add', '--', 'navigation.html']);

+43

}

+44

fs.writeFileSync(path.join(repo, 'hunks.sgl'),

+45

Array.from({length: 100}, (_, i) => `hunk base ${String(i).padStart(3, '0')}`).join('\n') + '\n');

+46

fs.writeFileSync(path.join(repo, 'large-diff.sgl'),

+47

Array.from({length: 160000}, (_, i) => `before ${String(i).padStart(6, '0')}`).join('\n') + '\n');

+48

runGit(['add', '--', 'visit-target.sgl', 'large-diff.sgl', 'hunks.sgl']);

+49

runGit(['commit', '-q', '-m', 'fixture base']);

+50

if (process.env.GIT_HISTORY_GATE === '1') {

+51

for (let i=0;i<55;i++) runGit(['commit','-q','--allow-empty','-m',`History checkpoint ${i}`]);

+52

  fs.writeFileSync(path.join(repo,'history.txt'),'history inspection marker\n'+Array.from({length:140},(_,i)=>`review line ${i+1}\n`).join(''));

+53

runGit(['add','--','history.txt']);

+54

  runGit(['commit','-q','-m','Add history inspection','-m','Inspect the **committed change** without losing your place.\n\n- Preserve selection\n- Render `code` clearly\n\n```sh\ngit log --oneline\n```']);

+55

}

+56

+57

if (process.env.GIT_NAVIGATION_GATE === '1')

+58

fs.appendFileSync(path.join(repo, 'navigation.html'),

+59

Array.from({length:1600}, (_, i) =>

+60

      `<div class="review-row" data-index="${i}"><span>${'HTML review content '.repeat(i % 40 === 0 ? 100 : 3)}</span></div>`).join('\n') + '\n');

+61

fs.writeFileSync(path.join(repo, 'visit-target.sgl'),

+62

`base\nunstaged exact\nlong exact ${'x'.repeat(3000)}\n`);

+63

const hunkLines = Array.from({length: 100}, (_, i) => `hunk base ${String(i).padStart(3, '0')}`);

+64

hunkLines[3] = 'hunk changed first';

+65

hunkLines[70] = 'hunk changed second';

+66

fs.writeFileSync(path.join(repo, 'hunks.sgl'), hunkLines.join('\n') + '\n');

+67

fs.writeFileSync(path.join(repo, 'large-diff.sgl'),

+68

Array.from({length: 160000}, (_, i) => `after ${String(i).padStart(6, '0')}`).join('\n') + '\n');

+69

fs.writeFileSync(path.join(repo, 'staged-exact.sgl'), 'staged exact\n');

+70

runGit(['add', '--', 'staged-exact.sgl']);

+71

fs.writeFileSync(path.join(repo, 'untracked-exact.sgl'), 'untracked exact\n');

+72

for (let i = 0; i < 80; i++)

+73

fs.writeFileSync(path.join(repo, `untracked-${String(i).padStart(3, '0')}.sgl`), `untracked ${i}\n`);

+74

const shim = path.join(shimDir, 'git');

+75

fs.writeFileSync(shim, `#!/bin/sh

+76

hold_status=false

+77

hold_diff=false

+78

hold_history=false

+79

for arg in "$@"; do

+80

if [ "$arg" = status ]; then hold_status=true; fi

+81

if [ "$arg" = diff ]; then hold_diff=true; fi

+82

if [ "$arg" = --topo-order ]; then hold_history=true; fi

+83

done

+84

if [ "$hold_status" = true ] && [ ! -f ${JSON.stringify(releaseFile)} ]; then

+85

: > ${JSON.stringify(heldFile)}

+86

while [ ! -f ${JSON.stringify(releaseFile)} ]; do sleep 0.05; done

+87

fi

+88

if [ "$hold_diff" = true ] && [ ! -f ${JSON.stringify(diffReleaseFile)} ]; then

+89

: > ${JSON.stringify(diffHeldFile)}

+90

while [ ! -f ${JSON.stringify(diffReleaseFile)} ]; do sleep 0.05; done

+91

fi

+92

if [ "$hold_history" = true ] && [ ! -f ${JSON.stringify(historyReleaseFile)} ]; then

+93

while [ ! -f ${JSON.stringify(historyReleaseFile)} ]; do sleep 0.05; done

+94

fi

+95

if [ "${process.env.GIT_BRANCH_GATE || '0'}" = 1 ]; then

+96

for arg in "$@"; do

+97

if [ "$arg" = for-each-ref ]; then

+98

while [ ! -f ${JSON.stringify(branchListReleaseFile)} ]; do sleep 0.05; done

+99

fi

+100

if [ "$arg" = switch ]; then

+101

while [ ! -f ${JSON.stringify(branchSwitchReleaseFile)} ]; do sleep 0.05; done

+102

fi

+103

done

+104

fi

+105

exec ${JSON.stringify(git)} "$@"

+106

`);

+107

fs.chmodSync(shim, 0o755);

+108

const port = await new Promise((resolve, reject) => {

+109

const probe = net.createServer();

+110

probe.once('error', reject);

+111

probe.listen(0, '127.0.0.1', () => {

+112

const selected = probe.address().port;

+113

probe.close(error => error ? reject(error) : resolve(selected));

+114

});

+115

});

+116

const url = `http://127.0.0.1:${port}/`;

+117

const slateBin = process.env.A3_SLATE_BIN || path.join(workspace, 'build/dev/bin/slate');

+118

const daemon = spawn(slateBin, ['serve', '--app-dir', process.env.A3_APP_DIR || path.join(workspace, 'build/web'),

+119

'--port', String(port), '--log-level', 'debug'], {

+120

cwd: workspace,

+121

env: { ...process.env, PATH: `${shimDir}:${process.env.PATH}`,

+122

// Each daemon owns its origin grants and atomic state-file publications.

+123

// Sharing the user's state directory makes concurrent gates race each other

+124

// and the ordinary preview, even though their repositories and ports differ.

+125

XDG_STATE_HOME: path.join(fixture, 'state'),

+126

SLATE_NODE_GRANTS: `fs:rw:${fixture},exec:full` },

+127

stdio: ['ignore', 'pipe', 'pipe']

+128

});

+129

let daemonLog = '';

+130

daemon.stdout.on('data', chunk => { daemonLog += chunk; });

+131

daemon.stderr.on('data', chunk => { daemonLog += chunk; });

+132

for (let i = 0; i < 200; i++) {

+133

try { if ((await fetch(url)).ok) break; } catch (_) {}

+134

if (i === 199) throw new Error(`Slate daemon did not start: ${daemonLog}`);

+135

await sleep(50);

+136

}

+137

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-git-status-chrome-'));

+138

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+139

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+140

{ stdio: ['ignore', 'ignore', 'pipe'] });

+141

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+142

let socket;

+143

const runtimeMessages = [];

+144

const sentFrames = [];

+145

const receivedFrames = [];

+146

const wireEvents = [];

+147

+148

try {

+149

const activePort = path.join(profile, 'DevToolsActivePort');

+150

let debugEndpoint;

+151

for (let i = 0; i < 200 && !debugEndpoint; i++) {

+152

if (fs.existsSync(activePort)) {

+153

// File creation can be observed before both endpoint lines are written.

+154

const [port, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+155

if (/^\d+$/.test(port) && browserPath?.startsWith('/devtools/browser/'))

+156

debugEndpoint = `ws://127.0.0.1:${port}${browserPath}`;

+157

}

+158

if (!debugEndpoint) await sleep(50);

+159

}

+160

assert.ok(debugEndpoint, 'Chrome did not publish a complete DevTools endpoint');

+161

socket = new WebSocket(debugEndpoint);

+162

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+163

let id = 0;

+164

const pending = new Map();

+165

socket.onmessage = ({ data }) => {

+166

const msg = JSON.parse(data);

+167

if (msg.method === 'Runtime.consoleAPICalled')

+168

runtimeMessages.push(msg.params.args.map(a => a.value ?? a.description).join(' '));

+169

if (msg.method === 'Runtime.exceptionThrown')

+170

runtimeMessages.push(msg.params.exceptionDetails.exception?.description || msg.params.exceptionDetails.text);

+171

if (msg.method === 'Network.webSocketFrameSent') {

+172

sentFrames.push(msg.params.response.payloadData || '');

+173

wireEvents.push({dir:'sent', payload:msg.params.response.payloadData || ''});

+174

}

+175

if (msg.method === 'Network.webSocketFrameReceived') {

+176

receivedFrames.push(msg.params.response.payloadData || '');

+177

wireEvents.push({dir:'received', payload:msg.params.response.payloadData || ''});

+178

}

+179

if (msg.id && pending.has(msg.id)) {

+180

const p = pending.get(msg.id); pending.delete(msg.id);

+181

msg.error ? p.reject(new Error(msg.error.message)) : p.resolve(msg.result);

+182

}

+183

};

+184

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+185

const callId = ++id; pending.set(callId, { resolve, reject });

+186

socket.send(JSON.stringify({ id: callId, method, params, ...(sessionId ? { sessionId } : {}) }));

+187

});

+188

const makeTab = async () => {

+189

const target = await send('Target.createTarget', { url: 'about:blank' });

+190

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+191

await send('Runtime.enable', {}, attached.sessionId);

+192

await send('Page.enable', {}, attached.sessionId);

+193

await send('Network.enable', {}, attached.sessionId);

+194

await send('Page.navigate', { url: `${url}?rbdebug&git-status-a3=${Date.now()}` }, attached.sessionId);

+195

return { targetId: target.targetId, sessionId: attached.sessionId };

+196

};

+197

const evalIn = async (tab, expression) => {

+198

const out = await send('Runtime.evaluate',

+199

{ expression, awaitPromise: true, returnByValue: true }, tab.sessionId);

+200

if (out.exceptionDetails) throw new Error(out.exceptionDetails.exception?.description || out.exceptionDetails.text);

+201

return out.result.value;

+202

};

+203

const waitFor = async (tab, expression, label, rounds = 300) => {

+204

for (let i = 0; i < rounds; i++) {

+205

if (await evalIn(tab, expression)) return;

+206

await sleep(100);

+207

}

+208

const body = await evalIn(tab, 'document.body.innerText.slice(0, 1600)');

+209

    throw new Error(`timeout waiting for ${label}; runtime=${runtimeMessages.join(' | ')}; daemon=${daemonLog.slice(-3000)}; body=${body}`);

+210

};

+211

const boot = async tab => {

+212

await waitFor(tab, `document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+213

await waitFor(tab, `window.slateEval && window.slateEval('(slate-node-connected?)') === '1'`, 'node auth');

+214

await waitFor(tab, `window.slateEval('(slate-preferences-settled?)') === '1'`, 'preference restore');

+215

await waitFor(tab, `!document.getElementById('splash')`, 'interactive app');

+216

};

+217

const tab = await makeTab();

+218

await boot(tab);

+219

const sgl = form => evalIn(tab, `window.slateEval(${JSON.stringify(form)})`);

+220

  const useRemoteRoot = process.env.GIT_HISTORY_REMOTE === '1' || process.env.A4_DIFF_GATE === '1' || process.env.B3_DISCARD_REFRESH_GATE === '1' || process.env.GIT_CONTINUITY_GATE === '1';

+221

const gateRoot = useRemoteRoot ? 'a4remote' : 'local';

+222

// The fixture grant excludes the real home directory, so fs/home cannot

+223

// publish the normal local root. Register the granted fixture explicitly on

+224

// both routes; keep the real local node transport and narrow test grants.

+225

// This synthetic root must not fire local-node arrival hooks: their async

+226

// init-file read can return to the startup view after navigation has begun.

+227

await sgl(`(begin (import (slate root))

+228

(register-root-silent! ${gateRoot}: #{ provider: local: home: ${JSON.stringify(repo)}

+229

host: ${JSON.stringify(useRemoteRoot ? 'fixture-remote' : 'localhost')}

+230

label: "Git fixture" class: machine: }))`);

+231

await sgl(`(begin (import (slate root))

+232

(register-root! gatebrowse: #{ provider: local: home: ${JSON.stringify(repo)}

+233

host: ${JSON.stringify(useRemoteRoot ? 'fixture-remote' : 'localhost')} class: machine: }))`);

+234

const openedRoot = await sgl('(slate-dispatch "openroot:gatebrowse")');

+235

assert.ok(!String(openedRoot).includes('Error:'), `root opening failed: ${openedRoot}`);

+236

await waitFor(tab, `document.querySelector('.folder') &&

+237

[...document.querySelectorAll('.folder-row')].some(row => row.textContent.includes('visit-target.sgl'))`,

+238

'root folder listing');

+239

await sgl('(slate-dispatch "open-folder")');

+240

const openedFolder = await sgl(`(slate-dispatch ${JSON.stringify(`openfolder:${shimDir}`)})`);

+241

assert.ok(!String(openedFolder).includes('Error:'), `folder path opening failed: ${openedFolder}`);

+242

await waitFor(tab, `document.querySelector('.folder') &&

+243

[...document.querySelectorAll('.folder-stem')].some(row => row.textContent.trim() === 'git')`,

+244

'folder path listing');

+245

await sgl(`(slate-dispatch ${JSON.stringify(`md-visit:${gateRoot}:${path.join(repo, 'visit-target.sgl')}`)})`);

+246

await waitFor(tab, `(() => {

+247

const editor=document.querySelector('.editor-input, .editor-content');

+248

return editor && (editor.value ?? editor.textContent).includes('unstaged exact');

+249

})()`, 'loaded repository file');

+250

const registered = await sgl('(begin (import (slate command)) (if (command-resolve "git-status") "YES" "NO"))');

+251

assert.ok(registered.includes('YES'), `git-status is absent from runtime registry: ${registered}`);

+252

await evalIn(tab, `window.__gitStatusLoadingSeen=false;

+253

    new MutationObserver(() => { if (document.body.innerText.includes('Loading…')) window.__gitStatusLoadingSeen=true; })

+254

.observe(document.body, {subtree:true, childList:true, characterData:true});`);

+255

const key = async (name, modifiers = 0) => {

+256

await send('Input.dispatchKeyEvent', { type: 'keyDown', key: name, modifiers }, tab.sessionId);

+257

await send('Input.dispatchKeyEvent', { type: 'keyUp', key: name, modifiers }, tab.sessionId);

+258

};

+259

await key('x', 2);

+260

await key('g');

+261

  await waitFor(tab, `document.querySelector('.git-status.loading') && document.body.innerText.includes('Loading…')`, 'held Git loading shell', 100);

+262

// Startup and discovery can exceed five seconds on a loaded machine. Wait

+263

// for the actual hold marker; elapsed setup time is not a performance gate.

+264

for (let i = 0; i < 600 && !fs.existsSync(heldFile); i++) await sleep(50);

+265

assert.ok(fs.existsSync(heldFile), 'real node Git status was not held');

+266

assert.equal(await evalIn(tab, 'window.__gitStatusLoadingSeen'), true, 'loading state was not rendered');

+267

await key('ArrowDown');

+268

await key('q');

+269

await waitFor(tab, `!document.querySelector('.git-status')`, 'q while remote status is held');

+270

fs.writeFileSync(releaseFile, 'release\n');

+271

await sleep(1000);

+272

assert.equal(await evalIn(tab, `!!document.querySelector('.git-status')`), false,

+273

'late held status reply mutated the closed view');

+274

await key('x', 2);

+275

await key('g');

+276

  await waitFor(tab, `document.querySelector('.git-status') && document.body.innerText.includes('untracked-exact.sgl')`, 'deterministic Git status view');

+277

for (const exact of ['visit-target.sgl', 'staged-exact.sgl', 'untracked-exact.sgl'])

+278

assert.equal(await evalIn(tab, `document.body.innerText.includes(${JSON.stringify(exact)})`), true,

+279

`fixture row missing: ${exact}`);

+280

  assert.equal(await evalIn(tab, `!!document.querySelector('.git-repository-name[aria-label="Repository"]') && !!document.querySelector('.git-repository-origin[aria-label="Root / node"]')`),

+281

true, 'repository root/node labels are absent');

+282

if (process.env.B1_MUTATION_GATE === '1') {

+283

const frameCount = verb => sentFrames.filter(frame => frame.includes(verb)).length;

+284

const clickMutation = async (filename, sectionClass) => {

+285

      const command = await evalIn(tab, `(() => { const row=[...document.querySelectorAll(${JSON.stringify(sectionClass)})]

+286

.find(e => e.textContent.includes(${JSON.stringify(filename)}));

+287

const action=row?.querySelector('.git-entry-mutation'); if (!action) return null;

+288

return action.getAttribute('data-slate-click'); })()`);

+289

assert.ok(command, `missing mutation action for ${filename}`);

+290

await sgl(`(slate-dispatch ${JSON.stringify(command)})`);

+291

};

+292

const stageBefore = frameCount('git/stage-file');

+293

await clickMutation('untracked-exact.sgl', '.git-entry');

+294

await waitFor(tab, `[...document.querySelectorAll('.git-staged')]

+295

.some(e => e.textContent.includes('untracked-exact.sgl'))`, 'pointer file stage');

+296

assert.ok(frameCount('git/stage-file') > stageBefore, 'pointer stage did not use git/stage-file');

+297

const unstageBefore = frameCount('git/unstage-file');

+298

await clickMutation('untracked-exact.sgl', '.git-staged');

+299

await waitFor(tab, `[...document.querySelectorAll('.git-untracked')]

+300

.some(e => e.textContent.includes('untracked-exact.sgl'))`, 'pointer file unstage');

+301

assert.ok(frameCount('git/unstage-file') > unstageBefore, 'pointer unstage did not use git/unstage-file');

+302

+303

const keyboardTarget = await evalIn(tab, `(() => { const row=[...document.querySelectorAll('.git-unstaged')]

+304

.find(e => e.textContent.includes('visit-target.sgl'));

+305

const action=row?.querySelector('.git-entry-mutation')?.getAttribute('data-slate-click');

+306

return action?.replace('git-select-stage:', 'git-select:') || null; })()`);

+307

assert.ok(keyboardTarget, 'keyboard mutation target is absent');

+308

await sgl(`(slate-dispatch ${JSON.stringify(keyboardTarget)})`);

+309

const keyboardStageBefore = frameCount('git/stage-file');

+310

await key('s');

+311

await waitFor(tab, `[...document.querySelectorAll('.git-staged')]

+312

.some(e => e.textContent.includes('visit-target.sgl'))`, 'keyboard file stage');

+313

assert.ok(frameCount('git/stage-file') > keyboardStageBefore, 's did not use git/stage-file');

+314

const stagedTarget = await evalIn(tab, `[...document.querySelectorAll('.git-staged')]

+315

.find(e=>e.textContent.includes('visit-target.sgl'))?.getAttribute('data-slate-click')`);

+316

await sgl(`(slate-dispatch ${JSON.stringify(stagedTarget)})`);

+317

await key('u');

+318

await waitFor(tab, `[...document.querySelectorAll('.git-unstaged')]

+319

.some(e => e.textContent.includes('visit-target.sgl'))`, 'keyboard file unstage');

+320

}

+321

if (process.env.B3_DISCARD_REFRESH_GATE === '1') {

+322

const frameCount = verb => sentFrames.filter(frame => frame.includes(verb)).length;

+323

const discardCommand = await evalIn(tab, `(() => { const row=[...document.querySelectorAll('.git-untracked')]

+324

.find(e=>e.textContent.includes('untracked-exact.sgl'));

+325

return row?.querySelector('.git-entry-discard')?.getAttribute('data-slate-click') || null; })()`);

+326

assert.ok(discardCommand, 'untracked pointer discard route missing');

+327

const beforeDecline = frameCount('git/discard-file');

+328

await sgl(`(slate-dispatch ${JSON.stringify(discardCommand)})`);

+329

    await waitFor(tab, `document.querySelector('.confirm-panel') && document.body.innerText.includes('This cannot be undone')`,

+330

'typed irreversible discard confirmation');

+331

await key('n');

+332

assert.equal(frameCount('git/discard-file'), beforeDecline, 'discard ran after decline');

+333

assert.ok(fs.existsSync(path.join(repo, 'untracked-exact.sgl')), 'decline removed untracked bytes');

+334

await sgl(`(slate-dispatch ${JSON.stringify(discardCommand)})`);

+335

await key('y');

+336

await waitFor(tab, `!document.body.innerText.includes('untracked-exact.sgl')`, 'confirmed discard convergence');

+337

assert.ok(frameCount('git/discard-file') > beforeDecline, 'confirmed discard did not use node operation');

+338

+339

const statusBefore = frameCount('git/status');

+340

for (let i = 0; i < 12; i++)

+341

fs.writeFileSync(path.join(repo, `storm-${String(i).padStart(2, '0')}.sgl`), `storm ${i}\n`);

+342

await waitFor(tab, `document.querySelector('.mode-line')?.textContent.includes('refresh needed')`,

+343

'watch event stale mode line');

+344

await key('n'); await key('p');

+345

assert.equal(frameCount('git/status'), statusBefore, 'passive watch started Git work');

+346

assert.ok(!await evalIn(tab, `document.body.innerText.includes('storm-11.sgl')`),

+347

'passive watch replaced status before user refresh');

+348

fs.rmSync(releaseFile);

+349

fs.rmSync(heldFile, {force:true});

+350

await key('g');

+351

await waitFor(tab, `document.querySelector('.mode-line')?.textContent.includes('refreshing')`,

+352

'explicit refresh progress in mode line');

+353

for (let i=0; i<100 && !fs.existsSync(heldFile); i++) await sleep(50);

+354

assert.ok(fs.existsSync(heldFile), 'explicit refresh was not held at the node');

+355

const pendingStageCount = frameCount('git/stage-file');

+356

const stageDuringRefresh = await evalIn(tab,

+357

`document.querySelector('.git-untracked .git-entry-mutation')?.getAttribute('data-slate-click')`);

+358

assert.ok(stageDuringRefresh, 'pending refresh stage fixture is missing');

+359

await sgl(`(slate-dispatch ${JSON.stringify(stageDuringRefresh)})`);

+360

assert.equal(frameCount('git/stage-file'), pendingStageCount, 'mutation raced an explicit refresh');

+361

fs.writeFileSync(path.join(repo, 'during-refresh.sgl'), 'newest state\n');

+362

const selectionBefore = await evalIn(tab, `document.querySelector('.git-row.selected')?.textContent`);

+363

await key('n');

+364

assert.notEqual(await evalIn(tab, `document.querySelector('.git-row.selected')?.textContent`), selectionBefore,

+365

'navigation blocked during explicit refresh');

+366

await key('p');

+367

await key('g');

+368

assert.equal(frameCount('git/status'), statusBefore + 1, 'excess status calls during explicit refresh');

+369

fs.writeFileSync(releaseFile, 'release\n');

+370

    await waitFor(tab, `document.body.innerText.includes('storm-11.sgl') && document.body.innerText.includes('during-refresh.sgl') && !document.querySelector('.mode-line')?.textContent.includes('refreshing')`,

+371

'explicit refresh newest-state convergence');

+372

const statusAfter = frameCount('git/status');

+373

assert.equal(statusAfter, statusBefore + 1,

+374

`explicit refresh status calls after event storm: ${statusAfter - statusBefore}`);

+375

}

+376

if (process.env.B2_HUNK_GATE === '1') {

+377

fs.writeFileSync(diffReleaseFile, 'release\n');

+378

const frameCount = verb => sentFrames.filter(frame => frame.includes(verb)).length;

+379

assert.equal(frameCount('git/diff'), 0, 'status open eagerly requested a diff');

+380

const pointerClick = async selectorExpression => {

+381

const point = await evalIn(tab, `(() => { const el=${selectorExpression}; if(!el) return null;

+382

el.scrollIntoView({block:'center'}); const r=el.getBoundingClientRect();

+383

return {x:r.left+r.width/2,y:r.top+r.height/2}; })()`);

+384

assert.ok(point, 'hunk pointer target missing');

+385

      await send('Input.dispatchMouseEvent', {type:'mousePressed', x:point.x, y:point.y, button:'left', clickCount:1}, tab.sessionId);

+386

      await send('Input.dispatchMouseEvent', {type:'mouseReleased', x:point.x, y:point.y, button:'left', clickCount:1}, tab.sessionId);

+387

};

+388

const unstagedRow = `[...document.querySelectorAll('.git-unstaged')].find(e=>e.textContent.includes('hunks.sgl'))`;

+389

await pointerClick(`${unstagedRow}?.querySelector('.git-entry-toggle')`);

+390

await waitFor(tab, `document.querySelectorAll('.slate-diff-hunk').length >= 2`, 'two worktree hunks');

+391

const stageBefore = frameCount('git/stage-hunk');

+392

await pointerClick(`document.querySelector('[data-slate-click^="git-select-stage:"][data-slate-click*=":hunk:"]')`);

+393

await waitFor(tab, `[...document.querySelectorAll('.git-staged')].some(e=>e.textContent.includes('hunks.sgl'))`,

+394

'pointer hunk stage');

+395

assert.ok(frameCount('git/stage-hunk') > stageBefore, 'pointer hunk stage did not use git/stage-hunk');

+396

const cached = spawnSync(git, ['diff', '--cached', '--', 'hunks.sgl'], {cwd:repo, encoding:'utf8'}).stdout;

+397

assert.ok(cached.includes('hunk changed first'), 'selected first hunk was not staged');

+398

assert.ok(!cached.includes('hunk changed second'), 'wrong hunk staged');

+399

const stagedRow = `[...document.querySelectorAll('.git-staged')].find(e=>e.textContent.includes('hunks.sgl'))`;

+400

await pointerClick(`${stagedRow}?.querySelector('.git-entry-toggle')`);

+401

    await waitFor(tab, `document.querySelector('[data-slate-click^="git-select-unstage:"][data-slate-click*=":hunk:"]')`,

+402

'staged hunk expansion');

+403

await pointerClick(`document.querySelector('[data-slate-click^="git-select-unstage:"][data-slate-click*=":hunk:"]')

+404

?.closest('.slate-diff-hunk')`);

+405

const unstageBefore = frameCount('git/unstage-hunk');

+406

await key('u');

+407

await waitFor(tab, `![...document.querySelectorAll('.git-staged')].some(e=>e.textContent.includes('hunks.sgl'))`,

+408

'keyboard hunk unstage');

+409

assert.ok(frameCount('git/unstage-hunk') > unstageBefore, 'u did not use git/unstage-hunk');

+410

}

+411

assert.equal(await evalIn(tab, `[...document.querySelectorAll('.git-section')]

+412

.some(section => /\$0\$\\s*$/.test(section.textContent.trim()))`), false,

+413

'zero-count section heading rendered');

+414

const selectedId = () => evalIn(tab, `(() => { const row=document.querySelector('.git-row.selected');

+415

    return row?.getAttribute('data-slate-click') || row?.querySelector('[data-slate-click]')?.getAttribute('data-slate-click') || ''; })()`);

+416

await key('n');

+417

await waitFor(tab, `document.querySelectorAll('.git-row.selected').length === 1`, 'keyboard selection');

+418

const afterN = await selectedId();

+419

assert.equal(afterN.includes('section:conflicts'), false, 'empty Conflicts section consumed navigation');

+420

await key('p');

+421

assert.notEqual(await selectedId(), afterN, 'p did not navigate backward');

+422

await key('ArrowDown');

+423

assert.equal(await selectedId(), afterN, 'ArrowDown did not alias n');

+424

await key('ArrowUp');

+425

assert.notEqual(await selectedId(), afterN, 'ArrowUp did not alias p');

+426

await evalIn(tab, `document.querySelector('.git-section-toggle').click()`);

+427

await evalIn(tab, `document.querySelector('.git-section-toggle').click()`);

+428

await key('Tab');

+429

await waitFor(tab, `document.querySelector('.git-section[aria-expanded="false"]')`, 'keyboard folding');

+430

const click = async selector => {

+431

await evalIn(tab, `new Promise(resolve => {

+432

document.querySelector(${JSON.stringify(selector)}).scrollIntoView({block:'center'});

+433

requestAnimationFrame(() => resolve(true));

+434

})`);

+435

const point = await evalIn(tab, `(() => { const el=document.querySelector(${JSON.stringify(selector)});

+436

const r=el.getBoundingClientRect(), x=r.left+r.width/2, y=r.top+r.height/2;

+437

const hit=document.elementFromPoint(x,y);

+438

return {x,y, hit:hit === el || el.contains(hit), target:hit?.outerHTML.slice(0,300)}; })()`);

+439

assert.ok(point.hit, `pointer target is obscured for ${selector}: ${point.target}`);

+440

    await send('Input.dispatchMouseEvent', {type:'mousePressed', x:point.x, y:point.y, button:'left', clickCount:1}, tab.sessionId);

+441

    await send('Input.dispatchMouseEvent', {type:'mouseReleased', x:point.x, y:point.y, button:'left', clickCount:1}, tab.sessionId);

+442

};

+443

const beforeRefresh = sentFrames.filter(frame => frame.includes('git/status')).length;

+444

fs.rmSync(releaseFile);

+445

await click('.git-status .git-header-icon[title^="Refresh"]');

+446

  await waitFor(tab, `document.querySelector('.mode-line')?.textContent.includes('refreshing')`, 'pointer refresh pending');

+447

fs.writeFileSync(releaseFile, 'release\n');

+448

  await waitFor(tab, `!document.querySelector('.mode-line')?.textContent.includes('refreshing')`, 'pointer refresh complete');

+449

assert.ok(sentFrames.filter(frame => frame.includes('git/status')).length > beforeRefresh,

+450

'pointer refresh did not send git/status');

+451

await click('.git-entry .git-entry-path');

+452

  await waitFor(tab, `!document.querySelector('.git-status') && document.querySelector('.editor-input, .editor-content')`,

+453

'pointer filename visit', 100);

+454

await sgl('(slate-dispatch "git-status")');

+455

  await waitFor(tab, `document.querySelector('.git-status') && document.body.innerText.includes('Untracked')`, 'Git status reopen');

+456

await sgl('(slate-dispatch "git-status")');

+457

await waitFor(tab, `document.querySelectorAll('.git-status').length === 1`, 'canonical repository view reuse');

+458

  await waitFor(tab, `document.body.innerText.includes('Untracked') && !document.querySelector('.mode-line')?.textContent.includes('refreshing')`, 'canonical view refresh');

+459

for (let i = 0; i < 35; i++) await key('n');

+460

  await waitFor(tab, `(() => { const pane=document.querySelector('.pane.focused'); const row=document.querySelector('.git-row.selected');

+461

if (!pane || !row) return false; const vr=pane.getBoundingClientRect(), rr=row.getBoundingClientRect();

+462

return rr.top >= vr.top && rr.bottom <= vr.bottom; })()`, 'Git selection follows viewport', 100);

+463

await sgl('(slate-dispatch "git-select:section:untracked")');

+464

const touchExpandedBefore = await evalIn(tab, `[...document.querySelectorAll('.git-section')]

+465

.find(e => e.textContent.includes('Untracked'))?.getAttribute('aria-expanded')`);

+466

const touchPoint = await evalIn(tab, `(() => {

+467

const section = [...document.querySelectorAll('.git-section')].find(e => e.textContent.includes('Untracked'));

+468

const el = section?.querySelector('.git-section-toggle');

+469

el.scrollIntoView({block:'center'});

+470

const r = el.getBoundingClientRect(); return {x:r.left+r.width/2, y:r.top+r.height/2};

+471

})()`);

+472

await send('Input.dispatchTouchEvent', { type: 'touchStart', touchPoints: [touchPoint] }, tab.sessionId);

+473

await send('Input.dispatchTouchEvent', { type: 'touchEnd', touchPoints: [] }, tab.sessionId);

+474

await waitFor(tab, `[...document.querySelectorAll('.git-section')]

+475

    .some(e => e.textContent.includes('Untracked') && e.getAttribute('aria-expanded') !== ${JSON.stringify(touchExpandedBefore)})`, 'touch folding');

+476

const wire = sentFrames.join('\n');

+477

  assert.ok(wire.includes('git/discover') && wire.includes('git/status'), 'Git requests did not traverse node WebSocket');

+478

if (process.env.B2_HUNK_GATE !== '1')

+479

assert.equal(wire.includes('git/diff'), false, 'status open eagerly requested a diff');

+480

if (process.env.GIT_LAYOUT_GATE === '1') {

+481

const framesBefore = sentFrames.filter(frame => frame.includes('git/diff')).length;

+482

fs.writeFileSync(diffReleaseFile, 'release\n');

+483

    await send('Emulation.setDeviceMetricsOverride', {width:1280,height:900,deviceScaleFactor:1,mobile:false}, tab.sessionId);

+484

await sgl('(slate-dispatch "git-select:section:unstaged")');

+485

    await evalIn(tab, `(() => { const section=[...document.querySelectorAll('.git-section')].find(e=>e.textContent.includes('Unstaged'));

+486

if(section.getAttribute('aria-expanded')==='false')section.querySelector('.git-section-toggle').click(); })()`);

+487

    await evalIn(tab, `[...document.querySelectorAll('.git-entry')].find(e=>e.textContent.includes('visit-target.sgl')).querySelector('.git-entry-toggle').click()`);

+488

    await waitFor(tab, `document.querySelector('.git-inline-diff.active .slate-diff-addition') && !document.body.innerText.includes('Loading diff…')`, 'layout review loaded');

+489

assert.equal(sentFrames.filter(frame=>frame.includes('git/diff')).length, framesBefore+1);

+490

    const expectedText = await evalIn(tab, `document.querySelector('.git-inline-diff.active .slate-diff-control').textContent`);

+491

    const owner = await evalIn(tab, `document.querySelector('.git-inline-diff.active').getAttribute('data-review-owner')`);

+492

const position = `getComputedStyle(document.querySelector('.git-inline-diff.active')).position`;

+493

await waitFor(tab, position+` === 'absolute'`, 'wide Auto review split');

+494

const requestsBeforeLayout = sentFrames.filter(frame=>/git\/(diff|status|discover)/.test(frame)).length;

+495

const screenshot = async label => {

+496

if (!process.env.GIT_UI_SCREENSHOTS) return;

+497

if (label === 'inline' || label === 'mobile') {

+498

        await evalIn(tab, `document.querySelector('.git-inline-diff.active .slate-diff-hunk')?.scrollIntoView({block:'start'})`);

+499

await sleep(100);

Showing the first 500 of 868 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

packages/slate/test/git-status-model-test.sgladded

@@ -0,0 +1,270 @@

+1

;;; A2 provider-neutral Git status model and repository resolution.

+2

(import (sigil core) (sigil test)

+3

(slate provider) (slate root) (slate project) (slate git model))

+4

+5

(define REQUESTS '())

+6

(define HELD '())

+7

(define MUTATION-ARGS #f)

+8

+9

(define (reply-status source args on-ready)

+10

(let ((repo (dict-ref args repo: #{})))

+11

(on-ready #{ version: 1 repo: repo

+12

snapshot: #{ head-oid: "abc" index-id: "idx" worktree-id: "wt" }

+13

branch: #{} entries: '() recent-commits: '() capabilities: #{} })))

+14

+15

(define (fake-git destination held?)

+16

(lambda (source verb args on-ready on-error)

+17

(when (or (string=? verb "git/stage-hunk") (string=? verb "git/unstage-hunk"))

+18

(set! MUTATION-ARGS args))

+19

(set! REQUESTS

+20

(append REQUESTS

+21

(list (list destination verb (dict-ref args path: #f)))))

+22

(let ((run (lambda ()

+23

(if (string=? verb "git/discover")

+24

(on-ready #{ version: 1

+25

node-repo: #{ worktree: "/home/user/repo"

+26

common-dir: "/home/user/repo/.git" }

+27

bare: #f object-format: "sha1" })

+28

(reply-status source args on-ready)))))

+29

(if held? (set! HELD (append HELD (list run))) (run)))))

+30

+31

(register-provider! model-local: #{ git-request: (fake-git "local" #f) })

+32

(register-provider! model-remote-a: #{ git-request: (fake-git "remote-a" #f) })

+33

(register-provider! model-remote-b: #{ git-request: (fake-git "remote-b" #f) })

+34

(register-provider! model-held: #{ git-request: (fake-git "held" #t) })

+35

(register-provider! model-browser: #{ materialize: (lambda (source) "") })

+36

(register-root! model-local: #{ provider: model-local: class: local: })

+37

(register-root! model-remote-a: #{ provider: model-remote-a: host: "a" class: machine: })

+38

(register-root! model-remote-b: #{ provider: model-remote-b: host: "b" class: machine: })

+39

(register-root! model-held: #{ provider: model-held: host: "held" class: machine: })

+40

(register-root! model-browser: #{ provider: model-browser: class: browser: })

+41

+42

(define (load-model source project)

+43

(let ((model (make-git-status-model #f)))

+44

(git-status-model-load! model source project)

+45

model))

+46

+47

(test "project roots and source directories choose discovery path"

+48

(set! REQUESTS '())

+49

(let* ((root (root->source model-local: dir: "/workspace/project"))

+50

(project (make-project root git: #{})))

+51

(load-model (root->source model-local: file: "/workspace/project/src/a.sgl") project)

+52

(load-model (root->source model-local: file: "/outside/src/b.sgl") project)

+53

(load-model (root->source model-local: dir: "/folder") #f)

+54

(assert-equal "/workspace/project" (caddr (car REQUESTS)))

+55

(assert-equal "/outside/src" (caddr (list-ref REQUESTS 2)))

+56

(assert-equal "/folder" (caddr (list-ref REQUESTS 4)))))

+57

+58

(test "local and remote roots use the same model contract"

+59

(let ((local (load-model (root->source model-local: file: "/x") #f))

+60

(remote (load-model (root->source model-remote-a: file: "/x") #f)))

+61

(assert-equal ready: (dict-ref (git-status-model-state local) state: #f))

+62

(assert-equal ready: (dict-ref (git-status-model-state remote) state: #f))))

+63

+64

(test "same path on different remote roots has no identity collision"

+65

(let* ((a (load-model (root->source model-remote-a: file: "/x") #f))

+66

(b (load-model (root->source model-remote-b: file: "/x") #f))

+67

(ar (dict-ref (dict-ref (git-status-model-state a) data: #{}) repo: #{}))

+68

(br (dict-ref (dict-ref (git-status-model-state b) data: #{}) repo: #{})))

+69

(assert-equal #f (git-repository=? ar br))

+70

(when (string=? (git-repository-key ar) (git-repository-key br))

+71

(error "identity collision"))))

+72

+73

(test "browser-only root is unavailable without a Git request"

+74

(set! REQUESTS '())

+75

(let ((model (load-model (root->source model-browser: file: "/note") #f)))

+76

(assert-equal unavailable: (dict-ref (git-status-model-state model) state: #f))

+77

(assert-equal '() REQUESTS)))

+78

+79

(test "late discovery reply cannot overwrite a newer generation"

+80

(set! HELD '())

+81

(let ((model (make-git-status-model #f)))

+82

(git-status-model-load! model (root->source model-held: file: "/old/a") #f)

+83

(git-status-model-load! model (root->source model-held: file: "/new/b") #f)

+84

((car HELD))

+85

(assert-equal loading: (dict-ref (git-status-model-state model) state: #f))

+86

((cadr HELD))

+87

((caddr HELD))

+88

(assert-equal ready: (dict-ref (git-status-model-state model) state: #f))

+89

(assert-equal 2 (git-status-model-generation model))))

+90

+91

(test "snapshot equality is pure and row ids are stable across snapshots"

+92

(let* ((repo-a #{ root: model-remote-a: worktree: "/r" common-dir: "/r/.git" })

+93

(repo-b #{ root: model-remote-b: worktree: "/r" common-dir: "/r/.git" })

+94

(snap #{ head-oid: "h" index-id: "i" worktree-id: "w" })

+95

(changed #{ head-oid: "h" index-id: "i2" worktree-id: "w" })

+96

(entry #{ id: "file-1" })

+97

(other-entry #{ id: "file-2" }))

+98

(assert-equal #t (git-snapshot=? snap snap))

+99

(assert-equal #f (git-snapshot=? snap changed))

+100

;; Refreshing repository data must not invalidate selection identity.

+101

(assert-equal (git-row-id repo-a snap entry)

+102

(git-row-id repo-a changed entry))

+103

;; Repository provenance and entry identity remain distinguishing inputs.

+104

(assert-equal #f (string=? (git-row-id repo-a snap entry)

+105

(git-row-id repo-b snap entry)))

+106

(assert-equal #f (string=? (git-row-id repo-a snap entry)

+107

(git-row-id repo-a snap other-entry)))))

+108

+109

(test "malformed discovery becomes an explicit error state"

+110

(register-provider!

+111

model-malformed:

+112

#{ git-request: (lambda (source verb args on-ready on-error)

+113

(on-ready #{ version: 1 })) })

+114

(register-root! model-malformed: #{ provider: model-malformed: class: machine: })

+115

(let ((model (load-model (root->source model-malformed: file: "/x") #f)))

+116

(assert-equal error: (dict-ref (git-status-model-state model) state: #f))))

+117

+118

(test "refresh keeps ready data visible as stale while pending"

+119

(let ((model (load-model (root->source model-local: file: "/x") #f)))

+120

(git-status-model-refresh! model (root->source model-held: file: "/x") #f)

+121

(assert-equal stale: (dict-ref (git-status-model-state model) state: #f))

+122

(assert-equal #t (dict? (dict-ref (git-status-model-state model) data: #f)))))

+123

+124

(test "held remote reply exposes loading and accepts client work before release"

+125

(set! HELD '())

+126

(let* ((beats '())

+127

(model (make-git-status-model

+128

(lambda (state)

+129

;; This listener runs on the client event lane. Recording a

+130

;; heartbeat proves the held node callback did not block it.

+131

(set! beats (cons (dict-ref state state: #f) beats))))))

+132

(git-status-model-load! model (root->source model-held: file: "/remote/repo/a") #f)

+133

(assert-equal loading: (dict-ref (git-status-model-state model) state: #f))

+134

(assert-equal (list loading:) beats)

+135

;; Closing a view drops its model; a subsequent client action need not wait

+136

;; for this held callback. Release here only to keep the fixture isolated.

+137

(assert-equal 1 (length HELD))

+138

((car HELD))

+139

((cadr HELD))

+140

(assert-equal ready: (dict-ref (git-status-model-state model) state: #f))))

+141

+142

(test "hunk mutation sends structured identity instead of rendered patch text"

+143

(set! MUTATION-ARGS #f)

+144

(let* ((source (root->source model-remote-a: file: "/x"))

+145

(model (load-model source #f))

+146

(identity #{ file-id: "file-1" side: "worktree" old-start: 1 old-lines: 2

+147

new-start: 1 new-lines: 3 context-hash: "context" }))

+148

(git-status-model-mutate-hunk! model source "git/stage-hunk" identity #f #f)

+149

(assert-equal identity (dict-ref MUTATION-ARGS hunk-id: #f))

+150

(assert-equal #f (dict-ref MUTATION-ARGS patch: #f))))

+151

+152

(test "watch event storm marks data stale without starting Git work"

+153

(set! HELD '())

+154

(let* ((source (root->source model-held: file: "/remote/repo/a"))

+155

(model (make-git-status-model #f)))

+156

(vector-set! model 1 #{ state: ready: generation: 0 data: #{ repo: #{} } })

+157

(git-status-model-watch-event! model source #f)

+158

(git-status-model-watch-event! model source #f)

+159

(git-status-model-watch-event! model source #f)

+160

(assert-equal stale: (dict-ref (git-status-model-state model) state: #f))

+161

(assert-equal #t (dict-ref (git-status-model-state model) external-change?: #f))

+162

(assert-equal '() HELD)))

+163

+164

(test "mutation-generated watch noise cannot invalidate its response"

+165

(set! HELD '())

+166

(let* ((source (root->source model-held: file: "/remote/repo/a"))

+167

(model (make-git-status-model #f)))

+168

;; A mutation owns the current generation until its fresh-status response

+169

;; arrives. Watch events caused by its filesystem writes must not start a

+170

;; competing load and advance that generation.

+171

(vector-set! model 1 #{ state: ready: generation: 7 mutation: pending: data: #{} })

+172

(vector-set! model 2 7)

+173

(git-status-model-watch-event! model source #f)

+174

(assert-equal 7 (git-status-model-generation model))

+175

(assert-equal '() HELD)))

+176

+177

(test "explicit refresh rejects excess status calls"

+178

(set! HELD '())

+179

(let* ((model (load-model (root->source model-local: file: "/x") #f))

+180

(source (root->source model-held: file: "/x")))

+181

(git-status-model-refresh! model source #f)

+182

(git-status-model-refresh! model source #f)

+183

(assert-equal 1 (length HELD))

+184

((car HELD))

+185

(git-status-model-refresh! model source #f)

+186

(assert-equal 2 (length HELD))

+187

((cadr HELD))

+188

(assert-equal ready: (dict-ref (git-status-model-state model) state: #f))

+189

(assert-equal 2 (length HELD))))

+190

+191

(test "watch during explicit refresh preserves progress without automatic reload"

+192

(set! HELD '())

+193

(let* ((model (load-model (root->source model-local: file: "/x") #f))

+194

(source (root->source model-held: file: "/x")))

+195

(git-status-model-refresh! model source #f)

+196

((car HELD))

+197

(git-status-model-watch-event! model source #f)

+198

(assert-false (dict-ref (git-status-model-state model) external-change?: #f))

+199

((cadr HELD))

+200

(assert-equal 2 (length HELD))

+201

(assert-true (dict-ref (git-status-model-state model) external-change?: #f))

+202

(assert-true (dict? (dict-ref (git-status-model-state model) data: #f)))))

+203

+204

(test "refresh cannot invalidate a pending mutation"

+205

(set! HELD '())

+206

(let* ((model (make-git-status-model #f))

+207

(source (root->source model-held: file: "/x")))

+208

(vector-set! model 1 #{ state: ready: generation: 7 mutation: pending: data: #{} })

+209

(vector-set! model 2 7)

+210

(git-status-model-refresh! model source #f)

+211

(assert-equal 7 (git-status-model-generation model))

+212

(assert-equal '() HELD)))

+213

+214

(test "late error cannot release a newer refresh guard"

+215

(let ((errors '()))

+216

(register-provider! model-errors:

+217

#{ git-request:

+218

(lambda (source verb args on-ready on-error)

+219

(set! errors (append errors (list on-error)))) })

+220

(register-root! model-errors: #{ provider: model-errors: class: machine: })

+221

(let* ((model (load-model (root->source model-local: file: "/x") #f))

+222

(source (root->source model-errors: file: "/x")))

+223

(git-status-model-load! model source #f)

+224

(git-status-model-refresh! model source #f)

+225

(assert-equal 2 (length errors))

+226

((car errors) operation-failed:)

+227

(git-status-model-refresh! model source #f)

+228

(assert-equal 2 (length errors))

+229

((cadr errors) operation-failed:)

+230

(assert-equal error: (dict-ref (git-status-model-state model) state: #f)))))

+231

+232

(test "unavailable refresh releases its guard for recovery"

+233

(let ((model (load-model (root->source model-local: file: "/x") #f)))

+234

(git-status-model-refresh! model (root->source model-browser: file: "/x") #f)

+235

(assert-equal unavailable: (dict-ref (git-status-model-state model) state: #f))

+236

(git-status-model-refresh! model (root->source model-local: file: "/x") #f)

+237

(assert-equal ready: (dict-ref (git-status-model-state model) state: #f))))

+238

+239

(test "watch activity cannot hide an explicit refresh failure"

+240

(let ((fail #f))

+241

(register-provider! model-refresh-error:

+242

#{ git-request:

+243

(lambda (source verb args on-ready on-error)

+244

(set! fail on-error)) })

+245

(register-root! model-refresh-error:

+246

#{ provider: model-refresh-error: class: machine: })

+247

(let* ((model (load-model (root->source model-local: file: "/x") #f))

+248

(source (root->source model-refresh-error: file: "/x")))

+249

(git-status-model-refresh! model source #f)

+250

(git-status-model-watch-event! model source #f)

+251

(fail operation-failed:)

+252

(assert-equal error: (dict-ref (git-status-model-state model) state: #f)))))

+253

+254

(test "mutations cannot race a refresh or an earlier mutation"

+255

(set! HELD '())

+256

(let* ((model (load-model (root->source model-local: file: "/x") #f))

+257

(source (root->source model-held: file: "/x")))

+258

(git-status-model-refresh! model source #f)

+259

(git-status-model-mutate! model source "git/stage-file" "file-1" #f #f)

+260

(git-status-model-mutate-hunk! model source "git/stage-hunk" #{} #f #f)

+261

(assert-equal 1 (length HELD))

+262

((car HELD))

+263

((cadr HELD))

+264

(git-status-model-mutate! model source "git/stage-file" "file-1" #f #f)

+265

(assert-equal 3 (length HELD))

+266

(git-status-model-mutate! model source "git/stage-file" "file-1" #f #f)

+267

(git-status-model-mutate-hunk! model source "git/stage-hunk" #{} #f #f)

+268

(assert-equal 3 (length HELD))

+269

((caddr HELD))

+270

(assert-equal complete: (dict-ref (git-status-model-state model) mutation: #f))))

packages/slate/test/git-status-view-test.sgladded

@@ -0,0 +1,383 @@

+1

;;; A3 structured read-only Git status view behavior.

+2

(import (sigil core) (sigil test) (sigil string)

+3

(slate git diff-model) (slate git model) (slate git review) (slate git status-view) (slate mode)

+4

(slate modes git-status) (slate option) (slate main preferences)

+5

(slate root) (slate view))

+6

+7

; Inspect lazy render output without a browser. Production evaluates these

+8

; producers only when the memo revision changes.

+9

(define (force-render value)

+10

(cond ((and (vector? value) (= (vector-length value) 4)

+11

(eq? (vector-ref value 0) 'web-client-memo))

+12

(force-render ((vector-ref value 3))))

+13

((pair? value) (map force-render value))

+14

(else value)))

+15

(define (rendered-text value) (format "~s" (force-render value)))

+16

+17

(test "Git status renderer is exported"

+18

(assert-true (procedure? git-status-render))

+19

(assert-true (procedure? git-status?)))

+20

+21

(test "Git layout defaults to Auto and restores only supported choices"

+22

(let* ((decl (option-declaration slate/git-layout:))

+23

(restored (preferences-restore-from #{} #{ slate/git-layout: 'split } #f))

+24

(invalid (preferences-restore-from #{} #{ slate/git-layout: 'unknown } #f)))

+25

(assert-equal 'auto (option-default decl))

+26

(assert-equal 'split (dict-ref (dict-ref restored state: #{}) slate/git-layout: #f))

+27

(assert-equal 'auto (dict-ref (dict-ref invalid state: #{}) slate/git-layout: #f))))

+28

+29

(test "Git status mode registers its constructor"

+30

(assert-true (dict? (mode-descriptor 'git-status-mode))))

+31

+32

(define repo #{ root: test-git: worktree: "/repo" common-dir: "/repo/.git" })

+33

(define snapshot #{ head-oid: "abc" index-id: "idx" worktree-id: "wt" })

+34

(define status

+35

#{ version: 1 repo: repo snapshot: snapshot

+36

branch: #{ head: "main" upstream: "origin/main" ahead: 1 behind: 2 }

+37

operation: #f

+38

entries: (list

+39

#{ id: "conflict" path: "conflict.sgl" kind: "conflict" index-state: "U" worktree-state: "U" }

+40

#{ id: "work" path: "work.sgl" kind: "ordinary" index-state: "." worktree-state: "M" }

+41

#{ id: "new" path: "new.sgl" kind: "untracked" index-state: "?" worktree-state: "?" }

+42

#{ id: "stage" path: "stage.sgl" kind: "ordinary" index-state: "M" worktree-state: "." })

+43

recent-commits: (list #{ oid: "abc" subject: "subject" }) capabilities: #{} })

+44

+45

(define (ready-view)

+46

(let ((model (make-git-status-model #f)))

+47

;; Feed the public reducer result into the model through its vector state slot;

+48

;; transport/generation behavior is covered by git-status-model-test.

+49

(vector-set! model 1 #{ state: ready: generation: 1 data: status })

+50

#{ slate/name: "*git-status:test*"

+51

slate/source: #{ root: test-git: provider: test: kind: file: address: "/repo/a.sgl" }

+52

slate/git-model: model slate/git-selected: #f slate/git-folded: '()

+53

slate/git-row-cache: (make-git-status-row-cache) }))

+54

+55

(define (ready-mode-view)

+56

(let* ((plain (ready-view))

+57

(ctor (dict-ref (mode-descriptor 'git-status-mode) ctor: #f)))

+58

(ctor slate/name: (dict-ref plain slate/name: "")

+59

slate/source: (dict-ref plain slate/source: #{})

+60

slate/git-model: (dict-ref plain slate/git-model: #f)

+61

slate/git-selected: #f slate/git-folded: '())))

+62

+63

(test "registered Git status mode renders structured status markup"

+64

(let* ((desc (mode-descriptor 'git-status-mode))

+65

(ctor (dict-ref desc ctor: #f))

+66

(plain (ready-view))

+67

(view (ctor slate/name: (dict-ref plain slate/name: "")

+68

slate/source: (dict-ref plain slate/source: #{})

+69

slate/git-model: (dict-ref plain slate/git-model: #f)

+70

slate/git-selected: #f slate/git-folded: '())))

+71

(assert-equal 'div (car (view-render view)))))

+72

+73

(test "ordinary status hides the inactive operation header"

+74

(let ((text (rendered-text (git-status-render (ready-view)))))

+75

(assert-false (string-contains? text "Operation"))))

+76

+77

(test "status summary and recent commits show abbreviated object ids"

+78

(let ((text (rendered-text (git-status-render (ready-view)))))

+79

(assert-true (string-contains? text "Latest commit"))

+80

(assert-true (string-contains? text "git-commit-oid"))

+81

(assert-true (string-contains? text "abc"))))

+82

+83

(test "mode string reports stable status counts and refresh activity"

+84

(let ((view (ready-mode-view)))

+85

(assert-equal "Git · 4 changed · 1 staged · 1 untracked" (view-info view))

+86

(vector-set! (git-status-model view) 1

+87

#{ state: stale: generation: 2 data: status })

+88

(assert-equal "Git · refreshing… · 4 changed · 1 staged · 1 untracked"

+89

(view-info view))))

+90

+91

(test "a newly staged file renders an unstage action"

+92

(let* ((view (ready-view))

+93

(model (git-status-model view))

+94

(data (dict-set status entries:

+95

(list #{ id: "added" path: "added.sgl" kind: "ordinary"

+96

index-state: "A" worktree-state: "." }))))

+97

(vector-set! model 1 #{ state: ready: generation: 2 data: data })

+98

(let ((text (rendered-text (git-status-render view))))

+99

(assert-true (string-contains? text "Unstage added.sgl"))

+100

(assert-true (string-contains? text "git-select-unstage:")))))

+101

+102

(test "status rows contain every required section and recent commits"

+103

(let ((rows (git-status-rows (ready-view))))

+104

(assert-equal 10 (length rows))

+105

(assert-equal "section:conflicts" (dict-ref (car rows) id: #f))

+106

(assert-equal "commit:abc" (dict-ref (list-ref rows 9) id: #f))))

+107

+108

(test "a staged plus unstaged file appears independently on both diff sides"

+109

(let* ((v (ready-view)) (model (git-status-model v))

+110

(both #{ id: "both" path: "both.sgl" kind: "ordinary"

+111

index-state: "M" worktree-state: "M" })

+112

(data (dict-set status entries: (list both))))

+113

(vector-set! model 1 #{ state: ready: generation: 2 data: data })

+114

(let ((rows (filter (lambda (row) (eq? (dict-ref row kind: #f) entry:))

+115

(git-status-rows v))))

+116

(assert-equal 2 (length rows))

+117

(assert-true (any (lambda (row) (eq? (dict-ref row section: #f) staged:)) rows))

+118

(assert-true (any (lambda (row) (eq? (dict-ref row section: #f) unstaged:)) rows)))))

+119

+120

(test "stage and unstage pointer controls render through registered command families"

+121

(let ((text (call-with-output-string (lambda (port) (write (git-status-render (ready-view)) port)))))

+122

(assert-true (string-contains? text "git-select-stage:"))

+123

(assert-true (string-contains? text "git-select-unstage:"))))

+124

+125

(test "status rows omit every zero-count section"

+126

(let* ((v (ready-view))

+127

(model (git-status-model v))

+128

(only-work (dict-set status entries:

+129

(list #{ id: "work" path: "work.sgl" kind: "ordinary"

+130

index-state: "." worktree-state: "M" })))

+131

(without-commits (dict-set only-work recent-commits: '())))

+132

(vector-set! model 1 #{ state: ready: generation: 2 data: without-commits })

+133

(let ((rows (git-status-rows v)))

+134

(assert-equal 2 (length rows))

+135

(assert-equal "section:unstaged" (dict-ref (car rows) id: #f))

+136

(assert-equal #f

+137

(any (lambda (row) (= 0 (dict-ref row count: 1))) rows)))))

+138

+139

(test "navigation aliases share bounded meaningful-row movement"

+140

(let* ((v (ready-view)) (down (git-status-move v 1))

+141

(down2 (git-status-move down 1)) (up (git-status-move down2 -1)))

+142

(assert-equal (dict-ref down slate/git-selected: #f)

+143

(dict-ref up slate/git-selected: #f))))

+144

+145

(test "folding a selected section hides only its member rows"

+146

(let* ((v (dict-set (ready-view) slate/git-selected: "section:unstaged"))

+147

(folded (git-status-toggle v)))

+148

(assert-equal 9 (length (git-status-rows folded)))

+149

(assert-equal #t (if (member "section:unstaged" (dict-ref folded slate/git-folded: '())) #t #f))))

+150

+151

(test "view names retain root provenance"

+152

(assert-equal "*git-status:test-git:/repo/a.sgl*"

+153

(git-status-view-name (dict-ref (ready-view) slate/source: #{})))

+154

(assert-equal "*git-status:test-git:/repo/a.sgl*"

+155

(git-status-view-name #{ root: "test-git" address: "/repo/a.sgl" })))

+156

+157

(test "canonical view names collapse files in one root-qualified repository"

+158

(assert-equal (git-status-repository-view-name repo)

+159

(git-status-repository-view-name

+160

#{ root: test-git: worktree: "/repo" common-dir: "/repo/.git" })))

+161

+162

(define (work-row view)

+163

(car (filter (lambda (row)

+164

(and (eq? (dict-ref row kind: #f) entry:)

+165

(string=? (dict-ref (dict-ref row entry: #{}) path: "") "work.sgl")))

+166

(git-status-rows view))))

+167

+168

(define (inline-view lines complete?)

+169

(let* ((view (ready-view)) (entry (work-row view)) (id (dict-ref entry id: ""))

+170

(model (make-git-diff-model (dict-ref view slate/source: #{}) repo snapshot

+171

"worktree" "work.sgl" #f)))

+172

(vector-set! model 1

+173

#{ state: ready: pages: (list #{ files: (list #{ hunks: lines })

+174

next-cursor: (if complete? #f "next") complete: complete? })

+175

next-cursor: (if complete? #f "next") complete: complete? })

+176

(dict-set view slate/git-inline-models: (list (cons id model)))))

+177

+178

(test "navigation reuses rows while section and hunk folds invalidate them"

+179

(let* ((v (inline-view (list #{ kind: hunk: text: "@@ -1 +1 @@" }

+180

#{ kind: addition: text: "+body" }) #t))

+181

(rows (git-status-rows v))

+182

(revision (git-status-row-revision v))

+183

(moved (git-status-move v 1))

+184

(hunk (find (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) rows))

+185

(folded (dict-set moved slate/git-hunk-folded: (list (dict-ref hunk id: #f)))))

+186

(assert-true (eq? rows (git-status-rows moved)))

+187

(assert-equal revision (git-status-row-revision moved))

+188

(assert-false (equal? revision (git-status-row-revision folded)))

+189

(assert-equal (- (length rows) 1) (length (git-status-rows folded)))

+190

(assert-equal rows (git-status-rows v))

+191

(let ((section-rows (git-status-rows

+192

(dict-set v slate/git-folded: '("section:unstaged")))))

+193

(assert-true (< (length section-rows) (length rows))))))

+194

+195

(test "cached rows revoke hunk authority when the model snapshot changes"

+196

(let* ((v (inline-view (list #{ kind: hunk: text: "@@ -1 +1 @@" }) #t))

+197

(model (cdr (car (dict-ref v slate/git-inline-models: '()))))

+198

(rows (git-status-rows v))

+199

(hunk (find (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) rows)))

+200

(assert-true (dict? (dict-ref hunk hunk-id: #f)))

+201

(vector-set! model 5 (dict-set snapshot index-id: "changed"))

+202

(let* ((next (git-status-rows v))

+203

(hunk (find (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) next)))

+204

(assert-false (eq? rows next))

+205

(assert-false (dict-ref hunk hunk-id: #f)))))

+206

+207

(test "expanded status file projects structured hunks and continuation inline"

+208

(let* ((view (inline-view

+209

(list #{ kind: hunk: text: "@@ -1 +1 @@" old-line: #f new-line: #f }

+210

#{ kind: deletion: text: "-old" old-line: 1 new-line: #f }

+211

#{ kind: addition: text: "+new" old-line: #f new-line: 1 }) #f))

+212

(rows (git-status-rows view)))

+213

(assert-true (any (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) rows))

+214

(assert-true (any (lambda (row) (eq? (dict-ref row kind: #f) addition:)) rows))

+215

(assert-true (any (lambda (row) (eq? (dict-ref row kind: #f) continuation:)) rows))))

+216

+217

(test "expanded hunk carries structured mutation identity and pointer action"

+218

(let* ((view (inline-view

+219

(list #{ kind: hunk: text: "@@ -3,2 +3,4 @@ function" old-line: #f new-line: #f }

+220

#{ kind: context: text: " line" old-line: 3 new-line: 3 }) #t))

+221

(hunk (car (filter (lambda (row) (eq? (dict-ref row kind: #f) hunk:))

+222

(git-status-rows view))))

+223

(identity (dict-ref hunk hunk-id: #{}))

+224

(rendered (rendered-text (git-status-render

+225

(dict-set view slate/git-selected: (dict-ref hunk id: ""))))))

+226

(assert-equal "worktree" (dict-ref identity side: ""))

+227

(assert-equal 3 (dict-ref identity old-start: 0))

+228

(assert-equal 2 (dict-ref identity old-lines: 0))

+229

(assert-equal 4 (dict-ref identity new-lines: 0))

+230

(assert-true (string? (dict-ref identity context-hash: #f)))

+231

(assert-true (string-contains? rendered "git-select-stage:"))

+232

(assert-true (string-contains? rendered "(title \"Stage hunk\")"))

+233

(assert-false (string-contains? rendered "(title \"Unstage hunk\")"))))

+234

+235

(test "inline hunk folding retains header and hides its body"

+236

(let* ((view (inline-view

+237

(list #{ kind: hunk: text: "@@ -1 +1 @@" old-line: #f new-line: #f }

+238

#{ kind: deletion: text: "-old" old-line: 1 new-line: #f }

+239

#{ kind: addition: text: "+new" old-line: #f new-line: 1 }) #t))

+240

(hunk (car (filter (lambda (row) (eq? (dict-ref row kind: #f) hunk:))

+241

(git-status-rows view))))

+242

(folded (dict-set view slate/git-hunk-folded: (list (dict-ref hunk id: ""))))

+243

(rows (git-status-rows folded)))

+244

(assert-true (any (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) rows))

+245

(assert-false (any (lambda (row) (eq? (dict-ref row kind: #f) addition:)) rows))))

+246

+247

(test "several inline pages cannot exceed the global mounted-row ceiling"

+248

(let* ((lines (map (lambda (n) #{ kind: context: text: " line" old-line: n new-line: n })

+249

(iota 1200 1)))

+250

(rows (git-status-rows (inline-view lines #t))))

+251

(assert-true (<= (length rows) 800))))

+252

+253

(test "Git header outline and command strip are separate layout regions"

+254

(let* ((markup (git-status-render (ready-view)))

+255

(regions (filter pair? (cddr markup))))

+256

(assert-equal '(header div nav) (map car regions))

+257

(assert-true (string-contains? (rendered-text (cadr regions)) "git-outline"))

+258

(assert-true (string-contains? (rendered-text (caddr regions)) "Git commands"))))

+259

+260

(test "layout changes keep one diff control and preserve selection folds and models"

+261

(let* ((view (inline-view

+262

(list #{ kind: hunk: text: "@@ -1 +1 @@" }

+263

#{ kind: addition: text: "+preserved" new-line: 1 }) #t))

+264

(id (dict-ref (work-row view) id: ""))

+265

(view (dict-set view slate/git-selected: id))

+266

(before (git-status-rows view))

+267

(models (dict-ref view slate/git-inline-models: '()))

+268

(prior (set-option-live-reader! (lambda (key default) 'auto))))

+269

(for-each

+270

(lambda (layout)

+271

(set-option-live-reader! (lambda (key default) layout))

+272

(let ((text (rendered-text (git-status-render view))))

+273

(assert-true (string-contains? text "git-inline-diff active"))

+274

(assert-equal 2 (length (string-split text "(class \"slate-diff-control\")")))

+275

(assert-equal before (git-status-rows view))

+276

(assert-equal id (dict-ref view slate/git-selected: #f))

+277

(assert-equal models (dict-ref view slate/git-inline-models: '()))))

+278

'(auto inline split))

+279

(set-option-live-reader! prior)))

+280

+281

(test "clean working tree has an explicit empty state"

+282

(let* ((view (ready-view))

+283

(data (dict-set status entries: '())))

+284

(vector-set! (git-status-model view) 1 #{ state: ready: data: data })

+285

(assert-true (string-contains? (rendered-text (git-status-render view))

+286

"Working tree clean"))))

+287

+288

(test "snapshot-scoped entry IDs do not replace display identity or close a folded section review"

+289

(let* ((v (inline-view (list #{ kind: hunk: text: "@@ -1 +1 @@" }) #t))

+290

(id (dict-ref (work-row v) id: #f))

+291

(v (dict-set (dict-set v slate/git-selected: id)

+292

slate/git-folded: (list "section:unstaged")))

+293

(data (dict-set status entries:

+294

(map (lambda (entry) (dict-set entry id: (string-append "fresh-" (dict-ref entry id: ""))))

+295

(dict-ref status entries: '()))))

+296

(next (git-review-status v data)))

+297

(assert-equal (dict-ref v slate/git-inline-models: '())

+298

(dict-ref next slate/git-inline-models: '()))

+299

(assert-equal (list "section:unstaged") (dict-ref next slate/git-folded: '()))

+300

(assert-equal id (dict-ref (work-row (dict-set next slate/git-folded: '())) id: #f))))

+301

+302

(test "staging a file continues at the next file in its source section"

+303

(let* ((v (ready-view))

+304

(work (dict-ref (work-row v) entry: #{}))

+305

(other #{ id: "other" path: "other.sgl" kind: "ordinary" index-state: "." worktree-state: "M" })

+306

(before (dict-set status entries: (list work other)))

+307

(v (dict-set (dict-set v slate/git-data: before)

+308

slate/git-selected: (dict-ref (work-row v) id: #f)))

+309

(fresh (dict-set before entries:

+310

(list (dict-set (dict-set work index-state: "M") worktree-state: ".") other)))

+311

(next (git-review-status v fresh))

+312

(selected (git-status-selected-row next)))

+313

(assert-equal "other.sgl" (dict-ref (dict-ref selected entry: #{}) path: #f))

+314

(assert-equal unstaged: (dict-ref selected section: #f))))

+315

+316

(test "a pending mutation does not override a later selection"

+317

(let* ((v (dict-set (ready-view) slate/git-selected: "section:staged"))

+318

(next (git-review-status v (dict-set status entries: (cdr (dict-ref status entries: '()))))))

+319

(assert-equal "section:staged" (dict-ref next slate/git-selected: #f))))

+320

+321

(test "retained old pages cannot render hunk mutation actions under a fresh snapshot"

+322

(let* ((v (inline-view (list #{ kind: hunk: text: "@@ -1 +1 @@" }

+323

#{ kind: addition: text: "+retained" }) #t))

+324

(fresh (dict-set status snapshot: #{ head-oid: "abc" index-id: "new-index" worktree-id: "wt" }))

+325

(next (git-review-status v fresh))

+326

(hunk (find (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) (git-status-rows next))))

+327

(assert-false (dict-ref hunk hunk-id: #f))

+328

(assert-true (string-contains? (rendered-text (git-status-render next)) "retained"))

+329

(assert-false (string-contains? (rendered-text (git-status-render next)) "slate-diff-mutation"))))

+330

+331

(test "refresh preserves a shifted hunk fold and selects the nearest remaining hunk"

+332

(let* ((first #{ kind: hunk: text: "@@ -1 +1,2 @@" })

+333

(second #{ kind: hunk: text: "@@ -20 +21 @@" })

+334

(v (inline-view (list first #{ kind: addition: text: "+first" }

+335

second #{ kind: addition: text: "+second" }) #t))

+336

(id (dict-ref (work-row v) id: #f))

+337

(model (cdr (assoc id (dict-ref v slate/git-inline-models: '()))))

+338

(old (git-diff-model-state model))

+339

(hunks (filter (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) (git-status-rows v)))

+340

(v (dict-set (dict-set v slate/git-selected: (dict-ref (car hunks) id: #f))

+341

slate/git-hunk-folded: (list (dict-ref (cadr hunks) id: #f)))))

+342

(vector-set! model 1

+343

#{ state: ready: pages: (list #{ files: (list #{ hunks:

+344

(list #{ kind: hunk: text: "@@ -21 +21 @@" } #{ kind: addition: text: "+second" }) }) })

+345

complete: #t })

+346

(let* ((next (git-review-diff v id old))

+347

(selected (git-status-selected-row next)))

+348

(assert-equal "@@ -21 +21 @@" (dict-ref selected text: #f))

+349

(assert-true (dict-ref selected folded?: #f))

+350

(assert-false (any (lambda (row) (eq? (dict-ref row kind: #f) addition:))

+351

(git-status-rows next))))))

+352

+353

(test "deferred folded review still projects and renders its retained hunk"

+354

(let* ((v (inline-view (list #{ kind: hunk: text: "@@ -1 +1 @@" }

+355

#{ kind: addition: text: "+retained" }) #t))

+356

(model (cdr (car (dict-ref v slate/git-inline-models: '()))))

+357

(hunk (find (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) (git-status-rows v)))

+358

(v (dict-set v slate/git-hunk-folded: (list (dict-ref hunk id: #f)))))

+359

(vector-set! model 1

+360

(dict-set (dict-set (git-diff-model-state model) state: deferred:) rebasing: #t))

+361

(let ((rows (git-status-rows v)) (markup (rendered-text (git-status-render v))))

+362

(assert-true (any (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) rows))

+363

(assert-true (string-contains? markup "Refresh this review"))

+364

(assert-true (string-contains? markup "@@ -1 +1 @@"))

+365

(assert-false (string-contains? markup "+retained")))))

+366

+367

(test "selection follows the same surviving hunk when earlier edits shift its header"

+368

(let* ((v (inline-view

+369

(list #{ kind: hunk: text: "@@ -1 +1,2 @@" } #{ kind: addition: text: "+first" }

+370

#{ kind: hunk: text: "@@ -20 +21 @@" } #{ kind: addition: text: "+second" }

+371

#{ kind: hunk: text: "@@ -40 +41 @@" } #{ kind: addition: text: "+third" }) #t))

+372

(id (dict-ref (work-row v) id: #f))

+373

(model (cdr (assoc id (dict-ref v slate/git-inline-models: '()))))

+374

(old (git-diff-model-state model))

+375

(hunks (filter (lambda (row) (eq? (dict-ref row kind: #f) hunk:)) (git-status-rows v)))

+376

(v (dict-set v slate/git-selected: (dict-ref (cadr hunks) id: #f))))

+377

(vector-set! model 1

+378

#{ state: ready: pages: (list #{ files: (list #{ hunks:

+379

(list #{ kind: hunk: text: "@@ -21 +21 @@" } #{ kind: addition: text: "+second" }

+380

#{ kind: hunk: text: "@@ -41 +41 @@" } #{ kind: addition: text: "+third" }) }) })

+381

complete: #t })

+382

(assert-equal "@@ -21 +21 @@"

+383

(dict-ref (git-status-selected-row (git-review-diff v id old)) text: #f))))

packages/slate/test/list-test.sglmodified

@@ -3,4 +3,7 @@

3

(test "list-last is the shared last-element operation"

4

(assert-equal (list-last '(first middle last)) 'last))

5

+6

(test "drop-last is the shared all-but-last operation"

+7

(assert-equal (drop-last '(first middle last)) '(first middle)))

+8

9

(test-summary)

packages/slate/test/local-root-identity-test.sgladded

@@ -0,0 +1,95 @@

+1

(import (sigil core) (sigil string) (sigil test) (sigil irc message)

+2

(slate provider) (slate root) (slate providers enclave-node))

+3

+4

(test-group "registered root locality"

+5

(test "opaque node identity reclassifies the canonical root onto loopback"

+6

(register-root! local:

+7

#{ provider: local: label: "This computer" class: local:

+8

local?: #t home: "/home/me" })

+9

(register-root! workstation:

+10

#{ provider: node: host: "slate-node-opaque-7" label: "workstation"

+11

class: machine: status: online: home: "/home/me" })

+12

+13

(enclave-node-set-local-identity! "slate-node-opaque-7")

+14

+15

(let ((canonical (root-ref workstation:))

+16

(alias (root-ref local:)))

+17

(assert-equal local: (dict-ref canonical provider: #f))

+18

(assert-true (dict-ref canonical local?: #f))

+19

(assert-true (dict-ref alias hidden?: #f))

+20

(assert-true (member workstation: (root-visible-names)))

+21

(assert-false (member local: (root-visible-names)))

+22

(assert-true (string-contains? (root-annotation workstation:) "local")))

+23

+24

(unregister-root! workstation:)

+25

(unregister-root! local:))

+26

+27

(test "display-label equality alone never marks a root local"

+28

(register-root! impostor:

+29

#{ provider: node: host: "different-opaque-id" label: "workstation"

+30

class: machine: status: online: })

+31

(enclave-node-set-local-identity! "slate-node-opaque-7")

+32

(assert-equal node: (dict-ref (root-ref impostor:) provider: #f))

+33

(assert-false (dict-ref (root-ref impostor:) local?: #f))

+34

(unregister-root! impostor:))

+35

+36

(test "loopback identity publishes the canonical root before discovery"

+37

(register-root! local:

+38

#{ provider: local: label: "This computer" class: local:

+39

local?: #t home: "/home/me" })

+40

(assert-equal earlybox:

+41

(enclave-node-register-local-root!

+42

"slate-node-early" "earlybox" "/home/me"))

+43

(let ((root (root-ref earlybox:)))

+44

(assert-equal local: (dict-ref root provider: #f))

+45

(assert-equal "slate-node-early" (dict-ref root host: #f))

+46

(assert-equal "/home/me" (dict-ref root home: #f))

+47

(assert-true (dict-ref root local?: #f))

+48

(assert-false (member local: (root-visible-names))))

+49

(unregister-root! earlybox:)

+50

(unregister-root! local:))

+51

+52

(test "authoritative discovery preserves the loopback classification"

+53

(register-root! local:

+54

#{ provider: local: label: "This computer" class: local:

+55

local?: #t home: "/home/me" })

+56

(enclave-node-register-local-root!

+57

"slate-node-aa561ddb01b9" "zerocool" "/home/me")

+58

;; Even a contradictory catalog row cannot downgrade a fact attested by

+59

;; the authenticated loopback node. This is not label-based locality: the

+60

;; canonical root already carries the remembered opaque local identity.

+61

(enclave-node-on-message!

+62

(parse-irc-message

+63

":server ENCLAVE-NODE zerocool stale-catalog-identity OFFLINE"))

+64

(let ((root (root-ref zerocool:)))

+65

(assert-equal local: (dict-ref root provider: #f))

+66

(assert-true (dict-ref root local?: #f))

+67

(assert-equal online: (dict-ref root status: #f))

+68

(assert-equal "slate-node-aa561ddb01b9" (dict-ref root host: #f))

+69

(assert-equal "/home/me" (dict-ref root home: #f)))

+70

(unregister-root! zerocool:)

+71

(unregister-root! local:))

+72

+73

(test "durable pairing retains a cached remote root without account discovery"

+74

;; This is the cold account-lane path: sys/info came from the authenticated

+75

;; loopback node, while no ENCLAVE-NODE/ENCLAVE-NODES frame arrived.

+76

(enclave-node-reset!)

+77

(register-root! zerocool:

+78

#{ provider: node: host: "slate-node-peer-01" label: "zerocool"

+79

class: machine: status: unknown: home: "/home/daviwil"

+80

planes: (list resource: session:) })

+81

(enclave-node-register-pairings!

+82

(list #{ transport-nick: "slate-node-peer-01"

+83

revoked: #f offline-ready?: #t }))

+84

(let ((root (root-ref zerocool:)))

+85

(assert-true root)

+86

(assert-equal "zerocool" (dict-ref root label: #f))

+87

(assert-equal "slate-node-peer-01" (dict-ref root host: #f))

+88

(assert-equal "/home/daviwil" (dict-ref root home: #f)))

+89

+90

;; A later authoritative local ledger without the pairing removes it; an

+91

;; old async fs/home result is generation-gated and cannot resurrect it.

+92

(enclave-node-register-pairings! '())

+93

(assert-false (root-ref zerocool:))

+94

(enclave-node-reset!))

+95

)

packages/slate/test/navigation-command-test.sglmodified

@@ -23,6 +23,7 @@

23

(assert-equal (command-module (command-resolve event))

24

'(slate commands navigation)))

25

(list "view-switch-recent" "show-messages" "scratchpad" "welcome"

+26

"slate-performance-start" "slate-performance-save"

27

"close-view" "clear" "reload-init" "switchspace:other"

28

"switch:b" "reveal-path:0:local:/tmp/a")))

29

packages/slate/test/node-companion-restart-live.sgladded

@@ -0,0 +1,121 @@

+1

;;; Companion restart -> generation-scoped carrier loss -> durable reattach.

+2

;;; Orchestrated only by scripts/test-node-direct-live.

+3

(import (sigil core) (sigil async) (sigil io) (sigil math) (sigil process) (sigil string)

+4

(sigil test) (sigil time)

+5

(slate enclave-account session) (slate provider)

+6

(slate providers enclave-node) (slate providers node))

+7

+8

(define endpoint (getenv "NODE_DIRECT_ENCLAVE_WS"))

+9

(define account (getenv "NODE_DIRECT_ACCOUNT"))

+10

(define credential (getenv "NODE_DIRECT_CREDENTIAL"))

+11

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+12

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+13

(define target (getenv "NODE_DIRECT_TARGET"))

+14

(define marker (getenv "NODE_DIRECT_MARKER"))

+15

(define restart-flag (getenv "NODE_COMPANION_RESTART_FLAG"))

+16

(define sentinel (getenv "NODE_DIRECT_SESSION_SENTINEL"))

+17

+18

(test "a companion restart retires its generation and reattaches the original PTY"

+19

(with-async

+20

(define account-ready #f)

+21

(define account-failure #f)

+22

(define output "")

+23

(define terminal-error #f)

+24

(define lost 0)

+25

(define reattached 0)

+26

(define reattach-transport #f)

+27

(define running #t)

+28

+29

(enclave-node-reset!)

+30

(node-reset!)

+31

(enclave-node-register!)

+32

(node-set-token! companion-token)

+33

(node-connect! companion)

+34

(account-session-on-message! enclave-node-on-message!)

+35

(account-session-start-saved!

+36

#{ version: 1 url: endpoint nick: account credential: credential }

+37

(lambda () (set! account-ready #t))

+38

(lambda (reason) (set! account-failure reason)))

+39

(go

+40

(let loop ()

+41

(account-session-poll!)

+42

(when running (sleep 0.001) (loop))))

+43

+44

(define (pump-until label predicate limit)

+45

(let loop ((n 0))

+46

(enclave-node-tick! (exact (floor (* 1000 (current-second)))))

+47

(node-poll!)

+48

(enclave-node-poll!)

+49

(cond ((predicate) #t)

+50

((>= n limit)

+51

(error (string-append "companion restart timeout: " label)

+52

account-failure terminal-error output lost reattached

+53

(enclave-node-reattach-count)

+54

(enclave-node-reattach-failures)

+55

(enclave-node-reattach-debug)

+56

(node-phase)))

+57

(else (sleep 0.01) (loop (+ n 1))))))

+58

+59

(pump-until "account and companion authenticate"

+60

(lambda () (and account-ready (node-ready?))) 4000)

+61

+62

(let* ((started (string-append marker "-companion-started"))

+63

(buffered (string-append marker "-companion-buffered"))

+64

(handle

+65

(source-session-open

+66

#{ provider: node: kind: pty: host: target

+67

argv: (list "sh" "-c"

+68

(string-append

+69

"if [ -e '" sentinel

+70

"' ]; then printf 'REPLACEMENT-PTY\\n'; exit 9; fi; : > '"

+71

sentinel "'; printf '" started

+72

"\\n'; (sleep 5; printf '" buffered

+73

"\\n') & while read line; do printf 'after:%s\\n' \"$line\"; done"))

+74

cols: 80 rows: 24 }

+75

(lambda (event)

+76

(let ((bytes (dict-ref event bytes: #f)))

+77

(when bytes (set! output (string-append output bytes))))

+78

(when (dict-ref event disconnected: #f)

+79

(set! lost (+ lost 1)))

+80

(when (dict-ref event reattached: #f)

+81

(set! reattached (+ reattached 1))

+82

(set! reattach-transport (dict-ref event transport: #f)))

+83

(when (dict-ref event error: #f)

+84

(set! terminal-error (dict-ref event error: #f))))

+85

#{ window: 4096 })))

+86

(pump-until "PTY starts on the original companion generation"

+87

(lambda () (string-contains? output started)) 4000)

+88

;; This phase deliberately exercises the implemented durable owner: a

+89

;; relay session lives in the target holder, outside the caller companion

+90

;; being restarted. Direct sessions still live in the companion-local hub

+91

;; and belong to the later hub-independence design phase.

+92

(assert-equal 'relay (enclave-node-carrier-transport target))

+93

(call-with-output-file restart-flag

+94

(lambda (port) (display "restart\n" port)))

+95

(pump-until "old companion generation reports one loss"

+96

(lambda () (> lost 0)) 6000)

+97

(assert-equal 1 lost)

+98

(pump-until "replacement companion authenticates"

+99

(lambda () (node-ready?)) 6000)

+100

(pump-until "durable PTY reattaches over a fresh carrier"

+101

(lambda () (> reattached 0)) 6000)

+102

(assert-equal 1 reattached)

+103

(assert-equal 'relay reattach-transport)

+104

(pump-until "output buffered during companion restart is replayed"

+105

(lambda () (string-contains? output buffered)) 4000)

+106

(when (string-contains? output "REPLACEMENT-PTY")

+107

(error "companion restart opened a replacement PTY"))

+108

(session-write handle "companion-restored\n")

+109

(pump-until "input reaches the original PTY after restart"

+110

(lambda () (string-contains? output "after:companion-restored")) 4000)

+111

(assert-equal reattach-transport

+112

(enclave-node-carrier-transport target))

+113

(assert-equal 0 (enclave-node-reattach-count))

+114

(session-close handle))

+115

+116

(set! running #f)

+117

(account-session-send-command! "ENCLAVE-NODES")

+118

(sleep 0.01)

+119

(enclave-node-reset!)

+120

(node-disconnect!)

+121

(account-session-close!)))

packages/slate/test/node-direct-live.sgladded

@@ -0,0 +1,311 @@

+1

;;; Real caller companion -> Enclave rendezvous -> target node live gate.

+2

;;; Orchestrated by scripts/test-node-direct-live.

+3

(import (sigil core) (sigil async) (sigil io) (sigil path) (sigil process) (sigil string)

+4

(sigil test) (sigil time)

+5

(slate enclave-account session)

+6

(slate provider)

+7

(slate providers enclave-node)

+8

(slate providers node))

+9

+10

(define endpoint (getenv "NODE_DIRECT_ENCLAVE_WS"))

+11

(define account (getenv "NODE_DIRECT_ACCOUNT"))

+12

(define credential (getenv "NODE_DIRECT_CREDENTIAL"))

+13

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+14

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+15

(define target (getenv "NODE_DIRECT_TARGET"))

+16

(define path (getenv "NODE_DIRECT_READABLE"))

+17

(define writable (getenv "NODE_DIRECT_WRITABLE"))

+18

(define marker (getenv "NODE_DIRECT_MARKER"))

+19

(define expected

+20

(if (string=? (getenv "NODE_DIRECT_EXPECT_TRANSPORT") "direct")

+21

'direct 'relay))

+22

+23

(test "real node carrier selects the expected transport"

+24

(with-async

+25

(define account-ready #f)

+26

(define account-failure #f)

+27

(define result #f)

+28

(define failure #f)

+29

(define write-failure #f)

+30

(define watch-event #f)

+31

(define mutation-result #f)

+32

(define mutation-failure #f)

+33

(define listing-result #f)

+34

(define transfer-progress '())

+35

(define terminal-output "")

+36

(define terminal-error #f)

+37

(define running #t)

+38

+39

(enclave-node-reset!)

+40

(node-reset!)

+41

(enclave-node-register!)

+42

(node-set-token! companion-token)

+43

(node-connect! companion)

+44

(account-session-on-message! enclave-node-on-message!)

+45

(account-session-start-saved!

+46

#{ version: 1 url: endpoint nick: account credential: credential }

+47

(lambda () (set! account-ready #t))

+48

(lambda (reason) (set! account-failure reason)))

+49

(go

+50

(let loop ()

+51

(account-session-poll!)

+52

;; The account pump is deliberately nowait. Yield explicitly so this

+53

;; native live probe models the browser metronome instead of monopolizing

+54

;; the scheduler once the socket has no work ready.

+55

(when running (sleep 0.001) (loop))))

+56

+57

(define (pump-until label predicate limit)

+58

(let loop ((n 0))

+59

(node-poll!)

+60

(enclave-node-poll!)

+61

(cond ((predicate) #t)

+62

((>= n limit)

+63

(error (string-append "node direct live timeout: " label)

+64

account-failure failure terminal-error terminal-output

+65

(node-phase)))

+66

(else (sleep 0.01) (loop (+ n 1))))))

+67

+68

(define (pump-for turns)

+69

(let loop ((n 0))

+70

(when (< n turns)

+71

(node-poll!)

+72

(enclave-node-poll!)

+73

(sleep 0.01)

+74

(loop (+ n 1)))))

+75

+76

(pump-until "account and caller companion authenticate"

+77

(lambda () (and account-ready (node-ready?))) 4000)

+78

(let* ((source #{ provider: node: kind: file: host: target address: path })

+79

(op (provider-async-op source)))

+80

(op source (lambda (value) (set! result value))

+81

(lambda (reason) (set! failure reason))))

+82

(pump-until "remote file request settles" (lambda () (or result failure)) 4000)

+83

(when failure (error "remote file request failed" failure))

+84

(let ((text (if (bytevector? result) (utf8->string result) result)))

+85

(unless (and (string? text) (string-contains? text marker))

+86

(error "remote file returned wrong content" result)))

+87

(assert-equal expected (enclave-node-carrier-transport target))

+88

+89

;; Session traffic must use the same selected carrier as resources. Start

+90

;; with deliberately insufficient credit so the marker cannot arrive,

+91

;; then replenish the window and exercise the bidirectional PTY controls.

+92

(let* ((session-marker

+93

(string-append marker "-session-" (symbol->string expected)))

+94

(prefix

+95

"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789--")

+96

(handle

+97

(source-session-open

+98

#{ provider: node: kind: pty: host: target

+99

argv: (list "sh" "-c"

+100

(string-append

+101

"trap 'stty size' WINCH; printf '" prefix

+102

session-marker

+103

"\\n'; while read line; do printf 'input:%s\\n' \"$line\"; stty size; done"))

+104

cols: 80 rows: 24 }

+105

(lambda (event)

+106

(let ((bytes (dict-ref event bytes: #f))

+107

(err (dict-ref event error: #f)))

+108

(when bytes

+109

(set! terminal-output

+110

(string-append terminal-output bytes)))

+111

(when err (set! terminal-error err))))

+112

#{ window: 32 })))

+113

(pump-until "PTY exhausts its initial consumer credit"

+114

(lambda () (= (string-length terminal-output) 32)) 4000)

+115

(when (string-contains? terminal-output session-marker)

+116

(error "PTY marker escaped the consumer credit window"))

+117

(session-credit handle 4096)

+118

(pump-until "PTY resumes after consumer credit"

+119

(lambda () (or terminal-error

+120

(string-contains? terminal-output session-marker))) 4000)

+121

(when terminal-error (error "remote PTY failed" terminal-error))

+122

(session-write handle "carrier-input\n")

+123

(pump-until "PTY input crosses the selected carrier"

+124

(lambda () (string-contains? terminal-output "input:carrier-input")) 4000)

+125

(session-resize handle 101 33)

+126

(session-write handle "size-probe\n")

+127

(pump-until "PTY resize crosses the selected carrier"

+128

(lambda () (string-contains? terminal-output "33 101")) 4000)

+129

(unless (session-detach handle)

+130

(error "provider refused session detach"))

+131

(unless (session-attach handle)

+132

(error "provider refused session reattach"))

+133

(session-write handle "reattached-input\n")

+134

(pump-until "reattached PTY uses a fresh ticket on the selected carrier"

+135

(lambda () (string-contains? terminal-output "input:reattached-input")) 4000)

+136

(assert-equal expected (enclave-node-carrier-transport target))

+137

(session-close handle))

+138

+139

;; The provider persists through the deferred 0x10 bulk lane. Subscribe

+140

;; first, then use that same write to prove the relay/direct watch event and

+141

;; finally unwatch through the returned provider thunk.

+142

(enclave-node-on-persist-error!

+143

(lambda (_path reason) (set! write-failure reason)))

+144

(enclave-node-on-transfer-progress!

+145

(lambda (progress)

+146

(set! transfer-progress (cons progress transfer-progress))))

+147

(let* ((write-source

+148

#{ provider: node: kind: file: host: target address: writable })

+149

(watch-source

+150

#{ provider: node: kind: dir: host: target

+151

address: (path-dirname writable) })

+152

(unsubscribe

+153

(source-subscribe watch-source

+154

(lambda (event) (set! watch-event event))))

+155

(written (string-append marker "-written-" (symbol->string expected)))

+156

(large-path (path-join (path-dirname writable) "large-transfer.bin"))

+157

(large-source

+158

#{ provider: node: kind: file: host: target address: large-path })

+159

;; 5 MiB plus a non-repeating tail. This is deliberately above the

+160

;; renderer's 3 MiB switch and the unary frame's 4 MiB ceiling, so a

+161

;; passing round trip necessarily exercised the credited multi-frame

+162

;; Resource lane.

+163

(large-value

+164

(string-append (string-repeat "0123456789abcdef" 327680)

+165

marker "-large-tail"))

+166

(dir-a (path-join (path-dirname writable) "mutation-a"))

+167

(dir-b (path-join (path-dirname writable) "mutation-b"))

+168

(dir-a-source

+169

#{ provider: node: kind: dir: host: target address: dir-a })

+170

(dir-b-source

+171

#{ provider: node: kind: dir: host: target address: dir-b }))

+172

(define (mutate label start)

+173

(set! mutation-result #f)

+174

(set! mutation-failure #f)

+175

(start (lambda (value) (set! mutation-result value))

+176

(lambda (reason) (set! mutation-failure reason)))

+177

(pump-until label

+178

(lambda () (or mutation-failure mutation-result)) 4000)

+179

(when mutation-failure (error label mutation-failure))

+180

(assert-equal expected (enclave-node-carrier-transport target)))

+181

(define (assert-directory-entry label name expected?)

+182

(set! listing-result #f)

+183

(set! mutation-failure #f)

+184

((provider-async-op watch-source) watch-source

+185

(lambda (value) (set! listing-result value))

+186

(lambda (reason) (set! mutation-failure reason)))

+187

(pump-until label

+188

(lambda () (or listing-result mutation-failure)) 4000)

+189

(when mutation-failure (error label mutation-failure))

+190

(assert-equal expected?

+191

(and (find (lambda (entry)

+192

(equal? (dict-ref entry name: #f) name))

+193

listing-result)

+194

#t)))

+195

(define (direction-progress direction)

+196

(reverse

+197

(filter (lambda (entry)

+198

(and (eq? (dict-ref entry direction: #f) direction)

+199

(equal? (dict-ref entry host: #f) target)))

+200

transfer-progress)))

+201

(define (assert-transfer-progress label direction expected-total)

+202

(let ((entries (direction-progress direction)))

+203

(unless (pair? entries)

+204

(error (string-append label ": no progress events")))

+205

(let loop ((xs entries) (previous 0))

+206

(when (pair? xs)

+207

(let* ((entry (car xs))

+208

(completed (dict-ref entry completed: -1))

+209

(total (dict-ref entry total: -1)))

+210

(unless (and (integer? completed) (>= completed previous)

+211

(<= completed expected-total)

+212

(= total expected-total))

+213

(error (string-append label ": invalid progress") entry))

+214

(loop (cdr xs) completed))))

+215

(let ((last (car (reverse entries))))

+216

(assert-equal 'complete (dict-ref last state: #f))

+217

(assert-equal expected-total (dict-ref last completed: -1))

+218

(unless (<= (dict-ref last peak-outstanding: 4294967295) 262144)

+219

(error (string-append label ": credit high-water exceeded") last))

+220

(unless (<= (dict-ref last peak-frame-bytes: 4294967295) 65536)

+221

(error (string-append label ": frame high-water exceeded") last)))))

+222

;; Wait for fs/watch's ok before causing the mutation.

+223

(pump-until "watch request settles"

+224

(lambda () (= (enclave-node-pending-count) 0)) 4000)

+225

;; Let the watcher establish its baseline before the mutation. The watch

+226

;; implementation is polling and intentionally does not report the

+227

;; directory's pre-existing contents as changes.

+228

(sleep 1.1)

+229

(source-persist write-source written)

+230

(pump-until "bulk write and watch event settle"

+231

(lambda () (or write-failure watch-event)) 4000)

+232

(when write-failure (error "remote bulk write failed" write-failure))

+233

(unless watch-event (error "remote watch produced no event"))

+234

(set! result #f)

+235

(set! failure #f)

+236

((provider-async-op write-source) write-source

+237

(lambda (value) (set! result value))

+238

(lambda (reason) (set! failure reason)))

+239

(pump-until "written file reads back" (lambda () (or result failure)) 4000)

+240

(when failure (error "remote written file read failed" failure))

+241

(unless (equal? result written)

+242

(error "remote bulk write returned wrong content" result))

+243

+244

;; Directory mutations use the same provider/correlation contract as the

+245

;; file operations. The platform watcher reports file changes, not

+246

;; directory inode creation, so verify each durable state with fs/stat.

+247

(mutate "remote mkdir settles"

+248

(lambda (ok err) (source-mkdir dir-a-source ok err)))

+249

(assert-directory-entry "created directory is visible" "mutation-a" #t)

+250

(mutate "remote rename settles"

+251

(lambda (ok err) (source-rename dir-a-source dir-b-source ok err)))

+252

(assert-directory-entry "renamed source is absent" "mutation-a" #f)

+253

(assert-directory-entry "renamed directory is visible" "mutation-b" #t)

+254

(mutate "remote delete settles"

+255

(lambda (ok err) (source-delete dir-b-source ok err)))

+256

(assert-directory-entry "deleted directory is absent" "mutation-b" #f)

+257

+258

;; Persist and read back above the unary ceiling over the same selected

+259

;; carrier. Exact equality verifies length, ordering, and every byte;

+260

;; progress verifies acknowledged completion rather than queued bytes.

+261

(set! transfer-progress '())

+262

(set! write-failure #f)

+263

(set! watch-event #f)

+264

(source-persist large-source large-value)

+265

(pump-until "large bulk write and watch event settle"

+266

(lambda () (or write-failure

+267

(and (= (enclave-node-pending-count) 0) watch-event))) 8000)

+268

(when write-failure (error "remote large bulk write failed" write-failure))

+269

(assert-equal 0 (enclave-node-transfer-count))

+270

(assert-transfer-progress "large upload" 'upload

+271

(string-length large-value))

+272

(set! transfer-progress '())

+273

(set! result #f)

+274

(set! failure #f)

+275

((provider-async-op large-source) large-source

+276

(lambda (value) (set! result value))

+277

(lambda (reason) (set! failure reason)))

+278

(pump-until "large file reads back" (lambda () (or result failure)) 8000)

+279

(when failure (error "remote large file read failed" failure))

+280

(unless (and (= (string-length result) (string-length large-value))

+281

(equal? result large-value))

+282

(error "remote large bulk round-trip mismatch"

+283

(string-length result) (string-length large-value)))

+284

(assert-equal 0 (enclave-node-transfer-count))

+285

(assert-transfer-progress "large download" 'download

+286

(string-length large-value))

+287

(assert-equal expected (enclave-node-carrier-transport target))

+288

+289

(unsubscribe)

+290

(pump-until "unwatch request settles"

+291

(lambda () (= (enclave-node-pending-count) 0)) 4000)

+292

;; Mutate after the unwatch acknowledgement and run longer than one watch

+293

;; poll interval. A late event would prove the listener survived unwatch.

+294

(set! watch-event #f)

+295

(set! write-failure #f)

+296

(source-persist write-source (string-append written "-after-unwatch"))

+297

(pump-until "post-unwatch write settles"

+298

(lambda () (or write-failure (= (enclave-node-pending-count) 0))) 4000)

+299

(when write-failure (error "post-unwatch write failed" write-failure))

+300

(pump-for 130)

+301

(when watch-event (error "watch emitted after explicit unwatch" watch-event)))

+302

+303

(set! running #f)

+304

;; Native irc-ws-receive parks until one frame arrives. Wake the account

+305

;; worker with a harmless request so it can observe RUNNING=#f and retire

+306

;; before with-async waits for its children.

+307

(account-session-send-command! "ENCLAVE-NODES")

+308

(sleep 0.01)

+309

(enclave-node-reset!)

+310

(node-disconnect!)

+311

(account-session-close!)))

packages/slate/test/node-direct-reattach-driver-test.mjsadded

@@ -0,0 +1,30 @@

+1

import assert from 'node:assert/strict';

+2

import fs from 'node:fs';

+3

+4

const main = fs.readFileSync(

+5

new URL('../src/slate/main.sgl', import.meta.url), 'utf8');

+6

+7

const start = main.indexOf('(define (slate-node-tick . rest)');

+8

const end = main.indexOf('(define (slate-node-active?)', start);

+9

assert.notEqual(start, -1, 'slate-node-tick must exist');

+10

assert.notEqual(end, -1, 'slate-node-tick boundary must exist');

+11

const tick = main.slice(start, end);

+12

+13

assert.match(

+14

tick,

+15

  /\(when \(and \(number\? epoch\)[\s\S]*?\(not \(or \(enclave-active\?\) \(account-session-active\?\)\)\)\)[\s\S]*?\(enclave-node-tick! epoch\)\)/,

+16

'the local-node metronome must drive remote-session recovery when the Enclave metronome is inactive',

+17

);

+18

+19

assert.ok(

+20

tick.indexOf('(node-poll!)') < tick.indexOf('(enclave-node-tick! epoch)'),

+21

'the replacement loopback generation must be polled before issuing a direct reattach',

+22

);

+23

+24

assert.match(

+25

tick,

+26

/$when \(terminal-take-visual-damage!$ $slate-refresh$\)/,

+27

'an asynchronous attach acknowledgement must repaint the terminal ribbon and dimmer',

+28

);

+29

+30

console.log('ok - direct-only retained terminals recover and repaint');

packages/slate/test/node-multi-root-live.sgladded

@@ -0,0 +1,122 @@

+1

;;; Two independently enrolled roots over concurrent direct and relay carriers.

+2

;;; Orchestrated only by scripts/test-node-direct-live.

+3

(import (sigil core) (sigil async) (sigil io) (sigil math) (sigil process) (sigil string)

+4

(sigil test) (sigil time)

+5

(slate enclave-account session) (slate provider)

+6

(slate providers enclave-node) (slate providers node))

+7

+8

(define endpoint (getenv "NODE_DIRECT_ENCLAVE_WS"))

+9

(define account (getenv "NODE_DIRECT_ACCOUNT"))

+10

(define credential (getenv "NODE_DIRECT_CREDENTIAL"))

+11

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+12

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+13

(define target-a (getenv "NODE_MULTI_ROOT_A"))

+14

(define target-b (getenv "NODE_MULTI_ROOT_B"))

+15

(define marker (getenv "NODE_DIRECT_MARKER"))

+16

+17

(test "concurrent mixed-transport roots keep independent PTYs"

+18

(with-async

+19

(define account-ready #f)

+20

(define account-failure #f)

+21

(define output-a "")

+22

(define output-b "")

+23

(define lost-a 0)

+24

(define lost-b 0)

+25

(define errors-a '())

+26

(define errors-b '())

+27

(define running #t)

+28

+29

(enclave-node-reset!)

+30

(node-reset!)

+31

(enclave-node-register!)

+32

(node-set-token! companion-token)

+33

(node-connect! companion)

+34

(account-session-on-message! enclave-node-on-message!)

+35

(account-session-start-saved!

+36

#{ version: 1 url: endpoint nick: account credential: credential }

+37

(lambda () (set! account-ready #t))

+38

(lambda (reason) (set! account-failure reason)))

+39

(go

+40

(let loop ()

+41

(account-session-poll!)

+42

(when running (sleep 0.001) (loop))))

+43

+44

(define (pump-until label predicate limit)

+45

(let loop ((n 0))

+46

(enclave-node-tick! (exact (floor (* 1000 (current-second)))))

+47

(node-poll!)

+48

(enclave-node-poll!)

+49

(cond ((predicate) #t)

+50

((>= n limit)

+51

(error (string-append "multi-root live timeout: " label)

+52

account-failure output-a output-b lost-a lost-b

+53

errors-a errors-b (enclave-node-pending-count)

+54

(enclave-node-stream-count)))

+55

(else (sleep 0.01) (loop (+ n 1))))))

+56

+57

(pump-until "account and companion authenticate"

+58

(lambda () (and account-ready (node-ready?))) 4000)

+59

+60

(let* ((started-a (string-append marker "-a-started"))

+61

(started-b (string-append marker "-b-started"))

+62

(handle-a

+63

(source-session-open

+64

#{ provider: node: kind: pty: host: target-a

+65

argv: (list "sh" "-c"

+66

(string-append "printf '" started-a

+67

"\\n'; while read line; do printf 'a:%s\\n' \"$line\"; done"))

+68

cols: 80 rows: 24 }

+69

(lambda (event)

+70

(let ((bytes (dict-ref event bytes: #f)))

+71

(when bytes (set! output-a (string-append output-a bytes))))

+72

(when (dict-ref event disconnected: #f)

+73

(set! lost-a (+ lost-a 1)))

+74

(when (dict-ref event error: #f)

+75

(set! errors-a (cons (dict-ref event error: #f) errors-a))))

+76

#{ window: 4096 }))

+77

(handle-b

+78

(source-session-open

+79

#{ provider: node: kind: pty: host: target-b

+80

argv: (list "sh" "-c"

+81

(string-append "printf '" started-b

+82

"\\n'; while read line; do printf 'b:%s\\n' \"$line\"; done"))

+83

cols: 80 rows: 24 }

+84

(lambda (event)

+85

(let ((bytes (dict-ref event bytes: #f)))

+86

(when bytes (set! output-b (string-append output-b bytes))))

+87

(when (dict-ref event disconnected: #f)

+88

(set! lost-b (+ lost-b 1)))

+89

(when (dict-ref event error: #f)

+90

(set! errors-b (cons (dict-ref event error: #f) errors-b))))

+91

#{ window: 4096 })))

+92

(pump-until "both PTYs start"

+93

(lambda () (and (string-contains? output-a started-a)

+94

(string-contains? output-b started-b))) 8000)

+95

(assert-equal 'direct (enclave-node-carrier-transport target-a))

+96

(assert-equal 'relay (enclave-node-carrier-transport target-b))

+97

(assert-equal 2 (enclave-node-stream-count))

+98

(session-write handle-a "first\n")

+99

(session-write handle-b "first\n")

+100

(pump-until "both PTYs receive independently correlated input"

+101

(lambda () (and (string-contains? output-a "a:first")

+102

(string-contains? output-b "b:first"))) 4000)

+103

(session-close handle-a)

+104

(assert-equal 1 (enclave-node-stream-count))

+105

(session-write handle-b "after-a-close\n")

+106

(pump-until "root B survives root A close"

+107

(lambda () (string-contains? output-b "b:after-a-close")) 4000)

+108

(assert-equal 0 lost-a)

+109

(assert-equal 0 lost-b)

+110

(assert-equal '() errors-a)

+111

(assert-equal '() errors-b)

+112

(assert-equal 'relay (enclave-node-carrier-transport target-b))

+113

(assert-equal 0 (enclave-node-pending-count))

+114

(session-close handle-b)

+115

(assert-equal 0 (enclave-node-stream-count)))

+116

+117

(set! running #f)

+118

(account-session-send-command! "ENCLAVE-NODES")

+119

(sleep 0.01)

+120

(enclave-node-reset!)

+121

(node-disconnect!)

+122

(account-session-close!)))

packages/slate/test/node-network-transition-live.sgladded

@@ -0,0 +1,123 @@

+1

;;; Established direct carrier -> explicit durable relay reattach live gate.

+2

;;; Orchestrated only by scripts/test-node-direct-live.

+3

(import (sigil core) (sigil async) (sigil io) (sigil math) (sigil process) (sigil string)

+4

(sigil test) (sigil time)

+5

(slate enclave-account session)

+6

(slate provider)

+7

(slate providers enclave-node)

+8

(slate providers node))

+9

+10

(define endpoint (getenv "NODE_DIRECT_ENCLAVE_WS"))

+11

(define account (getenv "NODE_DIRECT_ACCOUNT"))

+12

(define credential (getenv "NODE_DIRECT_CREDENTIAL"))

+13

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+14

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+15

(define target (getenv "NODE_DIRECT_TARGET"))

+16

(define marker (getenv "NODE_DIRECT_MARKER"))

+17

(define kill-flag (getenv "NODE_DIRECT_KILL_FLAG"))

+18

(define sentinel (getenv "NODE_DIRECT_SESSION_SENTINEL"))

+19

+20

(test "a direct-to-relay transition preserves the durable PTY explicitly"

+21

(with-async

+22

(define account-ready #f)

+23

(define account-failure #f)

+24

(define output "")

+25

(define terminal-error #f)

+26

(define lost 0)

+27

(define reattached 0)

+28

(define reattach-transport #f)

+29

(define running #t)

+30

+31

(enclave-node-reset!)

+32

(node-reset!)

+33

(enclave-node-register!)

+34

(node-set-token! companion-token)

+35

(node-connect! companion)

+36

(account-session-on-message! enclave-node-on-message!)

+37

(account-session-start-saved!

+38

#{ version: 1 url: endpoint nick: account credential: credential }

+39

(lambda () (set! account-ready #t))

+40

(lambda (reason) (set! account-failure reason)))

+41

(go

+42

(let loop ()

+43

(account-session-poll!)

+44

(when running (sleep 0.001) (loop))))

+45

+46

(define (pump-until label predicate limit)

+47

(let loop ((n 0))

+48

;; Match (slate main)'s production metronome: the pump discovers the

+49

;; closed carrier, while the tick schedules and issues reattachment.

+50

(enclave-node-tick! (exact (floor (* 1000 (current-second)))))

+51

(node-poll!)

+52

(enclave-node-poll!)

+53

(cond ((predicate) #t)

+54

((>= n limit)

+55

(error (string-append "node loss live timeout: " label)

+56

account-failure terminal-error output lost reattached

+57

(enclave-node-reattach-count)))

+58

(else (sleep 0.01) (loop (+ n 1))))))

+59

+60

(pump-until "account and direct companion authenticate"

+61

(lambda () (and account-ready (node-ready?))) 4000)

+62

+63

(let* ((started (string-append marker "-started"))

+64

(buffered (string-append marker "-buffered-during-loss"))

+65

(handle

+66

(source-session-open

+67

#{ provider: node: kind: pty: host: target

+68

argv: (list "sh" "-c"

+69

(string-append

+70

"if [ -e '" sentinel

+71

"' ]; then printf 'REPLACEMENT-PTY\\n'; exit 9; fi; : > '"

+72

sentinel "'; printf '" started

+73

"\\n'; (sleep 14; printf '" buffered

+74

"\\n') & while read line; do printf 'after:%s\\n' \"$line\"; done"))

+75

cols: 80 rows: 24 }

+76

(lambda (event)

+77

(let ((bytes (dict-ref event bytes: #f)))

+78

(when bytes (set! output (string-append output bytes))))

+79

(when (dict-ref event disconnected: #f)

+80

(set! lost (+ lost 1)))

+81

(when (dict-ref event reattached: #f)

+82

(set! reattached (+ reattached 1))

+83

(set! reattach-transport

+84

(dict-ref event transport: #f)))

+85

(when (dict-ref event error: #f)

+86

(set! terminal-error (dict-ref event error: #f))))

+87

#{ window: 4096 })))

+88

(pump-until "direct PTY starts"

+89

(lambda () (string-contains? output started)) 4000)

+90

(assert-equal 'direct (enclave-node-carrier-transport target))

+91

(call-with-output-file kill-flag (lambda (port) (display "kill\n" port)))

+92

(pump-until "direct carrier loss reaches the session"

+93

(lambda () (> lost 0)) 6000)

+94

(assert-equal 1 lost)

+95

(pump-until "the durable session reattaches"

+96

(lambda () (> reattached 0)) 5000)

+97

(assert-equal 1 reattached)

+98

(assert-equal 'relay reattach-transport)

+99

(assert-equal 'relay (enclave-node-carrier-transport target))

+100

(assert-equal 1 (enclave-node-stream-count))

+101

(when terminal-error

+102

(error "transport transition terminated the durable PTY" terminal-error))

+103

(pump-until "output buffered during loss is replayed"

+104

(lambda () (string-contains? output buffered)) 4000)

+105

(when (string-contains? output "REPLACEMENT-PTY")

+106

(error "reattach opened a replacement PTY"))

+107

(session-write handle "relay-restored\n")

+108

(pump-until "input reaches the original PTY after relay reattach"

+109

(lambda () (string-contains? output "after:relay-restored")) 4000)

+110

(assert-equal 1 lost)

+111

(assert-equal 1 reattached)

+112

(assert-equal 0 (enclave-node-reattach-count))

+113

(assert-equal 0 (enclave-node-pending-count))

+114

(when terminal-error

+115

(error "transport transition terminated the durable PTY" terminal-error))

+116

(session-close handle)

+117

(assert-equal 0 (enclave-node-stream-count)))

+118

+119

(set! running #f)

+120

(account-session-send-command! "ENCLAVE-NODES")

+121

(sleep 0.01)

+122

(enclave-node-reset!)

+123

(account-session-close!)))

packages/slate/test/node-paired-offline-invalidate-live.sgladded

@@ -0,0 +1,88 @@

+1

;;; Active paired-carrier invalidation gate. Orchestrated by

+2

;;; scripts/test-node-direct-live while Enclave is stopped.

+3

(import (sigil core) (sigil async) (sigil io) (sigil process) (sigil string)

+4

(sigil test) (sigil time)

+5

(slate provider) (slate providers enclave-node) (slate providers node))

+6

+7

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+8

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+9

(define target (getenv "NODE_DIRECT_TARGET"))

+10

(define writable (getenv "NODE_DIRECT_WRITABLE"))

+11

(define marker (getenv "NODE_DIRECT_MARKER"))

+12

(define armed-flag (getenv "NODE_PAIRING_INVALIDATE_FLAG"))

+13

+14

(test "live pairing invalidation closes active work exactly once"

+15

(with-async

+16

(define output "")

+17

(define session-error #f)

+18

(define lost 0)

+19

(define persist-failure #f)

+20

(define progress '())

+21

+22

(enclave-node-reset!)

+23

(node-reset!)

+24

(enclave-node-register!)

+25

(node-set-token! companion-token)

+26

(node-connect! companion)

+27

+28

(define (pump-until label predicate limit)

+29

(let loop ((n 0))

+30

(node-poll!)

+31

(enclave-node-poll!)

+32

(cond ((predicate) #t)

+33

((>= n limit)

+34

(error (string-append "paired invalidation timeout: " label)

+35

persist-failure session-error lost

+36

(enclave-node-transfer-count)

+37

(enclave-node-carrier-transport target)))

+38

(else (sleep 0.01) (loop (+ n 1))))))

+39

+40

(enclave-node-on-persist-error!

+41

(lambda (_path reason) (set! persist-failure reason)))

+42

(enclave-node-on-transfer-progress!

+43

(lambda (entry) (set! progress (cons entry progress))))

+44

(pump-until "local companion authenticates" node-ready? 4000)

+45

+46

(let* ((started (string-append marker "-invalidate-started"))

+47

(handle

+48

(source-session-open

+49

#{ provider: node: kind: pty: host: target

+50

argv: (list "sh" "-c"

+51

(string-append "printf '" started

+52

"\\n'; while read line; do printf 'live:%s\\n' \"$line\"; done"))

+53

cols: 80 rows: 24 }

+54

(lambda (event)

+55

(let ((bytes (dict-ref event bytes: #f)))

+56

(when bytes (set! output (string-append output bytes))))

+57

(when (dict-ref event disconnected: #f)

+58

(set! lost (+ lost 1)))

+59

(when (dict-ref event error: #f)

+60

(set! session-error (dict-ref event error: #f))))

+61

#{ window: 4096 }))

+62

(source #{ provider: node: kind: file: host: target address: writable })

+63

(payload (string-repeat "paired-invalidation" 350000)))

+64

(pump-until "paired PTY starts"

+65

(lambda () (string-contains? output started)) 4000)

+66

(assert-equal 'direct (enclave-node-carrier-transport target))

+67

(source-persist source payload)

+68

(pump-until "upload crosses at least one frame"

+69

(lambda ()

+70

(find (lambda (entry)

+71

(and (eq? (dict-ref entry state: #f) 'active)

+72

(> (dict-ref entry completed: 0) 0)))

+73

progress)) 4000)

+74

(call-with-output-file armed-flag

+75

(lambda (port) (display "invalidate\n" port)))

+76

(pump-until "active paired work is invalidated"

+77

(lambda () (and persist-failure (> lost 0))) 4000)

+78

(assert-equal 1 lost)

+79

(assert-equal 0 (enclave-node-transfer-count))

+80

(assert-equal 1

+81

(length (filter (lambda (entry)

+82

(eq? (dict-ref entry state: #f) 'failed))

+83

progress)))

+84

(assert-false (enclave-node-carrier-transport target))

+85

(session-close handle))

+86

+87

(enclave-node-reset!)

+88

(node-disconnect!)))

packages/slate/test/node-paired-offline-live.sgladded

@@ -0,0 +1,112 @@

+1

;;; Hub-down paired-auth gate. Orchestrated by scripts/test-node-direct-live.

+2

(import (sigil core) (sigil async) (sigil path) (sigil process) (sigil string)

+3

(sigil test) (sigil time)

+4

(slate provider) (slate providers enclave-node) (slate providers node))

+5

+6

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+7

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+8

(define target (getenv "NODE_DIRECT_TARGET"))

+9

(define path (getenv "NODE_DIRECT_READABLE"))

+10

(define writable (getenv "NODE_DIRECT_WRITABLE"))

+11

(define marker (getenv "NODE_DIRECT_MARKER"))

+12

+13

(test "restarted companions use cached pairing with the hub down"

+14

(with-async

+15

(define result #f)

+16

(define failure #f)

+17

(define output "")

+18

(define session-error #f)

+19

(define transfer-error #f)

+20

(define transfer-progress '())

+21

+22

(enclave-node-reset!)

+23

(node-reset!)

+24

(enclave-node-register!)

+25

(node-set-token! companion-token)

+26

(node-connect! companion)

+27

+28

(define (pump-until label predicate limit)

+29

(let loop ((n 0))

+30

(node-poll!)

+31

(enclave-node-poll!)

+32

(cond ((predicate) #t)

+33

((>= n limit)

+34

(error (string-append "paired offline timeout: " label)

+35

failure session-error output (node-phase)))

+36

(else (sleep 0.01) (loop (+ n 1))))))

+37

+38

(pump-until "local companion authenticates" node-ready? 4000)

+39

(let* ((source #{ provider: node: kind: file: host: target address: path })

+40

(op (provider-async-op source)))

+41

(op source (lambda (value) (set! result value))

+42

(lambda (reason) (set! failure reason))))

+43

(pump-until "paired resource request settles"

+44

(lambda () (or result failure)) 4000)

+45

(when failure (error "paired offline resource failed" failure))

+46

(let ((text (if (bytevector? result) (utf8->string result) result)))

+47

(unless (and (string? text) (string-contains? text marker))

+48

(error "paired offline resource returned wrong content" result)))

+49

(assert-equal 'direct (enclave-node-carrier-transport target))

+50

+51

(enclave-node-on-persist-error!

+52

(lambda (_path reason) (set! transfer-error reason)))

+53

(enclave-node-on-transfer-progress!

+54

(lambda (entry) (set! transfer-progress (cons entry transfer-progress))))

+55

(let* ((session-marker (string-append marker "-offline-session"))

+56

(large-path (path-join (path-dirname writable) "paired-large.bin"))

+57

(large-source

+58

#{ provider: node: kind: file: host: target address: large-path })

+59

(large-value

+60

(string-append (string-repeat "0123456789abcdef" 327680)

+61

marker "-paired-tail"))

+62

(handle

+63

(source-session-open

+64

#{ provider: node: kind: pty: host: target

+65

argv: (list "sh" "-c"

+66

(string-append "printf '" session-marker

+67

"\\n'; while read line; do printf 'offline:%s\\n' \"$line\"; done"))

+68

cols: 80 rows: 24 }

+69

(lambda (event)

+70

(let ((bytes (dict-ref event bytes: #f)))

+71

(when bytes (set! output (string-append output bytes))))

+72

(when (dict-ref event error: #f)

+73

(set! session-error (dict-ref event error: #f))))

+74

#{ window: 4096 })))

+75

;; Keep a PTY opening while a transfer above both the 3 MiB streaming

+76

;; threshold and 4 MiB unary ceiling is active. This is the release gate

+77

;; for correlation and flow-control isolation on a cached paired carrier.

+78

(source-persist large-source large-value)

+79

(pump-until "paired session and concurrent upload complete"

+80

(lambda ()

+81

(or session-error transfer-error

+82

(and (string-contains? output session-marker)

+83

(= (enclave-node-pending-count) 0)))) 8000)

+84

(when session-error (error "paired offline session failed" session-error))

+85

(when transfer-error (error "paired offline upload failed" transfer-error))

+86

(assert-equal 0 (enclave-node-transfer-count))

+87

(set! result #f)

+88

(set! failure #f)

+89

((provider-async-op large-source) large-source

+90

(lambda (value) (set! result value))

+91

(lambda (reason) (set! failure reason)))

+92

(pump-until "paired large download completes"

+93

(lambda () (or result failure)) 8000)

+94

(when failure (error "paired offline download failed" failure))

+95

(assert-equal large-value result)

+96

(assert-equal 0 (enclave-node-transfer-count))

+97

(for-each

+98

(lambda (entry)

+99

(unless (and (<= (dict-ref entry peak-outstanding: 4294967295) 262144)

+100

(<= (dict-ref entry peak-frame-bytes: 4294967295) 65536))

+101

(error "paired transfer exceeded its flow-control bounds" entry)))

+102

transfer-progress)

+103

(unless (session-detach handle) (error "offline detach refused"))

+104

(unless (session-attach handle) (error "offline attach refused"))

+105

(session-write handle "reattached\n")

+106

(pump-until "paired session reattaches"

+107

(lambda () (string-contains? output "offline:reattached")) 4000)

+108

(assert-equal 'direct (enclave-node-carrier-transport target))

+109

(session-close handle))

+110

+111

(enclave-node-reset!)

+112

(node-disconnect!)))

packages/slate/test/node-paired-offline-multi-root-live.sgladded

@@ -0,0 +1,70 @@

+1

;;; Two cached pairings used concurrently with Enclave stopped.

+2

(import (sigil core) (sigil async) (sigil process) (sigil string)

+3

(sigil test) (sigil time)

+4

(slate provider) (slate providers enclave-node) (slate providers node))

+5

+6

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+7

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+8

(define target-a (getenv "NODE_MULTI_ROOT_A"))

+9

(define target-b (getenv "NODE_MULTI_ROOT_B"))

+10

(define marker (getenv "NODE_DIRECT_MARKER"))

+11

+12

(test "two hub-down paired roots keep independent sessions"

+13

(with-async

+14

(define output-a "") (define output-b "")

+15

(define lost-a 0) (define lost-b 0)

+16

(define error-a #f) (define error-b #f)

+17

(enclave-node-reset!) (node-reset!) (enclave-node-register!)

+18

(node-set-token! companion-token) (node-connect! companion)

+19

(define (pump-until label predicate limit)

+20

(let loop ((n 0))

+21

(node-poll!) (enclave-node-poll!)

+22

(cond ((predicate) #t)

+23

((>= n limit) (error (string-append "paired multi-root timeout: " label)))

+24

(else (sleep 0.01) (loop (+ n 1))))))

+25

(pump-until "local companion authenticates" node-ready? 4000)

+26

(let* ((started-a (string-append marker "-paired-a"))

+27

(started-b (string-append marker "-paired-b"))

+28

(open

+29

(lambda (target prefix started set-output set-lost set-error)

+30

(source-session-open

+31

#{ provider: node: kind: pty: host: target

+32

argv: (list "sh" "-c"

+33

(string-append "printf '" started

+34

"\\n'; while read line; do printf '" prefix ":%s\\n' \"$line\"; done"))

+35

cols: 80 rows: 24 }

+36

(lambda (event)

+37

(let ((bytes (dict-ref event bytes: #f)))

+38

(when bytes (set-output bytes)))

+39

(when (dict-ref event disconnected: #f) (set-lost))

+40

(when (dict-ref event error: #f)

+41

(set-error (dict-ref event error: #f))))

+42

#{ window: 4096 })))

+43

(a (open target-a "a" started-a

+44

(lambda (x) (set! output-a (string-append output-a x)))

+45

(lambda () (set! lost-a (+ lost-a 1)))

+46

(lambda (x) (set! error-a x))))

+47

(b (open target-b "b" started-b

+48

(lambda (x) (set! output-b (string-append output-b x)))

+49

(lambda () (set! lost-b (+ lost-b 1)))

+50

(lambda (x) (set! error-b x)))))

+51

(pump-until "both paired PTYs start"

+52

(lambda () (or error-a error-b

+53

(and (string-contains? output-a started-a)

+54

(string-contains? output-b started-b)))) 8000)

+55

(when error-a (error "paired root A failed" error-a))

+56

(when error-b (error "paired root B failed" error-b))

+57

(assert-equal 'direct (enclave-node-carrier-transport target-a))

+58

(assert-equal 'direct (enclave-node-carrier-transport target-b))

+59

(session-write a "first\n") (session-write b "first\n")

+60

(pump-until "both paired roots exchange input"

+61

(lambda () (and (string-contains? output-a "a:first")

+62

(string-contains? output-b "b:first"))) 4000)

+63

(session-close a)

+64

(session-write b "after-a-close\n")

+65

(pump-until "root B survives root A close"

+66

(lambda () (string-contains? output-b "b:after-a-close")) 4000)

+67

(assert-equal 0 lost-a) (assert-equal 0 lost-b)

+68

(assert-equal 'direct (enclave-node-carrier-transport target-b))

+69

(session-close b))

+70

(enclave-node-reset!) (node-disconnect!)))

packages/slate/test/node-paired-offline-reject-live.sgladded

@@ -0,0 +1,39 @@

+1

;;; A paired-auth sabotage must never expose a usable carrier.

+2

(import (sigil core) (sigil async) (sigil process) (sigil test) (sigil time)

+3

(slate provider) (slate providers enclave-node) (slate providers node))

+4

+5

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+6

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+7

(define target (getenv "NODE_DIRECT_TARGET"))

+8

(define path (getenv "NODE_DIRECT_READABLE"))

+9

+10

(test "mutated paired authentication fails closed with the hub down"

+11

(with-async

+12

(define result #f)

+13

(define failure #f)

+14

(enclave-node-reset!)

+15

(node-reset!)

+16

(enclave-node-register!)

+17

(node-set-token! companion-token)

+18

(node-connect! companion)

+19

(let ready ((n 0))

+20

(node-poll!)

+21

(enclave-node-poll!)

+22

(cond ((node-ready?) #t)

+23

((>= n 4000) (error "paired rejection: companion unavailable"))

+24

(else (sleep 0.01) (ready (+ n 1)))))

+25

(let* ((source #{ provider: node: kind: file: host: target address: path })

+26

(op (provider-async-op source)))

+27

(op source (lambda (value) (set! result value))

+28

(lambda (reason) (set! failure reason))))

+29

(let settle ((n 0))

+30

(node-poll!)

+31

(enclave-node-poll!)

+32

(cond ((or result failure) #t)

+33

((>= n 4000) (error "paired rejection did not settle"))

+34

(else (sleep 0.01) (settle (+ n 1)))))

+35

(assert-false result)

+36

(assert-true failure)

+37

(assert-false (enclave-node-carrier-transport target))

+38

(enclave-node-reset!)

+39

(node-disconnect!)))

packages/slate/test/node-pairing-seed-live.sgladded

@@ -0,0 +1,50 @@

+1

;;; Minimal broker-authenticated direct encounter used to seed durable pairing.

+2

(import (sigil core) (sigil async) (sigil process) (sigil string)

+3

(sigil test) (sigil time)

+4

(slate enclave-account session) (slate provider)

+5

(slate providers enclave-node) (slate providers node))

+6

+7

(define endpoint (getenv "NODE_DIRECT_ENCLAVE_WS"))

+8

(define account (getenv "NODE_DIRECT_ACCOUNT"))

+9

(define credential (getenv "NODE_DIRECT_CREDENTIAL"))

+10

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+11

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+12

(define target (getenv "NODE_DIRECT_TARGET"))

+13

(define path (getenv "NODE_DIRECT_READABLE"))

+14

(define marker (getenv "NODE_DIRECT_MARKER"))

+15

+16

(test "a broker-authenticated direct encounter persists pairing"

+17

(with-async

+18

(define account-ready #f) (define account-failure #f)

+19

(define result #f) (define failure #f) (define running #t)

+20

(enclave-node-reset!) (node-reset!) (enclave-node-register!)

+21

(node-set-token! companion-token) (node-connect! companion)

+22

(account-session-on-message! enclave-node-on-message!)

+23

(account-session-start-saved!

+24

#{ version: 1 url: endpoint nick: account credential: credential }

+25

(lambda () (set! account-ready #t))

+26

(lambda (reason) (set! account-failure reason)))

+27

(go (let loop ()

+28

(account-session-poll!)

+29

(when running (sleep 0.001) (loop))))

+30

(define (pump-until label predicate limit)

+31

(let loop ((n 0))

+32

(node-poll!) (enclave-node-poll!)

+33

(cond ((predicate) #t)

+34

((>= n limit) (error (string-append "pairing seed timeout: " label)))

+35

(else (sleep 0.01) (loop (+ n 1))))))

+36

(pump-until "account and companion authenticate"

+37

(lambda () (and account-ready (node-ready?))) 4000)

+38

(let* ((source #{ provider: node: kind: file: host: target address: path })

+39

(op (provider-async-op source)))

+40

(op source (lambda (value) (set! result value))

+41

(lambda (reason) (set! failure reason))))

+42

(pump-until "direct request settles" (lambda () (or result failure)) 4000)

+43

(when failure (error "pairing seed request failed" failure account-failure))

+44

(unless (string-contains? (if (bytevector? result) (utf8->string result) result)

+45

marker)

+46

(error "pairing seed returned wrong content"))

+47

(assert-equal 'direct (enclave-node-carrier-transport target))

+48

(set! running #f)

+49

(account-session-send-command! "ENCLAVE-NODES") (sleep 0.01)

+50

(enclave-node-reset!) (node-disconnect!) (account-session-close!)))

packages/slate/test/node-provider-test.sglmodified

@@ -235,6 +235,17 @@

235

;; Resource plane — dired + file reads over bulk frames

236

;; ============================================================

237

+238

(test "node home discovery uses the resource plane and returns an absolute home"

+239

(bring-ready!)

+240

(node-clear-sent!)

+241

(let ((out (make-vector 1 #f)))

+242

(node-fetch-home! (lambda (home) (vector-set! out 0 home)))

+243

(let ((req (find-req "fs/home")))

+244

(assert-true (dict? req))

+245

(assert-false (find-req "proc/run"))

+246

(deliver-ok! (dict-ref req id: 0) #{ path: "/data/data/com.termux/files/home" }))

+247

(assert-equal "/data/data/com.termux/files/home" (vector-ref out 0))))

+248

249

(test "materialize-async dir sends fs/read-dir, bulk reply → folder entries"

250

(bring-ready!)

251

(node-clear-sent!)

@@ -257,7 +268,7 @@

268

(assert-eq (dict-ref (cadr entries) kind: #f) dir:)

269

(assert-equal (dict-ref (car entries) size: #f) 5))))

270

−260

(test "materialize-async file: bulk bytevector → decoded string"

+271

(test "materialize-async file: credited chunks complete only at transfer end"

272

(bring-ready!)

273

(node-clear-sent!)

274

(let ((out (make-vector 1 #f))

@@ -266,8 +277,18 @@

277

(lambda (c) (vector-set! out 0 c)) (lambda (e) #f))

278

(let ((req (find-req "fs/read-file")))

279

(assert-true (dict? req))

−269

;; read-file bulk payload is a wire-encoded bytevector

−270

(deliver-bulk! (dict-ref req id: 0) (string->utf8 "hello file\n")))

+280

(let ((id (dict-ref req id: 0)))

+281

(node-deliver-text!

+282

(json-encode

+283

#{ t: "ok" id: id

+284

transfer: #{ direction: "download" size: 11 chunk-bytes: 65536 } }))

+285

(node-deliver-binary!

+286

(frame-encode #x20 id (bytevector 0 0 0 0 104 101 108 108 111 32)))

+287

(node-deliver-binary!

+288

(frame-encode #x20 id (bytevector 0 0 0 1 102 105 108 101 10)))

+289

(assert-false (vector-ref out 0))

+290

(node-deliver-binary!

+291

(frame-encode #x21 id (bytevector 0 0 0 2 0 0 0 11)))))

292

(assert-equal (vector-ref out 0) "hello file\n")))

293

294

(test "stat-async: present path → kind; missing → #f"

packages/slate/test/node-registry-cache-test.sgladded

@@ -0,0 +1,20 @@

+1

(import (sigil core) (sigil test)

+2

(slate providers enclave-node))

+3

+4

(test-group "node registry cache codec"

+5

(test "round-trips the secret-free discovery fields"

+6

(let* ((entries

+7

(list #{ label: "zerocool" nick: "opaque-1" home: "/home/dw"

+8

online: #t }))

+9

(decoded (registry-cache<-json (registry-cache->json entries))))

+10

(assert-equal 1 (length decoded))

+11

(assert-equal "zerocool" (dict-ref (car decoded) label: #f))

+12

(assert-equal "opaque-1" (dict-ref (car decoded) nick: #f))

+13

(assert-equal "/home/dw" (dict-ref (car decoded) home: #f))))

+14

+15

(test "corrupt, wrong-version and malformed entries fail closed"

+16

(assert-equal '() (registry-cache<-json "not-json"))

+17

(assert-equal '() (registry-cache<-json "{\"version\":2,\"entries\":[]}"))

+18

(assert-equal '()

+19

(registry-cache<-json

+20

"{\"version\":1,\"entries\":[{\"label\":\"missing-nick\"}]}"))))

packages/slate/test/node-status-view-test.sgladded

@@ -0,0 +1,130 @@

+1

(import (sigil core) (sigil string) (sigil test) (slate command)

+2

(slate commands navigation) (slate modes node-status)

+3

(slate pane) (slate space) (slate state) (slate view))

+4

+5

(define (rendered-text value)

+6

(call-with-output-string (lambda (port) (write value port))))

+7

+8

(test "node status command opens the common local-node view"

+9

(let* ((plain (view slate/name: "plain"))

+10

(state #{ slate/views: (list plain)

+11

slate/spaces: (list (make-space "main" (make-leaf 0 "plain") 0 1))

+12

slate/active-space: "main" })

+13

(shown (command-run state "node-status")))

+14

(assert-true (node-status? (active-view shown)))

+15

(assert-equal node-status-view-name (view-name (active-view shown)))))

+16

+17

(test "desktop and Termux status use the same renderer contract"

+18

(for-each

+19

(lambda (fixture)

+20

(let ((out (rendered-text (view-render (node-status-ready (make-node-status-view) fixture)))))

+21

(assert-true (string-contains? out "Reachable"))

+22

(assert-true (string-contains? out "Current connection"))

+23

(assert-true (string-contains? out "Supervisor"))

+24

(assert-true (string-contains? out "Schema"))))

+25

(list

+26

#{ schema-version: 3 platform: #{ kind: "desktop" environment: "native" }

+27

identity: #{ role: "local-node" scope: "local-device" }

+28

capability-posture:

+29

#{ resource: #{ available: #t } session: #{ available: #t }

+30

agent: #{ available: #t } renderer: #{ available: #t }

+31

remote-transport-manager: #{ available: #f reason: "not-implemented" } }

+32

installation: #{ posture: "not-installed" }

+33

supervision: #{ kind: "none" running: #f }

+34

process: #{ pid: 42 live: #t pid-state: "exact" }

+35

listener: #{ healthy: #t url: "http://127.0.0.1:32640/node/health" }

+36

lifecycle: #{ state: "missing" restart-count: 0 }

+37

autostart: #{ posture: "not-configured" }

+38

upgrade: #{ current-version: "0.1.0" state: "not-checked"

+39

check: #{ endpoint: "/node/api/version" }

+40

apply: #{ available: #f reason: "not-implemented" }

+41

rollback: #{ available: #f reason: "not-implemented" }

+42

installation: #{ strategy: "package-managed" } }

+43

app: #{ selection: "production" url: "https://useslate.org" } }

+44

#{ schema-version: 3 platform: #{ kind: "android" environment: "termux" }

+45

identity: #{ role: "local-node" scope: "local-device" }

+46

capability-posture:

+47

#{ resource: #{ available: #t } session: #{ available: #t }

+48

agent: #{ available: #t } renderer: #{ available: #t }

+49

remote-transport-manager: #{ available: #f reason: "not-implemented" } }

+50

installation: #{ posture: "installed" }

+51

supervision: #{ kind: "runit" running: #t }

+52

process: #{ pid: 84 live: #t pid-state: "exact" }

+53

listener: #{ healthy: #t url: "http://127.0.0.1:32640/node/health" }

+54

lifecycle: #{ state: "valid" restart-count: 2 }

+55

autostart: #{ posture: "configured" }

+56

upgrade: #{ current-version: "0.1.0" state: "not-checked"

+57

check: #{ endpoint: "/node/api/version" }

+58

apply: #{ available: #f reason: "not-implemented" }

+59

rollback: #{ available: #f reason: "not-implemented" }

+60

installation: #{ strategy: "atomic-version-directory" } }

+61

app: #{ selection: "custom" url: "http://127.0.0.1:32641" } })))

+62

+63

(test "foreground connection is distinct from persistent installation"

+64

(let* ((fixture

+65

#{ schema-version: 1 platform: #{ kind: "android" environment: "termux" }

+66

installation: #{ posture: "not-installed" }

+67

supervision: #{ kind: "runit" running: #f }

+68

process: #{ pid: 32036 live: #t pid-state: "exact" }

+69

listener: #{ healthy: #t url: "http://127.0.0.1:32640/node/health" }

+70

lifecycle: #{ state: "missing" restart-count: 0 }

+71

autostart: #{ posture: "not-configured" }

+72

app: #{ selection: "production" url: "https://useslate.org" } })

+73

(view (node-status-ready (make-node-status-view) fixture #t

+74

"ws://127.0.0.1:32660/node/ws"))

+75

(out (rendered-text (view-render view))))

+76

(assert-true (string-contains? out "Connected"))

+77

(assert-true (string-contains? out "ws://127.0.0.1:32660/node/ws"))

+78

(assert-true (string-contains? out "Persistent installation"))

+79

(assert-true (string-contains? out "not-installed"))

+80

(assert-true (string-contains? out "http://127.0.0.1:32640/node/health"))))

+81

+82

(test "local-node role and unavailable remote manager are explicit"

+83

(let* ((fixture

+84

#{ schema-version: 2

+85

identity: #{ role: "local-node" scope: "local-device" }

+86

capability-posture:

+87

#{ resource: #{ available: #t } session: #{ available: #t }

+88

agent: #{ available: #t } renderer: #{ available: #t }

+89

remote-transport-manager:

+90

#{ available: #f reason: "not-implemented" } }

+91

listener: #{ healthy: #t } process: #{ live: #t } })

+92

(out (rendered-text

+93

(view-render (node-status-ready (make-node-status-view) fixture)))))

+94

(assert-true (string-contains? out "Role and capabilities"))

+95

(assert-true (string-contains? out "local-node"))

+96

(assert-true (string-contains? out "Remote transport manager"))

+97

(assert-true (string-contains? out "not-implemented"))

+98

(assert-true (string-contains? out "does not grant"))))

+99

+100

(test "upgrade posture is visible but mutation stays unavailable"

+101

(let* ((fixture

+102

#{ schema-version: 3

+103

listener: #{ healthy: #t } process: #{ live: #t }

+104

upgrade: #{ current-version: "0.1.0"

+105

available-version: "0.2.0"

+106

state: "upgrade-available"

+107

check: #{ endpoint: "/node/api/version" }

+108

apply: #{ available: #f reason: "not-implemented" }

+109

rollback: #{ available: #f reason: "not-implemented" }

+110

installation: #{ strategy: "package-managed" } } })

+111

(out (rendered-text

+112

(view-render (node-status-ready (make-node-status-view) fixture)))))

+113

(assert-true (string-contains? out "Node upgrade"))

+114

(assert-true (string-contains? out "0.2.0"))

+115

(assert-true (string-contains? out "package-managed"))

+116

(assert-true (string-contains? out "Upgrade checks are read-only"))))

+117

+118

(test "unavailable and corrupt states remain explicit"

+119

(let* ((failed (node-status-failed (make-node-status-view) "connection refused"))

+120

(failure-text (rendered-text (view-render failed)))

+121

(corrupt (node-status-ready (make-node-status-view)

+122

#{ schema-version: 1 platform: #{ kind: "desktop" environment: "native" }

+123

listener: #{ healthy: #f } process: #{ live: #f pid-state: "stale" }

+124

lifecycle: #{ state: "corrupt" restart-count: 7 } }))

+125

(corrupt-text (rendered-text (view-render corrupt))))

+126

(assert-true (string-contains? failure-text "connection refused"))

+127

(assert-true (string-contains? corrupt-text "corrupt"))

+128

(assert-true (string-contains? corrupt-text "Unavailable"))))

+129

+130

(test-summary)

packages/slate/test/node-target-restart-live.sgladded

@@ -0,0 +1,104 @@

+1

;;; Target restart -> definitive old-session retirement without replacement.

+2

;;; Orchestrated only by scripts/test-node-direct-live.

+3

(import (sigil core) (sigil async) (sigil io) (sigil math) (sigil process) (sigil string)

+4

(sigil test) (sigil time)

+5

(slate enclave-account session) (slate provider)

+6

(slate providers enclave-node) (slate providers node))

+7

+8

(define endpoint (getenv "NODE_DIRECT_ENCLAVE_WS"))

+9

(define account (getenv "NODE_DIRECT_ACCOUNT"))

+10

(define credential (getenv "NODE_DIRECT_CREDENTIAL"))

+11

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+12

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+13

(define target (getenv "NODE_DIRECT_TARGET"))

+14

(define marker (getenv "NODE_DIRECT_MARKER"))

+15

(define restart-flag (getenv "NODE_TARGET_RESTART_FLAG"))

+16

(define sentinel (getenv "NODE_DIRECT_SESSION_SENTINEL"))

+17

+18

(test "a target restart settles the old PTY without an implicit replacement"

+19

(with-async

+20

(define account-ready #f)

+21

(define account-failure #f)

+22

(define output "")

+23

(define terminal-error #f)

+24

(define lost 0)

+25

(define reattached 0)

+26

(define running #t)

+27

+28

(enclave-node-reset!)

+29

(node-reset!)

+30

(enclave-node-register!)

+31

(node-set-token! companion-token)

+32

(node-connect! companion)

+33

(account-session-on-message! enclave-node-on-message!)

+34

(account-session-start-saved!

+35

#{ version: 1 url: endpoint nick: account credential: credential }

+36

(lambda () (set! account-ready #t))

+37

(lambda (reason) (set! account-failure reason)))

+38

(go

+39

(let loop ()

+40

(account-session-poll!)

+41

(when running (sleep 0.001) (loop))))

+42

+43

(define (pump-until label predicate limit)

+44

(let loop ((n 0))

+45

(enclave-node-tick! (exact (floor (* 1000 (current-second)))))

+46

(node-poll!)

+47

(enclave-node-poll!)

+48

(cond ((predicate) #t)

+49

((>= n limit)

+50

(error (string-append "target restart timeout: " label)

+51

account-failure terminal-error output lost reattached

+52

(enclave-node-reattach-count)

+53

(enclave-node-reattach-debug)))

+54

(else (sleep 0.01) (loop (+ n 1))))))

+55

+56

(pump-until "account and companion authenticate"

+57

(lambda () (and account-ready (node-ready?))) 4000)

+58

+59

(let* ((started (string-append marker "-target-started"))

+60

(handle

+61

(source-session-open

+62

#{ provider: node: kind: pty: host: target

+63

argv: (list "sh" "-c"

+64

(string-append

+65

"if [ -e '" sentinel

+66

"' ]; then printf 'REPLACEMENT-PTY\\n'; exit 9; fi; : > '"

+67

sentinel "'; printf '" started

+68

"\\n'; while read line; do printf 'after:%s\\n' \"$line\"; done"))

+69

cols: 80 rows: 24 }

+70

(lambda (event)

+71

(let ((bytes (dict-ref event bytes: #f)))

+72

(when bytes (set! output (string-append output bytes))))

+73

(when (dict-ref event disconnected: #f)

+74

(set! lost (+ lost 1)))

+75

(when (dict-ref event reattached: #f)

+76

(set! reattached (+ reattached 1)))

+77

(when (dict-ref event error: #f)

+78

(set! terminal-error (dict-ref event error: #f))))

+79

#{ window: 4096 })))

+80

(pump-until "original PTY starts"

+81

(lambda () (string-contains? output started)) 4000)

+82

(assert-equal 'relay (enclave-node-carrier-transport target))

+83

(call-with-output-file restart-flag

+84

(lambda (port) (display "restart\n" port)))

+85

(pump-until "target carrier reports one loss"

+86

(lambda () (> lost 0)) 6000)

+87

(assert-equal 1 lost)

+88

(pump-until "restarted target definitively refuses the dead session"

+89

(lambda () terminal-error) 8000)

+90

(assert-true (string-contains? terminal-error "no-session"))

+91

(assert-equal 0 reattached)

+92

(assert-equal 0 (enclave-node-reattach-count))

+93

(when (string-contains? output "REPLACEMENT-PTY")

+94

(error "target restart opened an implicit replacement PTY"))

+95

(session-close handle))

+96

+97

(set! running #f)

+98

;; Native irc-ws-receive parks until one frame arrives. Wake the account

+99

;; worker so it can observe RUNNING=#f before with-async joins its children.

+100

(account-session-send-command! "ENCLAVE-NODES")

+101

(sleep 0.01)

+102

(enclave-node-reset!)

+103

(node-disconnect!)

+104

(account-session-close!)))

packages/slate/test/node-transfer-loss-live.sgladded

@@ -0,0 +1,137 @@

+1

;;; Multi-frame Resource interruption gate. Orchestrated by

+2

;;; scripts/test-node-direct-live with only the advertised direct carrier behind

+3

;;; slate-netem; Enclave control and relay remain healthy.

+4

(import (sigil core) (sigil async) (sigil io) (sigil path) (sigil process) (sigil string)

+5

(sigil test) (sigil time)

+6

(slate enclave-account session) (slate provider)

+7

(slate providers enclave-node) (slate providers node))

+8

+9

(define endpoint (getenv "NODE_DIRECT_ENCLAVE_WS"))

+10

(define account (getenv "NODE_DIRECT_ACCOUNT"))

+11

(define credential (getenv "NODE_DIRECT_CREDENTIAL"))

+12

(define companion (getenv "NODE_DIRECT_COMPANION_WS"))

+13

(define companion-token (getenv "NODE_DIRECT_COMPANION_TOKEN"))

+14

(define target (getenv "NODE_DIRECT_TARGET"))

+15

(define writable (getenv "NODE_DIRECT_WRITABLE"))

+16

(define recovery (getenv "NODE_DIRECT_RECOVERY"))

+17

(define direction (getenv "NODE_TRANSFER_DIRECTION"))

+18

(define expected

+19

(if (string=? (getenv "NODE_TRANSFER_EXPECT_TRANSPORT") "direct")

+20

'direct 'relay))

+21

(define payload-size (* 5 1024 1024))

+22

(define payload (string-repeat "x" payload-size))

+23

(define sentinel "atomic-sentinel")

+24

+25

(test "an interrupted multi-frame Resource transfer fails and cleans up"

+26

(with-async

+27

(define account-ready #f)

+28

(define account-failure #f)

+29

(define result #f)

+30

(define failure #f)

+31

(define persist-failure #f)

+32

(define progress '())

+33

(define running #t)

+34

+35

(enclave-node-reset!)

+36

(node-reset!)

+37

(enclave-node-register!)

+38

(node-set-token! companion-token)

+39

(node-connect! companion)

+40

(account-session-on-message! enclave-node-on-message!)

+41

(account-session-start-saved!

+42

#{ version: 1 url: endpoint nick: account credential: credential }

+43

(lambda () (set! account-ready #t))

+44

(lambda (reason) (set! account-failure reason)))

+45

(go

+46

(let loop ()

+47

(account-session-poll!)

+48

(when running (sleep 0.001) (loop))))

+49

+50

(define (pump-until label predicate limit)

+51

(let loop ((n 0))

+52

(node-poll!)

+53

(enclave-node-poll!)

+54

(cond ((predicate) #t)

+55

((>= n limit)

+56

(error (string-append "transfer loss timeout: " label)

+57

account-failure failure persist-failure

+58

(enclave-node-transfer-count) (node-phase)))

+59

(else (sleep 0.01) (loop (+ n 1))))))

+60

(define (failed-progress-count)

+61

(length (filter (lambda (entry)

+62

(eq? (dict-ref entry state: #f) 'failed))

+63

progress)))

+64

(define (active-progress?)

+65

(find (lambda (entry)

+66

(and (eq? (dict-ref entry state: #f) 'active)

+67

(> (dict-ref entry completed: 0) 0)

+68

(< (dict-ref entry completed: payload-size) payload-size)))

+69

progress))

+70

(define (assert-high-water)

+71

(for-each

+72

(lambda (entry)

+73

(unless (and (<= (dict-ref entry peak-outstanding: 4294967295) 262144)

+74

(<= (dict-ref entry peak-frame-bytes: 4294967295) 65536))

+75

(error "transfer exceeded its credit/frame high-water" entry)))

+76

progress))

+77

(define source

+78

#{ provider: node: kind: file: host: target address: writable })

+79

(define recovery-source

+80

#{ provider: node: kind: file: host: target address: recovery })

+81

+82

(enclave-node-on-persist-error!

+83

(lambda (_path reason) (set! persist-failure reason)))

+84

(enclave-node-on-transfer-progress!

+85

(lambda (entry) (set! progress (cons entry progress))))

+86

(pump-until "account and companion authenticate"

+87

(lambda () (and account-ready (node-ready?))) 4000)

+88

+89

(if (string=? direction "upload")

+90

(source-persist source payload)

+91

((provider-async-op source) source

+92

(lambda (value) (set! result value))

+93

(lambda (reason) (set! failure reason))))

+94

(pump-until "multiple transfer frames are acknowledged"

+95

active-progress? 4000)

+96

(assert-equal expected (enclave-node-carrier-transport target))

+97

(assert-equal 1 (enclave-node-transfer-count))

+98

+99

;; The scenario now cuts the only direct carrier. The in-flight operation

+100

;; must fail exactly once; it must not finish or migrate onto relay.

+101

(pump-until "the interrupted transfer fails"

+102

(lambda () (if (string=? direction "upload") persist-failure failure)) 4000)

+103

(assert-equal 0 (enclave-node-transfer-count))

+104

(assert-equal 1 (failed-progress-count))

+105

(assert-high-water)

+106

(when result (error "interrupted download completed"))

+107

+108

;; A fresh request may select relay. For upload, the destination must still

+109

;; contain its pre-transfer sentinel. For download, the complete seeded file

+110

;; must now arrive byte-for-byte through the newly selected carrier.

+111

;; Cutting the target's Enclave connection makes the relay target briefly

+112

;; unavailable. Allow the scenario to enter recovery before issuing a new

+113

;; request; direct-carrier cuts keep Enclave healthy and need no delay.

+114

(when (eq? expected 'relay)

+115

(let loop ((n 0))

+116

(when (< n 1200)

+117

(node-poll!) (enclave-node-poll!) (sleep 0.01) (loop (+ n 1)))))

+118

(set! result #f)

+119

(set! failure #f)

+120

(let ((fresh-source (if (string=? direction "upload") source recovery-source)))

+121

((provider-async-op fresh-source) fresh-source

+122

(lambda (value) (set! result value))

+123

(lambda (reason) (set! failure reason))))

+124

(pump-until "fresh relay read completes" (lambda () (or result failure)) 4000)

+125

(when failure (error "fresh relay read failed" failure))

+126

(if (string=? direction "upload")

+127

(assert-equal sentinel result)

+128

(assert-equal "relay-recovery" result))

+129

(assert-equal 'relay (enclave-node-carrier-transport target))

+130

(assert-equal 0 (enclave-node-transfer-count))

+131

+132

(set! running #f)

+133

(account-session-send-command! "ENCLAVE-NODES")

+134

(sleep 0.01)

+135

(enclave-node-reset!)

+136

(node-disconnect!)

+137

(account-session-close!)))

packages/slate/test/performance-capture-policy-test.mjsadded

@@ -0,0 +1,185 @@

+1

import assert from 'node:assert/strict';

+2

import fs from 'node:fs';

+3

+4

const html = fs.readFileSync(new URL('../assets/index.html', import.meta.url), 'utf8');

+5

const main = fs.readFileSync(new URL('../src/slate/main.sgl', import.meta.url), 'utf8');

+6

const help = fs.readFileSync(new URL('../src/slate/commands/help.sgl', import.meta.url), 'utf8');

+7

const enclaveNode = fs.readFileSync(new URL('../src/slate/providers/enclave-node.sgl', import.meta.url), 'utf8');

+8

const sessions = fs.readFileSync(new URL('../../slate-cli/src/slate-cli/sessions.sgl', import.meta.url), 'utf8');

+9

const wire = fs.readFileSync(new URL('../../slate-cli/src/slate-cli/wire.sgl', import.meta.url), 'utf8');

+10

+11

// Palette profiling is opt-in: the normal input path must not even read the

+12

// clock, while an active capture labels the synchronous model/render path.

+13

assert.match(html, /const measuring = window\.__slatePerfActive && window\.__slatePerfActive;/);

+14

assert.match(html, /const inputBegin = measuring \? performance\.now : 0;/);

+15

assert.match(html, /slateEvalRaw$'\(slate-selector-set[\s\S]*?'palette'$;/);

+16

assert.match(html, /slateEvalString\('\(slate-selector-set-profile/);

+17

+18

// Query edits take the selector-only host fast path regardless of whether a

+19

// capture is active; profiling merely decides whether timestamps are recorded.

+20

assert.match(html, /renderContext === 'palette-scheduled'/);

+21

assert.match(html, /syncSelector; animateSelectorEntrance; scrollSelectedIntoView;/);

+22

assert.match(html, /afterRender\(selectorOpen\(\) \? 'palette-scheduled' :\s*'scheduled-' \+ \(source \|\| 'unspecified'\)\);/);

+23

assert.match(html, /const perfDetail = renderContext && window\.__slatePerfActive/);

+24

+25

// The opaque WASM update is separated from the host post-render work, whose

+26

// useful groups expose whether selector/layout/service reconciliation dominates.

+27

for (const phase of [

+28

'wasm-eval-render-patch',

+29

'after-render-total',

+30

'after-render-fields',

+31

'after-render-view-bridges',

+32

'after-render-selector',

+33

'after-render-layout-focus',

+34

'after-render-services',

+35

'input-model-total',

+36

'terminal-node-tick',

+37

'terminal-enclave-tick',

+38

'terminal-registry-poll',

+39

'terminal-lantern-poll',

+40

'terminal-browserfs-poll',

+41

'terminal-frame-extract',

+42

'terminal-frame-parse',

+43

'terminal-dom-apply',

+44

'terminal-arm-to-frame',

+45

'terminal-dom-to-present',

+46

'terminal-output-paint',

+47

'terminal-key-to-wire-send',

+48

'terminal-wire-send-call',

+49

'terminal-remote-write',

+50

'terminal-remote-output',

+51

'terminal-wire-roundtrip',

+52

'terminal-key-to-wire-arrival',

+53

'terminal-receive-queue',

+54

'terminal-model-apply',

+55

'after-render-source',

+56

'after-render-schedule-source',

+57

'after-render-mutation-target',

+58

'terminal-arm-source',

+59

'terminal-invalidate-source',

+60

'terminal-flush-source',

+61

]) {

+62

assert.ok(html.includes(`'${phase}'`), `missing performance phase ${phase}`);

+63

}

+64

assert.match(html, /name\.endsWith$'-ms'$[\s\S]*?'palette-' \+ name/);

+65

assert.match(html, /'palette-candidate-count'/);

+66

assert.match(html, /'palette-visible-count'/);

+67

assert.match(main, /define $slate-selector-set-profile query$/);

+68

assert.match(main, /model-ms: $profile-ms t0 t1$/);

+69

assert.match(main, /candidates-ms: $profile-ms t1 t2$/);

+70

assert.match(main, /ranking-ms: $profile-ms t2 t3$/);

+71

assert.match(main, /sxml-ms: $profile-ms t3 t4$/);

+72

assert.match(main, /patch-ms: $profile-ms t4 t5$/);

+73

+74

// Full-session summaries and raw diagnostics have independent bounds, and the

+75

// serialized request has a final guard below the node's 16 KiB ceiling.

+76

assert.match(html, /const rawLimit = 96;/);

+77

assert.match(html, /const groupLimit = 512;/);

+78

assert.match(html, /if $samples\.length > rawLimit$ samples\.splice/);

+79

assert.match(html, /if $values\.length > groupLimit$ values\.splice/);

+80

assert.match(html, /new TextEncoder\.encode$body$\.length > 14000/);

+81

assert.match(html, /report\.raw_samples_omitted = true;/);

+82

assert.match(html, /terminalPaintRaf = requestAnimationFrame/,

+83

'terminal paint latency must end at an animation frame');

+84

assert.match(html, /eventType === 3 && window\.__slatePerfWebSocketArrival/,

+85

'binary WebSocket arrival must be measured before the coalesced WASM drain');

+86

assert.match(html, /latestKeyAt !== terminalWireTracedKeyAt && binaryPayload$data$/,

+87

'wire timing must select exactly the first synchronous binary send per terminal key');

+88

assert.match(html, /WebSocket\.prototype\.send = originalWebSocketSend/,

+89

'stopping a capture must remove the WebSocket probe');

+90

assert.doesNotMatch(html, /binaryPayload[\s\S]{0,700}(textContent|JSON\.stringify|decoder|bytes\[)/,

+91

'wire timing must not retain or decode typed terminal content');

+92

assert.match(html, /slate-performance-trace-set #t/,

+93

'starting a client capture must explicitly enable node markers');

+94

assert.match(html, /slate-performance-trace-set #f/,

+95

'saving a client capture must disable node markers');

+96

assert.match(wire, /define frame-trace-in\s+#x0a/);

+97

assert.match(wire, /define frame-trace-out\s+#x0b/);

+98

assert.match(sessions, /frame-trace-in[\s\S]*?trace-register!/,

+99

'the remote node must accept correlation markers separately from input');

+100

assert.match(sessions, /frame-trace-out[\s\S]*?trace-payload/,

+101

'the remote node must return timing separately from terminal output');

+102

assert.doesNotMatch(sessions, /trace-payload[\s\S]{0,500}(body|bytes)/,

+103

'returned trace metadata must not contain terminal payload bytes');

+104

+105

// The Enclave metronome follows the node tick's damage contract. An idle poll

+106

// must not run afterRender, because TERM.ensure would turn it into a full-grid

+107

// terminal invalidation every 150ms.

+108

assert.doesNotMatch(html, /enclaveTimer = setInterval$\($ => \{\s*slateEvalRaw/);

+109

assert.match(html, /slateEvalString\('\(slate-enclave-tick[\s\S]*?r === '2'\) afterRender\('enclave-tick'\);[\s\S]*?r === '1'\) TERM\.arm\('enclave-tick'\);/);

+110

assert.match(main, /define $slate-enclave-tick[\s\S]*?\(> \*refresh-count\* before$ "2"[\s\S]*?$drained\? "1"$/);

+111

assert.match(enclaveNode, /define $enclave-node-poll!$[\s\S]*?$if drained\? "1" ""$/);

+112

assert.doesNotMatch(html, /echoTimer\s*=|slate-echo-tick/,

+113

'echo dismissal must not poll the WASM runtime');

+114

assert.match(html, /addEventListener\('animationend'/);

+115

assert.match(html, /slate-echo-animation-done/);

+116

assert.match(main, /define $slate-echo-animation-done generation$/);

+117

assert.match(html, /classList\.contains$'echo-active'$\) el\.classList\.remove$'echo-active'$/,

+118

'idle echo sync must not rewrite the ledge class attribute');

+119

assert.match(html, /el\.style\.animationPlayState !== playState/,

+120

'echo sync must not rewrite an unchanged ledge style attribute');

+121

assert.match(html, /target\.closest && target\.closest$'\.term-content'$/,

+122

'terminal-owned row mutations must not schedule a full afterRender pass');

+123

assert.match(main, /define \(slate-accessory-key spec\)[\s\S]*?before \*refresh-count\*[\s\S]*?rendered\? \(> \*refresh-count\* before\)/,

+124

'accessory input must report whether it actually rendered Slate');

+125

assert.match(html, /r === '3' \|\| r === '4'\) afterRender$'accessory-render'$/,

+126

'only rendered accessory actions may run full host reconciliation');

+127

assert.match(main, /term-damage\? $and r \(not rendered\?$[\s\S]*?terminal-frame-pending\? $view-name v$/,

+128

'accessory input must report actual synchronous terminal damage');

+129

assert.match(html, /r === '5'[\s\S]*?TERM\.arm$'accessory-terminal'$/,

+130

'only actual synchronous terminal damage may arm the terminal pump');

+131

assert.match(html, /if \(!selectorOpen\(\) && document\.querySelector\('\.pane\.focused \.term-content'\)\) return;\s*scheduleAfterRender\('keydown'\)/,

+132

'terminal keys must not enter the editor-only full reconciliation repair');

+133

assert.match(html, /if \(selectorOpen\(\) \|\|[\s\S]*?!document\.querySelector\('\.pane\.focused \.term-content'\) \|\|[\s\S]*?event\.target\.id === 'slate-key-capture'/,

+134

'terminal key flush must ignore palettes, other views, and explicitly armed mobile input');

+135

assert.match(html, /const BRIDGE_BUSY_MS = 16, BRIDGE_IDLE_MS = 250/,

+136

'host bridges must retain a fast busy cadence and back off while idle');

+137

assert.match(html, /const BRIDGE_TERMINAL_IDLE_MS = 1000/,

+138

'idle non-terminal bridges must back off while a terminal is focused');

+139

assert.match(html, /if $r === '1'$ terminalPaintPriorityUntil = performance\.now \+ 80/,

+140

'received terminal output must reserve its immediate paint window');

+141

assert.match(html, /if $!terminalPaintPriorityActive\($\) enclaveTickOnce$'timer'$/,

+142

'an incidental Enclave timer must yield to an armed terminal paint');

+143

assert.match(html, /function registryDrain[\s\S]*?terminalPaintPriorityActive[\s\S]*?registrySchedule/,

+144

'idle registry work must yield to an armed terminal paint');

+145

assert.match(html, /function bfsDrain[\s\S]*?terminalPaintPriorityActive[\s\S]*?bfsSchedule/,

+146

'idle BrowserFS work must yield to an armed terminal paint');

+147

assert.doesNotMatch(html, /setInterval\(bfsDrain/,

+148

'BrowserFS must not enter WASM continuously while idle');

+149

assert.doesNotMatch(html, /registryTimer = setInterval/,

+150

'the package registry must not enter WASM continuously while idle');

+151

assert.match(html, /registryKick;[\s\S]*?__slateBrowserFsKick/,

+152

'normal renders must wake both adaptive bridges immediately');

+153

assert.match(html, /net\.createImports$\{ onEvent: netEventWake \}$/,

+154

'WebSocket arrivals must wake the in-WASM transport drain');

+155

assert.match(html, /if $nodeTimer !== null$ nodeTickOnce$'event'$/,

+156

'arrival wakes must retain the node timer as the active/recovery gate');

+157

assert.match(html, /if $source === 'event'$ TERM\.flush$'node-event'$/,

+158

'event-driven terminal output must paint in its arrival microtask');

+159

assert.match(html, /return \{ ensure, arm, invalidate, flush: flushNow \}/,

+160

'the terminal kernel must expose only its bounded synchronous flush');

+161

assert.match(html, /if $netWakePending$ return;[\s\S]*?queueMicrotask/,

+162

'arrival bursts must coalesce before entering WASM');

+163

assert.doesNotMatch(html, /netEventWake[\s\S]{0,300}enclaveTickOnce/,

+164

'node socket arrivals must not add an Enclave poll before paint');

+165

assert.match(html, /nodeTimer = setInterval$[\s\S]*?nodeTickOnce\('timer'$;[\s\S]*?\}, 150\)/,

+166

'the event-driven node fallback must retain the FSM recovery cadence');

+167

+168

// Query edits patch a sibling palette mount. It remains a projection of the

+169

// canonical Slate state and uses the canonical key handler; broader refreshes

+170

// update the frame and palette together.

+171

assert.match(html, /<div id="app"><\/div>\s*<div id="palette-root"><\/div>/);

+172

assert.match(main, /define $render-palette-mount\/content state content$[\s\S]*?on-key: ,slate-handle-key/);

+173

assert.match(main, /define $render-palette-mount state$[\s\S]*?render-palette-mount\/content/);

+174

assert.match(main, /define $slate-selector-refresh$[\s\S]*?web-client-update "#palette-root"/);

+175

assert.match(main, /define $slate-refresh$[\s\S]*?web-client-update "#app"[\s\S]*?slate-selector-refresh/);

+176

assert.match(main, /define $slate-selector-set query$[\s\S]*?slate-selector-refresh/);

+177

assert.doesNotMatch(main, /accessory-keyboard-deck[\s\S]{0,160}$palette state$/);

+178

assert.match(main, /define \*selector-max-rows\* 50/);

+179

assert.match(main, /define $effective-prompt-candidates state desc$/);

+180

assert.match(main, /prompt-candidate-policy desc\) snapshot:/);

+181

assert.match(main, /slate\/prompt-session:/);

+182

assert.match(help, /candidate-policy: live:/,

+183

'query-generated describe-command candidates must remain live');

+184

+185

console.log('performance capture policy: opt-in palette phases and bounded reports');

packages/slate/test/preferences-store-test.sglmodified

@@ -12,6 +12,7 @@

12

(define option-keys

13

(list slate/theme-name: slate/effects: slate/translucent:

14

slate/focus-follows-mouse: slate/terminals-use-tmux:

+15

slate/keep-screen-awake:

16

slate/opacity: slate/chrome-opacity: slate/ui-text-size:

17

slate/text-scale: slate/thumb-side:))

18

@@ -28,7 +29,7 @@

29

(fs-materialize kv #{ kind: file: provider: browser:

30

address: "/store/options.sgv" })))

31

−31

(test "all ten built-in preferences are declared"

+32

(test "all eleven built-in preferences are declared"

33

(for-each

34

(lambda (key)

35

(let ((declaration (option-declaration key)))

@@ -61,7 +62,7 @@

62

(assert-equal (dict-keys (options<-text "not a datum at all")) '())

63

(assert-equal (dict-keys (options<-text "(one two)")) '()))

64

−64

(test "fresh profile boots all ten defaults without inventing stored decisions"

+65

(test "fresh profile boots all eleven defaults without inventing stored decisions"

66

(let* ((result (preferences-restore-from #{} #{} #f))

67

(state (dict-ref result state: #f))

68

(stored (dict-ref result stored: #f)))

@@ -70,6 +71,7 @@

71

(assert-equal (dict-ref state slate/translucent: #t) #f)

72

(assert-equal (dict-ref state slate/focus-follows-mouse: #f) #t)

73

(assert-equal (dict-ref state slate/terminals-use-tmux: #f) #t)

+74

(assert-equal (dict-ref state slate/keep-screen-awake: #t) #f)

75

(assert-equal (dict-ref state slate/opacity: #f) 72)

76

(assert-equal (dict-ref state slate/chrome-opacity: #f) 86)

77

(assert-equal (dict-ref state slate/ui-text-size: #f) 15)

@@ -79,12 +81,13 @@

81

(assert-equal (dict-ref state slate/thumb-side: #f) 'left)

82

(assert-equal (dict-keys stored) '())))

83

−82

(test "store-backed profile restores all ten typed values"

+84

(test "store-backed profile restores all eleven typed values"

85

(let* ((stored #{ slate/theme-name: "slate-light"

86

slate/effects: #f

87

slate/translucent: #t

88

slate/focus-follows-mouse: #f

89

slate/terminals-use-tmux: #f

+90

slate/keep-screen-awake: #t

91

slate/opacity: 55

92

slate/chrome-opacity: 77

93

slate/ui-text-size: 20

packages/slate/test/profile-git-diff.mjsadded

@@ -0,0 +1,188 @@

+1

// Read-only live profiling: the same changed file with real or disabled watches.

+2

// GIT_PROFILE_WATCHES=off only replaces subscribe in this disposable client.

+3

// Build first: sigil build slate-cli --config node-release

+4

// Keep the worktree unchanged until all samples finish (snapshot validation).

+5

import assert from 'node:assert/strict';

+6

import fs from 'node:fs';

+7

import net from 'node:net';

+8

import os from 'node:os';

+9

import path from 'node:path';

+10

import { createHash } from 'node:crypto';

+11

import { spawn } from 'node:child_process';

+12

+13

const workspace = process.cwd();

+14

const repo = process.env.GIT_PROFILE_REPO || workspace;

+15

const file = process.env.GIT_PROFILE_FILE || 'packages/slate-cli/src/slate-cli/git/diff.sgl';

+16

const watches = process.env.GIT_PROFILE_WATCHES !== 'off';

+17

const samples = Number(process.env.GIT_PROFILE_SAMPLES || 5);

+18

assert.ok(Number.isInteger(samples) && samples > 0 && samples <= 30,

+19

'GIT_PROFILE_SAMPLES must be an integer from 1 to 30');

+20

const binary = process.env.GIT_PROFILE_BINARY || 'build/node-release/bin/slate';

+21

const binarySha256 = createHash('sha256').update(fs.readFileSync(binary)).digest('hex');

+22

const output = process.env.GIT_PROFILE_OUTPUT || `/tmp/slate-diff-profile-${watches ? 'on' : 'off'}`;

+23

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+24

const port = await new Promise((resolve, reject) => {

+25

const server = net.createServer();

+26

server.once('error', reject);

+27

server.listen(0, '127.0.0.1', () => {

+28

const chosen = server.address().port;

+29

server.close(error => error ? reject(error) : resolve(chosen));

+30

});

+31

});

+32

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-diff-profile-'));

+33

const daemon = spawn(binary,

+34

['serve', '--app-dir', 'build/web', '--port', String(port), '--log-level', 'debug'],

+35

{ cwd: workspace, stdio: ['ignore', 'pipe', 'pipe'] });

+36

let daemonLog = '', chrome, socket;

+37

daemon.stdout.on('data', b => { daemonLog += b; });

+38

daemon.stderr.on('data', b => { daemonLog += b; });

+39

const runtime = [];

+40

const started = new Date().toISOString();

+41

const loadBefore = os.loadavg();

+42

try {

+43

const url = `http://127.0.0.1:${port}/`;

+44

for (let i = 0; ; i++) {

+45

try { if ((await fetch(url)).ok) break; } catch (_) {}

+46

assert.ok(i < 200, 'daemon startup timeout');

+47

await sleep(100);

+48

}

+49

chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+50

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+51

{ stdio: 'ignore' });

+52

const activePort = path.join(profile, 'DevToolsActivePort');

+53

for (let i = 0; !fs.existsSync(activePort); i++) {

+54

assert.ok(i < 200, 'Chrome startup timeout');

+55

await sleep(100);

+56

}

+57

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+58

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+59

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+60

let id = 0;

+61

const pending = new Map();

+62

socket.onmessage = ({ data }) => {

+63

const msg = JSON.parse(data);

+64

if (msg.method === 'Runtime.consoleAPICalled')

+65

runtime.push(msg.params.args.map(a => a.value ?? a.description).join(' '));

+66

if (msg.method === 'Runtime.exceptionThrown')

+67

runtime.push(msg.params.exceptionDetails.exception?.description || msg.params.exceptionDetails.text);

+68

if (msg.id && pending.has(msg.id)) {

+69

const p = pending.get(msg.id); pending.delete(msg.id);

+70

msg.error ? p.reject(new Error(JSON.stringify(msg.error))) : p.resolve(msg.result);

+71

}

+72

};

+73

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+74

const call = ++id;

+75

pending.set(call, { resolve, reject });

+76

socket.send(JSON.stringify({ id: call, method, params, ...(sessionId ? { sessionId } : {}) }));

+77

});

+78

const target = await send('Target.createTarget', { url: 'about:blank' });

+79

const { sessionId } = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+80

await send('Runtime.enable', {}, sessionId);

+81

const evaluate = async expression => {

+82

const r = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, sessionId);

+83

if (r.exceptionDetails) throw new Error(r.exceptionDetails.exception?.description || r.exceptionDetails.text);

+84

return r.result.value;

+85

};

+86

const waitFor = async (expression, label) => {

+87

for (let i = 0; i < 600; i++) {

+88

if (await evaluate(expression)) return;

+89

await sleep(100);

+90

}

+91

    throw new Error(`timeout: ${label}; runtime=${runtime.join(' | ')}; body=${await evaluate('document.body.innerText.slice(0, 1800)')}`);

+92

};

+93

await send('Page.enable', {}, sessionId);

+94

await send('Page.addScriptToEvaluateOnNewDocument', { source: `

+95

window.gitProfile = {wire:[], samples:[]};

+96

const BaseWebSocket = window.WebSocket;

+97

window.WebSocket = class extends BaseWebSocket {

+98

constructor(...args) {

+99

super(...args);

+100

const requests = new Map();

+101

const baseSend = this.send;

+102

this.send = function(data) {

+103

try {

+104

const m = JSON.parse(data);

+105

if (m.verb?.startsWith('git/') || m.verb === 'fs/watch') {

+106

requests.set(m.id, m.verb);

+107

window.gitProfile.wire.push({phase:'send', verb:m.verb, id:m.id,

+108

cancel:m.args?.cancel === true, at:performance.now()});

+109

}

+110

} catch (_) {}

+111

return baseSend.call(this, data);

+112

};

+113

this.addEventListener('message', event => {

+114

try {

+115

const m = JSON.parse(event.data), verb = requests.get(m.id);

+116

if (verb && (m.t === 'ok' || m.t === 'err')) {

+117

window.gitProfile.wire.push({phase:'receive', verb, id:m.id, type:m.t, at:performance.now()});

+118

requests.delete(m.id);

+119

}

+120

} catch (_) {}

+121

});

+122

}

+123

};

+124

` }, sessionId);

+125

await send('Page.navigate', { url: `${url}?rbdebug` }, sessionId);

+126

await waitFor(`document.getElementById('status')?.textContent === 'ready' &&

+127

window.slateEval?.('(slate-node-connected?)') === '1'`, 'boot');

+128

const sgl = form => evaluate(`window.slateEval(${JSON.stringify(form)})`);

+129

if (!watches) await sgl(`(begin (import (slate provider))

+130

(register-provider! local:

+131

(dict-set (provider-ref local:) subscribe:

+132

(lambda (source callback) (lambda () #t)))) #t)`);

+133

await sgl(`(slate-dispatch ${JSON.stringify(`md-visit:local:${path.join(repo, file)}`)})`);

+134

await waitFor(`document.querySelector('.editor-input, .editor-content')`, 'source file');

+135

await sgl('(slate-dispatch "git-status")');

+136

const row = `[...document.querySelectorAll('.git-entry')].find(e => e.textContent.includes(${JSON.stringify(file)}))`;

+137

await waitFor(row, 'changed file in status');

+138

await evaluate(`new MutationObserver(() => {

+139

const p=window.gitProfile, sample=p.active;

+140

if (!sample) return;

+141

if (!sample.loading && document.body.innerText.includes('Loading diff')) sample.loading=performance.now();

+142

    if (!sample.rendered && document.querySelector('.git-status .slate-diff-addition, .git-status .slate-diff-deletion')) {

+143

sample.rendered=performance.now();

+144

requestAnimationFrame(() => { sample.frame=performance.now(); });

+145

}

+146

}).observe(document.getElementById('app'), {subtree:true, childList:true, characterData:true});`);

+147

for (let i = 0; i < samples; i++) {

+148

await evaluate(`(() => {

+149

const p=window.gitProfile;

+150

p.active={start:performance.now(), wireStart:p.wire.length};

+151

p.samples.push(p.active);

+152

(${row}).querySelector('.git-entry-toggle').click();

+153

p.active.dispatchReturned=performance.now();

+154

})()`);

+155

await waitFor('window.gitProfile.active?.frame', `diff sample ${i}`);

+156

await evaluate(`window.gitProfile.active=null; (${row}).querySelector('.git-entry-toggle').click()`);

+157

await waitFor(`!document.querySelector('.git-status .slate-diff-row')`, 'collapse');

+158

await sleep(350);

+159

}

+160

const timings = await evaluate('window.gitProfile');

+161

const measured = timings.samples.map(sample => {

+162

const sent = timings.wire.slice(sample.wireStart)

+163

.find(e => e.phase === 'send' && e.verb === 'git/diff' && !e.cancel);

+164

const received = sent && timings.wire.find(e => e.phase === 'receive' && e.id === sent.id && e.at >= sent.at);

+165

assert.ok(sent && received && received.type === 'ok', 'sample must contain a successful diff exchange');

+166

return {

+167

totalMs:sample.frame-sample.start, dispatchMs:sample.dispatchReturned-sample.start,

+168

loadingMs:sample.loading ? sample.loading-sample.start : null,

+169

actionToSendMs:sent.at-sample.start, roundTripMs:received.at-sent.at,

+170

receiveToDomMs:sample.rendered-received.at, receiveToFrameMs:sample.frame-received.at

+171

};

+172

});

+173

const result = {started, binary, binarySha256, watches, repo, file, loadBefore, loadAfter:os.loadavg(),

+174

logicalCpus:os.cpus().length, measured, wire:timings.wire,

+175

    daemonDurations:[...daemonLog.matchAll(/node\/rpc-end[^\n]*verb=(git\/[^ ]+|fs\/watch)[^\n]*duration-ms=([0-9.]+)/g)]

+176

.map(m => ({verb:m[1], ms:Number(m[2])})),

+177

diffPhases:[...daemonLog.matchAll(/node\/git-diff-phase[^\n]*phase=([^ ]+)[^\n]*duration-ms=([0-9.]+)/g)]

+178

.map(m => ({phase:m[1], ms:Number(m[2])})), runtime};

+179

fs.writeFileSync(`${output}.json`, JSON.stringify(result, null, 2));

+180

console.log(JSON.stringify({watches, measured, output:`${output}.json`}));

+181

} finally {

+182

fs.writeFileSync(`${output}.daemon.log`, daemonLog);

+183

if (socket) socket.close();

+184

if (chrome) chrome.kill('SIGTERM');

+185

daemon.kill('SIGTERM');

+186

await sleep(1000);

+187

fs.rmSync(profile, {recursive:true, force:true, maxRetries:5, retryDelay:100});

+188

}

packages/slate/test/prompt-test.sglmodified

@@ -22,6 +22,27 @@

22

23

(define (cand label action) #{ label: label action: action })

24

+25

(test "candidate lifecycle defaults by prompt type"

+26

(assert-eq

+27

(prompt-candidate-policy

+28

(completing-read-prompt "Choices" (lambda (st) '()) (lambda (st v) st)))

+29

snapshot:)

+30

(assert-eq

+31

(prompt-candidate-policy

+32

(file-prompt "File" (lambda (st) '()) (lambda (st v) st)

+33

(lambda (st q) q) #f))

+34

directory:)

+35

(assert-eq

+36

(prompt-candidate-policy

+37

(string-prompt "Text" (lambda (st v) #t) (lambda (st v) st)))

+38

live:))

+39

+40

(test "opening a prompt advances its candidate snapshot session"

+41

(let* ((first (open-prompt ST "one" (list "one")))

+42

(second (open-prompt first "two" (list "two"))))

+43

(assert-equal (dict-ref first slate/prompt-session: 0) 1)

+44

(assert-equal (dict-ref second slate/prompt-session: 0) 2)))

+45

46

;; A continuation that records what it was handed, so a test can assert on the

47

;; VALUE rather than on a state mutation.

48

(define (recorder)

packages/slate/test/provider-replay-test.sglmodified

@@ -127,6 +127,14 @@

127

(assert-false (dict-ref seen disconnected: #f))

128

(assert-false (dict-ref seen code: #f))))

129

+130

(test "it carries the explicitly selected reattach transport when supplied"

+131

(let ((seen #f))

+132

(source-session-open (a-source)

+133

(lambda (ev) (when (dict-ref ev reattached: #f) (set! seen ev)))

+134

#{})

+135

((dict-ref *ctx* reattached: #f) 12 345 'relay)

+136

(assert-equal 'relay (dict-ref seen transport: #f))))

+137

138

(test "`#f` BYTES STILL ANNOUNCES THE RE-ATTACH — less information, not wrong"

139

;; THE SURFACE DEGRADES TO SILENCE ON THE NUMBER, NEVER TO A WRONG NUMBER.

140

;;

packages/slate/test/resource-transfer-test.sgladded

@@ -0,0 +1,89 @@

+1

(import (sigil test) (sigil core) (sigil math)

+2

(slate resource transfer))

+3

+4

(define (u32 n)

+5

(bytevector (modulo (quotient n 16777216) 256)

+6

(modulo (quotient n 65536) 256)

+7

(modulo (quotient n 256) 256) (modulo n 256)))

+8

+9

(test-group "renderer Resource transfers"

+10

(test "upload waits for credit and progress advances only on acknowledgement"

+11

(let ((r (make-resource-transfer-registry)) (sent '()) (progress '()) (done #f))

+12

(resource-transfer-upload! r 1 'carrier-7 (bytevector 1 2 3 4 5)

+13

'direct (lambda (f) (set! sent (append sent (list f))))

+14

(lambda (_) (set! done #t)) (lambda (_) #f)

+15

(lambda (p) (set! progress (append progress (list p)))))

+16

(resource-transfer-control! r

+17

#{ t: "ok" id: 1 transfer: #{ direction: "upload" size: 5 chunk-bytes: 65536 } })

+18

(assert-equal 0 (length sent))

+19

(resource-transfer-frame! r

+20

(transfer-frame-encode #x23 1 (u32 5)))

+21

(assert-equal 2 (length sent)) ; batch + end

+22

(assert-equal 0 (dict-ref (car progress) completed: -1)) ; initial credit is not ack

+23

(resource-transfer-frame! r

+24

(transfer-frame-encode #x23 1 (u32 5)))

+25

(assert-equal 5 (dict-ref (cadr progress) completed: -1))

+26

(assert-false done)

+27

(resource-transfer-control! r #{ t: "ok" id: 1 result: #{ bytes: 5 } })

+28

(assert-true done)

+29

(assert-equal 5 (dict-ref (car (reverse progress)) peak-outstanding: -1))

+30

(assert-equal 5 (dict-ref (car (reverse progress)) peak-frame-bytes: -1))

+31

(assert-equal 0 (resource-transfer-count r))))

+32

+33

(test "download grants credit, assembles exact bytes, and completes on end"

+34

(let ((r (make-resource-transfer-registry)) (sent '()) (result #f)

+35

(progress '()))

+36

(resource-transfer-download! r 2 'local-3 'local

+37

(lambda (f) (set! sent (append sent (list f))))

+38

(lambda (bytes) (set! result bytes)) (lambda (_) #f)

+39

(lambda (entry) (set! progress (cons entry progress))))

+40

(resource-transfer-control! r

+41

#{ t: "ok" id: 2 transfer: #{ direction: "download" size: 3 chunk-bytes: 65536 } })

+42

(assert-equal 1 (length sent)) ; initial credit

+43

(let ((payload (bytevector 0 0 0 0 9 8 7)))

+44

(resource-transfer-frame! r (transfer-frame-encode #x20 2 payload)))

+45

(assert-equal 1 (length sent)) ; all bytes were already credited

+46

(resource-transfer-frame! r

+47

(transfer-frame-encode #x21 2 (bytevector 0 0 0 1 0 0 0 3)))

+48

(assert-equal (bytevector 9 8 7) result)

+49

(assert-equal 262144

+50

(dict-ref (car progress) peak-outstanding: -1))

+51

(assert-equal 3 (dict-ref (car progress) peak-frame-bytes: -1))

+52

(assert-equal 0 (resource-transfer-count r))))

+53

+54

(test "download credits only the remaining bytes and receives the final window without writing"

+55

(let ((r (make-resource-transfer-registry)) (sent '()) (result #f)

+56

(total 262147))

+57

(resource-transfer-download! r 5 'image 'relay

+58

(lambda (frame) (set! sent (append sent (list frame))))

+59

(lambda (bytes) (set! result bytes))

+60

(lambda (reason) (error reason)) #f)

+61

(resource-transfer-control! r

+62

#{ t: "ok" id: 5 transfer: #{ direction: "download" size: total } })

+63

(let loop ((seq 0))

+64

(when (< seq 4)

+65

(resource-transfer-frame! r

+66

(transfer-frame-encode #x20 5

+67

(bytevector-append (u32 seq) (make-bytevector 65536 seq))))

+68

(assert-equal 2 (length sent))

+69

(loop (+ seq 1))))

+70

(assert-equal (transfer-frame-encode #x23 5 (u32 3)) (cadr sent))

+71

(resource-transfer-frame! r

+72

(transfer-frame-encode #x20 5

+73

(bytevector-append (u32 4) (bytevector 9 8 7))))

+74

(resource-transfer-frame! r

+75

(transfer-frame-encode #x21 5 (bytevector-append (u32 5) (u32 total))))

+76

(assert-equal 2 (length sent))

+77

(assert-equal total (bytevector-length result))

+78

(assert-equal 7 (bytevector-u8-ref result (- total 1)))))

+79

+80

(test "owner teardown fails only that owner's transfers"

+81

(let ((r (make-resource-transfer-registry)) (failures 0))

+82

(resource-transfer-download! r 3 'carrier-a 'relay (lambda (_) #f)

+83

(lambda (_) #f) (lambda (_) (set! failures (+ failures 1))) (lambda (_) #f))

+84

(resource-transfer-download! r 4 'carrier-b 'direct (lambda (_) #f)

+85

(lambda (_) #f) (lambda (_) (set! failures (+ failures 1))) (lambda (_) #f))

+86

(assert-equal 1 (resource-transfer-remove-owner! r 'carrier-a "lost"))

+87

(assert-equal 1 failures)

+88

(assert-equal 1 (resource-transfer-count r))))

+89

)

packages/slate/test/root-browser-gate.mjsmodified

@@ -59,6 +59,8 @@ try {

59

const message = JSON.parse(event.data);

60

if (message.method === 'Runtime.exceptionThrown')

61

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+62

if (message.method === 'Runtime.consoleAPICalled' && message.params.type === 'error')

+63

errors.push(message.params.args.map(arg => arg.description || arg.value || '').join(' '));

64

if (message.id && pending.has(message.id)) {

65

const pair = pending.get(message.id); pending.delete(message.id);

66

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

@@ -73,6 +75,17 @@ try {

75

const session = attached.sessionId;

76

await send('Runtime.enable', {}, session);

77

await send('Page.enable', {}, session);

+78

// This gate owns runtime/root persistence, not service-worker lifecycle.

+79

// A fresh profile otherwise installs + claims the worker and reloads between

+80

// the ready observation and the first slateEval, racing the artifact check.

+81

await send('Page.addScriptToEvaluateOnNewDocument', {

+82

source: `if ('ServiceWorkerContainer' in globalThis) {

+83

Object.defineProperty(ServiceWorkerContainer.prototype, 'register', {

+84

configurable: true,

+85

value: () => Promise.reject(new Error('service worker disabled by root gate'))

+86

});

+87

}`

+88

}, session);

89

const forceFallback = process.env.SLATE_ROOT_GATE_BRANCH === 'fallback';

90

if (forceFallback) {

91

await send('Page.addScriptToEvaluateOnNewDocument', {

@@ -89,7 +102,8 @@ try {

102

return result.result.value;

103

};

104

for (let i = 0; i < 360; i++) {

−92

if (await evaluate(`document.getElementById('status')?.textContent === 'ready'`)) break;

+105

if (await evaluate(`document.getElementById('status')?.textContent === 'ready' &&

+106

typeof window.slateEval === 'function'`)) break;

107

if (i === 359) throw new Error(`timeout waiting for Slate boot; errors=${errors.join(' | ')}`);

108

await sleep(100);

109

}

@@ -99,6 +113,13 @@ try {

113

(source-persist (root->source browser: file: "/init.sgl")

114

${JSON.stringify(source)}))`);

115

await sgl('(import (slate hooks))');

+116

assert.equal(await sgl('(begin (import (slate pane)) (if (procedure? tree-find) "ready" "missing"))'),

+117

'ready', 'native artifact must preserve imported pane bindings');

+118

for (let i = 0; i < 120; i++) {

+119

if (await sgl('(if (= (length (hook-trace root-changed:)) 2) "ready" "waiting")') === 'ready') break;

+120

if (i === 119) throw new Error('timeout waiting for browser-root arrival');

+121

await sleep(50);

+122

}

123

const traceContext = `(dict-ref (car (reverse (hook-trace root-changed:))) context: #{})`;

124

assert.equal(await sgl(`(keyword->string (dict-ref ${traceContext} occasion: #f))`),

125

'registered', 'boot must trace a registered: arrival');

@@ -156,7 +177,7 @@ try {

177

assert.deepEqual(await evaluate(`[

178

localStorage.getItem('slate.project/catalog'),

179

localStorage.getItem('slate.project/search-roots')

−159

]`), ['[]', '[]'], 'project preferences must survive restart');

+180

]`), [null, null], 'clean-break boot must remove legacy project preference keys');

181

assert.deepEqual(errors, [], `artifact raised exceptions: ${errors.join(' | ')}`);

182

console.log(`PASS root artifact (${forceFallback ? 'localStorage fallback' : 'OPFS'}): ` +

183

'single boot arrival and handler latch delivered');

packages/slate/test/root-test.sglmodified

@@ -145,6 +145,23 @@

145

(test "rooted-path formats the parse's inverse"

146

(assert-equal (rooted-path zerocool: "/etc") "zerocool:/etc"))

147

+148

(test "local remains readable but writes through the canonical local root"

+149

(register-root! local:

+150

#{ provider: local: label: "This computer" class: local: local?: #t })

+151

(register-root! mybox:

+152

#{ provider: local: host: "opaque-local" label: "mybox" class: machine:

+153

local?: #t })

+154

;; Old saved/typed addresses still parse as the compatibility alias.

+155

(assert-equal (parse-rooted-path "local:/work")

+156

#{ root: local: path: "/work" })

+157

;; Every new spelling and every raw local source identity is canonical.

+158

(assert-equal mybox: (canonical-root-name local:))

+159

(assert-equal "mybox:/work" (rooted-path local: "/work"))

+160

(assert-equal mybox:

+161

(source-root #{ kind: file: provider: local: address: "/work" }))

+162

(unregister-root! mybox:)

+163

(unregister-root! local:))

+164

165

(test "display: bare root bare; machine roots never collide; rootless falls back"

166

(assert-equal (source-root-display-name (root->source alpha: file: "/a.txt"))

167

"/a.txt")

packages/slate/test/searchable-test.sglmodified

@@ -48,8 +48,8 @@

48

(let* ((v (a-folder))

49

(rows ((dict-ref (cap-of v) rows:) v)))

50

(assert-equal 5 (vector-length rows))

−51

(assert-equal "README.md" (vector-ref rows 0))

−52

(assert-equal "modes" (vector-ref rows 3))))

+51

(assert-equal "README.md" (vector-ref rows 2))

+52

(assert-equal "modes" (vector-ref rows 0))))

53

54

(test "goto: moves the point to the row"

55

(let* ((v (a-folder))

@@ -80,9 +80,9 @@

80

(hits (search-matches rows "sgl")))

81

(assert-equal 2 (length hits))

82

(assert-equal "buffer.sgl" (dict-ref (car hits) label: ""))

−83

(assert-equal 1 (dict-ref (car hits) line: -1))

+83

(assert-equal 3 (dict-ref (car hits) line: -1))

84

(assert-equal "search.sgl" (dict-ref (cadr hits) label: ""))

−85

(assert-equal 2 (dict-ref (cadr hits) line: -1))

+85

(assert-equal 4 (dict-ref (cadr hits) line: -1))

86

;; And the row index round-trips through goto: to the right entry.

87

(let ((moved ((dict-ref (cap-of v) goto:) v (dict-ref (cadr hits) line: 0) 0)))

88

(assert-equal "search.sgl" (dict-ref (folder-entry-at moved) name: "")))))

packages/slate/test/selector-test.sglmodified

@@ -157,3 +157,19 @@

157

(assert-equal (selector-clamp -1 3) 0)

158

(assert-equal (selector-clamp 0 0) 0)

159

(assert-equal (selector-clamp 1 3) 1))

+160

+161

;; ---- full search before the render window ---------------------------------

+162

+163

(test "a query finds a candidate beyond the first fifty source rows"

+164

;; The UI caps only AFTER ranking. A command's declaration position never

+165

;; makes it unsearchable; typing its distinguishing text promotes it into the

+166

;; rendered window even when more than fifty unrelated commands precede it.

+167

(let* ((noise (let loop ((i 0) (acc '()))

+168

(if (= i 60)

+169

(reverse acc)

+170

(loop (+ i 1)

+171

(cons (cand (string-append "ordinary-command-"

+172

(number->string i))) acc)))))

+173

(target "uniquely-searchable-command")

+174

(ranked (rank "uniquely-searchable" (append noise (list (cand target))))))

+175

(assert-equal ranked (list target))))

packages/slate/test/state-test.sglmodified

@@ -50,6 +50,7 @@

50

(assert-equal (dict-ref next slate/echo: #f) "saved")

51

(assert-equal (dict-ref next slate/echo-age: #f) 0)

52

(assert-equal (dict-ref next slate/echo-fading?: #t) #f)

+53

(assert-equal (dict-ref next slate/echo-generation: #f) 1)

54

(assert-equal (view-lines (find-view-by-name next "*messages*"))

55

(list "boot" "saved"))))

56

@@ -58,6 +59,7 @@

59

(assert-equal (dict-ref next slate/echo: #f) "C-x-")

60

(assert-equal (dict-ref next slate/echo-age: #f) 0)

61

(assert-equal (dict-ref next slate/echo-fading?: #t) #f)

+62

(assert-equal (dict-ref next slate/echo-generation: #f) 1)

63

(assert-equal (view-lines (find-view-by-name next "*messages*"))

64

(list "boot"))))

65

packages/slate/test/term-diff-test.sglmodified

@@ -117,7 +117,9 @@

117

(string-append ESC "[38;2mx")

118

(string-append ESC "P malicious dcs payload " ESC "\\ok")

119

(string-append ESC "[999999999Ix")

−120

(string-append ESC "[?9999h" ESC "[<5m" ESC "(0ok")

+120

;; DEC graphics are covered by sigil-vt and the browser gate; the historical

+121

;; reference does not implement them. Keep this fixture on an unknown set.

+122

(string-append ESC "[?9999h" ESC "[<5m" ESC "(Xok")

123

"aλbμc"

124

"abcdefgh"))

125

packages/slate/test/term-test.sglmodified

@@ -370,7 +370,7 @@

370

(let ((t (term* 10 2 ESC "[999999999I" "x")))

371

(check "CHT clamps" (cursor-of t) (list 0 (- 10 1))))

372

−373

(let ((t (term* 10 2 ESC "[?9999h" ESC "[<5m" ESC "(0" "ok")))

+373

(let ((t (term* 10 2 ESC "[?9999h" ESC "[<5m" ESC "(X" "ok")))

374

(check "unknown modes/charsets swallowed" (rows-of t) (list "ok" "")))

375

376

;; an escape split across chunk boundaries parses whole

packages/slate/test/terminal-compose-browser-gate.mjsadded

@@ -0,0 +1,218 @@

+1

// Mobile terminal deck gate: real touch events and native text input against the shipped WASM.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import http from 'node:http';

+5

import os from 'node:os';

+6

import path from 'node:path';

+7

import { spawn } from 'node:child_process';

+8

+9

const root = path.resolve(import.meta.dirname, '../../..');

+10

const webRoot = process.env.SLATE_TEST_WEB_ROOT || path.join(root, 'build/web');

+11

assert.ok(fs.existsSync(path.join(webRoot, 'slate.wasm')), 'build/web/slate.wasm is required');

+12

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+13

const types = { '.html': 'text/html', '.js': 'text/javascript', '.mjs': 'text/javascript',

+14

'.wasm': 'application/wasm', '.json': 'application/json', '.svg': 'image/svg+xml',

+15

'.woff2': 'font/woff2' };

+16

const server = http.createServer((req, res) => {

+17

const relative = req.url.split('?')[0] === '/' ? 'index.html' : req.url.split('?')[0].slice(1);

+18

const target = path.resolve(webRoot, relative);

+19

if (!target.startsWith(webRoot + path.sep) || !fs.existsSync(target)) {

+20

res.writeHead(404).end(); return;

+21

}

+22

res.setHeader('content-type', types[path.extname(target)] || 'application/octet-stream');

+23

fs.createReadStream(target).pipe(res);

+24

});

+25

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+26

+27

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-compose-chrome-'));

+28

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+29

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+30

{ stdio: ['ignore', 'ignore', 'pipe'] });

+31

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+32

let socket;

+33

const errors = [];

+34

try {

+35

const activePort = path.join(profile, 'DevToolsActivePort');

+36

for (let i = 0; i < 120 && !fs.existsSync(activePort); i++) await sleep(50);

+37

assert.ok(fs.existsSync(activePort), 'Chrome did not expose DevTools');

+38

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+39

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+40

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+41

let nextId = 0;

+42

const pending = new Map();

+43

socket.onmessage = event => {

+44

const message = JSON.parse(event.data);

+45

if (message.method === 'Runtime.exceptionThrown')

+46

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+47

if (message.id && pending.has(message.id)) {

+48

const pair = pending.get(message.id); pending.delete(message.id);

+49

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

+50

}

+51

};

+52

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+53

const id = ++nextId;

+54

const timer = setTimeout(() => { pending.delete(id); reject(new Error('CDP timeout: ' + method)); }, 15000);

+55

pending.set(id, {resolve: value => { clearTimeout(timer); resolve(value); },

+56

reject: error => { clearTimeout(timer); reject(error); }});

+57

socket.send(JSON.stringify({ id, method, params, ...(sessionId ? { sessionId } : {}) }));

+58

});

+59

const target = await send('Target.createTarget', { url: 'about:blank' });

+60

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+61

const session = attached.sessionId;

+62

await send('Runtime.enable', {}, session);

+63

await send('Emulation.setDeviceMetricsOverride', {width:390,height:844,deviceScaleFactor:1,mobile:true}, session);

+64

await send('Emulation.setTouchEmulationEnabled', {enabled:true}, session);

+65

await send('Page.navigate', {

+66

url: process.env.SLATE_TEST_URL ||

+67

`http://127.0.0.1:${server.address().port}/?rbdebug&prediction-gate`

+68

}, session);

+69

const evaluate = async expression => {

+70

const result = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, session);

+71

    if (result.exceptionDetails) throw new Error(result.exceptionDetails.exception?.description || result.exceptionDetails.text);

+72

return result.result.value;

+73

};

+74

async function waitFor(expression, label) {

+75

for (let i = 0; i < 360; i++) {

+76

if (await evaluate(expression)) return;

+77

await sleep(100);

+78

}

+79

    const diagnostic = await evaluate(`({status:document.getElementById('status')?.textContent, body:document.body.innerText.slice(-2000)})`);

+80

throw new Error(`timeout waiting for ${label}; errors=${errors.join(' | ')}; page=${JSON.stringify(diagnostic)}`);

+81

}

+82

const dispatch = event => evaluate(`window.slateEval('(slate-dispatch "${event}")')`);

+83

+84

await waitFor(`document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+85

console.log('PASS browser boot');

+86

  const sgl = async code => {const value = await evaluate(`window.slateEval(${JSON.stringify(code)})`); if (/^(Error|error):/.test(value)) throw new Error(value); if (code.includes('(slate-refresh)')) await evaluate('window.slateRefresh()'); return value;};

+87

await waitFor(`window.slateEval('(slate-preferences-settled?)') === '1'`, 'preference restore');

+88

await waitFor(`!document.getElementById('splash')`, 'interactive app');

+89

await evaluate('document.fonts.ready.then(() => true)');

+90

await sgl('(import (slate provider) (slate modes terminal) (slate extend))');

+91

await sgl(`(begin

+92

(define compose-context #f)

+93

(define compose-writes "")

+94

(register-provider! compose-probe:

+95

#{ session-open: (lambda (source ctx)

+96

(set! compose-context ctx)

+97

#{ write: (lambda (bytes)

+98

(set! compose-writes (string-append compose-writes bytes))) }) })

+99

(open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:}))

+100

((dict-ref compose-context emit:) "$ ")

+101

(slate-refresh))`);

+102

  await waitFor(`document.querySelector('.accessory-key-deck')?.getAttribute('data-compose-target') === 'compose-one'`, 'terminal deck');

+103

const field = `document.querySelector('.terminal-compose-input')`;

+104

const alt = '.terminal-key-row [data-slate-click="sticky-mod:alt"]';

+105

const ctrl = '.terminal-key-row [data-slate-click="sticky-mod:ctrl"]';

+106

async function touch(selector, dx = 0) {

+107

    const pos = await evaluate(`(() => { const r=document.querySelector(${JSON.stringify(selector)}).getBoundingClientRect(); return {x:r.x+r.width/2,y:r.y+r.height/2}; })()`);

+108

assert.ok(pos.y > 0 && pos.y < 844, 'touch target is visible: ' + selector);

+109

await send('Input.dispatchTouchEvent', {type:'touchStart', touchPoints:[pos]}, session);

+110

    if (dx) for(let i=1;i<=5;i++) await send('Input.dispatchTouchEvent', {type:'touchMove', touchPoints:[{x:pos.x+dx*i/5,y:pos.y}]}, session);

+111

await send('Input.dispatchTouchEvent', {type:'touchEnd', touchPoints:[]}, session);

+112

await sleep(50);

+113

}

+114

async function openCompose() {

+115

const button = '[data-slate-host-action="terminal-compose:open"]';

+116

if (!await evaluate(`!!document.querySelector('${button}')`))

+117

await touch('[data-slate-click="acc-cat:terminal"]');

+118

await touch(button);

+119

    assert.equal(await evaluate('document.activeElement.classList.contains("terminal-compose-input")'),true,'Compose Input focuses the native editor');

+120

}

+121

async function enter() {

+122

await send('Input.dispatchKeyEvent', {type:'keyDown',key:'Enter',code:'Enter',windowsVirtualKeyCode:13}, session);

+123

await send('Input.dispatchKeyEvent', {type:'keyUp',key:'Enter',code:'Enter',windowsVirtualKeyCode:13}, session);

+124

}

+125

const writes = () => sgl('compose-writes');

+126

const clear = () => sgl('(set! compose-writes "")');

+127

  await evaluate(`window.slateFocusTerminalKeys(); window.deckFocused=document.activeElement; window.deckBlur=0; window.deckFocused.addEventListener('blur',()=>window.deckBlur++);`);

+128

await touch(alt);

+129

assert.equal(await evaluate('document.activeElement === window.deckFocused'), true);

+130

assert.equal(await evaluate('window.deckBlur'), 0);

+131

assert.equal(await evaluate(`document.querySelector(${JSON.stringify(alt)}).classList.contains('once')`), true);

+132

await send('Input.dispatchKeyEvent', {type:'keyDown',key:'z',code:'KeyZ',text:'z'},session);

+133

await send('Input.dispatchKeyEvent', {type:'keyUp',key:'z',code:'KeyZ'},session);

+134

assert.equal(await writes(), '\x1bz', 'Alt applies once to the following live key');

+135

assert.equal(await evaluate(`document.querySelector(${JSON.stringify(alt)}).classList.contains('off')`),true);

+136

await clear();

+137

await touch(ctrl);

+138

assert.equal(await evaluate('document.activeElement === window.deckFocused && window.deckBlur === 0'),true);

+139

await touch(ctrl); await touch(ctrl); // once -> locked -> off

+140

console.log('PASS touch Alt/Ctrl retain native focus and modifiers still route');

+141

+142

await touch(alt,-65);

+143

assert.equal(await evaluate(`document.activeElement === ${field}`),true, 'swipe exposes and focuses composer');

+144

  assert.equal(await evaluate(`document.querySelector(${JSON.stringify(alt)}).classList.contains('off')`),true, 'swipe does not arm Alt');

+145

const draft = 'Hello café — typing longer text';

+146

await send('Input.insertText', {text:draft},session);

+147

assert.equal(await writes(),'','draft is local');

+148

await evaluate(`${field}.setSelectionRange(6,10)`);

+149

await sgl('((dict-ref compose-context emit:) "server output")');

+150

await sgl('(slate-refresh)');

+151

  assert.deepEqual(await evaluate(`({text:${field}.value, start:${field}.selectionStart,end:${field}.selectionEnd,focused:document.activeElement===${field}})`),{text:draft,start:6,end:10,focused:true});

+152

await enter();

+153

assert.equal(await writes(),draft,'Enter sends text only once, with no trailing CR');

+154

assert.equal(await evaluate(`${field}.value`),'');

+155

console.log('PASS local Unicode draft, output/rerender preserve selection, Enter sends text only');

+156

+157

await clear();

+158

await send('Input.insertText',{text:'IME draft'},session);

+159

  await evaluate(`(() => {const f=${field}; f.dispatchEvent(new CompositionEvent('compositionstart',{bubbles:true})); f.dispatchEvent(new KeyboardEvent('keydown',{key:'Enter',isComposing:true,bubbles:true,cancelable:true})); f.dispatchEvent(new CompositionEvent('compositionend',{data:'draft',bubbles:true})); f.dispatchEvent(new InputEvent('beforeinput',{inputType:'insertLineBreak',bubbles:true,cancelable:true})); f.dispatchEvent(new KeyboardEvent('keyup',{key:'Enter',bubbles:true})); })()`);

+160

assert.equal(await writes(),'','IME confirmation is not submission');

+161

  await evaluate(`${field}.dispatchEvent(new InputEvent('beforeinput',{inputType:'insertLineBreak',bubbles:true,cancelable:true}))`);

+162

assert.equal(await writes(),'IME draft','soft keyboard Enter submits text only');

+163

await clear();

+164

await send('Input.insertText',{text:'saved for one'},session);

+165

await touch('.terminal-compose-back',65);

+166

assert.equal(await evaluate('document.activeElement === window.deckFocused'),true);

+167

await openCompose();

+168

assert.equal(await evaluate(`${field}.value`),'saved for one');

+169

await sgl(`(begin (define compose-one-context compose-context)

+170

(open-view! (make-terminal-view "compose-two" #{kind: pty: provider: compose-probe:}))

+171

(slate-refresh))`);

+172

await openCompose();

+173

assert.equal(await evaluate(`${field}.value`),'','second terminal starts with its own draft');

+174

await send('Input.insertText',{text:'saved for two'},session);

+175

assert.equal(await sgl('(slate-term-compose "compose-one" "wrong target")'),'');

+176

assert.equal(await writes(),'','stale target cannot receive another draft');

+177

  await sgl('(begin (open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:})) (slate-refresh))');

+178

assert.equal(await evaluate(`${field}.value`),'saved for one');

+179

await evaluate(`${field}.focus()`);

+180

await sgl('((dict-ref compose-one-context emit:) (string-append (string (integer->char 27)) "[?2004h"))');

+181

await touch('.terminal-compose-send');

+182

assert.equal(await writes(),'\x1b[200~saved for one\x1b[201~','bracketed paste adds no Enter');

+183

await clear();

+184

await send('Input.insertText',{text:'retain when disconnected'},session);

+185

await sgl('((dict-ref compose-one-context lost:) 1234)');

+186

await enter();

+187

assert.equal(await writes(),'');

+188

assert.equal(await evaluate(`${field}.value`),'retain when disconnected');

+189

assert.match(await evaluate(`document.querySelector('.terminal-compose-status').textContent`),/Not sent/);

+190

console.log('PASS IME, soft Enter, draft switching, stale targets, bracketed paste, disconnected draft retention');

+191

if (process.env.SLATE_TEST_SCREENSHOT_DIR) {

+192

fs.mkdirSync(process.env.SLATE_TEST_SCREENSHOT_DIR,{recursive:true});

+193

const shot=await send('Page.captureScreenshot',{format:'png'},session);

+194

    fs.writeFileSync(path.join(process.env.SLATE_TEST_SCREENSHOT_DIR,'terminal-compose.png'),Buffer.from(shot.data,'base64'));

+195

}

+196

await sgl('(slate-dispatch "scratchpad")');

+197

await evaluate('window.slateRefresh()');

+198

  await waitFor(`document.querySelector('.pane.focused [contenteditable]:not([contenteditable="false"])')`, 'rendered editor');

+199

await evaluate(`(() => {

+200

const editor=document.querySelector('.pane.focused [contenteditable]:not([contenteditable="false"])');

+201

editor.focus(); window.editorFocused=editor; window.editorBlur=0;

+202

editor.addEventListener('blur',()=>window.editorBlur++);

+203

    const selection=getSelection(); window.editorAnchor=selection.anchorNode; window.editorOffset=selection.anchorOffset;

+204

})()`);

+205

await touch(alt);

+206

  assert.equal(await evaluate(`document.activeElement===window.editorFocused && window.editorBlur===0 && getSelection().anchorNode===window.editorAnchor && getSelection().anchorOffset===window.editorOffset`),true,'Alt preserves editor focus and caret');

+207

await touch(ctrl);

+208

assert.equal(await evaluate('document.activeElement===window.editorFocused && window.editorBlur===0'),true);

+209

console.log('PASS Alt/Ctrl retain rendered editor focus and caret');

+210

assert.deepEqual(errors,[]);

+211

} finally {

+212

if (socket) socket.close();

+213

chrome.kill('SIGTERM');

+214

await Promise.race([chromeExit, sleep(2000)]);

+215

await new Promise(resolve => server.close(resolve));

+216

try { fs.rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); }

+217

catch (_) { /* Chrome helpers may finish touching the disposable profile late. */ }

+218

}

packages/slate/test/terminal-copy-browser-gate.mjsadded

@@ -0,0 +1,343 @@

+1

// Mobile terminal deck gate: real touch events and native text input against the shipped WASM.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import http from 'node:http';

+5

import os from 'node:os';

+6

import path from 'node:path';

+7

import { spawn } from 'node:child_process';

+8

+9

const root = path.resolve(import.meta.dirname, '../../..');

+10

const webRoot = process.env.SLATE_TEST_WEB_ROOT || path.join(root, 'build/web');

+11

assert.ok(fs.existsSync(path.join(webRoot, 'slate.wasm')), 'build/web/slate.wasm is required');

+12

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+13

const types = { '.html': 'text/html', '.js': 'text/javascript', '.mjs': 'text/javascript',

+14

'.wasm': 'application/wasm', '.json': 'application/json', '.svg': 'image/svg+xml',

+15

'.woff2': 'font/woff2' };

+16

const server = http.createServer((req, res) => {

+17

const relative = req.url.split('?')[0] === '/' ? 'index.html' : req.url.split('?')[0].slice(1);

+18

const target = path.resolve(webRoot, relative);

+19

if (!target.startsWith(webRoot + path.sep) || !fs.existsSync(target)) {

+20

res.writeHead(404).end(); return;

+21

}

+22

res.setHeader('content-type', types[path.extname(target)] || 'application/octet-stream');

+23

fs.createReadStream(target).pipe(res);

+24

});

+25

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+26

+27

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-compose-chrome-'));

+28

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+29

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+30

{ stdio: ['ignore', 'ignore', 'pipe'] });

+31

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+32

let socket;

+33

const errors = [];

+34

try {

+35

const activePort = path.join(profile, 'DevToolsActivePort');

+36

for (let i = 0; i < 120 && !fs.existsSync(activePort); i++) await sleep(50);

+37

assert.ok(fs.existsSync(activePort), 'Chrome did not expose DevTools');

+38

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+39

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+40

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+41

let nextId = 0;

+42

const pending = new Map();

+43

socket.onmessage = event => {

+44

const message = JSON.parse(event.data);

+45

if (message.method === 'Runtime.exceptionThrown')

+46

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+47

if (message.id && pending.has(message.id)) {

+48

const pair = pending.get(message.id); pending.delete(message.id);

+49

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

+50

}

+51

};

+52

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+53

const id = ++nextId;

+54

const timer = setTimeout(() => { pending.delete(id); reject(new Error('CDP timeout: ' + method)); }, 15000);

+55

pending.set(id, {resolve: value => { clearTimeout(timer); resolve(value); },

+56

reject: error => { clearTimeout(timer); reject(error); }});

+57

socket.send(JSON.stringify({ id, method, params, ...(sessionId ? { sessionId } : {}) }));

+58

});

+59

const target = await send('Target.createTarget', { url: 'about:blank' });

+60

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+61

const session = attached.sessionId;

+62

await send('Runtime.enable', {}, session);

+63

await send('Emulation.setDeviceMetricsOverride', {width:390,height:844,deviceScaleFactor:1,mobile:true}, session);

+64

await send('Emulation.setTouchEmulationEnabled', {enabled:true}, session);

+65

await send('Page.navigate', {

+66

url: process.env.SLATE_TEST_URL ||

+67

`http://127.0.0.1:${server.address().port}/?rbdebug&prediction-gate`

+68

}, session);

+69

const evaluate = async expression => {

+70

const result = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, session);

+71

    if (result.exceptionDetails) throw new Error(result.exceptionDetails.exception?.description || result.exceptionDetails.text);

+72

return result.result.value;

+73

};

+74

async function waitFor(expression, label) {

+75

for (let i = 0; i < 360; i++) {

+76

if (await evaluate(expression)) return;

+77

await sleep(100);

+78

}

+79

    const diagnostic = await evaluate(`({status:document.getElementById('status')?.textContent, body:document.body.innerText.slice(-2000)})`);

+80

throw new Error(`timeout waiting for ${label}; errors=${errors.join(' | ')}; page=${JSON.stringify(diagnostic)}`);

+81

}

+82

const dispatch = event => evaluate(`window.slateEval('(slate-dispatch "${event}")')`);

+83

+84

await waitFor(`document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+85

console.log('PASS browser boot');

+86

  const sgl = async code => {const value = await evaluate(`window.slateEval(${JSON.stringify(code)})`); if (/^(Error|error):/.test(value)) throw new Error(value); if (code.includes('(slate-refresh)')) await evaluate('window.slateRefresh()'); return value;};

+87

await waitFor(`window.slateEval('(slate-preferences-settled?)') === '1'`, 'preference restore');

+88

await waitFor(`!document.getElementById('splash')`, 'interactive app');

+89

await evaluate('document.fonts.ready.then(() => true)');

+90

await sgl('(import (slate provider) (slate modes terminal) (slate extend))');

+91

await sgl(`(begin

+92

(define compose-context #f)

+93

(define compose-writes "")

+94

(register-provider! compose-probe:

+95

#{ session-open: (lambda (source ctx)

+96

(set! compose-context ctx)

+97

#{ write: (lambda (bytes)

+98

(set! compose-writes (string-append compose-writes bytes))) }) })

+99

(open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:}))

+100

((dict-ref compose-context emit:) "$ ")

+101

(slate-refresh))`);

+102

  await waitFor(`document.querySelector('.accessory-key-deck')?.getAttribute('data-compose-target') === 'compose-one'`, 'terminal deck');

+103

const field = `document.querySelector('.terminal-compose-input')`;

+104

const alt = '.terminal-key-row [data-slate-click="sticky-mod:alt"]';

+105

const ctrl = '.terminal-key-row [data-slate-click="sticky-mod:ctrl"]';

+106

async function touch(selector, dx = 0) {

+107

    const pos = await evaluate(`(() => { const r=document.querySelector(${JSON.stringify(selector)}).getBoundingClientRect(); return {x:r.x+r.width/2,y:r.y+r.height/2}; })()`);

+108

assert.ok(pos.y > 0 && pos.y < 844, 'touch target is visible: ' + selector);

+109

await send('Input.dispatchTouchEvent', {type:'touchStart', touchPoints:[pos]}, session);

+110

    if (dx) for(let i=1;i<=5;i++) await send('Input.dispatchTouchEvent', {type:'touchMove', touchPoints:[{x:pos.x+dx*i/5,y:pos.y}]}, session);

+111

await send('Input.dispatchTouchEvent', {type:'touchEnd', touchPoints:[]}, session);

+112

await sleep(50);

+113

}

+114

async function openCompose() {

+115

const button = '[data-slate-host-action="terminal-compose:open"]';

+116

if (!await evaluate(`!!document.querySelector('${button}')`))

+117

await touch('[data-slate-click="acc-cat:terminal"]');

+118

await touch(button);

+119

    assert.equal(await evaluate('document.activeElement.classList.contains("terminal-compose-input")'),true,'Compose Input focuses the native editor');

+120

}

+121

async function enter() {

+122

await send('Input.dispatchKeyEvent', {type:'keyDown',key:'Enter',code:'Enter',windowsVirtualKeyCode:13}, session);

+123

await send('Input.dispatchKeyEvent', {type:'keyUp',key:'Enter',code:'Enter',windowsVirtualKeyCode:13}, session);

+124

}

+125

const writes = () => sgl('compose-writes');

+126

const clear = () => sgl('(set! compose-writes "")');

+127

const copyButton = action => `.accessory-bar [data-terminal-copy="${action}"]`;

+128

const copyMenu = '[data-slate-click="acc-cat:terminal-copy"]';

+129

async function hardware(key, modifiers = 0) {

+130

await send('Input.dispatchKeyEvent', {type:'keyDown',key,modifiers},session);

+131

await send('Input.dispatchKeyEvent', {type:'keyUp',key,modifiers},session);

+132

}

+133

async function output(text) {

+134

const literal=JSON.stringify(text).replace(/\\u([0-9a-f]{4})/g,'\\x$1;');

+135

await sgl(`((dict-ref compose-context emit:) ${literal})`);

+136

await evaluate('window.slateTerm.flush()');

+137

}

+138

+139

// Exercise the linked native VT parser through real terminal rendering.

+140

// tmux may send ASCII q in DEC graphics mode for a Unicode horizontal line.

+141

await output('\x1bc\x1b(0lqqk\x1b(Bqq\r\n\x1b)0q\x0eqx\x0fq');

+142

  await waitFor(`document.querySelector('.term-content').innerText.includes('┌──┐qq')`, 'G0 graphics rendering');

+143

assert.match(await evaluate(`document.querySelector('.term-content').innerText`), /q─│q/,

+144

'G1 SO/SI renders graphics and returns to ASCII');

+145

await output('\r\n\x1b(');

+146

await output('0q─é\x1b(Bq');

+147

await sgl('(slate-refresh)');

+148

  await waitFor(`document.querySelector('.term-content').innerText.includes('──éq')`, 'split charset and Unicode after refresh');

+149

await output('\x1bc$ ');

+150

console.log('PASS native WASM DEC graphics, charset switching, split output and Unicode rendering');

+151

+152

await openCompose();

+153

assert.equal(await evaluate(`document.querySelector('.terminal-compose-send').disabled`),true);

+154

for (let i=1;i<=6;i++) {

+155

await send('Input.insertText',{text:`draft ${i} café`},session);

+156

await enter();

+157

}

+158

assert.equal(await writes(),Array.from({length:6},(_,i)=>`draft ${i+1} café`).join(''));

+159

  assert.equal(await evaluate(`document.querySelector('.terminal-compose-send').getAttribute('aria-label')`),'Text history');

+160

await touch('.terminal-compose-send');

+161

  assert.deepEqual(await evaluate(`Array.from(document.querySelectorAll('[data-terminal-history]'),b=>b.textContent)`),[6,5,4,3,2].map(n=>`draft ${n} café`));

+162

await evaluate('window.firstHistoryEntry=document.querySelector("[data-terminal-history]")');

+163

await evaluate('window.slateRefresh()');

+164

  assert.equal(await evaluate('document.querySelector("[data-terminal-history]")===window.firstHistoryEntry'),true,'unchanged history preserves its existing DOM entries');

+165

  assert.deepEqual(await evaluate(`Array.from(document.querySelectorAll('[data-terminal-history]'),b=>b.textContent)`),[6,5,4,3,2].map(n=>`draft ${n} café`),'an open history list survives refresh without rebuilding its contents');

+166

await touch('[data-terminal-history="2"]');

+167

assert.equal(await evaluate(`${field}.value`),'draft 4 café');

+168

await clear(); assert.equal(await writes(),'');

+169

await sgl('(slate-refresh)');

+170

assert.equal(await evaluate(`${field}.value`),'draft 4 café');

+171

await sgl(`(begin (define history-one-context compose-context)

+172

(open-view! (make-terminal-view "history-two" #{kind: pty: provider: compose-probe:})) (slate-refresh))`);

+173

await openCompose();

+174

  assert.equal(await evaluate(`document.querySelector('.terminal-compose-send').disabled`),true,'history belongs to its terminal');

+175

  await sgl('(begin (open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:})) (set! compose-context history-one-context) (slate-refresh))');

+176

assert.equal(await evaluate(`${field}.value`),'draft 4 café');

+177

await touch('.terminal-compose-back');

+178

console.log('PASS five-entry ephemeral history, clock, recall without sending, rerender and terminal isolation');

+179

+180

await evaluate(`window.clipboardWrites=[]; window.failClipboard=false; window.realClipboard=navigator.clipboard;

+181

    Object.defineProperty(navigator,'clipboard',{configurable:true,value:{writeText:async text=>{if(window.failClipboard)throw Error('test denial');window.clipboardWrites.push(text);}}});

+182

window.realExecCommand=document.execCommand.bind(document); document.execCommand=()=>false;`);

+183

  assert.equal(await evaluate('document.querySelectorAll(".terminal-compose-toggle").length'),0,'no pencil or reserved column');

+184

  assert.deepEqual(await evaluate(`Array.from(document.querySelectorAll('[data-accessory-category="terminal"] > .acc-btn'), el=>el.textContent)`),['Compose Input','C-c','C-d','C-r','Close'],'Term contains only composition, control chords and Close');

+185

  const targets = () => evaluate(`Array.from(document.querySelectorAll('.terminal-key-row .term-key, .acc-kbd-chip'), el => {const r=el.getBoundingClientRect(); return {x:r.x,y:r.y,width:r.width,height:r.height};})`);

+186

const terminalTargets = await targets();

+187

await sgl('(slate-dispatch "scratchpad")'); await evaluate('window.slateRefresh()');

+188

assert.equal(await evaluate(`!!document.querySelector('${copyMenu}')`),false,'Copy category is terminal-only');

+189

assert.deepEqual(await targets(),terminalTargets,'keyboard, Ctrl/Alt and all key targets stay fixed across views');

+190

  await sgl('(begin (open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:})) (set! compose-context history-one-context) (slate-refresh))');

+191

await evaluate('window.slateFocusTerminalKeys()');

+192

await touch(copyMenu);

+193

assert.equal(await evaluate('window.slateCopy.report().length'),0,'opening Copy does not freeze');

+194

assert.equal(await evaluate('document.activeElement.id'),'slate-key-capture','opening Copy retains keyboard focus');

+195

assert.deepEqual(await targets(),terminalTargets,'opening the menu leaves key targets fixed');

+196

  assert.equal(await evaluate('document.querySelectorAll(".view.terminal > .terminal-copy-tools").length'),0,'no dedicated terminal copy row');

+197

assert.deepEqual(await evaluate(`(() => {

+198

window.slateCopy.sync();

+199

const observer=new MutationObserver(()=>{});

+200

observer.observe(document.body,{attributes:true,childList:true,subtree:true});

+201

for(let i=0;i<5;i++)window.slateCopy.sync();

+202

const changes=observer.takeRecords().map(m=>({type:m.type,attribute:m.attributeName,target:m.target.className}));

+203

observer.disconnect(); return changes;

+204

})()`),[],'unchanged copy controls never retrigger the app mutation observer');

+205

  await clear(); await send('Input.insertText',{text:'x'},session); assert.equal(await writes(),'x','live input still works with Copy menu open'); await clear();

+206

console.log('PASS terminal-only Copy menu, explicit entry, keyboard focus and fixed key targets');

+207

  const lines=Array.from({length:150},(_,i)=>i===40?'row 040 <script>safe</script>':`row ${String(i).padStart(3,'0')} café`);

+208

await output('\x1b[2J\x1b[H'+lines.join('\r\n'));

+209

await touch(copyButton('start'));

+210

assert.equal(await evaluate('window.slateCopy.report().length'),1);

+211

const frozen=await evaluate(`document.querySelector('.term-content').innerText`);

+212

await output(Array.from({length:1200},(_,i)=>'\r\nlater output '+i).join('')+'\r\nnew live output');

+213

await sgl('(slate-refresh)');

+214

  assert.equal(await evaluate(`document.querySelector('.term-content').innerText`),frozen,'output and full render cannot change the frozen rows');

+215

await hardware('x');

+216

assert.equal(await writes(),'','copy mode swallows live typing');

+217

assert.equal(await sgl('(slate-term-compose "compose-one" "not sent")'),'');

+218

await hardware('Home',2);

+219

await touch(ctrl); await send('Input.insertText',{text:' '},session);

+220

assert.deepEqual((await evaluate('window.slateCopy.report()'))[0].mark,{row:0,col:0});

+221

await hardware('End',2);

+222

  assert.equal((await evaluate('window.slateCopy.report()'))[0].text,lines.join('\n'),'mark spans retained history beyond viewport');

+223

const beforeClose = await evaluate('window.slateCopy.report()');

+224

const selectionOnly = rows => rows.map(({top, ...selection}) => selection);

+225

await touch(copyMenu);

+226

assert.equal(await evaluate('document.querySelector(".pane.focused .terminal-copy-label").hidden'),false);

+227

  assert.equal(await evaluate('document.querySelector(".accessory-bar").innerText.includes("Tap a start")'),false,'copy help disappears when menu collapses');

+228

  assert.equal(await evaluate('document.querySelectorAll(".acc-cats .terminal-copy-status, .acc-cats .acc-host-status").length'),0,'copy status never migrates into the category row');

+229

if (process.env.SLATE_TEST_SCREENSHOT_DIR) {

+230

fs.mkdirSync(process.env.SLATE_TEST_SCREENSHOT_DIR,{recursive:true});

+231

const shot=await send('Page.captureScreenshot',{format:'png'},session);

+232

    fs.writeFileSync(path.join(process.env.SLATE_TEST_SCREENSHOT_DIR,'copy-collapsed.png'),Buffer.from(shot.data,'base64'));

+233

}

+234

await touch(copyMenu);

+235

  assert.deepEqual(selectionOnly(await evaluate('window.slateCopy.report()')),selectionOnly(beforeClose),'closing and reopening Copy preserves the selection');

+236

  assert.match(await evaluate(`document.querySelector('[data-accessory-category="terminal-copy"] .acc-host-status').textContent`),/Tap a start/,'help returns inside the reopened menu');

+237

await touch('[data-slate-click="acc-cat:terminal"]');

+238

assert.equal(await evaluate('!!document.querySelector(".acc-actions.terminal-copy-tools")'),false);

+239

await touch(copyMenu);

+240

// Different action rows change viewport height and may clamp its top row.

+241

// The frozen text and selection endpoints must remain unchanged.

+242

  assert.deepEqual(selectionOnly(await evaluate('window.slateCopy.report()')),selectionOnly(beforeClose),'switching categories preserves the selection');

+243

await evaluate('window.failClipboard=true');

+244

await touch(copyButton('copy'));

+245

assert.equal(await evaluate('window.slateCopy.report().length'),1,'failed copy retains frozen selection');

+246

assert.match(await evaluate(`document.querySelector('.terminal-copy-status').textContent`),/Copy failed/);

+247

await evaluate('window.failClipboard=false');

+248

await hardware('w',1);

+249

await waitFor('window.slateCopy.report().length === 0','successful copy exit');

+250

assert.deepEqual(await evaluate('window.clipboardWrites'),[lines.join('\n')]);

+251

await evaluate('window.slateTerm.flush()');

+252

assert.match(await evaluate(`document.querySelector('.term-content').innerText`),/new live output/);

+253

  console.log('PASS frozen scrollback, local input isolation, Emacs mark/motion, exact Unicode text, failed-copy retention and live return');

+254

+255

// Touch selection: tap -> Mark -> scroll -> tap another endpoint.

+256

await touch(copyButton('start'));

+257

  const rect=await evaluate(`(() => {const el=document.querySelector('.term-content'), r=el.getBoundingClientRect(),s=getComputedStyle(el);return {x:r.x+parseFloat(s.paddingLeft)+20,y:r.y+parseFloat(s.paddingTop)+8};})()`);

+258

const tapAt=async pos=>{

+259

await send('Input.dispatchTouchEvent',{type:'touchStart',touchPoints:[pos]},session);

+260

await send('Input.dispatchTouchEvent',{type:'touchEnd',touchPoints:[]},session);

+261

};

+262

await tapAt(rect); await touch(copyButton('mark'));

+263

const mark=(await evaluate('window.slateCopy.report()'))[0].mark;

+264

const dragStart={x:rect.x+60,y:rect.y+60};

+265

await send('Input.dispatchTouchEvent',{type:'touchStart',touchPoints:[dragStart]},session);

+266

  for(let i=1;i<=8;i++)await send('Input.dispatchTouchEvent',{type:'touchMove',touchPoints:[{x:dragStart.x,y:dragStart.y+i*25}]},session);

+267

await send('Input.dispatchTouchEvent',{type:'touchEnd',touchPoints:[]},session);

+268

await tapAt(rect);

+269

const selected=(await evaluate('window.slateCopy.report()'))[0];

+270

assert.deepEqual(selected.mark,mark);

+271

assert.ok(selected.point.row<mark.row,'scroll then tap extends region into older rows');

+272

assert.ok(selected.text.includes('\n'));

+273

assert.equal(await writes(),'','touch selection never writes to the PTY');

+274

if(process.env.SLATE_TEST_SCREENSHOT_DIR){

+275

fs.mkdirSync(process.env.SLATE_TEST_SCREENSHOT_DIR,{recursive:true});

+276

const shot=await send('Page.captureScreenshot',{format:'png'},session);

+277

    fs.writeFileSync(path.join(process.env.SLATE_TEST_SCREENSHOT_DIR,'terminal-copy.png'),Buffer.from(shot.data,'base64'));

+278

}

+279

await touch(copyButton('cancel'));

+280

+281

// A full-screen app exposes its current screen, not unrelated main-screen history.

+282

await output('\x1b[?1049h\x1b[2J\x1b[Hfull screen app\x1b[?1000h');

+283

await touch(copyButton('start'));

+284

await hardware('Home',2); await hardware(' ',2); await hardware('End',2);

+285

const alternate=(await evaluate('window.slateCopy.report()'))[0].text;

+286

assert.ok(alternate.startsWith('full screen app'));

+287

assert.ok(!alternate.includes('row 000'));

+288

await hardware('g',2);

+289

assert.equal(await writes(),'');

+290

await output('\x1b[?1049l');

+291

+292

await touch(copyMenu); // Received-text badge is visible even while the menu is closed.

+293

  const tmuxFixture=process.env.SLATE_TEST_OSC52_FILE ? JSON.parse(fs.readFileSync(process.env.SLATE_TEST_OSC52_FILE,'utf8')) : null;

+294

const receivedText=tmuxFixture?.text || 'tmux clipboard café\nsecond line';

+295

await output(tmuxFixture?.sequence || ('\x1b]52;c;'+Buffer.from(receivedText).toString('base64')+'\x07'));

+296

await evaluate('window.slateRefresh()');

+297

assert.equal(await evaluate(`document.querySelector('${copyMenu}').classList.contains('copy-received')`),true);

+298

await touch(copyMenu);

+299

assert.equal(await evaluate(`document.querySelector('${copyButton('received')}').hidden`),false);

+300

await evaluate('window.failClipboard=true');

+301

await touch(copyButton('received'));

+302

assert.equal(await sgl('(slate-tmux-clip-staged)'),receivedText);

+303

await evaluate('window.failClipboard=false');

+304

await touch(copyButton('received'));

+305

await waitFor(`window.slateEval('(slate-tmux-clip-staged)') === ''`,'received copy acknowledgment');

+306

assert.equal((await evaluate('window.clipboardWrites')).at(-1),receivedText);

+307

assert.equal(await evaluate(`document.querySelector('${copyMenu}').classList.contains('copy-received')`),false);

+308

console.log('PASS tap/mark/scroll/tap, alternate-screen isolation, OSC 52 mobile take and failure retention');

+309

// Verify one real clipboard operation in the browser as well as the fault seam.

+310

const origin = await evaluate('location.origin');

+311

await send('Browser.grantPermissions',{origin,permissions:['clipboardReadWrite','clipboardSanitizedWrite']});

+312

  await evaluate(`Object.defineProperty(navigator,'clipboard',{configurable:true,value:window.realClipboard}); document.execCommand=window.realExecCommand;`);

+313

await output(tmuxFixture?.sequence || ('\x1b]52;c;'+Buffer.from(receivedText).toString('base64')+'\x07'));

+314

await evaluate('window.slateRefresh()');

+315

await touch(copyButton('received'));

+316

await waitFor(`window.slateEval('(slate-tmux-clip-staged)') === ''`, 'real browser clipboard write');

+317

assert.equal(await evaluate('navigator.clipboard.readText()'),receivedText);

+318

console.log('PASS real browser clipboard receives the exact terminal clipboard text');

+319

// Copy controls must focus their own pane before subsequent keyboard input.

+320

  await sgl('(begin (slate-dispatch "split-down") (open-view! (make-terminal-view "history-two" #{kind: pty: provider: compose-probe:})) (slate-refresh))');

+321

assert.equal(await evaluate('document.querySelectorAll(".pane").length'),2);

+322

// Desktop keeps compact controls in the existing header.

+323

await send('Emulation.setDeviceMetricsOverride',{width:1100,height:844,deviceScaleFactor:1,mobile:false},session);

+324

const otherStart = '.pane:not(.focused) .terminal-copy-header-tools [data-terminal-copy="start"]';

+325

const otherId = await evaluate(`document.querySelector('${otherStart}').closest('.pane').dataset.paneId`);

+326

await touch(otherStart);

+327

assert.equal(await evaluate('document.querySelector(".pane.focused").dataset.paneId'),otherId);

+328

await clear(); await hardware('x');

+329

assert.equal(await writes(),'','copying in another pane keeps input local');

+330

await hardware('Home',2); await hardware(' ',2); await hardware('End',2);

+331

assert.ok((await evaluate('window.slateCopy.report()'))[0].text.length>0);

+332

await hardware('g',2);

+333

assert.equal(await evaluate('window.slateCopy.report().length'),0);

+334

console.log('PASS copy controls focus their split pane and keep subsequent input local');

+335

assert.deepEqual(errors,[]);

+336

} finally {

+337

if (socket) socket.close();

+338

chrome.kill('SIGTERM');

+339

await Promise.race([chromeExit, sleep(2000)]);

+340

await new Promise(resolve => server.close(resolve));

+341

try { fs.rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); }

+342

catch (_) { /* Chrome helpers may finish touching the disposable profile late. */ }

+343

}

packages/slate/test/terminal-copy-test.mjsadded

@@ -0,0 +1,19 @@

+1

import assert from 'node:assert/strict';

+2

import { TerminalCopySelection } from '../assets/terminal-copy.mjs';

+3

const make = () => new TerminalCopySelection({ html: [], rows: ['alpha βeta', 'middle', 'last 😀 line'], cols: 20, top: 0, point: {row: 0,col: 0} });

+4

const model = make(); model.height = 2;

+5

model.key('C-Space'); model.key('M->');

+6

assert.equal(model.text(), 'alpha βeta\nmiddle\nlast 😀 line');

+7

assert.equal(model.top, 1);

+8

model.key('M-<'); model.key('M-f');

+9

assert.deepEqual(model.point, {row:0,col:5});

+10

model.key('M-f'); assert.deepEqual(model.point, {row:0,col:10});

+11

model.key('M-b'); assert.deepEqual(model.point, {row:0,col:6});

+12

model.setPoint(2, 6); model.setMark(); model.setPoint(0, 6);

+13

assert.equal(model.text(), 'βeta\nmiddle\nlast 😀');

+14

model.scroll(-1000); assert.equal(model.top,0);

+15

assert.equal(model.text(), 'βeta\nmiddle\nlast 😀', 'scrolling preserves a reversed selection');

+16

model.scroll(1000); assert.equal(model.top,1);

+17

model.setPoint(0,0); model.key('C-b'); assert.deepEqual(model.point,{row:0,col:0});

+18

model.key('M->'); model.key('C-f'); assert.deepEqual(model.point,{row:2,col:11});

+19

console.log('PASS frozen region: multi-page selection, reversed endpoints, Unicode, Emacs word motion, bounds');

packages/slate/test/terminal-geometry-browser-gate.mjsadded

@@ -0,0 +1,200 @@

+1

// Mobile resize settling and touch sensitivity against the shipped WASM provider.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import http from 'node:http';

+5

import os from 'node:os';

+6

import path from 'node:path';

+7

import { spawn } from 'node:child_process';

+8

+9

const root = path.resolve(import.meta.dirname, '../../..');

+10

const webRoot = process.env.SLATE_TEST_WEB_ROOT || path.join(root, 'build/web');

+11

assert.ok(fs.existsSync(path.join(webRoot, 'slate.wasm')), 'build/web/slate.wasm is required');

+12

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+13

const types = { '.html': 'text/html', '.js': 'text/javascript', '.mjs': 'text/javascript',

+14

'.wasm': 'application/wasm', '.json': 'application/json', '.svg': 'image/svg+xml',

+15

'.woff2': 'font/woff2' };

+16

const server = http.createServer((req, res) => {

+17

const relative = req.url.split('?')[0] === '/' ? 'index.html' : req.url.split('?')[0].slice(1);

+18

const target = path.resolve(webRoot, relative);

+19

if (!target.startsWith(webRoot + path.sep) || !fs.existsSync(target)) {

+20

res.writeHead(404).end(); return;

+21

}

+22

res.setHeader('content-type', types[path.extname(target)] || 'application/octet-stream');

+23

fs.createReadStream(target).pipe(res);

+24

});

+25

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+26

+27

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-compose-chrome-'));

+28

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+29

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+30

{ stdio: ['ignore', 'ignore', 'pipe'] });

+31

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+32

let socket;

+33

const errors = [];

+34

try {

+35

const activePort = path.join(profile, 'DevToolsActivePort');

+36

for (let i = 0; i < 120 && !fs.existsSync(activePort); i++) await sleep(50);

+37

assert.ok(fs.existsSync(activePort), 'Chrome did not expose DevTools');

+38

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+39

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+40

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+41

let nextId = 0;

+42

const pending = new Map();

+43

socket.onmessage = event => {

+44

const message = JSON.parse(event.data);

+45

if (message.method === 'Runtime.exceptionThrown')

+46

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+47

if (message.id && pending.has(message.id)) {

+48

const pair = pending.get(message.id); pending.delete(message.id);

+49

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

+50

}

+51

};

+52

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+53

const id = ++nextId;

+54

const timer = setTimeout(() => { pending.delete(id); reject(new Error('CDP timeout: ' + method)); }, 60000);

+55

pending.set(id, {resolve: value => { clearTimeout(timer); resolve(value); },

+56

reject: error => { clearTimeout(timer); reject(error); }});

+57

socket.send(JSON.stringify({ id, method, params, ...(sessionId ? { sessionId } : {}) }));

+58

});

+59

const target = await send('Target.createTarget', { url: 'about:blank' });

+60

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+61

const session = attached.sessionId;

+62

await send('Runtime.enable', {}, session);

+63

await send('Emulation.setDeviceMetricsOverride', {width:390,height:844,deviceScaleFactor:1,mobile:true}, session);

+64

await send('Emulation.setTouchEmulationEnabled', {enabled:true}, session);

+65

await send('Page.navigate', {

+66

url: process.env.SLATE_TEST_URL ||

+67

`http://127.0.0.1:${server.address().port}/?rbdebug&prediction-gate`

+68

}, session);

+69

const evaluate = async expression => {

+70

const result = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, session);

+71

    if (result.exceptionDetails) throw new Error(result.exceptionDetails.exception?.description || result.exceptionDetails.text);

+72

return result.result.value;

+73

};

+74

async function waitFor(expression, label) {

+75

for (let i = 0; i < 360; i++) {

+76

if (await evaluate(expression)) return;

+77

await sleep(100);

+78

}

+79

    const diagnostic = await evaluate(`({status:document.getElementById('status')?.textContent, body:document.body.innerText.slice(-2000)})`);

+80

throw new Error(`timeout waiting for ${label}; errors=${errors.join(' | ')}; page=${JSON.stringify(diagnostic)}`);

+81

}

+82

const dispatch = event => evaluate(`window.slateEval('(slate-dispatch "${event}")')`);

+83

+84

await waitFor(`document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+85

console.log('PASS browser boot');

+86

  const sgl = async code => {const value = await evaluate(`window.slateEval(${JSON.stringify(code)})`); if (/^(Error|error):/.test(value)) throw new Error(value); if (code.includes('(slate-refresh)')) await evaluate('window.slateRefresh()'); return value;};

+87

await waitFor(`window.slateEval('(slate-preferences-settled?)') === '1'`, 'preference restore');

+88

await waitFor(`!document.getElementById('splash')`, 'interactive app');

+89

await evaluate('document.fonts.ready.then(() => true)');

+90

await sgl('(import (slate provider) (slate modes terminal) (slate extend))');

+91

await sgl(`(begin

+92

(define compose-context #f)

+93

(define compose-writes "")

+94

(register-provider! compose-probe:

+95

#{ session-open: (lambda (source ctx)

+96

(set! compose-context ctx)

+97

#{ write: (lambda (bytes)

+98

(set! compose-writes (string-append compose-writes bytes))) }) })

+99

(open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:}))

+100

((dict-ref compose-context emit:) "$ ")

+101

(slate-refresh))`);

+102

  await waitFor(`document.querySelector('.accessory-key-deck')?.getAttribute('data-compose-target') === 'compose-one'`, 'terminal deck');

+103

+104

await send('Emulation.setFocusEmulationEnabled', {enabled:true}, session);

+105

await sgl(`(begin

+106

(define geometry-resizes 0)

+107

(define geometry-cols 0)

+108

(define geometry-rows 0)

+109

(register-provider! geometry-probe:

+110

#{session-open: (lambda (source ctx)

+111

(set! compose-context ctx)

+112

#{write: (lambda (bytes)

+113

(set! compose-writes (string-append compose-writes bytes)))

+114

resize: (lambda (cols rows)

+115

(set! geometry-resizes (+ geometry-resizes 1))

+116

(set! geometry-cols cols)

+117

(set! geometry-rows rows))})})

+118

(open-view! (make-terminal-view "geometry-probe" #{kind: pty: provider: geometry-probe:}))

+119

(slate-refresh))`);

+120

const count = () => sgl('(number->string geometry-resizes)');

+121

await waitFor(`window.slateEval('(number->string geometry-cols)') !== '0'`, 'initial terminal sizing');

+122

await sleep(250);

+123

const dimensions = () => evaluate(`(() => {

+124

    const el=document.querySelector('.term-content[data-term="geometry-probe"]') || document.querySelector('.term-content');

+125

const cs=getComputedStyle(el);

+126

return {

+127

      cols:Math.max(2,Math.floor((el.clientWidth-parseFloat(cs.paddingLeft)-parseFloat(cs.paddingRight))/parseFloat(cs.getPropertyValue('--cell-w')))),

+128

      rows:Math.max(1,Math.floor((el.clientHeight-parseFloat(cs.paddingTop)-parseFloat(cs.paddingBottom))/parseFloat(cs.getPropertyValue('--cell-h'))))

+129

};

+130

})()`);

+131

async function assertSize() {

+132

const expected = await dimensions();

+133

assert.equal(Number(await sgl('(number->string geometry-cols)')), expected.cols);

+134

assert.equal(Number(await sgl('(number->string geometry-rows)')), expected.rows);

+135

}

+136

for (const [from,to] of [[844,460],[460,844]]) {

+137

await sgl('(set! geometry-resizes 0)');

+138

// Drive the same viewport CSS variable used by Android keyboard events.

+139

const during = await evaluate(`(async () => {

+140

for(let i=1;i<=40;i++) {

+141

document.documentElement.style.setProperty('--vvh', (${from}+(${to}-${from})*i/40)+'px');

+142

await new Promise(requestAnimationFrame);

+143

}

+144

return window.slateEval('(number->string geometry-resizes)');

+145

})()`);

+146

assert.equal(during, '0', 'no PTY resize during continuous keyboard animation');

+147

await sleep(250);

+148

assert.equal(await count(), '1', 'one final PTY resize per keyboard animation');

+149

await assertSize();

+150

}

+151

await sgl('(set! geometry-resizes 0)');

+152

await send('Emulation.setDeviceMetricsOverride', {width:844,height:390,deviceScaleFactor:1,mobile:true}, session);

+153

await sleep(300);

+154

assert.equal(await count(), '1', 'orientation change reaches the provider once');

+155

await assertSize();

+156

await send('Emulation.setDeviceMetricsOverride', {width:390,height:844,deviceScaleFactor:1,mobile:true}, session);

+157

await sleep(300);

+158

await assertSize();

+159

  console.log('PASS keyboard show/hide coalesces to one final resize; orientation and initial sizing fit the actual terminal');

+160

+161

// Convert JSON control-character escapes to Sigil string syntax.

+162

  await sgl('((dict-ref compose-context emit:) '+JSON.stringify('\x1b[?1000h\x1b[?1006h').replace(/\\u([0-9a-f]{4})/g,'\\x$1;')+')');

+163

await evaluate('window.slateTerm.arm("geometry-test")');

+164

  const point = await evaluate(`(() => {const el=document.querySelector('.term-content'); const r=el.getBoundingClientRect(); return {x:r.x+60,y:r.y+r.height/2,cellH:parseFloat(getComputedStyle(el).getPropertyValue('--cell-h'))};})()`);

+165

const writes = () => sgl('compose-writes');

+166

const clear = () => sgl('(set! compose-writes "")');

+167

const wheelReports = text => [...text.matchAll(/\x1b\[<(64|65);\d+;\d+M/g)].map(match => Number(match[1]));

+168

async function drag(distance, steps=8) {

+169

await clear();

+170

await send('Input.dispatchTouchEvent',{type:'touchStart',touchPoints:[{x:point.x,y:point.y}]},session);

+171

for(let i=1;i<=steps;i++) await send('Input.dispatchTouchEvent',{

+172

type:'touchMove',touchPoints:[{x:point.x,y:point.y+distance*i/steps}]

+173

},session);

+174

await send('Input.dispatchTouchEvent',{type:'touchEnd',touchPoints:[]},session);

+175

await sleep(60);

+176

return await writes();

+177

}

+178

assert.equal(wheelReports(await drag(8,1)).length,0,'small movement remains a tap');

+179

const distance = Math.max(24, point.cellH*3)*3.2;

+180

for (const sign of [1,-1]) {

+181

const result = await drag(sign*distance);

+182

    assert.deepEqual(wheelReports(result),Array(6).fill(sign>0?64:65),'same travel produces six reports instead of three');

+183

const before = result;

+184

await sleep(200);

+185

assert.equal(await writes(),before,'no scroll reports after touch ends');

+186

}

+187

await clear();

+188

await send('Input.dispatchMouseEvent', {type:'mouseWheel',x:point.x,y:point.y,deltaX:0,deltaY:-100}, session);

+189

await sleep(100);

+190

assert.deepEqual(wheelReports(await writes()),[64],'physical mouse wheel stays at one report per detent');

+191

  console.log('PASS trusted touch scrolls in both directions at 2x sensitivity; tap slop, stop behavior and physical wheel preserved');

+192

assert.deepEqual(errors, []);

+193

} finally {

+194

if (socket) socket.close();

+195

chrome.kill('SIGTERM');

+196

await Promise.race([chromeExit, sleep(2000)]);

+197

await new Promise(resolve => server.close(resolve));

+198

try { fs.rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); }

+199

catch (_) { /* Chrome helpers may finish touching the disposable profile late. */ }

+200

}

packages/slate/test/terminal-mobile-input-policy-test.mjsadded

@@ -0,0 +1,33 @@

+1

import assert from 'node:assert/strict';

+2

import fs from 'node:fs';

+3

+4

const html = fs.readFileSync(new URL('../assets/index.html', import.meta.url), 'utf8');

+5

const accessory = fs.readFileSync(

+6

new URL('../src/slate/accessory.sgl', import.meta.url), 'utf8');

+7

+8

assert.match(html, /cap\.setAttribute$'type', 'password'$/);

+9

assert.match(html, /cap\.setAttribute$'autocorrect', 'off'$/);

+10

assert.match(html, /cap\.setAttribute$'autocapitalize', 'none'$/);

+11

assert.match(html, /cap\.setAttribute$'spellcheck', 'false'$/);

+12

+13

for (const label of ['ESC', '/', '-', 'HOME', '↑', 'END', 'PGUP',

+14

'TAB', 'CTRL', 'ALT', '←', '↓', '→', 'PGDN']) {

+15

assert.ok(accessory.includes(`label: "${label}"`), `missing terminal key ${label}`);

+16

}

+17

assert.match(accessory, /class "accessory-key-deck"/);

+18

assert.match(html, /grid-template-columns: repeat\(7,/);

+19

assert.match(html, /height: 32px/);

+20

assert.match(html, /border-radius: 0/);

+21

assert.match(html, /background: var$--key-deck-bg$/);

+22

assert.match(accessory, /data-kbd-toggle "1"/);

+23

assert.match(html, /closest$'\.accessory-bar, \.accessory-key-deck'$/);

+24

assert.match(html, /@media $max-width: 767px$ \{\s*\.accessory-key-deck/s);

+25

assert.match(html, /inputType === 'deleteContentBackward'/);

+26

assert.match(html, /navigator\.vibrate$35$/);

+27

assert.match(html, /const CAP_SENTINEL = '\\u200b'/);

+28

assert.match(html, /armCapture$cap$/);

+29

assert.match(html, /--bottom-chrome-h: calc$100px \+ env\(safe-area-inset-bottom$\)/);

+30

assert.match(html, /\.ledge-msgs, \.ledge-notif, \.ledge-ind[\s\S]*min-width: 36px; height: 36px/);

+31

assert.match(html, /var$--bottom-chrome-h, var\(--ledge-h$\)/);

+32

+33

console.log('terminal mobile input: literal capture and two-row key deck');

packages/slate/test/terminal-prediction-browser-gate.mjsadded

@@ -0,0 +1,255 @@

+1

// E2 extraction gate: drive the command module through the shipped WASM.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import http from 'node:http';

+5

import os from 'node:os';

+6

import path from 'node:path';

+7

import { spawn } from 'node:child_process';

+8

+9

const root = path.resolve(import.meta.dirname, '../../..');

+10

const webRoot = process.env.SLATE_TEST_WEB_ROOT || path.join(root, 'build/web');

+11

assert.ok(fs.existsSync(path.join(webRoot, 'slate.wasm')), 'build/web/slate.wasm is required');

+12

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+13

const types = { '.html': 'text/html', '.js': 'text/javascript', '.mjs': 'text/javascript',

+14

'.wasm': 'application/wasm', '.json': 'application/json', '.svg': 'image/svg+xml',

+15

'.woff2': 'font/woff2' };

+16

const server = http.createServer((req, res) => {

+17

const relative = req.url.split('?')[0] === '/' ? 'index.html' : req.url.split('?')[0].slice(1);

+18

const target = path.resolve(webRoot, relative);

+19

if (!target.startsWith(webRoot + path.sep) || !fs.existsSync(target)) {

+20

res.writeHead(404).end(); return;

+21

}

+22

res.setHeader('content-type', types[path.extname(target)] || 'application/octet-stream');

+23

fs.createReadStream(target).pipe(res);

+24

});

+25

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+26

+27

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-prediction-chrome-'));

+28

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+29

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+30

{ stdio: ['ignore', 'ignore', 'pipe'] });

+31

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+32

let socket;

+33

const errors = [];

+34

try {

+35

const activePort = path.join(profile, 'DevToolsActivePort');

+36

for (let i = 0; i < 120 && !fs.existsSync(activePort); i++) await sleep(50);

+37

assert.ok(fs.existsSync(activePort), 'Chrome did not expose DevTools');

+38

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+39

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+40

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+41

let nextId = 0;

+42

const pending = new Map();

+43

socket.onmessage = event => {

+44

const message = JSON.parse(event.data);

+45

if (message.method === 'Runtime.exceptionThrown')

+46

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+47

if (message.id && pending.has(message.id)) {

+48

const pair = pending.get(message.id); pending.delete(message.id);

+49

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

+50

}

+51

};

+52

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+53

const id = ++nextId;

+54

const timer = setTimeout(() => { pending.delete(id); reject(new Error('CDP timeout: ' + method)); }, 15000);

+55

pending.set(id, {resolve: value => { clearTimeout(timer); resolve(value); },

+56

reject: error => { clearTimeout(timer); reject(error); }});

+57

socket.send(JSON.stringify({ id, method, params, ...(sessionId ? { sessionId } : {}) }));

+58

});

+59

const target = await send('Target.createTarget', { url: 'about:blank' });

+60

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+61

const session = attached.sessionId;

+62

await send('Runtime.enable', {}, session);

+63

// Prediction deliberately clears on window blur. Keep this isolated CDP tab

+64

// focused so host window-manager events cannot interrupt the latency probe.

+65

await send('Emulation.setFocusEmulationEnabled', {enabled:true}, session);

+66

await send('Page.bringToFront', {}, session);

+67

await send('Page.navigate', {

+68

url: process.env.SLATE_TEST_URL ||

+69

`http://127.0.0.1:${server.address().port}/?rbdebug&prediction-gate`

+70

}, session);

+71

const evaluate = async expression => {

+72

const result = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, session);

+73

    if (result.exceptionDetails) throw new Error(result.exceptionDetails.exception?.description || result.exceptionDetails.text);

+74

return result.result.value;

+75

};

+76

async function waitFor(expression, label) {

+77

for (let i = 0; i < 360; i++) {

+78

if (await evaluate(expression)) return;

+79

await sleep(100);

+80

}

+81

    const diagnostic = await evaluate(`({status:document.getElementById('status')?.textContent, body:document.body.innerText.slice(-2000)})`);

+82

throw new Error(`timeout waiting for ${label}; errors=${errors.join(' | ')}; page=${JSON.stringify(diagnostic)}`);

+83

}

+84

const dispatch = event => evaluate(`window.slateEval('(slate-dispatch "${event}")')`);

+85

+86

await waitFor(`document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+87

console.log('PASS browser boot');

+88

  const sgl = async code => {const value = await evaluate(`window.slateEval(${JSON.stringify(code)})`); if (/^(Error|error):/.test(value)) throw new Error(value); return value;};

+89

await waitFor(`window.slateEval('(slate-preferences-settled?)') === '1'`, 'preference restore');

+90

await waitFor(`!document.getElementById('splash')`, 'interactive app');

+91

await evaluate('document.fonts.ready.then(() => true)');

+92

await sgl('(import (slate provider) (slate modes terminal) (slate extend))');

+93

await sgl(`(begin

+94

(define prediction-context #f)

+95

(define prediction-writes "")

+96

(register-provider! prediction-probe:

+97

#{ session-open:

+98

(lambda (source ctx)

+99

(set! prediction-context ctx)

+100

#{ write: (lambda (bytes)

+101

(set! prediction-writes (string-append prediction-writes bytes))) }) })

+102

(open-view! (make-terminal-view "prediction-probe"

+103

#{ kind: pty: provider: prediction-probe: }))

+104

((dict-ref prediction-context emit:) "$ ")

+105

(slate-refresh))`);

+106

await evaluate('window.slateTerm.ensure(); window.slateTerm.flush()');

+107

await waitFor(`document.querySelector('[data-term="prediction-probe"] .tr')`, 'probe terminal');

+108

assert.equal((await evaluate('window.slatePredictEcho.report()')).enabled, false);

+109

await dispatch('terminal-predictive-echo:toggle');

+110

await evaluate('window.slateTerm.ensure(); window.slateTerm.flush()');

+111

assert.equal((await evaluate('window.slatePredictEcho.report()')).enabled, true);

+112

console.log('PASS prediction option and probe setup');

+113

  const rect = await evaluate(`(() => {const r=document.querySelector('[data-term="prediction-probe"]').getBoundingClientRect(); return {x:r.x+30,y:r.y+20}})()`);

+114

await send('Input.dispatchMouseEvent', {type:'mousePressed', ...rect, button:'left', clickCount:1}, session);

+115

await send('Input.dispatchMouseEvent', {type:'mouseReleased', ...rect, button:'left', clickCount:1}, session);

+116

async function key(value) {

+117

const params = {key: value, code: 'Key'+value.toUpperCase(), text: value};

+118

await send('Input.dispatchKeyEvent', {type:'keyDown', ...params}, session);

+119

await send('Input.dispatchKeyEvent', {type:'keyUp', ...params}, session);

+120

}

+121

async function output(text) {

+122

const literal = JSON.stringify(text).replace(/\\u([0-9a-f]{4})/g, '\\x$1;');

+123

await sgl(`((dict-ref prediction-context emit:) ${literal})`);

+124

await evaluate('window.slateTerm.flush()');

+125

}

+126

const overlay = () => evaluate(`document.querySelector('.term-prediction')?.textContent || ''`);

+127

const report = () => evaluate('window.slatePredictEcho.report()');

+128

for (const ch of 'ab') {

+129

await key(ch);

+130

assert.equal(await overlay(), '');

+131

await sleep(190);

+132

await output(ch);

+133

}

+134

assert.equal((await report()).terminals[0].armed, true, 'two real delayed echoes arm prediction');

+135

await key('c');

+136

assert.equal(await overlay(), 'c');

+137

if (process.env.SLATE_TEST_SCREENSHOT_DIR) {

+138

fs.mkdirSync(process.env.SLATE_TEST_SCREENSHOT_DIR, {recursive: true});

+139

const shot = await send('Page.captureScreenshot', {format: 'png'}, session);

+140

fs.writeFileSync(path.join(process.env.SLATE_TEST_SCREENSHOT_DIR, 'prediction.png'),

+141

Buffer.from(shot.data, 'base64'));

+142

}

+143

const realFrame = await sgl('(slate-term-take-frame "prediction-probe" 1)');

+144

assert.ok(realFrame.includes('\np\t$ ab'), 'authoritative VT has no predicted c');

+145

await sleep(260);

+146

assert.equal(await evaluate(`document.querySelector('.term-prediction').classList.contains('stale')`), true);

+147

await output('c');

+148

assert.equal(await overlay(), '', 'authoritative echo removes overlay');

+149

assert.equal((await report()).terminals[0].confirmed, 3);

+150

await key('d');

+151

assert.equal(await overlay(), 'd');

+152

await output('X');

+153

assert.equal(await overlay(), '', 'mismatched echo rolls back');

+154

assert.equal((await report()).terminals[0].mismatches, 1);

+155

assert.equal(await sgl('prediction-writes'), 'abcd', 'prediction sends no extra input');

+156

+157

// Performance capture suppresses prediction even if the saved option is on.

+158

await evaluate('window.slatePerf.start()');

+159

assert.equal((await report()).suppressed, true);

+160

const count = (await report()).overlayWrites;

+161

for (const ch of 'efg') {

+162

await key(ch);

+163

await sleep(190);

+164

await output(ch);

+165

}

+166

assert.equal(await overlay(), '');

+167

assert.equal((await report()).overlayWrites, count);

+168

await evaluate('window.slatePerf.stop()');

+169

+170

// A mode-only frame cannot arm prediction without confirmed input echoes.

+171

await output('\x1b[?1000h');

+172

await key('h');

+173

assert.equal(await overlay(), '');

+174

await output('\x1b[?1000l');

+175

if (process.env.SLATE_TEST_TMUX_FIXTURE) {

+176

const fixture=JSON.parse(fs.readFileSync(process.env.SLATE_TEST_TMUX_FIXTURE,'utf8'));

+177

await output(Buffer.from(fixture.boot,'base64').toString('utf8'));

+178

// An actual tmux client enables alternate screen and mouse tracking even

+179

// though its foreground program is an ordinary interactive shell.

+180

const tmuxFrame=await sgl('(slate-term-take-frame "prediction-probe" 1)');

+181

assert.equal(tmuxFrame.split('\n')[0].split(' ')[7],'1','tmux permits echo learning');

+182

await sleep(1100); // previous mismatch backoff must expire before training

+183

for (const [index,echo] of fixture.echoes.entries()) {

+184

await key(echo.key);

+185

assert.equal(await overlay(),index===2?echo.key:'','tmux learns before predicting');

+186

await sleep(190);

+187

await output(Buffer.from(echo.bytes,'base64').toString('utf8'));

+188

assert.equal(await overlay(),'','actual tmux echo reconciles the overlay');

+189

}

+190

console.log('PASS real tmux alternate-screen/mouse-mode echo learns and predicts without modifying authority');

+191

}

+192

// Codex-style full redraws: Unicode prompt, placeholder, then ASCII input.

+193

// These are synthetic VT bytes, not a recording of a live Codex session.

+194

const redrawCodex = text => output('\x1b[?1049h\x1b[?25l\x1b[H\x1b[2J' +

+195

'\x1b[2;1H› ' + text + '\x1b[2;' + (3 + text.length) + 'H\x1b[?25h');

+196

await redrawCodex('Ask anything');

+197

await output('\x1b[2;3H');

+198

await sleep(1100);

+199

await key('a');

+200

assert.equal(await overlay(), '', 'Codex placeholder is not predicted over');

+201

await sleep(190);

+202

await redrawCodex('a');

+203

for (const [index, ch] of [...'bc'].entries()) {

+204

await key(ch);

+205

assert.equal(await overlay(), '', 'Codex redraws must establish echo learning');

+206

await sleep(190);

+207

await redrawCodex('abc'.slice(0, index + 2));

+208

}

+209

assert.equal((await report()).terminals[0].armed, true, 'Codex prompt allows learning');

+210

const writesBeforeCodexPrediction = await sgl('prediction-writes');

+211

await key('d');

+212

assert.equal(await overlay(), 'd');

+213

assert.ok(await evaluate(`getComputedStyle(document.querySelector('.term-prediction'),

+214

'::after').boxShadow !== 'none'`), 'predicted cursor has its underscore');

+215

const codexFrame = await sgl('(slate-term-take-frame "prediction-probe" 1)');

+216

assert.equal(codexFrame.split('\n').find(line => line.startsWith('p\t'))?.slice(2).trimEnd(),

+217

'› abc', 'Codex prediction leaves the authoritative row unchanged');

+218

await sleep(190);

+219

await redrawCodex('abcd');

+220

assert.equal(await overlay(), '', 'Codex redraw reconciles the prediction');

+221

assert.equal(await sgl('prediction-writes'), writesBeforeCodexPrediction + 'd');

+222

console.log('PASS Codex-style Unicode prompt, placeholder, full redraws and predicted cursor underscore');

+223

+224

await dispatch('terminal-predictive-echo:toggle');

+225

await evaluate('window.slateTerm.ensure(); window.slateTerm.flush()');

+226

assert.equal((await report()).enabled, false);

+227

// Run the VT-side regression cases in the WASM artifact, whose native VT

+228

// bindings are present (the current standalone test harness lacks them).

+229

await sgl('(import (sigil string))');

+230

await sgl(`(begin

+231

(define prediction-check-count 0)

+232

(define (check name got want)

+233

(unless (equal? got want) (error name got want))

+234

(set! prediction-check-count (+ prediction-check-count 1)))

+235

(define (check-true name got) (check name (and got #t) #t))

+236

(define (contains? s sub) (if (string-contains? s sub) #t #f))

+237

(define (header-field frame n)

+238

(list-ref (string-split (car (string-split frame (string (integer->char 10)))) " ") n))

+239

(define ESC-S (string (integer->char 27))))`);

+240

const source = fs.readFileSync(path.join(root, 'packages/slate/test/terminal-test.sgl'), 'utf8');

+241

const marker = ';; Predictive echo consumes accepted terminal writes';

+242

assert.ok(source.includes(marker));

+243

await sgl(source.slice(source.indexOf(marker)));

+244

assert.equal(await sgl('(number->string prediction-check-count)'), '12');

+245

assert.deepEqual(errors, [], `artifact raised exceptions: ${errors.join(' | ')}`);

+246

  console.log('PASS predictive echo artifact: default/toggle, real keys, authoritative reconciliation, stale/mismatch, no extra writes, capture suppression, mode safety');

+247

+248

} finally {

+249

if (socket) socket.close();

+250

chrome.kill('SIGTERM');

+251

await Promise.race([chromeExit, sleep(2000)]);

+252

await new Promise(resolve => server.close(resolve));

+253

try { fs.rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); }

+254

catch (_) { /* Chrome helpers may finish touching the disposable profile late. */ }

+255

}

packages/slate/test/terminal-prediction-test.mjsadded

@@ -0,0 +1,175 @@

+1

import assert from 'node:assert/strict';

+2

import { TerminalPrediction } from '../assets/terminal-prediction.mjs';

+3

+4

let passed = 0;

+5

function test(name, body) {

+6

body();

+7

passed++;

+8

console.log(`PASS ${name}`);

+9

}

+10

function frame(text = '$ ', serial = 0, extra = {}) {

+11

return { row: 0, col: text.length, cols: 80, serial,

+12

safe: true, text: text.padEnd(80, ' '), ...extra };

+13

}

+14

function warm() {

+15

const model = new TerminalPrediction();

+16

model.update(frame(), 0);

+17

model.input('a', 0, 1);

+18

assert.equal(model.overlay(2), null);

+19

model.update(frame('$ a', 1), 201);

+20

model.input('b', 1, 220);

+21

model.update(frame('$ ab', 2), 420);

+22

assert.equal(model.armed, true);

+23

return model;

+24

}

+25

+26

test('two independent slow echoes arm an append-only overlay', () => {

+27

const model = warm();

+28

const original = { ...model.frame };

+29

model.input('c', 2, 430);

+30

model.input('d', 2, 440);

+31

assert.equal(model.overlay(445).text, 'cd');

+32

assert.deepEqual(model.frame, original, 'prediction must not change authority');

+33

model.update(frame('$ abc', 3), 630);

+34

assert.equal(model.overlay(631).text, 'd');

+35

assert.equal(model.overlay(631).col, 5);

+36

model.update(frame('$ abcd', 4), 640);

+37

assert.equal(model.overlay(641), null);

+38

assert.equal(model.stats.confirmed, 4);

+39

});

+40

+41

test('one coalesced output burst cannot arm prediction', () => {

+42

const model = new TerminalPrediction();

+43

model.update(frame(), 0);

+44

model.input('a', 0, 1);

+45

model.input('b', 0, 2);

+46

model.update(frame('$ ab', 1), 200);

+47

assert.equal(model.stats.confirmed, 2);

+48

assert.equal(model.armed, false);

+49

});

+50

+51

test('Codex prompt learns echoes after its placeholder disappears', () => {

+52

const model = new TerminalPrediction();

+53

model.update(frame('› Ask anything', 0, {col: 2}), 0);

+54

model.input('a', 0, 1);

+55

assert.equal(model.pending.length, 0, 'placeholder prevents append prediction');

+56

model.update(frame('› a', 1), 201);

+57

for (const [index, key] of [...'bc'].entries()) {

+58

model.input(key, index + 1, 220 + index * 220);

+59

assert.equal(model.overlay(221 + index * 220), null);

+60

model.update(frame('› a' + 'bc'.slice(0, index + 1), index + 2), 420 + index * 220);

+61

}

+62

assert.equal(model.armed, true);

+63

model.input('d', 3, 660);

+64

assert.equal(model.overlay(661).text, 'd');

+65

assert.equal(model.overlay(661).col, 5, 'prompt glyph occupies one cell');

+66

model.update(frame('› abcd', 4), 860);

+67

assert.equal(model.overlay(861), null);

+68

assert.equal(model.stats.confirmed, 3);

+69

});

+70

+71

for (const text of ['界 ', 'e\u0301 ', '😀 ', '› 界 '])

+72

test(`ambiguous string/cell offsets remain unsafe: ${JSON.stringify(text)}`, () => {

+73

assert.equal(new TerminalPrediction().safe(frame(text)), false);

+74

});

+75

+76

test('an unchanged frame cannot confirm repeated text already on screen', () => {

+77

const model = warm();

+78

model.input('b', 2, 430);

+79

model.update(frame('$ ab', 2), 500);

+80

assert.equal(model.pending.length, 1);

+81

assert.equal(model.stats.confirmed, 2);

+82

});

+83

+84

for (const [name, next] of [

+85

['wrong cursor position', frame('$ abcc', 3)],

+86

['matching suffix on another row', frame('$ abc', 3, {row: 1})],

+87

['changed prefix with matching echo suffix', frame('! abc', 3)],

+88

['wrong echoed character', frame('$ abx', 3)],

+89

['output without cursor advancement', frame('$ ab', 3)],

+90

['matching text without fresh output', frame('$ abc', 2)],

+91

]) test(`reject ${name}`, () => {

+92

const model = warm();

+93

model.input('c', 2, 430);

+94

model.update(next, 630);

+95

assert.equal(model.overlay(631), null);

+96

assert.equal(model.armed, false);

+97

assert.equal(model.stats.mismatches, 1);

+98

assert.equal(model.stats.confirmed, 2);

+99

});

+100

+101

test('mismatch imposes backoff even after two new slow echoes', () => {

+102

const model = warm();

+103

model.input('c', 2, 430);

+104

model.update(frame('$ abx', 3), 630);

+105

model.input('d', 3, 640);

+106

model.update(frame('$ abxd', 4), 840);

+107

model.input('e', 4, 850);

+108

model.update(frame('$ abxde', 5), 1050);

+109

assert.equal(model.armed, false);

+110

});

+111

+112

test('stale overlay fades and expires without any server output', () => {

+113

const model = warm();

+114

model.input('c', 2, 430);

+115

assert.equal(model.overlay(679).stale, false);

+116

assert.equal(model.overlay(680).stale, true);

+117

assert.equal(model.overlay(2430), null);

+118

assert.equal(model.pending.length, 0);

+119

assert.equal(model.stats.expired, 1);

+120

});

+121

+122

test('late warming echoes cannot arm after timeout', () => {

+123

const model = warm();

+124

model.reset(430);

+125

model.input('c', 2, 440);

+126

model.update(frame('$ abc', 3), 3000);

+127

assert.equal(model.armed, false);

+128

assert.equal(model.stats.confirmed, 2);

+129

});

+130

+131

for (const key of ['', '\r', '\x7f', '\t', '\x1b[A', 'é', '😀', 'ab'])

+132

test(`editing, control, paste or non-ASCII input resets: ${JSON.stringify(key)}`, () => {

+133

const model = warm();

+134

model.input('c', 2, 430);

+135

model.input(key, 2, 431);

+136

assert.equal(model.overlay(432), null);

+137

assert.equal(model.armed, false);

+138

});

+139

+140

test('Enter followed by a no-echo prompt never previews its input', () => {

+141

const model = warm();

+142

model.input('\r', 2, 430);

+143

model.update(frame('Password: ', 3), 630);

+144

for (const key of 'secret') model.input(key, 3, 640);

+145

assert.equal(model.overlay(650), null);

+146

assert.equal(model.armed, false);

+147

});

+148

+149

for (const extra of [{safe: false}, {text: 'é'.padEnd(80, ' ')},

+150

{text: '$ ab text'.padEnd(80, ' ')}, {col: 79}])

+151

test(`unsafe state abandons predictions: ${JSON.stringify(extra)}`, () => {

+152

const model = warm();

+153

model.input('c', 2, 430);

+154

model.update(frame('$ ab', 2, extra), 431);

+155

assert.equal(model.overlay(432), null);

+156

assert.equal(model.armed, false);

+157

});

+158

+159

test('input against an unpainted output serial is not predicted', () => {

+160

const model = warm();

+161

model.input('c', 3, 430);

+162

assert.equal(model.overlay(431), null);

+163

assert.equal(model.pending.length, 0);

+164

});

+165

+166

test('two fast echoes disarm prediction', () => {

+167

const model = warm();

+168

model.input('c', 2, 430);

+169

model.update(frame('$ abc', 3), 450);

+170

model.input('d', 3, 460);

+171

model.update(frame('$ abcd', 4), 480);

+172

assert.equal(model.armed, false);

+173

});

+174

+175

console.log(`${passed} predictive echo checks passed`);

packages/slate/test/terminal-reattach-browser-gate.mjsadded

@@ -0,0 +1,179 @@

+1

// Terminal: Reattach picker against the real browser command and provider seam.

+2

import assert from 'node:assert/strict';

+3

import fs from 'node:fs';

+4

import http from 'node:http';

+5

import os from 'node:os';

+6

import path from 'node:path';

+7

import { spawn } from 'node:child_process';

+8

+9

const root = path.resolve(import.meta.dirname, '../../..');

+10

const webRoot = process.env.SLATE_TEST_WEB_ROOT || path.join(root, 'build/web');

+11

assert.ok(fs.existsSync(path.join(webRoot, 'slate.wasm')), 'build/web/slate.wasm is required');

+12

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+13

const types = { '.html': 'text/html', '.js': 'text/javascript', '.mjs': 'text/javascript',

+14

'.wasm': 'application/wasm', '.json': 'application/json', '.svg': 'image/svg+xml',

+15

'.woff2': 'font/woff2' };

+16

const server = http.createServer((req, res) => {

+17

const relative = req.url.split('?')[0] === '/' ? 'index.html' : req.url.split('?')[0].slice(1);

+18

const target = path.resolve(webRoot, relative);

+19

if (!target.startsWith(webRoot + path.sep) || !fs.existsSync(target)) {

+20

res.writeHead(404).end(); return;

+21

}

+22

res.setHeader('content-type', types[path.extname(target)] || 'application/octet-stream');

+23

fs.createReadStream(target).pipe(res);

+24

});

+25

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+26

+27

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-compose-chrome-'));

+28

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+29

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+30

{ stdio: ['ignore', 'ignore', 'pipe'] });

+31

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+32

let socket;

+33

const errors = [];

+34

try {

+35

const activePort = path.join(profile, 'DevToolsActivePort');

+36

for (let i = 0; i < 120 && !fs.existsSync(activePort); i++) await sleep(50);

+37

assert.ok(fs.existsSync(activePort), 'Chrome did not expose DevTools');

+38

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+39

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+40

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+41

let nextId = 0;

+42

const pending = new Map();

+43

socket.onmessage = event => {

+44

const message = JSON.parse(event.data);

+45

if (message.method === 'Runtime.exceptionThrown')

+46

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+47

if (message.id && pending.has(message.id)) {

+48

const pair = pending.get(message.id); pending.delete(message.id);

+49

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

+50

}

+51

};

+52

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+53

const id = ++nextId;

+54

const timer = setTimeout(() => { pending.delete(id); reject(new Error('CDP timeout: ' + method)); }, 60000);

+55

pending.set(id, {resolve: value => { clearTimeout(timer); resolve(value); },

+56

reject: error => { clearTimeout(timer); reject(error); }});

+57

socket.send(JSON.stringify({ id, method, params, ...(sessionId ? { sessionId } : {}) }));

+58

});

+59

const target = await send('Target.createTarget', { url: 'about:blank' });

+60

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+61

const session = attached.sessionId;

+62

await send('Runtime.enable', {}, session);

+63

await send('Emulation.setDeviceMetricsOverride', {width:390,height:844,deviceScaleFactor:1,mobile:true}, session);

+64

await send('Emulation.setTouchEmulationEnabled', {enabled:true}, session);

+65

await send('Page.navigate', {

+66

url: process.env.SLATE_TEST_URL ||

+67

`http://127.0.0.1:${server.address().port}/?rbdebug&prediction-gate`

+68

}, session);

+69

const evaluate = async expression => {

+70

const result = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, session);

+71

    if (result.exceptionDetails) throw new Error(result.exceptionDetails.exception?.description || result.exceptionDetails.text);

+72

return result.result.value;

+73

};

+74

async function waitFor(expression, label) {

+75

for (let i = 0; i < 360; i++) {

+76

if (await evaluate(expression)) return;

+77

await sleep(100);

+78

}

+79

    const diagnostic = await evaluate(`({status:document.getElementById('status')?.textContent, body:document.body.innerText.slice(-2000)})`);

+80

throw new Error(`timeout waiting for ${label}; errors=${errors.join(' | ')}; page=${JSON.stringify(diagnostic)}`);

+81

}

+82

const dispatch = event => evaluate(`window.slateEval('(slate-dispatch "${event}")')`);

+83

+84

await waitFor(`document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+85

console.log('PASS browser boot');

+86

  const sgl = async code => {const value = await evaluate(`window.slateEval(${JSON.stringify(code)})`); if (/^(Error|error):/.test(value)) throw new Error(value); if (code.includes('(slate-refresh)')) await evaluate('window.slateRefresh()'); return value;};

+87

await waitFor(`window.slateEval('(slate-preferences-settled?)') === '1'`, 'preference restore');

+88

await waitFor(`!document.getElementById('splash')`, 'interactive app');

+89

await evaluate('document.fonts.ready.then(() => true)');

+90

await sgl('(import (slate provider) (slate modes terminal) (slate extend))');

+91

await sgl(`(begin

+92

(define compose-context #f)

+93

(define compose-writes "")

+94

(register-provider! compose-probe:

+95

#{ session-open: (lambda (source ctx)

+96

(set! compose-context ctx)

+97

#{ write: (lambda (bytes)

+98

(set! compose-writes (string-append compose-writes bytes))) }) })

+99

(open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:}))

+100

((dict-ref compose-context emit:) "$ ")

+101

(slate-refresh))`);

+102

  await waitFor(`document.querySelector('.accessory-key-deck')?.getAttribute('data-compose-target') === 'compose-one'`, 'terminal deck');

+103

+104

await send('Emulation.setFocusEmulationEnabled', {enabled:true}, session);

+105

  await sgl('(import (slate commands terminal) (slate providers node) (slate state) (slate main) (slate command) (slate view))');

+106

// Intercept only the catalog RPC; use the production command/prompt/reducer.

+107

await sgl(`(begin

+108

(define picker-state #f)

+109

(install-builtin-command! "picker-snapshot" "Test snapshot" "test" '(test picker)

+110

(lambda (state) (set! picker-state state) state))

+111

(define (slate-state) (slate-dispatch "picker-snapshot") picker-state)

+112

(define picker-ready #f)

+113

(define picker-error #f)

+114

(define picker-opens 0)

+115

(set! node-list-sessions!

+116

(lambda (ready error) (set! picker-ready ready) (set! picker-error error)))

+117

(register-provider! local:

+118

#{session-open: (lambda (source ctx)

+119

(set! picker-opens (+ picker-opens 1))

+120

#{remote-id: (lambda () (dict-ref source attach: #f))

+121

write: (lambda (bytes) #t)})}))`);

+122

await dispatch('terminal-reattach');

+123

await sgl(`(picker-ready #{catalog-version: 1 sessions: #[

+124

#{sid: "s-1111111111111111" kind: "pty" alive: #t attached: #f

+125

command: "bash" cwd: "/projects" idle: 3600}

+126

#{sid: "s-2222222222222222" kind: "process" alive: #t}

+127

#{sid: "s-3333333333333333" kind: "pty" alive: #f}] unavailable: 0})`);

+128

await evaluate('window.slateRefresh()');

+129

console.log('PASS catalog reply populated live terminal rows');

+130

const candidates = () => sgl('(number->string (length (terminal-session-candidates (slate-state))))');

+131

assert.equal(await candidates(),'1','picker includes only live terminal sessions');

+132

assert.equal(await sgl('(dict-ref (car (terminal-session-candidates (slate-state))) annotation: "")'),

+133

'detached · idle 1h · /projects');

+134

  await waitFor("document.body.innerText.includes('Reattach terminal') && document.body.innerText.includes('s-1111111111111111')", 'rendered picker row');

+135

if (process.env.SLATE_TEST_SCREENSHOT) {

+136

const shot=await send('Page.captureScreenshot',{format:'png'},session);

+137

fs.writeFileSync(process.env.SLATE_TEST_SCREENSHOT,Buffer.from(shot.data,'base64'));

+138

}

+139

await dispatch('selector-enter');

+140

await waitFor(`window.slateEval('(number->string picker-opens)') === '1'`, 'selected session attachment');

+141

assert.equal(await sgl('(dict-ref (view-source (active-view (slate-state))) attach: #f)'), 's-1111111111111111');

+142

const name = await sgl('(view-name (active-view (slate-state)))');

+143

await dispatch('terminal-reattach');

+144

  await sgl('(picker-ready #{catalog-version: 1 sessions: #[#{sid: "s-1111111111111111" kind: "pty" alive: #t attached: #t command: "bash" idle: 0}]})');

+145

await dispatch('selector-pick:0');

+146

assert.equal(await sgl('(number->string picker-opens)'),'1','reattaching an open view does not open another session');

+147

assert.equal(await sgl('(view-name (active-view (slate-state)))'),name);

+148

await dispatch('terminal-reattach');

+149

await dispatch('selector-escape');

+150

await sgl('(picker-ready #{catalog-version: 1 sessions: #[#{sid: "s-4444444444444444" kind: "pty" alive: #t}]})');

+151

  assert.notEqual(await sgl('(dict-ref (slate-state) slate/minibuffer: #f)'), 'terminal-session','late catalog reply does not reopen cancelled picker');

+152

await dispatch('terminal-reattach');

+153

await sgl('(picker-ready #{catalog-version: 1 sessions: #[] unavailable: 2})');

+154

assert.match(await sgl('(dict-ref (slate-state) slate/echo: "")'), /could not be listed/);

+155

await dispatch('terminal-reattach');

+156

await sgl('(picker-error "node is offline")');

+157

assert.match(await sgl('(dict-ref (slate-state) slate/echo: "")'), /node is offline/);

+158

await dispatch('terminal-reattach');

+159

await sgl('(picker-ready #{sessions: #[]})');

+160

assert.match(await sgl('(dict-ref (slate-state) slate/echo: "")'), /Update this node/);

+161

await sgl('(set! node-list-sessions! (lambda (ok err) (err "local node is not connected")))');

+162

await dispatch('terminal-reattach');

+163

assert.match(await sgl('(dict-ref (slate-state) slate/echo: "")'), /local node is not connected/);

+164

  console.log('PASS Terminal: Reattach lists live PTYs, attaches by SID, focuses existing views, ignores cancelled replies and reports unavailable nodes');

+165

await sgl('(import (slate enclave-account session) (slate providers enclave-node) (sigil json))');

+166

  await sgl('(begin (define picker-wire #f) (set! node-ready? (lambda () #f)) (set! account-session-send-command! (lambda args (set! picker-wire args) #t)))');

+167

  await sgl('(remote-session-open #{kind: pty: host: "remote-test" attach: "s-5555555555555555" attach-route: "relay"} #{sid: "picker-wire-test"})');

+168

assert.equal(await sgl('(list-ref picker-wire 3)'), 'stream/open');

+169

  assert.equal(await sgl('(dict-ref (dict-ref (json-decode (list-ref picker-wire 4)) args: #{}) sid: #f)'), 's-5555555555555555');

+170

console.log('PASS remote holder routing carries the selected SID instead of creating a shell');

+171

assert.deepEqual(errors, []);

+172

} finally {

+173

if (socket) socket.close();

+174

chrome.kill('SIGTERM');

+175

await Promise.race([chromeExit, sleep(2000)]);

+176

await new Promise(resolve => server.close(resolve));

+177

try { fs.rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); }

+178

catch (_) { /* Chrome helpers may finish touching the disposable profile late. */ }

+179

}

packages/slate/test/terminal-resize-browser-probe.mjsadded

@@ -0,0 +1,148 @@

+1

// Compare output, resizing, and frozen-copy frame costs in a disposable mobile browser.

+2

// Mobile terminal deck gate: real touch events and native text input against the shipped WASM.

+3

import assert from 'node:assert/strict';

+4

import fs from 'node:fs';

+5

import http from 'node:http';

+6

import os from 'node:os';

+7

import path from 'node:path';

+8

import { spawn } from 'node:child_process';

+9

+10

const root = path.resolve(import.meta.dirname, '../../..');

+11

const webRoot = process.env.SLATE_TEST_WEB_ROOT || path.join(root, 'build/web');

+12

assert.ok(fs.existsSync(path.join(webRoot, 'slate.wasm')), 'build/web/slate.wasm is required');

+13

const sleep = ms => new Promise(resolve => setTimeout(resolve, ms));

+14

const types = { '.html': 'text/html', '.js': 'text/javascript', '.mjs': 'text/javascript',

+15

'.wasm': 'application/wasm', '.json': 'application/json', '.svg': 'image/svg+xml',

+16

'.woff2': 'font/woff2' };

+17

const server = http.createServer((req, res) => {

+18

const relative = req.url.split('?')[0] === '/' ? 'index.html' : req.url.split('?')[0].slice(1);

+19

const target = path.resolve(webRoot, relative);

+20

if (!target.startsWith(webRoot + path.sep) || !fs.existsSync(target)) {

+21

res.writeHead(404).end(); return;

+22

}

+23

res.setHeader('content-type', types[path.extname(target)] || 'application/octet-stream');

+24

fs.createReadStream(target).pipe(res);

+25

});

+26

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+27

+28

const profile = fs.mkdtempSync(path.join(os.tmpdir(), 'slate-compose-chrome-'));

+29

const chrome = spawn('google-chrome', ['--headless=new', '--no-sandbox', '--disable-gpu',

+30

'--remote-debugging-port=0', `--user-data-dir=${profile}`, 'about:blank'],

+31

{ stdio: ['ignore', 'ignore', 'pipe'] });

+32

const chromeExit = new Promise(resolve => chrome.once('exit', resolve));

+33

let socket;

+34

const errors = [];

+35

try {

+36

const activePort = path.join(profile, 'DevToolsActivePort');

+37

for (let i = 0; i < 120 && !fs.existsSync(activePort); i++) await sleep(50);

+38

assert.ok(fs.existsSync(activePort), 'Chrome did not expose DevTools');

+39

const [debugPort, browserPath] = fs.readFileSync(activePort, 'utf8').trim().split('\n');

+40

socket = new WebSocket(`ws://127.0.0.1:${debugPort}${browserPath}`);

+41

await new Promise((resolve, reject) => { socket.onopen = resolve; socket.onerror = reject; });

+42

let nextId = 0;

+43

const pending = new Map();

+44

socket.onmessage = event => {

+45

const message = JSON.parse(event.data);

+46

if (message.method === 'Runtime.exceptionThrown')

+47

errors.push(message.params.exceptionDetails.exception?.description || message.params.exceptionDetails.text);

+48

if (message.id && pending.has(message.id)) {

+49

const pair = pending.get(message.id); pending.delete(message.id);

+50

message.error ? pair.reject(new Error(message.error.message)) : pair.resolve(message.result);

+51

}

+52

};

+53

const send = (method, params = {}, sessionId) => new Promise((resolve, reject) => {

+54

const id = ++nextId;

+55

const timer = setTimeout(() => { pending.delete(id); reject(new Error('CDP timeout: ' + method)); }, 60000);

+56

pending.set(id, {resolve: value => { clearTimeout(timer); resolve(value); },

+57

reject: error => { clearTimeout(timer); reject(error); }});

+58

socket.send(JSON.stringify({ id, method, params, ...(sessionId ? { sessionId } : {}) }));

+59

});

+60

const target = await send('Target.createTarget', { url: 'about:blank' });

+61

const attached = await send('Target.attachToTarget', { targetId: target.targetId, flatten: true });

+62

const session = attached.sessionId;

+63

await send('Runtime.enable', {}, session);

+64

await send('Emulation.setDeviceMetricsOverride', {width:390,height:844,deviceScaleFactor:1,mobile:true}, session);

+65

await send('Emulation.setTouchEmulationEnabled', {enabled:true}, session);

+66

await send('Page.navigate', {

+67

url: process.env.SLATE_TEST_URL ||

+68

`http://127.0.0.1:${server.address().port}/?rbdebug&prediction-gate`

+69

}, session);

+70

const evaluate = async expression => {

+71

const result = await send('Runtime.evaluate', { expression, awaitPromise: true, returnByValue: true }, session);

+72

    if (result.exceptionDetails) throw new Error(result.exceptionDetails.exception?.description || result.exceptionDetails.text);

+73

return result.result.value;

+74

};

+75

async function waitFor(expression, label) {

+76

for (let i = 0; i < 360; i++) {

+77

if (await evaluate(expression)) return;

+78

await sleep(100);

+79

}

+80

    const diagnostic = await evaluate(`({status:document.getElementById('status')?.textContent, body:document.body.innerText.slice(-2000)})`);

+81

throw new Error(`timeout waiting for ${label}; errors=${errors.join(' | ')}; page=${JSON.stringify(diagnostic)}`);

+82

}

+83

const dispatch = event => evaluate(`window.slateEval('(slate-dispatch "${event}")')`);

+84

+85

await waitFor(`document.getElementById('status')?.textContent === 'ready'`, 'Slate boot');

+86

console.log('PASS browser boot');

+87

  const sgl = async code => {const value = await evaluate(`window.slateEval(${JSON.stringify(code)})`); if (/^(Error|error):/.test(value)) throw new Error(value); if (code.includes('(slate-refresh)')) await evaluate('window.slateRefresh()'); return value;};

+88

await waitFor(`window.slateEval('(slate-preferences-settled?)') === '1'`, 'preference restore');

+89

await waitFor(`!document.getElementById('splash')`, 'interactive app');

+90

await evaluate('document.fonts.ready.then(() => true)');

+91

await sgl('(import (slate provider) (slate modes terminal) (slate extend))');

+92

await sgl(`(begin

+93

(define compose-context #f)

+94

(define compose-writes "")

+95

(register-provider! compose-probe:

+96

#{ session-open: (lambda (source ctx)

+97

(set! compose-context ctx)

+98

#{ write: (lambda (bytes)

+99

(set! compose-writes (string-append compose-writes bytes))) }) })

+100

(open-view! (make-terminal-view "compose-one" #{kind: pty: provider: compose-probe:}))

+101

((dict-ref compose-context emit:) "$ ")

+102

(slate-refresh))`);

+103

  await waitFor(`document.querySelector('.accessory-key-deck')?.getAttribute('data-compose-target') === 'compose-one'`, 'terminal deck');

+104

+105

await send('Emulation.setFocusEmulationEnabled',{enabled:true},session);

+106

  await sgl('(begin (define perf-resizes 0) (define perf-resize-output "") (register-provider! resize-probe: #{session-open: (lambda (source ctx) (set! compose-context ctx) #{write: (lambda (bytes) #t) resize: (lambda (cols rows) (set! perf-resizes (+ perf-resizes 1)) ((dict-ref ctx emit:) perf-resize-output))})}) (open-view! (make-terminal-view "resize-probe" #{kind: pty: provider: resize-probe:})) (slate-refresh))');

+107

const line='\x1b[32mBuild output\x1b[0m: '+('terminal streaming text ').repeat(3)+'\r\n';

+108

const payload=line.repeat(32);

+109

await sgl('(define perf-payload '+JSON.stringify(payload)+')');

+110

await sgl('(set! perf-resize-output '+JSON.stringify('\x1b[H'+line.repeat(20))+')');

+111

await send('Emulation.setCPUThrottlingRate',{rate:4},session);

+112

const results=[];

+113

for(const scenario of ['quiet-resize','output-only','output-resize','frozen-output-resize']) {

+114

await send('Emulation.setDeviceMetricsOverride',{width:390,height:844,deviceScaleFactor:1,mobile:true},session);

+115

await sleep(350);

+116

if(scenario==='frozen-output-resize') {

+117

await sgl('(slate-dispatch "acc-cat:terminal-copy")');

+118

await evaluate('document.querySelector(\'.accessory-bar [data-terminal-copy="start"]\').click()');

+119

}

+120

await sgl('(set! perf-resizes 0)');

+121

    await evaluate('window.slatePerf.start(); window.perfFrames=[]; window.perfFeedTimes=[]; window.perfLastFrame=performance.now(); window.perfRunning=true; window.perfFrame=()=>{if(!window.perfRunning)return;const now=performance.now();window.perfFrames.push(now-window.perfLastFrame);window.perfLastFrame=now;requestAnimationFrame(window.perfFrame)}; requestAnimationFrame(window.perfFrame)');

+122

    if(scenario!=='quiet-resize') await evaluate('window.perfFeedTimer=setInterval(()=>{const begin=performance.now(); window.slateEval(\'((dict-ref compose-context emit:) perf-payload)\'); window.slateTerm.arm("load-probe"); window.perfFeedTimes.push(performance.now()-begin);},25)');

+123

for(let i=0;i<24;i++) {

+124

if(scenario!=='output-only') {

+125

const heights=[844,760,650,520,460,520,650,760];

+126

const landscape=i>=16&&i<20;

+127

        await send('Emulation.setDeviceMetricsOverride',{width:landscape?844:390,height:landscape?390:heights[i%8],deviceScaleFactor:1,mobile:true},session);

+128

}

+129

await sleep(100);

+130

}

+131

await evaluate('clearInterval(window.perfFeedTimer); window.perfRunning=false');

+132

await sleep(250);

+133

const report=await evaluate('window.slatePerf.stop()');

+134

const extra=await evaluate('({frames:window.perfFrames, feeds:window.perfFeedTimes})');

+135

    const stats=xs=>{xs.sort((a,b)=>a-b);return {n:xs.length,p50:xs[Math.floor(xs.length*.5)],p95:xs[Math.floor(xs.length*.95)],max:xs.at(-1)}};

+136

    const result={scenario,resizeCount:await sgl('(number->string perf-resizes)'),frames:stats(extra.frames),feed:stats(extra.feeds),summary:report.summary};

+137

results.push(result); console.log(JSON.stringify(result));

+138

if(scenario==='frozen-output-resize') await evaluate('window.slateCopy.key("C-g")');

+139

}

+140

  if(process.env.SLATE_TEST_PROFILE_OUTPUT) fs.writeFileSync(process.env.SLATE_TEST_PROFILE_OUTPUT,JSON.stringify(results,null,2));

+141

} finally {

+142

if (socket) socket.close();

+143

chrome.kill('SIGTERM');

+144

await Promise.race([chromeExit, sleep(2000)]);

+145

await new Promise(resolve => server.close(resolve));

+146

try { fs.rmSync(profile, { recursive: true, force: true, maxRetries: 5, retryDelay: 100 }); }

+147

catch (_) { /* Chrome helpers may finish touching the disposable profile late. */ }

+148

}

packages/slate/test/terminal-resize-policy-test.mjsadded

@@ -0,0 +1,53 @@

+1

// Exercise the shipped observer callbacks with a deterministic clock. A keyboard

+2

// animation must finish before either the PTY or tmux client learns its new size.

+3

import assert from 'node:assert/strict';

+4

import fs from 'node:fs';

+5

import vm from 'node:vm';

+6

+7

const html = fs.readFileSync(new URL('../assets/index.html', import.meta.url), 'utf8');

+8

for (const kernel of ['TERM', 'TMUXSZ']) {

+9

const start = html.indexOf('t.ro = new ResizeObserver(() => {', html.indexOf(`const ${kernel} =`));

+10

const end = html.indexOf('\n t.ro.observe(el);', start);

+11

assert.ok(start > 0 && end > start);

+12

let now = 1000, timerId = 0, size = 40;

+13

const timers = new Map(), reports = [];

+14

const report = () => reports.push(size);

+15

const t = { rszTimer: null, lastRsz: 0 };

+16

vm.runInNewContext(html.slice(start, end), {

+17

t, name: 'resize-test', Date: { now: () => now }, report, reportSize: report,

+18

ResizeObserver: class { constructor(callback) { this.notify = callback; } },

+19

clearTimeout: id => timers.delete(id),

+20

setTimeout: (callback, delay) => {

+21

const id = ++timerId;

+22

timers.set(id, { at: now + delay, callback });

+23

return id;

+24

},

+25

});

+26

function advance(ms) {

+27

const until = now + ms;

+28

for (;;) {

+29

const next = [...timers.entries()].sort((a, b) => a[1].at - b[1].at)[0];

+30

if (!next || next[1].at > until) break;

+31

timers.delete(next[0]);

+32

now = next[1].at;

+33

next[1].callback();

+34

}

+35

now = until;

+36

}

+37

for (const target of [20, 40]) {

+38

const from = size;

+39

for (let step = 1; step <= 40; step++) {

+40

size = from + (target - from) * step / 40;

+41

t.ro.notify();

+42

advance(16);

+43

}

+44

assert.equal(reports.length, target === 20 ? 0 : 1, `${kernel}: no intermediate sizes`);

+45

advance(119 - 16);

+46

assert.equal(reports.length, target === 20 ? 0 : 1, `${kernel}: wait for quiet geometry`);

+47

advance(1);

+48

assert.equal(reports.at(-1), target, `${kernel}: final size delivered`);

+49

}

+50

assert.deepEqual(reports, [20, 40], `${kernel}: one resize per keyboard transition`);

+51

assert.equal(t.rszTimer, null);

+52

console.log(`PASS ${kernel}: keyboard animation settles into one final resize in each direction`);

+53

}

packages/slate/test/terminal-test.sglmodified

@@ -750,3 +750,53 @@

750

(check-true "closed -> not live" (not (terminal-live? "t1")))

751

(check "closed -> empty frames" (terminal-take-frame "t1" 1) "")

752

+753

;; Predictive echo consumes accepted terminal writes and authoritative VT

+754

;; snapshots, including mode-only changes that do not damage a visible row.

+755

(define *prediction-emit* #f)

+756

(define *prediction-lost* #f)

+757

(define *prediction-reattached* #f)

+758

(register-provider! prediction-pty:

+759

#{ session-open:

+760

(lambda (source ctx)

+761

(set! *prediction-emit* (dict-ref ctx emit:))

+762

(set! *prediction-lost* (dict-ref ctx lost:))

+763

(set! *prediction-reattached* (dict-ref ctx reattached:))

+764

#{ write: (lambda (bytes) #t) }) })

+765

(define pv (make-terminal-view "prediction" #{ kind: pty: provider: prediction-pty: }))

+766

(terminal-send-key! pv #{ key: "a" })

+767

(check "disabled prediction has no input handoff" (terminal-take-prediction-input!) "")

+768

(terminal-set-prediction-enabled! #t)

+769

(*prediction-emit* "$ ")

+770

(define pf (terminal-take-frame "prediction" 1))

+771

(check "plain terminal is prediction safe" (header-field pf 7) "1")

+772

(check-true "prediction frame includes the authoritative cursor row" (contains? pf "\np\t$ "))

+773

(terminal-send-key! pv #{ key: "a" })

+774

(check "accepted input carries the pre-write output serial"

+775

(terminal-take-prediction-input!)

+776

(string-append "prediction\n" (header-field pf 8) "\na"))

+777

(check "prediction input handoff drains once" (terminal-take-prediction-input!) "")

+778

(terminal-send-key! pv #{ key: "c" ctrl-key: #t })

+779

(check "control input is an explicit prediction barrier"

+780

(terminal-take-prediction-input!)

+781

(string-append "prediction\n" (header-field pf 8) "\n"))

+782

(*prediction-emit* (string-append ESC-S "[?2004h"))

+783

(define pp (terminal-take-frame "prediction" 0))

+784

(check "shell bracketed-paste support alone permits ordinary typing" (header-field pp 7) "1")

+785

(check-true "mode-only output advances the authoritative serial"

+786

(> (string->number (header-field pp 8)) (string->number (header-field pf 8))))

+787

(*prediction-emit* (string-append ESC-S "[?1000h"))

+788

(check "mouse tracking permits confirmed echo learning"

+789

(header-field (terminal-take-frame "prediction" 0) 7) "1")

+790

(*prediction-emit* (string-append ESC-S "[?1000l" ESC-S "[?1049h"))

+791

(check "alternate screen permits confirmed echo learning"

+792

(header-field (terminal-take-frame "prediction" 0) 7) "1")

+793

(*prediction-emit* (string-append ESC-S "[?1049l"))

+794

(terminal-take-frame "prediction" 1)

+795

(*prediction-lost* 1)

+796

(*prediction-reattached* 0 2)

+797

(check "reattach between frames still invalidates prediction"

+798

(header-field (terminal-take-frame "prediction" 0) 7) "0")

+799

(check "the following connected frame can learn fresh echoes"

+800

(header-field (terminal-take-frame "prediction" 0) 7) "1")

+801

(terminal-set-prediction-enabled! #f)

+802

(terminal-close! "prediction")

packages/slate/test/terminal-tmux-prediction-fixture.mjsadded

@@ -0,0 +1,43 @@

+1

// Capture real tmux screen/echo sequences without touching the user's server.

+2

import fs from 'node:fs';

+3

import os from 'node:os';

+4

import path from 'node:path';

+5

import {spawn, execFileSync} from 'node:child_process';

+6

const dir=fs.mkdtempSync(path.join(os.tmpdir(),'slate-prediction-tmux-'));

+7

const socket=path.join(dir,'tmux.sock');

+8

const env={...process.env,TERM:'xterm-256color'};

+9

delete env.TMUX;

+10

const quote=value=>"'"+value.replaceAll("'","'\\''")+"'";

+11

const command='stty cols 80 rows 24; exec env -u TMUX TERM=xterm-256color tmux -S '+quote(socket)+

+12

' -f /dev/null new-session -s prediction '+quote('env PS1="SLATE-PROBE> " bash --noprofile --norc');

+13

const proc=spawn('script',['-q','-f','-c',command,'/dev/null'],{env,stdio:['pipe','pipe','pipe']});

+14

const exited=new Promise(resolve=>proc.once('exit',resolve));

+15

let chunks=[];

+16

proc.stdout.on('data',chunk=>chunks.push(chunk));

+17

proc.stderr.on('data',chunk=>process.stderr.write(chunk));

+18

const sleep=ms=>new Promise(resolve=>setTimeout(resolve,ms));

+19

const drain=()=>{const bytes=Buffer.concat(chunks);chunks=[];return bytes.toString('base64')};

+20

let owns=false;

+21

try {

+22

for(let i=0;i<50&&!fs.existsSync(socket);i++)await sleep(100);

+23

const actual=execFileSync('tmux',['-S',socket,'display-message','-p','#{socket_path}'],{env,encoding:'utf8'}).trim();

+24

if(actual!==socket)throw Error('tmux socket isolation failed');

+25

owns=true;

+26

execFileSync('tmux',['-S',socket,'set-option','-g','mouse','on'],{env});

+27

await sleep(700);

+28

const fixture={boot:drain(),echoes:[]};

+29

for(const key of ['a','b','c']) {

+30

proc.stdin.write(key);

+31

await sleep(250);

+32

fixture.echoes.push({key,bytes:drain()});

+33

}

+34

const output=process.argv[2];

+35

if(!output)throw Error('Pass an output JSON path');

+36

fs.writeFileSync(output,JSON.stringify(fixture,null,2));

+37

console.log('PASS isolated tmux fixture captured with mouse tracking enabled');

+38

} finally {

+39

if(owns)try{execFileSync('tmux',['-S',socket,'kill-session','-t','prediction'],{env,stdio:'ignore'})}catch{}

+40

proc.kill('SIGTERM');

+41

await Promise.race([exited,sleep(2000)]);

+42

fs.rmSync(dir,{recursive:true,force:true});

+43

}

packages/slate/test/tmux-ladder-test.sglmodified

@@ -31,6 +31,7 @@

31

(import (sigil test)

32

(sigil core)

33

(sigil string)

+34

(slate root)

35

(slate tmux ladder))

36

37

;; A labelled check. `assert-true` carries no message, so attribution comes from

@@ -321,6 +322,11 @@

322

(test-group "tmux-node-label"

323

(test "a discovered node is named by its nick"

324

(assert-equal "orion" (tmux-node-label "orion")))

+325

(test "an opaque transport is named by its discovered display root"

+326

(register-root! nynex:

+327

#{ provider: node: host: "slate-node-4f0c767ffc13" label: "nynex" })

+328

(assert-equal "nynex" (tmux-node-label "slate-node-4f0c767ffc13"))

+329

(unregister-root! nynex:))

330

;; "" IS THE LOCAL NODE, not a missing value — the same convention every

331

;; remote verb uses for an absent host:.

332

(test "the empty host is the local node, and gets a readable name"

packages/slate/test/wake-lock-policy-test.mjsadded

@@ -0,0 +1,21 @@

+1

import fs from 'node:fs';

+2

import assert from 'node:assert/strict';

+3

+4

const html = fs.readFileSync(new URL('../assets/index.html', import.meta.url), 'utf8');

+5

const sw = fs.readFileSync(new URL('../assets/sw.js', import.meta.url), 'utf8');

+6

const nav = fs.readFileSync(new URL('../src/slate/commands/navigation.sgl', import.meta.url), 'utf8');

+7

const prefs = fs.readFileSync(new URL('../src/slate/main/preferences.sgl', import.meta.url), 'utf8');

+8

const main = fs.readFileSync(new URL('../src/slate/main.sgl', import.meta.url), 'utf8');

+9

+10

assert.match(nav, /"Slate: Keep Screen Awake"/);

+11

assert.match(prefs, /define-option slate\/keep-screen-awake:[\s\S]*?default: #f/);

+12

assert.match(main, /save-option! slate\/keep-screen-awake: next/);

+13

assert.match(html, /navigator\.wakeLock\.request$'screen'$/);

+14

assert.match(html, /document\.visibilityState !== 'visible'/);

+15

assert.match(html, /visibilitychange/);

+16

assert.match(html, /this browser does not provide Screen Wake Lock/);

+17

assert.match(html, /WAKE\.sync/);

+18

assert.match(html, /2026-09-03-wake-lock-1/);

+19

assert.match(sw, /2026-09-03-wake-lock-1/);

+20

+21

console.log('wake lock policy: persisted opt-in and visible-only reacquisition');

packages/slate/test/web-package-contract-test.sgladded

@@ -0,0 +1,14 @@

+1

(import (sigil fs) (sigil string) (sigil test))

+2

+3

(define package-source (read-file-string "packages/slate/package.sgl"))

+4

+5

(test "Slate is the sole writer of the PWA shell"

+6

(assert-true

+7

(and (string-contains? package-source "html: 'manual")

+8

(string-contains? package-source "source-dir: \"assets\""))))

+9

+10

(test "the authored PWA shell identifies Slate"

+11

(let ((index (read-file-string "packages/slate/assets/index.html")))

+12

(assert-true

+13

(and (string-contains? index "<title>Slate</title>")

+14

(string-contains? index "manifest.webmanifest")))))

probes/local/http-body/check.cjsadded

@@ -0,0 +1,87 @@

+1

// From the workspace root, after `sigil deps install`:

+2

// SIGIL=/path/to/sigil node probes/local/http-body/check.cjs

+3

const assert = require('node:assert/strict');

+4

const net = require('node:net');

+5

const {spawn} = require('node:child_process');

+6

const path = require('node:path');

+7

const delay = ms => new Promise(resolve => setTimeout(resolve, ms));

+8

+9

async function exchange(port, expected, payload, splitAt) {

+10

  const header = Buffer.from(`POST /probe HTTP/1.1\r\nHost: 127.0.0.1:${port}\r\nContent-Length: ${Buffer.byteLength(expected)}\r\n\r\n`);

+11

return new Promise((resolve, reject) => {

+12

const socket = net.connect(port, '127.0.0.1');

+13

const chunks = [];

+14

const timer = setTimeout(() => socket.destroy(new Error('response timeout with client still open')), 2000);

+15

socket.on('error', reject);

+16

socket.on('data', chunk => chunks.push(chunk));

+17

socket.on('close', () => clearTimeout(timer));

+18

socket.on('end', () => {

+19

const response = Buffer.concat(chunks);

+20

const at = response.indexOf('\r\n\r\n');

+21

try {

+22

assert.match(response.subarray(0, at).toString(), /^HTTP\/1\.1 200 /);

+23

assert.deepEqual(response.subarray(at + 4), Buffer.from(expected));

+24

resolve();

+25

} catch (error) { reject(error); }

+26

});

+27

socket.on('connect', async () => {

+28

if (splitAt === null) socket.write(Buffer.concat([header, payload]));

+29

else {

+30

socket.write(Buffer.concat([header, payload.subarray(0, splitAt)]));

+31

await delay(50);

+32

if (!socket.destroyed) socket.write(payload.subarray(splitAt));

+33

}

+34

});

+35

});

+36

}

+37

+38

(async () => {

+39

const reservation = net.createServer();

+40

await new Promise(resolve => reservation.listen(0, '127.0.0.1', resolve));

+41

const port = reservation.address().port;

+42

await new Promise(resolve => reservation.close(resolve));

+43

const child = spawn(process.env.SIGIL || 'sigil',

+44

['-L', 'packages/slate-cli/src', 'eval', '-f', path.join(__dirname, 'server.sgl')],

+45

{env: {...process.env, SLATE_HTTP_TEST_PORT: String(port)},

+46

stdio: ['ignore', 'pipe', 'pipe']});

+47

let output = '';

+48

let stopped = false;

+49

child.on('exit', () => { stopped = true; });

+50

child.stdout.on('data', chunk => { output += chunk; });

+51

child.stderr.on('data', chunk => { output += chunk; });

+52

const startupError = new Promise((_, reject) => child.once('error', reject));

+53

try {

+54

await Promise.race([startupError, (async () => {

+55

for (let i = 0; i < 300; i++) {

+56

if (output.includes('READY\n')) return;

+57

if (stopped) throw new Error(output);

+58

await delay(100);

+59

}

+60

throw new Error(`listener startup timeout: ${output}`);

+61

})()]);

+62

const cases = [

+63

['ASCII', 'abc', 'abc', null],

+64

['buffered Unicode JSON', '{"note":"→😀é"}', '{"note":"→😀é"}', null],

+65

['body after headers', '→😀é', '→😀é', 0],

+66

['split three-byte code point', '→😀é', '→😀é', 1],

+67

['split four-byte code point', '→😀é', '→😀é', 5],

+68

['declared byte boundary', '→', '→extra', null],

+69

];

+70

let failed = 0;

+71

for (const [name, expected, payload, splitAt] of cases) {

+72

try {

+73

await exchange(port, expected, Buffer.from(payload), splitAt);

+74

console.log(`PASS ${name}`);

+75

} catch (error) {

+76

failed++;

+77

console.log(`FAIL ${name}: ${error.message}`);

+78

}

+79

}

+80

console.log(`${cases.length - failed} passed; ${failed} failed`);

+81

if (failed) process.exitCode = 1;

+82

} finally {

+83

child.kill('SIGTERM');

+84

for (let i = 0; i < 30 && !stopped; i++) await delay(100);

+85

if (!stopped) child.kill('SIGKILL');

+86

}

+87

})().catch(error => { console.error(error); process.exitCode = 1; });

probes/local/http-body/server.sgladded

@@ -0,0 +1,14 @@

+1

(import (sigil async)

+2

(sigil io)

+3

(sigil process)

+4

(slate-cli listen))

+5

+6

;; The external runner supplies a free loopback port and owns this process.

+7

(with-async

+8

(start-listener! "127.0.0.1" (string->number (getenv "SLATE_HTTP_TEST_PORT")) #f

+9

#{ http-handler:

+10

(lambda (daemon client method path headers head)

+11

(send-http-response! client 200 "text/plain"

+12

(dict-ref head body: ""))) })

+13

(display "READY\n")

+14

(flush-output-port))

release/README.mdadded

@@ -0,0 +1,46 @@

+1

# Slate CLI release trust

+2

+3

CLI release manifests are signed with the dedicated OpenSSH Ed25519 identity

+4

`slate-cli-release-v1` in the `slate-cli-release` signature namespace. The

+5

trusted public key is recorded in `allowed_signers`; private key material must

+6

never be stored in this repository.

+7

+8

The current local signing key is encrypted by `pass` at:

+9

+10

```text

+11

sigil/slate/release-signing-v1

+12

```

+13

+14

Its fingerprint is:

+15

+16

```text

+17

SHA256:FwFUpe8UFLB4lzmpysY3SkEwjsDIR21mKjUoaaCqYEA

+18

```

+19

+20

For a local release, use the Sigil wrapper. It retrieves the key without

+21

printing it, verifies the fingerprint, scopes the release environment, streams

+22

the matrix build's output, and securely removes the temporary key when the

+23

build returns or raises an error:

+24

+25

```sh

+26

scripts/local-release.sgl build 0.1.0 /absolute/path/to/release-candidate

+27

```

+28

+29

The wrapper uses `dynamic-wind` for cleanup during ordinary success and error

+30

unwinding. An uncatchable process termination or machine failure can bypass any

+31

in-process cleanup; the temporary directory is therefore mode `0700` and the

+32

key is mode `0600`. Check the system temporary directory after such an event.

+33

Keep an encrypted backup of the pass store separately from this machine before

+34

relying on this key for public releases.

+35

+36

To verify a manually materialized identity before signing:

+37

+38

```sh

+39

ssh-keygen -y -f "$SLATE_RELEASE_SIGNING_KEY" |

+40

ssh-keygen -lf -

+41

```

+42

+43

The reported fingerprint must match the fingerprint above. If the private key

+44

is lost or suspected to be exposed, stop signing with this identity, add a new

+45

versioned identity and public key, and publish the rotation through a channel

+46

that does not depend solely on the compromised key.

release/allowed_signersadded

@@ -0,0 +1 @@

+1

slate-cli-release-v1 namespaces="slate-cli-release" ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIPGBR7QQY0gT7C7pwK45Y1RRAV7wI0B03sTWT8lcxCy1 Slate CLI release signing key v1

release/cli-v0.1.3.mdadded

@@ -0,0 +1,16 @@

+1

# Slate CLI 0.1.3

+2

+3

Slate CLI 0.1.3 completes the first multi-node companion rollout.

+4

+5

Highlights:

+6

+7

- Preserves remote working directories for terminals and file completion.

+8

- Fixes desktop `node status --json` reporting when no Termux control script is

+9

present.

+10

- Adds persistent macOS installation support without replacing enrollment.

+11

- Adds signed OpenBSD amd64 and arm64 release artifacts.

+12

- Ships the existing Linux, macOS, Android arm64, and Windows matrix, including

+13

the fully static Linux amd64 build for Guix systems.

+14

+15

The signed release manifest and artifacts are available under

+16

`https://useslate.org/releases/cli/`.

scripts/check-git-contractadded

@@ -0,0 +1,23 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

+4

repo=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)

+5

contract="$repo/packages/slate/test/git-contract-v1.json"

+6

gate="$repo/packages/slate/test/git-contract-gate.mjs"

+7

+8

for tool in node git; do

+9

command -v "$tool" >/dev/null 2>&1 || {

+10

echo "SETUP-FAILED git-contract: missing $tool" >&2

+11

exit 2

+12

}

+13

done

+14

[ -f "$contract" ] && [ -f "$gate" ] || {

+15

echo "SETUP-FAILED git-contract: declaration or gate is missing" >&2

+16

exit 2

+17

}

+18

+19

fixture_root=$(mktemp -d "${TMPDIR:-/tmp}/slate-git-contract.XXXXXX")

+20

cleanup() { rm -rf -- "$fixture_root"; }

+21

trap cleanup EXIT HUP INT TERM

+22

+23

node "$gate" "$contract" "$fixture_root"

scripts/check-git-diff-viewadded

@@ -0,0 +1,53 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

root=$(cd "$(dirname "$0")/.." && pwd)

+4

backend="$root/packages/slate-cli/src/slate-cli/git/diff.sgl"

+5

dispatch="$root/packages/slate-cli/src/slate-cli/dispatch.sgl"

+6

model="$root/packages/slate/src/slate/git/diff-model.sgl"

+7

view="$root/packages/slate/src/slate/git/diff-view.sgl"

+8

mode="$root/packages/slate/src/slate/modes/git-diff.sgl"

+9

commands="$root/packages/slate/src/slate/commands/git.sgl"

+10

component="$root/packages/slate/src/slate/components/diff.sgl"

+11

for file in "$backend" "$dispatch" "$model" "$view" "$mode" "$commands" "$component"; do

+12

[ -f "$file" ] || { echo "SETUP-FAILED git-diff-view: missing $file" >&2; exit 2; }

+13

done

+14

rg -qF '((string=? verb "git/diff")' "$dispatch" || { echo 'git-diff: node verb missing' >&2; exit 1; }

+15

rg -qF 'max-lines: 400 max-bytes: 262144' "$model" || { echo 'diff reply exceeded byte/line ceiling' >&2; exit 1; }

+16

rg -qF '(define mounted-row-ceiling 800)' "$view" || { echo 'git-diff: mounted row ceiling missing' >&2; exit 1; }

+17

safe_callbacks=$(rg -cF '(= generation (git-diff-model-generation model))' "$model" || true)

+18

[ "$safe_callbacks" -eq 2 ] || { echo 'late diff reply mutated current view' >&2; exit 1; }

+19

rg -qF '(page (stream-page token stream max-lines max-bytes))' "$backend" || { echo 'diff reply exceeded byte/line ceiling' >&2; exit 1; }

+20

rg -qF '(encoded-bytes reply)' "$backend" || { echo 'diff reply exceeded byte/line ceiling' >&2; exit 1; }

+21

rg -qF '(stream-remove! cursor stream #t)' "$backend" || { echo 'abandoned diff cursor leaked node process' >&2; exit 1; }

+22

rg -qF '(go (expire-stream token stream))' "$backend" || { echo 'abandoned diff cursor leaked node process' >&2; exit 1; }

+23

rg -qF 'cancel: #t max-lines: 400 max-bytes: 262144' "$model" || { echo 'abandoned diff cursor leaked node process' >&2; exit 1; }

+24

if rg -nF '(git-exec grants worktree (diff-argv kind target))' "$backend"; then

+25

echo 'diff reply exceeded byte/line ceiling' >&2; exit 1

+26

fi

+27

for binding in '"n" "git-next"' '"ArrowDown" "git-next"' '"p" "git-prev"' '"ArrowUp" "git-prev"' '"Enter" "git-visit"' '"q" "git-quit"'; do

+28

rg -qF "$binding" "$mode" || { echo "git-diff: mode binding missing: $binding" >&2; exit 1; }

+29

done

+30

for command in git-diff git-diff-more git-diff-refresh; do

+31

rg -qF "\"$command\"" "$commands" || { echo "git-diff: missing command $command" >&2; exit 1; }

+32

done

+33

rg -qF 'root: (dict-ref source root: #f)' "$commands" || { echo 'diff visit changed root' >&2; exit 1; }

+34

rg -qF '(slate components diff)' "$mode" || { echo 'git-diff: shared control missing' >&2; exit 1; }

+35

rg -qF 'data-slate-click' "$component" || { echo 'git-diff: pointer route missing' >&2; exit 1; }

+36

node_log=$(mktemp)

+37

client_log=$(mktemp)

+38

trap 'rm -f "$node_log" "$client_log"' EXIT

+39

if ! sigil test slate-cli --sgl --no-color "$root/packages/slate-cli/test/test-git-diff-contract.sgl" >"$node_log" 2>&1; then

+40

cat "$node_log" >&2

+41

if rg -qF 'abandoned cursors are explicitly cancelled without leaking children' "$node_log"; then

+42

echo 'abandoned diff cursor leaked node process' >&2

+43

exit 1

+44

fi

+45

echo 'diff reply exceeded byte/line ceiling' >&2

+46

exit 1

+47

fi

+48

if ! sigil test slate --sgl --no-color "$root/packages/slate/test/git-diff-view-test.sgl" >"$client_log" 2>&1; then

+49

cat "$client_log" >&2

+50

echo 'late diff reply mutated current view' >&2

+51

exit 1

+52

fi

+53

echo 'PASS git-diff-view: paged structured diff; bounded window; remote visit; late reply'

scripts/check-git-discard-refreshadded

@@ -0,0 +1,27 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

root="$(cd "$(dirname "$0")/.." && pwd)"

+4

commands="$root/packages/slate/src/slate/commands/git.sgl"

+5

model="$root/packages/slate/src/slate/git/model.sgl"

+6

node="$root/packages/slate-cli/src/slate-cli/git/mutation.sgl"

+7

dispatch="$root/packages/slate-cli/src/slate-cli/dispatch.sgl"

+8

+9

rg -qF '(if (not yes?) next' "$commands" || { echo 'discard ran after decline' >&2; exit 1; }

+10

rg -qF 'This cannot be undone.' "$commands" || { echo 'discard confirmation omits irreversibility' >&2; exit 1; }

+11

rg -qF 'git/discard-file' "$dispatch" || { echo 'discard node dispatch missing' >&2; exit 1; }

+12

rg -qF 'git-discard-hunk' "$node" || { echo 'discard hunk authority missing' >&2; exit 1; }

+13

rg -qF 'external-change?: #t' "$model" || { echo 'passive watch does not mark stale status' >&2; exit 1; }

+14

if sed -n '/define (git-status-model-watch-event!/,/^ (define /p' "$model" | rg -qF 'git-status-model-load!'; then

+15

echo 'passive watch started Git work' >&2; exit 1

+16

fi

+17

+18

source "$root/scripts/lib/slate-harness.sh"

+19

log="$(mktemp)"

+20

trap 'rm -f "$log"' EXIT

+21

sigil test slate-cli --sgl --no-color \

+22

"$root/packages/slate-cli/test/test-git-discard.sgl" >"$log" 2>&1 || { cat "$log"; exit 1; }

+23

harness_verdict "$log" 1

+24

sigil test slate --sgl --no-color \

+25

"$root/packages/slate/test/git-status-model-test.sgl" >"$log" 2>&1 || { cat "$log"; exit 1; }

+26

harness_verdict "$log" 1

+27

echo 'PASS git-discard-refresh: confirmed node discard; stale unchanged; passive watch is notification-only'

scripts/check-git-file-mutationsadded

@@ -0,0 +1,48 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

root=$(cd "$(dirname "$0")/.." && pwd)

+4

dispatch="$root/packages/slate-cli/src/slate-cli/dispatch.sgl"

+5

node="$root/packages/slate-cli/src/slate-cli/git/mutation.sgl"

+6

commands="$root/packages/slate/src/slate/commands/git.sgl"

+7

mode="$root/packages/slate/src/slate/modes/git-status.sgl"

+8

for file in "$dispatch" "$node" "$commands" "$mode"; do

+9

[ -f "$file" ] || { echo "SETUP-FAILED git-file-mutations: missing $file" >&2; exit 2; }

+10

done

+11

for verb in git/stage-file git/unstage-file; do

+12

rg -qF "\"$verb\"" "$dispatch" || { echo "git-file-mutations: missing dispatch $verb" >&2; exit 1; }

+13

rg -qF "\"$verb\"" "$commands" || { echo "git-file-mutations: missing client $verb" >&2; exit 1; }

+14

done

+15

rg -qF '(snapshot=? expected current)' "$node" || {

+16

echo 'mutation accepted stale snapshot' >&2; exit 1;

+17

}

+18

rg -qF 'GIT_INDEX_FILE=' "$node" || { echo 'git-file-mutations: isolated candidate index missing' >&2; exit 1; }

+19

rg -qF '(list "apply" "--cached"' "$node" || { echo 'git-file-mutations: atomic index publication missing' >&2; exit 1; }

+20

rg -qF 'edit in the validation publication window' "$root/packages/slate-cli/test/test-git-file-mutations.sgl" || {

+21

echo 'git-file-mutations: exact-window race fixture missing' >&2; exit 1;

+22

}

+23

rg -qF 'entry-id:' "$node" || { echo 'git-file-mutations: entry identity guard missing' >&2; exit 1; }

+24

for binding in '"s" "git-stage"' '"u" "git-unstage"'; do

+25

rg -qF "$binding" "$mode" || { echo "git-file-mutations: binding missing $binding" >&2; exit 1; }

+26

done

+27

for family in git-select-stage: git-select-unstage:; do

+28

rg -qF "$family" "$mode" || { echo "git-file-mutations: pointer family missing $family" >&2; exit 1; }

+29

done

+30

cache=$(mktemp -d)

+31

log=$(mktemp)

+32

source "$root/scripts/lib/slate-harness.sh"

+33

trap 'rm -rf "$cache"; rm -f "$log"' EXIT

+34

if ! XDG_CACHE_HOME="$cache" sigil test slate-cli --sgl --no-color \

+35

"$root/packages/slate-cli/test/test-git-file-mutations.sgl" >"$log" 2>&1; then

+36

if rg -qF 'stale snapshot changes neither index nor newer worktree state' "$log"; then

+37

echo 'mutation accepted stale snapshot' >&2

+38

fi

+39

cat "$log" >&2; exit 1

+40

fi

+41

harness_verdict "$log" 1

+42

if ! XDG_CACHE_HOME="$cache" sigil test slate --sgl --no-color \

+43

"$root/packages/slate/test/git-status-view-test.sgl" \

+44

"$root/packages/slate/test/git-status-model-test.sgl" >"$log" 2>&1; then

+45

cat "$log" >&2; exit 1

+46

fi

+47

harness_verdict "$log" 2

+48

echo 'PASS git-file-mutations: atomic stage/unstage; exact-window stale unchanged; keyboard/pointer parity'

scripts/check-git-historyadded

@@ -0,0 +1,20 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

root=$(cd "$(dirname "$0")/.." && pwd)

+4

source "$root/scripts/lib/slate-harness.sh"

+5

log=$(mktemp)

+6

trap 'rm -f "$log"' EXIT

+7

for package in slate-cli slate; do

+8

if [ "$package" = slate-cli ]; then

+9

test_file="$root/packages/slate-cli/test/test-git-log.sgl"

+10

else

+11

test_file="$root/packages/slate/test/git-log-test.sgl"

+12

fi

+13

if ! sigil test "$package" --sgl --no-color "$test_file" >"$log" 2>&1; then

+14

cat "$log"

+15

exit 1

+16

fi

+17

harness_verdict "$log" 1

+18

done

+19

node --check "$root/packages/slate/test/git-log-browser-gate.mjs"

+20

echo 'PASS git-history: bounded pages, lazy inspection, root identity, commit topology'

scripts/check-git-hunk-mutationsadded

@@ -0,0 +1,45 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

root=$(cd "$(dirname "$0")/.." && pwd)

+4

dispatch="$root/packages/slate-cli/src/slate-cli/dispatch.sgl"

+5

node="$root/packages/slate-cli/src/slate-cli/git/mutation.sgl"

+6

commands="$root/packages/slate/src/slate/commands/git.sgl"

+7

mode="$root/packages/slate/src/slate/modes/git-status.sgl"

+8

model="$root/packages/slate/src/slate/git/model.sgl"

+9

node_test="$root/packages/slate-cli/test/test-git-hunk-mutations.sgl"

+10

for file in "$dispatch" "$node" "$commands" "$mode" "$model" "$node_test"; do

+11

[ -f "$file" ] || { echo "SETUP-FAILED git-hunk-mutations: missing $file" >&2; exit 2; }

+12

done

+13

for verb in git/stage-hunk git/unstage-hunk; do

+14

rg -qF "\"$verb\"" "$dispatch" || { echo "git-hunk-mutations: missing dispatch $verb" >&2; exit 1; }

+15

rg -qF "\"$verb\"" "$commands" || { echo "git-hunk-mutations: missing client $verb" >&2; exit 1; }

+16

done

+17

rg -qF '(patch-hunks text side file-id)' "$node" || { echo 'git-hunk-mutations: node reconstruction missing' >&2; exit 1; }

+18

rg -qF '(snapshot=? expected latest)' "$node" || { echo 'mutation accepted stale snapshot' >&2; exit 1; }

+19

rg -qF 'GIT_INDEX_FILE=' "$node" || { echo 'git-hunk-mutations: isolated candidate index missing' >&2; exit 1; }

+20

rg -qF 'hunk-id: hunk-id' "$model" || { echo 'git-hunk-mutations: structured hunk request missing' >&2; exit 1; }

+21

if rg -qF 'patch: patch' "$model" "$commands"; then

+22

echo 'git-hunk-mutations: rendered patch crossed client boundary' >&2; exit 1

+23

fi

+24

for family in git-select-stage: git-select-unstage:; do

+25

rg -qF "$family" "$mode" || { echo "git-hunk-mutations: pointer family missing $family" >&2; exit 1; }

+26

done

+27

cache=$(mktemp -d)

+28

log=$(mktemp)

+29

source "$root/scripts/lib/slate-harness.sh"

+30

trap 'rm -rf "$cache"; rm -f "$log"' EXIT

+31

if ! XDG_CACHE_HOME="$cache" sigil test slate-cli --sgl --no-color "$node_test" >"$log" 2>&1; then

+32

if rg -qF 'stage the exact non-first worktree hunk and unstage its exact index hunk' "$log"; then

+33

echo 'wrong hunk staged' >&2

+34

fi

+35

cat "$log" >&2; exit 1

+36

fi

+37

harness_verdict "$log" 1

+38

if ! XDG_CACHE_HOME="$cache" sigil test slate --sgl --no-color \

+39

"$root/packages/slate/test/git-status-view-test.sgl" \

+40

"$root/packages/slate/test/git-status-model-test.sgl" \

+41

"$root/packages/slate/test/diff-control-test.sgl" >"$log" 2>&1; then

+42

cat "$log" >&2; exit 1

+43

fi

+44

harness_verdict "$log" 3

+45

echo 'PASS git-hunk-mutations: node reconstruction; atomic partial index; keyboard/pointer parity'

scripts/check-git-inline-diffadded

@@ -0,0 +1,39 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

root=$(cd "$(dirname "$0")/.." && pwd)

+4

component="$root/packages/slate/src/slate/components/diff.sgl"

+5

status="$root/packages/slate/src/slate/modes/git-status.sgl"

+6

dedicated="$root/packages/slate/src/slate/modes/git-diff.sgl"

+7

agent="$root/packages/slate/src/slate/modes/agent-session.sgl"

+8

commands="$root/packages/slate/src/slate/commands/git.sgl"

+9

asset="$root/packages/slate/assets/index.html"

+10

for file in "$component" "$status" "$dedicated" "$agent" "$commands" "$asset"; do

+11

[ -f "$file" ] || { echo "SETUP-FAILED git-inline-diff: missing $file" >&2; exit 2; }

+12

done

+13

for host in "$status" "$dedicated" "$agent"; do

+14

  rg -qF '(slate components diff)' "$host" || { echo "git-inline-diff: host bypassed shared control: $host" >&2; exit 1; }

+15

done

+16

rg -qF '.slate-diff-addition { color:var(--ok);' "$asset" || { echo 'git-inline-diff: addition/deletion distinction missing' >&2; exit 1; }

+17

rg -qF '.slate-diff-deletion { color:var(--err);' "$asset" || { echo 'git-inline-diff: addition/deletion distinction missing' >&2; exit 1; }

+18

rg -qF 'slate-diff-old' "$component" || { echo 'git-inline-diff: line-number gutters missing' >&2; exit 1; }

+19

rg -qF 'slate-diff-new' "$component" || { echo 'git-inline-diff: line-number gutters missing' >&2; exit 1; }

+20

rg -qF '.slate-diff-control { min-width:0; width:100%; max-width:100%; overflow:hidden;' "$asset" || {

+21

echo 'git-inline-diff: narrow pane overflow containment missing' >&2; exit 1;

+22

}

+23

rg -qF '(define mounted-row-ceiling 800)' "$root/packages/slate/src/slate/git/status-view.sgl" || {

+24

echo 'git-inline-diff: mounted row ceiling missing' >&2; exit 1;

+25

}

+26

rg -qF 'git-inline-more:' "$commands" || { echo 'git-inline-diff: continuation command missing' >&2; exit 1; }

+27

cache_dir=${XDG_CACHE_HOME:-$(mktemp -d)}

+28

log=$(mktemp)

+29

trap 'rm -f "$log"' EXIT

+30

source "$root/scripts/lib/slate-harness.sh"

+31

if ! XDG_CACHE_HOME="$cache_dir" sigil test slate --sgl --no-color \

+32

"$root/packages/slate/test/diff-control-test.sgl" \

+33

"$root/packages/slate/test/git-status-view-test.sgl" \

+34

"$root/packages/slate/test/git-diff-view-test.sgl" >"$log" 2>&1; then

+35

tail -n 80 "$log" >&2

+36

exit 1

+37

fi

+38

harness_verdict "$log" 3

+39

echo 'PASS git-inline-diff: shared control 3/3 hosts; gutters/color; lazy folding; bounded rows'

scripts/check-git-node-contractadded

@@ -0,0 +1,65 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

+4

repo=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)

+5

dispatch="$repo/packages/slate-cli/src/slate-cli/dispatch.sgl"

+6

executor="$repo/packages/slate-cli/src/slate-cli/git/exec.sgl"

+7

status="$repo/packages/slate-cli/src/slate-cli/git/status.sgl"

+8

routing="$repo/packages/slate/test/git-provider-routing-test.sgl"

+9

runtime_test="$repo/packages/slate-cli/test/test-git-node-contract.sgl"

+10

contract="$repo/packages/slate/test/git-contract-v1.json"

+11

+12

for file in "$dispatch" "$executor" "$status" "$routing" "$runtime_test" "$contract"; do

+13

[ -f "$file" ] || { echo "SETUP-FAILED git-node-contract: missing $file" >&2; exit 2; }

+14

done

+15

+16

fail=0

+17

while IFS= read -r verb; do

+18

case "$verb" in

+19

git/discover|git/status)

+20

if ! rg -qF "\"$verb\"" "$dispatch"; then

+21

echo "$verb: missing dispatch registration" >&2

+22

fail=1

+23

fi

+24

;;

+25

esac

+26

done < <(node -e 'const c=require(process.argv[1]); for (const v of Object.keys(c.verbs)) console.log(v)' "$contract")

+27

+28

for forbidden in '"sh" "-c"' '"/bin/sh"' '"timeout"' '"env" "--chdir"' '"-C"' 'process-spawn-pipe' 'process-signal!'; do

+29

if rg -qF "$forbidden" "$executor" "$status"; then

+30

echo "git invocation is not platform portable: $forbidden" >&2

+31

fail=1

+32

fi

+33

done

+34

+35

rg -qF 'process-spawn' "$executor" || { echo "portable process API missing" >&2; fail=1; }

+36

rg -qF 'cwd: cwd' "$executor" || { echo "child-local working directory missing" >&2; fail=1; }

+37

rg -qF 'environment: (git-environment)' "$executor" || { echo "explicit child environment missing" >&2; fail=1; }

+38

rg -qF '"LC_ALL=C"' "$executor" || { echo "frozen Git locale missing" >&2; fail=1; }

+39

rg -qF 'released runtime applies child cwd and environment' "$runtime_test" || {

+40

echo "executable child-context runtime probe missing" >&2

+41

fail=1

+42

}

+43

rg -qF 'process-kill!' "$executor" || { echo "portable timeout cancellation missing" >&2; fail=1; }

+44

rg -qF 'output-exceeded?' "$executor" || { echo "bounded output result missing" >&2; fail=1; }

+45

+46

for field in 'node/rpc-begin' 'node/rpc-end' 'duration-ms:' 'args-path-summary'; do

+47

if ! rg -qF "$field" "$dispatch"; then

+48

echo "Git request logging field missing: $field" >&2

+49

fail=1

+50

fi

+51

done

+52

rg -qF '(dict-ref args repo: #f)' "$dispatch" || {

+53

echo "Git status log has no safe repository path summary" >&2

+54

fail=1

+55

}

+56

+57

local_dest=$(rg -o 'recording-op "node-local"' "$routing" || true)

+58

remote_dest=$(rg -o 'recording-op "node-remote"' "$routing" || true)

+59

if [ -z "$local_dest" ] || [ -z "$remote_dest" ]; then

+60

echo "remote root executed on local node" >&2

+61

fail=1

+62

fi

+63

+64

[ "$fail" -eq 0 ] || exit 1

+65

echo "PASS git-node-contract: git/discover + git/status; root parity 2/2"

scripts/check-git-status-modeladded

@@ -0,0 +1,54 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

+4

repo=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)

+5

model="$repo/packages/slate/src/slate/git/model.sgl"

+6

test_file="$repo/packages/slate/test/git-status-model-test.sgl"

+7

+8

for file in "$model" "$test_file"; do

+9

[ -f "$file" ] || { echo "SETUP-FAILED git-status-model: missing $file" >&2; exit 2; }

+10

done

+11

+12

fail=0

+13

for state in loading stale ready unavailable error; do

+14

rg -qF "state: ${state}:" "$model" || {

+15

echo "git status model state missing: $state" >&2

+16

fail=1

+17

}

+18

done

+19

+20

for seam in 'source-root' 'source-git-request' 'project-source?' 'project-root'; do

+21

rg -qF "$seam" "$model" || {

+22

echo "git status model seam missing: $seam" >&2

+23

fail=1

+24

}

+25

done

+26

+27

rg -qF '(keyword->string root)' "$model" || {

+28

echo "identity collision: repository key omits root" >&2

+29

fail=1

+30

}

+31

rg -qF 'same path on different remote roots has no identity collision' "$test_file" || {

+32

echo "identity collision arm missing" >&2

+33

fail=1

+34

}

+35

rg -qF 'late discovery reply cannot overwrite a newer generation' "$test_file" || {

+36

echo "late-reply arm missing" >&2

+37

fail=1

+38

}

+39

rg -qF 'row ids are stable across snapshots' "$test_file" || {

+40

echo "cross-snapshot row identity arm missing" >&2

+41

fail=1

+42

}

+43

rg -qF 'browser-only root is unavailable without a Git request' "$test_file" || {

+44

echo "browser unavailable arm missing" >&2

+45

fail=1

+46

}

+47

+48

if rg -q -e '$slate providers (node|enclave-node|lantern)$|$sigil process$' "$model"; then

+49

echo "git status model imports a concrete transport or process" >&2

+50

fail=1

+51

fi

+52

+53

[ "$fail" -eq 0 ] || exit 1

+54

echo "PASS git-status-model: project/folder; local/remote; same-path/different-root; late-reply"

scripts/check-git-status-viewadded

@@ -0,0 +1,24 @@

+1

#!/usr/bin/env bash

+2

set -euo pipefail

+3

root=$(cd "$(dirname "$0")/.." && pwd)

+4

mode="$root/packages/slate/src/slate/modes/git-status.sgl"

+5

commands="$root/packages/slate/src/slate/commands/git.sgl"

+6

bindings="$root/packages/slate/src/slate/bindings.sgl"

+7

main="$root/packages/slate/src/slate/main.sgl"

+8

test_file="$root/packages/slate/test/git-status-view-test.sgl"

+9

for file in "$mode" "$commands" "$bindings" "$main" "$test_file"; do

+10

[ -f "$file" ] || { echo "SETUP-FAILED git-status-view: missing $file" >&2; exit 2; }

+11

done

+12

rg -qF '"g" "git-status"' "$bindings" || { echo 'git-status: canonical binding missing' >&2; exit 1; }

+13

for command in git-status git-next git-prev git-toggle git-visit git-refresh git-help git-quit; do

+14

rg -qF "\"$command\"" "$commands" || { echo "git-status: missing command $command" >&2; exit 1; }

+15

done

+16

for binding in '"n" "git-next"' '"ArrowDown" "git-next"' '"p" "git-prev"' '"ArrowUp" "git-prev"' '"Tab" "git-toggle"' '"Enter" "git-visit"' '"?" "git-help"' '"q" "git-quit"'; do

+17

rg -qF "$binding" "$mode" || { echo "git-status: mode binding missing: $binding" >&2; exit 1; }

+18

done

+19

rg -qF '(slate commands git)' "$main" || { echo 'git-status: command module not composed' >&2; exit 1; }

+20

rg -qF '(configure-git-commands!' "$main" || { echo 'git-status: commands not configured' >&2; exit 1; }

+21

rg -qF 'data-slate-click' "$mode" || { echo 'git-status: pointer route missing' >&2; exit 1; }

+22

rg -qF 'key: "ArrowDown"' "$mode" || { echo 'git-status: touch key synthesis missing' >&2; exit 1; }

+23

if rg -n 'git/diff|patch:' "$mode" "$commands"; then echo 'git-status: eager diff surface present' >&2; exit 1; fi

+24

echo 'PASS git-status-view: commands/bindings; keyboard/pointer; zero eager diff'

scripts/check-hooks-browser-gatesmodified

@@ -27,6 +27,7 @@ node packages/slate/test/hooks-doc-browser-gate.mjs

27

node packages/slate/test/notification-browser-gate.mjs

28

node packages/slate/test/terminal-extraction-browser-gate.mjs

29

node packages/slate/test/project-folder-extraction-browser-gate.mjs

+30

node packages/slate/test/folder-redesign-browser-gate.mjs

31

# Runs BOTH its branches internally (opfs / fallback), each driving a different

32

# no-init path through run-init. Registered here because nothing else can see a

33

# .mjs: check-suite-shape derives its denominator from .sgl names only and

@@ -40,4 +41,4 @@ node packages/slate/test/scratchpad-extend-browser-gate.mjs

41

# that never calls back, which only the unveil deadline can rescue).

42

node packages/slate/test/store-backend-browser-gate.mjs

43

−43

echo "OK hooks browser gates: help, save, root OPFS/fallback, hooks docs, notification persistence, terminal extraction, project/folder extraction, scratchpad extend, store backend"

+44

echo "OK hooks browser gates: help, save, root OPFS/fallback, hooks docs, notification persistence, terminal extraction, project/folder extraction, folder redesign, scratchpad extend, store backend"

scripts/local-release.sgladded

@@ -0,0 +1,82 @@

+1

#!/usr/bin/env sigil

+2

;;; Run a local Slate CLI build with the release key materialized from pass.

+3

;;; The child release process inherits only the temporary key path and public

+4

;;; verification policy; private key bytes never enter argv or command tracing.

+5

+6

(import (sigil core) (sigil fs) (sigil path) (sigil process)

+7

(sigil shell) (sigil string))

+8

+9

(define signing-key-entry "sigil/slate/release-signing-v1")

+10

(define signing-key-id "slate-cli-release-v1")

+11

(define signing-key-fingerprint

+12

"SHA256:FwFUpe8UFLB4lzmpysY3SkEwjsDIR21mKjUoaaCqYEA")

+13

+14

(define (usage)

+15

(display "usage: scripts/local-release.sgl build <version> <dir>\n")

+16

(exit 2))

+17

+18

(define (quietly thunk)

+19

(guard (condition (#t #f)) (thunk)))

+20

+21

(define (restore-env! name prior)

+22

;; Sigil currently exposes setenv! but not unsetenv!. An empty value has the

+23

;; same fail-closed behavior as an absent value to scripts/release.sgl.

+24

(setenv! name (or prior "")))

+25

+26

(define (cleanup-key! key-path key-dir)

+27

(when (file-exists? key-path)

+28

(quietly (lambda () ($ shred -u ,key-path))))

+29

;; If shred failed, remove the still-protected file rather than leave secret

+30

;; material behind. The enclosing temporary directory is mode 0700.

+31

(when (file-exists? key-path)

+32

(quietly (lambda () (delete-file key-path))))

+33

(when (directory-exists? key-dir)

+34

(quietly (lambda () (delete-directory key-dir)))))

+35

+36

(define (run-build version output-dir)

+37

(requires (tools pass chmod ssh-keygen shred))

+38

(let* ((root (path-join (script-dir) ".."))

+39

(release-script (path-join root "scripts" "release.sgl"))

+40

(allowed-signers (path-join root "release" "allowed_signers"))

+41

(key-dir (make-temp-directory))

+42

(key-path (and key-dir (path-join key-dir signing-key-id)))

+43

(old-key (getenv "SLATE_RELEASE_SIGNING_KEY"))

+44

(old-id (getenv "SLATE_RELEASE_SIGNING_KEY_ID"))

+45

(old-allowed (getenv "SLATE_RELEASE_ALLOWED_SIGNERS")))

+46

(unless key-dir

+47

(error "could not create a temporary release-key directory"))

+48

(dynamic-wind

+49

(lambda () #t)

+50

(lambda ()

+51

($ chmod 700 ,key-dir)

+52

;; `out` captures stdout without displaying it. Do not replace this

+53

;; with `$`: that would print the private key to the release log.

+54

;; `out` trims trailing newlines; OpenSSH's private-key encoding needs

+55

;; exactly one restored after the PEM-style closing marker.

+56

(write-file-string key-path

+57

(string-append (out pass show ,signing-key-entry) "\n"))

+58

($ chmod 600 ,key-path)

+59

(let ((description (out ssh-keygen -lf ,key-path)))

+60

(unless (string-contains? description signing-key-fingerprint)

+61

(error "pass entry does not match the trusted release-key fingerprint")))

+62

(setenv! "SLATE_RELEASE_SIGNING_KEY" key-path)

+63

(setenv! "SLATE_RELEASE_SIGNING_KEY_ID" signing-key-id)

+64

(setenv! "SLATE_RELEASE_ALLOWED_SIGNERS" allowed-signers)

+65

(display (string-append "Verified release key " signing-key-fingerprint "\n"))

+66

;; process-run inherits the terminal, so the long matrix build remains

+67

;; visible as it progresses. `(sigil shell)` command capture currently

+68

;; buffers a nested command's output until it exits.

+69

(let ((status (process-run release-script "build" version output-dir)))

+70

(unless (= status 0)

+71

(error (string-append "release build exited with status "

+72

(number->string status))))))

+73

(lambda ()

+74

(restore-env! "SLATE_RELEASE_SIGNING_KEY" old-key)

+75

(restore-env! "SLATE_RELEASE_SIGNING_KEY_ID" old-id)

+76

(restore-env! "SLATE_RELEASE_ALLOWED_SIGNERS" old-allowed)

+77

(cleanup-key! key-path key-dir)))))

+78

+79

(let ((args (script-args)))

+80

(if (and (= (length args) 3) (string=? (car args) "build"))

+81

(run-build (cadr args) (caddr args))

+82

(usage)))

scripts/release.sgladded

@@ -0,0 +1,316 @@

+1

#!/usr/bin/env sigil

+2

;;; Build and publish Slate CLI releases. Publishing expects Wrangler's ambient

+3

;;; authentication; no account identifiers or credentials live here. Every

+4

;;; command has a dry-run form and publishing always targets staging first.

+5

+6

(import (sigil core) (sigil fs) (sigil json) (sigil path) (sigil process)

+7

(sigil shell) (sigil string))

+8

+9

(define platforms

+10

'("linux-amd64" "linux-amd64-static" "linux-arm64"

+11

"macos-amd64" "macos-arm64"

+12

"openbsd-amd64" "openbsd-arm64"

+13

"android-arm64" "windows-amd64"))

+14

+15

(define cli-version-source

+16

"packages/slate-cli/package.sgl")

+17

+18

(define release-package-sources

+19

'("packages/slate/package.sgl"

+20

"packages/slate-cli/package.sgl"

+21

"packages/slate-netem/package.sgl"

+22

"packages/slate-shell/package.sgl"))

+23

+24

(define (say text)

+25

(display text)

+26

(display "\n"))

+27

+28

(define (declared-cli-version)

+29

(let* ((marker "\n version: \"")

+30

(source (read-file-string cli-version-source))

+31

(parts (string-split source marker)))

+32

(unless (= (length parts) 2)

+33

(error (string-append "cannot read authoritative CLI version from "

+34

cli-version-source)))

+35

(car (string-split (cadr parts) "\""))))

+36

+37

(define (require-version! requested)

+38

(let ((declared (declared-cli-version)))

+39

(unless (string=? requested declared)

+40

(error (string-append "requested CLI version " requested

+41

" does not match declared version " declared)))))

+42

+43

(define (require-clean-tracked-checkout!)

+44

;; Deliberately ignore untracked files. They may be unrelated user work.

+45

(let ((changes (out git status --porcelain --untracked-files=no)))

+46

(unless (= (string-length changes) 0)

+47

(error "release builds require a clean tracked checkout"))))

+48

+49

(define (require-release-dependencies!)

+50

;; Release commands resolve only checked-in remote locks. Development

+51

;; redirects are deliberately opt-in and must never leak into a manifest.

+52

(for-each

+53

(lambda (path)

+54

(let ((source (read-file-string path)))

+55

(unless (string-contains? source "sigil: \"0.20.3\"")

+56

(error (string-append "release package does not require Sigil 0.20.3: " path)))

+57

(when (or (string-contains? source "from-path")

+58

(string-contains? source "commit:"))

+59

(error (string-append "release package contains a path or raw commit dependency: " path)))))

+60

release-package-sources)

+61

(let ((lock (read-file-string "sigil.lock")))

+62

(unless (and (string-contains? lock "name: \"sigil-websocket\"")

+63

(string-contains? lock "ref: \"^0.10.8\"")

+64

(string-contains? lock "version: \"0.10.8\"")

+65

(string-contains? lock "ref: \"^0.20.3\""))

+66

(error "workspace lock does not contain the published release dependency floors"))

+67

(when (or (string-contains? lock "from-path")

+68

(string-contains? lock "../"))

+69

(error "workspace release lock contains a local dependency source"))))

+70

+71

(define (artifact-name platform)

+72

(string-append "slate-" platform

+73

(if (string=? platform "windows-amd64") ".exe" "")))

+74

+75

(define (required-env name)

+76

(let ((value (getenv name)))

+77

(if (and value (> (string-length value) 0)) value

+78

(error (string-append name " is required")))))

+79

+80

(define (file-sha256 path)

+81

(car (string-split (out sha256sum ,path) " ")))

+82

+83

(define (copy-artifact! platform out)

+84

(let* ((source-name (if (string=? platform "windows-amd64")

+85

"slate.exe" "slate"))

+86

(source (path-join "build" platform "bin" source-name))

+87

(target (path-join out (artifact-name platform))))

+88

(unless (file-exists? source)

+89

(error (string-append "build produced no artifact: " source)))

+90

($ cp ,source ,target)))

+91

+92

(define (release-manifest version dir public-base notes-url signing-key-id)

+93

(let loop ((rest platforms) (urls #{}) (hashes #{}))

+94

(if (null? rest)

+95

#{ schema: 1 stream: "cli" latest: version platforms: urls sha256: hashes

+96

signature: #{ algorithm: "ed25519"

+97

key-id: signing-key-id

+98

url: (string-append public-base "/v" version ".json.sig") }

+99

release-notes-url: notes-url }

+100

(let* ((platform (car rest))

+101

(name (artifact-name platform))

+102

(path (path-join dir name)))

+103

(unless (file-exists? path)

+104

(error (string-append "missing release artifact: " path)))

+105

(loop (cdr rest)

+106

(dict-set urls (string->keyword platform)

+107

(string-append public-base "/v" version "/" name))

+108

(dict-set hashes (string->keyword platform)

+109

(file-sha256 path)))))))

+110

+111

(define (write-manifests! version dir)

+112

(let* ((base (or (getenv "SLATE_RELEASE_PUBLIC_BASE")

+113

"https://useslate.org/releases/cli"))

+114

(notes (string-append

+115

"https://codeberg.org/sigil/slate/releases/tag/cli-v" version))

+116

(key-id (required-env "SLATE_RELEASE_SIGNING_KEY_ID"))

+117

(encoded (string-append

+118

(json-encode

+119

(release-manifest version dir base notes key-id)) "\n")))

+120

(write-file-string (path-join dir (string-append "v" version ".json")) encoded)

+121

(write-file-string (path-join dir "latest.json") encoded)))

+122

+123

(define (sign-manifest! version dir)

+124

(let ((key (required-env "SLATE_RELEASE_SIGNING_KEY"))

+125

(manifest (path-join dir (string-append "v" version ".json")))

+126

(signature (path-join dir (string-append "v" version ".json.sig"))))

+127

;; OpenSSH writes the detached signature beside the input as PATH.sig.

+128

($ ssh-keygen -Y sign -f ,key -n slate-cli-release ,manifest)

+129

(unless (file-exists? signature)

+130

(error "ssh-keygen produced no detached manifest signature"))))

+131

+132

(define (verify-manifest-signature! version dir)

+133

(let ((allowed (required-env "SLATE_RELEASE_ALLOWED_SIGNERS"))

+134

(identity (required-env "SLATE_RELEASE_SIGNING_KEY_ID"))

+135

(manifest (path-join dir (string-append "v" version ".json")))

+136

(signature (path-join dir (string-append "v" version ".json.sig"))))

+137

(unless (file-exists? signature)

+138

(error "missing detached manifest signature"))

+139

($ ssh-keygen -Y verify -f ,allowed -I ,identity -n slate-cli-release

+140

-s ,signature in: ,(read-file-string manifest))))

+141

+142

(define (u16-le bytes offset)

+143

(+ (bytevector-u8-ref bytes offset)

+144

(* 256 (bytevector-u8-ref bytes (+ offset 1)))))

+145

+146

(define (u32-le bytes offset)

+147

(+ (u16-le bytes offset) (* 65536 (u16-le bytes (+ offset 2)))))

+148

+149

(define (bytes-at? bytes offset expected)

+150

(and (<= (+ offset (length expected)) (bytevector-length bytes))

+151

(let loop ((rest expected) (i offset))

+152

(or (null? rest)

+153

(and (= (car rest) (bytevector-u8-ref bytes i))

+154

(loop (cdr rest) (+ i 1)))))))

+155

+156

(define (valid-elf? bytes machine)

+157

(and (bytes-at? bytes 0 '(127 69 76 70))

+158

(>= (bytevector-length bytes) 20)

+159

(= (u16-le bytes 18) machine)))

+160

+161

(define (valid-mach-o? bytes cpu-type)

+162

(and (bytes-at? bytes 0 '(207 250 237 254))

+163

(>= (bytevector-length bytes) 8)

+164

(= (u32-le bytes 4) cpu-type)))

+165

+166

(define (valid-pe-amd64? bytes)

+167

(and (bytes-at? bytes 0 '(77 90))

+168

(>= (bytevector-length bytes) 64)

+169

(let ((pe-offset (u32-le bytes 60)))

+170

(and (<= (+ pe-offset 6) (bytevector-length bytes))

+171

(bytes-at? bytes pe-offset '(80 69 0 0))

+172

(= (u16-le bytes (+ pe-offset 4)) 34404)))))

+173

+174

(define (valid-platform-binary? platform bytes)

+175

(cond ((string=? platform "windows-amd64") (valid-pe-amd64? bytes))

+176

((string=? platform "macos-amd64") (valid-mach-o? bytes 16777223))

+177

((string=? platform "macos-arm64") (valid-mach-o? bytes 16777228))

+178

((or (string=? platform "linux-amd64")

+179

(string=? platform "linux-amd64-static")

+180

(string=? platform "openbsd-amd64"))

+181

(valid-elf? bytes 62))

+182

(else (valid-elf? bytes 183))))

+183

+184

(define (validate-artifact! platform path)

+185

(unless (file-exists? path)

+186

(error (string-append "missing release artifact: " path)))

+187

(unless (valid-platform-binary? platform (read-file-bytes path))

+188

(error (string-append "wrong executable format or architecture for "

+189

platform ": " path))))

+190

+191

(define (validate-release! version dir)

+192

(for-each

+193

(lambda (platform)

+194

(validate-artifact! platform

+195

(path-join dir (artifact-name platform))))

+196

platforms)

+197

(let ((versioned (path-join dir (string-append "v" version ".json")))

+198

(latest (path-join dir "latest.json")))

+199

(unless (and (file-exists? versioned) (file-exists? latest))

+200

(error "missing release manifests"))

+201

(unless (string=? (read-file-string versioned) (read-file-string latest))

+202

(error "versioned and latest CLI manifests are not byte-identical"))

+203

(verify-manifest-signature! version dir)))

+204

+205

(define (build! version out)

+206

(require-version! version)

+207

(require-release-dependencies!)

+208

(require-clean-tracked-checkout!)

+209

(requires (tools sigil git cp sha256sum ssh-keygen))

+210

(ensure-directory out)

+211

(for-each

+212

(lambda (platform)

+213

(display (string-append "Building " platform "\n"))

+214

($ sigil build slate-cli --config ,platform)

+215

(copy-artifact! platform out))

+216

platforms)

+217

(write-manifests! version out)

+218

(sign-manifest! version out)

+219

($ sha256sum

+220

,@(map (lambda (platform) (path-join out (artifact-name platform))) platforms)

+221

out: ,(path-join out "SHA256SUMS"))

+222

(validate-release! version out))

+223

+224

(define (build-dry-run version out)

+225

(require-version! version)

+226

(require-release-dependencies!)

+227

(say "DRY RUN: no files will be written and no remote calls will be made")

+228

(say "preflight: require clean tracked checkout (untracked files ignored)")

+229

(say "preflight: published Sigil 0.20.3 and sigil-websocket 0.10.8 dependencies")

+230

(say (string-append "preflight: declared CLI version = " version))

+231

(for-each

+232

(lambda (platform)

+233

(say (string-append "build: sigil build slate-cli --config " platform))

+234

(say (string-append "artifact: " (path-join out (artifact-name platform)))))

+235

platforms)

+236

(say (string-append "manifest: " (path-join out (string-append "v" version ".json"))))

+237

(say (string-append "manifest: " (path-join out "latest.json") " (byte-identical)"))

+238

(say (string-append "signature: ed25519 detached "

+239

(path-join out (string-append "v" version ".json.sig"))))

+240

(say (string-append "checksums: " (path-join out "SHA256SUMS"))))

+241

+242

(define (publish-file! bucket key path content-type cache-control)

+243

($ wrangler r2 object put --remote ,(string-append bucket "/" key)

+244

--file ,path --content-type ,content-type --cache-control ,cache-control))

+245

+246

(define (publication-plan version dir prefix)

+247

(let ((version-prefix (string-append prefix "/cli/v" version)))

+248

(append

+249

(map

+250

(lambda (platform)

+251

(list (string-append version-prefix "/" (artifact-name platform))

+252

(path-join dir (artifact-name platform))

+253

"application/octet-stream"

+254

"public, max-age=31536000, immutable"))

+255

platforms)

+256

(list

+257

(list (string-append prefix "/cli/v" version ".json")

+258

(path-join dir (string-append "v" version ".json"))

+259

"application/json" "public, max-age=31536000, immutable")

+260

(list (string-append prefix "/cli/v" version ".json.sig")

+261

(path-join dir (string-append "v" version ".json.sig"))

+262

"application/octet-stream" "public, max-age=31536000, immutable")

+263

(list (string-append prefix "/cli/latest.json")

+264

(path-join dir "latest.json")

+265

"application/json" "no-cache")))))

+266

+267

(define (print-publication-plan version dir)

+268

(require-version! version)

+269

(let ((prefix (or (getenv "SLATE_RELEASE_STAGING_PREFIX") "staging")))

+270

(say "DRY RUN: no files will be written and no remote calls will be made")

+271

(say "publication order (latest.json is the visibility switch):")

+272

(for-each

+273

(lambda (item)

+274

(say (string-append "PUT " (car item)

+275

" <- " (cadr item)

+276

" | Content-Type: " (caddr item)

+277

" | Cache-Control: " (cadddr item))))

+278

(publication-plan version dir prefix))

+279

(for-each

+280

(lambda (platform)

+281

(say (string-append "REDIRECT /downloads/cli/latest/" platform

+282

" -> /releases/cli/v" version "/"

+283

(artifact-name platform))))

+284

platforms)))

+285

+286

(define (publish! version dir)

+287

(require-version! version)

+288

(requires (tools wrangler ssh-keygen))

+289

;; Validate the complete local set before making any remote mutation.

+290

(for-each

+291

(lambda (platform)

+292

(unless (file-exists? (path-join dir (artifact-name platform)))

+293

(error (string-append "missing release artifact: " (artifact-name platform)))))

+294

platforms)

+295

(validate-release! version dir)

+296

(let* ((bucket (required-env "SLATE_RELEASE_BUCKET"))

+297

(prefix (or (getenv "SLATE_RELEASE_STAGING_PREFIX") "staging")))

+298

;; latest.json is deliberately last: it is the visibility switch.

+299

(for-each

+300

(lambda (item)

+301

(publish-file! bucket (car item) (cadr item) (caddr item) (cadddr item)))

+302

(publication-plan version dir prefix))))

+303

+304

(define (usage)

+305

(display "usage: scripts/release.sgl build|build-dry-run|publish|publish-dry-run <version> <dir>\n")

+306

(exit 2))

+307

+308

(let ((args (cddr (command-line))))

+309

(if (not (= (length args) 3)) (usage)

+310

(cond ((string=? (car args) "build") (build! (cadr args) (caddr args)))

+311

((string=? (car args) "build-dry-run")

+312

(build-dry-run (cadr args) (caddr args)))

+313

((string=? (car args) "publish") (publish! (cadr args) (caddr args)))

+314

((string=? (car args) "publish-dry-run")

+315

(print-publication-plan (cadr args) (caddr args)))

+316

(else (usage)))))

scripts/run-slate-netemadded

@@ -0,0 +1,6 @@

+1

#!/bin/sh

+2

set -eu

+3

+4

slate_root=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)

+5

export SIGIL_LOAD_PATH="$slate_root/build/dev/lib${SIGIL_LOAD_PATH:+:$SIGIL_LOAD_PATH}"

+6

exec sigil "$slate_root/packages/slate-netem/slate-netem.sgl" "$@"

scripts/test-enclave-remote-livemodified

@@ -222,6 +222,9 @@ db=$run_dir/enclave.db

222

state=$run_dir/state

223

mkdir -p "$state/slate" || harness_setup_failed "cannot create $state/slate"

224

readable=$run_dir/readable.txt

+225

image=$run_dir/preview.png

+226

printf '%s' 'iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAQAAAC1HAwCAAAAC0lEQVR42mP8/x8AAwMCAO+a4HcAAAAASUVORK5CYII=' | base64 -d >"$image"

+227

truncate -s 1600000 "$image"

228

denied=$run_dir/denied.txt

229

printf 'p3s-readable-marker\n' >"$readable" || harness_setup_failed "cannot write $readable"

230

printf 'p3s-denied-marker\n' >"$denied" || harness_setup_failed "cannot write $denied"

@@ -287,7 +290,7 @@ harness_say "SLATE-HARNESS: enclave up ws://127.0.0.1:$ws_port/ws"

290

node_log_args=()

291

[ -z "${NODE_LOG_LEVEL:-}" ] || node_log_args=(--log-level "$NODE_LOG_LEVEL")

292

XDG_STATE_HOME="$state" \

−290

SLATE_NODE_GRANTS="fs:ro:$readable,pty:on,exec:full" \

+293

SLATE_NODE_GRANTS="fs:ro:$readable,fs:ro:$image,pty:on,exec:full" \

294

stdbuf -oL -eL "$slate_bin" node run "${node_log_args[@]+"${node_log_args[@]}"}" >"$node_log" 2>&1 &

295

node_pid=$!

296

deadline=$(( $(date +%s) + READY_TIMEOUT ))

@@ -365,6 +368,7 @@ rc=0

368

P3S_ENCLAVE_WS="ws://127.0.0.1:$ws_port/ws" P3S_ACCOUNT=gate-owner \

369

P3S_CREDENTIAL="$client_credential" P3S_NODE=gate-node \

370

P3S_READABLE_PATH="$readable" P3S_DENIED_PATH="$denied" \

+371

P3S_IMAGE_PATH="$image" \

372

P3S_PTY_MARKER="$marker" P3T_SESSION_SENTINEL="$session_sentinel" \

373

guix shell binaryen -- sigil test slate --sgl --no-color "$TEST_FILE" ) \

374

> "$client_log" 2>&1 || rc=$?

scripts/test-node-direct-liveadded

@@ -0,0 +1,1031 @@

+1

#!/usr/bin/env bash

+2

# Real two-node direct-dial gate: relay fallback with no advertised endpoint,

+3

# then direct success after the same target identity enables its listener.

+4

set -eu

+5

+6

script_dir=$(CDPATH= cd -- "$(dirname -- "$0")" && pwd)

+7

slate_root=$(CDPATH= cd -- "$script_dir/.." && pwd)

+8

. "$script_dir/lib/slate-harness.sh"

+9

+10

# Keep the gate pinned to the node-dial implementation worktree by default.

+11

# ENCLAVE_ROOT remains available for CI or a differently arranged checkout.

+12

enclave_root=${ENCLAVE_ROOT:-$slate_root/.worktrees/enclave-node-dial}

+13

slate_bin=${SLATE_BIN:-$slate_root/build/dev/bin/slate}

+14

enclave_bin=${ENCLAVE_BIN:-$enclave_root/build/dev/bin/enclave}

+15

netem_bin=${NETEM_BIN:-$slate_root/scripts/run-slate-netem}

+16

test_file=packages/slate/test/node-direct-live.sgl

+17

loss_test_file=packages/slate/test/node-network-transition-live.sgl

+18

companion_restart_test_file=packages/slate/test/node-companion-restart-live.sgl

+19

target_restart_test_file=packages/slate/test/node-target-restart-live.sgl

+20

multi_root_test_file=packages/slate/test/node-multi-root-live.sgl

+21

paired_offline_test_file=packages/slate/test/node-paired-offline-live.sgl

+22

paired_offline_reject_test_file=packages/slate/test/node-paired-offline-reject-live.sgl

+23

paired_offline_invalidate_test_file=packages/slate/test/node-paired-offline-invalidate-live.sgl

+24

paired_offline_multi_root_test_file=packages/slate/test/node-paired-offline-multi-root-live.sgl

+25

pairing_seed_test_file=packages/slate/test/node-pairing-seed-live.sgl

+26

loss_scenario=$slate_root/packages/slate-netem/scenarios/node-direct-loss.scn

+27

transfer_loss_test_file=packages/slate/test/node-transfer-loss-live.sgl

+28

transfer_loss_scenario=$slate_root/packages/slate-netem/scenarios/node-transfer-loss.scn

+29

ready_timeout=${READY_TIMEOUT:-40}

+30

live_timeout=${LIVE_TIMEOUT:-180}

+31

+32

# The transition-only spelling names the lifecycle under test. Preserve the

+33

# older loss-only switch as an internal compatibility alias for the existing

+34

# harness branch conditions.

+35

if [ -n "${NODE_NETWORK_TRANSITION_ONLY:-}" ]; then

+36

NODE_DIRECT_LOSS_ONLY=1

+37

fi

+38

+39

harness_say "SLATE-HARNESS: gate node-direct-live"

+40

harness_say "SLATE-HARNESS: workspace $slate_root"

+41

[ -x "$slate_bin" ] || harness_setup_failed "missing Slate binary: $slate_bin"

+42

[ -x "$enclave_bin" ] || harness_setup_failed "missing Enclave binary: $enclave_bin"

+43

[ -x "$netem_bin" ] || harness_setup_failed "missing slate-netem binary: $netem_bin"

+44

[ -f "$slate_root/$test_file" ] || harness_setup_failed "missing live probe: $test_file"

+45

[ -f "$slate_root/$loss_test_file" ] || harness_setup_failed "missing live probe: $loss_test_file"

+46

[ -f "$slate_root/$companion_restart_test_file" ] || harness_setup_failed "missing live probe: $companion_restart_test_file"

+47

[ -f "$slate_root/$target_restart_test_file" ] || harness_setup_failed "missing live probe: $target_restart_test_file"

+48

[ -f "$slate_root/$multi_root_test_file" ] || harness_setup_failed "missing live probe: $multi_root_test_file"

+49

[ -f "$slate_root/$paired_offline_test_file" ] || harness_setup_failed "missing live probe: $paired_offline_test_file"

+50

[ -f "$slate_root/$paired_offline_reject_test_file" ] || harness_setup_failed "missing live probe: $paired_offline_reject_test_file"

+51

[ -f "$slate_root/$paired_offline_invalidate_test_file" ] || harness_setup_failed "missing live probe: $paired_offline_invalidate_test_file"

+52

[ -f "$slate_root/$paired_offline_multi_root_test_file" ] || harness_setup_failed "missing live probe: $paired_offline_multi_root_test_file"

+53

[ -f "$slate_root/$pairing_seed_test_file" ] || harness_setup_failed "missing live probe: $pairing_seed_test_file"

+54

[ -f "$loss_scenario" ] || harness_setup_failed "missing netem scenario: $loss_scenario"

+55

[ -f "$slate_root/$transfer_loss_test_file" ] || harness_setup_failed "missing live probe: $transfer_loss_test_file"

+56

[ -f "$transfer_loss_scenario" ] || harness_setup_failed "missing netem scenario: $transfer_loss_scenario"

+57

harness_require_library_tree "$slate_root" dev

+58

+59

# A direct listener intentionally rejects loopback. Select one concrete local

+60

# interface address and advertise exactly the address successfully bound.

+61

direct_host=${NODE_DIRECT_HOST:-}

+62

if [ -z "$direct_host" ]; then

+63

direct_host=$(ip -4 -o addr show scope global 2>/dev/null |

+64

awk '$2 != "lo" {

+65

split($4, a, "/");

+66

if ($2 ~ /^wg/) { print a[1]; found = 1; exit }

+67

if (fallback == "") fallback = a[1]

+68

}

+69

END { if (!found) print fallback }')

+70

fi

+71

[ -n "$direct_host" ] || harness_setup_failed \

+72

'no non-loopback IPv4 address is available for the direct listener' \

+73

'Set NODE_DIRECT_HOST to an explicitly bindable VPN/test-interface address.'

+74

harness_say "SLATE-HARNESS: direct bind $direct_host"

+75

+76

base_port=${NODE_DIRECT_BASE_PORT:-$((41000 + $$ % 8000))}

+77

irc_port=$base_port

+78

ws_port=$((base_port + 1))

+79

caller_port=$((base_port + 2))

+80

target_port=$((base_port + 3))

+81

direct_port=$((base_port + 4))

+82

netem_port=$((base_port + 5))

+83

relay_netem_port=$((base_port + 6))

+84

target_b_port=$((base_port + 7))

+85

target_b_direct_port=$((base_port + 8))

+86

run_dir=$(mktemp -d)

+87

server_pid= caller_pid= target_pid= target_b_pid= loss_client_pid= netem_pid=

+88

+89

kill_child() {

+90

local pid=${1:-}

+91

[ -n "$pid" ] || return 0

+92

kill "$pid" 2>/dev/null || true

+93

local n=0

+94

while kill -0 "$pid" 2>/dev/null && [ "$n" -lt 50 ]; do

+95

sleep 0.1

+96

n=$((n + 1))

+97

done

+98

kill -9 "$pid" 2>/dev/null || true

+99

wait "$pid" 2>/dev/null || true

+100

}

+101

cleanup() {

+102

kill_child "${loss_client_pid:-}"

+103

kill_child "${netem_pid:-}"

+104

kill_child "${target_b_pid:-}"

+105

kill_child "${target_pid:-}"

+106

kill_child "${caller_pid:-}"

+107

kill_child "${server_pid:-}"

+108

if [ -n "${NODE_DIRECT_KEEP_RUN_DIR:-}" ]; then

+109

harness_say "SLATE-HARNESS: preserved $run_dir"

+110

else

+111

rm -rf "$run_dir"

+112

fi

+113

}

+114

trap cleanup EXIT

+115

trap 'cleanup; exit 130' HUP INT TERM

+116

+117

db=$run_dir/enclave.db

+118

caller_state=$run_dir/caller-state

+119

target_state=$run_dir/target-state

+120

target_b_state=$run_dir/target-b-state

+121

mkdir -p "$caller_state/slate" "$target_state/slate" "$target_b_state/slate"

+122

readable=$run_dir/readable.txt

+123

writable_dir=$run_dir/writable

+124

writable=$writable_dir/live-write.txt

+125

recovery=$writable_dir/transfer-recovery.txt

+126

marker="node-direct-live-$PPID-$$"

+127

mkdir -p "$writable_dir"

+128

printf '%s\n' "$marker" >"$readable"

+129

printf '%s\n' initial >"$writable"

+130

printf '%s' relay-recovery >"$recovery"

+131

+132

owner=direct-owner

+133

credential=dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd

+134

ENCLAVE_DB_PATH="$db" "$enclave_bin" user add "$owner" --password "$credential" >/dev/null ||

+135

harness_setup_failed 'could not seed the live-gate owner'

+136

+137

register_bot() {

+138

local nick=$1

+139

local out token

+140

out=$(ENCLAVE_DB_PATH="$db" "$enclave_bin" bot register "$nick" --owner "$owner") || return 1

+141

token=$(printf '%s\n' "$out" |

+142

sed -n 's/.*Token (one-time display): $[0-9a-f]*$.*/\1/p' | head -1)

+143

[ "${#token}" -eq 64 ] || return 1

+144

printf '%s' "$token"

+145

}

+146

caller_token=$(register_bot gate-caller) || harness_setup_failed 'could not register caller node'

+147

target_token=$(register_bot gate-target) || harness_setup_failed 'could not register target node'

+148

target_b_token=$(register_bot gate-target-b) || harness_setup_failed 'could not register second target node'

+149

+150

bot_id() {

+151

local nick=$1 id

+152

id=$(ENCLAVE_DB_PATH="$db" "$enclave_bin" bot list |

+153

sed -n "s/.*bot=$nick id=$[0-9][0-9]*$.*/\1/p" | head -1)

+154

[ -n "$id" ] || return 1

+155

printf '%s' "$id"

+156

}

+157

caller_bot_id=$(bot_id gate-caller) || harness_setup_failed 'could not resolve caller bot id'

+158

target_bot_id=$(bot_id gate-target) || harness_setup_failed 'could not resolve target bot id'

+159

target_b_bot_id=$(bot_id gate-target-b) || harness_setup_failed 'could not resolve second target bot id'

+160

+161

write_identity() {

+162

local state=$1 nick=$2 bot_id=$3 token=$4 connect_port=${5:-$ws_port}

+163

local stream_port=${6:-$connect_port}

+164

  printf '{"version":1,"origin":"http://127.0.0.1:%s","websocket-url":"ws://127.0.0.1:%s/ws","stream-websocket-url":"ws://127.0.0.1:%s/ws","node-name":"%s","transport-nick":"%s","bot-id":"%s","token":"%s"}\n' \

+165

"$ws_port" "$connect_port" "$stream_port" "$nick" "$nick" "$bot_id" "$token" \

+166

>"$state/slate/enclave-node.json"

+167

chmod 700 "$state/slate"

+168

chmod 600 "$state/slate/enclave-node.json"

+169

}

+170

write_identity "$caller_state" gate-caller "$caller_bot_id" "$caller_token"

+171

write_identity "$target_state" gate-target "$target_bot_id" "$target_token"

+172

write_identity "$target_b_state" gate-target-b "$target_b_bot_id" "$target_b_token"

+173

+174

# Native sigil-websocket does not expose an Origin-header option. Seed a normal

+175

# salted token entry for its empty Origin in this disposable state directory;

+176

# the daemon still authenticates through the production token verifier.

+177

companion_token=flt_node_direct_live

+178

companion_salt=node-direct-live-salt

+179

companion_hash=$(printf '%s' "$companion_salt$companion_token" | sha256sum | awk '{print $1}')

+180

printf '[{"id":"live-gate","origin":"","label":"native live gate","salt":"%s","token-hash":"%s","created":1,"last-seen":1}]\n' \

+181

"$companion_salt" "$companion_hash" >"$caller_state/slate/origins.json"

+182

chmod 600 "$caller_state/slate/origins.json"

+183

+184

server_log=$run_dir/server.log

+185

caller_log=$run_dir/caller.log

+186

target_log=$run_dir/target.log

+187

target_b_log=$run_dir/target-b.log

+188

node_log_args=()

+189

[ -z "${NODE_LOG_LEVEL:-}" ] || node_log_args=(--log-level "$NODE_LOG_LEVEL")

+190

ENCLAVE_DB_PATH="$db" ENCLAVE_PORT="$irc_port" ENCLAVE_WS_PORT="$ws_port" \

+191

"$enclave_bin" dev >"$server_log" 2>&1 &

+192

server_pid=$!

+193

+194

wait_log() {

+195

local pid=$1 file=$2 pattern=$3 label=$4

+196

local deadline=$(( $(date +%s) + ready_timeout ))

+197

until grep -q "$pattern" "$file" 2>/dev/null; do

+198

if ! kill -0 "$pid" 2>/dev/null; then

+199

cat "$file" >&2 || true

+200

harness_setup_failed "$label exited before readiness"

+201

fi

+202

if [ "$(date +%s)" -ge "$deadline" ]; then

+203

cat "$file" >&2 || true

+204

harness_setup_failed "$label was not ready within ${ready_timeout}s"

+205

fi

+206

sleep 0.05

+207

done

+208

}

+209

wait_log "$server_pid" "$server_log" 'ws-listener-ready\|WebSocket listening' Enclave

+210

+211

wait_health() {

+212

local pid=$1 port=$2 label=$3

+213

local deadline=$(( $(date +%s) + ready_timeout ))

+214

until curl -fsS "http://127.0.0.1:$port/node/health" >/dev/null 2>&1; do

+215

if ! kill -0 "$pid" 2>/dev/null; then

+216

harness_setup_failed "$label exited before its local listener was ready"

+217

fi

+218

if [ "$(date +%s)" -ge "$deadline" ]; then

+219

harness_setup_failed "$label local listener was not ready within ${ready_timeout}s"

+220

fi

+221

sleep 0.05

+222

done

+223

}

+224

+225

start_caller() {

+226

local mutation=${1:-}

+227

: >"$caller_log"

+228

if [ -n "$mutation" ]; then

+229

XDG_STATE_HOME="$caller_state" SLATE_DEV=1 \

+230

SLATE_DIRECT_TEST_MUTATION="$mutation" \

+231

SLATE_NODE_GRANTS="fs:ro:$readable" \

+232

stdbuf -oL -eL "$slate_bin" node run --port "$caller_port" \

+233

--log-level info >"$caller_log" 2>&1 &

+234

else

+235

XDG_STATE_HOME="$caller_state" SLATE_NODE_GRANTS="fs:ro:$readable" \

+236

stdbuf -oL -eL "$slate_bin" node run --port "$caller_port" \

+237

"${node_log_args[@]+"${node_log_args[@]}"}" \

+238

>"$caller_log" 2>&1 &

+239

fi

+240

caller_pid=$!

+241

wait_log "$caller_pid" "$caller_log" \

+242

'Slate node connected to Enclave as gate-caller' 'caller node'

+243

}

+244

+245

start_caller

+246

+247

start_target() {

+248

local mode=$1

+249

local target_log_args=()

+250

if [ -n "${NODE_DIRECT_CHILD_LOGS:-}" ]; then

+251

target_log_args=(--log "$run_dir/target-child.log" --log-level "${NODE_LOG_LEVEL:-info}")

+252

fi

+253

: >"$target_log"

+254

if [ "$mode" = relay-proxied ]; then

+255

write_identity "$target_state" gate-target "$target_bot_id" "$target_token" "$ws_port" "$relay_netem_port"

+256

else

+257

write_identity "$target_state" gate-target "$target_bot_id" "$target_token" "$ws_port"

+258

fi

+259

if [ "$mode" = direct ] || [ "$mode" = proxied ]; then

+260

direct_extra=()

+261

if [ "$mode" = proxied ]; then

+262

direct_extra=(--direct-advertise-port "$netem_port")

+263

fi

+264

XDG_STATE_HOME="$target_state" SLATE_DEV=1 \

+265

SLATE_NODE_GRANTS="fs:ro:$readable,fs:rw:$writable_dir,pty:on,exec:full" \

+266

stdbuf -oL -eL "$slate_bin" node run --port "$target_port" \

+267

--direct-host "$direct_host" --direct-port "$direct_port" \

+268

"${direct_extra[@]+"${direct_extra[@]}"}" \

+269

"${node_log_args[@]+"${node_log_args[@]}"}" \

+270

"${target_log_args[@]+"${target_log_args[@]}"}" \

+271

>"$target_log" 2>&1 &

+272

else

+273

XDG_STATE_HOME="$target_state" SLATE_NODE_GRANTS="fs:ro:$readable,fs:rw:$writable_dir,pty:on,exec:full" \

+274

stdbuf -oL -eL "$slate_bin" node run --port "$target_port" \

+275

"${node_log_args[@]+"${node_log_args[@]}"}" \

+276

"${target_log_args[@]+"${target_log_args[@]}"}" \

+277

>"$target_log" 2>&1 &

+278

fi

+279

target_pid=$!

+280

wait_log "$target_pid" "$target_log" 'Slate node connected to Enclave as gate-target' 'target node'

+281

if [ "$mode" = direct ] || [ "$mode" = proxied ]; then

+282

advertised_port=$direct_port

+283

[ "$mode" = proxied ] && advertised_port=$netem_port

+284

grep -q "direct ws : ws://$direct_host:$advertised_port/node/direct" "$target_log" || {

+285

cat "$target_log" >&2

+286

harness_setup_failed 'target authenticated but did not publish the requested direct listener'

+287

}

+288

fi

+289

}

+290

+291

start_target_b() {

+292

local mode=${1:-relay}

+293

local direct_args=()

+294

if [ "$mode" = direct ]; then

+295

direct_args=(--direct-host "$direct_host" --direct-port "$target_b_direct_port")

+296

fi

+297

: >"$target_b_log"

+298

write_identity "$target_b_state" gate-target-b "$target_b_bot_id" "$target_b_token" "$ws_port"

+299

XDG_STATE_HOME="$target_b_state" \

+300

SLATE_NODE_GRANTS="fs:ro:$readable,fs:rw:$writable_dir,pty:on,exec:full" \

+301

stdbuf -oL -eL "$slate_bin" node run --port "$target_b_port" \

+302

"${direct_args[@]+"${direct_args[@]}"}" \

+303

"${node_log_args[@]+"${node_log_args[@]}"}" \

+304

>"$target_b_log" 2>&1 &

+305

target_b_pid=$!

+306

wait_log "$target_b_pid" "$target_b_log" \

+307

'Slate node connected to Enclave as gate-target-b' 'second target node'

+308

if [ "$mode" = direct ]; then

+309

grep -q "direct ws : ws://$direct_host:$target_b_direct_port/node/direct" "$target_b_log" ||

+310

harness_setup_failed 'second target did not publish its direct listener'

+311

fi

+312

}

+313

+314

run_multi_root() {

+315

local multi_log=$run_dir/client-multi-root.log rc=0

+316

(cd "$slate_root" &&

+317

timeout --signal=TERM --kill-after=10 "$live_timeout" \

+318

env PATH="$HOME/.sigil/toolchain/zig:$PATH" \

+319

SLATE_TEST_SRC="$slate_root/packages/slate/src" \

+320

NODE_DIRECT_ENCLAVE_WS="ws://127.0.0.1:$ws_port/ws" \

+321

NODE_DIRECT_ACCOUNT="$owner" NODE_DIRECT_CREDENTIAL="$credential" \

+322

NODE_DIRECT_COMPANION_WS="ws://127.0.0.1:$caller_port/node/ws" \

+323

NODE_DIRECT_COMPANION_TOKEN="$companion_token" \

+324

NODE_MULTI_ROOT_A=gate-target NODE_MULTI_ROOT_B=gate-target-b \

+325

NODE_DIRECT_MARKER="$marker" \

+326

guix shell binaryen -- sigil test slate --sgl --no-color "$multi_root_test_file") \

+327

>"$multi_log" 2>&1 || rc=$?

+328

cat "$multi_log"

+329

if [ "$rc" -eq 124 ] || [ "$rc" -eq 137 ]; then

+330

cat "$caller_log" "$target_log" "$target_b_log" "$server_log" >&2

+331

exit "$HARNESS_TIMED_OUT"

+332

fi

+333

local verdict=0

+334

harness_verdict "$multi_log" 1 || verdict=$?

+335

[ "$verdict" -eq "$HARNESS_GREEN" ] || exit "$verdict"

+336

harness_say 'SLATE-HARNESS: PASS concurrent direct and relay roots remained isolated'

+337

}

+338

+339

run_probe() {

+340

local expected=$1 target_name=${2:-gate-target}

+341

local client_log=$run_dir/client-$target_name-$expected.log rc=0

+342

(cd "$slate_root" &&

+343

timeout --signal=TERM --kill-after=10 "$live_timeout" \

+344

env PATH="$HOME/.sigil/toolchain/zig:$PATH" \

+345

SLATE_TEST_SRC="$slate_root/packages/slate/src" \

+346

NODE_DIRECT_ENCLAVE_WS="ws://127.0.0.1:$ws_port/ws" \

+347

NODE_DIRECT_ACCOUNT="$owner" NODE_DIRECT_CREDENTIAL="$credential" \

+348

NODE_DIRECT_COMPANION_WS="ws://127.0.0.1:$caller_port/node/ws" \

+349

NODE_DIRECT_COMPANION_TOKEN="$companion_token" \

+350

NODE_DIRECT_TARGET="$target_name" NODE_DIRECT_READABLE="$readable" \

+351

NODE_DIRECT_WRITABLE="$writable" \

+352

NODE_DIRECT_MARKER="$marker" NODE_DIRECT_EXPECT_TRANSPORT="$expected" \

+353

guix shell binaryen -- sigil test slate --sgl --no-color "$test_file") \

+354

>"$client_log" 2>&1 || rc=$?

+355

cat "$client_log"

+356

if [ "$rc" -eq 124 ] || [ "$rc" -eq 137 ]; then

+357

cat "$caller_log" "$target_log" "$server_log" >&2

+358

exit "$HARNESS_TIMED_OUT"

+359

fi

+360

local verdict=0

+361

harness_verdict "$client_log" 1 || verdict=$?

+362

if [ "$verdict" -ne "$HARNESS_GREEN" ]; then

+363

harness_err '---- caller log ----'; cat "$caller_log" >&2

+364

harness_err '---- target log ----'; cat "$target_log" >&2

+365

harness_err '---- server log ----'; cat "$server_log" >&2

+366

exit "$verdict"

+367

fi

+368

harness_say "SLATE-HARNESS: PASS real carrier selected $expected"

+369

}

+370

+371

run_pairing_seed() {

+372

local target_name=$1 seed_log=$run_dir/client-seed-$1.log rc=0

+373

(cd "$slate_root" &&

+374

timeout --signal=TERM --kill-after=10 "$live_timeout" \

+375

env PATH="$HOME/.sigil/toolchain/zig:$PATH" \

+376

SLATE_TEST_SRC="$slate_root/packages/slate/src" \

+377

NODE_DIRECT_ENCLAVE_WS="ws://127.0.0.1:$ws_port/ws" \

+378

NODE_DIRECT_ACCOUNT="$owner" NODE_DIRECT_CREDENTIAL="$credential" \

+379

NODE_DIRECT_COMPANION_WS="ws://127.0.0.1:$caller_port/node/ws" \

+380

NODE_DIRECT_COMPANION_TOKEN="$companion_token" \

+381

NODE_DIRECT_TARGET="$target_name" NODE_DIRECT_READABLE="$readable" \

+382

NODE_DIRECT_MARKER="$marker" \

+383

guix shell binaryen -- sigil test slate --sgl --no-color \

+384

"$pairing_seed_test_file") >"$seed_log" 2>&1 || rc=$?

+385

cat "$seed_log"

+386

if [ "$rc" -eq 124 ] || [ "$rc" -eq 137 ]; then exit "$HARNESS_TIMED_OUT"; fi

+387

local verdict=0

+388

harness_verdict "$seed_log" 1 || verdict=$?

+389

[ "$verdict" -eq "$HARNESS_GREEN" ] || exit "$verdict"

+390

}

+391

+392

run_companion_restart() {

+393

local restart_flag=$run_dir/companion-restart-ready

+394

local session_sentinel=$run_dir/companion-session-sentinel

+395

local restart_log=$run_dir/client-companion-restart.log

+396

local restart_rc_file=$run_dir/client-companion-restart.rc

+397

(cd "$slate_root" &&

+398

set +e

+399

timeout --signal=TERM --kill-after=10 "$live_timeout" \

+400

env PATH="$HOME/.sigil/toolchain/zig:$PATH" \

+401

SLATE_TEST_SRC="$slate_root/packages/slate/src" \

+402

NODE_DIRECT_ENCLAVE_WS="ws://127.0.0.1:$ws_port/ws" \

+403

NODE_DIRECT_ACCOUNT="$owner" NODE_DIRECT_CREDENTIAL="$credential" \

+404

NODE_DIRECT_COMPANION_WS="ws://127.0.0.1:$caller_port/node/ws" \

+405

NODE_DIRECT_COMPANION_TOKEN="$companion_token" \

+406

NODE_DIRECT_TARGET=gate-target NODE_DIRECT_MARKER="$marker" \

+407

NODE_COMPANION_RESTART_FLAG="$restart_flag" \

+408

NODE_DIRECT_SESSION_SENTINEL="$session_sentinel" \

+409

guix shell binaryen -- sigil test slate --sgl --no-color "$companion_restart_test_file"

+410

restart_rc=$?

+411

printf '%s\n' "$restart_rc" >"$restart_rc_file"

+412

exit "$restart_rc") >"$restart_log" 2>&1 &

+413

loss_client_pid=$!

+414

+415

local deadline=$(( $(date +%s) + ready_timeout ))

+416

until [ -f "$restart_flag" ]; do

+417

if ! kill -0 "$loss_client_pid" 2>/dev/null; then

+418

cat "$restart_log" >&2 || true

+419

harness_setup_failed 'companion-restart client exited before arming restart'

+420

fi

+421

if [ "$(date +%s)" -ge "$deadline" ]; then

+422

cat "$restart_log" >&2 || true

+423

harness_setup_failed 'companion-restart client did not arm restart'

+424

fi

+425

sleep 0.02

+426

done

+427

kill_child "$caller_pid"

+428

caller_pid=

+429

sleep 0.2

+430

start_caller

+431

wait "$loss_client_pid" 2>/dev/null || true

+432

loss_client_pid=

+433

cat "$restart_log"

+434

local restart_rc

+435

restart_rc=$(cat "$restart_rc_file" 2>/dev/null || printf '1')

+436

if [ "$restart_rc" -eq 124 ] || [ "$restart_rc" -eq 137 ]; then

+437

exit "$HARNESS_TIMED_OUT"

+438

fi

+439

local restart_verdict=0

+440

harness_verdict "$restart_log" 1 || restart_verdict=$?

+441

[ "$restart_verdict" -eq "$HARNESS_GREEN" ] || exit "$restart_verdict"

+442

harness_say 'SLATE-HARNESS: PASS companion restart reattached the original PTY'

+443

}

+444

+445

run_target_restart() {

+446

local restart_flag=$run_dir/target-restart-ready

+447

local session_sentinel=$run_dir/target-session-sentinel

+448

local restart_log=$run_dir/client-target-restart.log

+449

local restart_rc_file=$run_dir/client-target-restart.rc

+450

(cd "$slate_root" &&

+451

set +e

+452

timeout --signal=TERM --kill-after=10 "$live_timeout" \

+453

env PATH="$HOME/.sigil/toolchain/zig:$PATH" \

+454

SLATE_TEST_SRC="$slate_root/packages/slate/src" \

+455

NODE_DIRECT_ENCLAVE_WS="ws://127.0.0.1:$ws_port/ws" \

+456

NODE_DIRECT_ACCOUNT="$owner" NODE_DIRECT_CREDENTIAL="$credential" \

+457

NODE_DIRECT_COMPANION_WS="ws://127.0.0.1:$caller_port/node/ws" \

+458

NODE_DIRECT_COMPANION_TOKEN="$companion_token" \

+459

NODE_DIRECT_TARGET=gate-target NODE_DIRECT_MARKER="$marker" \

+460

NODE_TARGET_RESTART_FLAG="$restart_flag" \

+461

NODE_DIRECT_SESSION_SENTINEL="$session_sentinel" \

+462

guix shell binaryen -- sigil test slate --sgl --no-color "$target_restart_test_file"

+463

restart_rc=$?

+464

printf '%s\n' "$restart_rc" >"$restart_rc_file"

+465

exit "$restart_rc") >"$restart_log" 2>&1 &

+466

loss_client_pid=$!

+467

+468

local deadline=$(( $(date +%s) + ready_timeout ))

+469

until [ -f "$restart_flag" ]; do

+470

if ! kill -0 "$loss_client_pid" 2>/dev/null; then

+471

cat "$restart_log" >&2 || true

+472

harness_setup_failed 'target-restart client exited before arming restart'

+473

fi

+474

if [ "$(date +%s)" -ge "$deadline" ]; then

+475

cat "$restart_log" >&2 || true

+476

harness_setup_failed 'target-restart client did not arm restart'

+477

fi

+478

sleep 0.02

+479

done

+480

kill_child "$target_pid"

+481

target_pid=

+482

# Holders use die-with-parent. Let that process tree finish and unlink its

+483

# control sockets before the replacement node performs its startup sweep;

+484

# otherwise it can briefly preserve a socket whose holder is still exiting.

+485

sleep 1.5

+486

start_target relay

+487

wait "$loss_client_pid" 2>/dev/null || true

+488

loss_client_pid=

+489

cat "$restart_log"

+490

local restart_rc

+491

restart_rc=$(cat "$restart_rc_file" 2>/dev/null || printf '1')

+492

if [ "$restart_rc" -eq 124 ] || [ "$restart_rc" -eq 137 ]; then

+493

exit "$HARNESS_TIMED_OUT"

+494

fi

+495

local restart_verdict=0

+496

harness_verdict "$restart_log" 1 || restart_verdict=$?

+497

[ "$restart_verdict" -eq "$HARNESS_GREEN" ] || exit "$restart_verdict"

+498

harness_say 'SLATE-HARNESS: PASS target restart settled the old PTY without replacement'

+499

# A new client lifetime proves the replacement target can establish a fresh

Showing the first 500 of 1032 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

sigil.lockmodified

@@ -1,29 +1,40 @@

1

;; Auto-generated by sigil deps install. Do not edit.

2

(lock

+3

(package name: "sigil-stdlib"

+4

url: "codeberg:sigil/sigil"

+5

sha: "9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95"

+6

package-selector: "sigil-stdlib"

+7

version: "0.22.0")

+8

(package name: "sigil-test"

+9

url: "codeberg:sigil/sigil"

+10

ref: ">=0.20"

+11

sha: "9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95"

+12

package-selector: "sigil-test"

+13

version: "0.22.0")

+14

(package name: "sigil-test-runner"

+15

url: "codeberg:sigil/sigil"

+16

ref: ">=0.20"

+17

sha: "9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95"

+18

package-selector: "sigil-test-runner"

+19

version: "0.22.0")

20

(package name: "sigil-wasm-runtime"

21

url: "codeberg:sigil/sigil"

−5

ref: "^0.20"

−6

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

+22

ref: ">=0.20"

+23

sha: "6cab4724e4512cb5ff9339ffe6964ed286759d8c"

24

package-selector: "sigil-wasm-runtime"

−8

version: "0.20.2")

+25

version: "0.22.0")

26

(package name: "sigil-lib"

27

url: "codeberg:sigil/sigil"

−11

ref: "^0.19"

−12

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

+28

ref: ">=0.21"

+29

sha: "9fdbd7aff420e65c8c2c73f0f97abf8dbfae2d95"

30

package-selector: "sigil-lib"

−14

version: "0.20.2")

−15

(package name: "sigil-stdlib"

−16

url: "codeberg:sigil/sigil"

−17

ref: "^0.20"

−18

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

−19

package-selector: "sigil-stdlib"

−20

version: "0.20.2")

+31

version: "0.22.0")

32

(package name: "sigil-format"

33

url: "codeberg:sigil/sigil"

−23

ref: "^0.20"

−24

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

+34

ref: ">=0.20"

+35

sha: "6cab4724e4512cb5ff9339ffe6964ed286759d8c"

36

package-selector: "sigil-format"

−26

version: "0.20.2")

+37

version: "0.22.0")

38

(package name: "sigil-markdown"

39

url: "codeberg:sigil/sigil-markdown"

40

ref: "^0.9.1"

@@ -38,16 +49,16 @@

49

version: "0.15.4")

50

(package name: "sigil-wasm-dom"

51

url: "codeberg:sigil/sigil"

−41

ref: "^0.20"

−42

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

+52

ref: ">=0.20"

+53

sha: "6cab4724e4512cb5ff9339ffe6964ed286759d8c"

54

package-selector: "sigil-wasm-dom"

−44

version: "0.20.2")

+55

version: "0.22.0")

56

(package name: "sigil-browser"

57

url: "codeberg:sigil/sigil"

−47

ref: "^0.20"

−48

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

+58

ref: ">=0.20"

+59

sha: "6cab4724e4512cb5ff9339ffe6964ed286759d8c"

60

package-selector: "sigil-browser"

−50

version: "0.20.2")

+61

version: "0.22.0")

62

(package name: "enclave-rpc"

63

url: "codeberg:sigil/enclave"

64

ref: "^0.3"

@@ -56,58 +67,52 @@

67

version: "0.3.0")

68

(package name: "sigil-irc"

69

url: "codeberg:sigil/sigil-irc"

−59

ref: "^0.16"

−60

sha: "3698a4519d11557b2d5f9bc8b752a72f3ec0f387"

+70

ref: "^0.16.5"

+71

sha: "a3f76b68ed44efe94f49b6abea3c97c71f8dea54"

72

package-selector: "sigil-irc"

−62

version: "0.16.4")

+73

version: "0.16.5")

74

(package name: "sigil-irc-websocket"

75

url: "codeberg:sigil/sigil-irc"

−65

ref: "^0.16"

−66

sha: "3698a4519d11557b2d5f9bc8b752a72f3ec0f387"

+76

ref: "^0.16.5"

+77

sha: "a3f76b68ed44efe94f49b6abea3c97c71f8dea54"

78

package-selector: "sigil-irc-websocket"

−68

version: "0.16.4")

+79

version: "0.16.5")

80

(package name: "sigil-websocket"

81

url: "codeberg:sigil/sigil-websocket"

−71

ref: "^0.10.7"

−72

sha: "6c181e52c71a2838980fc376e1e062176ee9dd45"

+82

ref: "^0.10.13"

+83

sha: "2b0f82a1ecc474ec0af0d8ee8dcaf7befd05e4f5"

84

package-selector: "sigil-websocket"

−74

version: "0.10.7")

+85

version: "0.10.13")

86

(package name: "sigil-wasm-net"

87

url: "codeberg:sigil/sigil"

−77

ref: "^0.20"

−78

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

+88

ref: ">=0.20"

+89

sha: "6cab4724e4512cb5ff9339ffe6964ed286759d8c"

90

package-selector: "sigil-wasm-net"

−80

version: "0.20.2")

+91

version: "0.22.0")

92

(package name: "sigil-wire"

93

url: "codeberg:sigil/sigil-wire"

94

ref: "^0.1"

95

sha: "980678c6b2a9318135a635c3f92f938e1589c961"

96

package-selector: "sigil-wire"

97

version: "0.1.0")

+98

(package name: "sigil-log"

+99

url: "codeberg:sigil/sigil-log"

+100

ref: "^0.17"

+101

sha: "e50644a2d73729cca94f7c6dfd4934f4d8530c21"

+102

package-selector: "sigil-log"

+103

version: "0.17.0")

104

(package name: "sigil-vt"

105

url: "codeberg:sigil/sigil-vt"

106

ref: "^0.1.0"

−90

sha: "9d719e4254bff07f0af46dcba0909758c329f2e1"

+107

sha: "c8569cf54c91f4341c36d0e610986b96daa311c5"

108

package-selector: "sigil-vt"

−92

version: "0.1.2")

+109

version: "0.1.3")

110

(package name: "sigil-doc"

111

url: "codeberg:sigil/sigil-doc"

112

ref: "^0.1.3"

113

sha: "0b7c5caca6a087d8df65e1792f8d2f584511fb56"

114

package-selector: "sigil-doc"

115

version: "0.1.4")

−99

(package name: "sigil-test"

−100

url: "codeberg:sigil/sigil"

−101

ref: "^0.20"

−102

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

−103

package-selector: "sigil-test"

−104

version: "0.20.2")

−105

(package name: "sigil-test-runner"

−106

url: "codeberg:sigil/sigil"

−107

ref: "^0.20"

−108

sha: "bf1759f72cdb604e4a66123f186d4c7d8c850445"

−109

package-selector: "sigil-test-runner"

−110

version: "0.20.2")

116

(package name: "sigil-system"

117

url: "codeberg:sigil/sigil-system"

118

ref: "^0.1"

@@ -130,44 +135,47 @@

135

version: "0.17.5")

136

(package name: "sigil-crypto"

137

url: "codeberg:sigil/sigil-crypto"

−133

ref: "^0.16"

−134

sha: "debba4462b7ff4de143db9e0792b8606fdc455bc"

−135

version: "0.16.5")

−136

(package name: "sigil-log"

−137

url: "codeberg:sigil/sigil-log"

−138

ref: "^0.17"

−139

sha: "e50644a2d73729cca94f7c6dfd4934f4d8530c21"

−140

version: "0.17.0")

+138

ref: "^0.16.6"

+139

sha: "71362137db0596e0695791b32c4f6e8faf11b39e"

+140

version: "0.16.6")

+141

(package name: "sigil-tls"

+142

url: "codeberg:sigil/sigil-tls"

+143

ref: "^0.16.7"

+144

sha: "8b1c4658df861b1c31cd7674d9607249ca7d6a27"

+145

version: "0.16.7")

+146

(package name: "sigil-shell"

+147

url: "codeberg:sigil/sigil"

+148

ref: ">=0.20"

+149

sha: "6cab4724e4512cb5ff9339ffe6964ed286759d8c"

+150

package-selector: "sigil-shell"

+151

version: "0.22.0")

152

(package name: "lantern"

153

url: "codeberg:sigil/lantern"

+154

ref: "^0.1.4"

155

sha: "16cf13897cb48e4cc1eb4065a9969dfbf23d73f6"

156

package-selector: "lantern"

157

version: "0.1.4")

158

(package name: "lantern-system"

159

url: "codeberg:sigil/lantern"

+160

ref: "^0.1.4"

161

sha: "16cf13897cb48e4cc1eb4065a9969dfbf23d73f6"

162

package-selector: "lantern-system"

163

version: "0.1.4")

−151

(package name: "sigil-tls"

−152

url: "codeberg:sigil/sigil-tls"

−153

ref: "^0.16"

−154

sha: "4cde885f8bbb15b1457b0293a5b9fa7d292cfc46"

−155

version: "0.16.6")

+164

(package name: "sigil-sqlite"

+165

url: "codeberg:sigil/sigil-sqlite"

+166

ref: "^0.16.0"

+167

sha: "569ef1063dda8f5989968644af31fc09c64b4bfe"

+168

version: "0.16.3")

169

(package name: "sigil-sxml"

170

url: "codeberg:sigil/sigil-sxml"

171

ref: "^0.15.0"

172

sha: "5a4f043247600f58bdabae19de55664d759a30c9"

173

version: "0.15.0")

−161

(package name: "sigil-sqlite"

−162

url: "codeberg:sigil/sigil-sqlite"

−163

ref: "^0.16.0"

−164

sha: "3d441fb32a216aaf99d0e2732bef5877e91d5d48"

−165

version: "0.16.2")

174

(package name: "sigil-nrepl"

175

url: "codeberg:sigil/sigil-nrepl"

176

ref: "^0.17.1"

−169

sha: "3d741f14b046ed7a3e39017a3a6d7229be4537a8"

−170

version: "0.17.1")

+177

sha: "666cb4d09af907e22c5146e74a0b5766ba53a751"

+178

version: "0.17.2")

179

(package name: "sigil-ffi"

180

url: "codeberg:sigil/sigil-ffi"

181

ref: "^0.16.3"

@@ -175,8 +183,8 @@

183

version: "0.16.3")

184

(package name: "sigil-repl"

185

url: "codeberg:sigil/sigil"

−178

ref: "^0.19"

−179

sha: "c9719987aa3c866291db10b29044bc21a4790c31"

+186

ref: ">=0.19"

+187

sha: "6cab4724e4512cb5ff9339ffe6964ed286759d8c"

188

package-selector: "sigil-repl"

−181

version: "0.19.4")

+189

version: "0.22.0")

190

)