diff --git a/test/test-web.lisp b/test/test-web.lisp index bce9924..a33c521 100644 --- a/test/test-web.lisp +++ b/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 @@ "Link to example.com"))) +(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)) diff --git a/util.lisp b/util.lisp index 13d2ab1..9942c3c 100644 --- a/util.lisp +++ b/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 - (ironclad:digest-sequence alg - (flexi-streams:string-to-octets tx :external-format :utf8)) - :scheme scheme)) + (b64:encode-bytes (ironclad:digest-sequence alg (to-bytes tx)) :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) diff --git a/web/jwt.lisp b/web/jwt.lisp index 6fc8371..b18d399 100644 --- a/web/jwt.lisp +++ b/web/jwt.lisp @@ -3,10 +3,21 @@ (defpackage :scopes/web/jwt (:use :common-lisp) - (:local-nicknames (:alx :alexandria) - (:b64 :qbase64) - (:fxs :flexi-streams) - (:ic :ironclad) - (:jzon :com.inuoe.jzon)) - (:export #:issue #:decode)) + (:local-nicknames (:util :scopes/util)) + (:export #:create #:decode)) + +(in-package :scopes/web/jwt) +(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))))