TFC/tfcconnection
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Making the tfc-api in lisp use ningle rather than raw hunchentoot

Browse source
This commit is contained in:
Chris Cochrun 2024-09-19 14:37:27 -05:00
parent 038b813a0b
commit 228626b65d
3 changed files with 66 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
flake.nix
View file

@ -28,6 +28,9 @@
cl_plus_ssl
fiveam
slite
clack
woo
ningle
pkgs.openssl
pkgs.openssl.out
pkgs.openssl.dev
@ -68,7 +71,17 @@
in
{
devShell = import ./shell.nix { inherit pkgs; };
devShell = pkgs.mkShell {
name = "tfc-api";
version = "0.0.1";
src = src;
nativeBuildInputs = nbi;
buildInputs = bi;
nativeLibs = nativeLibs;
shellHook = ''
export LD_LIBRARY_PATH="$LD_LIBRARY_PATH:${pkgs.lib.makeLibraryPath nativeLibs}"
'';
};
packages.default = pkgs.rustPlatform.buildRustPackage {
pname = "api";
version = "0.0.1";

4
layouts/shortcodes/health-form.html
View file

@ -78,7 +78,7 @@
// Can now start using this in production IF,
// I get the server running on the server
/* let base = "https://api.tfcconnection.org/health-form"; */
let base = "http://localhost:4242/health-form";
let base = "http://localhost:5000/health-form";
fetch(base, {
method: "POST",
body: data
@ -217,7 +217,7 @@
<div id="health-form" class="form text-lg w-full">
<form id='form'
hx-post="https://tfcconnection.org/api/health-form"
hx-post="http://localhost:5000/health-form"
hx-encoding="multipart/form-data"
autocomplete="on"
method="post"

81
src/main.lisp
View file

@ -8,6 +8,8 @@
(asdf:load-system 'cl-smtp)
(asdf:load-system 'log4cl)
(asdf:load-system 'fiveam)
(asdf:load-system 'clack)
(asdf:load-system 'ningle)
(defpackage tfcserver
(:use :cl :com.inuoe.jzon :spinneret :serapeum))
@ -16,12 +18,7 @@
(log:config :daily "/tmp/tfc-%Y%m%d.log")
(defvar *server*)
(defun start-server (port)
(setq *server*
(hunchentoot:start
(make-instance 'hunchentoot:easy-acceptor
:port port))))
(defvar *app* (make-instance 'ningle:app))
(defparameter *mail-css*
'((table :border-collapse "collapse" :width "100%")
@ -406,7 +403,7 @@ with the image attached"
(not (cl-smtp:send-email
"mail.tfcconnection.org"
"no-reply@mail.tfcconnection.org"
'("chris@tfcconnection.org" "ethan@tfcconnection.org")
'("chris@tfcconnection.org")
(format nil "~a ~a filled out a Health Form!" first-name last-name)
(format nil "Health Form for ~a ~a" first-name last-name)
:display-name "TFC ADMIN"
@ -430,48 +427,42 @@ with the image attached"
"-" (car row) " ")))
(:td (cdr row))))))))))))
(tbnl:define-easy-handler (health-form :uri "/health-form") ()
(setf (tbnl:header-out :access-control-expose-headers) "*")
(let* ((data (tbnl:post-parameters* tbnl:*request*))
(registration (cdr (assoc "registration" data :test 'string=)))
(image (cdr (assoc "image" data :test 'string=)))
(first-name (cdr (assoc "first-name" data :test 'string=)))
(last-name (cdr (assoc "last-name" data :test 'string=)))
(image (cdr (assoc "image" data :test 'string=)))
(attachment nil))
(loop :for d :in data
:do (progn
(if (string= "first-name" (car d))
(progn
(setf first-name (cdr d))))
(if (string= "last-name" (car d))
(progn
(setf last-name (cdr d))))
(if (string= "image" (car d))
(let ((path (path-join
hunchentoot:*tmp-directory*
(format nil "~a_~a.~a" first-name last-name
(cadr (uiop:split-string
(car (last d 2)) :separator "."))))))
(uiop:copy-file
(cadr d)
(path-join
hunchentoot:*tmp-directory*
(format nil "~a_~a.~a" first-name last-name
(cadr (uiop:split-string
(car (last d 2)) :separator ".")))))
(setf attachment path)
(log:info attachment)))))
(log:info data)
(when data
(mail-health-form data attachment)
(setf (ningle:route *app* "/health-form" :method :post)
#'(lambda (params)
(log:info params)
(let* ((image-element (assoc "image" params :test 'string=))
(registration (cdr (assoc "registration" params :test 'string=)))
(first-name (cdr (assoc "first-name" params :test 'string=)))
(last-name (cdr (assoc "last-name" params :test 'string=)))
(image (nth 1 image-element))
(filename (nth 2 image-element)))
(serapeum:write-stream-into-file
image (pathname "frodo.jpg")
:if-exists :supersede
:if-does-not-exist :create)
(log:info filename)
(bt:make-thread
(lambda ()
(mail-health-form params (pathname filename))
(log:info "Sent email"))
:name "health-form")
(setf (lack.response:response-headers ningle:*response*)
(append (lack.response:response-headers ningle:*response*)
(list :access-control-expose-headers "*")))
(log:info registration)
(cond ((string= registration "now")
(log:info "Sending them to pay now")
(setf (hunchentoot:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JPJ"))
(setf (lack.response:response-headers ningle:*response*)
(append (lack.response:response-headers ningle:*response*)
(list :hx-redirect
"https://secure.myvanco.com/L-Z772/campaign/C-13JPJ"))))
((string= registration "full")
(log:info "Sending them to pay full amount")
(setf (tbnl:header-out :HX-Redirect) "https://secure.myvanco.com/L-Z772/campaign/C-13JQE"))
((string= registration "later")
(setf (lack.response:response-headers ningle:*response*)
(append (lack.response:response-headers ningle:*response*)
(list :hx-redirect
"https://secure.myvanco.com/L-Z772/campaign/C-13JQE"))))
(t
(log:info "Sending the health form thank you snippet")
(with-html-string
(:div