From 25431da247c33c66529c373e13919c87d8e86c55 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Thu, 21 Oct 2021 10:53:28 +0200
Subject: Verbose HTTP router

---
 src/scm/webid-oidc/server/endpoint.scm | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/src/scm/webid-oidc/server/endpoint.scm b/src/scm/webid-oidc/server/endpoint.scm
index 9a19ceb..e38bb5e 100644
--- a/src/scm/webid-oidc/server/endpoint.scm
+++ b/src/scm/webid-oidc/server/endpoint.scm
@@ -151,6 +151,7 @@
                    (list routed)))))))
 
 (define-method (relevant? (endpoint <endpoint>) request)
+  (format (current-error-port) "Is ~s relevant for ~s?\n" endpoint request)
   (let ((requested-host
          (match (request-host request)
            ((or ((? string? host) . _)
@@ -160,22 +161,34 @@
         (requested-path
          (split-and-decode-uri-path
           (uri-path (request-uri request)))))
+    (format (current-error-port) "Requested host: ~s, requested path: ~s\n" requested-host requested-path)
     (and (or (not (host endpoint))
              (equal? (host endpoint) requested-host))
          (let check-path ((path (split-and-decode-uri-path (path endpoint)))
                           (requested-path requested-path))
+           (format (current-error-port) "Checking if path ~s is compatible with requested path ~s…\n" path requested-path)
            (match `(,path ,requested-path)
-             ((() _) #t)
-             ((_ ()) #f)
+             ((() _)
+              (format (current-error-port) "Yes.\n")
+              #t)
+             ((_ ())
+              (format (current-error-port) "No.\n")
+              #f)
              (((element path ...)
                (requested-element requested-path ...))
+              (unless (equal? element requested-element)
+                (format (current-error-port) "No (~s vs ~s)\n" element requested-element))
               (and (equal? element requested-element)
+                   (format (current-error-port) "Maybe…\n")
                    (check-path path requested-path))))))))
 
 (define-method (handle (endpoint <router>) request request-body)
+  (format (current-error-port) "Handling in a router: ~s ~s\n" request request-body)
   (let find-router ((routed (routed endpoint)))
+    (format (current-error-port) "Handling in a router: ~s ~s, ~s\n" request request-body routed)
     (match routed
       (()
+       (format (current-error-port) "Handling in a router: ~s ~s, no more routed\n" request request-body)
        (raise-exception
         (make-exception
          (make-web-exception 404 (W_ "Not Found"))
@@ -183,6 +196,7 @@
       (((and router
              (? (cute relevant? <> request)))
         _ ...)
+       (format (current-error-port) "Handling in a router: ~s ~s, found ~s\n" request request-body router)
        (handle router request request-body))
       ((_ routed ...)
        (find-router routed)))))
-- 
cgit v1.2.3