40 lines
1.6 KiB
Common Lisp
40 lines
1.6 KiB
Common Lisp
;;;; cl-scopes/web/jwt - JWT creation and validation
|
|
;;;; inspired by: cljwt
|
|
|
|
(defpackage :scopes/web/jwt
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:crypt :scopes/util/crypt)
|
|
(:util :scopes/util)
|
|
(:jzon :com.inuoe.jzon))
|
|
(: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,\"exp\":~s}")
|
|
|
|
(defun create (secret name &key (subject :scopes) (ttl 86400))
|
|
(let* ((exp (util:to-unix-time (+ (get-universal-time) ttl)))
|
|
(payload (util:to-b64
|
|
(format nil *payload-format*
|
|
(util:from-keyword subject)
|
|
(util:from-keyword name) exp)
|
|
:scheme :uri))
|
|
(data (str:join "." (list *header* payload)))
|
|
(sig (crypt:sign data secret)))
|
|
(str:join "." (list data sig))))
|
|
|
|
(defun decode (token secret)
|
|
(let (payload)
|
|
(destructuring-bind (data &optional sig) (str:rsplit "." token :limit 2)
|
|
(unless sig
|
|
(return-from decode (values nil :malformed-token token)))
|
|
(unless (equal sig (crypt:sign data secret))
|
|
(return-from decode (values nil :invalid-signature (list data sig))))
|
|
(destructuring-bind (hjson &optional pjson) (str:split "." data)
|
|
(setf payload (jzon:parse (util:from-b64 pjson)))
|
|
(when (> (util:to-unix-time (get-universal-time)) (gethash "exp" payload))
|
|
(return-from decode (values nil :token-expired payload)))
|
|
(values payload nil nil)))))
|