Infrastructure as a Service / Nemoptera

Artifact e54bb23b9019846078c9f695322d3dcb02a59e058599f4bf4c3d03202de8c4d6:

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

(defmodule nemoptera_auth
  (export all))

(defun cookie-name () #"nemoptera_session")
(defun ttl-seconds () 604800)
(defun fail-limit () 5)
(defun lock-seconds () 900)

(defun login (username password)
  (cond
    ((locked?) `#(error "Too many attempts. Try again in 15 minutes."))
    ((check username password)
     (reset-fails)
     `#(ok ,(session-value username)))
    ('true
     (register-fail)
     `#(error "Unknown username or password."))))

(defun check (username password)
  (case (nemoptera_db:q "SELECT password_hash FROM admin_user WHERE username=?;" (list username))
    (`((,hash)) (nemoptera_crypto:verify-password password hash))
    (_ 'false)))

(defun session-value (username)
  (let* ((expires (+ (os:system_time 'second) (ttl-seconds)))
         (payload (lists:flatten (io_lib:format "~s|~p" (list username expires))))
         (sig (sign payload)))
    (lists:flatten (list (b64 payload) "." sig))))

(defun verify-value (value)
  (case (catch (verify-unsafe value))
    (`#(ok ,username) `#(ok ,username))
    (_ 'error)))

(defun verify-unsafe (value)
  (case (string:split (nemoptera_text:to-str value) "." 'leading)
    (`(,payload-b64 ,sig)
     (let ((payload (binary_to_list (unb64 payload-b64))))
       (if (=:= sig (sign payload))
           (case (string:split payload "|" 'leading)
             (`(,username ,expires-s)
              (if (> (list_to_integer expires-s) (os:system_time 'second))
                  `#(ok ,username)
                  'error))
             (_ 'error))
           'error)))
    (_ 'error)))

(defun verify-request (req)
  (case (catch (cowboy_req:parse_cookies req))
    (cookies (when (is_list cookies))
      (case (proplists:get_value (cookie-name) cookies)
        ('undefined 'error)
        (value (verify-value value))))
    (_ 'error)))

(defun current-user (req)
  (case (verify-request req)
    (`#(ok ,username) username)
    (_ "")))

(defun csrf (username)
  (sign (lists:flatten (list "csrf|" username))))

(defun csrf-ok? (username token)
  (=:= (nemoptera_text:to-str token) (csrf username)))

(defun sign (payload)
  (b64 (crypto:mac 'hmac 'sha256 (nemoptera_crypto:secret) payload)))

(defun b64 (data)
  (binary_to_list
   (base64:encode (to-bin data)
                  #M(mode urlsafe padding false))))

(defun unb64 (data)
  (base64:decode (list_to_binary (nemoptera_text:to-str data))
                 #M(mode urlsafe padding false)))

(defun to-bin (value)
  (if (is_binary value) value (list_to_binary (nemoptera_text:to-str value))))

(defun locked? ()
  (> (maps:get 'lock_until (persistent_term:get 'nemoptera_auth_fails #M()) 0)
     (os:system_time 'second)))

(defun register-fail ()
  (let* ((state (persistent_term:get 'nemoptera_auth_fails #M()))
         (count (+ (maps:get 'count state 0) 1))
         (next (maps:put 'count count state)))
    (persistent_term:put 'nemoptera_auth_fails
                         (if (>= count (fail-limit))
                             (maps:put 'lock_until (+ (os:system_time 'second) (lock-seconds)) next)
                             next))))

(defun reset-fails ()
  (persistent_term:erase 'nemoptera_auth_fails))