Infrastructure as a Service / Nemoptera

Artifact c8d7ba057b61a7a2aea42eee9fbf6716646d9058d536569e58642fee4a292581:

• File src/web/nemoptera_http.lfe — part of check-in [14d905c889] at 2026-11-08 15:25:21 on branch trunk — refactor(core): 重命名项目为 Nemoptera (user: pluto size: 2154)

(defmodule nemoptera_http
  (export all))

(defun html (code body)
  (let ((bin (list_to_binary (lists:flatten body))))
    `#(status ,code #M(#"content-type" #"text/html; charset=utf-8") ,bin)))

(defun xml (code type body)
  `#(status ,code #M(#"content-type" ,(list_to_binary type))
     ,(list_to_binary (lists:flatten body))))

(defun redirect (location)
  `#(status 302 #M(#"location" ,(list_to_binary location)) #""))

(defun redirect-cookie (req location value max-age)
  (let ((req2 (cowboy_req:set_resp_cookie
               (nemoptera_auth:cookie-name)
               (list_to_binary value)
               req
               (maps:from_list
                (list (tuple 'path "/")
                      (tuple 'http_only 'true)
                      (tuple 'same_site 'lax)
                      (tuple 'max_age max-age))))))
    `#(status 302 #M(#"location" ,(list_to_binary location)) #"" ,req2)))

(defun param (req name)
  (let ((posted (lookup (maps:get 'params req #M()) name)))
    (if (=:= "" posted)
        (lookup (maps:get 'parsed_qs req #M()) name)
        posted)))

(defun lookup (params name)
  (case (maps:find (list_to_binary name) params)
    (`#(ok ,value) (nemoptera_text:to-str value))
    (_
     (case (maps:find name params)
       (`#(ok ,value) (nemoptera_text:to-str value))
       (_ "")))))

(defun checked? (req name)
  (not (nemoptera_text:blank? (param req name))))

(defun binding (req name)
  (let ((bindings (maps:get 'bindings req #M())))
    (case (maps:find (list_to_binary name) bindings)
      (`#(ok ,value) (nemoptera_text:to-str value))
      (_
       (case (maps:find name bindings)
         (`#(ok ,value) (nemoptera_text:to-str value))
         (_ ""))))))

(defun binding-id (req)
  (nemoptera_text:to-int (binding req "id") 0))

(defun csrf-field (req)
  (let ((user (nemoptera_auth:current-user req)))
    (list "<input type=\"hidden\" name=\"csrf\" value=\""
          (nemoptera_ui:escape (nemoptera_auth:csrf user)) "\">")))

(defun csrf-ok? (req)
  (let ((user (nemoptera_auth:current-user req)))
    (and (not (=:= "" user))
         (nemoptera_auth:csrf-ok? user (param req "csrf")))))