From eaeff37566238e918e0667ea03ee7803d349d7ae Mon Sep 17 00:00:00 2001 From: not manx Date: Fri, 22 May 2020 18:14:26 +0000 Subject: [PATCH] Changes for testing --- src/bantflags.asd | 15 +++++++-------- src/db.lisp | 33 ++++++++++++++------------------- src/main.lisp | 31 ++++++++++++------------------- src/utils.lisp | 21 +++++++++++++++------ 4 files changed, 48 insertions(+), 52 deletions(-) diff --git a/src/bantflags.asd b/src/bantflags.asd index 26b523b..47f6eb9 100644 --- a/src/bantflags.asd +++ b/src/bantflags.asd @@ -1,16 +1,15 @@ (asdf:defsystem #:bantflags - :description "the bantflags server component" - :author "Manx (boku@plum.moe)" + :description "the bantflags server component" + :author "Manx (boku@plum.moe)" :mailto "boku@plum.moe" - :license "AGPLv3+" - :version "0.0.1" - :serial t - :depends-on (:hunchentoot - :easy-routes + :license "AGPLv3+" + :version "0.0.1" + :serial t + :depends-on (:hunchentoot :str :clsql :jonathan) - :Components + :Components ((:file "utils") (:file "db") (:file "config") diff --git a/src/db.lisp b/src/db.lisp index 5c7f780..55891ad 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -5,8 +5,7 @@ (defparameter conn nil) (defvar get-posts-sql "SELECT posts.post_nr, flags.flag from flags left join postflags on (postflags.flag = flags.id) left join posts on (postflags.post_nr = posts.id) where posts.post_nr in (~{'~a'~^,~}) and posts.board = '~a';") - -(clsql:file-enable-sql-reader-syntax) +;; (clsql:start-sql-recording) (defmacro dbfun (name &rest body) `(defun ,name ,(car body) @@ -19,26 +18,22 @@ (dbfun insert-post (post_nr board flags) (clsql:query (format nil "insert ignore into posts (post_nr, board) values (~a, '~a');" post_nr board)) (let ((post-id (caar (clsql:query (format nil "select id from posts where post_nr = ~a and board = '~a';" post_nr board))))) - (clsql:with-transaction () - (clsql:execute-command - (with-output-to-string (s) - (format s "insert into postflags (post_nr, flag) values") - (loop for flag in (butlast flags) - do (format s "(~a,~a)," post-id (flag-id flag))) - (format s "(~a,~a);" post-id (flag-id (car (last flags)))) - :database db))))) + (clsql:execute-command + (with-output-to-string (s) + (format s "insert into postflags (post_nr, flag) values") + (loop for flag in (butlast flags) + do (format s "(~a,~a)," post-id (flag-id flag))) + (format s "(~a,~a);" post-id (flag-id (car (last flags)))) + :database db)))) (dbfun get-posts (posts board) - (let ((result (clsql:query (format nil get-posts-sql posts board :database db))) + (let ((result (clsql:query (format nil get-posts-sql posts board) :database db)) (table (make-hash-table))) - (dolist (row result) - (let ((key (car row))) - (unless (gethash key table) - (setf (gethash key table) '()) - (push (cadr row) (gethash key table))))) + (loop for (post_nr . flag) in result do + (unless (gethash post_nr table) + (setf (gethash post_nr table) '())) + (push (car flag) (gethash post_nr table))) (jojo:to-json table))) (dbfun get-flags () - (clsql:select [id] [flag] - :from [flags] - :database db)) + (clsql:query "select flags.id, flags.flag from flags" :database db)) diff --git a/src/main.lisp b/src/main.lisp index f1347a4..5c179f6 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -15,8 +15,7 @@ (handler-case (init) (error (c) (format t "Init fucked up, exiting ~a" c) - (return-from main))) - + (return-from main))) (loop (sleep 43200) (gc :full t))) (defmethod hunchentoot:acceptor-status-message (acceptor (http-status-code (eql 404)) &key) @@ -29,16 +28,9 @@ (hunchentoot:abort-request-handler)) ,@body)) -(defun host-dir (uri path) - (push - (hunchentoot:create-folder-dispatcher-and-handler uri path) - hunchentoot:*dispatch-table*)) - -(host-dir "/flags/" (merge-pathnames #p"flags/" (cconf 'www-root))) - -(handle :post (api-post :uri "/post") - (post_nr regions board verison) - (@json) +(handle :post (api-post :uri "/staging/post") + (post_nr regions board version) + (setf (hunchentoot:content-type*) "application/json") (let ((separator (if (< 1 (get-version version)) "," "||"))) (multiple-value-bind (result msg) (post-valid-p post_nr regions board separator) (cond @@ -48,16 +40,17 @@ (t (format nil "{\"Error\": \"~a\"}~%" msg)))))) -(handle :get (api-flags :uri "/flags") - () - (setf (hunchentoot:content-type*) "text/plain") - (format nil "~a~%" *flags-txt*)) - -(handle :post (api-get :uri "/get") +(handle :post (api-get :uri "/staging/get") (post_nrs board version) + (@json *reply*) (setf post_nrs (str:split "," post_nrs)) (cond ((and (loop for x in post_nrs always (post-number-p x)) (boardp board)) - (format nil "~a" (get-posts post_nrs board))) + (format nil "~a~%" (get-posts post_nrs board))) (t (format nil "~a~%" "bad")))) + +(handle :get (api-flags :uri "/staging/flags") + () + (@plain tbnl:*reply*) + (format nil "~a~%" *flags-txt*)) diff --git a/src/utils.lisp b/src/utils.lisp index d666f25..7b0d3ae 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -26,12 +26,6 @@ (defun set-db-conn () (setq conn (conf 'db-conn))) -(defun @plain () - (setf (hunchentoot:content-type*) "text/plain")) - -(defun @json () - (setf (hunchentoot:content-type*) "application/json")) - (defun get-version (thing) (if (null thing) 0 (or (parse-integer thing :junk-allowed t) 0))) @@ -60,3 +54,18 @@ always (gethash flag *flags*)) (values t flags)) (t (values t empty-flag))))) + +(defun host-dir (uri path) + (push + (hunchentoot:create-folder-dispatcher-and-handler uri path) + hunchentoot:*dispatch-table*)) + +;; This is uneccessarily complicated, no I'm not sorry +(defmacro content-type (types) + (cons 'progn + (mapcar (lambda (type) `(defun ,(car type) (reply) + (setf (tbnl:content-type* reply) ,(cadr type)))) + types))) +(content-type + ((@json "application/json") + (@plain "text/plain")))