challenge-routes.lisp

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
;; Copyright (c) 2024, SWGY, Inc. <ron@sw.gy>
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software Foundation, Inc.,
;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;;
(in-package :swtx)

(defun put-challenge (request-params)
  "As a ningle handler, receive a request to create a one-shot auth challenge."
  (format T "PUT challenge params:~%~S~%" request-params)
  ; This function expects a "path" attribute. The specific path attribute will
  ; determine what email address is used to send the authentication code.
  (let* ((path (param-val "path" request-params *max-path-length*))
         (challenge (create-new-challenge path
                                          :people-db *people-db*
                                          :auth-db *auth-db*)))
    (cond
      ((null challenge)
       (format T "Failed to create challenge for ~A~%" path)
       `(400 () ("Failed to create challenge. Try again later")))
      (t (format T "Created challenge ~A~%" challenge)
         (write-to-db *auth-db* challenge)
         (lparallel:submit-task
          *mt-channel* (lambda () (email-challenge challenge)))
         `(200 () (,(st-json:write-json-to-string (to-hash challenge))))))))

(defun resolve-challenge (request-params)
  "A basic endpoint requiring one-shot authentication."
  (declare (ignore request-params))
  (with-oneshot-auth *auth-db* (email)
    (declare (ignore email))
    `(200 () ("\"Resolved!\""))))

(defun describe-jwt (request-params)
  "A basic endpoint requiring persistent auth."
  (with-persistent-auth ((list *role-any*) request-params)
    (let* ((request-headers (lack.request:request-headers ningle:*request*))
           (auth-header (header-val "authorization" request-headers
                                    *max-auth-header-length*))
           (jwt-payload (jwt-decode
                         (second
                          (cl-ppcre:split "[Bb]earer " auth-header))
                         *jwt-signing-secret*))
           (response (st-json:write-json-to-string jwt-payload)))
      `(200 () (,response)))))