@reventlessdev/reventless-infra 3.0.0-alpha.100

package/src/types/ExtensionPointMapping.res

@@ -0,0 +1,303 @@
+type extensionPointName = string
+
+/**
+An async handler for a typed extension-point directive. May call the scheduler
+or query engine as a side effect. Used as the handler argument in `HandleDirective`
+on both `commandAction` and `eventAction`.
+*/
+type directiveHandler<'directive> = (
+  Reventless.Schedule.create,
+  Reventless.Schedule.delete,
+  Reventless.QueryEngine.operations,
+  'directive,
+) => promise<unit>
+
+/**
+Actions returned by `mapIncomingCommand` — what to do when the extension point
+receives a command from an extension.
+
+- `PublishCommand(id, cmd)` — publish a command to the wrapped aggregate
+- `HandleDirective(handler, directive)` — invoke an async handler for an
+  extension-point-defined directive
+*/
+/* these actions are needed for Mapping */
+type commandAction<'command, 'directive> =
+  | PublishCommand(string, 'command)
+  | HandleDirective(directiveHandler<'directive>, 'directive)
+
+/**
+Actions returned by `mapOutgoingEvent` — what to do when the wrapped aggregate
+emits an event that should be reflected through the extension point.
+
+- `PublishEvent(id, event)` — synchronously emit an extension point event
+- `PublishEventAsync(promise)` — resolve a promise and emit the resulting event
+- `HandleDirective(handler, directive)` — invoke an async handler for an
+  extension-point-defined directive
+*/
+type eventAction<'event, 'directive> =
+  | PublishEvent(string, 'event)
+  | PublishEventAsync(promise<(string, 'event)>)
+  | HandleDirective(directiveHandler<'directive>, 'directive)
+
+/**
+The extension point protocol — defines the command, event, and directive types
+that extensions and aggregates exchange through this extension point.
+*/
+module type Spec = {
+  let name: string
+  let moduleUrl: string
+
+  @schema
+  type command
+  @schema
+  type event
+  @schema
+  type directive
+}
+
+/**
+Maps an incoming extension point command to zero or more aggregate commands
+(or side-effect calls).
+
+Called when an extension publishes a command to this extension point.
+Receives the entity ID, the command, and the message metadata.
+*/
+type mapIncomingCommand<'extensionPointCommand, 'aggregateCommand, 'extensionPointDirective> = (
+  string,
+  'extensionPointCommand,
+  Reventless.Message.meta,
+) => array<commandAction<'aggregateCommand, 'extensionPointDirective>>
+
+/**
+Maps an aggregate outgoing event to zero or more extension point events
+(or side-effect calls).
+
+Called when the wrapped aggregate emits an event. Receives the entity ID,
+the event, message metadata, and the query engine.
+*/
+type mapOutgoingEvent<'aggregateEvent, 'extensionPointEvent, 'extensionPointDirective> = (
+  string,
+  'aggregateEvent,
+  Reventless.Message.meta,
+  Reventless.QueryEngine.operations,
+) => array<eventAction<'extensionPointEvent, 'extensionPointDirective>>
+
+/**
+Application-level implementation of the command / event mapping for one
+aggregate connected to an extension point.
+
+Pass this to `ExtensionPointMapping.Make(Spec, Mapping)` to produce a compiled
+`ExtensionPointMapping.T` module.
+*/
+module type Mapping = {
+  module ExtensionPoint: Spec
+  module Delegate: Reventless.Aggregate.Spec
+
+  // Module URL of the mapping file (e.g. catalog/src/ExtensionPoint/
+  // Products_ExtensionPointMapping.res.mjs). Distinct from ExtensionPoint.moduleUrl
+  // (the spec, in catalog-spec). Auto-injected by `@@reventless.spec` on
+  // ExtensionPointMapping files. The EventCollector runtime needs THIS url
+  // (not the spec's) to dynamic-import the mapping file's mapOutgoingEvent.
+  let moduleUrl: string
+
+  let mapIncomingCommand: mapIncomingCommand<
+    ExtensionPoint.command,
+    Delegate.command,
+    ExtensionPoint.directive,
+  >
+
+  let mapOutgoingEvent: option<
+    mapOutgoingEvent<Delegate.event, ExtensionPoint.event, ExtensionPoint.directive>,
+  >
+}
+
+// Internal pre-compiled action types used by the ExtensionPoint runtime.
+// Created by ExtensionPointMapping.Make (in reventless); consumed by ExtensionPoint_Callback
+// and ExtensionPoint_Operations.
+
+/** Internal runtime action produced after pre-encoding a `commandAction`. Not for direct use. */
+type abstractCommandAction =
+  | AbstractPublishCommand(string, string, Reventless.Message.commandJson)
+  | AbstractHandleDirective(string, unit => promise<unit>)
+
+/** Internal runtime action produced after pre-encoding an `eventAction`. Not for direct use. */
+type abstractEventAction<'extensionPointEvent> =
+  | AbstractPublishEvent(string, Reventless.Message.meta, JSON.t)
+  | AbstractPublishEventAsync(promise<(string, Reventless.Message.meta, JSON.t)>)
+  | AbstractHandleDirective(unit => promise<unit>)
+
+/**
+A pre-compiled mapping module produced by `ExtensionPointMapping.Make(Spec, Mapping)`.
+
+The runtime uses `mapIncomingCommands` and `mapOutgoingEvent` to dispatch commands
+and events without knowing the concrete extension point or aggregate types.
+Application developers call `Make` themselves; the result satisfies this type.
+*/
+// Pre-compiled mapping module type. Created by ExtensionPointMapping.Make(Spec, Mapping).
+// App developers call Make themselves; the result satisfies this type.
+module type T = {
+  module ExtensionPoint: Spec
+
+  /** Name of the target this mapping connects to the extension point. */
+  let delegateName: string
+
+  /**
+  Converts a batch of typed extension point commands into pre-encoded abstract actions.
+  Called by the extension point runtime for each incoming command batch.
+  */
+  let mapIncomingCommands: (
+    array<CommandTopic.topicItem<Reventless.Message.command'<Reventless.Id.String.t, ExtensionPoint.command>>>,
+    Reventless.Schedule.create,
+    Reventless.Schedule.delete,
+    Reventless.QueryEngine.operations,
+  ) => array<abstractCommandAction>
+
+  /**
+  Converts a raw aggregate event JSON into pre-encoded abstract event actions.
+  `None` if this mapping does not produce outgoing extension point events.
+  */
+  let mapOutgoingEvent: option<
+    (
+      JSON.t,
+      Reventless.Schedule.create,
+      Reventless.Schedule.delete,
+      Reventless.QueryEngine.operations,
+    ) => array<abstractEventAction<ExtensionPoint.event>>,
+  >
+}
+
+module Make = (MappingImpl: Mapping): (
+  T with module ExtensionPoint := MappingImpl.ExtensionPoint
+) => {
+  module Spec = MappingImpl.ExtensionPoint
+  module Delegate = MappingImpl.Delegate
+  let delegateName = Delegate.name
+  let extensionPointName = Spec.name
+
+  // Variant TAGs the Delegate cares about — derived from the Delegate's event
+  // schema at functor instantiation. Used to pre-filter incoming envelopes:
+  // sibling variants on the source log (events the Delegate did not declare)
+  // are silently skipped without any decode attempt.
+  // Pre-filter incoming envelopes against the Delegate's full constructor
+  // set — includes payload-less variants (e.g. UnknownPluginDetected
+  // compiled to `S.literal("…")`) since the JSON envelope's `event` TAG
+  // still carries the literal name even when the variant has no payload.
+  let acceptedTags = Reventless.DcbTag.extractAllVariantNames(Delegate.eventSchema)
+
+  // Carry `comp` as a structured Effect log annotation — EffectLogger.install
+  // (in reventless-core, wired at Lambda startup) lifts it to the top-level
+  // JSON `comp` field. Without the unified logger installed, Effect's default
+  // logger still renders the annotation, just less prettily.
+  let compLog = (comp, msg) =>
+    Effect.logInfo(msg)->Effect.annotateLogs("comp", comp)->Effect.runSync
+
+  let doMapIncomingCommands = (
+    mapIncomingEventImpl,
+    topicItems,
+    createSchedule,
+    deleteSchedule,
+    queryEngine,
+  ) =>
+    topicItems
+    ->Array.map(({CommandTopic.reference: reference, command: {Reventless.Message.id: id, command, meta}}) =>
+      mapIncomingEventImpl(id->Reventless.Id.String.toString, command, meta)->Array.map(x =>
+        switch x {
+        | PublishCommand(targetId, targetCmd) =>
+          let cmdJson = targetCmd->Reventless.Message.encode(Delegate.commandSchema)
+          compLog(`ExtensionPoint(${extensionPointName})`, `EP→${delegateName}: ${cmdJson->Reventless.Message.variantNameOfJson->Reventless.AnsiStyle.bold}(${targetId})`)
+
+          AbstractPublishCommand(
+            delegateName,
+            reference,
+            {
+              id: targetId,
+              meta: {
+                ...meta,
+                service: Delegate.name,
+                msgId: Message.uuid(),
+              },
+              commandJson: targetCmd->Reventless.Message.encode(Delegate.commandSchema),
+            },
+          )
+        | HandleDirective(handler, directive) =>
+          compLog(`ExtensionPoint(${extensionPointName})`, "incoming directive")
+
+          AbstractHandleDirective(
+            reference,
+            () => handler(createSchedule, deleteSchedule, queryEngine, directive),
+          )
+        }
+      )
+    )
+    ->Array.flat
+
+  let mapIncomingCommands = doMapIncomingCommands(MappingImpl.mapIncomingCommand, ...)
+
+  let variantTagOfEnvelope = json =>
+    json
+    ->JSON.Decode.object
+    ->Option.flatMap(d => d->Dict.get("event"))
+    ->Option.map(Reventless.Message.variantNameOfJson)
+    ->Option.getOr("unknown")
+
+  let doMapOutgoingEvent = (
+    mapOutgoingEventImpl,
+    targetEventJson',
+    createSchedule,
+    deleteSchedule,
+    queryEngine,
+  ) => {
+    let tag = variantTagOfEnvelope(targetEventJson')
+    // Pre-filter by TAG: sibling variants from the source log that the Delegate
+    // did not declare are not this mapping's concern — skip silently with no
+    // decode attempt.
+    if !(acceptedTags->Array.includes(tag)) {
+      []
+    } else {
+      let {id, meta, event} =
+        targetEventJson'->Reventless.Message.decodeEvent'(
+          Delegate.Id.schema,
+          Delegate.eventSchema,
+        )
+      mapOutgoingEventImpl(
+        id->Delegate.Id.toString,
+        event,
+        meta,
+        queryEngine,
+      )->Array.map(eventAction =>
+        switch eventAction {
+        | PublishEvent(id, event) =>
+          let eventJson = event->Reventless.Message.encode(Spec.eventSchema)
+          compLog(`ExtensionPoint(${extensionPointName})`, `mapped ${delegateName} → ${eventJson->Reventless.Message.variantNameOfJson->Reventless.AnsiStyle.bold}(${id})`)
+          let meta = {
+            ...meta,
+            service: Spec.name,
+            msgId: Message.uuid(),
+          }
+          let eventJson' = Reventless.Message.composeEventJson'(id, meta, eventJson)
+          AbstractPublishEvent(id, meta, eventJson')
+        | PublishEventAsync(promise) =>
+          let toEvent' = async promise => {
+            let (id, event) = await promise
+            let eventJson = event->Reventless.Message.encode(Spec.eventSchema)
+            compLog(`ExtensionPoint(${extensionPointName})`, `mapped ${delegateName} → ${eventJson->Reventless.Message.variantNameOfJson->Reventless.AnsiStyle.bold}(${id}) (async)`)
+            let eventJson' = Reventless.Message.composeEventJson'(id, meta, eventJson) // TODO: check if meta is correct
+            (id, meta, eventJson')
+          }
+          AbstractPublishEventAsync(promise->toEvent')
+        | HandleDirective(handler, directive) =>
+          compLog(`ExtensionPoint(${extensionPointName})`, `mapped ${delegateName} → directive`)
+
+          AbstractHandleDirective(() =>
+            handler(createSchedule, deleteSchedule, queryEngine, directive)
+          )
+        }
+      )
+    }
+  }
+
+  let mapOutgoingEvent =
+    MappingImpl.mapOutgoingEvent->Option.map(mapOutgoingEventImpl =>
+      doMapOutgoingEvent(mapOutgoingEventImpl, ...)
+    )
+}

package/src/types/ExtensionPointMapping.res.mjs

@@ -0,0 +1,116 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Uuid from "uuid";
+import * as Stdlib_JSON from "@rescript/runtime/lib/es6/Stdlib_JSON.js";
+import * as Id$Reventless from "@reventlessdev/reventless-spec/src/types/Id.res.mjs";
+import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
+import * as Effect from "effect/Effect";
+import * as DcbTag$Reventless from "@reventlessdev/reventless-spec/src/components/DcbTag.res.mjs";
+import * as Message$Reventless from "@reventlessdev/reventless-spec/src/types/Message.res.mjs";
+import * as AnsiStyle$Reventless from "@reventlessdev/reventless-spec/src/AnsiStyle.res.mjs";
+
+function Make(MappingImpl) {
+  let Spec = MappingImpl.ExtensionPoint;
+  let Delegate = MappingImpl.Delegate;
+  let delegateName = Delegate.name;
+  let extensionPointName = Spec.name;
+  let acceptedTags = DcbTag$Reventless.extractAllVariantNames(Delegate.eventSchema);
+  let compLog = (comp, msg) => Effect.runSync(Effect.annotateLogs(Effect.logInfo(msg), "comp", comp));
+  let mapIncomingCommands = (extra, extra$1, extra$2, extra$3) => {
+    let mapIncomingEventImpl = MappingImpl.mapIncomingCommand;
+    return extra.map(param => {
+      let reference = param.reference;
+      let match = param.command;
+      let meta = match.meta;
+      return mapIncomingEventImpl(Id$Reventless.$$String.toString(match.id), match.command, meta).map(x => {
+        if (x.TAG === "PublishCommand") {
+          let targetCmd = x._1;
+          let targetId = x._0;
+          let cmdJson = Message$Reventless.encode(targetCmd, Delegate.commandSchema);
+          compLog(`ExtensionPoint(` + extensionPointName + `)`, `EP→` + delegateName + `: ` + AnsiStyle$Reventless.bold(Message$Reventless.variantNameOfJson(cmdJson)) + `(` + targetId + `)`);
+          let newrecord = {...meta};
+          return {
+            TAG: "AbstractPublishCommand",
+            _0: delegateName,
+            _1: reference,
+            _2: {
+              id: targetId,
+              meta: (newrecord.msgId = Uuid.v4(), newrecord.service = Delegate.name, newrecord),
+              commandJson: Message$Reventless.encode(targetCmd, Delegate.commandSchema)
+            }
+          };
+        }
+        let directive = x._1;
+        let handler = x._0;
+        compLog(`ExtensionPoint(` + extensionPointName + `)`, "incoming directive");
+        return {
+          TAG: "AbstractHandleDirective",
+          _0: reference,
+          _1: () => handler(extra$1, extra$2, extra$3, directive)
+        };
+      });
+    }).flat();
+  };
+  let variantTagOfEnvelope = json => Stdlib_Option.getOr(Stdlib_Option.map(Stdlib_Option.flatMap(Stdlib_JSON.Decode.object(json), d => d["event"]), Message$Reventless.variantNameOfJson), "unknown");
+  let mapOutgoingEvent = Stdlib_Option.map(MappingImpl.mapOutgoingEvent, mapOutgoingEventImpl => ((extra, extra$1, extra$2, extra$3) => {
+    let tag = variantTagOfEnvelope(extra);
+    if (!acceptedTags.includes(tag)) {
+      return [];
+    }
+    let match = Message$Reventless.decodeEvent$p(extra, Delegate.Id.schema, Delegate.eventSchema);
+    let meta = match.meta;
+    return mapOutgoingEventImpl(Delegate.Id.toString(match.id), match.event, meta, extra$3).map(eventAction => {
+      switch (eventAction.TAG) {
+        case "PublishEvent" :
+          let id = eventAction._0;
+          let eventJson = Message$Reventless.encode(eventAction._1, Spec.eventSchema);
+          compLog(`ExtensionPoint(` + extensionPointName + `)`, `mapped ` + delegateName + ` → ` + AnsiStyle$Reventless.bold(Message$Reventless.variantNameOfJson(eventJson)) + `(` + id + `)`);
+          let newrecord = {...meta};
+          newrecord.msgId = Uuid.v4();
+          newrecord.service = Spec.name;
+          let eventJson$p = Message$Reventless.composeEventJson$p(id, newrecord, eventJson);
+          return {
+            TAG: "AbstractPublishEvent",
+            _0: id,
+            _1: newrecord,
+            _2: eventJson$p
+          };
+        case "PublishEventAsync" :
+          let toEvent$p = async promise => {
+            let match = await promise;
+            let id = match[0];
+            let eventJson = Message$Reventless.encode(match[1], Spec.eventSchema);
+            compLog(`ExtensionPoint(` + extensionPointName + `)`, `mapped ` + delegateName + ` → ` + AnsiStyle$Reventless.bold(Message$Reventless.variantNameOfJson(eventJson)) + `(` + id + `) (async)`);
+            let eventJson$p = Message$Reventless.composeEventJson$p(id, meta, eventJson);
+            return [
+              id,
+              meta,
+              eventJson$p
+            ];
+          };
+          return {
+            TAG: "AbstractPublishEventAsync",
+            _0: toEvent$p(eventAction._0)
+          };
+        case "HandleDirective" :
+          let directive = eventAction._1;
+          let handler = eventAction._0;
+          compLog(`ExtensionPoint(` + extensionPointName + `)`, `mapped ` + delegateName + ` → directive`);
+          return {
+            TAG: "AbstractHandleDirective",
+            _0: () => handler(extra$1, extra$2, extra$3, directive)
+          };
+      }
+    });
+  }));
+  return {
+    delegateName: delegateName,
+    mapIncomingCommands: mapIncomingCommands,
+    mapOutgoingEvent: mapOutgoingEvent
+  };
+}
+
+export {
+  Make,
+}
+/* uuid Not a pure module */

package/src/types/Message.res

@@ -0,0 +1,3 @@
+/** Generates a new UUID v4 string. */
+@module("uuid") @val
+external uuid: unit => string = "v4"

package/src/types/Message.res.mjs

@@ -0,0 +1,2 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */

package/src/types/NoEventMappings.res

@@ -0,0 +1,25 @@
+/**
+Produces an empty `EventMapper.Mappings` module for aggregates that do not
+need to route their events to other aggregates.
+
+Use this when creating an aggregate via `Platform.Aggregate.Make` and the
+aggregate's events do not trigger commands on other aggregates.
+
+@example
+```rescript
+// CatalogPlugin.res
+module CategoryAggregate = Platform.Aggregate.Make(
+  Category,
+  CategoryBehavior,
+  NoEventMappings.Make(Category),
+)
+```
+*/
+module Make = (Target: Reventless.EventMapping.Target): (
+  EventMapper.Mappings with module Target := Target
+) => {
+  module type Mapping = Reventless.EventMapping.T with module Target := Target
+  let moduleUrl: string = %raw(`import.meta.url`)
+  let mappings = []
+  let counter = None
+}

package/src/types/NoEventMappings.res.mjs

@@ -0,0 +1,17 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function Make(Target) {
+  let moduleUrl = import.meta.url;
+  let mappings = [];
+  return {
+    moduleUrl: moduleUrl,
+    mappings: mappings,
+    counter: undefined
+  };
+}
+
+export {
+  Make,
+}
+/* No side effect */