93 lines
3.3 KiB
Common Lisp
93 lines
3.3 KiB
Common Lisp
;;;; cl-scopes/test-web - test web (client and server) functionality
|
|
|
|
(defpackage :scopes/test-web
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:config :scopes/config)
|
|
(:core :scopes/core)
|
|
(:client :scopes/web/client)
|
|
(:cs-hx :scopes/frontend/cs-hx)
|
|
(:crypt :scopes/util/crypt)
|
|
(:dom :scopes/web/dom)
|
|
(:jwt :scopes/web/jwt)
|
|
(:logging :scopes/logging)
|
|
(:message :scopes/core/message)
|
|
(:server :scopes/web/server)
|
|
(:util :scopes/util)
|
|
(:t :scopes/testing))
|
|
(:export #:run)
|
|
(:import-from :scopes/testing #:deftest #:== #:has-prefix))
|
|
|
|
(in-package :scopes/test-web)
|
|
|
|
;;;; test runner
|
|
|
|
(defun run ()
|
|
(let ((t:*test-suite* (t:test-suite "web")))
|
|
(load (t:test-path "config-web" "etc"))
|
|
(unwind-protect
|
|
(progn
|
|
(core:setup-services)
|
|
(let ((server (core:find-service :server))
|
|
(client (core:find-service :client)))
|
|
(test-dom-parse)
|
|
(test-dom)
|
|
(test-jwt)
|
|
(test-server-config server)
|
|
(sleep 0.1)
|
|
(test-fileserver client)
|
|
(test-message client)
|
|
(sleep 0.1)))
|
|
(core:shutdown)
|
|
(t:show-result))))
|
|
|
|
;;;; the tests
|
|
|
|
(deftest test-dom-parse ()
|
|
(let (inp parsed)
|
|
(setf inp "<a href=\"https://example.com\">Link</a>")
|
|
(setf parsed (dom:parse inp))
|
|
(== parsed '(((:a :href "https://example.com") "Link")))
|
|
;(== (dom:from-list parsed) ((dom:a '(:href "https://example.com") "Link")))
|
|
(== (dom:render (dom:from-list parsed)) inp)
|
|
(== (dom:to-list (dom:a '(:href "https://example.com") "Link")) (car parsed))
|
|
))
|
|
|
|
(deftest test-dom ()
|
|
(== (dom:render
|
|
(dom:a '(:href "https://example.com"
|
|
:title "Demo" :class (:demo-link :plain))
|
|
"Link to example.com"))
|
|
(format nil
|
|
"<a href=\"https://example.com\" title=\"Demo\" ~
|
|
class=\"demo-link plain\">Link to example.com</a>"))
|
|
(== (dom:render (dom:br)) (format nil "<br>")))
|
|
|
|
(deftest test-jwt ()
|
|
(let ((secret (crypt:create-secret))
|
|
;(secret "5Hw3zlpoVbFGRNZcp7Dymw")
|
|
tok1 jwtdata)
|
|
(setf tok1 (jwt:create secret :admin))
|
|
(util:lgi secret tok1)
|
|
(setf jwtdata (jwt:decode tok1 secret))
|
|
(util:lgi jwtdata)
|
|
(== (gethash "name" jwtdata) "admin")))
|
|
|
|
(deftest test-server-config (server)
|
|
(== (parse-integer (server:port (core:config server))) 8899))
|
|
|
|
(deftest test-fileserver (client)
|
|
(let ((msg (message:create '(:test :get-page) :data '(:path "demo.html"))))
|
|
(== (client:base-url (core:config client)) "http://localhost:8899")
|
|
(has-prefix (client:get-page client msg) "Hello Fileserver!")))
|
|
|
|
(deftest test-message (client)
|
|
(let ((msg (message:create '(:test :data :field :info) :data '(:info "test data"))))
|
|
(== (client:send-message client msg)
|
|
"<div><div><label>info</label>: test data</div></div>")) ; cs-hx:response
|
|
;"<dl><dt>info</dt><dd>test data</dd></dl>"))) ; default response
|
|
(let ((msg (message:create '(:test :cookie)
|
|
:data '(:name "mycookie" :value "my_value"
|
|
:domain "localhost"))))
|
|
(client:send-message client msg)
|
|
(util:lgi client::*cookie-jar*))
|
|
)
|