web/server fileserver improvements; work in progress: message handling

test/test-web.lisp

@@ -9,7 +9,7 @@
                     (:server :scopes/web/server)
                     (:t :scopes/testing))
   (:export #:run)
-  (:import-from :scopes/testing #:deftest #:==))
+  (:import-from :scopes/testing #:deftest #:== #:has-prefix))
 
 (in-package :scopes/test-web)
 
@@ -20,19 +20,24 @@
         (*config* nil))
     (load (t:test-path "config-web" "etc"))
     (core:setup-services *config*)
-    (test-server-config)
+    (let ((server (core:find-service :server))
-    (sleep 0.1)
+          (client (core:find-service :client)))
-    (test-client)
+      (test-server-config server)
-    (sleep 0.1)
+      (sleep 0.1)
-    (server:stop (core:find-service :server))
+      (test-fileserver client)
-    (t:show-result)))
+      ;(test-message client)
+      (sleep 0.1)
+      (server:stop (core:find-service :server))
+      (t:show-result))))
 
-(t:deftest test-server-config ()
+(t:deftest test-server-config (server)
-  (let ((cfg (core:config (core:find-service :server))))
+  (== (parse-integer (server:port (core:config server))) 8899))
-    (== (parse-integer (server:port cfg)) 8899)))
 
-(t:deftest test-client ()
+(t:deftest test-fileserver (client)
-  (let ((ctx (core:find-service :client))
+  (let ((msg (message:simple-message '(:test :get-page) '(:path "demo.html"))))
-        (msg (message:simple-message '(:test :get-page) '(:path "demo.html"))))
+    (== (client:base-url (core:config client)) "http://localhost:8899")
-    (== (client:base-url (core:config ctx)) "http://localhost:8899")
+    (has-prefix (client:get-page client msg) "Hello Fileserver!")))
-    (== (client:get-page ctx msg) "Hello World!")))
+
+(t:deftest test-message (client)
+  (let ((msg (message:simple-message '(:test :data))))
+    (== (client:send-message client msg) "Hello World!")))

testing.lisp

@@ -6,7 +6,7 @@
   (:use :common-lisp)
   (:export #:*test-suite*
            #:test-suite #:deftest #:show-result
-           #:failure #:test #:==
+           #:failure #:test #:== #:has-prefix
            #:test-path #:*current-system*))
 
 (in-package :scopes/testing)
@@ -42,6 +42,13 @@
     (unless is-ok
       (failure "~s!=~s" have wanted))))
 
+(defun has-prefix (have wanted)
+  (let ((suite *test-suite*)
+        (is-ok (string= (str:prefix (list have wanted)) wanted)))
+    (push is-ok (car (result suite)))
+    (unless is-ok
+      (failure "~s has not prefix ~s" have wanted))))
+
 (defmacro deftest (name args &body body)
   `(defun ,name ,args
    (push '(,name) (result *test-suite*))

web/client.lisp

@@ -6,7 +6,7 @@
                     (:core :scopes/core)
                     (:message :scopes/core/message))
   (:export #:config #:base-url #:api-path #:doc-path
-           #:get-page))
+           #:get-page #:send-message))
 
 (in-package :scopes/web/client)
 
@@ -23,3 +23,8 @@
          (path (getf (message:data msg) :path))
          (url (str:concat (base-url cfg) (doc-path cfg) path)))
     (dex:get url)))
+
+(defun send-message (ctx msg)
+  (let* ((cfg (core:config ctx))
+         (url (str:concat (base-url cfg) (api-path cfg) (message:head-as-list msg))))
+    (dex:get url)))

web/server.lisp

@@ -34,14 +34,11 @@
   (clack:stop (listener ctx)))
 
 (defun fileserver (ctx env &key doc-root)
-  (print env)
   (let* ((message-head (getf env :message-head))
          (rel-path (str:join "/" (cdr message-head)))
          (file-app (make-instance 'lack/app/file:lack-app-file 
                                   :file rel-path :root doc-root)))
-    (format t "~&fileserver: doc-root ~s, rel-path ~s, message-head ~s~%" 
+    ;(format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root))
-            doc-root rel-path message-head)
-    (format t "~&file path: ~s~%" (merge-pathnames rel-path doc-root))
     (lack/component:call file-app env)))
 
 (defun message-handler (ctx env)
@@ -53,7 +50,7 @@
     (if (match (car r) nil)
       (progn
         (setf (getf env :message-head) (str:split "/" (getf env :path-info)))
-        (format t "~&route: ~s~%" r)
+        ;(format t "~&route: ~s~%" r)
         (return-from select-app 
                      #'(lambda () 
                          (apply (cadr r) ctx env (cddr r)))))))