;; 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)
(defparameter lmdb:*env* nil "Lightning Memory-Mapped Database environment")
(defparameter *people-db* nil "LMDB holding vendors and people")
(defparameter *auth-db* nil "LMDB holding auth challenges")
(defparameter *interactions-db* nil "LMDB holding interaction details")
(defparameter *mt-channel* nil
"lparallel channel for task submission.")
(defparameter *app* nil "The ningle application.")
(defparameter *clack-handler* nil
"The clack handler, needed as a reference for stopping the server")
(defparameter *disable-random-codes* nil
"If T, all generated response codes will be 000000")
(defvar *noop* (lambda (params)
(declare (ignore params))
`(200 () ("\"Nothing to do!\"")))
"Reusable handler for no-op endpoints")
(defun status-check (params)
"Status check endpoint"
(declare (ignore params))
`(200 () ("\"All ok!\"")))
(defun initialize-jwt-secrets ()
(setf *jwt-signing-secret* (read-secret "jwt.secret" nil))
(setf *jwt-api-id* (read-secret "jwt.api-id" nil))
(setf *jwt-app-id* (read-secret "jwt.app-id" nil)))
(defun initialize-db ()
(unless lmdb:*env*
(setq lmdb:*env* (open-env #p"/tmp/swiggy-tix-lmdb/"
:if-does-not-exist :create
:max-dbs 3
:map-size (* 32 1024 1024)
:sync t))
;; people-db, auth-db, interactions-db
(setq *people-db* (get-db "people" :value-encoding :utf-8))
(setq *auth-db* (get-db "auth" :value-encoding :utf-8))
(setq *interactions-db* (get-db "interactions" :value-encoding :utf-8))))
(defun initialize-mt-kernel ()
(setf lparallel:*kernel*
(lparallel:make-kernel
2 :name "task-workers"))
(setf *mt-channel* (lparallel:make-channel)))
(defun close-db ()
(when lmdb:*env*
(format T "Closing database environment.")
(lmdb:close-env lmdb:*env*)
(setf lmdb:*env* nil)))
(defun build-routes ()
(when (null *app*)
(error :app-not-initialized))
(setf (ningle:route *app* "/api/all-ok-p" :method :GET) #'status-check)
(setf (ningle:route *app* "/api/recover-accounts"
:method :GET) #'recover-accounts)
(setf (ningle:route *app* "/api/ops" :method :GET) #'ops-status)
(setf (ningle:route *app* "/api/interxs"
:method :GET) #'list-all-interactions)
(setf (ningle:route *app* "/api/attendees" :method :GET) #'list-attendees)
(setf (ningle:route *app* "/api/attendees" :method :PUT) #'put-attendee)
(setf (ningle:route *app* "/api/attendees/:attendee-id"
:method :GET) #'get-attendee)
(setf (ningle:route *app* "/api/attendees/:attendee-id"
:method :PUT) #'update-attendee)
(setf (ningle:route *app* "/api/attendees/:attendee-id"
:method :DELETE) #'deactivate-attendee)
(setf (ningle:route *app* "/api/attendees/:attendee-id/auth"
:method :PUT) #'auth-attendee)
(setf (ningle:route *app* "/api/attendees/:attendee-id/check-auth"
:method :GET) #'check-auth-attendee)
(setf (ningle:route *app* "/api/hosts" :method :GET) #'list-hosts)
(setf (ningle:route *app* "/api/hosts" :method :PUT) #'put-host)
(setf (ningle:route *app* "/api/hosts/:host-id"
:method :GET) #'get-host)
(setf (ningle:route *app* "/api/hosts/:host-id"
:method :PUT) #'update-host)
(setf (ningle:route *app* "/api/hosts/:host-id/auth"
:method :PUT) #'auth-host)
(setf (ningle:route *app* "/api/hosts/:host-id/check-auth"
:method :PUT) #'check-auth-host)
(setf (ningle:route *app* "/api/vendors" :method :PUT) #'put-vendor)
(setf (ningle:route *app* "/api/vendors" :method :GET) #'list-vendors)
(setf (ningle:route *app* "/api/vendors/:vendor-id"
:method :GET) #'get-vendor)
(setf (ningle:route *app* "/api/vendors/:vendor-id/interxs"
:method :GET) #'list-vendor-interactions)
(setf (ningle:route *app* "/api/vendors/:vendor-id"
:method :PUT) #'update-vendor)
(setf (ningle:route *app* "/api/vendors/:vendor-id"
:method :DELETE) #'deactivate-vendor)
(setf (ningle:route *app* "/api/vendors/:vendor-id/auth"
:method :PUT) #'auth-vendor)
(setf (ningle:route *app* "/api/vendors/:vendor-id/check-auth"
:method :GET) #'check-auth-vendor)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps"
:method :PUT) #'put-rep)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps"
:method :GET) #'list-reps)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps/:rep-id"
:method :GET) #'get-rep)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps/:rep-id"
:method :PUT) #'update-rep)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps/:rep-id"
:method :DELETE) #'deactivate-rep)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps/:rep-id/auth"
:method :PUT) #'auth-rep)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps/:rep-id/check-auth"
:method :GET) #'check-auth-rep)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps/:rep-id/interxs"
:method :GET) #'list-rep-interactions)
(setf (ningle:route *app* "/api/vendors/:vendor-id/reps/:rep-id/interxs"
:method :PUT) #'put-interaction)
(setf (ningle:route *app* "/api/challenges" :method :PUT) #'put-challenge)
(setf (ningle:route *app* "/api/challenges/resolve"
:method :POST) #'resolve-challenge)
(setf (ningle:route *app* "/api/challenges/describe-jwt"
:method :GET) #'describe-jwt))
(defun initialize-ningle ()
(unless *app*
(setf *app* (make-instance 'ningle:app)))
(build-routes))
(defun initialize ()
(initialize-jwt-secrets)
(initialize-db)
(initialize-mt-kernel)
(initialize-ningle))
(defun list-db-contents (db)
(with-txn (:write nil)
(lmdb:with-cursor (c db)
(loop initially
(lmdb:cursor-first c)
do (when (null (cursor-key c)) (return))
(format T "k: ~A, v: ~A~%"
(stringify (cursor-key c))
(cursor-value c))
(unless (lmdb:cursor-next c)
(return))))))
(defun serve (&key (address "127.0.0.1") (port 5000) (use-thread t))
"Start the app"
(initialize)
; Start cleanup thread
(sb-thread:make-thread
(lambda ()
(handler-case
(loop
(progn
(delete-expired-challenges *auth-db* (get-universal-time))
(sleep 180)))
(lmdb:lmdb-error (e)
(format T "LMDB Error: ~A" e)))))
; use-thread nil means do not daemonize
(handler-case (setf *clack-handler*
(clack:clackup *app*
:server :fcgi
:address address
:port port :use-thread use-thread))
; Use (clack:stop *clack-handler*) to stop the server
(serious-condition (c)
(lparallel:end-kernel :wait t)
(close-db)
(format T "~A~%" c)
(signal c))))
(defun standalone-serve ()
; TODO: parse (uiop:command-line-arguments) for things like swank,
; secrets location, hardcoded challenge codes, etc.
(setf *disable-random-codes* t)
(slynk:create-server :port 4005)
(serve))