@reventlessdev/reventless-seed 1.0.0-alpha.1

package/src/Seed.res

@@ -0,0 +1,30 @@
+// Facade for the seeding harness.
+//
+// A seed run is: build a list of mutations from typed domain commands, send
+// them through the public GraphQL API in phases, then verify what the views
+// actually contain. Nothing here knows about a specific domain — the mapping
+// from a plugin's command types to `mutation` values is the caller's adapter.
+
+module Random = Seed_Random
+module Client = Seed_Client
+module Runner = Seed_Runner
+module Upload = Seed_Upload
+
+exception Failed = Seed_Types.Failed
+
+type rec value = Seed_Types.value =
+  | String(string)
+  | Id(string)
+  | Int(int)
+  | Float(float)
+  | Bool(bool)
+  | Enum(string)
+  | List(array<value>)
+  | Object(array<(string, value)>)
+
+type mutation = Seed_Types.mutation = {field: string, args: array<(string, value)>}
+
+let mutation = Seed_Types.mutation
+let ids = Seed_Types.ids
+let strings = Seed_Types.strings
+let describe = Seed_Types.describe

package/src/Seed.res.mjs

@@ -0,0 +1,34 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Seed_Types$ReventlessSeed from "./Seed_Types.res.mjs";
+
+let Random;
+
+let Client;
+
+let Runner;
+
+let Upload;
+
+let Failed = Seed_Types$ReventlessSeed.Failed;
+
+let mutation = Seed_Types$ReventlessSeed.mutation;
+
+let ids = Seed_Types$ReventlessSeed.ids;
+
+let strings = Seed_Types$ReventlessSeed.strings;
+
+let describe = Seed_Types$ReventlessSeed.describe;
+
+export {
+  Random,
+  Client,
+  Runner,
+  Upload,
+  Failed,
+  mutation,
+  ids,
+  strings,
+  describe,
+}
+/* No side effect */

package/src/Seed_Client.res

@@ -0,0 +1,251 @@
+// GraphQL transport for seeding: authentication, mutation dispatch, and the
+// query helpers a seed run needs to observe what it produced.
+//
+// Everything here is domain-agnostic — it knows about the shapes the framework
+// generates (the CommandResult union, Relay-style connections) but nothing about
+// any particular plugin.
+
+open Seed_Types
+
+// ── Node 18+ globals ────────────────────────────────────────────────────────
+
+type fetchInit = {method: string, headers: dict<string>, body: string}
+type response
+
+@val external fetch: (string, fetchInit) => promise<response> = "fetch"
+@send external responseJson: response => promise<JSON.t> = "json"
+@send external responseText: response => promise<string> = "text"
+@get external responseOk: response => bool = "ok"
+@get external responseStatus: response => int = "status"
+
+@val external setTimeout: (unit => unit, int) => unit = "setTimeout"
+@scope("Date") @val external nowMs: unit => float = "now"
+
+let sleep = (ms: int): promise<unit> => Promise.make((resolve, _) => setTimeout(() => resolve(), ms))
+
+// ── Configuration ───────────────────────────────────────────────────────────
+
+type config = {
+  endpoint: string,
+  loginEndpoint: string,
+  username: string,
+  password: string,
+}
+
+type t = {config: config, mutable token: option<string>}
+
+let make = (~config: config): t => {config, token: None}
+
+/** The bearer token from the last successful `login`, if any — so callers (e.g.
+    Seed.Upload) can authenticate side-channel requests with the same identity. */
+let currentToken = (t: t): option<string> => t.token
+
+// ── JSON helpers ────────────────────────────────────────────────────────────
+
+let field = (json: JSON.t, key: string): option<JSON.t> =>
+  switch json {
+  | Object(obj) => obj->Dict.get(key)
+  | _ => None
+  }
+
+let asString = (json: JSON.t): option<string> =>
+  switch json {
+  | String(s) => Some(s)
+  | _ => None
+  }
+
+/** Reads a string property off a node returned by `queryAllNodes`. */
+let nodeString = (node: JSON.t, key: string): option<string> =>
+  node->field(key)->Option.flatMap(asString)
+
+// ── Requests ────────────────────────────────────────────────────────────────
+
+let login = async (t: t): unit => {
+  let body = JSON.stringify(
+    JSON.Encode.object(
+      Dict.fromArray([
+        ("username", JSON.Encode.string(t.config.username)),
+        ("password", JSON.Encode.string(t.config.password)),
+      ]),
+    ),
+  )
+  let res = try await fetch(
+    t.config.loginEndpoint,
+    {method: "POST", headers: Dict.fromArray([("content-type", "application/json")]), body},
+  ) catch {
+  | _ =>
+    throw(
+      Failed(`login: cannot reach ${t.config.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)
+            ->Int.toString}: ${detail}`,
+      ),
+    )
+  }
+  let json = await res->responseJson
+  t.token = json->field("token")->Option.flatMap(asString)
+}
+
+/**
+ * Sends one GraphQL document and returns its `data`. A GraphQL-level error
+ * aborts the run: a half-seeded store is worse than an empty one, because it
+ * looks like a working dataset.
+ */
+let gql = async (t: t, ~query: string, ~label: string): JSON.t => {
+  let headers = Dict.fromArray([("content-type", "application/json")])
+  switch t.token {
+  | Some(token) => headers->Dict.set("authorization", `Bearer ${token}`)
+  | None => ()
+  }
+  let body = JSON.stringify(
+    JSON.Encode.object(Dict.fromArray([("query", JSON.Encode.string(query))])),
+  )
+  let res = try await fetch(t.config.endpoint, {method: "POST", headers, body}) catch {
+  | _ =>
+    throw(Failed(`${label}: cannot reach ${t.config.endpoint} — is the platform running?`))
+  }
+  let json = await res->responseJson
+  switch json->field("errors") {
+  | Some(errors) =>
+    throw(
+      Failed(`${label} failed\n  query: ${query}\n  response: ${JSON.stringify(errors)}`),
+    )
+  | None => json->field("data")->Option.getOr(JSON.Encode.null)
+  }
+}
+
+// ── Commands ────────────────────────────────────────────────────────────────
+
+let commandResultSelection = `__typename
+  ... on CommandAccepted { eventCount }
+  ... on CommandRejected { errorCode errorDetail }`
+
+/**
+ * Issues one command and insists it was accepted.
+ *
+ * `tolerate` names error codes that are an expected outcome of the domain
+ * rather than a broken seed; a tolerated rejection is returned to the caller so
+ * it can report on them instead of failing.
+ */
+let send = async (t: t, m: mutation, ~tolerate: array<string>=[]): option<string> => {
+  let label = m->describe
+  let query = `mutation { r: ${m.field}(${m.args->renderArgs}) { ${commandResultSelection} } }`
+  let data = await gql(t, ~query, ~label)
+  let result = data->field("r")->Option.getOr(JSON.Encode.null)
+  switch result->nodeString("__typename") {
+  | Some("CommandRejected") =>
+    let code = result->nodeString("errorCode")->Option.getOr("unknown")
+    let detail = result->nodeString("errorDetail")->Option.getOr("none")
+    if tolerate->Array.includes(code) {
+      Some(code)
+    } else {
+      throw(Failed(`${label} was rejected\n  errorCode: ${code}\n  errorDetail: ${detail}`))
+    }
+  | _ => None
+  }
+}
+
+let sendAll = async (t: t, mutations: array<mutation>): unit =>
+  for i in 0 to mutations->Array.length - 1 {
+    switch mutations->Array.get(i) {
+    | Some(m) => (await send(t, m))->ignore
+    | None => ()
+    }
+  }
+
+// ── Queries ─────────────────────────────────────────────────────────────────
+
+/**
+ * Walks a Relay-style connection to the end. Connections page at 50 by default,
+ * so any count taken from a single request silently truncates.
+ */
+let queryAllNodes = async (t: t, ~field as fieldName: string, ~selection: string): array<
+  JSON.t,
+> => {
+  let nodes = []
+  let after = ref(None)
+  let more = ref(true)
+  while more.contents {
+    let cursor = switch after.contents {
+    | Some(c) => `, after: ${quote(c)}`
+    | None => ""
+    }
+    let query = `{ ${fieldName}(first: 100${cursor}) { edges { node { ${selection} } } pageInfo { hasNextPage endCursor } } }`
+    let data = await gql(t, ~query, ~label=fieldName)
+    let connection = data->field(fieldName)->Option.getOr(JSON.Encode.null)
+    switch connection->field("edges") {
+    | Some(Array(edges)) =>
+      edges->Array.forEach(edge =>
+        switch edge->field("node") {
+        | Some(node) => nodes->Array.push(node)
+        | None => ()
+        }
+      )
+    | _ => ()
+    }
+    let pageInfo = connection->field("pageInfo")->Option.getOr(JSON.Encode.null)
+    let hasNext = switch pageInfo->field("hasNextPage") {
+    | Some(Boolean(b)) => b
+    | _ => false
+    }
+    let endCursor = pageInfo->nodeString("endCursor")
+    switch (hasNext, endCursor) {
+    | (true, Some(c)) => after := Some(c)
+    | _ => more := false
+    }
+  }
+  nodes
+}
+
+let countNodes = async (t: t, ~field: string): int =>
+  (await queryAllNodes(t, ~field, ~selection="id"))->Array.length
+
+/**
+ * Polls a `<View>ByIds` field until every id is present.
+ *
+ * Cross-plugin propagation (extension point → extension → command) is
+ * asynchronous, so a seed that places orders immediately after creating
+ * products would race the shadow copy. Waiting on the observable result beats
+ * sleeping and hoping.
+ */
+let waitForIds = async (
+  t: t,
+  ~field as fieldName: string,
+  ~ids: array<string>,
+  ~timeoutMs: int=60000,
+): int => {
+  let deadline = nowMs() +. Int.toFloat(timeoutMs)
+  let idList = ids->Array.map(id => quote(id))->Array.join(", ")
+  let result = ref(None)
+  while result.contents == None {
+    let query = `{ ${fieldName}(ids: [${idList}]) { id } }`
+    let data = await gql(t, ~query, ~label=fieldName)
+    let found = switch data->field(fieldName) {
+    | Some(Array(rows)) => rows
+    | _ => []
+    }
+    if found->Array.length >= ids->Array.length {
+      result := Some(found->Array.length)
+    } else if nowMs() > deadline {
+      let present = found->Array.filterMap(row => row->nodeString("id"))
+      let missing = ids->Array.filter(id => !(present->Array.includes(id)))
+      let shown = missing->Array.slice(~start=0, ~end=10)->Array.join(", ")
+      let extra =
+        missing->Array.length > 10 ? ` (+${(missing->Array.length - 10)->Int.toString} more)` : ""
+      throw(
+        Failed(
+          `only ${(found->Array.length)->Int.toString}/${(ids->Array.length)
+              ->Int.toString} ids reached ${fieldName} within ${timeoutMs->Int.toString}ms.\n  missing: ${shown}${extra}`,
+        ),
+      )
+    } else {
+      await sleep(250)
+    }
+  }
+  result.contents->Option.getOr(0)
+}

package/src/Seed_Client.res.mjs

@@ -0,0 +1,242 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Stdlib_Array from "@rescript/runtime/lib/es6/Stdlib_Array.js";
+import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
+import * as Seed_Types$ReventlessSeed from "./Seed_Types.res.mjs";
+
+function sleep(ms) {
+  return new Promise((resolve, param) => {
+    setTimeout(() => resolve(), ms);
+  });
+}
+
+function make(config) {
+  return {
+    config: config,
+    token: undefined
+  };
+}
+
+function currentToken(t) {
+  return t.token;
+}
+
+function field(json, key) {
+  if (typeof json === "object" && json !== null && !Array.isArray(json)) {
+    return json[key];
+  }
+}
+
+function asString(json) {
+  if (typeof json === "string") {
+    return json;
+  }
+}
+
+function nodeString(node, key) {
+  return Stdlib_Option.flatMap(field(node, key), asString);
+}
+
+async function login(t) {
+  let body = JSON.stringify(Object.fromEntries([
+    [
+      "username",
+      t.config.username
+    ],
+    [
+      "password",
+      t.config.password
+    ]
+  ]));
+  let res;
+  try {
+    res = await fetch(t.config.loginEndpoint, {
+      method: "POST",
+      headers: Object.fromEntries([[
+          "content-type",
+          "application/json"
+        ]]),
+      body: body
+    });
+  } catch (exn) {
+    throw {
+      RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+      _1: `login: cannot reach ` + t.config.loginEndpoint + ` — is the platform running?`,
+      Error: new Error()
+    };
+  }
+  if (!res.ok) {
+    let detail = await res.text();
+    throw {
+      RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+      _1: `login as "` + t.config.username + `" failed with HTTP ` + res.status.toString() + `: ` + detail,
+      Error: new Error()
+    };
+  }
+  let json = await res.json();
+  t.token = Stdlib_Option.flatMap(field(json, "token"), asString);
+}
+
+async function gql(t, query, label) {
+  let headers = Object.fromEntries([[
+      "content-type",
+      "application/json"
+    ]]);
+  let token = t.token;
+  if (token !== undefined) {
+    headers["authorization"] = `Bearer ` + token;
+  }
+  let body = JSON.stringify(Object.fromEntries([[
+      "query",
+      query
+    ]]));
+  let res;
+  try {
+    res = await fetch(t.config.endpoint, {
+      method: "POST",
+      headers: headers,
+      body: body
+    });
+  } catch (exn) {
+    throw {
+      RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+      _1: label + `: cannot reach ` + t.config.endpoint + ` — is the platform running?`,
+      Error: new Error()
+    };
+  }
+  let json = await res.json();
+  let errors = field(json, "errors");
+  if (errors !== undefined) {
+    throw {
+      RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+      _1: label + ` failed\n  query: ` + query + `\n  response: ` + JSON.stringify(errors),
+      Error: new Error()
+    };
+  }
+  return Stdlib_Option.getOr(field(json, "data"), null);
+}
+
+let commandResultSelection = `__typename
+  ... on CommandAccepted { eventCount }
+  ... on CommandRejected { errorCode errorDetail }`;
+
+async function send(t, m, tolerateOpt) {
+  let tolerate = tolerateOpt !== undefined ? tolerateOpt : [];
+  let label = Seed_Types$ReventlessSeed.describe(m);
+  let query = `mutation { r: ` + m.field + `(` + Seed_Types$ReventlessSeed.renderArgs(m.args) + `) { ` + commandResultSelection + ` } }`;
+  let data = await gql(t, query, label);
+  let result = Stdlib_Option.getOr(field(data, "r"), null);
+  let match = nodeString(result, "__typename");
+  if (match === undefined) {
+    return;
+  }
+  if (match !== "CommandRejected") {
+    return;
+  }
+  let code = Stdlib_Option.getOr(nodeString(result, "errorCode"), "unknown");
+  let detail = Stdlib_Option.getOr(nodeString(result, "errorDetail"), "none");
+  if (tolerate.includes(code)) {
+    return code;
+  }
+  throw {
+    RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+    _1: label + ` was rejected\n  errorCode: ` + code + `\n  errorDetail: ` + detail,
+    Error: new Error()
+  };
+}
+
+async function sendAll(t, mutations) {
+  for (let i = 0, i_finish = mutations.length; i < i_finish; ++i) {
+    let m = mutations[i];
+    if (m !== undefined) {
+      await send(t, m, undefined);
+    }
+  }
+}
+
+async function queryAllNodes(t, fieldName, selection) {
+  let nodes = [];
+  let after;
+  let more = true;
+  while (more) {
+    let c = after;
+    let cursor = c !== undefined ? `, after: ` + Seed_Types$ReventlessSeed.quote(c) : "";
+    let query = `{ ` + fieldName + `(first: 100` + cursor + `) { edges { node { ` + selection + ` } } pageInfo { hasNextPage endCursor } } }`;
+    let data = await gql(t, query, fieldName);
+    let connection = Stdlib_Option.getOr(field(data, fieldName), null);
+    let match = field(connection, "edges");
+    if (Array.isArray(match)) {
+      match.forEach(edge => {
+        let node = field(edge, "node");
+        if (node !== undefined) {
+          nodes.push(node);
+          return;
+        }
+      });
+    }
+    let pageInfo = Stdlib_Option.getOr(field(connection, "pageInfo"), null);
+    let match$1 = field(pageInfo, "hasNextPage");
+    let hasNext = match$1 === true;
+    let endCursor = nodeString(pageInfo, "endCursor");
+    if (hasNext && endCursor !== undefined) {
+      after = endCursor;
+    } else {
+      more = false;
+    }
+  };
+  return nodes;
+}
+
+async function countNodes(t, field) {
+  return (await queryAllNodes(t, field, "id")).length;
+}
+
+async function waitForIds(t, fieldName, ids, timeoutMsOpt) {
+  let timeoutMs = timeoutMsOpt !== undefined ? timeoutMsOpt : 60000;
+  let deadline = Date.now() + timeoutMs;
+  let idList = ids.map(Seed_Types$ReventlessSeed.quote).join(", ");
+  let result;
+  while (result === undefined) {
+    let query = `{ ` + fieldName + `(ids: [` + idList + `]) { id } }`;
+    let data = await gql(t, query, fieldName);
+    let match = field(data, fieldName);
+    let found = match !== undefined ? (
+        Array.isArray(match) ? match : []
+      ) : [];
+    if (found.length >= ids.length) {
+      result = found.length;
+    } else {
+      if (Date.now() > deadline) {
+        let present = Stdlib_Array.filterMap(found, row => nodeString(row, "id"));
+        let missing = ids.filter(id => !present.includes(id));
+        let shown = missing.slice(0, 10).join(", ");
+        let extra = missing.length > 10 ? ` (+` + (missing.length - 10 | 0).toString() + ` more)` : "";
+        throw {
+          RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+          _1: `only ` + found.length.toString() + `/` + ids.length.toString() + ` ids reached ` + fieldName + ` within ` + timeoutMs.toString() + `ms.\n  missing: ` + shown + extra,
+          Error: new Error()
+        };
+      }
+      await sleep(250);
+    }
+  };
+  return Stdlib_Option.getOr(result, 0);
+}
+
+export {
+  sleep,
+  make,
+  currentToken,
+  field,
+  asString,
+  nodeString,
+  login,
+  gql,
+  commandResultSelection,
+  send,
+  sendAll,
+  queryAllNodes,
+  countNodes,
+  waitForIds,
+}
+/* No side effect */

package/src/Seed_Random.res

@@ -0,0 +1,80 @@
+// Deterministic pseudo-randomness for reproducible datasets.
+//
+// A seeded generator rather than `Math.random`, so two runs against a fresh
+// store produce identical data — which is what makes a seeded store usable as a
+// baseline for screenshots or comparison.
+
+@scope("Math") @val external imul: (int, int) => int = "imul"
+
+type t = {mutable state: int}
+
+let make = (~seed: int): t => {state: seed}
+
+
+/** mulberry32 — small, fast, and stable across JS engines and Node versions. */
+let float = (r: t): float => {
+  r.state = (r.state + 0x6d2b79f5)->Int.bitwiseOr(0)
+  let a = r.state
+  let b = imul(a->Int.bitwiseXor(a->Int.shiftRightUnsigned(15)), a->Int.bitwiseOr(1))
+  let c = b->Int.bitwiseXor(b + imul(b->Int.bitwiseXor(b->Int.shiftRightUnsigned(7)), b->Int.bitwiseOr(61)))
+  let bits = c->Int.bitwiseXor(c->Int.shiftRightUnsigned(14))
+  // `bits` is a signed 32-bit result; fold the sign bit back in to get the
+  // unsigned value a `>>> 0` would produce.
+  let unsigned = bits < 0 ? Int.toFloat(bits) +. 4294967296.0 : Int.toFloat(bits)
+  unsigned /. 4294967296.0
+}
+
+/** Inclusive on both ends. */
+let int = (r: t, ~min: int, ~max: int): int =>
+  min + Int.fromFloat(float(r) *. Int.toFloat(max - min + 1))
+
+let pick = (r: t, xs: array<'a>): option<'a> =>
+  xs->Array.get(Int.fromFloat(float(r) *. Int.toFloat(xs->Array.length)))
+
+let pickOr = (r: t, ~fallback: 'a, xs: array<'a>): 'a => pick(r, xs)->Option.getOr(fallback)
+
+/**
+ * Weighted sample without replacement.
+ *
+ * Used both for skewing which items are chosen (a few popular ones, a long
+ * tail) and for shuffling — pass equal weights and a count equal to the input
+ * length to get a deterministic permutation.
+ */
+let sampleWeighted = (r: t, entries: array<('a, float)>, ~count: int): array<'a> => {
+  let pool = entries->Array.copy
+  let chosen = []
+  let remaining = count < pool->Array.length ? count : pool->Array.length
+  for _ in 1 to remaining {
+    let total = pool->Array.reduce(0.0, (sum, (_, w)) => sum +. w)
+    let cursor = ref(float(r) *. total)
+    let index = ref(pool->Array.length - 1)
+    let found = ref(false)
+    pool->Array.forEachWithIndex(((_, w), i) => {
+      if !found.contents {
+        cursor := cursor.contents -. w
+        if cursor.contents <= 0.0 {
+          index := i
+          found := true
+        }
+      }
+    })
+    switch pool->Array.get(index.contents) {
+    | Some((item, _)) =>
+      chosen->Array.push(item)
+      pool->Array.splice(~start=index.contents, ~remove=1, ~insert=[])
+    | None => ()
+    }
+  }
+  chosen
+}
+
+/**
+ * Zipf-like weights over an already-ordered array: the first entry carries the
+ * most weight and the tail decays smoothly. `exponent` controls how sharp the
+ * head is — around 1.1 gives a clear leader with a long tail.
+ */
+let zipfWeights = (items: array<'a>, ~exponent: float): array<('a, float)> =>
+  items->Array.mapWithIndex((item, rank) => (
+    item,
+    1.0 /. Math.pow(Int.toFloat(rank + 1), ~exp=exponent),
+  ))