lolisp/loli.lisp

(in-package :lolisp)

(defvar @html "text/html")
(defparameter *serb* nil
  "The hunchentoot acceptor (server) that will serve our handlers and
  files.")

(defmacro str (&rest strs)
  "Concatenate a list of strings `strs' to one string."
  `(concatenate 'string ,@strs))

(defmacro config-item (thing &aux (item (gensym)))
  "Get `thing' from the alist `config', error if it doesn't exist"
  `(let ((,item (assoc ,thing config)))
     (when (atom ,item)
       (error "No such config item"))
     (cdr ,item)))

(defun loli-link (rating)
  "Extract file_url from the JSON returned by `dex:get' and replace
escaped backslashes (\\\\/) with /.  

Use cl-rng to pick a random page from the lolibooru API"
  (cl-ppcre:register-groups-bind (url)
      ("(?:file_url\":\")(.*?)(?:\",)"
       (dex:get (str "https://lolibooru.moe/post/index.json?tags=rating:"
                     (or (cl-ppcre:scan-to-strings "^-?[sqe]$" rating) "s")
                     "+-3dcg+-rape&limit=1&page="
                     (write-to-string (cl-rng:crandom :limit 25000 :transform 'floor)))))
    (cl-ppcre:regex-replace-all "\\\\/" url "/")))

(defun based-loli (url)
  (str "data:image/jpeg;base64," (qbase64:encode-bytes (dex:get url))))

(henh:handle :get (loli :uri "/loli/") @html
    (rating)
  (cl-who:with-html-output-to-string (x)
    (:html
     (:head
      (:meta :charset "utf-8")
      (:meta :name "viewport" :content "width=device-width, initial-scale=1")
      (:title "lolisp")
      (:style "body{position:relative;}img{object-fit:contain;width:100%;height:100%;}#about{position:absolute;top:8px;right:16px}"))
     (:body
      (:img :src (based-loli (loli-link rating)))
      (:a :id "about" :href "/loli/about" "about")))
    x))

(defun configure ()
  (setf *serb* (make-instance 'hunchentoot:easy-acceptor
                              :port (config-item :port)
                              :address (config-item :host)
                              :document-root (config-item :document-root)
                              :error-template-directory (config-item :error-root)
                              ;; We (eval) these because quoting streams is werid.
                              ;; '*standard-ouput* is not of type stream why?
                              :access-log-destination (eval (config-item :access-log))
                              :message-log-destination (eval (config-item :error-log)))))

(defun start ()
  (handler-case (configure)
    (error (e) "Configuration failed: ~a" e))
  (when (null *serb*)
    (error "Serb is nill? ehh?"))
  (hunchentoot:start *serb*))

(defun stop ()
  (hunchentoot:stop *serb*))

(export '(configure
          start
          stop
          *serb*))