Suros

;;; suros.el --- a personal web server

;; made in the United States by emsenn

;; Author: emsenn <emsenn@emsenn.net>
;; Keywords: server, ActivityPub
;; Version: 0.1.0

;; This program was made by emsenn in the United States.
;; To the extent possible under law, they have waived all
;; copyright and related or neighboring rights to this program.
;; This program was made for the good of the commons.

;;; Commentary:

;; Suros.el provides a web server that provides objects rendered
;; from Elisp data and Org-mode files.

;;; Code:

;; Suros Data
;; Customize this, carefully, by hand.
(setq
 suros-config
 (ht
  ("actor-public-key" "-----BEGIN PUBLIC KEY-----\nMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAoo+p0r7lPkESdf9JQ/cw\nBFpQQd8NDddM++Q4mqROliq//8U7UBe9c7AQTfnRz3jc5zs8e+kL0L0tFywv2wwS\nDBp4hq5fQuyNMq/XebEveYjtu/Ckw5alcrtwKI+ArdJJ3rGaGzKLtNDRrxoc40u1\nWnGulzsxNzjoJy+OvPgjjdqaBB55k+oKL6jC/MI5WQN86FYEG/uMXkRSXIJbbB2M\nZMOmLjBi3VlVJ/p9robd7dImb4jhP/9YHQ/wFEzRe3ekD4KKPUkhpM63z1WjVh8n\nHPgulhB6OrAu0phwCozA3TZvg368GJKle6GdxHyLH3dnBvwue3AhyNOYXeVuK0fn\nhwIDAQAB\n-----END PUBLIC KEY-----")
  ("base-url" "suros-emsenn.pagekite.me")
  ("language-code" "en")
  ("make-things" '("words" . "computer instructions"))
  ("make-verb" "craft")
  ("preferred-name" "emsenn")
  ("proper-name" "emsenn")
  ("server-description" "an early-alpha personal webserver")
  ("server-name" "suros")
  ("server-source-link" "https://emsenn.neocities.org/suros.html")
  ("username" "emsenn")
  ("template-directory" "~/src/suros/mustache/")
  ("web-port" 9000)))

;; Suros Functions
;; Probably don't touch these.
(setq suros-server-object nil)
  (defun suros-start ()
    "This function starts your suros."
    (interactive)
    (let ((config suros-config))
      (if (suros-validate-config config)
          (setq suros-server-object
                (ws-start
                 '(((:POST . ".*") .
                    (lambda (request) (suros-read-post-request request)))
                   ((:GET . ".*") .
                    (lambda (request) (suros-read-get-request request)))
                   ((:HEAD . ".*") .
                    (lambda (request)
                      (with-slots (process headers) request
                        (ws-response-header process 200 '("Content-type" . "text/plain"))))))
                 (ht-get suros-config "web-port")
                 (get-buffer-create "suros-log"))))))
(defun suros-stop ()
  "This function stops your suros."
  (interactive)
  (ws-stop suros-server-object))
(defun suros-read-get-request (request)
  (with-slots (process headers) request
    (let ((path (substring (cdr (assoc :GET headers)) 1))
          (context suros-config))
      (if (equal path "")
          (suros-send-html-object process (suros-render "index.html" headers context))
        (if (ht-contains? (suros-flippen-flatten-ht suros-builtin-objects) path)
            (ht-get (suros-flippen-flatten-ht suros-builtin-objects) path)
          (suros-send-html-object process (concat "No page at " path ". AKA a 404")))))))
(defun suros-read-post-request (request)
  (with-slots (process headers) request
    (process-send-string process "suros has read your POST request.")))
(defun suros-read-head-request (request)
  (with-slots (process headers) request
    (ws-response-header process 200 '("Content-type" . "text/plain"))))
(defun suros-send-html-object (process rendering)
  (ws-response-header process 200 '("Content-type" . "text/html"))
  (process-send-string process rendering))
(defun suros-send-json-object (process rendering)
  (ws-response-header process 200 '("Content-type" . "application/json"))
  (process-send-string process rendering))

(defun suros-template-p (template)
  "Returns true if there is a file at the given template name. Does no checking of validity."
    (file-exists-p (concat (gethash "template-directory" suros-config) template ".mustache")))
(defun suros-validate-config (config)
  "Returns true. Pretty rubbish validator."
  t)
(defun suros-flippen-flatten-ht (htable)
  (ht<-alist (-flatten-n 1 (append
                            (ht-map (lambda (key vals)
                                      (mapcar (lambda (val) (cons val key)) vals))
                                    htable)))))
;; End of Suros Code
(provide 'suros)
;;; suros.el ends here