diff --git a/core/core.lisp b/core/core.lisp index 3e6717a..ee312b6 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -83,8 +83,7 @@ (defun setup-services (&optional (cfg config:*root*)) (async:init) - (let* ((ctx (make-instance 'context :config cfg)) - (bhv (lambda (msg) (funcall #'handle-message ctx msg)))) + (let* ((ctx (make-instance 'context :config cfg))) (setf (mailbox ctx) (lpq:make-queue)) (setf *root* ctx)) (dolist (c (reverse (config:children cfg))) @@ -94,7 +93,9 @@ (unwind-protect (progn (setup-services cfg) - (actor:start (mailbox *root*) :foreground t)) + (actor:start (mailbox *root*) + (lambda (msg) (funcall #'handle-message *root* msg)) + :foreground t)) (shutdown))) (defun shutdown () diff --git a/web/client.lisp b/web/client.lisp index 574b56e..ea116e5 100644 --- a/web/client.lisp +++ b/web/client.lisp @@ -15,7 +15,7 @@ (defvar *cookie-jar* (cl-cookie:make-cookie-jar)) (defclass config (config:base) - ((config:setup :initform (core:make-setup :class 'core:service)) + ((config:setup :initform (core:make-setup :class 'core:context)) (base-url :reader base-url :initarg :base-url :initform "http://localhost:8135") (doc-path :reader doc-path :initarg :doc-path :initform "/") (api-path :reader api-path :initarg :api-path :initform "/api/") diff --git a/web/response.lisp b/web/response.lisp index ddb65d5..6656b50 100644 --- a/web/response.lisp +++ b/web/response.lisp @@ -6,6 +6,7 @@ (:cookie :scopes/web/cookie) (:core :scopes/core) (:dom :scopes/web/dom) + (:lpq :lparallel.queue) (:message :scopes/core/message) (:shape :scopes/shape) (:util :scopes/util)) @@ -71,8 +72,11 @@ (defun setup (ctx env &key html-responder) (let* ((headers (getf env :headers)) - (resp-class (select-response-class (gethash "accept" headers) html-responder))) - (actor:make-actor #'core:handle-message resp-class :context ctx :env env))) + (resp-class (select-response-class (gethash "accept" headers) html-responder)) + (resp (make-instance resp-class :context ctx :env env))) + (setf (core:mailbox resp) (lpq:make-queue)) + resp)) + ;(actor:make-actor #'core:handle-message resp-class :context ctx :env env))) (defun select-response-class (accept html-responder) (let ((accept (string-downcase accept))) @@ -100,7 +104,9 @@ (defun render (resp) #'(lambda (responder) (setf (responder resp) responder) - (actor:start resp))) + (actor:start (core:mailbox resp) + (lambda (msg) (funcall #'core:handle-message resp msg)) + :foreground t))) (defun render-not-found(resp) (list 404 '(:content-type "text/plain") '("Not found"))) diff --git a/web/server.lisp b/web/server.lisp index c105c3b..52c457f 100644 --- a/web/server.lisp +++ b/web/server.lisp @@ -29,7 +29,7 @@ ((listener :accessor listener))) (defun setup (cfg) - (let ((ctx (core:default-setup cfg 'context))) + (let ((ctx (funcall (core:make-setup :class 'context) cfg))) (start ctx))) ;;;; listener = server process @@ -89,8 +89,9 @@ (defun message-handler (ctx env &key html-responder) (let* ((resp (response:setup ctx env :html-responder html-responder)) - (msg (message:create - (head env) :data (plist (post-data env)) :customer resp))) + (msg (message:create (head env) + :data (plist (post-data env)) + :customer (core:mailbox resp)))) (util:lgd msg) ; (check-auth ctx msg env) => (response:render-unauthorized resp) (if (core:handle-message ctx msg)