cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

web/jwt, util: improvements and fixes

Browse source
This commit is contained in:
Helmut Merz 2024-08-25 11:52:36 +02:00
parent c747cb0557
commit 536e89b0d5
2 changed files with 13 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
util.lisp
View file

@ -41,9 +41,8 @@
;;;; 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 :uri))
(str:trim-right (b64:encode-bytes (ironclad:random-data bytes) :scheme scheme) (b64-encode (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))
@ -55,8 +54,7 @@
; :initial-contents (b64:decode-string key))) ; :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)
(str:trim-right (b64:encode-bytes (ironclad:produce-mac mac) :scheme :uri) (b64-encode (ironclad:produce-mac mac) :scheme :uri)))
:char-bag "=")))
;;;; lists and loops ;;;; lists and loops
@ -112,8 +110,11 @@
(defun to-bytes (s) (defun to-bytes (s)
(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 b64-encode (b &key (scheme :uri))
(str:trim-right (b64:encode-bytes (to-bytes s) :scheme scheme) :char-bag "=")) (str:trim-right (b64:encode-bytes b :scheme scheme) :char-bag "="))
(defun to-b64 (s &key (scheme :uri))
(b64-encode (to-bytes s) :scheme scheme))
;;;; directory and pathname utilities ;;;; directory and pathname utilities

8
web/jwt.lisp
View file

@ -9,14 +9,16 @@
(in-package :scopes/web/jwt) (in-package :scopes/web/jwt)
(defvar *header* (defvar *header*
(util:to-b64 "{\"alg\": \"HS256\", \"typ\": \"JWT\"}" :scheme :uri)) (util:to-b64 "{\"alg\":\"HS256\",\"typ\":\"JWT\"}" :scheme :uri))
(defvar *payload-format* "{\"sub\": ~s, \"name\": ~s, \"iat\": ~s}") (defvar *payload-format* "{\"sub\":~s,\"name\":~s,\"iat\":~s}")
(defun create (secret name &key (subject "scopes") (ttl 86400)) (defun create (secret name &key (subject "scopes") (ttl 86400))
(let* ((iat (util:to-unix-time (+ (get-universal-time) ttl))) (let* ((iat (util:to-unix-time (+ (get-universal-time) ttl)))
(payload (util:to-b64 (payload (util:to-b64
(format nil *payload-format* subject (util:to-string name) iat) (format nil *payload-format*
(util:keyword-to-string subject)
(util:keyword-to-string name) iat)
:scheme :uri)) :scheme :uri))
(data (str:join "." (list *header* payload))) (data (str:join "." (list *header* payload)))
(sign (util:sign data secret))) (sign (util:sign data secret)))