@reventlessdev/reventless-seed 1.0.0-alpha.16 → 1.0.0-alpha.18

package/lib/bs/src/Seed_Users.res

@@ -0,0 +1,80 @@
+// The dev accounts a seed run can log in as, read from `.reventless/users.yaml`.
+//
+// Both platforms keep that file beside the package the seed runs from: locally
+// the in-memory auth adapter loads it at startup, and on AWS it is the record of
+// what was created in the Cognito pool. Either way it already holds the
+// credentials an operator would otherwise retype, so the credential prompt
+// offers its entries instead of asking for a password nobody remembers.
+//
+// Absence is normal and silent — the caller falls back to asking. Nothing here
+// throws: a missing, unreadable or malformed file yields no accounts.
+
+@module("yaml") external parseYaml: string => JSON.t = "parse"
+
+/** One account: what to log in as, and what to send with it. */
+type user = {username: string, password: string, groups: array<string>}
+
+let asString = (json: JSON.t): option<string> =>
+  switch json {
+  | String(s) => Some(s)
+  | _ => None
+  }
+
+let userOf = (json: JSON.t): option<user> =>
+  switch json {
+  | Object(obj) =>
+    switch (
+      obj->Dict.get("username")->Option.flatMap(asString),
+      obj->Dict.get("password")->Option.flatMap(asString),
+    ) {
+    | (Some(username), Some(password)) =>
+      let groups = switch obj->Dict.get("groups") {
+      | Some(JSON.Array(items)) => items->Array.filterMap(asString)
+      | _ => []
+      }
+      Some({username, password, groups})
+    | _ => None
+    }
+  | _ => None
+  }
+
+/**
+ * The accounts a users.yaml document defines, in the order it defines them —
+ * the order is what makes "the first one" a stable default.
+ *
+ * An entry without both a username and a password is skipped rather than
+ * rejected: the file is hand-maintained, and one incomplete entry should not
+ * cost the operator the rest of the list.
+ */
+let parseString = (yamlText: string): array<user> => {
+  let doc = try parseYaml(yamlText) catch {
+  | _ => JSON.Null
+  }
+  switch doc {
+  | Array(items) => items->Array.filterMap(userOf)
+  | _ => []
+  }
+}
+
+/** Where the file lives for the platform being seeded — the seed runs from that
+    package's directory, which is the same cwd the local auth adapter reads. */
+let defaultPath = (): string => NodePath.join([NodeProcess.cwd(), ".reventless", "users.yaml"])
+
+/**
+ * The accounts on disk, with the path they came from. `None` when there is no
+ * readable file with at least one usable account, which the caller reads as
+ * "ask for credentials instead".
+ */
+let load = (~path: option<string>=?): option<(string, array<user>)> => {
+  let file = path->Option.getOr(defaultPath())
+  let users = try {
+    NodeFs.existsSync(file) ? parseString(NodeFs.readFileSync(file)) : []
+  } catch {
+  | _ => []
+  }
+  users->Array.length == 0 ? None : Some((file, users))
+}
+
+/** Menu label: the username, plus whatever groups the file records for it. */
+let label = (u: user): string =>
+  u.groups->Array.length == 0 ? u.username : `${u.username}  [${u.groups->Array.join(", ")}]`

package/lib/bs/src/Seed_Users.res.mjs

@@ -0,0 +1,90 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Yaml from "yaml";
+import * as Nodefs from "node:fs";
+import * as Nodepath from "node:path";
+import * as Stdlib_Array from "@rescript/runtime/lib/es6/Stdlib_Array.js";
+import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
+
+function asString(json) {
+  if (typeof json === "string") {
+    return json;
+  }
+}
+
+function userOf(json) {
+  if (typeof json !== "object" || json === null || Array.isArray(json)) {
+    return;
+  }
+  let match = Stdlib_Option.flatMap(json["username"], asString);
+  let match$1 = Stdlib_Option.flatMap(json["password"], asString);
+  if (match === undefined) {
+    return;
+  }
+  if (match$1 === undefined) {
+    return;
+  }
+  let match$2 = json["groups"];
+  let groups = match$2 !== undefined ? (
+      Array.isArray(match$2) ? Stdlib_Array.filterMap(match$2, asString) : []
+    ) : [];
+  return {
+    username: match,
+    password: match$1,
+    groups: groups
+  };
+}
+
+function parseString(yamlText) {
+  let doc;
+  try {
+    doc = Yaml.parse(yamlText);
+  } catch (exn) {
+    doc = null;
+  }
+  if (Array.isArray(doc)) {
+    return Stdlib_Array.filterMap(doc, userOf);
+  } else {
+    return [];
+  }
+}
+
+function defaultPath() {
+  return Nodepath.join(process.cwd(), ".reventless", "users.yaml");
+}
+
+function load(path) {
+  let file = Stdlib_Option.getOr(path, defaultPath());
+  let users;
+  try {
+    users = Nodefs.existsSync(file) ? parseString(Nodefs.readFileSync(file, "utf8")) : [];
+  } catch (exn) {
+    users = [];
+  }
+  if (users.length === 0) {
+    return;
+  } else {
+    return [
+      file,
+      users
+    ];
+  }
+}
+
+function label(u) {
+  if (u.groups.length === 0) {
+    return u.username;
+  } else {
+    return u.username + `  [` + u.groups.join(", ") + `]`;
+  }
+}
+
+export {
+  asString,
+  userOf,
+  parseString,
+  defaultPath,
+  load,
+  label,
+}
+/* yaml Not a pure module */

package/lib/bs/tests/Seed_ClientTest.res

@@ -0,0 +1,59 @@
+open JestGlobals
+
+// A seed issues hundreds of commands against runtimes a preceding reset left
+// cold, so the endpoint faulting on one of them is a normal event rather than an
+// exceptional one. Before the retry, a single `InternalFailure` in that batch
+// aborted the run and left a half-seeded store that could only be recovered by a
+// full wipe and a re-run — for a request that would have succeeded on being
+// asked again.
+//
+// What makes the retry safe is the classifier, so that is what these pin. A
+// fault on the endpoint's side carries no information about the document and is
+// worth resending; anything that is an *answer* — a validation error, an unknown
+// field, a refused token — comes back identical however many times it is asked,
+// and resending it only delays the failure the operator needs to see.
+
+let errors = entries => JSON.Encode.array(entries->Array.map(JSON.Encode.object))
+
+let errorOfType = errorType =>
+  Dict.fromArray([("errorType", JSON.Encode.string(errorType))])
+
+describe("Seed_Client.isTransient:", () => {
+  testSync("resends a fault on the endpoint's own side", () =>
+    ["InternalFailure", "ServiceUnavailable", "Throttling", "TooManyRequestsException"]
+    ->Array.forEach(t =>
+      expect(Seed_Client.isTransient(errors([errorOfType(t)])))->toBe(true)
+    )
+  )
+
+  // The exact payload the seed aborted on.
+  testSync("resends the shape AppSync actually returned", () => {
+    let payload = JSON.parseOrThrow(`[{"errorType":"InternalFailure","message":"An internal failure occurred."}]`)
+    expect(Seed_Client.isTransient(payload))->toBe(true)
+  })
+
+  testSync("fails fast on an error that is an answer", () =>
+    ["ValidationException", "Unauthorized", "FieldUndefined"]->Array.forEach(t =>
+      expect(Seed_Client.isTransient(errors([errorOfType(t)])))->toBe(false)
+    )
+  )
+
+  // A real error sitting alongside a transient one still means the request was
+  // wrong, and resending it cannot make it right.
+  testSync("refuses to resend a batch that mixes a real error in", () =>
+    expect(
+      Seed_Client.isTransient(
+        errors([errorOfType("InternalFailure"), errorOfType("ValidationException")]),
+      ),
+    )->toBe(false)
+  )
+
+  // `Array.every` is vacuously true on an empty array, which would turn "the
+  // endpoint said errors but named none" into an endless resend.
+  testSync("treats an empty or untyped error list as final", () => {
+    expect(Seed_Client.isTransient(errors([])))->toBe(false)
+    expect(Seed_Client.isTransient(errors([Dict.fromArray([("message", JSON.Encode.string("boom"))])])))
+    ->toBe(false)
+    expect(Seed_Client.isTransient(JSON.Encode.null))->toBe(false)
+  })
+})

package/lib/bs/tests/Seed_ClientTest.res.mjs

@@ -0,0 +1,64 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Seed_Client$ReventlessSeed from "../src/Seed_Client.res.mjs";
+
+function errors(entries) {
+  return entries.map(prim => prim);
+}
+
+function errorOfType(errorType) {
+  return Object.fromEntries([[
+      "errorType",
+      errorType
+    ]]);
+}
+
+globalThis.describe("Seed_Client.isTransient:", () => {
+  globalThis.test("resends a fault on the endpoint's own side", () => {
+    [
+      "InternalFailure",
+      "ServiceUnavailable",
+      "Throttling",
+      "TooManyRequestsException"
+    ].forEach(t => {
+      let entries = [errorOfType(t)];
+      globalThis.expect(Seed_Client$ReventlessSeed.isTransient(entries.map(prim => prim))).toBe(true);
+    });
+  });
+  globalThis.test("resends the shape AppSync actually returned", () => {
+    let payload = JSON.parse(`[{"errorType":"InternalFailure","message":"An internal failure occurred."}]`);
+    globalThis.expect(Seed_Client$ReventlessSeed.isTransient(payload)).toBe(true);
+  });
+  globalThis.test("fails fast on an error that is an answer", () => {
+    [
+      "ValidationException",
+      "Unauthorized",
+      "FieldUndefined"
+    ].forEach(t => {
+      let entries = [errorOfType(t)];
+      globalThis.expect(Seed_Client$ReventlessSeed.isTransient(entries.map(prim => prim))).toBe(false);
+    });
+  });
+  globalThis.test("refuses to resend a batch that mixes a real error in", () => {
+    let entries = [
+      errorOfType("InternalFailure"),
+      errorOfType("ValidationException")
+    ];
+    globalThis.expect(Seed_Client$ReventlessSeed.isTransient(entries.map(prim => prim))).toBe(false);
+  });
+  globalThis.test("treats an empty or untyped error list as final", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.isTransient([].map(prim => prim))).toBe(false);
+    let entries = [Object.fromEntries([[
+          "message",
+          "boom"
+        ]])];
+    globalThis.expect(Seed_Client$ReventlessSeed.isTransient(entries.map(prim => prim))).toBe(false);
+    globalThis.expect(Seed_Client$ReventlessSeed.isTransient(null)).toBe(false);
+  });
+});
+
+export {
+  errors,
+  errorOfType,
+}
+/*  Not a pure module */

package/lib/bs/tests/Seed_UsersTest.res

@@ -0,0 +1,92 @@
+open JestGlobals
+
+// `.reventless/users.yaml` is hand-maintained and shared with the auth adapter,
+// so the seed reads it defensively: it must survive the comment blocks both
+// copies carry, must not reorder the accounts (the first one is the prompt's
+// default, so order IS the contract), and must never throw — a broken file costs
+// the menu, not the run.
+
+let document = `
+# Local dev users — a comment block like the real file carries.
+
+- username: admin
+  password: admin
+  groups: [Admin, Shopper]
+  userId: local-admin
+
+- username: shopper
+  password: Shopper-2026!
+  groups: [Shopper]
+
+- username: noGroups
+  password: pw
+`
+
+describe("Seed_Users.parseString:", () => {
+  testSync("reads every account, in the order the file defines them", () => {
+    let users = Seed_Users.parseString(document)
+    expect(users->Array.map(u => u.Seed_Users.username))->Expect.toEqual([
+      "admin",
+      "shopper",
+      "noGroups",
+    ])
+  })
+
+  testSync("carries the password beside the username", () => {
+    let users = Seed_Users.parseString(document)
+    expect(users->Array.map(u => u.Seed_Users.password))->Expect.toEqual([
+      "admin",
+      "Shopper-2026!",
+      "pw",
+    ])
+  })
+
+  testSync("keeps the groups, and reads a missing groups key as none", () => {
+    let users = Seed_Users.parseString(document)
+    expect(users->Array.map(u => u.Seed_Users.groups))->Expect.toEqual([
+      ["Admin", "Shopper"],
+      ["Shopper"],
+      [],
+    ])
+  })
+
+  // An entry half-written by hand is the likely flaw in this file. Dropping it
+  // keeps the other accounts selectable; failing the parse would not.
+  testSync("skips an entry that names no password", () => {
+    let users = Seed_Users.parseString(`
+- username: admin
+  password: admin
+- username: halfWritten
+  groups: [Shopper]
+`)
+    expect(users->Array.map(u => u.Seed_Users.username))->Expect.toEqual(["admin"])
+  })
+
+  testSync("yields no accounts for a document that is not a list", () => {
+    expect(Seed_Users.parseString("users: {}")->Array.length)->Expect.toBe(0)
+  })
+
+  // The whole point of returning accounts rather than raising: the caller falls
+  // back to prompting, and it can only do that if nothing here escapes.
+  testSync("yields no accounts for malformed YAML instead of throwing", () => {
+    expect(Seed_Users.parseString("- username: [unclosed")->Array.length)->Expect.toBe(0)
+  })
+})
+
+describe("Seed_Users.load:", () => {
+  testSync("is silent about a file that is not there", () => {
+    expect(Seed_Users.load(~path="/nonexistent/.reventless/users.yaml"))->Expect.toBe(None)
+  })
+})
+
+describe("Seed_Users.label:", () => {
+  testSync("names the groups an account carries", () => {
+    expect(
+      Seed_Users.label({username: "admin", password: "x", groups: ["Admin", "Shopper"]}),
+    )->Expect.toBe("admin  [Admin, Shopper]")
+  })
+
+  testSync("is the bare username when the file records no groups", () => {
+    expect(Seed_Users.label({username: "admin", password: "x", groups: []}))->Expect.toBe("admin")
+  })
+})

package/lib/bs/tests/Seed_UsersTest.res.mjs

@@ -0,0 +1,95 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Seed_Users$ReventlessSeed from "../src/Seed_Users.res.mjs";
+
+let document = `
+# Local dev users — a comment block like the real file carries.
+
+- username: admin
+  password: admin
+  groups: [Admin, Shopper]
+  userId: local-admin
+
+- username: shopper
+  password: Shopper-2026!
+  groups: [Shopper]
+
+- username: noGroups
+  password: pw
+`;
+
+globalThis.describe("Seed_Users.parseString:", () => {
+  globalThis.test("reads every account, in the order the file defines them", () => {
+    let users = Seed_Users$ReventlessSeed.parseString(document);
+    globalThis.expect(users.map(u => u.username)).toEqual([
+      "admin",
+      "shopper",
+      "noGroups"
+    ]);
+  });
+  globalThis.test("carries the password beside the username", () => {
+    let users = Seed_Users$ReventlessSeed.parseString(document);
+    globalThis.expect(users.map(u => u.password)).toEqual([
+      "admin",
+      "Shopper-2026!",
+      "pw"
+    ]);
+  });
+  globalThis.test("keeps the groups, and reads a missing groups key as none", () => {
+    let users = Seed_Users$ReventlessSeed.parseString(document);
+    globalThis.expect(users.map(u => u.groups)).toEqual([
+      [
+        "Admin",
+        "Shopper"
+      ],
+      ["Shopper"],
+      []
+    ]);
+  });
+  globalThis.test("skips an entry that names no password", () => {
+    let users = Seed_Users$ReventlessSeed.parseString(`
+- username: admin
+  password: admin
+- username: halfWritten
+  groups: [Shopper]
+`);
+    globalThis.expect(users.map(u => u.username)).toEqual(["admin"]);
+  });
+  globalThis.test("yields no accounts for a document that is not a list", () => {
+    globalThis.expect(Seed_Users$ReventlessSeed.parseString("users: {}").length).toBe(0);
+  });
+  globalThis.test("yields no accounts for malformed YAML instead of throwing", () => {
+    globalThis.expect(Seed_Users$ReventlessSeed.parseString("- username: [unclosed").length).toBe(0);
+  });
+});
+
+globalThis.describe("Seed_Users.load:", () => {
+  globalThis.test("is silent about a file that is not there", () => {
+    globalThis.expect(Seed_Users$ReventlessSeed.load("/nonexistent/.reventless/users.yaml")).toBe(undefined);
+  });
+});
+
+globalThis.describe("Seed_Users.label:", () => {
+  globalThis.test("names the groups an account carries", () => {
+    globalThis.expect(Seed_Users$ReventlessSeed.label({
+      username: "admin",
+      password: "x",
+      groups: [
+        "Admin",
+        "Shopper"
+      ]
+    })).toBe("admin  [Admin, Shopper]");
+  });
+  globalThis.test("is the bare username when the file records no groups", () => {
+    globalThis.expect(Seed_Users$ReventlessSeed.label({
+      username: "admin",
+      password: "x",
+      groups: []
+    })).toBe("admin");
+  });
+});
+
+export {
+  document,
+}
+/*  Not a pure module */

package/lib/ocaml/.compiler.log

@@ -1,2 +1,2 @@
-#Start(1787013927827)
-#Done(1787013927856)
+#Start(1787841681066)
+#Done(1787841681103)

package/lib/ocaml/ReventlessSeed.mlmap

@@ -1,6 +1,7 @@
 randjbuildsystem
 Seed
 Seed_Client
+Seed_ClientTest
 Seed_Connect
 Seed_Prompt
 Seed_PromptTest
@@ -9,3 +10,5 @@ Seed_RandomTest
 Seed_Runner
 Seed_Types
 Seed_Upload
+Seed_Users
+Seed_UsersTest

package/lib/ocaml/Seed.res

@@ -10,6 +10,7 @@ module Client = Seed_Client
 module Runner = Seed_Runner
 module Upload = Seed_Upload
 module Prompt = Seed_Prompt
+module Users = Seed_Users
 module Connect = Seed_Connect
 
 exception Failed = Seed_Types.Failed

package/lib/ocaml/Seed_Client.res

@@ -106,10 +106,57 @@ let login = async (t: t): unit => {
   t.token = json->field("token")->Option.flatMap(asString)
 }
 
+/** Error types the endpoint returns for a fault on its own side rather than a
+    problem with the document. They say nothing about the request, so the same
+    request sent again can succeed — and across the few hundred commands a seed
+    issues, one of these is ordinary rather than exceptional.
+
+    Everything else — a validation error, an unknown field, a refused token — is
+    an answer, and the same answer comes back however many times it is asked. */
+let transientErrorTypes = [
+  "InternalFailure",
+  "ServiceUnavailable",
+  "ServiceUnavailableError",
+  "Throttling",
+  "ThrottlingException",
+  "TooManyRequestsException",
+  "RequestTimeout",
+]
+
+/** Every entry must be transient for the document to be worth resending: one
+    real error alongside a transient one still means the request was wrong. An
+    empty `errors` array is not a reason to retry either. */
+let isTransient = (errors: JSON.t): bool =>
+  switch errors->JSON.Decode.array {
+  | None | Some([]) => false
+  | Some(entries) =>
+    entries->Array.every(e =>
+      switch e->nodeString("errorType") {
+      | Some(errorType) => transientErrorTypes->Array.includes(errorType)
+      | None => false
+      }
+    )
+  }
+
+let attempts = 4
+
 /**
  * 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.
+ *
+ * Which is exactly why a fault on the endpoint's own side must not abort it. A
+ * seed issues hundreds of commands, many of them concurrently and all of them
+ * against runtimes that a preceding reset left cold, so a single
+ * `InternalFailure` somewhere in the batch is a normal event. Treating it as
+ * fatal threw away every command that had already landed and demanded a full
+ * wipe and re-run — for a request that would have succeeded on being asked
+ * again. So resend those, backing off between tries, and keep failing fast on
+ * everything that is an answer rather than a fault.
+ *
+ * The backoff is jittered because the commands go out in concurrent batches: a
+ * fixed delay would have the whole batch retry in lockstep and rebuild the same
+ * burst that provoked the fault.
  */
 let gql = async (t: t, ~query: string, ~label: string): JSON.t => {
   let headers = Dict.fromArray([("content-type", "application/json")])
@@ -120,18 +167,27 @@ let gql = async (t: t, ~query: string, ~label: string): JSON.t => {
   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)
+  let rec attempt = async (n: int): JSON.t => {
+    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) =>
+      if errors->isTransient && n < attempts {
+        await sleep(250 * Int.shiftLeft(1, n - 1) + Int.fromFloat(Math.random() *. 250.))
+        await attempt(n + 1)
+      } else {
+        let tried = n > 1 ? `\n  gave up after ${n->Int.toString} attempts` : ""
+        throw(
+          Failed(`${label} failed\n  query: ${query}\n  response: ${JSON.stringify(errors)}${tried}`),
+        )
+      }
+    | None => json->field("data")->Option.getOr(JSON.Encode.null)
+    }
   }
+  await attempt(1)
 }
 
 // ── Commands ────────────────────────────────────────────────────────────────