work in progress: web/jwt creation

test/test-web.lisp

@@ -7,6 +7,7 @@
                     (:client :scopes/web/client)
                     (:cs-hx :scopes/frontend/cs-hx)
                     (:dom :scopes/web/dom)
+                    (:jwt :scopes/web/jwt)
                     (:logging :scopes/logging)
                     (:message :scopes/core/message)
                     (:server :scopes/web/server)
@@ -28,6 +29,7 @@
         (let ((server (core:find-service :server))
               (client (core:find-service :client)))
           (test-dom)
+          (test-jwt)
           (test-server-config server)
           (sleep 0.1)
           (test-fileserver client)
@@ -45,6 +47,12 @@
               "<a href=\"https://example.com\" title=\"Demo\" ~
                   class=\"demo-link plain\">Link to example.com</a>")))
 
+(deftest test-jwt ()
+  (let ((secret (util:create-secret))
+        jwt1)
+    (setf jwt1 (jwt:create secret :admin))
+    (util:lgi secret jwt1)))
+
 (deftest test-server-config (server)
   (== (parse-integer (server:port (core:config server))) 8899))
 

util.lisp

@@ -9,6 +9,7 @@
            #:create-secret #:digest #:sign
            #:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
            #:flatten-str #:to-keyword #:keyword-to-string #:to-integer #:to-string
+           #:from-bytes #:to-bytes #:to-b64
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
            #:relative-path #:runtime-path #:system-path
            #:add-package-local-nickname))
@@ -44,13 +45,10 @@
   (b64:encode-bytes (ironclad:random-data bytes) :scheme scheme))
 
 (defun digest (tx &key (scheme :original) (alg :sha256))
-  (b64:encode-bytes
+  (b64:encode-bytes (ironclad:digest-sequence alg (to-bytes tx)) :scheme scheme))
-    (ironclad:digest-sequence alg 
-      (flexi-streams:string-to-octets tx :external-format :utf8))
-    :scheme scheme))
 
 (defun sign (tx key)
-  (let* ((binp (flexi-streams:string-to-octets tx :external-format :utf8))
+  (let* ((binp (to-bytes tx))
          (bkey (make-array 16 :element-type '(unsigned-byte 8)
                           :initial-contents (b64:decode-string key)))
          (mac (ironclad:make-mac :hmac bkey :sha256)))
@@ -105,6 +103,15 @@
     nil
     (intern (string-upcase s) :keyword)))
 
+(defun from-bytes (b)
+  (flexi-streams:octets-to-string b :external-format :utf8))
+
+(defun to-bytes (s)
+  (flexi-streams:string-to-octets s :external-format :utf8))
+
+(defun to-b64 (s &key (scheme :original))
+  (b64:encode-bytes (to-bytes s) :scheme scheme))
+
 ;;;; directory and pathname utilities
 
 (defun split-filename (name)

web/jwt.lisp

@@ -3,10 +3,21 @@
 
 (defpackage :scopes/web/jwt
   (:use :common-lisp)
-  (:local-nicknames (:alx :alexandria)
+  (:local-nicknames (:util :scopes/util))
-                    (:b64 :qbase64)
+  (:export #:create #:decode))
-                    (:fxs :flexi-streams)
+
-                    (:ic :ironclad)
+(in-package :scopes/web/jwt)
-                    (:jzon :com.inuoe.jzon))
-  (:export #:issue #:decode))
  
+(defvar *header* 
+  (util:to-b64 "{\"alg\": \"HS256\", \"typ\": \"JWT\"}" :scheme :uri))
+
+(defvar *payload-format* "{\"sub\": ~s, \"name\": ~s, \"iat\": ~s}")
+
+(defun create (secret name &key (subject "scopes") (ttl 86400))
+  (let* ((iat (util:to-unix-time (+ (get-universal-time) ttl)))
+         (payload (util:to-b64 
+                    (format nil *payload-format* subject (util:to-string name) iat)
+                    :scheme :uri))
+         (data (str:join "." (list *header* payload)))
+         (sign (util:sign data secret)))
+    (str:join "." (list data sign))))