ops-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
;; 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 ops-status (request-params)
  "Creates a new host."
  (with-persistent-auth ((list *role-admin*) request-params)
    (handler-case (let ((stats (get-db-stats)))
            `(200 () (,(st-json:write-json-to-string stats))))
      (serious-condition (c)
        `(400 () (,(format nil "Problem! ~A" c)))))))

(defun recover-accounts (request-params)
  "Given a request to recover the accounts associated with a particular email
address, email that address with the associated accounts."
  (with-oneshot-auth *auth-db* (email)
    (lparallel:submit-task
     *mt-channel*
     (lambda ()
       (let ((located-accounts
               (list-associated-accounts *people-db* :email email)))
         (format T "Located accounts ~A for ~A~%" located-accounts email)
         (when located-accounts
        ; TODO: For reps, include the associated vendor name
           (send-account-listing-email
            email (mapcar
                   #'(lambda (x)
                       (cons (account-type-from-key x) x))
                   located-accounts))))))
    `(200 () ("Information is on the way."))))