25 lines
888 B
Common Lisp
25 lines
888 B
Common Lisp
;;;; cl-scopes/web/jwt - JWT creation and validation
|
|
;;;; inspired by: cljwt
|
|
|
|
(defpackage :scopes/web/jwt
|
|
(:use :common-lisp)
|
|
(: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*
|
|
(util:keyword-to-string subject)
|
|
(util:keyword-to-string name) iat)
|
|
:scheme :uri))
|
|
(data (str:join "." (list *header* payload)))
|
|
(sign (util:sign data secret)))
|
|
(str:join "." (list data sign))))
|