From 81e44aa4a88d462dd9cb1c7f88d1cdc4fc0aab81 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 25 Aug 2024 18:28:35 +0200
Subject: [PATCH] web/jwt: JWT decoding basically working

---
 test/test-web.lisp |  9 ++++++---
 util.lisp          | 13 ++++++++++++-
 web/jwt.lisp       | 14 +++++++++++++-
 3 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/test/test-web.lisp b/test/test-web.lisp
index d3bc1d6..cadb361 100644
--- a/test/test-web.lisp
+++ b/test/test-web.lisp
@@ -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))
diff --git a/util.lisp b/util.lisp
index 5d65822..47d987b 100644
--- a/util.lisp
+++ b/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))
 
diff --git a/web/jwt.lisp b/web/jwt.lisp
index fee1cf6..54ea3a4 100644
--- a/web/jwt.lisp
+++ b/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)))))