JWT creation with valid signature basically working

This commit is contained in:
Helmut Merz 2024-08-25 11:21:55 +02:00
parent c14a6775a9
commit c747cb0557
2 changed files with 9 additions and 5 deletions

View file

@ -49,6 +49,7 @@
(deftest test-jwt () (deftest test-jwt ()
(let ((secret (util:create-secret)) (let ((secret (util:create-secret))
;(secret "5Hw3zlpoVbFGRNZcp7Dymw")
jwt1) jwt1)
(setf jwt1 (jwt:create secret :admin)) (setf jwt1 (jwt:create secret :admin))
(util:lgi secret jwt1))) (util:lgi secret jwt1)))

View file

@ -42,18 +42,21 @@
;;;; secrets, digests, and other crypto stuff ;;;; secrets, digests, and other crypto stuff
(defun create-secret (&key (bytes 16) (scheme :original)) (defun create-secret (&key (bytes 16) (scheme :original))
(b64:encode-bytes (ironclad:random-data bytes) :scheme scheme)) (str:trim-right (b64:encode-bytes (ironclad:random-data bytes) :scheme scheme)
:char-bag "="))
(defun digest (tx &key (scheme :original) (alg :sha256)) (defun digest (tx &key (scheme :original) (alg :sha256))
(b64:encode-bytes (ironclad:digest-sequence alg (to-bytes tx)) :scheme scheme)) (b64:encode-bytes (ironclad:digest-sequence alg (to-bytes tx)) :scheme scheme))
(defun sign (tx key) (defun sign (tx key)
(let* ((binp (to-bytes tx)) (let* ((binp (to-bytes tx))
(bkey (make-array 16 :element-type '(unsigned-byte 8) (bkey (to-bytes key))
:initial-contents (b64:decode-string key))) ;(bkey (make-array 16 :element-type '(unsigned-byte 8)
; :initial-contents (b64:decode-string key)))
(mac (ironclad:make-mac :hmac bkey :sha256))) (mac (ironclad:make-mac :hmac bkey :sha256)))
(ironclad:update-mac mac binp) (ironclad:update-mac mac binp)
(b64:encode-bytes (ironclad:hmac-digest mac) :scheme :uri))) (str:trim-right (b64:encode-bytes (ironclad:produce-mac mac) :scheme :uri)
:char-bag "=")))
;;;; lists and loops ;;;; lists and loops
@ -110,7 +113,7 @@
(flexi-streams:string-to-octets s :external-format :utf8)) (flexi-streams:string-to-octets s :external-format :utf8))
(defun to-b64 (s &key (scheme :original)) (defun to-b64 (s &key (scheme :original))
(b64:encode-bytes (to-bytes s) :scheme scheme)) (str:trim-right (b64:encode-bytes (to-bytes s) :scheme scheme) :char-bag "="))
;;;; directory and pathname utilities ;;;; directory and pathname utilities