@reventlessdev/online-shop-aggregates-ordering 3.0.0-alpha.101

package/lib/ocaml/AvailableProducts_Projections.res

@@ -0,0 +1,20 @@
+// AvailableProducts projection mappings.
+// Maps CatalogProduct aggregate events to the AvailableProducts read model.
+@@reventless.mappings
+
+module CatalogProductMapping = Mapping.Make(
+  CatalogProduct,
+  AvailableProducts,
+  {
+    open CatalogProduct
+    let project = ({event, id, _}) =>
+      switch event {
+      | Synced({name, price}) =>
+        Set(id, {AvailableProducts.name: name, price})
+      | PriceUpdated({price}) =>
+        Update(id, state => {...state, price})
+      }
+  },
+)
+
+let mappings: array<module(Mapping)> = [module(CatalogProductMapping)]

package/lib/ocaml/CatalogProduct.res

@@ -0,0 +1,18 @@
+// CatalogProduct aggregate specification.
+// Stores a synced shadow of Catalog products inside Ordering,
+// driven by Catalog's ProductsExtensionPoint.
+
+@@reventless.spec
+
+@schema
+type command =
+  | Sync({name: string, price: float})
+  | UpdatePrice({price: float})
+
+@schema
+type event =
+  | Synced({name: string, price: float})
+  | PriceUpdated({price: float})
+
+@schema
+type error = unit // always succeeds — sync is idempotent

package/lib/ocaml/CatalogProduct_Behavior.res

@@ -0,0 +1,27 @@
+// CatalogProduct aggregate behavior.
+// Idempotently syncs Catalog product state into Ordering.
+
+@@reventless.behavior
+
+@schema
+type state =
+  | NotCreated
+  | Created({name: string, price: float})
+
+let initialState = NotCreated
+
+let evolve = (state, event) =>
+  switch (state, event) {
+  | (NotCreated, Synced({name, price})) => Created({name, price})
+  | (Created(_), Synced({name, price})) => Created({name, price})
+  | (Created(s), PriceUpdated({price})) => Created({...s, price})
+  | (NotCreated, PriceUpdated(_)) => state
+  }
+
+let decide = (state, command) =>
+  switch (state, command) {
+  | (NotCreated, Sync({name, price})) => Ok([Synced({name, price})])
+  | (NotCreated, UpdatePrice(_)) => Ok([]) // no aggregate yet — idempotent
+  | (Created(_), Sync(_)) => Ok([]) // already exists — idempotent
+  | (Created(_), UpdatePrice({price})) => Ok([PriceUpdated({price: price})])
+  }

package/lib/ocaml/CatalogProduct_GWT.res

@@ -0,0 +1,27 @@
+@@reventless.gwt
+
+describe("CatalogProduct Behavior", () => {
+  test("Sync on new aggregate produces Synced", () =>
+    givenEvents([])
+    ->whenCmd(Sync({name: "Laptop", price: 999.99}))
+    ->thenEvent(Synced({name: "Laptop", price: 999.99}))
+  )
+
+  test("Sync on already-synced aggregate produces no events (idempotent)", () =>
+    givenEvents([Synced({name: "Laptop", price: 999.99})])
+    ->whenCmd(Sync({name: "Laptop", price: 999.99}))
+    ->thenNoEvent
+  )
+
+  test("UpdatePrice on never-synced aggregate produces no events (idempotent)", () =>
+    givenEvents([])
+    ->whenCmd(UpdatePrice({price: 1.0}))
+    ->thenNoEvent
+  )
+
+  test("UpdatePrice on synced aggregate produces PriceUpdated", () =>
+    givenEvents([Synced({name: "Laptop", price: 999.99})])
+    ->whenCmd(UpdatePrice({price: 899.99}))
+    ->thenEvent(PriceUpdated({price: 899.99}))
+  )
+})

package/lib/ocaml/Customer.res

@@ -0,0 +1,24 @@
+// Customer aggregate specification.
+// A registered buyer with contact details and account status.
+
+@@reventless.spec
+
+@schema
+type command =
+  | Register({email: string, address: string})
+  | UpdateEmail({email: string})
+  | UpdateAddress({address: string})
+  | Deactivate
+
+@schema
+type event =
+  | Registered({email: string, address: string})
+  | EmailUpdated({email: string})
+  | AddressUpdated({address: string})
+  | Deactivated
+
+@schema
+type error =
+  | CustomerAlreadyRegistered
+  | CustomerNotFound
+  | CustomerAlreadyDeactivated

package/lib/ocaml/Customer_Behavior.res

@@ -0,0 +1,41 @@
+// Customer aggregate behavior.
+// Implements the state machine for registering and managing customers.
+
+@@reventless.behavior
+
+@schema
+type state =
+  | NotCreated
+  | Active({email: string, address: string})
+  | Deactivated
+
+let initialState = NotCreated
+
+let evolve = (state, event) =>
+  switch (state, event) {
+  | (NotCreated, Registered({email, address})) => Active({email, address})
+  | (Active(_), Registered({email, address})) => Active({email, address})
+  | (Active(s), EmailUpdated({email})) => Active({...s, email})
+  | (Active(s), AddressUpdated({address})) => Active({...s, address})
+  | (Active(_), Customer.Deactivated) => Deactivated
+  | (Deactivated, _) => state
+  | (NotCreated, _) => state
+  }
+
+let decide = (state, command) =>
+  switch (state, command) {
+  | (NotCreated, Register({email, address})) => Ok([Registered({email, address})])
+  | (NotCreated, UpdateEmail(_)) => Error(CustomerNotFound)
+  | (NotCreated, UpdateAddress(_)) => Error(CustomerNotFound)
+  | (NotCreated, Deactivate) => Error(CustomerNotFound)
+  | (Active(_), Register(_)) => Error(CustomerAlreadyRegistered)
+  | (Active(s), UpdateEmail({email})) if email == s.email => Ok([])
+  | (Active(_), UpdateEmail({email})) => Ok([EmailUpdated({email: email})])
+  | (Active(s), UpdateAddress({address})) if address == s.address => Ok([])
+  | (Active(_), UpdateAddress({address})) => Ok([AddressUpdated({address: address})])
+  | (Active(_), Deactivate) => Ok([Customer.Deactivated])
+  | (Deactivated, Register(_)) => Error(CustomerAlreadyDeactivated)
+  | (Deactivated, UpdateEmail(_)) => Error(CustomerAlreadyDeactivated)
+  | (Deactivated, UpdateAddress(_)) => Error(CustomerAlreadyDeactivated)
+  | (Deactivated, Deactivate) => Ok([]) // idempotent
+  }

package/lib/ocaml/Customer_GWT.res

@@ -0,0 +1,90 @@
+@@reventless.gwt
+
+describe("Customer Behavior", () => {
+  test("Register on new aggregate produces Registered", () =>
+    givenEvents([])
+    ->whenCmd(Register({email: "alice@example.com", address: "123 Main St"}))
+    ->thenEvent(Registered({email: "alice@example.com", address: "123 Main St"}))
+  )
+
+  test("Register on existing aggregate returns CustomerAlreadyRegistered", () =>
+    givenEvents([Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenCmd(Register({email: "bob@example.com", address: "456 Oak Ave"}))
+    ->thenError(CustomerAlreadyRegistered)
+  )
+
+  test("Register on deactivated aggregate returns CustomerAlreadyDeactivated", () =>
+    givenEvents([
+      Registered({email: "alice@example.com", address: "123 Main St"}),
+      Deactivated,
+    ])
+    ->whenCmd(Register({email: "bob@example.com", address: "456 Oak Ave"}))
+    ->thenError(CustomerAlreadyDeactivated)
+  )
+
+  test("UpdateEmail on non-existent aggregate returns CustomerNotFound", () =>
+    givenEvents([])
+    ->whenCmd(UpdateEmail({email: "x@y"}))
+    ->thenError(CustomerNotFound)
+  )
+
+  test("UpdateEmail on active customer produces EmailUpdated", () =>
+    givenEvents([Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenCmd(UpdateEmail({email: "alice2@example.com"}))
+    ->thenEvent(EmailUpdated({email: "alice2@example.com"}))
+  )
+
+  test("UpdateEmail to same email produces no events (idempotent)", () =>
+    givenEvents([Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenCmd(UpdateEmail({email: "alice@example.com"}))
+    ->thenNoEvent
+  )
+
+  test("UpdateEmail on deactivated customer returns CustomerAlreadyDeactivated", () =>
+    givenEvents([
+      Registered({email: "alice@example.com", address: "123 Main St"}),
+      Deactivated,
+    ])
+    ->whenCmd(UpdateEmail({email: "x@y"}))
+    ->thenError(CustomerAlreadyDeactivated)
+  )
+
+  test("UpdateAddress on non-existent aggregate returns CustomerNotFound", () =>
+    givenEvents([])
+    ->whenCmd(UpdateAddress({address: "x"}))
+    ->thenError(CustomerNotFound)
+  )
+
+  test("UpdateAddress on active customer produces AddressUpdated", () =>
+    givenEvents([Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenCmd(UpdateAddress({address: "789 Pine Rd"}))
+    ->thenEvent(AddressUpdated({address: "789 Pine Rd"}))
+  )
+
+  test("UpdateAddress to same address produces no events (idempotent)", () =>
+    givenEvents([Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenCmd(UpdateAddress({address: "123 Main St"}))
+    ->thenNoEvent
+  )
+
+  test("Deactivate on non-existent aggregate returns CustomerNotFound", () =>
+    givenEvents([])
+    ->whenCmd(Deactivate)
+    ->thenError(CustomerNotFound)
+  )
+
+  test("Deactivate on active customer produces Deactivated", () =>
+    givenEvents([Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenCmd(Deactivate)
+    ->thenEvent(Deactivated)
+  )
+
+  test("Deactivate on deactivated customer produces no events (idempotent)", () =>
+    givenEvents([
+      Registered({email: "alice@example.com", address: "123 Main St"}),
+      Deactivated,
+    ])
+    ->whenCmd(Deactivate)
+    ->thenNoEvent
+  )
+})

package/lib/ocaml/Customers.res

@@ -0,0 +1,12 @@
+// Customers read model specification.
+// Query-side state for registered customers.
+
+@@reventless.spec
+
+@schema
+type state = {
+  email: string,
+  address: string,
+  deactivated: bool,
+}
+

package/lib/ocaml/Customers_GWT.res

@@ -0,0 +1,27 @@
+@@reventless.gwt(Customers_Projections.CustomerMapping)
+
+describe("Customers ReadModel ← Customer", () => {
+  test("Registered sets initial read model state", () =>
+    givenEvents([])
+    ->whenEvent(Customer.Registered({email: "alice@example.com", address: "123 Main St"}))
+    ->thenState({Customers.email: "alice@example.com", address: "123 Main St", deactivated: false})
+  )
+
+  test("EmailUpdated updates the email", () =>
+    givenEvents([Customer.Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenEvent(Customer.EmailUpdated({email: "alice2@example.com"}))
+    ->thenState({Customers.email: "alice2@example.com", address: "123 Main St", deactivated: false})
+  )
+
+  test("AddressUpdated updates the address", () =>
+    givenEvents([Customer.Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenEvent(Customer.AddressUpdated({address: "789 Pine Rd"}))
+    ->thenState({Customers.email: "alice@example.com", address: "789 Pine Rd", deactivated: false})
+  )
+
+  test("Deactivated sets deactivated flag", () =>
+    givenEvents([Customer.Registered({email: "alice@example.com", address: "123 Main St"})])
+    ->whenEvent(Customer.Deactivated)
+    ->thenState({Customers.email: "alice@example.com", address: "123 Main St", deactivated: true})
+  )
+})

package/lib/ocaml/Customers_Projections.res

@@ -0,0 +1,21 @@
+// Customer projection mappings.
+// Maps Customer aggregate events to Customers read model state changes.
+@@reventless.mappings
+
+module CustomerMapping = Mapping.Make(
+  Customer,
+  Customers,
+  {
+    open Customer
+    let project = ({event, id, _}) =>
+      switch event {
+      | Registered({email, address}) =>
+        Set(id, {Customers.email: email, address, deactivated: false})
+      | EmailUpdated({email}) => Update(id, state => {...state, email})
+      | AddressUpdated({address}) => Update(id, state => {...state, address})
+      | Deactivated => Update(id, state => {...state, deactivated: true})
+      }
+  },
+)
+
+let mappings: array<module(Mapping)> = [module(CustomerMapping)]

package/lib/ocaml/EmailService.res

@@ -0,0 +1,22 @@
+// Stub email service for the example.
+//
+// The implementation goes through a `ref`-held `backend` so that tests can
+// install a recording mock (see `EmailService_Mock.res` next to the GWT files
+// — Option C of the `sideeffect-gwt` plan). Production code still calls
+// `EmailService.sendOrderConfirmation(...)` directly; the indirection is
+// invisible at the call site.
+
+type backend = {
+  sendOrderConfirmation: (~email: string, ~orderId: string) => promise<unit>,
+}
+
+let liveBackend: backend = {
+  sendOrderConfirmation: async (~email as _, ~orderId as _) => {
+    Console.log("[EmailService] Order confirmation sent")
+  },
+}
+
+let current = ref(liveBackend)
+
+let sendOrderConfirmation = (~email, ~orderId) =>
+  current.contents.sendOrderConfirmation(~email, ~orderId)

package/lib/ocaml/EmailService_Mock.res

@@ -0,0 +1,31 @@
+// Recording mock for `EmailService` (Option C of the `sideeffect-gwt` plan).
+// `install()` swaps `EmailService.current` to a backend that records every
+// call into a ref. `SideEffect_GWT` reads the recorded calls back via `mock`
+// and renders assertions against them.
+//
+// Production code never sees this file — it lives under `tests/` and only
+// loads when the test runner imports it.
+
+@schema
+type call = SendOrderConfirmation({email: string, orderId: string})
+
+let calls: ref<array<call>> = ref([])
+
+let reset = () => calls := []
+
+let recordingBackend: EmailService.backend = {
+  sendOrderConfirmation: async (~email, ~orderId) => {
+    calls := calls.contents->Array.concat([SendOrderConfirmation({email, orderId})])
+  },
+}
+
+// Swap the live backend and clear any prior recordings. Call from `beforeEach`.
+let install = () => {
+  EmailService.current := recordingBackend
+  reset()
+}
+
+let mock: ReventlessGwt.SideEffect_GWT.mock<call> = {
+  snapshot: () => calls.contents,
+  encode: c => c->S.reverseConvertToJsonOrThrow(callSchema),
+}

package/lib/ocaml/Order.res

@@ -0,0 +1,27 @@
+// Order aggregate specification.
+// A confirmed purchase referencing Product IDs and a CustomerId.
+
+@@reventless.spec
+
+@schema
+type command =
+  | Place({customerId: string, @ref("AvailableProducts") @noDcbTag productIds: array<string>})
+  | @allowedStates([Orders.Placed]) Ship
+  | @allowedStates([Orders.Placed]) Cancel
+  | @allowedStates([Orders.Cancelled]) Refund({reason: string})
+
+@schema
+type event =
+  | Placed({customerId: string, productIds: array<string>})
+  | Shipped
+  | Cancelled({productIds: array<string>})
+  | Refunded({reason: string})
+
+@schema
+type error =
+  | OrderAlreadyPlaced
+  | OrderNotFound
+  | OrderAlreadyShipped
+  | OrderAlreadyCancelled
+  | OrderNotCancelled
+  | OrderAlreadyRefunded

package/lib/ocaml/OrderMappings_GWT.res

@@ -0,0 +1,52 @@
+// `Mapping_GWT` exercises Order's self-mapping (auto-ship on placement).
+// Bare `@@reventless.gwt` would derive the Behavior DSL from the Aggregate
+// folder; the cross-pattern Mapping DSL is wired explicitly instead.
+//
+// Self-mappings need the target's per-id history pre-seeded with the
+// source-emitted event, since Mapping_GWT models source and target as
+// independent aggregates even when they're the same one in production.
+
+module OrderSource = ReventlessGwt.Mapping_GWT.FromBehavior(Order, Order_Behavior)
+module OrderTarget = ReventlessGwt.Mapping_GWT.FromBehavior(Order, Order_Behavior)
+
+module AutoShipGwtMapping = {
+  module Source = OrderSource
+  module Target = OrderTarget
+  let map = Order_Mappings.AutoShipMapping.map
+}
+
+include ReventlessGwt.Mapping_GWT.Make(AutoShipGwtMapping)
+
+let placedEvent = Order.Placed({customerId: "cust-1", productIds: ["prod-1"]})
+
+describe("Order auto-ship mapping (Placed → Ship)", () => {
+  test("Place → AutoShipMapping issues Ship → target emits Shipped", () =>
+    givenSourceEvents([])
+    ->andTargetEvents([("order-1", [placedEvent])])
+    ->whenSourceCmd("order-1", Place({customerId: "cust-1", productIds: ["prod-1"]}))
+    ->thenTargetEvent("order-1", Order.Shipped)
+  )
+
+  test("Ship command does not fire the mapping (only Placed events do)", () =>
+    givenSourceEvents([placedEvent])
+    ->andTargetEvents([("order-1", [placedEvent])])
+    ->whenSourceCmd("order-1", Ship)
+    ->thenNoTargetEvent
+  )
+
+  test("Cancel command does not fire the mapping", () =>
+    givenSourceEvents([placedEvent])
+    ->andTargetEvents([("order-1", [placedEvent])])
+    ->whenSourceCmd("order-1", Cancel)
+    ->thenNoTargetEvent
+  )
+
+  test("Refund command does not fire the mapping (only Placed events do)", () =>
+    givenSourceEvents([placedEvent, Order.Cancelled({productIds: ["prod-1"]})])
+    ->andTargetEvents([
+      ("order-1", [placedEvent, Order.Cancelled({productIds: ["prod-1"]})]),
+    ])
+    ->whenSourceCmd("order-1", Refund({reason: "customer-changed-mind"}))
+    ->thenNoTargetEvent
+  )
+})

package/lib/ocaml/OrderNotifications.res

@@ -0,0 +1,8 @@
+// Order notification task — hosts side effects for the Order aggregate.
+// Sends email confirmations when orders are placed.
+
+@@reventless.task
+
+let setup = (_queryEngine, _queryBucketName, _opts) => {
+  Task.sideEffects: [module(Order_EmailNotification): module(SideEffect.T)],
+}