web/jwt: JWT decoding basically working
This commit is contained in:
parent
536e89b0d5
commit
81e44aa4a8
3 changed files with 31 additions and 5 deletions
|
@ -50,9 +50,12 @@
|
|||
(deftest test-jwt ()
|
||||
(let ((secret (util:create-secret))
|
||||
;(secret "5Hw3zlpoVbFGRNZcp7Dymw")
|
||||
jwt1)
|
||||
(setf jwt1 (jwt:create secret :admin))
|
||||
(util:lgi secret jwt1)))
|
||||
tok1 jwtdata)
|
||||
(setf tok1 (jwt:create secret :admin))
|
||||
(util:lgi secret tok1)
|
||||
(setf jwtdata (jwt:decode tok1 secret))
|
||||
(util:lgi jwtdata)
|
||||
(== (gethash "name" jwtdata) "admin")))
|
||||
|
||||
(deftest test-server-config (server)
|
||||
(== (parse-integer (server:port (core:config server))) 8899))
|
||||
|
|
13
util.lisp
13
util.lisp
|
@ -9,7 +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
|
||||
#:from-bytes #:to-bytes #:from-b64 #:to-b64
|
||||
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
||||
#:relative-path #:runtime-path #:system-path
|
||||
#:add-package-local-nickname))
|
||||
|
@ -110,9 +110,20 @@
|
|||
(defun to-bytes (s)
|
||||
(flexi-streams:string-to-octets s :external-format :utf8))
|
||||
|
||||
(defun b64-decode (s &key (scheme :uri))
|
||||
(let ((padding
|
||||
(case (mod (length s) 4)
|
||||
(3 "=")
|
||||
(2 "=")
|
||||
(t ""))))
|
||||
(b64:decode-string (str:concat s padding) :scheme scheme)))
|
||||
|
||||
(defun b64-encode (b &key (scheme :uri))
|
||||
(str:trim-right (b64:encode-bytes b :scheme scheme) :char-bag "="))
|
||||
|
||||
(defun from-b64 (s &key (scheme :uri))
|
||||
(from-bytes (b64-decode s :scheme scheme)))
|
||||
|
||||
(defun to-b64 (s &key (scheme :uri))
|
||||
(b64-encode (to-bytes s) :scheme scheme))
|
||||
|
||||
|
|
14
web/jwt.lisp
14
web/jwt.lisp
|
@ -3,7 +3,8 @@
|
|||
|
||||
(defpackage :scopes/web/jwt
|
||||
(:use :common-lisp)
|
||||
(:local-nicknames (:util :scopes/util))
|
||||
(:local-nicknames (:util :scopes/util)
|
||||
(:jzon :com.inuoe.jzon))
|
||||
(:export #:create #:decode))
|
||||
|
||||
(in-package :scopes/web/jwt)
|
||||
|
@ -23,3 +24,14 @@
|
|||
(data (str:join "." (list *header* payload)))
|
||||
(sign (util:sign data secret)))
|
||||
(str:join "." (list data sign))))
|
||||
|
||||
(defun decode (token secret)
|
||||
(let (payload errors parts)
|
||||
(destructuring-bind (data &optional sig) (str:rsplit "." token :limit 2)
|
||||
(unless sig
|
||||
(return-from decode (values nil :malformed-token nil)))
|
||||
(unless (equal sig (util: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)))
|
||||
(values payload errors parts)))))
|
||||
|
|
Loading…
Add table
Reference in a new issue