minor improvements on message handling, server response, echo handler

This commit is contained in:
Helmut Merz 2024-07-07 11:04:16 +02:00
parent 9c3f68740c
commit 797b291262
4 changed files with 19 additions and 15 deletions

View file

@ -105,10 +105,13 @@
;;;; some simple predefined actions ;;;; some simple predefined actions
(defun echo (ctx msg) (defun echo (ctx msg)
(let ((resp (message:sender msg))) (let ((sndr (message:sender msg)))
(if (null resp) (if sndr
(log:warn "sender missing: ~s" msg) (let* ((h (message:head-as-list msg))
(send resp msg)))) (new-msg (message:create `(:scopes :echo ,@(cddr h))
:data (message:data msg))))
(send sndr new-msg))
(log:warn "sender missing: ~s" msg))))
(defun do-print (ctx msg) (defun do-print (ctx msg)
(declare (ignore ctx)) (declare (ignore ctx))

View file

@ -2,8 +2,9 @@
(defpackage :scopes/core/message (defpackage :scopes/core/message
(:use :common-lisp) (:use :common-lisp)
(:export #:message #:make-message #:simple-message (:export #:message #:create #:make-message #:simple-message
#:head #:data #:sender #:head-as-list)) #:head #:head-as-list
#:data #:sender))
(in-package :scopes/core/message) (in-package :scopes/core/message)
@ -24,6 +25,9 @@
(data :accessor data :initarg :data :initform nil))) (data :accessor data :initarg :data :initform nil)))
(defun make-message (head-vals &key data sender) (defun make-message (head-vals &key data sender)
(create head-vals :data data :sender sender))
(defun create (head-vals &key data sender)
(let ((h (make-instance 'message-head))) (let ((h (make-instance 'message-head)))
(dolist (sl '(domain action class item)) (dolist (sl '(domain action class item))
(setf (slot-value h sl) (pop head-vals))) (setf (slot-value h sl) (pop head-vals)))

View file

@ -57,14 +57,14 @@
(lack/component:call file-app env)))) (lack/component:call file-app env))))
(defun message-handler (ctx env) (defun message-handler (ctx env)
(let* ((resp (make-response ctx)) (let* ((resp (make-instance 'response))
(msg (message:make-message (msg (message:create
(head env) :data (plist (post-data env)) :sender resp))) (head env) :data (plist (post-data env)) :sender resp)))
(log:debug "msg ~s" msg) (log:debug "msg ~s" msg)
(if (core:handle-message ctx msg) (if (core:handle-message ctx msg)
;(render-response ctx resp) ;(render-response ctx resp)
(list 200 (headers resp) (list (body resp))) (list 200 (headers resp) (list (body resp)))
'(404 (:content-type "text/plain") ("Not found"))))) (list 404 '(:content-type "text/plain") '("Not found")))))
;(render-not-found ctx) ;(render-not-found ctx)
(defun select-app (ctx env) (defun select-app (ctx env)
@ -85,18 +85,15 @@
;;;; server response - provice response body and headers ;;;; server response - provice response body and headers
(defclass response () (defclass response ()
((ctx :reader ctx :initarg :ctx) ((message :accessor message :initform nil)
(message :accessor message :initform nil)
(headers :accessor headers :initform '(:content-type "text/plain")))) (headers :accessor headers :initform '(:content-type "text/plain"))))
(defun make-response (ctx)
(make-instance 'response :ctx ctx))
(defgeneric body (r) (defgeneric body (r)
(:method ((r response)) (:method ((r response))
(getf (message:data (message r)) :info))) (getf (message:data (message r)) :info)))
(defmethod core:send ((r response) msg) (defmethod core:send ((r response) msg)
(log:debug "receiving ~s" msg)
(setf (message r) msg)) (setf (message r) msg))
(defmethod print-object ((r response) s) (defmethod print-object ((r response) s)