Initial commit

Safsaf is a Guile web framework, written using Claude Code running
Claude Opus 4.6, based off of the Guix Data Service, Nar Herder and
Guix Build Coordinator codebases.

safsaf.scm

@@ -0,0 +1,161 @@
+;; Safsaf, a Guile web framework
+;; Copyright (C) 2026  Christopher Baines <mail@cbaines.net>
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public License
+;; as published by the Free Software Foundation, either version 3 of
+;; the License, or (at your option) any later version.
+;;
+;; This program 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
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this program.  If not, see
+;; <https://www.gnu.org/licenses/>.
+
+(define-module (safsaf)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:use-module (fibers)
+  #:use-module (fibers conditions)
+  #:use-module (fibers scheduler)
+  #:use-module (knots)
+  #:use-module (knots web-server)
+  #:use-module (safsaf router)
+  #:export (run-safsaf
+            default-method-not-allowed-handler))
+
+(define (default-method-not-allowed-handler request allowed-methods)
+  "Return a 405 Method Not Allowed response with an Allow header listing
+ALLOWED-METHODS."
+  (values (build-response
+           #:code 405
+           #:headers `((allow . ,allowed-methods)
+                       (content-type text/plain)))
+          "Method Not Allowed"))
+
+(define* (make-handler compiled-routes reverse-routes
+                       #:key
+                       method-not-allowed?
+                       method-not-allowed-handler)
+  "Build a handler that dispatches to the matching route.
+Handler signature: (request body-port) -> (values response body).
+
+HEAD requests that have no explicit route are automatically handled by
+dispatching to the matching GET handler and discarding the response body.
+
+When METHOD-NOT-ALLOWED? is true, requests whose path matches a route but
+whose method does not receive a 405 response via METHOD-NOT-ALLOWED-HANDLER."
+  (let ((catch-all-handler (compiled-route-handler
+                            (last compiled-routes))))
+
+    (define (run-handler handler bindings request body-port)
+      (parameterize ((current-route-params bindings)
+                     (current-reverse-routes reverse-routes))
+        (handler request body-port)))
+
+    (define (check-405-or-catch-all handler bindings
+                                    path-segments request body-port)
+      (if method-not-allowed?
+          (let* ((allowed (find-allowed-methods compiled-routes
+                                                path-segments))
+                 ;; GET implies HEAD via auto-HEAD handling.
+                 (allowed (if (and (memq 'GET allowed)
+                                   (not (memq 'HEAD allowed)))
+                              (cons 'HEAD allowed)
+                              allowed)))
+            (if (null? allowed)
+                (run-handler handler bindings request body-port)
+                (method-not-allowed-handler request allowed)))
+          (run-handler handler bindings request body-port)))
+
+    (lambda (request body-port)
+      (let* ((method (request-method request))
+             (path-segments (split-and-decode-uri-path
+                             (uri-path (request-uri request))))
+             (handler bindings (match-route compiled-routes
+                                            method path-segments)))
+        (cond
+         ;; Direct match — dispatch normally.
+         ((not (eq? handler catch-all-handler))
+          (run-handler handler bindings request body-port))
+
+         ;; HEAD with no explicit route — try GET, discard body.
+         ((eq? method 'HEAD)
+          (let ((get-handler get-bindings
+                             (match-route compiled-routes
+                                          'GET path-segments)))
+            (if (eq? get-handler catch-all-handler)
+                ;; No GET route either — 405 or catch-all.
+                (check-405-or-catch-all handler bindings
+                                        path-segments request body-port)
+                ;; Run GET handler, keep response headers, discard body.
+                (let ((response _body
+                                (run-handler get-handler get-bindings
+                                             request body-port)))
+                  (values response "")))))
+
+         ;; Catch-all matched — check for 405.
+         (else
+          (check-405-or-catch-all handler bindings
+                                  path-segments request body-port)))))))
+
+(define* (run-safsaf routes
+                     #:key
+                     (host #f)
+                     (port 8080)
+                     (method-not-allowed? #t)
+                     (method-not-allowed-handler
+                      default-method-not-allowed-handler)
+                     (connection-buffer-size #f))
+  "Start a Safsaf web server.
+
+ROUTES is a list of routes and route-groups (as returned by component
+constructors).  The last route must be a catch-all so that every
+request is handled.
+
+HEAD requests are handled automatically: when no explicit HEAD route
+matches, the matching GET handler runs and its response body is
+discarded.  Explicit HEAD routes always take precedence.
+
+When METHOD-NOT-ALLOWED? is #t (the default), requests that match a
+route's path but not its method receive a 405 response with an Allow
+header.  METHOD-NOT-ALLOWED-HANDLER is a procedure
+(request allowed-methods) -> (values response body) that produces the
+405 response; the default returns plain text.
+
+When called outside a Fibers scheduler, sets up a scheduler, starts
+the HTTP server, and blocks until Ctrl-C.  When called inside an
+existing scheduler (e.g. within run-fibers), just starts the HTTP
+server and returns immediately — the caller manages the lifecycle."
+  (let* ((compiled reverse-routes (compile-routes routes))
+         (handler  (make-handler compiled reverse-routes
+                                 #:method-not-allowed? method-not-allowed?
+                                 #:method-not-allowed-handler
+                                 method-not-allowed-handler)))
+    (define (start-server)
+      (apply run-knots-web-server
+             handler
+             #:host host
+             #:port port
+             #:call-handler-with-body-port? #t
+             (if connection-buffer-size
+                 (list #:connection-buffer-size connection-buffer-size)
+                 '())))
+
+    (if (current-scheduler)
+        ;; Already inside run-fibers — just start the server.
+        (start-server)
+        ;; Standalone — manage the full lifecycle.
+        (run-fibers
+         (lambda ()
+           (start-server)
+           (let ((quit-cvar (make-condition)))
+             (call-with-sigint
+              (lambda () (wait quit-cvar))
+              quit-cvar)))))))