cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
core/actor.lisp
View file

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

11
core/core.lisp
View file

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

19
core/message.lisp
View file

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

5
lib/auth/web.lisp
View file

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

2
web/server.lisp
View file

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