@reventlessdev/reventless-seed 1.0.0-alpha.2 → 1.0.0-alpha.21

package/tests/Seed_ClientTest.res

@@ -0,0 +1,287 @@
+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)
+  })
+})
+
+// An account's listed groups are not what authorizes it — the token's are. Both
+// platforms narrow a token to the single role the caller last chose, so a seed
+// can log in as an account the user list shows as `[Admin, Shopper]` and present
+// a token carrying `Shopper` alone. The refusal that follows names the field and
+// not the caller, and the account list cannot explain it either. These pin the
+// reading-back that turns that into a sentence.
+
+let b64url = payload =>
+  payload
+  ->NodeBuffer.fromStringUtf8
+  ->NodeBuffer.toStringBase64Url
+
+// A REAL JOSE header, not the literal string "header". The difference is the
+// whole bug: `{"kid":…,"alg":"RS256"}` is base64url JSON and decodes exactly as
+// the payload does, so `claims` took it as the claims set and found no groups
+// and no id in any Cognito token ever issued. A fake header that happened not to
+// decode is what let every assertion below pass against broken code.
+let joseHeader = b64url(`{"kid":"abc123","alg":"RS256"}`)
+
+let jwt = claims =>
+  `${joseHeader}.${b64url(JSON.stringify(JSON.Encode.object(Dict.fromArray(claims))))}.signature`
+
+let localToken = claims =>
+  `${b64url(JSON.stringify(JSON.Encode.object(Dict.fromArray(claims))))}.signature`
+
+let strings = values => JSON.Encode.array(values->Array.map(JSON.Encode.string))
+
+let clientWith = token => {
+  let c = Seed_Client.make(~config={endpoint: "http://example.invalid/graphql"})
+  c->Seed_Client.useToken(token)
+  c
+}
+
+describe("Seed_Client.claims:", () => {
+  // The regression this file could not previously express. A JWT header is a
+  // decodable JSON object sitting in front of the payload, so "the first segment
+  // that parses" is the header on every real token — and the seed then reported
+  // no groups, printed no `Acting as:` line, and attached no identity to a
+  // refusal, which is exactly the diagnosis it exists to give.
+  testSync("skips the JOSE header and reads the payload behind it", () =>
+    expect(
+      clientWith(jwt([("sub", JSON.Encode.string("real-sub"))]))
+      ->Seed_Client.claims
+      ->Option.flatMap(c => c->Dict.get("sub"))
+      ->Option.flatMap(JSON.Decode.string),
+    )->toEqual(Some("real-sub"))
+  )
+
+  // The header is identified by `alg`, not by position — a two-segment local dev
+  // token has no header at all, and its payload must not be mistaken for one.
+  testSync("takes the first segment when there is no header", () =>
+    expect(
+      clientWith(localToken([("userId", JSON.Encode.string("local-shopper"))]))
+      ->Seed_Client.claims
+      ->Option.flatMap(c => c->Dict.get("userId"))
+      ->Option.flatMap(JSON.Decode.string),
+    )->toEqual(Some("local-shopper"))
+  )
+})
+
+describe("Seed_Client.effectiveGroups:", () => {
+  // A Cognito id token carries its payload in the second segment, a local dev
+  // token in the first. Neither platform should have to announce which it is.
+  testSync("reads the payload wherever the provider put it", () => {
+    expect(
+      clientWith(
+        jwt([("cognito:groups", strings(["Admin", "Shopper"]))]),
+      )->Seed_Client.effectiveGroups,
+    )->toEqual(Some(["Admin", "Shopper"]))
+    expect(
+      clientWith(localToken([("groups", strings(["Merchandiser"]))]))->Seed_Client.effectiveGroups,
+    )->toEqual(Some(["Merchandiser"]))
+  })
+
+  // An opaque bearer is not an error — it just means this can add nothing, and
+  // the failure reports what it always did.
+  testSync("says nothing about a token it cannot read", () => {
+    expect(clientWith("not-a-token")->Seed_Client.effectiveGroups)->toEqual(None)
+    expect(
+      Seed_Client.make(
+        ~config={endpoint: "http://example.invalid/graphql"},
+      )->Seed_Client.effectiveGroups,
+    )->toEqual(None)
+  })
+})
+
+// The id an `@owner` field is stamped with. A seed that cannot read it can only
+// key owner-scoped rows to a literal, and a literal matches one platform's
+// accounts at most — which is how a demo shopper came to be registered on a
+// deployment where nobody can ever be that shopper.
+
+describe("Seed_Client.callerId:", () => {
+  // A Cognito id token says `sub`; the local dev token is a base64url
+  // `Identity.t`, whose field is `userId`. Neither platform announces which.
+  testSync("reads the id under whichever name the provider gave it", () => {
+    expect(
+      clientWith(jwt([("sub", JSON.Encode.string("4275e4a4-00c1-70e1"))]))->Seed_Client.callerId,
+    )->toEqual(Some("4275e4a4-00c1-70e1"))
+    expect(
+      clientWith(
+        localToken([("userId", JSON.Encode.string("local-shopper"))]),
+      )->Seed_Client.callerId,
+    )->toEqual(Some("local-shopper"))
+  })
+
+  // `sub` first, so a token carrying both is read the way the pool that minted
+  // it means it.
+  testSync("prefers sub when a token carries both names", () =>
+    expect(
+      clientWith(
+        jwt([
+          ("sub", JSON.Encode.string("f215e4b4-30f1-700c")),
+          ("userId", JSON.Encode.string("local-shopper")),
+        ]),
+      )->Seed_Client.callerId,
+    )->toEqual(Some("f215e4b4-30f1-700c"))
+  )
+
+  // `None` is not an error — it means this cannot add anything, and the caller
+  // falls back to whatever the accounts file declared.
+  testSync("says nothing about a token it cannot read, or one naming no id", () => {
+    expect(clientWith("not-a-token")->Seed_Client.callerId)->toEqual(None)
+    expect(
+      clientWith(jwt([("cognito:groups", strings(["Admin"]))]))->Seed_Client.callerId,
+    )->toEqual(None)
+    expect(
+      Seed_Client.make(~config={endpoint: "http://example.invalid/graphql"})->Seed_Client.callerId,
+    )->toEqual(None)
+  })
+
+  // A claim of the wrong shape is not an id. Taking the array's first element
+  // would be a guess, and a guessed owner id seeds rows nobody can read.
+  testSync("refuses a claim that is not a single string", () =>
+    expect(clientWith(jwt([("sub", strings(["a", "b"]))]))->Seed_Client.callerId)->toEqual(None)
+  )
+})
+
+describe("Seed_Client.identitySummary:", () => {
+  // The case that cost the debugging: eligible in the user list, refused by the
+  // token. Naming what it was narrowed FROM is what points at the role switch.
+  testSync("names the membership a narrowed token gave up", () =>
+    expect(
+      clientWith(
+        jwt([
+          ("cognito:groups", strings(["Shopper"])),
+          ("availableRoles", JSON.Encode.string("Admin,Shopper")),
+        ]),
+      )->Seed_Client.identitySummary,
+    )->toEqual(Some("Shopper — narrowed to this role from Admin, Shopper"))
+  )
+
+  // An ordinary login is not narrowed and has nothing to explain.
+  testSync("stays quiet about an unnarrowed token", () =>
+    expect(
+      clientWith(
+        jwt([("cognito:groups", strings(["Admin", "Shopper"]))]),
+      )->Seed_Client.identitySummary,
+    )->toEqual(Some("Admin, Shopper"))
+  )
+
+  // A token granting nothing reads as a sentence rather than an empty string.
+  testSync("says so when the token carries no groups at all", () =>
+    expect(
+      clientWith(jwt([("cognito:groups", strings([]))]))->Seed_Client.identitySummary,
+    )->toEqual(Some("no groups"))
+  )
+})
+
+// Whether a token is narrowed cannot be read off the group claim: a bearer
+// carrying one group looks identical whether the account holds one role or five.
+// `availableRoles` is written only when a role was chosen, so its presence IS
+// the narrowing — and that is what decides whether the seed has anything to ask.
+
+describe("Seed_Client.narrowedFrom:", () => {
+  testSync("names the membership a narrowed token was reduced from", () =>
+    expect(
+      clientWith(
+        jwt([
+          ("cognito:groups", strings(["Shopper"])),
+          ("availableRoles", JSON.Encode.string("Admin,Shopper")),
+        ]),
+      )->Seed_Client.narrowedFrom,
+    )->toEqual(Some(["Admin", "Shopper"]))
+  )
+
+  // The case that must NOT prompt: a single-role account is not narrowed, it is
+  // simply small. Asking it to choose would put a question in every run.
+  testSync("says nothing about an unnarrowed token", () => {
+    expect(
+      clientWith(jwt([("cognito:groups", strings(["Shopper"]))]))->Seed_Client.narrowedFrom,
+    )->toEqual(None)
+    expect(
+      clientWith(
+        jwt([("cognito:groups", strings(["Admin", "Shopper"]))]),
+      )->Seed_Client.narrowedFrom,
+    )->toEqual(None)
+  })
+
+  // An empty claim is not a narrowing to nothing — it is a claim carrying no
+  // information, and offering a menu of no roles would be a dead end.
+  testSync("treats an empty availableRoles as not narrowed", () =>
+    expect(
+      clientWith(jwt([("availableRoles", JSON.Encode.string(""))]))->Seed_Client.narrowedFrom,
+    )->toEqual(None)
+  )
+})
+
+describe("Seed_Client.isDenied:", () => {
+  // AppSync types it; the local server carries it in the message.
+  testSync("recognises a refusal in either platform's vocabulary", () => {
+    expect(Seed_Client.isDenied(errors([errorOfType("Unauthorized")])))->toBe(true)
+    expect(
+      Seed_Client.isDenied(
+        errors([Dict.fromArray([("message", JSON.Encode.string("Not Authorized to access X"))])]),
+      ),
+    )->toBe(true)
+  })
+
+  // Attaching an identity to an unrelated failure would point the reader at the
+  // wrong thing.
+  testSync("leaves every other failure alone", () => {
+    expect(Seed_Client.isDenied(errors([errorOfType("ValidationException")])))->toBe(false)
+    expect(Seed_Client.isDenied(errors([])))->toBe(false)
+  })
+})

package/tests/Seed_ClientTest.res.mjs

@@ -0,0 +1,268 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Stdlib_JSON from "@rescript/runtime/lib/es6/Stdlib_JSON.js";
+import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
+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);
+  });
+});
+
+function b64url(payload) {
+  return Buffer.from(payload, "utf8").toString("base64url");
+}
+
+let joseHeader = Buffer.from(`{"kid":"abc123","alg":"RS256"}`, "utf8").toString("base64url");
+
+function jwt(claims) {
+  let payload = JSON.stringify(Object.fromEntries(claims));
+  return joseHeader + `.` + Buffer.from(payload, "utf8").toString("base64url") + `.signature`;
+}
+
+function localToken(claims) {
+  let payload = JSON.stringify(Object.fromEntries(claims));
+  return Buffer.from(payload, "utf8").toString("base64url") + `.signature`;
+}
+
+function strings(values) {
+  return values.map(prim => prim);
+}
+
+function clientWith(token) {
+  let c = Seed_Client$ReventlessSeed.make({
+    endpoint: "http://example.invalid/graphql"
+  });
+  Seed_Client$ReventlessSeed.useToken(c, token);
+  return c;
+}
+
+globalThis.describe("Seed_Client.claims:", () => {
+  globalThis.test("skips the JOSE header and reads the payload behind it", () => {
+    globalThis.expect(Stdlib_Option.flatMap(Stdlib_Option.flatMap(Seed_Client$ReventlessSeed.claims(clientWith(jwt([[
+        "sub",
+        "real-sub"
+      ]]))), c => c["sub"]), Stdlib_JSON.Decode.string)).toEqual("real-sub");
+  });
+  globalThis.test("takes the first segment when there is no header", () => {
+    globalThis.expect(Stdlib_Option.flatMap(Stdlib_Option.flatMap(Seed_Client$ReventlessSeed.claims(clientWith(localToken([[
+        "userId",
+        "local-shopper"
+      ]]))), c => c["userId"]), Stdlib_JSON.Decode.string)).toEqual("local-shopper");
+  });
+});
+
+globalThis.describe("Seed_Client.effectiveGroups:", () => {
+  globalThis.test("reads the payload wherever the provider put it", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.effectiveGroups(clientWith(jwt([[
+        "cognito:groups",
+        [
+          "Admin",
+          "Shopper"
+        ].map(prim => prim)
+      ]])))).toEqual([
+      "Admin",
+      "Shopper"
+    ]);
+    globalThis.expect(Seed_Client$ReventlessSeed.effectiveGroups(clientWith(localToken([[
+        "groups",
+        ["Merchandiser"].map(prim => prim)
+      ]])))).toEqual(["Merchandiser"]);
+  });
+  globalThis.test("says nothing about a token it cannot read", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.effectiveGroups(clientWith("not-a-token"))).toEqual(undefined);
+    globalThis.expect(Seed_Client$ReventlessSeed.effectiveGroups(Seed_Client$ReventlessSeed.make({
+      endpoint: "http://example.invalid/graphql"
+    }))).toEqual(undefined);
+  });
+});
+
+globalThis.describe("Seed_Client.callerId:", () => {
+  globalThis.test("reads the id under whichever name the provider gave it", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.callerId(clientWith(jwt([[
+        "sub",
+        "4275e4a4-00c1-70e1"
+      ]])))).toEqual("4275e4a4-00c1-70e1");
+    globalThis.expect(Seed_Client$ReventlessSeed.callerId(clientWith(localToken([[
+        "userId",
+        "local-shopper"
+      ]])))).toEqual("local-shopper");
+  });
+  globalThis.test("prefers sub when a token carries both names", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.callerId(clientWith(jwt([
+      [
+        "sub",
+        "f215e4b4-30f1-700c"
+      ],
+      [
+        "userId",
+        "local-shopper"
+      ]
+    ])))).toEqual("f215e4b4-30f1-700c");
+  });
+  globalThis.test("says nothing about a token it cannot read, or one naming no id", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.callerId(clientWith("not-a-token"))).toEqual(undefined);
+    globalThis.expect(Seed_Client$ReventlessSeed.callerId(clientWith(jwt([[
+        "cognito:groups",
+        ["Admin"].map(prim => prim)
+      ]])))).toEqual(undefined);
+    globalThis.expect(Seed_Client$ReventlessSeed.callerId(Seed_Client$ReventlessSeed.make({
+      endpoint: "http://example.invalid/graphql"
+    }))).toEqual(undefined);
+  });
+  globalThis.test("refuses a claim that is not a single string", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.callerId(clientWith(jwt([[
+        "sub",
+        [
+          "a",
+          "b"
+        ].map(prim => prim)
+      ]])))).toEqual(undefined);
+  });
+});
+
+globalThis.describe("Seed_Client.identitySummary:", () => {
+  globalThis.test("names the membership a narrowed token gave up", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.identitySummary(clientWith(jwt([
+      [
+        "cognito:groups",
+        ["Shopper"].map(prim => prim)
+      ],
+      [
+        "availableRoles",
+        "Admin,Shopper"
+      ]
+    ])))).toEqual("Shopper — narrowed to this role from Admin, Shopper");
+  });
+  globalThis.test("stays quiet about an unnarrowed token", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.identitySummary(clientWith(jwt([[
+        "cognito:groups",
+        [
+          "Admin",
+          "Shopper"
+        ].map(prim => prim)
+      ]])))).toEqual("Admin, Shopper");
+  });
+  globalThis.test("says so when the token carries no groups at all", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.identitySummary(clientWith(jwt([[
+        "cognito:groups",
+        [].map(prim => prim)
+      ]])))).toEqual("no groups");
+  });
+});
+
+globalThis.describe("Seed_Client.narrowedFrom:", () => {
+  globalThis.test("names the membership a narrowed token was reduced from", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.narrowedFrom(clientWith(jwt([
+      [
+        "cognito:groups",
+        ["Shopper"].map(prim => prim)
+      ],
+      [
+        "availableRoles",
+        "Admin,Shopper"
+      ]
+    ])))).toEqual([
+      "Admin",
+      "Shopper"
+    ]);
+  });
+  globalThis.test("says nothing about an unnarrowed token", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.narrowedFrom(clientWith(jwt([[
+        "cognito:groups",
+        ["Shopper"].map(prim => prim)
+      ]])))).toEqual(undefined);
+    globalThis.expect(Seed_Client$ReventlessSeed.narrowedFrom(clientWith(jwt([[
+        "cognito:groups",
+        [
+          "Admin",
+          "Shopper"
+        ].map(prim => prim)
+      ]])))).toEqual(undefined);
+  });
+  globalThis.test("treats an empty availableRoles as not narrowed", () => {
+    globalThis.expect(Seed_Client$ReventlessSeed.narrowedFrom(clientWith(jwt([[
+        "availableRoles",
+        ""
+      ]])))).toEqual(undefined);
+  });
+});
+
+globalThis.describe("Seed_Client.isDenied:", () => {
+  globalThis.test("recognises a refusal in either platform's vocabulary", () => {
+    let entries = [errorOfType("Unauthorized")];
+    globalThis.expect(Seed_Client$ReventlessSeed.isDenied(entries.map(prim => prim))).toBe(true);
+    let entries$1 = [Object.fromEntries([[
+          "message",
+          "Not Authorized to access X"
+        ]])];
+    globalThis.expect(Seed_Client$ReventlessSeed.isDenied(entries$1.map(prim => prim))).toBe(true);
+  });
+  globalThis.test("leaves every other failure alone", () => {
+    let entries = [errorOfType("ValidationException")];
+    globalThis.expect(Seed_Client$ReventlessSeed.isDenied(entries.map(prim => prim))).toBe(false);
+    globalThis.expect(Seed_Client$ReventlessSeed.isDenied([].map(prim => prim))).toBe(false);
+  });
+});
+
+export {
+  errors,
+  errorOfType,
+  b64url,
+  joseHeader,
+  jwt,
+  localToken,
+  strings,
+  clientWith,
+}
+/*  Not a pure module */

package/tests/Seed_ConnectTest.res

@@ -0,0 +1,64 @@
+open JestGlobals
+
+// `SEED_ROLE` is how a run says what to act as when nobody can answer a prompt —
+// a CI run wedged by a stored narrowing, or a deliberate restricted run.
+//
+// It carries two different intentions in one variable, which is why the parsing
+// is worth pinning: naming a role narrows to it, and the "give me everything"
+// answer has several spellings because an operator setting it by hand will write
+// whichever one comes to mind. Getting that wrong is not a typo — `SEED_ROLE=full`
+// read as a role named "full" would ask the platform to act as a group nobody
+// holds, and be refused.
+
+let withEnv = (value: option<string>, f: unit => unit) => {
+  let key = "SEED_ROLE"
+  let previous = NodeProcess.env->Dict.get(key)
+  switch value {
+  | Some(v) => NodeProcess.env->Dict.set(key, v)
+  | None => NodeProcess.env->Dict.delete(key)
+  }
+  f()
+  switch previous {
+  | Some(v) => NodeProcess.env->Dict.set(key, v)
+  | None => NodeProcess.env->Dict.delete(key)
+  }
+}
+
+describe("Seed_Connect.roleFromEnv:", () => {
+  testSync("is absent when nothing asked for a role", () =>
+    withEnv(None, () => expect(Seed_Connect.roleFromEnv())->Expect.toEqual(None))
+  )
+
+  testSync("reads a named role as a narrowing to it", () =>
+    withEnv(
+      Some("Shopper"),
+      () =>
+        expect(Seed_Connect.roleFromEnv())->Expect.toEqual(Some(Seed_Connect.Narrowed("Shopper"))),
+    )
+  )
+
+  // Every spelling of "everything" an operator might reach for. They all mean
+  // clear the stored choice, which is what seeding wants.
+  testSync("takes each spelling of full membership as a clear", () =>
+    ["full", "all", "none", "clear", "FULL", "All"]->Array.forEach(
+      v =>
+        withEnv(
+          Some(v),
+          () => expect(Seed_Connect.roleFromEnv())->Expect.toEqual(Some(Seed_Connect.Full)),
+        ),
+    )
+  )
+
+  // Role names are case-sensitive to the platform (`mayActAs` compares exactly),
+  // so a named role is passed through untouched — only the clear vocabulary is
+  // case-folded.
+  testSync("passes a role name through with its case intact", () =>
+    withEnv(
+      Some("Merchandiser"),
+      () =>
+        expect(Seed_Connect.roleFromEnv())->Expect.toEqual(
+          Some(Seed_Connect.Narrowed("Merchandiser")),
+        ),
+    )
+  )
+})

package/tests/Seed_ConnectTest.res.mjs

@@ -0,0 +1,56 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Stdlib_Dict from "@rescript/runtime/lib/es6/Stdlib_Dict.js";
+import * as Seed_Connect$ReventlessSeed from "../src/Seed_Connect.res.mjs";
+
+function withEnv(value, f) {
+  let key = "SEED_ROLE";
+  let previous = process.env[key];
+  if (value !== undefined) {
+    process.env[key] = value;
+  } else {
+    Stdlib_Dict.$$delete(process.env, key);
+  }
+  f();
+  if (previous !== undefined) {
+    process.env[key] = previous;
+    return;
+  } else {
+    return Stdlib_Dict.$$delete(process.env, key);
+  }
+}
+
+globalThis.describe("Seed_Connect.roleFromEnv:", () => {
+  globalThis.test("is absent when nothing asked for a role", () => withEnv(undefined, () => {
+    globalThis.expect(Seed_Connect$ReventlessSeed.roleFromEnv()).toEqual(undefined);
+  }));
+  globalThis.test("reads a named role as a narrowing to it", () => withEnv("Shopper", () => {
+    globalThis.expect(Seed_Connect$ReventlessSeed.roleFromEnv()).toEqual({
+      TAG: "Narrowed",
+      _0: "Shopper"
+    });
+  }));
+  globalThis.test("takes each spelling of full membership as a clear", () => {
+    [
+      "full",
+      "all",
+      "none",
+      "clear",
+      "FULL",
+      "All"
+    ].forEach(v => withEnv(v, () => {
+      globalThis.expect(Seed_Connect$ReventlessSeed.roleFromEnv()).toEqual("Full");
+    }));
+  });
+  globalThis.test("passes a role name through with its case intact", () => withEnv("Merchandiser", () => {
+    globalThis.expect(Seed_Connect$ReventlessSeed.roleFromEnv()).toEqual({
+      TAG: "Narrowed",
+      _0: "Merchandiser"
+    });
+  }));
+});
+
+export {
+  withEnv,
+}
+/*  Not a pure module */