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

package/src/Seed_Prompt.res.mjs

@@ -53,6 +53,10 @@ function envValue(key) {
   }
 }
 
+function hasTty() {
+  return Stdlib_Option.getOr(process.stdin.isTTY, false);
+}
+
 function requireTty() {
   if (Stdlib_Option.getOr(process.stdin.isTTY, false)) {
     return;
@@ -142,6 +146,15 @@ async function select(title, options, env, defaultIndex) {
   return await pick();
 }
 
+function typedUser(username, password) {
+  return {
+    username: username,
+    password: password,
+    groups: [],
+    userId: undefined
+  };
+}
+
 async function askCredentials(localDefaults, envUser) {
   let username;
   if (envUser !== undefined) {
@@ -160,10 +173,7 @@ async function askCredentials(localDefaults, envUser) {
     let entered$1 = await askHidden(localDefaults ? "Password [admin]: " : "Password: ");
     password = entered$1 === "" && localDefaults ? "admin" : entered$1;
   }
-  return [
-    username,
-    password
-  ];
+  return typedUser(username, password);
 }
 
 async function fromUsersFile(envUser) {
@@ -179,10 +189,10 @@ async function fromUsersFile(envUser) {
     ]), "SEED_USER", 0);
   return Stdlib_Option.map(chosen, u => {
     console.log(`Logging in as ` + u.username + ` (from ` + path + `)`);
-    return [
-      u.username,
-      u.password
-    ];
+    return {
+      caller: u,
+      accounts: users
+    };
   });
 }
 
@@ -190,33 +200,31 @@ async function credentials(localDefaultsOpt) {
   let localDefaults = localDefaultsOpt !== undefined ? localDefaultsOpt : false;
   let envUser = envValue("REVENTLESS_DEMO_USER");
   let match = envValue("REVENTLESS_DEMO_PASSWORD");
-  let match$1;
+  let resolved;
   let exit = 0;
   if (envUser !== undefined && match !== undefined) {
-    match$1 = [
-      envUser,
-      match
-    ];
+    resolved = {
+      caller: typedUser(envUser, match),
+      accounts: []
+    };
   } else {
     exit = 1;
   }
   if (exit === 1) {
-    let pair = await fromUsersFile(envUser);
-    match$1 = pair !== undefined ? pair : await askCredentials(localDefaults, envUser);
+    let resolved$1 = await fromUsersFile(envUser);
+    resolved = resolved$1 !== undefined ? resolved$1 : ({
+        caller: await askCredentials(localDefaults, envUser),
+        accounts: []
+      });
   }
-  let password = match$1[1];
-  let username = match$1[0];
-  if (username === "" || password === "") {
+  if (resolved.caller.username === "" || resolved.caller.password === "") {
     throw {
       RE_EXN_ID: Seed_Types$ReventlessSeed.Failed,
       _1: "username and password are required.",
       Error: new Error()
     };
   }
-  return [
-    username,
-    password
-  ];
+  return resolved;
 }
 
 export {
@@ -225,11 +233,13 @@ export {
   iface,
   close,
   envValue,
+  hasTty,
   requireTty,
   ask,
   askHidden,
   isAffirmative,
   select,
+  typedUser,
   askCredentials,
   fromUsersFile,
   credentials,

package/src/Seed_Random.res

@@ -10,13 +10,15 @@ 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 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.

package/src/Seed_Runner.res

@@ -2,7 +2,6 @@
 
 open Seed_Types
 
-
 let envOr = (key: string, fallback: string): string =>
   NodeProcess.env->Dict.get(key)->Option.getOr(fallback)
 
@@ -58,14 +57,12 @@ let verifyViews = async (client: Seed_Client.t, ~views: array<view>): dict<int>
     Console.log(`  ${count->Int.toString->String.padStart(4, " ")}  ${name}${note}`)
   })
 
-  let empty =
-    views
-    ->Array.filterMap(v =>
-      switch v {
-      | Seeded(name) if counts->Dict.get(name)->Option.getOr(0) == 0 => Some(name)
-      | _ => None
-      }
-    )
+  let empty = views->Array.filterMap(v =>
+    switch v {
+    | Seeded(name) if counts->Dict.get(name)->Option.getOr(0) == 0 => Some(name)
+    | _ => None
+    }
+  )
   if empty->Array.length > 0 {
     throw(Failed(`these views are still empty after seeding: ${empty->Array.join(", ")}`))
   }
@@ -138,9 +135,7 @@ let run = async (main: unit => promise<unit>): unit =>
     Console.error("")
     Console.error("Seeding aborted with an unexpected error:")
     Console.error("")
-    Console.error(
-      exn->JsExn.fromException->Option.flatMap(JsExn.message)->Option.getOr("unknown"),
-    )
+    Console.error(exn->JsExn.fromException->Option.flatMap(JsExn.message)->Option.getOr("unknown"))
     NodeProcess.exit(1)
   }
 

package/src/Seed_Upload.res

@@ -64,7 +64,9 @@ let uploadAsset = async (
   // 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 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)
@@ -89,7 +91,7 @@ let uploadAsset = async (
       | Ok(putRes) if putRes->responseOk => Ok(storageRef)
       | Ok(putRes) =>
         let detail = await putRes->responseText
-        Error(`upload PUT failed with HTTP ${(putRes->responseStatus)->Int.toString}: ${detail}`)
+        Error(`upload PUT failed with HTTP ${putRes->responseStatus->Int.toString}: ${detail}`)
       }
     | _ => Error("Upload_Presign response missing uploadUrl/storageRef")
     }

package/src/Seed_Users.res

@@ -11,8 +11,20 @@
 
 @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>}
+/**
+ * One account: what to log in as, what to send with it, and — when the file
+ * records one — the id the platform stamps on rows this account writes.
+ *
+ * `userId` is optional because absence is normal on both platforms: a local file
+ * may omit it and let the auth adapter default it to the username, and a
+ * hand-maintained AWS file records subs the pool minted, so it can lag.
+ */
+type user = {
+  username: string,
+  password: string,
+  groups: array<string>,
+  userId: option<string>,
+}
 
 let asString = (json: JSON.t): option<string> =>
   switch json {
@@ -32,7 +44,7 @@ let userOf = (json: JSON.t): option<user> =>
       | Some(JSON.Array(items)) => items->Array.filterMap(asString)
       | _ => []
       }
-      Some({username, password, groups})
+      Some({username, password, groups, userId: obj->Dict.get("userId")->Option.flatMap(asString)})
     | _ => None
     }
   | _ => None

package/src/Seed_Users.res.mjs

@@ -31,7 +31,8 @@ function userOf(json) {
   return {
     username: match,
     password: match$1,
-    groups: groups
+    groups: groups,
+    userId: Stdlib_Option.flatMap(json["userId"], asString)
   };
 }
 

package/tests/Seed_ClientTest.res

@@ -15,15 +15,16 @@ open JestGlobals
 
 let errors = entries => JSON.Encode.array(entries->Array.map(JSON.Encode.object))
 
-let errorOfType = errorType =>
-  Dict.fromArray([("errorType", JSON.Encode.string(errorType))])
+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)
-    )
+    [
+      "InternalFailure",
+      "ServiceUnavailable",
+      "Throttling",
+      "TooManyRequestsException",
+    ]->Array.forEach(t => expect(Seed_Client.isTransient(errors([errorOfType(t)])))->toBe(true))
   )
 
   // The exact payload the seed aborted on.
@@ -33,8 +34,8 @@ describe("Seed_Client.isTransient:", () => {
   })
 
   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)
+    ["ValidationException", "Unauthorized", "FieldUndefined"]->Array.forEach(
+      t => expect(Seed_Client.isTransient(errors([errorOfType(t)])))->toBe(false),
     )
   )
 
@@ -52,8 +53,9 @@ describe("Seed_Client.isTransient:", () => {
   // 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(errors([Dict.fromArray([("message", JSON.Encode.string("boom"))])])),
+    )->toBe(false)
     expect(Seed_Client.isTransient(JSON.Encode.null))->toBe(false)
   })
 })
@@ -70,8 +72,15 @@ let b64url = 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 =>
-  `header.${b64url(JSON.stringify(JSON.Encode.object(Dict.fromArray(claims))))}.signature`
+  `${joseHeader}.${b64url(JSON.stringify(JSON.Encode.object(Dict.fromArray(claims))))}.signature`
 
 let localToken = claims =>
   `${b64url(JSON.stringify(JSON.Encode.object(Dict.fromArray(claims))))}.signature`
@@ -84,12 +93,41 @@ let clientWith = 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,
+      clientWith(
+        jwt([("cognito:groups", strings(["Admin", "Shopper"]))]),
+      )->Seed_Client.effectiveGroups,
     )->toEqual(Some(["Admin", "Shopper"]))
     expect(
       clientWith(localToken([("groups", strings(["Merchandiser"]))]))->Seed_Client.effectiveGroups,
@@ -101,12 +139,64 @@ describe("Seed_Client.effectiveGroups:", () => {
   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,
+      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.
@@ -124,8 +214,9 @@ describe("Seed_Client.identitySummary:", () => {
   // 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,
+      clientWith(
+        jwt([("cognito:groups", strings(["Admin", "Shopper"]))]),
+      )->Seed_Client.identitySummary,
     )->toEqual(Some("Admin, Shopper"))
   )
 
@@ -137,6 +228,45 @@ describe("Seed_Client.identitySummary:", () => {
   )
 })
 
+// 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", () => {

package/tests/Seed_ClientTest.res.mjs

@@ -1,5 +1,7 @@
 // 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) {
@@ -61,9 +63,11 @@ 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 `header.` + Buffer.from(payload, "utf8").toString("base64url") + `.signature`;
+  return joseHeader + `.` + Buffer.from(payload, "utf8").toString("base64url") + `.signature`;
 }
 
 function localToken(claims) {
@@ -83,6 +87,21 @@ function clientWith(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([[
@@ -108,6 +127,50 @@ globalThis.describe("Seed_Client.effectiveGroups:", () => {
   });
 });
 
+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([
@@ -138,6 +201,43 @@ globalThis.describe("Seed_Client.identitySummary:", () => {
   });
 });
 
+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")];
@@ -159,6 +259,7 @@ export {
   errors,
   errorOfType,
   b64url,
+  joseHeader,
   jwt,
   localToken,
   strings,

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")),
+        ),
+    )
+  )
+})