From 95127d94e83a6d5ae24d563da52e1efbf104f7fa Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Wed, 14 Jan 2026 14:49:58 +0100
Subject: [PATCH] core: add 'forward' action handler

---
 core/core.lisp            | 16 +++++++++++++++-
 test/etc/config-core.lisp |  6 ++++++
 test/test-core.lisp       | 11 ++++++++++-
 3 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/core/core.lisp b/core/core.lisp
index b37567e..662052c 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -14,7 +14,7 @@
            #:find-service #:run-services #:setup-services #:shutdown
            #:base-context #:context #:add-action #:config #:mailbox #:name
            #:handle-message
-           #:do-print #:echo))
+           #:do-print #:echo #:forward))
 
 (in-package :scopes/core)
 
@@ -141,6 +141,20 @@
         (actor:send cust new-msg))
       (util:lgw "customer missing" msg))))
 
+(defun forward (ctx msg &key receivers (domain :scopes) (action :forward))
+  (unless receivers
+    (util:lgw "empty receivers list" msg)
+    (return-from forward))
+  (let* ((h (shape:head msg))
+         (new-msg (message:create `(,domain ,action ,@(cddr h))
+                                  :data (shape:data msg)
+                                  :customer (actor:customer msg))))
+    (dolist (rcvname receivers)
+      (let ((rcvr (find-service rcvname)))
+        (if (null rcvr)
+          (util:lgw "receiver not found" rcvname)
+          (actor:send (mailbox rcvr) new-msg))))))
+
 (defun do-print (ctx msg)
   (declare (ignore ctx))
   (format t "~&~s~%" msg))
diff --git a/test/etc/config-core.lisp b/test/etc/config-core.lisp
index 4b94a28..9e46a8f 100644
--- a/test/etc/config-core.lisp
+++ b/test/etc/config-core.lisp
@@ -11,3 +11,9 @@
 
 (config:add :test-receiver :setup #'setup)
 (config:add-action '(:test) #'check-message)
+(config:add-action '(:scopes) #'check-message)
+
+(config:add :forwarder :setup (core:make-setup))
+(config:add-action '(:test)
+  (lambda (ctx msg)
+    (core:forward ctx msg :receivers '(:test-receiver))))
diff --git a/test/test-core.lisp b/test/test-core.lisp
index 5b69df6..86aa80a 100644
--- a/test/test-core.lisp
+++ b/test/test-core.lisp
@@ -66,7 +66,8 @@
         (test-util-async)
         (test-actor)
         (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
-        (test-send))
+        (test-send)
+        (test-forwarder))
       (core:shutdown)
       (check-expected)
       (t:show-result))))
@@ -143,3 +144,11 @@
     (== (core:name rcvr) :test-receiver)
     (actor:send (core:mailbox rcvr) msg)
     ))
+
+(deftest test-forwarder ()
+   (let ((rcvr (receiver t:*test-suite*))
+         (fwd (core:find-service :forwarder))
+         (msg (message:create '(:test :dummy) :data "dummy payload"))
+         (msg-exp (message:create '(:scopes :forward) :data "dummy payload")))
+    (expect rcvr msg-exp)
+    (actor:send (core:mailbox fwd) msg)))