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

package/lib/ocaml/Seed_Runner.res

@@ -2,11 +2,9 @@
 
 open Seed_Types
 
-@scope("process") @val external exit: int => unit = "exit"
-@scope("process") @val external env: dict<string> = "env"
 
 let envOr = (key: string, fallback: string): string =>
-  env->Dict.get(key)->Option.getOr(fallback)
+  NodeProcess.env->Dict.get(key)->Option.getOr(fallback)
 
 /** One line of progress per phase, so a slow run never looks hung. */
 let report = (line: string): unit => Console.log(`  ${line}`)
@@ -90,19 +88,52 @@ let warn = (warnings: array<string>): unit =>
     warnings->Array.forEach(w => Console.log(`  - ${w}`))
   }
 
+/**
+ * Pre-flight: refuse to seed onto a store that already holds data.
+ *
+ * The harness is a one-shot against a fresh store — a re-run would hit the
+ * domain's own duplicate rejections (`CategoryAlreadyExists`, …) and abort
+ * mid-phase. Catching it here, before any command is sent, turns that into an
+ * honest "nothing was written" startup abort instead of a misleading
+ * half-seeded one. It is the inverse of `verifyViews`: seeding refuses to start
+ * unless the store reads empty. Stops at the first non-empty probe view, so a
+ * populated store aborts after a single query.
+ */
+let assertStoreEmpty = async (client: Seed_Client.t, ~probeViews: array<string>): unit =>
+  for i in 0 to probeViews->Array.length - 1 {
+    switch probeViews->Array.get(i) {
+    | Some(name) =>
+      let count = await Seed_Client.countNodes(client, ~field=name)
+      if count > 0 {
+        throw(
+          Failed(
+            `the target store is not empty — "${name}" already holds ${count->Int.toString} row(s). Seeding is a one-shot against a fresh store; reset the store before re-running.`,
+          ),
+        )
+      }
+    | None => ()
+    }
+  }
+
 /**
  * Wraps a seed run. On failure it prints the cause and exits non-zero, saying
  * plainly that the store is now half-seeded — recovery is a reset, not a re-run.
  */
 let run = async (main: unit => promise<unit>): unit =>
-  try await main() catch {
+  try {
+    await main()
+    // Exit cleanly: HTTP keep-alive sockets (and, on the interactive path, the
+    // readline/stdin handle) can otherwise keep the event loop alive so the CLI
+    // appears to hang after a successful run.
+    NodeProcess.exit(0)
+  } catch {
   | Failed(message) =>
     Console.error("")
     Console.error("Seeding aborted — the store is now half-seeded; re-run against a")
     Console.error("fresh store once the cause below is fixed.")
     Console.error("")
     Console.error(message)
-    exit(1)
+    NodeProcess.exit(1)
   | exn =>
     Console.error("")
     Console.error("Seeding aborted with an unexpected error:")
@@ -110,5 +141,90 @@ let run = async (main: unit => promise<unit>): unit =>
     Console.error(
       exn->JsExn.fromException->Option.flatMap(JsExn.message)->Option.getOr("unknown"),
     )
-    exit(1)
+    NodeProcess.exit(1)
   }
+
+/**
+ * A named, seedable data set. `seed` owns everything domain-specific — the
+ * phases, `verifyViews`, the summary board — so the generic runner never sees
+ * domain detail. `label` is what the selection menu shows.
+ */
+type dataSet = {
+  name: string,
+  label: string,
+  seed: Seed_Connect.connection => promise<unit>,
+  // View names probed by the fresh-store guard before any command is sent; a
+  // non-empty one aborts the run at startup. Omit to skip the guard.
+  probeViews?: array<string>,
+}
+
+/**
+ * A failure before any command is sent — bad data-set selection, an
+ * unreachable/undeployed target, a login failure. Nothing was written, so this
+ * says so plainly rather than warning about a half-seeded store (which would
+ * send the user resetting a store the run never touched).
+ */
+let abortStartup = (message: string): unit => {
+  Seed_Prompt.close()
+  Console.error("")
+  Console.error("Seeding did not start — nothing was written. Fix the cause below and re-run.")
+  Console.error("")
+  Console.error(message)
+  NodeProcess.exit(1)
+}
+
+/**
+ * Top-level seed entry: choose a data set (auto when there is one, `SEED_SET`
+ * or a menu otherwise), connect, then hand the connection to the chosen set.
+ * Prompts are closed before seeding so the shared readline never lingers.
+ *
+ * Selection and connect run before any command is sent, so a failure there is
+ * reported as "did not start"; only failures inside the data set's own `seed`
+ * carry the half-seeded warning (via `run`).
+ */
+let seed = (~sets: array<dataSet>, ~connect: unit => promise<Seed_Connect.connection>): unit => {
+  let go = async () => {
+    let started = try {
+      let chosen = switch sets {
+      | [only] => only
+      | _ =>
+        switch Seed_Prompt.envValue("SEED_SET") {
+        | Some(wanted) =>
+          switch sets->Array.find(s => s.name == wanted) {
+          | Some(s) => s
+          | None =>
+            throw(
+              Failed(
+                `SEED_SET="${wanted}" matches no data set (have: ${sets
+                  ->Array.map(s => s.name)
+                  ->Array.join(", ")})`,
+              ),
+            )
+          }
+        | None =>
+          await Seed_Prompt.select(~title="Data set:", ~options=sets->Array.map(s => (s.label, s)))
+        }
+      }
+      let connection = await connect()
+      Seed_Prompt.close()
+      // Runs inside this pre-seed `try`, so refusing a non-empty store (or a
+      // failed probe query) is reported as "did not start", not "half-seeded".
+      await assertStoreEmpty(connection.client, ~probeViews=chosen.probeViews->Option.getOr([]))
+      Some((chosen, connection))
+    } catch {
+    | Failed(message) =>
+      abortStartup(message)
+      None
+    | exn =>
+      abortStartup(exn->JsExn.fromException->Option.flatMap(JsExn.message)->Option.getOr("unknown"))
+      None
+    }
+    switch started {
+    | None => () // unreachable: abortStartup has already exited
+    | Some((chosen, connection)) =>
+      heading(`Seeding "${chosen.label}" into ${connection.label}`)
+      await run(() => chosen.seed(connection))
+    }
+  }
+  go()->ignore
+}

package/lib/ocaml/Seed_Upload.res

@@ -1,27 +1,26 @@
-// Seed-time asset upload against the framework's presign-shaped upload contract.
+// Seed-time asset upload against the framework's upload contract (route B).
 //
-// One code path for both providers: the AWS `Upload_Presign_S3` Function URL and
-// the local dev upload route expose the SAME shape — POST `{fileName,contentType}`
-// → `{uploadUrl, storageRef}`, then PUT the bytes to `uploadUrl`. `uploadAsset`
-// resolves `Ok(storageRef)` — the same same-origin `/{prefix}/{key}` ref a command
-// stores and the UI renders.
+// Minting is a GraphQL mutation on the domain API — `Upload_Presign(store, fileName,
+// contentType)` — authenticated by the same bearer the seed already uses for commands
+// (no separate endpoint, no anonymous surface). `uploadAsset` issues it through the
+// shared `Seed_Client`, then PUTs the bytes to the returned `uploadUrl` and resolves
+// `Ok(storageRef)` — the same `/{prefix}/{key}` ref a command stores and the UI renders.
 //
-// The seed runs under Node, so the returned `uploadUrl` is resolved to an
-// absolute URL against the endpoint's origin: AWS returns an absolute presigned
-// S3 URL (unchanged), while the local route returns a same-origin relative
-// `/{prefix}/{key}` that Node's `fetch` cannot PUT to until it is made absolute.
+// The seed runs under Node, so a relative `uploadUrl` (the local dev server returns a
+// same-origin `/{prefix}/{key}`) is resolved to an absolute URL against the client's
+// endpoint origin before the PUT; AWS returns an absolute presigned S3 URL (used as-is).
+// The PUT itself is unauthenticated — presigned on AWS, open on the local route.
 
 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"
 
-// Resolve a possibly-relative URL against a base (WHATWG URL semantics: an
-// absolute `input` ignores `base`, a relative one is resolved against it).
+// Resolve a possibly-relative URL against a base (WHATWG URL semantics: an absolute
+// `input` ignores `base`, a relative one is resolved against it).
 type url
 @new external makeUrl: (string, string) => url = "URL"
 @get external urlHref: url => string = "href"
@@ -38,51 +37,50 @@ let asString = (json: JSON.t): option<string> =>
   | _ => None
   }
 
-// A `fetch` that reports an unreachable endpoint as `Error` instead of throwing,
-// so the two-step upload can thread failures without exceptions.
+// Whether this run should skip uploads entirely. `SEED_SKIP_UPLOADS` seeds domain data
+// fast, or skips a broken/absent upload path without editing the data set.
+let uploadsSkipped = (): bool => Seed_Prompt.envValue("SEED_SKIP_UPLOADS")->Option.isSome
+
+// A `fetch` that reports an unreachable endpoint as `Error` instead of throwing.
 let tryFetch = async (url: string, init: fetchInit): result<response, string> =>
   try Ok(await fetch(url, init)) catch {
   | _ => Error(`cannot reach ${url}`)
   }
 
 /**
- * Uploads `bytes` under `fileName`/`contentType` through `uploadEndpoint` and
+ * Uploads `bytes` under `fileName`/`contentType` into `store` (the qualified
+ * `{plugin}.{store}` the asset's field declares, e.g. `"Catalog.productImages"`) and
  * resolves `Ok(storageRef)` (the stored `/{prefix}/{key}` ref), or `Error(msg)`
- * describing the step that failed. `authToken`, when supplied, is sent as a
- * Bearer on the presign request (the endpoint decides whether it is required;
- * the PUT itself is unauthenticated — presigned on AWS, open locally).
+ * describing the step that failed. Mints through the domain API's `Upload_Presign`
+ * mutation on `client`, then PUTs the bytes to the returned `uploadUrl`.
  */
 let uploadAsset = async (
-  ~uploadEndpoint: string,
+  ~client: Seed_Client.t,
+  ~store: string,
   ~bytes: string,
   ~fileName: string,
   ~contentType: string,
-  ~authToken: option<string>=?,
 ): result<string, string> => {
-  let presignHeaders = Dict.fromArray([("content-type", "application/json")])
-  authToken->Option.forEach(t => presignHeaders->Dict.set("authorization", `Bearer ${t}`))
-  let presignBody = JSON.stringify(
-    JSON.Encode.object(
-      Dict.fromArray([
-        ("fileName", JSON.Encode.string(fileName)),
-        ("contentType", JSON.Encode.string(contentType)),
-      ]),
-    ),
-  )
+  // GraphQL string literals: JSON-quote the argument values (JSON string escaping is a
+  // superset-safe subset of GraphQL's for these ASCII-ish inputs).
+  let q = s => JSON.stringify(JSON.Encode.string(s))
+  let query = `mutation { r: Upload_Presign(store: ${q(store)}, fileName: ${q(fileName)}, contentType: ${q(contentType)}) { uploadUrl storageRef } }`
+
+  let presign = try Ok(await Seed_Client.gql(client, ~query, ~label="Upload_Presign")) catch {
+  | Seed_Types.Failed(m) => Error(m)
+  | _ => Error("Upload_Presign: unexpected error")
+  }
 
-  switch await tryFetch(uploadEndpoint, {method: "POST", headers: presignHeaders, body: presignBody}) {
-  | Error(m) => Error(`presign: ${m} — is the platform running?`)
-  | Ok(presignRes) if !(presignRes->responseOk) =>
-    let detail = await presignRes->responseText
-    Error(`presign failed with HTTP ${(presignRes->responseStatus)->Int.toString}: ${detail}`)
-  | Ok(presignRes) =>
-    let json = await presignRes->responseJson
+  switch presign {
+  | Error(m) => Error(`presign: ${m}`)
+  | Ok(data) =>
+    let r = data->field("r")->Option.getOr(JSON.Encode.null)
     switch (
-      json->field("uploadUrl")->Option.flatMap(asString),
-      json->field("storageRef")->Option.flatMap(asString),
+      r->field("uploadUrl")->Option.flatMap(asString),
+      r->field("storageRef")->Option.flatMap(asString),
     ) {
     | (Some(uploadUrl), Some(storageRef)) =>
-      let putUrl = urlHref(makeUrl(uploadUrl, uploadEndpoint))
+      let putUrl = urlHref(makeUrl(uploadUrl, Seed_Client.endpoint(client)))
       switch await tryFetch(
         putUrl,
         {method: "PUT", headers: Dict.fromArray([("content-type", contentType)]), body: bytes},
@@ -93,7 +91,7 @@ let uploadAsset = async (
         let detail = await putRes->responseText
         Error(`upload PUT failed with HTTP ${(putRes->responseStatus)->Int.toString}: ${detail}`)
       }
-    | _ => Error("presign response missing uploadUrl/storageRef")
+    | _ => Error("Upload_Presign response missing uploadUrl/storageRef")
     }
   }
 }

package/package.json

@@ -1,10 +1,14 @@
 {
   "name": "@reventlessdev/reventless-seed",
-  "version": "1.0.0-alpha.1",
+  "version": "1.0.0-alpha.11",
   "description": "Reusable harness for seeding a Reventless platform through its public GraphQL command API",
   "license": "Apache-2.0",
+  "dependencies": {
+    "@reventlessdev/rescript-node": "2.0.0-alpha.4"
+  },
   "devDependencies": {
-    "rescript": "12.3.0"
+    "rescript": "12.3.0",
+    "@reventlessdev/rescript-jest": "1.0.0-alpha.10"
   },
   "peerDependencies": {
     "rescript": "12.3.0"

package/rescript.json

@@ -12,9 +12,17 @@
     {
       "dir": "src",
       "subdirs": true
+    },
+    {
+      "dir": "tests",
+      "subdirs": true,
+      "type": "dev"
     }
   ],
-  "dependencies": [],
+  "dependencies": [
+    "@reventlessdev/rescript-node",
+    "@reventlessdev/rescript-jest"
+  ],
   "compiler-flags": [],
   "suffix": ".res.mjs"
 }

package/src/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/src/Seed.res.mjs

@@ -10,6 +10,10 @@ let Runner;
 
 let Upload;
 
+let Prompt;
+
+let Connect;
+
 let Failed = Seed_Types$ReventlessSeed.Failed;
 
 let mutation = Seed_Types$ReventlessSeed.mutation;
@@ -25,6 +29,8 @@ export {
   Client,
   Runner,
   Upload,
+  Prompt,
+  Connect,
   Failed,
   mutation,
   ids,

package/src/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/src/Seed_Client.res.mjs

@@ -21,6 +21,14 @@ function currentToken(t) {
   return t.token;
 }
 
+function endpoint(t) {
+  return t.config.endpoint;
+}
+
+function useToken(t, token) {
+  t.token = token;
+}
+
 function field(json, key) {
   if (typeof json === "object" && json !== null && !Array.isArray(json)) {
     return json[key];
@@ -38,19 +46,32 @@ function nodeString(node, key) {
 }
 
 async function login(t) {
+  let e = t.config.loginEndpoint;
+  let loginEndpoint;
+  if (e !== undefined) {
+    loginEndpoint = e;
+  } else {
+    throw {
+      RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+      _1: "login: no loginEndpoint configured — supply one or call useToken",
+      Error: new Error()
+    };
+  }
+  let username = Stdlib_Option.getOr(t.config.username, "");
+  let password = Stdlib_Option.getOr(t.config.password, "");
   let body = JSON.stringify(Object.fromEntries([
     [
       "username",
-      t.config.username
+      username
     ],
     [
       "password",
-      t.config.password
+      password
     ]
   ]));
   let res;
   try {
-    res = await fetch(t.config.loginEndpoint, {
+    res = await fetch(loginEndpoint, {
       method: "POST",
       headers: Object.fromEntries([[
           "content-type",
@@ -61,7 +82,7 @@ async function login(t) {
   } catch (exn) {
     throw {
       RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
-      _1: `login: cannot reach ` + t.config.loginEndpoint + ` — is the platform running?`,
+      _1: `login: cannot reach ` + loginEndpoint + ` — is the platform running?`,
       Error: new Error()
     };
   }
@@ -69,7 +90,7 @@ async function login(t) {
     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,
+      _1: `login as "` + username + `" failed with HTTP ` + res.status.toString() + `: ` + detail,
       Error: new Error()
     };
   }
@@ -191,6 +212,28 @@ async function countNodes(t, field) {
   return (await queryAllNodes(t, field, "id")).length;
 }
 
+async function queryAllNodesUntil(t, field, selection, satisfied, onTimeout, timeoutMsOpt) {
+  let timeoutMs = timeoutMsOpt !== undefined ? timeoutMsOpt : 60000;
+  let deadline = Date.now() + timeoutMs;
+  let result;
+  while (result === undefined) {
+    let nodes = await queryAllNodes(t, field, selection);
+    if (satisfied(nodes)) {
+      result = nodes;
+    } else {
+      if (Date.now() > deadline) {
+        throw {
+          RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
+          _1: onTimeout(nodes),
+          Error: new Error()
+        };
+      }
+      await sleep(500);
+    }
+  };
+  return Stdlib_Option.getOr(result, []);
+}
+
 async function waitForIds(t, fieldName, ids, timeoutMsOpt) {
   let timeoutMs = timeoutMsOpt !== undefined ? timeoutMsOpt : 60000;
   let deadline = Date.now() + timeoutMs;
@@ -227,6 +270,8 @@ export {
   sleep,
   make,
   currentToken,
+  endpoint,
+  useToken,
   field,
   asString,
   nodeString,
@@ -237,6 +282,7 @@ export {
   sendAll,
   queryAllNodes,
   countNodes,
+  queryAllNodesUntil,
   waitForIds,
 }
 /* No side effect */