;;;; 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:keyword-to-string subject)
                            (util:keyword-to-string 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)))))