@reventlessdev/reventless-spec 3.0.0-alpha.84 → 3.0.0-alpha.86

package/src/semantic/Color.res.mjs

@@ -0,0 +1,29 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as S from "sury/src/S.res.mjs";
+import * as Semantic$Reventless from "./Semantic.res.mjs";
+
+let hex = /^#([0-9a-fA-F]{3,4}|[0-9a-fA-F]{6}|[0-9a-fA-F]{8})$/;
+
+function fromString(raw) {
+  if (hex.test(raw)) {
+    return {
+      TAG: "Ok",
+      _0: raw
+    };
+  } else {
+    return {
+      TAG: "Error",
+      _0: `expected a hex colour such as "#1e90ff" or "#1e90ffcc", got ` + Semantic$Reventless.showString(raw) + `. Named colours and rgb()/oklch() forms are not accepted.`
+    };
+  }
+}
+
+let schema = Semantic$Reventless.refined(S.string, Semantic$Reventless.Id.color, fromString);
+
+export {
+  hex,
+  fromString,
+  schema,
+}
+/* schema Not a pure module */

package/src/semantic/Duration.res

@@ -0,0 +1,53 @@
+/**
+Marks an `int` field as a length of time, in **seconds**.
+
+## Why a scalar, and why seconds are part of the type
+
+The obvious richer design is `{value, unit}`. It is not available here, and the
+reason is the reason this whole set of types is safe to add: a record is an
+*object* on the wire, so adopting it would turn every field that used it into a
+decode failure against events already written. These types are additive
+precisely because they stay scalars. A duration that carries its unit is a
+different type for a different plan, not a later version of this one — widening
+this one would retroactively hand an upcaster obligation to every field that had
+already adopted it.
+
+Seconds, because that is what the renderer reads: it formats `3660` as
+`"1h 1m"`. Milliseconds would be off by a factor of a thousand and would
+render as weeks, which is the same class of silent wrongness `Percent` avoids by
+matching its gauge.
+
+`int` is right here where it was wrong for `Bytes`: int32 seconds is 68 years,
+which no duration field needs to exceed.
+
+## The grammar
+
+A whole number of seconds, zero or greater. Zero is a real duration — an instant
+timeout, a zero-length window.
+
+@example
+```rescript
+@schema type state = {
+  jobId: string,
+  runtimeSeconds: @s.matches(Reventless.Duration.schema) int,
+}
+```
+*/
+
+/** The duration's representation, in seconds. Transparent `int`. */
+type t = int
+
+external unsafe: int => t = "%identity"
+external toInt: t => int = "%identity"
+
+/** Validate a number of seconds as a duration, saying why when it is not one. */
+let fromInt = (raw: int): result<t, string> =>
+  if raw < 0 {
+    Error(`a duration cannot be negative, got ${Int.toString(raw)} seconds`)
+  } else {
+    Ok(raw)
+  }
+
+/** The sury schema for a duration field, in seconds.
+    Use with `@s.matches(Reventless.Duration.schema)`. */
+let schema: S.t<t> = S.int->Semantic.refined(~id=Semantic.Id.duration, ~check=fromInt)

package/src/semantic/Duration.res.mjs

@@ -0,0 +1,26 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as S from "sury/src/S.res.mjs";
+import * as Semantic$Reventless from "./Semantic.res.mjs";
+
+function fromInt(raw) {
+  if (raw < 0) {
+    return {
+      TAG: "Error",
+      _0: `a duration cannot be negative, got ` + raw.toString() + ` seconds`
+    };
+  } else {
+    return {
+      TAG: "Ok",
+      _0: raw
+    };
+  }
+}
+
+let schema = Semantic$Reventless.refined(S.int, Semantic$Reventless.Id.duration, fromInt);
+
+export {
+  fromInt,
+  schema,
+}
+/* schema Not a pure module */

package/src/semantic/Email.res

@@ -0,0 +1,51 @@
+/**
+Marks a `string` field as an email address.
+
+## Why a type rather than a name
+
+An `email` field already renders as a mailto link today, because the UI guesses
+from the field's *name*. The guess is the whole problem: `contact`, `owner` and
+`notifyTo` hold addresses and are not guessed, `emailTemplate` is guessed and is
+not an address, and nothing anywhere checks that what was written is one. A type
+says it, and the check comes with it.
+
+## The grammar
+
+Sury's `S.email`, and nothing added. This is a case where the framework has no
+opinion worth having: address syntax is somebody else's specification, and a
+second regex here would only be a way to disagree with it.
+
+Note that a syntactically valid address is not a deliverable one — nothing here
+sends a probe. This rejects what is not an address, which is the part a boundary
+check can honestly do.
+
+@example
+```rescript
+@schema type command =
+  | InviteMember({
+      teamId: @s.matches(DcbTag.string) string,
+      email: @s.matches(Reventless.Email.schema) string,
+    })
+```
+*/
+
+/** The address's representation. Transparent `string`: the marker refines an
+    existing field rather than replacing it, so nothing stored changes. */
+type t = string
+
+external unsafe: string => t = "%identity"
+external toString: t => string = "%identity"
+
+// Sury's check, held once. `fromString` runs it rather than restating it, and
+// `schema` is built from `fromString`, so there is exactly one grammar here.
+let grammar: S.t<string> = S.string->S.email
+
+/** Validate a raw string as an email address, saying why when it is not one. */
+let fromString = (raw: string): result<t, string> =>
+  switch raw->S.parseOrThrow(grammar) {
+  | value => Ok(value)
+  | exception _ => Error(`expected an email address, got ${Semantic.showString(raw)}`)
+  }
+
+/** The sury schema for an email field. Use with `@s.matches(Reventless.Email.schema)`. */
+let schema: S.t<t> = S.string->Semantic.refined(~id=Semantic.Id.email, ~check=fromString)

package/src/semantic/Email.res.mjs

@@ -0,0 +1,31 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as S from "sury/src/S.res.mjs";
+import * as Semantic$Reventless from "./Semantic.res.mjs";
+
+let grammar = S.email(S.string, undefined);
+
+function fromString(raw) {
+  let value;
+  try {
+    value = S.parseOrThrow(raw, grammar);
+  } catch (exn) {
+    return {
+      TAG: "Error",
+      _0: `expected an email address, got ` + Semantic$Reventless.showString(raw)
+    };
+  }
+  return {
+    TAG: "Ok",
+    _0: value
+  };
+}
+
+let schema = Semantic$Reventless.refined(S.string, Semantic$Reventless.Id.email, fromString);
+
+export {
+  grammar,
+  fromString,
+  schema,
+}
+/* grammar Not a pure module */

package/src/semantic/Percent.res

@@ -0,0 +1,53 @@
+/**
+Marks a `float` field as a percentage, expressed **0–100**.
+
+## Why 0–100 and not 0–1
+
+Both conventions are defensible in the abstract, so the tie is broken by the
+consumer that already exists: the dashboard gauges a field with this semantic
+against fixed bounds of 0 and 100, and formats `42.0` as `"42%"`. Under a 0–1
+convention every value would render as a rounding error near zero — a gauge
+pinned at empty and a label reading `"0.42%"`.
+
+That failure is quiet, and it is quiet in the worst way: the numbers are
+*present* and *wrong*, and the layer at fault is not the one showing the symptom.
+Agreeing with the renderer costs nothing; disagreeing costs an afternoon.
+
+A fraction is still perfectly good arithmetic — it just multiplies by 100 before
+it becomes this type.
+
+## The grammar
+
+A finite number in `[0, 100]`. Fractions are allowed: `99.95` is a percentage.
+
+@example
+```rescript
+@schema type state = {
+  productId: string,
+  taxRate: @s.matches(Reventless.Percent.schema) float,
+}
+```
+*/
+
+/** The percentage's representation. Transparent `float`: the marker refines an
+    existing numeric field rather than replacing it, so nothing stored changes. */
+type t = float
+
+external unsafe: float => t = "%identity"
+external toFloat: t => float = "%identity"
+
+/** Validate a number as a percentage, saying why when it is not one. */
+let fromFloat = (raw: float): result<t, string> =>
+  if !Float.isFinite(raw) {
+    Error(`a percentage must be a finite number, got ${Float.toString(raw)}`)
+  } else if raw < 0.0 || raw > 100.0 {
+    Error(
+      `a percentage runs from 0 to 100, got ${Float.toString(raw)}. ` ++
+      `This scale is 0–100, not 0–1 — a fraction multiplies by 100 first.`,
+    )
+  } else {
+    Ok(raw)
+  }
+
+/** The sury schema for a percentage field. Use with `@s.matches(Reventless.Percent.schema)`. */
+let schema: S.t<t> = S.float->Semantic.refined(~id=Semantic.Id.percent, ~check=fromFloat)

package/src/semantic/Percent.res.mjs

@@ -0,0 +1,33 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as S from "sury/src/S.res.mjs";
+import * as Semantic$Reventless from "./Semantic.res.mjs";
+
+function fromFloat(raw) {
+  if (isFinite(raw)) {
+    if (raw < 0.0 || raw > 100.0) {
+      return {
+        TAG: "Error",
+        _0: `a percentage runs from 0 to 100, got ` + raw.toString() + `. This scale is 0–100, not 0–1 — a fraction multiplies by 100 first.`
+      };
+    } else {
+      return {
+        TAG: "Ok",
+        _0: raw
+      };
+    }
+  } else {
+    return {
+      TAG: "Error",
+      _0: `a percentage must be a finite number, got ` + raw.toString()
+    };
+  }
+}
+
+let schema = Semantic$Reventless.refined(S.float, Semantic$Reventless.Id.percent, fromFloat);
+
+export {
+  fromFloat,
+  schema,
+}
+/* schema Not a pure module */

package/src/semantic/Phone.res

@@ -0,0 +1,55 @@
+/**
+Marks a `string` field as a phone number in E.164 form.
+
+## Why E.164, and only E.164
+
+A phone number written the way a person says it out loud — `(030) 12 34 56`,
+`+49 30 123456`, `0049-30-123456` — is three different strings for one number,
+so a log full of them cannot be searched, deduplicated or dialled reliably. E.164
+is the one form that is unambiguous internationally, and it is the form the
+`tel:` link this field renders as actually wants.
+
+That makes this the one branded scalar that is likely to *reject* input a form
+would otherwise have accepted, and it should: the alternative is storing an
+un-dialable string permanently. Normalising a local number into E.164 needs a
+default country the framework does not know, so that belongs to the caller,
+before the command.
+
+## The grammar
+
+`+`, then a country digit 1–9, then up to 14 more digits — at most 15 in total,
+which is the E.164 limit. No spaces, no punctuation, no leading zero after the
+`+`.
+
+@example
+```rescript
+@schema type command =
+  | SetContactPhone({
+      customerId: @s.matches(DcbTag.string) string,
+      phone: @s.matches(Reventless.Phone.schema) string,
+    })
+```
+*/
+
+/** The number's representation. Transparent `string`; see `Email.t`. */
+type t = string
+
+external unsafe: string => t = "%identity"
+external toString: t => string = "%identity"
+
+let e164 = /^\+[1-9]\d{0,14}$/
+
+/** Validate a raw string as an E.164 number, saying why when it is not one. */
+let fromString = (raw: string): result<t, string> =>
+  if e164->RegExp.test(raw) {
+    Ok(raw)
+  } else {
+    Error(
+      `expected a phone number in E.164 form — "+" then up to 15 digits, as in "+4930123456" — got ${Semantic.showString(
+          raw,
+        )}. Spaces, dashes and brackets are not part of the stored form.`,
+    )
+  }
+
+/** The sury schema for a phone field. Use with `@s.matches(Reventless.Phone.schema)`. */
+let schema: S.t<t> = S.string->Semantic.refined(~id=Semantic.Id.phone, ~check=fromString)

package/src/semantic/Phone.res.mjs

@@ -0,0 +1,29 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as S from "sury/src/S.res.mjs";
+import * as Semantic$Reventless from "./Semantic.res.mjs";
+
+let e164 = /^\+[1-9]\d{0,14}$/;
+
+function fromString(raw) {
+  if (e164.test(raw)) {
+    return {
+      TAG: "Ok",
+      _0: raw
+    };
+  } else {
+    return {
+      TAG: "Error",
+      _0: `expected a phone number in E.164 form — "+" then up to 15 digits, as in "+4930123456" — got ` + Semantic$Reventless.showString(raw) + `. Spaces, dashes and brackets are not part of the stored form.`
+    };
+  }
+}
+
+let schema = Semantic$Reventless.refined(S.string, Semantic$Reventless.Id.phone, fromString);
+
+export {
+  e164,
+  fromString,
+  schema,
+}
+/* schema Not a pure module */

package/src/semantic/Semantic.res

@@ -48,6 +48,16 @@ module Id = {
   let dateTime = "dateTime"
   let reference = "reference"
   let storageRef = "storageRef"
+
+  // The branded scalars. Each refines a `string` or a number without changing
+  // its shape, so a field gains one of these without anything stored changing.
+  let email = "email"
+  let phone = "phone"
+  let url = "url"
+  let percent = "percent"
+  let bytes = "bytes"
+  let duration = "duration"
+  let color = "color"
 }
 
 let semanticId: S.Metadata.Id.t<t> = S.Metadata.Id.make(~namespace="reventless", ~name="semantic")
@@ -56,6 +66,30 @@ let semanticId: S.Metadata.Id.t<t> = S.Metadata.Id.make(~namespace="reventless",
 let mark = (schema: S.t<'a>, ~id: string, ~payload: payload=Plain): S.t<'a> =>
   schema->S.Metadata.set(~id=semanticId, {id, payload})
 
+/**
+A schema that validates with `check` and carries the semantic `id`.
+
+The branded scalars all have the same shape — one constructor function that
+defines the grammar, and a schema that must agree with it — and `StorageRef`
+established that the schema is *derived* from the constructor rather than
+hand-rolling a second check beside it. Deriving it here makes that structural:
+there is one place a grammar can be written, so there is nowhere for a second
+one to drift.
+*/
+let refined = (base: S.t<'a>, ~id: string, ~check: 'a => result<'a, string>): S.t<'a> =>
+  base
+  ->S.refine(s => value =>
+    switch check(value) {
+    | Ok(_) => ()
+    | Error(why) => s.fail(why)
+    }
+  )
+  ->mark(~id)
+
+/** A value as it should read back to the person who typed it. Rejection messages
+    reach forms through `validateInput`, so they quote the offending value. */
+let showString = (raw: string): string => raw->JSON.Encode.string->JSON.stringify
+
 /** The semantic a field's schema carries, if any. */
 let get = (fieldSchema: S.t<'a>): option<t> => S.Metadata.get(fieldSchema, ~id=semanticId)
 

package/src/semantic/Semantic.res.mjs

@@ -5,7 +5,14 @@ import * as S from "sury/src/S.res.mjs";
 let Id = {
   dateTime: "dateTime",
   reference: "reference",
-  storageRef: "storageRef"
+  storageRef: "storageRef",
+  email: "email",
+  phone: "phone",
+  url: "url",
+  percent: "percent",
+  bytes: "bytes",
+  duration: "duration",
+  color: "color"
 };
 
 let semanticId = S.Metadata.Id.make("reventless", "semantic");
@@ -18,6 +25,21 @@ function mark(schema, id, payloadOpt) {
   });
 }
 
+function refined(base, id, check) {
+  return mark(S.refine(base, s => (value => {
+    let why = check(value);
+    if (why.TAG === "Ok") {
+      return;
+    } else {
+      return s.fail(why._0, undefined);
+    }
+  })), id, undefined);
+}
+
+function showString(raw) {
+  return JSON.stringify(raw);
+}
+
 function get(fieldSchema) {
   return S.Metadata.get(fieldSchema, semanticId);
 }
@@ -35,6 +57,8 @@ export {
   Id,
   semanticId,
   mark,
+  refined,
+  showString,
   get,
   has,
 }

package/src/semantic/Url.res

@@ -0,0 +1,66 @@
+/**
+Marks a `string` field as a web address.
+
+## The grammar: parseable, **and** `http`/`https`
+
+Sury's `S.url` is the parse — it is `new URL()`, so it settles host, port and
+escaping without this module having an opinion. But `new URL()` accepts every
+scheme, `javascript:alert(1)` included, and that is not an academic gap here: a
+field carrying this semantic renders as an anchor whose `href` is the stored
+value. An append-only log plus a scheme nobody checked is a stored XSS that
+cannot be deleted afterwards — the same shape of hole `StorageRef` exists to
+close, arriving through a different field.
+
+So the grammar is sury's parse plus a two-scheme allowlist. `mailto:` and `tel:`
+are deliberately outside it: those are `Email` and `Phone`, which validate what
+they actually hold and render correctly on their own.
+
+@example
+```rescript
+@schema type command =
+  | SetSupplierSite({
+      supplierId: @s.matches(DcbTag.string) string,
+      website: @s.matches(Reventless.Url.schema) string,
+    })
+```
+*/
+
+/** The address's representation. Transparent `string`; see `Email.t`. */
+type t = string
+
+external unsafe: string => t = "%identity"
+external toString: t => string = "%identity"
+
+// Sury's parse, held once — `fromString` runs it and adds the scheme check, and
+// `schema` derives from `fromString`. One grammar, in one place.
+let grammar: S.t<string> = S.string->S.url
+
+// Schemes are case-insensitive per RFC 3986, and `HTTPS://x` parses fine, so the
+// allowlist has to fold case or it rejects a valid address on a technicality.
+let hasWebScheme = (raw: string): bool => {
+  let lower = String.toLowerCase(raw)
+  String.startsWith(lower, "http://") || String.startsWith(lower, "https://")
+}
+
+/** Validate a raw string as an `http`/`https` URL, saying why when it is not one. */
+let fromString = (raw: string): result<t, string> =>
+  switch raw->S.parseOrThrow(grammar) {
+  | value =>
+    if hasWebScheme(value) {
+      Ok(value)
+    } else {
+      Error(
+        `a URL field takes an http:// or https:// address, got ${Semantic.showString(raw)}. ` ++
+        `Use Email or Phone for mailto:/tel:, and a storage ref for an uploaded object.`,
+      )
+    }
+  | exception _ =>
+    Error(
+      `expected an absolute URL, got ${Semantic.showString(
+          raw,
+        )}. A relative path is not a URL — include the scheme and host.`,
+    )
+  }
+
+/** The sury schema for a URL field. Use with `@s.matches(Reventless.Url.schema)`. */
+let schema: S.t<t> = S.string->Semantic.refined(~id=Semantic.Id.url, ~check=fromString)

package/src/semantic/Url.res.mjs

@@ -0,0 +1,48 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as S from "sury/src/S.res.mjs";
+import * as Semantic$Reventless from "./Semantic.res.mjs";
+
+let grammar = S.url(S.string, undefined);
+
+function hasWebScheme(raw) {
+  let lower = raw.toLowerCase();
+  if (lower.startsWith("http://")) {
+    return true;
+  } else {
+    return lower.startsWith("https://");
+  }
+}
+
+function fromString(raw) {
+  let value;
+  try {
+    value = S.parseOrThrow(raw, grammar);
+  } catch (exn) {
+    return {
+      TAG: "Error",
+      _0: `expected an absolute URL, got ` + Semantic$Reventless.showString(raw) + `. A relative path is not a URL — include the scheme and host.`
+    };
+  }
+  if (hasWebScheme(value)) {
+    return {
+      TAG: "Ok",
+      _0: value
+    };
+  } else {
+    return {
+      TAG: "Error",
+      _0: `a URL field takes an http:// or https:// address, got ` + Semantic$Reventless.showString(raw) + `. Use Email or Phone for mailto:/tel:, and a storage ref for an uploaded object.`
+    };
+  }
+}
+
+let schema = Semantic$Reventless.refined(S.string, Semantic$Reventless.Id.url, fromString);
+
+export {
+  grammar,
+  hasWebScheme,
+  fromString,
+  schema,
+}
+/* grammar Not a pure module */