@reventlessdev/reventless-core 3.0.0-alpha.240 → 3.0.0-alpha.242

package/src/components/Api/SuryToJsonSchema.res

@@ -196,9 +196,45 @@ let rec fromSchemaType = (st: SchemaType.schemaType): JSON.t =>
       ("enum", JSON.Encode.array(values->Array.map(JSON.Encode.string))),
     ])
   | Semantic(sem, inner) => fromSchemaType(inner)->withSemantic(sem)
+  // A union is `oneOf` its arms, each an object carrying the `TAG` const it is
+  // discriminated by. The discriminator is what tells a union apart from a
+  // nullable object, which is also a `oneOf` of objects — a reader that misses
+  // it selects one arm's fields as though they were the field's own and produces
+  // a query that looks plausible and is invalid.
+  | TaggedUnion(name, arms) =>
+    let members = arms->Array.map(((tag, armType)) => armToJsonSchema(~tag, armType))
+    jsonObject([("oneOf", JSON.Encode.array(members)), ("x-reventless-union", str(name))])
   | Unknown => jsonObject([("type", str("string"))])
   }
 
+// One arm. `TAG` is declared rather than filtered out — the raw value on the
+// wire and in the live change channel carries it, and it is the only thing in
+// the payload that says which arm this is. The GraphQL member type name rides
+// alongside so a reader mapping a raw payload to a selection does not have to
+// re-derive the naming rule in a second repo.
+and armToJsonSchema = (~tag: string, armType: SchemaType.schemaType): JSON.t =>
+  switch armType {
+  | ObjectRef(memberName, fields) =>
+    let base = objectRefToJsonSchema(fields)
+    switch base->JSON.Decode.object {
+    | Some(obj) =>
+      switch obj->Dict.get("properties")->Option.flatMap(JSON.Decode.object) {
+      | Some(props) =>
+        props->Dict.set("TAG", jsonObject([("type", str("string")), ("const", str(tag))]))
+      | None => ()
+      }
+      let required = switch obj->Dict.get("required")->Option.flatMap(JSON.Decode.array) {
+      | Some(existing) => Array.concat([str("TAG")], existing)
+      | None => [str("TAG")]
+      }
+      obj->Dict.set("required", JSON.Encode.array(required))
+      obj->Dict.set("x-reventless-union-member", str(memberName))
+      JSON.Encode.object(obj)
+    | None => base
+    }
+  | other => fromSchemaType(other)
+  }
+
 // Attach a type-carried semantic to a field's JSON Schema.
 //
 // This is the type path's emission point, and it is deliberately *not*

package/src/components/Api/SuryToJsonSchema.res.mjs

@@ -246,10 +246,54 @@ function fromSchemaType(st) {
         ]);
       case "Semantic" :
         return withSemantic(fromSchemaType(st._1), st._0);
+      case "TaggedUnion" :
+        let members = st._1.map(param => armToJsonSchema(param[0], param[1]));
+        return Object.fromEntries([
+          [
+            "oneOf",
+            members
+          ],
+          [
+            "x-reventless-union",
+            st._0
+          ]
+        ]);
     }
   }
 }
 
+function armToJsonSchema(tag, armType) {
+  if (typeof armType !== "object") {
+    return fromSchemaType(armType);
+  }
+  if (armType.TAG !== "ObjectRef") {
+    return fromSchemaType(armType);
+  }
+  let base = objectRefToJsonSchema(undefined, undefined, undefined, armType._1);
+  let obj = Stdlib_JSON.Decode.object(base);
+  if (obj === undefined) {
+    return base;
+  }
+  let props = Stdlib_Option.flatMap(obj["properties"], Stdlib_JSON.Decode.object);
+  if (props !== undefined) {
+    props["TAG"] = Object.fromEntries([
+      [
+        "type",
+        "string"
+      ],
+      [
+        "const",
+        tag
+      ]
+    ]);
+  }
+  let existing = Stdlib_Option.flatMap(obj["required"], Stdlib_JSON.Decode.array);
+  let required = existing !== undefined ? ["TAG"].concat(existing) : ["TAG"];
+  obj["required"] = required;
+  obj["x-reventless-union-member"] = armType._0;
+  return obj;
+}
+
 function withSemantic(fieldSchema, sem) {
   let obj = Stdlib_JSON.Decode.object(fieldSchema);
   if (obj === undefined) {
@@ -368,6 +412,7 @@ export {
   mergeAnnotations,
   isNullableType,
   fromSchemaType,
+  armToJsonSchema,
   withSemantic,
   objectRefToJsonSchema,
   deriveObjectSchema,

package/src/components/QueryDb/QueryDb_Operations.res

@@ -67,12 +67,24 @@ module Make = (ReadModelSpec: Reventless.ReadModel.Spec, Ops: Ops) => {
     })
   }
 
+  // Every union value in the row carries the GraphQL member type it is, written
+  // once here rather than by each of the fourteen read doors across three
+  // backends — and, unlike a read-time stamp, it is also on the row the live
+  // change channel hands over as raw JSON. A view with no union field is walked
+  // and left exactly as it was.
+  let stampUnionMembers = dict =>
+    Reventless.TaggedUnion.stampInto(
+      ~schema=ReadModelSpec.stateSchema->S.castToUnknown,
+      JSON.Encode.object(dict),
+    )
+
   let save = async (id, state, saveMode, ttl) =>
     switch state->Message.encode(ReadModelSpec.stateSchema)->JSON.Decode.object {
     | Some(dict) =>
       dict->Dict.set("id", id->Message.encode(ReadModelSpec.Id.schema))
       injectSubId(dict, state)
       injectCompositeIndexAttrs(dict)
+      stampUnionMembers(dict)
       let json = JSON.Encode.object(dict)
       await Ops.jsonOps.save(id->ReadModelSpec.Id.toString, json, saveMode, ttl)
     | None =>
@@ -87,6 +99,7 @@ module Make = (ReadModelSpec: Reventless.ReadModel.Spec, Ops: Ops) => {
           dict->Dict.set("id", id->Message.encode(ReadModelSpec.Id.schema))
           injectSubId(dict, state)
           injectCompositeIndexAttrs(dict)
+          stampUnionMembers(dict)
           let json = JSON.Encode.object(dict)
           Ok(batch->Array.concat([(id->ReadModelSpec.Id.toString, json, ttl)]))
         | None =>

package/src/components/QueryDb/QueryDb_Operations.res.mjs

@@ -8,6 +8,7 @@ import * as Effect from "effect/Effect";
 import * as Stream from "effect/Stream";
 import * as Primitive_exceptions from "@rescript/runtime/lib/es6/Primitive_exceptions.js";
 import * as Message$ReventlessCore from "../../Message.res.mjs";
+import * as TaggedUnion$Reventless from "@reventlessdev/reventless-spec/src/components/TaggedUnion.res.mjs";
 
 function Make(ReadModelSpec) {
   return Ops => {
@@ -76,12 +77,14 @@ function Make(ReadModelSpec) {
         dict[attrName$1] = value$1;
       });
     };
+    let stampUnionMembers = dict => TaggedUnion$Reventless.stampInto(ReadModelSpec.stateSchema, dict);
     let save = async (id, state, saveMode, ttl) => {
       let dict = Stdlib_JSON.Decode.object(Message$ReventlessCore.encode(state, ReadModelSpec.stateSchema));
       if (dict !== undefined) {
         dict["id"] = Message$ReventlessCore.encode(id, ReadModelSpec.Id.schema);
         injectSubId(dict, state);
         injectCompositeIndexAttrs(dict);
+        TaggedUnion$Reventless.stampInto(ReadModelSpec.stateSchema, dict);
         return await Ops.jsonOps.save(ReadModelSpec.Id.toString(id), dict, saveMode, ttl);
       } else {
         return {
@@ -107,6 +110,7 @@ function Make(ReadModelSpec) {
             dict["id"] = Message$ReventlessCore.encode(id, ReadModelSpec.Id.schema);
             injectSubId(dict, state);
             injectCompositeIndexAttrs(dict);
+            TaggedUnion$Reventless.stampInto(ReadModelSpec.stateSchema, dict);
             return {
               TAG: "Ok",
               _0: batch.concat([[
@@ -150,6 +154,7 @@ function Make(ReadModelSpec) {
       load: load,
       injectSubId: injectSubId,
       injectCompositeIndexAttrs: injectCompositeIndexAttrs,
+      stampUnionMembers: stampUnionMembers,
       save: save,
       saveBatch: saveBatch,
       count: count,

package/src/plugin/component/Plugin_Structure.res

@@ -23,6 +23,11 @@ let rec isLabelShape = (t: SchemaType.schemaType): bool =>
   switch t {
   | ScalarString => true
   | Nullable(inner) => isLabelShape(inner)
+  // Written out rather than left to the catch-all: a union is a composite whose
+  // rendering depends on which arm a row is in, so no single string names the
+  // record. The label picker's fallback rung is a *guess*, and this is the shape
+  // it would guess most confidently and most wrongly.
+  | TaggedUnion(_, _) => false
   | _ => false
   }
 
@@ -33,6 +38,10 @@ let rec isLifecycleShape = (t: SchemaType.schemaType): bool =>
   switch t {
   | Enum(_, _) => true
   | Nullable(inner) => isLifecycleShape(inner)
+  // A union is a closed set of *shapes*, not of values, and `allowedStates`
+  // compares values. The same answer the ppx gives `@lifecycle` on a union
+  // field, which is a compile error — this is the convention rung agreeing.
+  | TaggedUnion(_, _) => false
   | _ => false
   }
 

package/src/plugin/component/Plugin_Structure.res.mjs

@@ -32,11 +32,13 @@ function isLabelShape(_t) {
     if (typeof t !== "object") {
       return t === "ScalarString";
     }
-    if (t.TAG !== "Nullable") {
-      return false;
+    switch (t.TAG) {
+      case "Nullable" :
+        _t = t._0;
+        continue;
+      default:
+        return false;
     }
-    _t = t._0;
-    continue;
   };
 }
 

package/src/plugin/component/SchemaWalker.res

@@ -28,9 +28,22 @@ let rec describeSchema = (schema: S.t<unknown>): string =>
       | _ => true
       }
     )
-    switch nonNull->Array.get(0) {
-    | Some(inner) => "option<" ++ describeSchema(inner) ++ ">"
-    | None => "unknown"
+    let isOptional = nonNull->Array.length < anyOf->Array.length
+    switch nonNull {
+    | [inner] => "option<" ++ describeSchema(inner) ++ ">"
+    | [] => "unknown"
+    | members =>
+      // A field holding a variant. Described by every arm, sorted, rather than by
+      // the first one: the structural hash is computed from this string, and a
+      // description that mentions one arm is blind to a change in any other —
+      // which is drift detection reporting "no change" for a changed schema.
+      let inner =
+        members
+        ->Array.map(describeSchema)
+        ->Array.toSorted(String.compare)
+        ->Array.join("|")
+      let union = "union<" ++ inner ++ ">"
+      isOptional ? "option<" ++ union ++ ">" : union
     }
   | Array({additionalItems}) =>
     let itemDesc = switch additionalItems {

package/src/plugin/component/SchemaWalker.res.mjs

@@ -26,7 +26,8 @@ function describeSchema(schema) {
       let inner = Object.entries(schema.properties).filter(param => param[0] !== "TAG").toSorted((param, param$1) => Primitive_string.compare(param[0], param$1[0])).map(param => param[0] + ":" + describeSchema(param[1])).join(",");
       return "{" + inner + "}";
     case "anyOf" :
-      let nonNull = schema.anyOf.filter(v => {
+      let anyOf = schema.anyOf;
+      let nonNull = anyOf.filter(v => {
         switch (v.type) {
           case "null" :
           case "undefined" :
@@ -35,12 +36,22 @@ function describeSchema(schema) {
             return true;
         }
       });
-      let inner$1 = nonNull[0];
-      if (inner$1 !== undefined) {
-        return "option<" + describeSchema(inner$1) + ">";
-      } else {
-        return "unknown";
+      let isOptional = nonNull.length < anyOf.length;
+      let len = nonNull.length;
+      if (len !== 1) {
+        if (len === 0) {
+          return "unknown";
+        }
+        let inner$1 = nonNull.map(describeSchema).toSorted(Primitive_string.compare).join("|");
+        let union = "union<" + inner$1 + ">";
+        if (isOptional) {
+          return "option<" + union + ">";
+        } else {
+          return union;
+        }
       }
+      let inner$2 = nonNull[0];
+      return "option<" + describeSchema(inner$2) + ">";
     default:
       return "unknown";
   }

package/src/plugin/lifecycle/PluginsReadModelSpec.res

@@ -10,7 +10,7 @@
 // this (spec-level `permission` outranks the legacy `{tableName, group}` pair),
 // and so does the `requiredAccess` the platform publishes — so a shell can gate
 // the Plugins view up front instead of offering it and meeting a refusal.
-@@reventless.authorize(Reventless.Authorization.AllowGroups(["Admin"]))
+@@reventless.authorize(AllowGroups(["Admin"]))
 
 // Current view — one row per plugin **name**, holding the currently-active
 // version's definition. Keyed by the aggregate id (= plugin name). The status

package/tests/admin/Platform_Admin_StructureTest.res

@@ -269,7 +269,7 @@ describe("the Plugins queryableDef is what the generic helpers produce", () => {
     // nested object types whose own fields would match a naive `includes`.
     let props =
       rm.schema
-      ->JSON.parseExn
+      ->JSON.parseOrThrow
       ->JSON.Decode.object
       ->Option.flatMap(o => o->Dict.get("properties"))
       ->Option.flatMap(JSON.Decode.object)
@@ -289,7 +289,7 @@ describe("the Plugins queryableDef is what the generic helpers produce", () => {
   testSync("while the internal fields are not published at all", () => {
     let props =
       rm.schema
-      ->JSON.parseExn
+      ->JSON.parseOrThrow
       ->JSON.Decode.object
       ->Option.flatMap(o => o->Dict.get("properties"))
       ->Option.flatMap(JSON.Decode.object)

package/tests/api/TaggedUnionSchemaTest.res

@@ -0,0 +1,198 @@
+open JestGlobals
+open TaggedUnionFixtures
+
+let fragmentFor = (~returnTypeName, ~specName, stateSchema) =>
+  GraphQL_FragmentGenerator.generate(
+    ~mutationEntries=[],
+    ~queryEntries=[queryEntryFor(~returnTypeName, ~specName, stateSchema)],
+  )
+
+let typesOf = fragment => GraphQL_Stitcher.decode(fragment).types
+let typeDefFor = (fragment, needle) =>
+  typesOf(fragment)->Array.find(t => t->String.includes(needle))->Option.getOr("")
+
+// ── The IR ────────────────────────────────────────────────────────────────
+
+describe("SchemaType classifies a named union", () => {
+  let shapeOfField = (schema, field) =>
+    switch SchemaType.fromSuryObject(~typeName="X", schema->S.castToUnknown) {
+    | Some(fields) => fields->Dict.get(field)
+    | None => None
+    }
+
+  testSync("arms are keyed by TAG and carry the member type's own name", () => {
+    switch shapeOfField(CustomersSpec.stateSchema, "geolocation") {
+    | Some(TaggedUnion(name, arms)) =>
+      expect(name)->toBe("Geolocation")
+      expect(arms->Array.map(((tag, _)) => tag))->toEqual(["Pending", "Located", "Unresolvable"])
+      switch arms->Array.find(((tag, _)) => tag === "Located") {
+      | Some((_, ObjectRef(memberName, fields))) =>
+        expect(memberName)->toBe("GeolocationLocated")
+        expect(fields->Dict.keysToArray)->toEqual(["point"])
+      | _ => expect("Located arm")->toBe("an ObjectRef")
+      }
+    | other =>
+      expect(other->Option.isSome ? "some other shape" : "nothing")->toBe("a TaggedUnion")
+    }
+  })
+
+  testSync("an optional union keeps its arms behind Nullable", () => {
+    switch shapeOfField(SightingsSpec.stateSchema, "lastSeen") {
+    | Some(Nullable(TaggedUnion(name, arms))) =>
+      expect((name, arms->Array.length))->toEqual(("Geolocation", 3))
+    | _ => expect("lastSeen")->toBe("Nullable(TaggedUnion(...))")
+    }
+  })
+
+  testSync("an array of unions keeps its arms behind ArrayOf", () => {
+    switch shapeOfField(SightingsSpec.stateSchema, "history") {
+    | Some(ArrayOf(TaggedUnion(name, _))) => expect(name)->toBe("Geolocation")
+    | _ => expect("history")->toBe("ArrayOf(TaggedUnion(...))")
+    }
+  })
+
+  // The silent degradation this plan set out to end: an unclassifiable union
+  // rendered as `String!` with nothing said anywhere.
+  testSync("an unnamed union is reported by field and by reason", () => {
+    switch SchemaType.unclassifiedUnions(UnnamedSpec.stateSchema->S.castToUnknown) {
+    | [{path, reason}] =>
+      expect(path)->toBe("verdict")
+      expect(reason->String.includes("no name"))->toBe(true)
+    | found =>
+      expect(found->Array.length)->toBe(1)
+    }
+  })
+
+  testSync("a classified union and an enum are not reported", () => {
+    expect(
+      SchemaType.unclassifiedUnions(CustomersSpec.stateSchema->S.castToUnknown)->Array.length,
+    )->toBe(0)
+  })
+})
+
+// ── The SDL ───────────────────────────────────────────────────────────────
+
+describe("GraphQL_FragmentGenerator emits a union", () => {
+  let fragment = fragmentFor(
+    ~returnTypeName="Ordering_TuCustomer",
+    ~specName="TaggedUnionCustomers",
+    CustomersSpec.stateSchema,
+  )
+
+  testSync("the field is typed as the union", () => {
+    expect(
+      typeDefFor(fragment, "type Ordering_TuCustomer ")->String.includes(
+        "geolocation: Geolocation!",
+      ),
+    )->toBe(true)
+  })
+
+  testSync("the union names one member type per arm", () => {
+    expect(typeDefFor(fragment, "union Geolocation"))->toBe(
+      "union Geolocation = GeolocationPending | GeolocationLocated | GeolocationUnresolvable",
+    )
+  })
+
+  testSync("each member type declares the arm's own fields, and no TAG", () => {
+    let located = typeDefFor(fragment, "type GeolocationLocated ")
+    expect(located->String.includes("point: GeoPoint!"))->toBe(true)
+    expect(located->String.includes("TAG"))->toBe(false)
+    expect(
+      typeDefFor(fragment, "type GeolocationUnresolvable ")->String.includes("reason: String!"),
+    )->toBe(true)
+  })
+
+  // The merged-API property. AppSync unions same-named types from each source
+  // API, and a union of identical definitions is that definition — so a second
+  // plugin's copy has to be byte-identical, not merely equivalent. This is the
+  // assertion that fails quietly: a name composed from the field path would pass
+  // every other test in this file.
+  testSync("a second plugin's copy of the union is byte-identical", () => {
+    let other = fragmentFor(
+      ~returnTypeName="Catalog_TuSighting",
+      ~specName="TaggedUnionSightings",
+      SightingsSpec.stateSchema,
+    )
+    let unionOf = f => typeDefFor(f, "union Geolocation")
+    expect(unionOf(other))->toBe(unionOf(fragment))
+    expect(typeDefFor(other, "type GeolocationLocated "))->toBe(
+      typeDefFor(fragment, "type GeolocationLocated "),
+    )
+  })
+
+  testSync("an optional union is nullable and an array of them is a list", () => {
+    let sightings = fragmentFor(
+      ~returnTypeName="Catalog_TuSighting",
+      ~specName="TaggedUnionSightings",
+      SightingsSpec.stateSchema,
+    )
+    let row = typeDefFor(sightings, "type Catalog_TuSighting ")
+    expect(row->String.includes("lastSeen: Geolocation\n"))->toBe(true)
+    expect(row->String.includes("history: [Geolocation!]!"))->toBe(true)
+  })
+
+  // Unchanged behaviour, pinned: without a name there is no type to emit, and
+  // inventing one would publish a contract nothing can stamp a `__typename` for.
+  testSync("an unnamed union stays a String", () => {
+    let unnamed = fragmentFor(
+      ~returnTypeName="Ordering_TuCase",
+      ~specName="TaggedUnionUnnamed",
+      UnnamedSpec.stateSchema,
+    )
+    expect(
+      typeDefFor(unnamed, "type Ordering_TuCase ")->String.includes("verdict: String!"),
+    )->toBe(true)
+    expect(typesOf(unnamed)->Array.some(t => t->String.startsWith("union ")))->toBe(false)
+  })
+})
+
+// ── The JSON Schema ───────────────────────────────────────────────────────
+
+let objAt = (json, key) =>
+  json->JSON.Decode.object->Option.flatMap(o => o->Dict.get(key))
+
+describe("SuryToJsonSchema emits the arms as oneOf", () => {
+  let json = SuryToJsonSchema.deriveObjectSchema(CustomersSpec.stateSchema->S.castToUnknown)
+  let field =
+    objAt(json, "properties")
+    ->Option.flatMap(p => p->JSON.Decode.object)
+    ->Option.flatMap(p => p->Dict.get("geolocation"))
+    ->Option.getOr(JSON.Encode.null)
+
+  testSync("the field names the union it is", () => {
+    expect(objAt(field, "x-reventless-union")->Option.flatMap(JSON.Decode.string))->toEqual(
+      Some("Geolocation"),
+    )
+  })
+
+  testSync("one member per arm, each discriminated by its TAG const", () => {
+    let members =
+      objAt(field, "oneOf")->Option.flatMap(JSON.Decode.array)->Option.getOr([])
+    expect(members->Array.length)->toBe(3)
+    let tags = members->Array.filterMap(m =>
+      objAt(m, "properties")
+      ->Option.flatMap(JSON.Decode.object)
+      ->Option.flatMap(p => p->Dict.get("TAG"))
+      ->Option.flatMap(t => objAt(t, "const"))
+      ->Option.flatMap(JSON.Decode.string)
+    )
+    expect(tags)->toEqual(["Pending", "Located", "Unresolvable"])
+  })
+
+  // Without this a reader has to re-derive `<UnionName><Arm>` in a second repo to
+  // map a raw live-channel payload onto an inline fragment.
+  testSync("each member publishes the GraphQL type it is emitted as", () => {
+    let names =
+      objAt(field, "oneOf")
+      ->Option.flatMap(JSON.Decode.array)
+      ->Option.getOr([])
+      ->Array.filterMap(m =>
+        objAt(m, "x-reventless-union-member")->Option.flatMap(JSON.Decode.string)
+      )
+    expect(names)->toEqual([
+      "GeolocationPending",
+      "GeolocationLocated",
+      "GeolocationUnresolvable",
+    ])
+  })
+})