effect 4.0.7 → 4.1.1

package/src/eventlog/EventLogRemote.ts

@@ -11,6 +11,7 @@
  * @stability unstable
  * @since 4.0.0
  */
+import * as Arr from "../Array.ts"
 import * as Cache from "../Cache.ts"
 import * as Context from "../Context.ts"
 import * as Data from "../Data.ts"
@@ -19,27 +20,38 @@ import * as Layer from "../Layer.ts"
 import * as Predicate from "../Predicate.ts"
 import * as Queue from "../Queue.ts"
 import * as Redacted from "../Redacted.ts"
+import * as Result from "../Result.ts"
 import * as RpcClient from "../rpc/RpcClient.ts"
 import type { RpcClientError } from "../rpc/RpcClientError.ts"
 import type * as RpcGroup from "../rpc/RpcGroup.ts"
 import type * as Schema from "../Schema.ts"
 import type * as Scope from "../Scope.ts"
+import * as Stream from "../Stream.ts"
 import { type Entry, type EventJournal, type EventJournalError, RemoteEntry, type RemoteId } from "./EventJournal.ts"
 import { type Identity, Registry } from "./EventLog.ts"
-import { EventLogEncryption, layerSubtle } from "./EventLogEncryption.ts"
+import { type EncryptedBatch, EventLogEncryption, layerSubtle } from "./EventLogEncryption.ts"
 import {
   Authenticate,
   ChangesRpc,
   ChunkedMessage,
+  type CompactionBeginResult,
+  type CompactionInputHeader,
+  CompactionInputRpc,
+  CompactionPartRpc,
+  type CompactionResult,
+  type CompactionStatus,
+  EventLogCompactionRpcs,
   EventLogProtocolError,
   EventLogRemoteRpcs,
   type HelloResponse,
+  type SingleMessage,
   type StoreId,
   type WriteAck,
   WriteEntries,
   WriteEntriesUnencrypted
 } from "./EventLogMessage.ts"
 import { encodeSessionAuthPayload, signSessionAuthPayloadBytes } from "./EventLogSessionAuth.ts"
+import { toBatches } from "./internal/batches.ts"
 import { makeGetIdentityRootSecretMaterial } from "./internal/identityRootSecretDerivation.ts"
 
 /**
@@ -87,8 +99,82 @@ export class EventLogRemote extends Context.Service<EventLogRemote, {
   readonly whenAuthenticated: <A, E, R>(
     effect: Effect.Effect<A, E, R>
   ) => Effect.Effect<A, E | EventLogRemoteError, R | Identity>
+  /**
+   * Encrypted remote compaction. Present when the remote advertises
+   * `HelloResponse.compaction` and the RPC client includes
+   * `EventLogCompactionRpcs`.
+   */
+  readonly compaction?: EventLogRemoteCompaction | undefined
 }>()("effect/eventlog/EventLogRemote") {}
 
+/**
+ * A stage opened by `EventLogRemoteCompaction.begin`, with the identity and
+ * store it belongs to.
+ *
+ * @stability unstable
+ * @category models
+ * @since 4.0.0
+ */
+export interface CompactionStage {
+  readonly identity: Identity["Service"]
+  readonly storeId: StoreId
+  readonly stageId: string
+}
+
+/**
+ * Client side of encrypted remote compaction.
+ *
+ * **Details**
+ *
+ * A run opens a stage with `begin`, reads its input headers with `input`,
+ * fetches the batches it needs with `fetch`, uploads the kept entries with
+ * `upload` and calls `commit`. `abort` releases a stage that won't be
+ * committed.
+ *
+ * @stability unstable
+ * @category models
+ * @since 4.0.0
+ */
+export interface EventLogRemoteCompaction {
+  readonly status: (options: {
+    readonly identity: Identity["Service"]
+    readonly storeId: StoreId
+  }) => Effect.Effect<CompactionStatus, EventLogRemoteError>
+  readonly begin: (options: {
+    readonly identity: Identity["Service"]
+    readonly storeId: StoreId
+  }) => Effect.Effect<CompactionBeginResult, EventLogRemoteError>
+  /**
+   * Streams the stage's input batch headers in input order.
+   */
+  readonly input: (stage: CompactionStage) => Stream.Stream<CompactionInputHeader, EventLogRemoteError>
+  /**
+   * Fetches and decrypts the input batches at the given input sequences.
+   */
+  readonly fetch: (
+    stage: CompactionStage,
+    sequences: ReadonlyArray<number>
+  ) => Stream.Stream<RemoteEntry, EventLogRemoteError>
+  /**
+   * Encrypts the kept entries, in input-sequence order, and uploads them in
+   * segments of about `ChunkedMessage.chunkSize`. An oversized segment is
+   * split into pieces, and a segment is resent in full after a dropped
+   * connection.
+   */
+  readonly upload: (
+    stage: CompactionStage,
+    entries: ReadonlyArray<Entry>
+  ) => Effect.Effect<{ readonly segmentCount: number }, EventLogRemoteError>
+  readonly commit: (
+    stage: CompactionStage,
+    result: CompactionResult
+  ) => Effect.Effect<"Committed" | "Superseded", EventLogRemoteError>
+  /**
+   * Releases the stage. Failures are ignored.
+   */
+  readonly abort: (stage: CompactionStage) => Effect.Effect<void>
+}
+
 /**
  * Error raised by `EventLogRemote` operations, recording the failed method and
  * underlying cause.
@@ -112,7 +198,7 @@ export class EventLogRemoteError extends Data.TaggedError("EventLogRemoteError")
   }
 }
 
-const getIdentityRootSecretMaterial = makeGetIdentityRootSecretMaterial(globalThis.crypto)
+const getIdentityRootSecretMaterial = makeGetIdentityRootSecretMaterial()
 
 const makeAuthenticate = Effect.fnUntraced(function*(options: {
   readonly identity: Identity["Service"]
@@ -146,24 +232,36 @@ const makeAuthenticate = Effect.fnUntraced(function*(options: {
  * Use to provide the RPC client used by remote event-log replicas to
  * authenticate, write entries, and subscribe to changes.
  *
+ * **Details**
+ *
+ * The `EventLogCompactionRpcs` methods are optional. The encrypted remote
+ * offers compaction only when the client has them. `layer` builds the client
+ * from both groups.
+ *
  * @stability unstable
  * @category services
  * @since 4.0.0
  */
 export class EventLogRemoteClient extends Context.Service<
   EventLogRemoteClient,
-  RpcClient.RpcClient<RpcGroup.Rpcs<typeof EventLogRemoteRpcs>, RpcClientError>
+  & RpcClient.RpcClient<RpcGroup.Rpcs<typeof EventLogRemoteRpcs>, RpcClientError>
+  & Partial<CompactionClient>
 >()(
   "effect/eventlog/EventLogRemote/EventLogRemoteClient"
 ) {
   static readonly layer = Layer.effect(
     EventLogRemoteClient,
-    RpcClient.make(EventLogRemoteRpcs, {
+    RpcClient.make(EventLogRemoteRpcs.merge(EventLogCompactionRpcs), {
       disableTracing: true
     })
   )
 }
 
+type CompactionClient = RpcClient.RpcClient<RpcGroup.Rpcs<typeof EventLogCompactionRpcs>, RpcClientError>
+
+const getCompactionClient = (client: EventLogRemoteClient["Service"]): CompactionClient | undefined =>
+  client["EventLog.CompactionStatus"] === undefined ? undefined : client as CompactionClient
+
 /**
  * Creates an `EventLogRemote` from custom write encoding and change decoding
  * functions.
@@ -178,7 +276,7 @@ export class EventLogRemoteClient extends Context.Service<
  * @category constructors
  * @since 4.0.0
  */
-export const makeWith = Effect.fnUntraced(function*({ encodeWrite, decodeChanges }: {
+export const makeWith = (options: {
   readonly encodeWrite: (options: {
     readonly identity: Identity["Service"]
     readonly entries: ReadonlyArray<Entry>
@@ -190,6 +288,39 @@ export const makeWith = Effect.fnUntraced(function*({ encodeWrite, decodeChanges
     data: Uint8Array<ArrayBuffer>,
     knownEntries?: EventJournal["Service"]["entriesById"]
   ) => Effect.Effect<ReadonlyArray<RemoteEntry>, Schema.SchemaError | EventJournalError>
+}): Effect.Effect<EventLogRemote["Service"], EventLogRemoteError, Scope.Scope | EventLogRemoteClient | Registry> =>
+  makeRemote(options)
+
+interface RemoteSession {
+  readonly client: EventLogRemoteClient["Service"]
+  /** Authenticates, runs the request, and authenticates again after a refusal. */
+  readonly request: <A, E>(
+    method: string,
+    identity: Identity["Service"],
+    effect: Effect.Effect<A, E>
+  ) => Effect.Effect<A, EventLogRemoteError>
+  /** Authenticates, then joins and decodes a framed response stream. */
+  readonly framed: <A, E, E2>(
+    method: string,
+    identity: Identity["Service"],
+    frames: () => Stream.Stream<SingleMessage | ChunkedMessage, E>,
+    decode: (data: Uint8Array<ArrayBuffer>) => Effect.Effect<Iterable<A>, E2>
+  ) => Stream.Stream<A, EventLogRemoteError>
+}
+
+const makeRemote = Effect.fnUntraced(function*({ encodeWrite, decodeChanges, makeCompaction }: {
+  readonly encodeWrite: (options: {
+    readonly identity: Identity["Service"]
+    readonly entries: ReadonlyArray<Entry>
+    readonly storeId: StoreId
+  }) => Effect.Effect<Uint8Array<ArrayBuffer>, Schema.SchemaError>
+  readonly decodeChanges: (
+    identity: Identity["Service"],
+    storeId: StoreId,
+    data: Uint8Array<ArrayBuffer>,
+    knownEntries?: EventJournal["Service"]["entriesById"]
+  ) => Effect.Effect<ReadonlyArray<RemoteEntry>, Schema.SchemaError | EventJournalError>
+  readonly makeCompaction?: ((session: RemoteSession) => EventLogRemoteCompaction | undefined) | undefined
 }): Effect.fn.Return<EventLogRemote["Service"], EventLogRemoteError, Scope.Scope | EventLogRemoteClient | Registry> {
   const client = yield* EventLogRemoteClient
   const registry = yield* Registry
@@ -228,6 +359,12 @@ export const makeWith = Effect.fnUntraced(function*({ encodeWrite, decodeChanges
     return Cache.get(authCache, identity.publicKey)
   }
 
+  // The next request says hello and authenticates again.
+  const resetAuthentication = (identity: Identity["Service"]) => {
+    hello = null
+    return Cache.invalidate(authCache, identity.publicKey)
+  }
+
   const retryForbidden = <A, E, R>(
     effect: Effect.Effect<A, E, R>,
     options: {
@@ -235,19 +372,47 @@ export const makeWith = Effect.fnUntraced(function*({ encodeWrite, decodeChanges
     }
   ) =>
     Effect.retry(effect, {
-      while(e) {
-        hello = null
-        const error = EventLogRemoteError.is(e) && e.method === "authenticate"
-          ? e.cause
-          : e
-        const isForbidden = EventLogProtocolError.is(error) && error.code === "Forbidden"
-        return Cache.invalidate(authCache, options.identity.publicKey).pipe(
-          Effect.as(isForbidden)
-        )
-      },
+      while: (e) => Effect.as(resetAuthentication(options.identity), isForbidden(e)),
       times: 5
     })
 
+  const toRemoteError = (method: string) => (cause: unknown) =>
+    EventLogRemoteError.is(cause) ? cause : new EventLogRemoteError({ method, cause })
+
+  const request = <A, E>(
+    method: string,
+    identity: Identity["Service"],
+    effect: Effect.Effect<A, E>
+  ): Effect.Effect<A, EventLogRemoteError> =>
+    ensureAuthenticated(identity).pipe(
+      Effect.andThen(effect),
+      (effect) => retryForbidden(effect, { identity }),
+      Effect.mapError(toRemoteError(method))
+    )
+
+  // Not retried like `request`; a refused identity authenticates again on the
+  // next request.
+  const framed = <A, E, E2>(
+    method: string,
+    identity: Identity["Service"],
+    frames: () => Stream.Stream<SingleMessage | ChunkedMessage, E>,
+    decode: (data: Uint8Array<ArrayBuffer>) => Effect.Effect<Iterable<A>, E2>
+  ): Stream.Stream<A, EventLogRemoteError> =>
+    Stream.unwrap(Effect.map(ensureAuthenticated(identity), () => {
+      const state = ChunkedMessage.initialJoinState()
+      return frames().pipe(
+        Stream.filterMap((frame) => {
+          const data = frame._tag === "Single" ? frame.data : ChunkedMessage.join(state, frame)
+          return data === undefined ? Result.failVoid : Result.succeed(data)
+        }),
+        Stream.mapEffect(decode),
+        Stream.flattenIterable
+      )
+    })).pipe(
+      Stream.tapError((error) => isForbidden(error) ? resetAuthentication(identity) : Effect.void),
+      Stream.mapError(toRemoteError(method))
+    )
+
   let chunkedIdCounter = 0
 
   const remote = EventLogRemote.of({
@@ -325,7 +490,8 @@ export const makeWith = Effect.fnUntraced(function*({ encodeWrite, decodeChanges
       return outgoing
     }),
     whenAuthenticated: (effect) =>
-      IdentityService.use((identity) => Effect.flatMap(ensureAuthenticated(identity), () => effect))
+      IdentityService.use((identity) => Effect.flatMap(ensureAuthenticated(identity), () => effect)),
+    compaction: hello.compaction === true ? makeCompaction?.({ client, request, framed }) : undefined
   })
 
   yield* registry.registerRemote(remote)
@@ -333,6 +499,11 @@ export const makeWith = Effect.fnUntraced(function*({ encodeWrite, decodeChanges
   return remote
 })
 
+const isForbidden = (e: unknown): boolean => {
+  const error = EventLogRemoteError.is(e) && e.method === "authenticate" ? e.cause : e
+  return EventLogProtocolError.is(error) && error.code === "Forbidden"
+}
+
 /** @effect-diagnostics-next-line classSelfMismatch:off */
 class IdentityService extends Context.Service<Identity, Identity["Service"]>()(
   "effect/eventlog/EventLog/Identity" satisfies Identity["key"]
@@ -342,11 +513,19 @@ class IdentityService extends Context.Service<Identity, Identity["Service"]>()(
  * Creates an `EventLogRemote` that encrypts outgoing entries and decrypts
  * incoming changes with `EventLogEncryption`.
  *
+ * **Details**
+ *
+ * The remote has a `compaction` member when the server advertises compaction
+ * and the RPC client includes `EventLogCompactionRpcs`, unless built with
+ * `compaction: false`. Without it the client never calls the compaction RPCs.
+ *
  * @stability unstable
  * @category constructors
  * @since 4.0.0
  */
-export const makeEncrypted = Effect.gen(function*(): Effect.fn.Return<
+export const makeEncryptedWith = Effect.fnUntraced(function*(options: {
+  readonly compaction?: boolean | undefined
+}): Effect.fn.Return<
   EventLogRemote["Service"],
   EventLogRemoteError,
   Scope.Scope | EventLogRemoteClient | EventLogEncryption | Registry
@@ -385,7 +564,7 @@ export const makeEncrypted = Effect.gen(function*(): Effect.fn.Return<
     })
   })
 
-  return yield* makeWith({
+  return yield* makeRemote({
     encodeWrite: (options) =>
       encryption.encrypt(options.identity, options.storeId, options.entries).pipe(
         Effect.flatMap((batches) =>
@@ -396,10 +575,151 @@ export const makeEncrypted = Effect.gen(function*(): Effect.fn.Return<
           }).encoded
         )
       ),
-    decodeChanges
+    decodeChanges,
+    makeCompaction: options.compaction === false ? undefined : (session) => {
+      const client = getCompactionClient(session.client)
+      return client === undefined ? undefined : makeEncryptedCompaction({ session, client, encryption })
+    }
   })
 })
 
+/**
+ * Creates an `EventLogRemote` that encrypts outgoing entries and decrypts
+ * incoming changes with `EventLogEncryption`.
+ *
+ * @see {@link makeEncryptedWith} for opting out of running compaction
+ *
+ * @stability unstable
+ * @category constructors
+ * @since 4.0.0
+ */
+export const makeEncrypted: Effect.Effect<
+  EventLogRemote["Service"],
+  EventLogRemoteError,
+  Scope.Scope | EventLogRemoteClient | EventLogEncryption | Registry
+> = makeEncryptedWith({})
+
+// How many times a segment is sent before a dropped connection, an
+// `RpcClientError`, fails the upload.
+const segmentAttempts = 3
+
+const makeEncryptedCompaction = ({ client, encryption, session: { framed, request } }: {
+  readonly session: RemoteSession
+  readonly client: CompactionClient
+  readonly encryption: EventLogEncryption["Service"]
+}): EventLogRemoteCompaction => {
+  const stageRequest = (stage: CompactionStage) => ({
+    publicKey: stage.identity.publicKey,
+    storeId: stage.storeId,
+    stageId: stage.stageId
+  })
+
+  return {
+    status: ({ identity, storeId }) =>
+      request(
+        "compactionStatus",
+        identity,
+        client["EventLog.CompactionStatus"]({ publicKey: identity.publicKey, storeId })
+      ),
+    begin: ({ identity, storeId }) =>
+      request(
+        "compactionBegin",
+        identity,
+        client["EventLog.CompactionBegin"]({ publicKey: identity.publicKey, storeId })
+      ),
+    input: (stage) =>
+      framed(
+        "compactionInput",
+        stage.identity,
+        () => client["EventLog.CompactionInput"](stageRequest(stage)),
+        CompactionInputRpc.decodeHeaders
+      ),
+    fetch: (stage, sequences) =>
+      framed(
+        "compactionFetch",
+        stage.identity,
+        () => client["EventLog.CompactionFetch"]({ ...stageRequest(stage), batches: sequences }),
+        (data) =>
+          Effect.flatMap(
+            ChangesRpc.decodeEncrypted(data),
+            (batches) => encryption.decrypt(stage.identity, stage.storeId, batches)
+          )
+      ),
+    upload: (stage, entries) =>
+      Effect.suspend(() => {
+        let segment: Array<EncryptedBatch> = []
+        let segmentBytes = 0
+        let segmentCount = 0
+
+        // The server forgets a segment's pieces when the connection drops, so a
+        // retry resends all of them.
+        const sendSegment = Effect.suspend(() => {
+          if (!Arr.isArrayNonEmpty(segment)) return Effect.void
+          const batches = segment
+          const id = segmentCount++
+          segment = []
+          segmentBytes = 0
+          return Effect.flatMap(CompactionPartRpc.encodeSegment(batches), (data) => {
+            const pieces = ChunkedMessage.split(id, data)
+            return request(
+              "compactionUpload",
+              stage.identity,
+              Effect.forEach(
+                pieces,
+                (chunk) => client["EventLog.CompactionPart"]({ ...stageRequest(stage), chunk }),
+                { discard: true }
+              ).pipe(
+                Effect.retry({ while: (error) => error._tag === "RpcClientError", times: segmentAttempts - 1 })
+              )
+            )
+          })
+        })
+
+        // Whole batches go into a segment until the next one would take it
+        // past `ChunkedMessage.chunkSize`.
+        const addBatch = (batch: Arr.NonEmptyArray<Entry>) =>
+          Effect.flatMap(encryption.encrypt(stage.identity, stage.storeId, batch), (encrypted) =>
+            Effect.forEach(encrypted, (batch) => {
+              const size = encodedBatchSize(batch)
+              const send = segment.length > 0 && segmentBytes + size > ChunkedMessage.chunkSize
+                ? sendSegment
+                : Effect.void
+              return Effect.andThen(
+                send,
+                Effect.sync(() => {
+                  segment.push(batch)
+                  segmentBytes += size
+                })
+              )
+            }, { discard: true }))
+
+        return Effect.forEach(toBatches(entries), addBatch, { discard: true }).pipe(
+          Effect.andThen(sendSegment),
+          Effect.map(() => ({ segmentCount })),
+          Effect.mapError((cause) =>
+            EventLogRemoteError.is(cause) ? cause : new EventLogRemoteError({ method: "compactionUpload", cause })
+          )
+        )
+      }),
+    commit: (stage, result) =>
+      request(
+        "compactionCommit",
+        stage.identity,
+        client["EventLog.CompactionCommit"]({ ...stageRequest(stage), result })
+      ),
+    abort: (stage) =>
+      request(
+        "compactionAbort",
+        stage.identity,
+        client["EventLog.CompactionAbort"](stageRequest(stage))
+      ).pipe(Effect.ignore)
+  }
+}
+
+// Ignores the segment framing.
+const encodedBatchSize = (batch: EncryptedBatch): number =>
+  batch.encryptedBatch.byteLength + batch.iv.byteLength + batch.entryIds.length * 16
+
 /**
  * Creates an `EventLogRemote` that sends and receives plaintext entry payloads.
  *
@@ -425,6 +745,33 @@ export const makeUnencrypted: Effect.Effect<
  * Provides an encrypted `EventLogRemote` using the remote RPC client and the
  * default Web Crypto encryption layer.
  *
+ * **Details**
+ *
+ * `compaction: false` leaves the remote without its `compaction` member, so
+ * this client never calls the compaction RPCs.
+ *
+ * @stability unstable
+ * @category layers
+ * @since 4.0.0
+ */
+export const layerEncryptedWith = (options: {
+  readonly compaction?: boolean | undefined
+}): Layer.Layer<
+  EventLogRemote,
+  EventLogRemoteError,
+  RpcClient.Protocol | Registry
+> =>
+  Layer.effect(EventLogRemote, makeEncryptedWith(options)).pipe(
+    Layer.provide(EventLogRemoteClient.layer),
+    Layer.provide(layerSubtle)
+  )
+
+/**
+ * Provides an encrypted `EventLogRemote` using the remote RPC client and the
+ * default Web Crypto encryption layer.
+ *
+ * @see {@link layerEncryptedWith} for opting out of running compaction
+ *
  * @stability unstable
  * @category layers
  * @since 4.0.0
@@ -433,10 +780,7 @@ export const layerEncrypted: Layer.Layer<
   EventLogRemote,
   EventLogRemoteError,
   RpcClient.Protocol | Registry
-> = Layer.effect(EventLogRemote, makeEncrypted).pipe(
-  Layer.provide(EventLogRemoteClient.layer),
-  Layer.provide(layerSubtle)
-)
+> = layerEncryptedWith({})
 
 /**
  * Provides an unencrypted `EventLogRemote` using the remote RPC client.

package/src/eventlog/EventLogServer.ts

@@ -13,6 +13,7 @@ import type { NonEmptyReadonlyArray } from "../Array.ts"
 import * as Arr from "../Array.ts"
 import * as Cache from "../Cache.ts"
 import * as Context from "../Context.ts"
+import * as Mac from "../crypto/Mac.ts"
 import * as Data from "../Data.ts"
 import * as Duration from "../Duration.ts"
 import * as Effect from "../Effect.ts"
@@ -76,8 +77,16 @@ export const layerAuthMiddleware: Layer.Layer<
  * chunked writes, delegates write and change handling to the supplied callbacks,
  * and frames large change payloads into chunks.
  *
+ * `Authenticate` calls `authorizeIdentity` with the claimed public key and the
+ * presented signing public key, then verifies the signature against the
+ * presented key. Only a verified key is passed to
+ * `getOrCreateSessionAuthBinding`, and a key that differs from the identity's
+ * existing binding is rejected.
+ *
  * Use the connection's `ConnectionWrites.track` in `onWrite` and
  * `ConnectionWrites.filter` in `changes` to suppress its own write echoes.
+ * `compaction` sets `HelloResponse.compaction`, advertising that the server
+ * also serves `EventLogCompactionRpcs`.
  *
  * @stability unstable
  * @category layers
@@ -86,7 +95,11 @@ export const layerAuthMiddleware: Layer.Layer<
 export const layerRpcHandlers = (options: {
   readonly remoteId: RemoteId
   readonly firstSequence?: number | undefined
-  readonly authorizeIdentity?: (publicKey: string) => Effect.Effect<void, EventLogProtocolError>
+  readonly compaction?: boolean | undefined
+  readonly authorizeIdentity?: (
+    publicKey: string,
+    signingPublicKey: Uint8Array<ArrayBuffer>
+  ) => Effect.Effect<void, EventLogProtocolError>
   readonly getOrCreateSessionAuthBinding: (
     publicKey: string,
     signingPublicKey: Uint8Array<ArrayBuffer>
@@ -111,7 +124,7 @@ export const layerRpcHandlers = (options: {
       capacity: Number.MAX_SAFE_INTEGER,
       timeToLive: EventLogSessionAuth.SessionAuthChallengeTimeToLiveMillis
     })
-    let chunkedIdCounter = 0
+    const toFrames = makeFramer()
 
     const persistedSigningPublicKeys = yield* Cache.makeWith(
       (key: SessionAuthCacheKey) =>
@@ -139,7 +152,8 @@ export const layerRpcHandlers = (options: {
         return new HelloResponse({
           remoteId: options.remoteId,
           challenge,
-          firstSequence: options.firstSequence
+          firstSequence: options.firstSequence,
+          compaction: options.compaction === true ? true : undefined
         })
       }),
       "EventLog.Authenticate": Effect.fnUntraced(function*(request, { client }) {
@@ -154,33 +168,40 @@ export const layerRpcHandlers = (options: {
         }
         yield* Cache.invalidate(clientChallenges, client.id)
         if (options.authorizeIdentity) {
-          yield* options.authorizeIdentity(request.publicKey)
+          yield* options.authorizeIdentity(request.publicKey, request.signingPublicKey)
         }
-        const signingPublicKey = yield* Cache.get(
-          persistedSigningPublicKeys,
-          new SessionAuthCacheKey({
-            publicKey: request.publicKey,
-            signingPublicKey: request.signingPublicKey
-          })
-        )
         const verified = yield* EventLogSessionAuth.verifySessionAuthenticateRequest({
           remoteId: options.remoteId,
           challenge,
           publicKey: request.publicKey,
-          signingPublicKey,
+          signingPublicKey: request.signingPublicKey,
           signature: request.signature,
           algorithm: request.algorithm
         }).pipe(
           Effect.catch(() => Effect.succeed(false))
         )
 
-        if (!verified) {
-          return yield* new EventLogProtocolError({
+        const verificationFailed = () =>
+          new EventLogProtocolError({
             requestTag: "Authenticate",
             publicKey: request.publicKey,
             code: "Forbidden",
             message: "Session auth signature verification failed"
           })
+        if (!verified) {
+          return yield* verificationFailed()
+        }
+        // Only a verified key reaches the binding. A key other than the
+        // identity's bound key is rejected like a bad signature.
+        const boundSigningPublicKey = yield* Cache.get(
+          persistedSigningPublicKeys,
+          new SessionAuthCacheKey({
+            publicKey: request.publicKey,
+            signingPublicKey: request.signingPublicKey
+          })
+        )
+        if (!Mac.timingSafeEqual(boundSigningPublicKey, request.signingPublicKey)) {
+          return yield* verificationFailed()
         }
 
         const authenticatedIdentities = new Set(
@@ -229,12 +250,7 @@ export const layerRpcHandlers = (options: {
           startSequence: request.startSequence,
           writes: getConnectionWrites(client)
         }).pipe(
-          Stream.mapArray(Arr.flatMap((data): NonEmptyReadonlyArray<SingleMessage | ChunkedMessage> => {
-            if (data.byteLength <= ChunkedMessage.chunkSize) {
-              return [new SingleMessage({ data })]
-            }
-            return ChunkedMessage.split(chunkedIdCounter++, data)
-          })),
+          Stream.mapArray(Arr.flatMap(toFrames)),
           Stream.catchCause((_) =>
             Stream.fail(
               new EventLogProtocolError({
@@ -412,6 +428,8 @@ export class AuthenticatedIdentities extends Context.Service<AuthenticatedIdenti
   "effect/eventlog/EventLogServer/AuthenticatedIdentities"
 ) {}
 
+// Keyed by `publicKey` alone: the cache holds each identity's bound signing
+// key, and `Authenticate` rejects any presented key that differs from it.
 class SessionAuthCacheKey extends Data.Class<{
   readonly publicKey: string
   readonly signingPublicKey: Uint8Array<ArrayBuffer>
@@ -424,4 +442,20 @@ class SessionAuthCacheKey extends Data.Class<{
   }
 }
 
+/**
+ * Frames one encoded message for a response stream: a `SingleMessage` when it
+ * fits, or the pieces of a `ChunkedMessage` with the next id otherwise.
+ *
+ * @internal
+ */
+export const makeFramer = (): (
+  data: Uint8Array<ArrayBuffer>
+) => NonEmptyReadonlyArray<SingleMessage | ChunkedMessage> => {
+  let chunkedIdCounter = 0
+  return (data) =>
+    data.byteLength <= ChunkedMessage.chunkSize
+      ? [new SingleMessage({ data })]
+      : ChunkedMessage.split(chunkedIdCounter++, data)
+}
+
 const constEmptyPrivateKey = Redacted.make(new Uint8Array(32))