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

package/lib/bs/tests/Seed_UsersTest.res

@@ -50,6 +50,22 @@ describe("Seed_Users.parseString:", () => {
     ])
   })
 
+  // The half that was dropped, and the reason owner-scoped demo rows were keyed
+  // to ids nobody on a Cognito deployment holds: the file records the id the
+  // platform stamps, and reading it only for a password threw that away.
+  //
+  // Absent stays absent rather than defaulting to the username — a local file
+  // may omit it and let the auth adapter default it, and an AWS file records a
+  // sub no default could invent. Guessing here would look like an answer.
+  testSync("keeps the userId an entry declares, and reads a missing one as absent", () => {
+    let users = Seed_Users.parseString(document)
+    expect(users->Array.map(u => u.Seed_Users.userId))->Expect.toEqual([
+      Some("local-admin"),
+      None,
+      None,
+    ])
+  })
+
   // 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", () => {
@@ -79,14 +95,73 @@ describe("Seed_Users.load:", () => {
   })
 })
 
+// A pool that signs in on an email address takes `shopper@example.com`, not
+// `shopper`, so a demo cannot find its accounts by username alone there.
+describe("Seed_Users.playing:", () => {
+  let users = Seed_Users.parseString(`
+- username: shopper@example.com
+  password: pw
+  groups: [Shopper]
+  demoOwner: shopper
+- username: admin
+  password: pw
+  groups: [Admin]
+`)
+
+  testSync("finds the account whose demoOwner names the person", () => {
+    expect(
+      Seed_Users.playing(users, "shopper")->Option.map(u => u.Seed_Users.username),
+    )->Expect.toEqual(Some("shopper@example.com"))
+  })
+
+  testSync("falls back to the username when no entry declares one", () => {
+    expect(
+      Seed_Users.playing(users, "admin")->Option.map(u => u.Seed_Users.username),
+    )->Expect.toEqual(Some("admin"))
+  })
+
+  testSync("finds nobody for a person no entry plays", () => {
+    expect(Seed_Users.playing(users, "merch"))->Expect.toEqual(None)
+  })
+})
+
 describe("Seed_Users.label:", () => {
   testSync("names the groups an account carries", () => {
     expect(
-      Seed_Users.label({username: "admin", password: "x", groups: ["Admin", "Shopper"]}),
+      Seed_Users.label({
+        username: "admin",
+        password: "x",
+        groups: ["Admin", "Shopper"],
+        userId: None,
+        demoOwner: None,
+      }),
     )->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")
+    expect(
+      Seed_Users.label({
+        username: "admin",
+        password: "x",
+        groups: [],
+        userId: None,
+        demoOwner: None,
+      }),
+    )->Expect.toBe("admin")
+  })
+
+  // The menu is unchanged by the id: an operator picks an account by name and
+  // membership, and a Cognito sub in the list would be noise at the one moment
+  // they are choosing a login.
+  testSync("says nothing about the userId", () => {
+    expect(
+      Seed_Users.label({
+        username: "admin",
+        password: "x",
+        groups: ["Admin"],
+        userId: Some("4275e4a4-00c1-70e1-1cb5-363b06b992b5"),
+        demoOwner: None,
+      }),
+    )->Expect.toBe("admin  [Admin]")
   })
 })

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

@@ -1,5 +1,6 @@
 // Generated by ReScript, PLEASE EDIT WITH CARE
 
+import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
 import * as Seed_Users$ReventlessSeed from "../src/Seed_Users.res.mjs";
 
 let document = `
@@ -46,6 +47,14 @@ globalThis.describe("Seed_Users.parseString:", () => {
       []
     ]);
   });
+  globalThis.test("keeps the userId an entry declares, and reads a missing one as absent", () => {
+    let users = Seed_Users$ReventlessSeed.parseString(document);
+    globalThis.expect(users.map(u => u.userId)).toEqual([
+      "local-admin",
+      undefined,
+      undefined
+    ]);
+  });
   globalThis.test("skips an entry that names no password", () => {
     let users = Seed_Users$ReventlessSeed.parseString(`
 - username: admin
@@ -69,6 +78,27 @@ globalThis.describe("Seed_Users.load:", () => {
   });
 });
 
+globalThis.describe("Seed_Users.playing:", () => {
+  let users = Seed_Users$ReventlessSeed.parseString(`
+- username: shopper@example.com
+  password: pw
+  groups: [Shopper]
+  demoOwner: shopper
+- username: admin
+  password: pw
+  groups: [Admin]
+`);
+  globalThis.test("finds the account whose demoOwner names the person", () => {
+    globalThis.expect(Stdlib_Option.map(Seed_Users$ReventlessSeed.playing(users, "shopper"), u => u.username)).toEqual("shopper@example.com");
+  });
+  globalThis.test("falls back to the username when no entry declares one", () => {
+    globalThis.expect(Stdlib_Option.map(Seed_Users$ReventlessSeed.playing(users, "admin"), u => u.username)).toEqual("admin");
+  });
+  globalThis.test("finds nobody for a person no entry plays", () => {
+    globalThis.expect(Seed_Users$ReventlessSeed.playing(users, "merch")).toEqual(undefined);
+  });
+});
+
 globalThis.describe("Seed_Users.label:", () => {
   globalThis.test("names the groups an account carries", () => {
     globalThis.expect(Seed_Users$ReventlessSeed.label({
@@ -77,16 +107,29 @@ globalThis.describe("Seed_Users.label:", () => {
       groups: [
         "Admin",
         "Shopper"
-      ]
+      ],
+      userId: undefined,
+      demoOwner: undefined
     })).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: []
+      groups: [],
+      userId: undefined,
+      demoOwner: undefined
     })).toBe("admin");
   });
+  globalThis.test("says nothing about the userId", () => {
+    globalThis.expect(Seed_Users$ReventlessSeed.label({
+      username: "admin",
+      password: "x",
+      groups: ["Admin"],
+      userId: "4275e4a4-00c1-70e1-1cb5-363b06b992b5",
+      demoOwner: undefined
+    })).toBe("admin  [Admin]");
+  });
 });
 
 export {

package/lib/ocaml/.compiler.log

@@ -1,2 +1,2 @@
-#Start(1788869322834)
-#Done(1788869322875)
+#Start(1789592211625)
+#Done(1789592211686)

package/lib/ocaml/ReventlessSeed.mlmap

@@ -3,6 +3,7 @@ Seed
 Seed_Client
 Seed_ClientTest
 Seed_Connect
+Seed_ConnectTest
 Seed_Prompt
 Seed_PromptTest
 Seed_Random

package/lib/ocaml/Seed.res

@@ -16,12 +16,18 @@ 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.
+// are skipped this run, a label, and who the run is acting as. 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,
+  accounts: array<Seed_Users.user>,
+  caller: Seed_Users.user,
+  callerId: option<string>,
+  login: (~username: string, ~password: string) => promise<string>,
+  roleSwitch: option<Seed_Connect.roleSwitch>,
 }
 
 // A named, seedable data set. `seed` owns everything domain-specific.

package/lib/ocaml/Seed_Client.res

@@ -21,7 +21,8 @@ type response
 @val external setTimeout: (unit => unit, int) => unit = "setTimeout"
 @scope("Date") @val external nowMs: unit => float = "now"
 
-let sleep = (ms: int): promise<unit> => Promise.make((resolve, _) => setTimeout(() => resolve(), ms))
+let sleep = (ms: int): promise<unit> =>
+  Promise.make((resolve, _) => setTimeout(() => resolve(), ms))
 
 // ── Configuration ───────────────────────────────────────────────────────────
 
@@ -68,6 +69,12 @@ let availableRolesClaim = "availableRoles"
 /** Group claim per provider, tried in order. */
 let groupClaimNames = ["cognito:groups", "groups"]
 
+/** Claim carrying the caller's id, per provider, tried in order. A Cognito JWT
+    says `sub`; the local dev token is a base64url `Identity.t`, whose field is
+    `userId`. Same shape as `groupClaimNames`, for the same reason: this harness
+    depends on no framework package and must not learn who signed the token. */
+let callerIdClaimNames = ["sub", "userId"]
+
 let decodeSegment = (segment: string): option<dict<JSON.t>> =>
   try {
     segment
@@ -79,10 +86,22 @@ let decodeSegment = (segment: string): option<dict<JSON.t>> =>
   | _ => None
   }
 
+/**
+ * A JOSE header rather than a claims set.
+ *
+ * RFC 7515 requires `alg` on the header, and nothing puts it on a payload. The
+ * test matters because a JWT header is base64url JSON exactly as the payload is,
+ * so it decodes just as readily — and it comes first.
+ */
+let isJoseHeader = (obj: dict<JSON.t>): bool => obj->Dict.get("alg")->Option.isSome
+
 /** The bearer's payload, from whichever segment carries it — a Cognito JWT puts
     it second and a local dev token first, so trying each in turn saves this from
     having to know which platform signed the token. A segment that is not a JSON
-    object (a signature) simply does not decode. */
+    object (a signature) simply does not decode, and a JOSE header is skipped:
+    it IS a decodable JSON object, so taking the first one that parsed read a
+    real Cognito token's `{kid, alg}` as its claims and found no groups and no
+    id in it — silently, since an unreadable token is not an error here. */
 let claims = (t: t): option<dict<JSON.t>> =>
   t.token->Option.flatMap(token =>
     token
@@ -90,7 +109,11 @@ let claims = (t: t): option<dict<JSON.t>> =>
     ->Array.reduce(None, (found, segment) =>
       switch found {
       | Some(_) => found
-      | None => decodeSegment(segment)
+      | None =>
+        switch decodeSegment(segment) {
+        | Some(obj) if obj->isJoseHeader => None
+        | decoded => decoded
+        }
       }
     )
   )
@@ -118,6 +141,31 @@ let effectiveGroups = (t: t): option<array<string>> =>
     }
   )
 
+/** The id the bearer presents — what an `@owner` field is stamped with, and so
+    the only id a seed can key owner-scoped rows to and have an account read them
+    back. `None` when the token is opaque to us or names no id. */
+let callerId = (t: t): option<string> =>
+  callerIdClaimNames->Array.reduce(None, (found, name) =>
+    switch found {
+    | Some(_) => found
+    | None => t->claims->Option.flatMap(c => c->Dict.get(name))->Option.flatMap(JSON.Decode.string)
+    }
+  )
+
+/**
+ * The membership a narrowed token was reduced *from*, or `None` when the bearer
+ * is not narrowed.
+ *
+ * `availableRoles` is only written when a role was chosen, so its presence is
+ * the narrowing — the group claim alone cannot tell you, since a token carrying
+ * one group looks identical whether the account holds one or five.
+ */
+let narrowedFrom = (t: t): option<array<string>> =>
+  switch t->claimStrings(availableRolesClaim) {
+  | Some(available) if available->Array.length > 0 => Some(available)
+  | _ => None
+  }
+
 /** One line naming the identity the bearer carries, and — when it was narrowed —
     the membership it was narrowed from. The second half is the point: without it
     a refusal looks like a misconfigured grant rather than a role switch. */
@@ -178,8 +226,9 @@ let login = async (t: t): unit => {
     let detail = await res->responseText
     throw(
       Failed(
-        `login as "${username}" failed with HTTP ${(res->responseStatus)
-            ->Int.toString}: ${detail}`,
+        `login as "${username}" failed with HTTP ${res
+          ->responseStatus
+          ->Int.toString}: ${detail}`,
       ),
     )
   }
@@ -254,7 +303,19 @@ let attempts = 4
  * 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 => {
+/** What a document came back as. `Errors` carries both the raw array — so a
+    caller can classify it, e.g. as a refusal — and the message `gql` would have
+    thrown, so the two paths cannot describe the same failure differently. */
+type failure = {errors: JSON.t, message: string}
+type outcome = Data(JSON.t) | Errors(failure)
+
+/**
+ * Sends one document and reports what came back, resending a transient fault
+ * along the way. Returning the errors rather than throwing is what lets a caller
+ * treat a refusal as an *answer* — which the authorization probe needs and
+ * seeding must never do.
+ */
+let gqlOutcome = async (t: t, ~query: string, ~label: string): outcome => {
   let headers = Dict.fromArray([("content-type", "application/json")])
   switch t.token {
   | Some(token) => headers->Dict.set("authorization", `Bearer ${token}`)
@@ -263,10 +324,9 @@ 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 rec attempt = async (n: int): JSON.t => {
+  let rec attempt = async (n: int): outcome => {
     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?`))
+    | _ => throw(Failed(`${label}: cannot reach ${t.config.endpoint} — is the platform running?`))
     }
     let json = await res->responseJson
     switch json->field("errors") {
@@ -283,20 +343,52 @@ let gql = async (t: t, ~query: string, ~label: string): JSON.t => {
         | Some(summary) => `\n  identity: ${summary}`
         | None => ""
         }
-        throw(
-          Failed(
-            `${label} failed\n  query: ${query}\n  response: ${JSON.stringify(
-                errors,
-              )}${identity}${tried}`,
-          ),
-        )
+        Errors({
+          errors,
+          message: `${label} failed\n  query: ${query}\n  response: ${JSON.stringify(
+              errors,
+            )}${identity}${tried}`,
+        })
       }
-    | None => json->field("data")->Option.getOr(JSON.Encode.null)
+    | None => Data(json->field("data")->Option.getOr(JSON.Encode.null))
     }
   }
   await attempt(1)
 }
 
+let gql = async (t: t, ~query: string, ~label: string): JSON.t =>
+  switch await gqlOutcome(t, ~query, ~label) {
+  | Data(data) => data
+  | Errors({message}) => throw(Failed(message))
+  }
+
+/**
+ * Whether the endpoint let this caller through, for a probe that means to find
+ * out rather than to succeed.
+ *
+ * Three outcomes and not two: "not refused" and "worked" are different claims,
+ * and collapsing them would let a misspelled field name read as a passing
+ * authorization check. `Granted` covers a domain rejection too — a
+ * `CommandRejected` arrives inside `data` with no GraphQL error, which is
+ * precisely how a probe confirms access without writing anything.
+ */
+type access =
+  | Granted
+  | Refused
+  | // Served, and carrying nothing. Its own case because the two platforms deny a
+  // read differently: AppSync answers `Unauthorized`, while the local resolver's
+  // interceptor returns an empty connection — so on local an unauthorized read
+  // and an empty view are the same response, and no caller can tell them apart.
+  // Naming it lets a probe say "consistent with a denial" instead of guessing.
+  Empty
+  | Broke(string)
+
+let checkAccess = async (t: t, ~query: string, ~label: string): access =>
+  switch await gqlOutcome(t, ~query, ~label) {
+  | Data(_) => Granted
+  | Errors({errors, message}) => errors->isDenied ? Refused : Broke(message)
+  }
+
 // ── Commands ────────────────────────────────────────────────────────────────
 
 let commandResultSelection = `__typename
@@ -328,6 +420,61 @@ let send = async (t: t, m: mutation, ~tolerate: array<string>=[]): option<string
   }
 }
 
+/**
+ * Whether this caller may issue one command — asked with the very document
+ * `send` would have sent, so what the probe tests is what the seed actually
+ * uses rather than a hand-built lookalike.
+ *
+ * Pair it with a payload the domain would refuse anyway. Then `Granted` arrives
+ * as a `CommandRejected` inside `data`, which appends nothing: the probe learns
+ * that the door opened without walking through it, and a regression that wrongly
+ * opens a door still writes no events.
+ */
+/** Refusal codes a command result carries. The two platforms answer a refused
+    command differently — AppSync rejects at the field and produces a GraphQL
+    `Unauthorized` error, while the local resolver runs the command handler and
+    answers `CommandRejected { errorCode: "Forbidden" }` inside `data`. Reading
+    only the first reports the second as allowed. */
+let deniedCommandCodes = ["Forbidden", "Unauthorized", "AccessDenied"]
+
+let isDeniedResult = (result: JSON.t): bool =>
+  switch (result->nodeString("errorCode"), result->nodeString("errorDetail")) {
+  | (Some(code), _) if deniedCommandCodes->Array.includes(code) => true
+  | (_, Some(detail)) => detail->String.toLowerCase->String.includes("not authorized")
+  | _ => false
+  }
+
+let checkCommandAccess = async (t: t, m: mutation): access =>
+  switch await gqlOutcome(
+    t,
+    ~query=`mutation { r: ${m.field}(${m.args->renderArgs}) { ${commandResultSelection} } }`,
+    ~label=m->describe,
+  ) {
+  | Errors({errors, message}) => errors->isDenied ? Refused : Broke(message)
+  // No GraphQL error is not yet a grant: the local platform's refusal lives in
+  // the command result, so the domain's own answer has to be read too. Any other
+  // rejection IS a grant — the door opened and the domain refused what came
+  // through it, which is exactly the outcome a non-writing probe wants.
+  | Data(data) =>
+    data->field("r")->Option.getOr(JSON.Encode.null)->isDeniedResult ? Refused : Granted
+  }
+
+/** Whether this caller may read one connection field. One row is enough: the
+    door is answered by the first request, not by the page behind it — but
+    whether a row came back is what separates a grant from a silent denial. */
+let checkQueryAccess = async (t: t, ~field as fieldName: string): access => {
+  let query = `{ ${fieldName}(first: 1) { edges { node { id } } } }`
+  switch await gqlOutcome(t, ~query, ~label=fieldName) {
+  | Errors({errors, message}) => errors->isDenied ? Refused : Broke(message)
+  | Data(data) =>
+    let edges = switch data->field(fieldName)->Option.flatMap(c => c->field("edges")) {
+    | Some(Array(rows)) => rows->Array.length
+    | _ => 0
+    }
+    edges > 0 ? Granted : Empty
+  }
+}
+
 let sendAll = async (t: t, mutations: array<mutation>): unit =>
   for i in 0 to mutations->Array.length - 1 {
     switch mutations->Array.get(i) {
@@ -342,12 +489,12 @@ let sendAll = async (t: t, mutations: array<mutation>): unit =>
  * Walks a Relay-style connection to the end. Connections page at 50 by default,
  * so any count taken from a single request silently truncates.
  */
-// `~args` is spliced into the connection's argument list — `"includeRetired: true"`
+let // `~args` is spliced into the connection's argument list — `"includeRetired: true"`
 // is the case it exists for, and the only way to read rows the resolvers withhold
 // by default. Literal GraphQL rather than a typed argument list because a seed
 // writes the query it means; the alternative is a builder that has to grow a case
 // per argument the platform adds.
-let queryAllNodes = async (
+queryAllNodes = async (
   t: t,
   ~field as fieldName: string,
   ~selection: string,
@@ -463,8 +610,9 @@ let waitForIds = async (
         missing->Array.length > 10 ? ` (+${(missing->Array.length - 10)->Int.toString} more)` : ""
       throw(
         Failed(
-          `only ${(found->Array.length)->Int.toString}/${(ids->Array.length)
-              ->Int.toString} ids reached ${fieldName} within ${timeoutMs->Int.toString}ms.\n  missing: ${shown}${extra}`,
+          `only ${found->Array.length->Int.toString}/${ids
+            ->Array.length
+            ->Int.toString} ids reached ${fieldName} within ${timeoutMs->Int.toString}ms.\n  missing: ${shown}${extra}`,
         ),
       )
     } else {