Response objects

5 files changed, 142 insertions, 12 deletions

diff --git a/tests/response.scm b/tests/response.scm
new file mode 100644
index 0000000..e382169
--- /dev/null
+++ b/tests/response.scm
@@ -0,0 +1,20 @@
+(use-modules (srfi srfi-64)
+             (weeb response)
+             (weeb struct))
+
+(test-runner-current (test-runner-simple))
+
+(test-begin "weeb-response")
+
+(test-group "any->response"
+  (let ((resp (make-struct <response> 201 '() "created")))
+    (test-equal "identity" resp (any->response resp)))
+  (test-equal "string-only" (make-struct <response> 200 '() "hello")
+    (any->response "hello"))
+  (test-equal "list" (make-struct <response> 404 '() "not found")
+    (any->response '(404 "not found")))
+  (test-error "integer should trigger error" #t (any->response 500))
+  (test-error "list too short" #t (any->response '(200)))
+  (test-error "list too long" #t (any->response '(200 "body" "extra"))))
+
+(test-end)
diff --git a/weeb/main.scm b/weeb/main.scm
index 4c7e69f..fa4e9fc 100644
--- a/weeb/main.scm
+++ b/weeb/main.scm
@@ -23,10 +23,85 @@
   #:use-module (srfi srfi-11) ;; Temporary, probably
   #:use-module (weeb fcgi)
   #:use-module (weeb request)
+  #:use-module (weeb response)
   #:use-module (weeb router)
   #:use-module (weeb struct)
   #:export (weeb main))
 
+(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
@@ -51,13 +126,11 @@
     (make-struct <request> method uri '() headers (fcgi-read))))
 
 (define (show-headers request)
-  ;; TODO: Return a response object.
   (with-accessors (request headers)
-    (fcgi-display "Content-type: text/html\r\n\r\n")
-    (fcgi-display (format #f "~a" headers))))
+    (format #f "~a" headers)))
 
 (define (show-message request message)
-  (fcgi-display (format #f "~a" message)))
+  (format #f "~a" message))
 
 (define-router router
   ("/headers"        (GET) show-headers)
@@ -65,7 +138,8 @@
 
 (define (run-server)
   (while (zero? (fcgi-accept))
-    (let ((request (receive-request)))
-      (iter-routes request router))))
+    (let* ((request (receive-request))
+           (response (iter-routes request router)))
+      (write-response (any->response response)))))
 
 (run-server)
diff --git a/weeb/response.scm b/weeb/response.scm
new file mode 100644
index 0000000..71b8167
--- /dev/null
+++ b/weeb/response.scm
@@ -0,0 +1,38 @@
+;;; 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 response)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (weeb struct)
+  #:use-module (weeb sxml)
+  #:export (<response>
+            any->response))
+
+(define-struct <response>
+  code headers body)
+
+(define (any->response data)
+  (match data
+    ((? (cut instance-of? <> <response>)) data)
+    ((? string?) (make-struct <response> 200 '() data))
+    ((code body)
+     ;; (assert (and (list? headers) (string? body)))
+     (make-struct <response> code '() body))
+    (_ (error "could not coerce data to <response>" data))))
diff --git a/weeb/router.scm b/weeb/router.scm
index 575860b..689084a 100644
--- a/weeb/router.scm
+++ b/weeb/router.scm
@@ -69,11 +69,8 @@
       ((_ name route* ...)
        #'(define name (list (%handle-route route*) ...))))))
 
-(use-modules (weeb fcgi))
 (define (default-handler request)
-  (fcgi-display "Status: 404 Not Found\r\n")
-  (fcgi-display "Content-type: text/html\r\n\r\n")
-  (fcgi-display "Route not found.\n"))
+  '(404 "Route not found."))
 
 (define (iter-routes request router)
   (match router
diff --git a/weeb/struct.scm b/weeb/struct.scm
index 1f14d94..fbf90c3 100644
--- a/weeb/struct.scm
+++ b/weeb/struct.scm
@@ -41,9 +41,10 @@
 instantiate the record's fields."
   (apply (record-constructor type) args))
 
-(define (instance-of? type rtd)
+(define (instance-of? rtd type)
   "Returns true if RTD is an instance of TYPE."
-  ((record-predicate type) rtd))
+  (and (record? rtd)
+       ((record-predicate type) rtd)))
 
 ;; Bind the accessors for the fields of the record RTD to local
 ;; variables in BODY. RTD must be a record type descriptor.