;;; Weeb --- Web microframework for GNU Guile
;;; Copyright © 2026 Jakob Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This file is part of Weeb.
;;;
;;; Weeb is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Weeb is distributed in the hope that it will be useful, but WITHOUT
;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General
;;; Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with Weeb. If not, see <https://www.gnu.org/licenses/>.

(define-module (weeb main)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11) ;; Temporary, probably
  #:use-module (srfi srfi-26)
  #:use-module (system repl error-handling)
  #:use-module (weeb fcgi)
  #:use-module (weeb request)
  #:use-module (weeb response)
  #:use-module (weeb router)
  #:use-module (weeb struct)
  #:use-module (weeb sxml)
  #:export (%enable-web-console
            run-server))

(define %enable-web-console
  (make-parameter #f))

(define status-codes
  '((100 . "Continue")
    (101 . "Switching Protocols")
    (102 . "Processing")
    (200 . "OK")
    (201 . "Created")
    (202 . "Accepted")
    (203 . "Non-Authoritative Information")
    (204 . "No Content")
    (205 . "Reset Content")
    (206 . "Partial Content")
    (207 . "Multi-Status")
    (208 . "Already Reported")
    (226 . "IM Used")
    (300 . "Multiple Choices")
    (301 . "Moved Permanently")
    (302 . "Found")
    (303 . "See Other")
    (304 . "Not Modified")
    (305 . "Use Proxy")
    (306 . "Reserved")
    (307 . "Temporary Redirect")
    (308 . "Permanent Redirect")
    (400 . "Bad Request")
    (401 . "Unauthorized")
    (402 . "Payment Required")
    (403 . "Forbidden")
    (404 . "Not Found")
    (405 . "Method Not Allowed")
    (406 . "Not Acceptable")
    (407 . "Proxy Authentication Required")
    (408 . "Request Timeout")
    (409 . "Conflict")
    (410 . "Gone")
    (411 . "Length Required")
    (412 . "Precondition Failed")
    (413 . "Request Entity Too Large")
    (414 . "Request-URI Too Long")
    (415 . "Unsupported Media Type")
    (416 . "Requested Range Not Satisfiable")
    (417 . "Expectation Failed")
    (422 . "Unprocessable Entity")
    (423 . "Locked")
    (424 . "Failed Dependency")
    (426 . "Upgrade Required")
    (428 . "Precondition Required")
    (429 . "Too Many Requests")
    (431 . "Request Header Fields Too Large")
    (500 . "Internal Server Error")
    (501 . "Not Implemented")
    (502 . "Bad Gateway")
    (503 . "Service Unavailable")
    (504 . "Gateway Timeout")
    (505 . "HTTP Version Not Supported")
    (506 . "Variant Also Negotiates (Experimental)")
    (507 . "Insufficient Storage")
    (508 . "Loop Detected")
    (510 . "Not Extended")
    (511 . "Network Authentication Required")))

(define (write-response response)
  (with-accessors (response code headers body)
    (fcgi-display (format #f "Status: ~a ~a\r\n" code (assv-ref status-codes code)))
    (let ((headers (if (assoc 'content-type headers)
                       headers
                       `((content-type . "text/html") ,@headers))))
      (fcgi-display
       (string-join (map (match-lambda
                           ((key . value) (format #f "~a: ~a" key value)))
                         headers)
                    "\r\n")))
    (fcgi-display "\r\n\r\n")
    (fcgi-display body)))

(define (receive-request)
  (define string->method
    (match-lambda
      ("GET"  'GET)
      ("POST" 'POST)))
  (define (strip-query-string uri)
    (let ((match-object (string-match "^(/.*)\\?" uri)))
      (if match-object
          (match:substring match-object 1)
          uri)))
  ;; According to RFC 9110, header names must be treated as case-insensitive.
  (define headers
    (filter-map
     (lambda (var)
       (let ((match-object (string-match "HTTP_(.*)=(.*)" var)))
         (if match-object
             `(,(string->symbol
                 (string-downcase
                  (string-map (lambda (c) (if (char=? c #\_) #\- c))
                              (match:substring match-object 1))))
               .
               ,(match:substring match-object 2))
             #f)))
     (environ)))
  (let* ((method (string->method (getenv "REQUEST_METHOD")))
         (query  (parse-form-urlencoded (getenv "QUERY_STRING")))
         (uri    (strip-query-string (getenv "REQUEST_URI"))))
    (make-struct <request> method uri query headers (fcgi-read))))

(define (render-generic-500)
  (sxml->html
   `(html
     (body
      (h1 "Error")))))

(define (render-web-console stack)
  (sxml->html
   `(html
     (body
      (h1 "Error")
      (pre ,(call-with-output-string (cut display-backtrace stack <>)))))))

(define (handle-errors thunk)
  (let ((stack #f))
    (call-with-error-handling
     thunk
     #:pass-keys '(quit interrupt)
     #:on-error
     (begin
       (set! stack (make-stack #t))
       'pass)
     #:post-error
     (lambda _
       (list 500 (if (%enable-web-console)
                     (render-web-console stack)
                     (render-generic-500)))))))

(define (run-server router)
  (while (zero? (fcgi-accept))
    (write-response
     (any->response
      (handle-errors
       (lambda ()
         (let* ((request (receive-request)))
           (iter-routes request router))))))))