@reventlessdev/reventless-seed 1.0.0-alpha.1 → 1.0.0-alpha.11

package/lib/ocaml/.compiler.log

@@ -1,2 +1,2 @@
-#Start(1785055307106)
-#Done(1785055311634)
+#Start(1786453304385)
+#Done(1786453304425)

package/lib/ocaml/ReventlessSeed.mlmap

@@ -1,7 +1,10 @@
 randjbuildsystem
 Seed
 Seed_Client
+Seed_Connect
+Seed_Prompt
 Seed_Random
+Seed_RandomTest
 Seed_Runner
 Seed_Types
 Seed_Upload

package/lib/ocaml/Seed.res

@@ -9,9 +9,28 @@ module Random = Seed_Random
 module Client = Seed_Client
 module Runner = Seed_Runner
 module Upload = Seed_Upload
+module Prompt = Seed_Prompt
+module Connect = Seed_Connect
 
 exception Failed = Seed_Types.Failed
 
+// A live target a data set seeds against: an authenticated client, whether uploads
+// are skipped this run, and a label. Uploads mint through the domain API's
+// `Upload_Presign` mutation on the client (route B), so no upload endpoint is carried.
+type connection = Seed_Connect.connection = {
+  client: Seed_Client.t,
+  uploadsSkipped: bool,
+  label: string,
+}
+
+// A named, seedable data set. `seed` owns everything domain-specific.
+type dataSet = Seed_Runner.dataSet = {
+  name: string,
+  label: string,
+  seed: connection => promise<unit>,
+  probeViews?: array<string>,
+}
+
 type rec value = Seed_Types.value =
   | String(string)
   | Id(string)

package/lib/ocaml/Seed_Client.res

@@ -27,9 +27,12 @@ let sleep = (ms: int): promise<unit> => Promise.make((resolve, _) => setTimeout(
 
 type config = {
   endpoint: string,
-  loginEndpoint: string,
-  username: string,
-  password: string,
+  // Present only for the `login` flow (a platform that mints tokens over HTTP,
+  // e.g. the local dev `/__inmemory/login`). Omit when the bearer is supplied
+  // out-of-band via `useToken` (e.g. a Cognito id token minted by the caller).
+  loginEndpoint?: string,
+  username?: string,
+  password?: string,
 }
 
 type t = {config: config, mutable token: option<string>}
@@ -40,6 +43,15 @@ let make = (~config: config): t => {config, token: None}
     Seed.Upload) can authenticate side-channel requests with the same identity. */
 let currentToken = (t: t): option<string> => t.token
 
+/** The GraphQL endpoint this client targets — so `Seed.Upload` can resolve a
+    relative presigned `uploadUrl` against the same origin. */
+let endpoint = (t: t): string => t.config.endpoint
+
+/** Injects a bearer obtained out-of-band (e.g. a Cognito id token), instead of
+    minting one via `login`. Provider-agnostic: the harness only cares that the
+    token is a valid bearer for `endpoint`. */
+let useToken = (t: t, token: string): unit => t.token = Some(token)
+
 // ── JSON helpers ────────────────────────────────────────────────────────────
 
 let field = (json: JSON.t, key: string): option<JSON.t> =>
@@ -61,28 +73,31 @@ let nodeString = (node: JSON.t, key: string): option<string> =>
 // ── Requests ────────────────────────────────────────────────────────────────
 
 let login = async (t: t): unit => {
+  let loginEndpoint = switch t.config.loginEndpoint {
+  | Some(e) => e
+  | None => throw(Failed("login: no loginEndpoint configured — supply one or call useToken"))
+  }
+  let username = t.config.username->Option.getOr("")
+  let password = t.config.password->Option.getOr("")
   let body = JSON.stringify(
     JSON.Encode.object(
       Dict.fromArray([
-        ("username", JSON.Encode.string(t.config.username)),
-        ("password", JSON.Encode.string(t.config.password)),
+        ("username", JSON.Encode.string(username)),
+        ("password", JSON.Encode.string(password)),
       ]),
     ),
   )
   let res = try await fetch(
-    t.config.loginEndpoint,
+    loginEndpoint,
     {method: "POST", headers: Dict.fromArray([("content-type", "application/json")]), body},
   ) catch {
-  | _ =>
-    throw(
-      Failed(`login: cannot reach ${t.config.loginEndpoint} — is the platform running?`),
-    )
+  | _ => throw(Failed(`login: cannot reach ${loginEndpoint} — is the platform running?`))
   }
   if !(res->responseOk) {
     let detail = await res->responseText
     throw(
       Failed(
-        `login as "${t.config.username}" failed with HTTP ${(res->responseStatus)
+        `login as "${username}" failed with HTTP ${(res->responseStatus)
             ->Int.toString}: ${detail}`,
       ),
     )
@@ -205,6 +220,42 @@ let queryAllNodes = async (t: t, ~field as fieldName: string, ~selection: string
 let countNodes = async (t: t, ~field: string): int =>
   (await queryAllNodes(t, ~field, ~selection="id"))->Array.length
 
+/**
+ * Polls a connection field until the collected nodes satisfy `satisfied`, or the
+ * timeout elapses. Read models are eventually consistent: a view queried the
+ * instant after the writes that feed it can still read empty or partial (a
+ * DynamoDB connection scan is eventually consistent by default, and the write and
+ * read-back can land on different replicas), so a cross-check that asserts on a
+ * single immediate read races the projection. Same rationale as `waitForIds`,
+ * for the "observe the whole connection" case rather than a fixed id set.
+ *
+ * On timeout, throws `Failed(onTimeout(finalNodes))` so the caller can report
+ * what the view actually settled on — distinguishing a still-empty view from a
+ * genuine count mismatch — instead of a bare assertion.
+ */
+let queryAllNodesUntil = async (
+  t: t,
+  ~field: string,
+  ~selection: string,
+  ~satisfied: array<JSON.t> => bool,
+  ~onTimeout: array<JSON.t> => string,
+  ~timeoutMs: int=60000,
+): array<JSON.t> => {
+  let deadline = nowMs() +. Int.toFloat(timeoutMs)
+  let result = ref(None)
+  while result.contents == None {
+    let nodes = await queryAllNodes(t, ~field, ~selection)
+    if satisfied(nodes) {
+      result := Some(nodes)
+    } else if nowMs() > deadline {
+      throw(Failed(onTimeout(nodes)))
+    } else {
+      await sleep(500)
+    }
+  }
+  result.contents->Option.getOr([])
+}
+
 /**
  * Polls a `<View>ByIds` field until every id is present.
  *

package/lib/ocaml/Seed_Connect.res

@@ -0,0 +1,86 @@
+// Turns endpoints plus a login function into a ready `connection`.
+//
+// A connection is what a data set seeds against: an authenticated GraphQL
+// client, the deployment's upload endpoints (empty when it serves no uploads),
+// and a human label for the target. `make` is provider-agnostic — it prompts for
+// credentials, calls the supplied `login` to obtain a bearer, and wires it onto
+// the client via `useToken`. Where the bearer comes from (a local `/login`
+// round-trip, a Cognito id token) is the caller's concern.
+
+open Seed_Types
+
+// Under route B the client mints uploads through the domain API's `Upload_Presign`
+// mutation (authenticated by the same bearer as commands), so a connection needs no
+// upload endpoint — just the authenticated client and whether uploads are skipped this
+// run (`SEED_SKIP_UPLOADS`). Which store an asset uploads into is the caller's `~store`.
+type connection = {
+  client: Seed_Client.t,
+  uploadsSkipped: bool,
+  label: string,
+}
+
+/**
+ * Prompts for credentials, calls `login` to mint a bearer, and returns a
+ * connection with that bearer already applied. `login` returns the bearer so a
+ * single `useToken` path serves every provider.
+ */
+let make = async (
+  ~label: string,
+  ~endpoint: string,
+  ~login: (~username: string, ~password: string) => promise<string>,
+  ~localDefaults: bool=false,
+): connection => {
+  // `SEED_SKIP_UPLOADS` forces the upload phase to no-op — seed domain data fast, or
+  // skip a broken/absent upload path without editing the data set. The data set reads
+  // `connection.uploadsSkipped` and reports the skip.
+  let uploadsSkipped = Seed_Upload.uploadsSkipped()
+  let (username, password) = await Seed_Prompt.credentials(~localDefaults)
+  let token = await login(~username, ~password)
+  let client = Seed_Client.make(~config={endpoint: endpoint})
+  client->Seed_Client.useToken(token)
+  {client, uploadsSkipped, label}
+}
+
+/**
+ * A login function backed by an HTTP login endpoint (the local dev
+ * `/__inmemory/login` shape: POST `{username, password}` → `{token}`). Reuses
+ * `Seed_Client.login` but hands the token back for `useToken`.
+ */
+let viaLoginEndpoint = (~loginEndpoint: string) => async (
+  ~username: string,
+  ~password: string,
+): string => {
+  let client = Seed_Client.make(
+    ~config={endpoint: loginEndpoint, loginEndpoint, username, password},
+  )
+  await Seed_Client.login(client)
+  switch Seed_Client.currentToken(client) {
+  | Some(token) => token
+  | None => throw(Failed(`login at ${loginEndpoint} returned no token`))
+  }
+}
+
+let envOr = (key: string, fallback: string): string =>
+  Seed_Prompt.envValue(key)->Option.getOr(fallback)
+
+/**
+ * A ready `connect` thunk for the local dev platform, with the localhost
+ * defaults baked in and overridable per endpoint (arg, then env var, then
+ * default). Empty input at the credential prompt falls back to `admin`/`admin`.
+ *
+ * No upload endpoint: uploads mint through the domain API's `Upload_Presign` mutation
+ * on the same `graphql` endpoint, with the store passed per asset.
+ */
+let local = (~graphql=?, ~login=?, ()): (unit => promise<connection>) => {
+  let endpoint =
+    graphql->Option.getOr(envOr("REVENTLESS_GRAPHQL_ENDPOINT", "http://localhost:4000/graphql"))
+  let loginEndpoint =
+    login->Option.getOr(envOr("REVENTLESS_LOGIN_ENDPOINT", "http://localhost:4000/__inmemory/login"))
+  () =>
+    make(
+      ~label="local",
+      ~endpoint,
+      ~login=viaLoginEndpoint(~loginEndpoint),
+      ~localDefaults=true,
+    )
+}

package/lib/ocaml/Seed_Prompt.res

@@ -0,0 +1,178 @@
+// One shared readline interface for every interactive prompt in a seed run.
+//
+// The reason this module exists: creating and closing a fresh `readline`
+// interface per prompt leaves NodeProcess.stdin paused after the first `close`, so the
+// second prompt (password after username) never fires and the run hangs. A
+// single interface, created lazily and closed exactly once, avoids that — and a
+// `muted` gate on its output lets password entry reuse the same interface
+// instead of opening a second one just to suppress the echo.
+//
+// Node bindings are declared here as typed externals; this package is
+// stdlib-only, so no `%raw`.
+
+open Seed_Types
+
+// ── Node bindings ─────────────────────────────────────────────────────────────
+
+type rl
+type rlOptions = {input: NodeProcess.stream, output: NodeProcess.stream, terminal?: bool}
+@module("node:readline") external createInterface: rlOptions => rl = "createInterface"
+@send external question: (rl, string, string => unit) => unit = "question"
+@send external closeRl: rl => unit = "close"
+@set external setWriteToOutput: (rl, string => unit) => unit = "_writeToOutput"
+
+// ── Shared interface ──────────────────────────────────────────────────────────
+
+// Created on first use, closed once via `close`. `muted` gates the echo so the
+// same interface serves both visible and hidden prompts.
+let rlRef: ref<option<rl>> = ref(None)
+let muted = ref(false)
+
+let iface = (): rl =>
+  switch rlRef.contents {
+  | Some(rl) => rl
+  | None =>
+    let rl = createInterface({input: NodeProcess.stdin, output: NodeProcess.stdout, terminal: true})
+    rl->setWriteToOutput(s =>
+      if !muted.contents {
+        NodeProcess.stdout->NodeProcess.write(s)
+      }
+    )
+    rlRef := Some(rl)
+    rl
+  }
+
+let close = (): unit =>
+  switch rlRef.contents {
+  | Some(rl) =>
+    rl->closeRl
+    rlRef := None
+    // Closing the interface is not enough: a terminal-mode readline leaves
+    // NodeProcess.stdin resumed and reffed, which keeps the event loop alive so the CLI
+    // never exits after seeding. Release it explicitly.
+    NodeProcess.stdin->NodeProcess.pause
+    NodeProcess.stdin->NodeProcess.unref
+  | None => ()
+  }
+
+// ── Env + TTY ─────────────────────────────────────────────────────────────────
+
+let envValue = (key: string): option<string> =>
+  switch NodeProcess.env->Dict.get(key) {
+  | Some(v) if v->String.trim != "" => Some(v->String.trim)
+  | _ => None
+  }
+
+let requireTty = (): unit =>
+  if !(NodeProcess.stdin->NodeProcess.isTTY->Option.getOr(false)) {
+    throw(
+      Failed(
+        "no TTY for an interactive prompt — set the documented SEED_* / REVENTLESS_DEMO_* " ++
+        "env vars to run non-interactively.",
+      ),
+    )
+  }
+
+// ── Prompts ───────────────────────────────────────────────────────────────────
+
+let ask = (query: string): promise<string> =>
+  Promise.make((resolve, _) => {
+    let rl = iface()
+    rl->question(query, answer => resolve(answer->String.trim))
+  })
+
+// Same interface, echo suppressed for the keystrokes. `question` writes the
+// prompt synchronously first (while unmuted), then muting is switched on so only
+// the typed characters are hidden — the canonical readline recipe, which keeps
+// the line editor's cursor state consistent (a manual write + empty `question`
+// left some terminals unable to read the next line).
+let askHidden = (query: string): promise<string> =>
+  Promise.make((resolve, _) => {
+    let rl = iface()
+    rl->question(query, answer => {
+      muted := false
+      NodeProcess.stdout->NodeProcess.write("\n")
+      resolve(answer)
+    })
+    muted := true
+  })
+
+/**
+ * Chooses one of `options` (a label paired with the value it selects).
+ *
+ * Auto-returns when there is a single option, so a lone data set or stack needs
+ * no keypress. `env` (e.g. `SEED_SET`) preselects by matching label or 1-based
+ * index, so CI runs without a TTY. Otherwise it prints a numbered menu.
+ */
+let select = async (
+  ~title: string,
+  ~options: array<(string, 'a)>,
+  ~env=?,
+): 'a =>
+  switch options {
+  | [(_, only)] => only
+  | _ =>
+    let fromEnv =
+      env
+      ->Option.flatMap(envValue)
+      ->Option.flatMap(v =>
+        switch options->Array.findIndex(((label, _)) => label == v) {
+        | -1 =>
+          switch Int.fromString(v) {
+          | Some(n) if n >= 1 && n <= options->Array.length => options->Array.get(n - 1)
+          | _ => None
+          }
+        | i => options->Array.get(i)
+        }
+      )
+    switch fromEnv {
+    | Some((_, value)) => value
+    | None =>
+      requireTty()
+      Console.log("")
+      Console.log(title)
+      Console.log("")
+      options->Array.forEachWithIndex(((label, _), i) =>
+        Console.log(`  ${(i + 1)->Int.toString}) ${label}`)
+      )
+      let rec pick = async (): 'a => {
+        let answer = await ask(`\nSelect [1-${(options->Array.length)->Int.toString}]: `)
+        switch Int.fromString(answer) {
+        | Some(n) if n >= 1 && n <= options->Array.length =>
+          let (_, value) = options->Array.getUnsafe(n - 1)
+          value
+        | _ =>
+          Console.log("  Not a valid choice.")
+          await pick()
+        }
+      }
+      await pick()
+    }
+  }
+
+/**
+ * Prompts for a username (visible) and password (echo muted).
+ *
+ * `REVENTLESS_DEMO_USER` / `REVENTLESS_DEMO_PASSWORD` skip the prompts. With
+ * `localDefaults`, empty input falls back to `admin`/`admin` — the dev login.
+ */
+let credentials = async (~localDefaults: bool=false): (string, string) => {
+  let username = switch envValue("REVENTLESS_DEMO_USER") {
+  | Some(u) => u
+  | None =>
+    requireTty()
+    let entered = await ask(localDefaults ? "Username [admin]: " : "Username: ")
+    entered == "" && localDefaults ? "admin" : entered
+  }
+  let password = switch envValue("REVENTLESS_DEMO_PASSWORD") {
+  | Some(p) => p
+  | None =>
+    requireTty()
+    let entered = await askHidden(localDefaults ? "Password [admin]: " : "Password: ")
+    entered == "" && localDefaults ? "admin" : entered
+  }
+  if username == "" || password == "" {
+    throw(Failed("username and password are required."))
+  }
+  (username, password)
+}

package/lib/ocaml/Seed_RandomTest.res

@@ -0,0 +1,160 @@
+open JestGlobals
+
+// `Seed_Random` exists so that two seed runs against a fresh store produce the
+// same data — that is what makes a seeded store usable as a screenshot baseline
+// or a comparison target. Its correctness is therefore not "looks random" but
+// "repeats exactly, and stays inside the bounds it advertises".
+//
+// The suite is written around that: every case below fails for a generator that
+// is subtly non-reproducible or that walks out of its range, and none of them
+// would notice a change of algorithm that kept both properties.
+
+describe("Seed_Random:", () => {
+  let take = (~seed, ~n) => {
+    let r = Seed_Random.make(~seed)
+    Array.make(~length=n, 0.0)->Array.map(_ => Seed_Random.float(r))
+  }
+
+  describe("reproducibility — the reason this module exists:", () => {
+    testSync("the same seed replays the same sequence", () =>
+      expect(take(~seed=42, ~n=25))->toEqual(take(~seed=42, ~n=25))
+    )
+
+    // Without this, a generator that returned a constant would satisfy the
+    // case above and nothing else in the suite would catch it.
+    testSync("different seeds diverge", () =>
+      expect(take(~seed=42, ~n=25) == take(~seed=43, ~n=25))->toBe(false)
+    )
+
+    testSync("a fresh generator does not continue the previous one", () => {
+      let r = Seed_Random.make(~seed=7)
+      let first = Seed_Random.float(r)
+      let _ = Seed_Random.float(r)
+      expect(Seed_Random.float(Seed_Random.make(~seed=7)))->toEqual(first)
+    })
+  })
+
+  describe("float stays a unit interval:", () => {
+    // mulberry32's last step is a signed 32-bit value folded back to unsigned.
+    // Get that fold wrong and roughly half the draws come out negative, which
+    // every consumer below (int, pick, sampleWeighted) silently mis-scales.
+    testSync("every draw is in [0, 1)", () =>
+      expect(take(~seed=99, ~n=500)->Array.every(f => f >= 0.0 && f < 1.0))->toBe(true)
+    )
+
+    testSync("and the draws are not all the same value", () => {
+      let draws = take(~seed=99, ~n=100)
+      expect(draws->Array.some(f => f != draws->Array.getUnsafe(0)))->toBe(true)
+    })
+  })
+
+  describe("int is inclusive on both ends, as documented:", () => {
+    let draws = (~min, ~max, ~n) => {
+      let r = Seed_Random.make(~seed=5)
+      Array.make(~length=n, 0)->Array.map(_ => Seed_Random.int(r, ~min, ~max))
+    }
+
+    testSync("never escapes the range", () =>
+      expect(draws(~min=3, ~max=7, ~n=500)->Array.every(i => i >= 3 && i <= 7))->toBe(true)
+    )
+
+    // The documented contract is "inclusive on both ends"; an off-by-one in the
+    // `max - min + 1` scaling shows up as a bound that is never drawn.
+    testSync("reaches both bounds", () => {
+      let d = draws(~min=3, ~max=7, ~n=500)
+      expect((d->Array.includes(3), d->Array.includes(7)))->toEqual((true, true))
+    })
+
+    testSync("a single-value range is that value", () =>
+      expect(draws(~min=4, ~max=4, ~n=10)->Array.every(i => i == 4))->toBe(true)
+    )
+  })
+
+  describe("pick:", () => {
+    testSync("returns None for an empty array", () =>
+      expect(Seed_Random.make(~seed=1)->Seed_Random.pick([]))->toEqual(None)
+    )
+
+    testSync("always lands on a member", () => {
+      let r = Seed_Random.make(~seed=2)
+      let xs = ["a", "b", "c", "d"]
+      let hits = Array.make(~length=200, "")->Array.map(_ =>
+        r->Seed_Random.pickOr(~fallback="MISS", xs)
+      )
+      expect(hits->Array.every(h => xs->Array.includes(h)))->toBe(true)
+    })
+
+    testSync("pickOr falls back only when there is nothing to pick", () =>
+      expect(Seed_Random.make(~seed=3)->Seed_Random.pickOr(~fallback="fallback", []))->toBe(
+        "fallback",
+      )
+    )
+  })
+
+  describe("sampleWeighted is without replacement:", () => {
+    let equal = xs => xs->Array.map(x => (x, 1.0))
+
+    // The documented shuffle use: equal weights, count = length. If sampling
+    // ever replaced instead of removing, duplicates would appear here.
+    testSync("count = length yields a permutation, not a multiset", () => {
+      let xs = ["a", "b", "c", "d", "e"]
+      let out = Seed_Random.make(~seed=11)->Seed_Random.sampleWeighted(equal(xs), ~count=5)
+      let sorted = out->Array.toSorted(String.compare)
+      expect((out->Array.length, sorted))->toEqual((5, ["a", "b", "c", "d", "e"]))
+    })
+
+    testSync("count < length returns exactly count distinct items", () => {
+      let xs = ["a", "b", "c", "d", "e"]
+      let out = Seed_Random.make(~seed=12)->Seed_Random.sampleWeighted(equal(xs), ~count=3)
+      let distinct = Set.fromArray(out)->Set.size
+      expect((out->Array.length, distinct))->toEqual((3, 3))
+    })
+
+    testSync("count > length clamps to the pool", () =>
+      expect(
+        Seed_Random.make(~seed=13)
+        ->Seed_Random.sampleWeighted(equal(["a", "b"]), ~count=99)
+        ->Array.length,
+      )->toBe(2)
+    )
+
+    testSync("a zero-weight entry is never chosen while others remain", () => {
+      let out =
+        Seed_Random.make(~seed=14)->Seed_Random.sampleWeighted(
+          [("never", 0.0), ("a", 1.0), ("b", 1.0)],
+          ~count=2,
+        )
+      expect(out->Array.includes("never"))->toBe(false)
+    })
+
+    testSync("is reproducible for a given seed", () => {
+      let run = () =>
+        Seed_Random.make(~seed=15)->Seed_Random.sampleWeighted(
+          equal(["a", "b", "c", "d", "e", "f"]),
+          ~count=4,
+        )
+      expect(run())->toEqual(run())
+    })
+  })
+
+  describe("zipfWeights skews toward the head:", () => {
+    let weights = Seed_Random.zipfWeights(["a", "b", "c", "d", "e"], ~exponent=1.1)
+
+    testSync("keeps every item, in order", () =>
+      expect(weights->Array.map(((item, _)) => item))->toEqual(["a", "b", "c", "d", "e"])
+    )
+
+    testSync("weight decreases monotonically with rank", () => {
+      let ws = weights->Array.map(((_, w)) => w)
+      let decreasing =
+        ws->Array.everyWithIndex((w, i) => i == 0 || w < ws->Array.getUnsafe(i - 1))
+      expect(decreasing)->toBe(true)
+    })
+
+    testSync("the leader is clear — first outweighs last several times over", () => {
+      let first = weights->Array.get(0)->Option.mapOr(0.0, ((_, w)) => w)
+      let last = weights->Array.get(4)->Option.mapOr(0.0, ((_, w)) => w)
+      expect(first > last *. 3.0)->toBe(true)
+    })
+  })
+})