diff --git a/core/core.lisp b/core/core.lisp index aaff20b..35b9175 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -46,7 +46,8 @@ (defvar *root* nil) -(defclass base-context ()) +(defclass base-context () + ()) (defclass context () ((config :reader config :initarg :config) @@ -97,7 +98,7 @@ (cond ((do-actions ctx msg) t) ((do-actions ctx msg #'default-actions) t) - (t (log:warn "handle-message: no action selected for ~s" msg))))) + (t (util:lgw "no action selected" msg))))) (defun do-actions (ctx msg &optional (acts #'actions)) (let ((hdlrs (select msg (funcall acts ctx)))) @@ -115,7 +116,7 @@ (new-msg (message:create `(:scopes :echo ,@(cddr h)) :data (shape:data msg)))) (send sndr new-msg)) - (log:warn "sender missing: ~s" msg)))) + (util:lgw "sender missing" msg)))) (defun do-print (ctx msg) (declare (ignore ctx)) diff --git a/shape/shape.lisp b/shape/shape.lisp index bbda9d5..fedf8ee 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -24,7 +24,7 @@ (print-fields rec stream 'head 'data)) (defun print-fields (rec stream &rest fields) - (let ((fm (util:make-vars-format fields nil))) + (let ((fm (util:make-vars-format fields))) (print-unreadable-object (rec stream :type t) (apply #'format stream fm (mapcar #'(lambda (x) (funcall x rec)) fields))))) @@ -37,7 +37,7 @@ (defun head-plist (rec) (let (pl (hv (head rec))) (dolist (hf (head-fields rec)) - (setf pl (cons hf (cons (util:keyword-to-string (pop hv)) pl)))) + (setf pl (cons hf (cons (util:from-keyword (pop hv)) pl)))) pl)) (defun data-value (rec key) diff --git a/util/util.lisp b/util/util.lisp index a8b4bc6..3ee98df 100644 --- a/util/util.lisp +++ b/util/util.lisp @@ -4,10 +4,10 @@ (:use :common-lisp) (:local-nicknames (:b64 :qbase64)) #+sbcl (:import-from :sb-ext #:add-package-local-nickname) - (:export #:make-vars-format #:lg #:lgd #:lgi + (:export #:make-vars-format #:lg #:lgd #:lgi #:lgw #:from-unix-time #:to-unix-time #:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal - #:flatten-str #:to-keyword #:keyword-to-string #:to-integer #:to-string + #:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string #:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64 #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string #:relative-path #:runtime-path #:system-path @@ -17,7 +17,7 @@ ;;;; formatting and logging shortcuts -(defun make-vars-format (vars info) +(defun make-vars-format (vars &optional info) (let ((prefix (if info (format nil "~a: " info) ""))) (format nil "~a~{~(~a~): ~~S ~}" prefix vars))) @@ -28,6 +28,7 @@ (defmacro lgd (&rest vars) `(lg :debug nil ,@vars)) (defmacro lgi (&rest vars) `(lg :info nil ,@vars)) +(defmacro lgw (info &rest vars) `(lg :warn ,info ,@vars)) ;;;; date and time manipulations @@ -70,9 +71,6 @@ (mapcar (lambda (x) (str:trim x)) (str:lines s)))) -(defun keyword-to-string (k) - (if k (string-downcase k) "")) - (defun to-string (k &key (sep " ") lower-case) (let ((pattern (if lower-case "~(~a~)" "~a"))) (if (atom k) @@ -82,6 +80,9 @@ (defun to-integer (k) (parse-integer (string k))) +(defun from-keyword (k) + (if k (string-downcase k) "")) + (defun to-keyword (s) (if (string= s "") nil diff --git a/web/jwt.lisp b/web/jwt.lisp index da7eb10..58cffcb 100644 --- a/web/jwt.lisp +++ b/web/jwt.lisp @@ -19,8 +19,8 @@ (let* ((exp (util:to-unix-time (+ (get-universal-time) ttl))) (payload (util:to-b64 (format nil *payload-format* - (util:keyword-to-string subject) - (util:keyword-to-string name) exp) + (util:from-keyword subject) + (util:from-keyword name) exp) :scheme :uri)) (data (str:join "." (list *header* payload))) (sig (crypt:sign data secret)))