message: use actor:message as second base class => replace message:sender with actor:customer

This commit is contained in:
Helmut Merz 2025-05-02 14:41:27 +02:00
parent e528d96e09
commit 92b26c74bb
5 changed files with 22 additions and 17 deletions

View file

@ -5,7 +5,7 @@
(:local-nicknames (:async :scopes/util/async)
(:util :scopes/util))
(:export #:actor #:bg-actor #:become #:create #:send
#:content
#:message #:content #:customer
#:*logger* #:*root*
#:echo #:inc #:lgi
#:calculator #:plus #:minus #:show #:send-value))

View file

@ -2,7 +2,8 @@
(defpackage :scopes/core
(:use :common-lisp)
(:local-nicknames (:async :scopes/util/async)
(:local-nicknames (actor :scopes/core/actor)
(:async :scopes/util/async)
(:config :scopes/config)
(:message :scopes/core/message)
(:shape :scopes/shape)
@ -146,13 +147,13 @@
;;;; some simple predefined actions
(defun echo (ctx msg &key (domain :scopes) (action :echo))
(let ((sndr (message:sender msg)))
(if sndr
(let ((cust (actor:customer msg)))
(if cust
(let* ((h (shape:head msg))
(new-msg (message:create `(,domain ,action ,@(cddr h))
:data (shape:data msg))))
(send sndr new-msg))
(util:lgw "sender missing" msg))))
(send cust new-msg))
(util:lgw "customer missing" msg))))
(defun do-print (ctx msg)
(declare (ignore ctx))

View file

@ -2,9 +2,10 @@
(defpackage :scopes/core/message
(:use :common-lisp)
(:local-nicknames (:shape :scopes/shape))
(:local-nicknames (:actor :scopes/core/actor)
(:shape :scopes/shape))
(:export #:message-meta #:message #:create
#:head #:data #:sender))
#:head #:data))
(in-package :scopes/core/message)
@ -13,12 +14,14 @@
(defun message-meta ()
(make-instance 'shape:record-meta :head-fields '(:domain :action :class :item)))
(defclass message (shape:record)
((shape:meta :initform (message-meta) :allocation :class)
(sender :reader sender :initarg :sender :initform nil)))
(defclass message (shape:record actor:message)
((shape:meta :initform (message-meta) :allocation :class)))
(defun create (head &key data sender)
(shape:create 'message :head head :data data :sender sender))
(defun create (head &key data customer)
(shape:create 'message :head head :data data :customer customer))
(defmethod print-object ((msg message) stream)
(shape:print-slots msg stream 'shape:head 'sender 'shape:data))
(shape:print-slots msg stream 'shape:head 'actor:customer 'shape:data))
(defmethod actor:content ((msg message))
(list (shape:head-plist) (shape:data)))

View file

@ -2,7 +2,8 @@
(defpackage :scopes-auth/web
(:use :common-lisp)
(:local-nicknames (:auth :scopes-auth)
(:local-nicknames (:actor :scopes/core/actor)
(:auth :scopes-auth)
(:config :scopes/config)
(:core :scopes/core)
(:jwt :scopes/web/jwt)
@ -17,7 +18,7 @@
(defun login-form (ctx msg)
(let ((msg (message:create '(:html :render :form :login)
:data '(:fields (:login :password) :button "Login")
:sender (message:sender msg))))
:customer (actor:customer msg))))
(core:echo ctx msg)))
(defun login (ctx msg)

View file

@ -91,7 +91,7 @@
(let* ((resp (response:setup ctx env :html-responder html-responder))
(iact (make-instance 'response:interaction :response resp))
(msg (message:create
(head env) :data (plist (post-data env)) :sender iact)))
(head env) :data (plist (post-data env)) :customer iact)))
(util:lgd msg)
; (check-auth ctx msg env) => (response:render-unauthorized resp)
(if (core:handle-message ctx msg)