From efd69e5fcaf0f825d85b1202d337a1a8ba47ef28 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Wed, 23 Feb 2022 11:00:40 -0600
Subject: added prefixes to apps

---
 example/lazybones-example.lisp |  1 +
 lazybones-hunchentoot.lisp     | 11 ++++++++---
 lazybones.asd                  |  2 +-
 lazybones.lisp                 | 18 +++++++++++++-----
 4 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/example/lazybones-example.lisp b/example/lazybones-example.lisp
index 018b4ae..902c2ef 100644
--- a/example/lazybones-example.lisp
+++ b/example/lazybones-example.lisp
@@ -32,6 +32,7 @@
 (lzb:provision-app ()
   :title "Lazybones Demo App"
   :version "0.0.0"
+  :prefix "/eg"
   :description "Just an API that defines some endpoints. These
   endpoints aren't meant to accomplish anything. Merely testing out
   the lazybones HTTP routing framework."
diff --git a/lazybones-hunchentoot.lisp b/lazybones-hunchentoot.lisp
index 24fe5e1..bb47d27 100644
--- a/lazybones-hunchentoot.lisp
+++ b/lazybones-hunchentoot.lisp
@@ -52,16 +52,21 @@
   stream.")
 
 (defmethod h:acceptor-dispatch-request ((%server% lazybones-acceptor) request)
-  (let ((%request-body-cache% nil)) 
+  (let* ((%request-body-cache% nil)
+         (route
+           (request-path request))         
+         (apps
+           (remove-if-not (lambda (app) (a:starts-with-subseq (lzb::app-prefix app) route))
+                          (acceptor-apps %server%))))
     (handler-case  
-        (loop for app in (acceptor-apps %server%)
+        (loop for app in apps
               for (endpoint . args) = (lzb::find-endpoint app request)
               when endpoint
                 return (lzb::run-endpoint endpoint args request h:*reply* app)
               ;; if no endpoint was found, call next method. 
               finally (let ((lzb:*request* request)
                             (lzb:*response* h:*reply*))
-                        (return (lzb:http-err nil 404))))
+                        (lzb:http-err 404)))
       (lzb::http-error (http-error)
         (let ((lzb:*request* request)
               (lzb:*response* h:*reply*))
diff --git a/lazybones.asd b/lazybones.asd
index 058257c..fcbce22 100644
--- a/lazybones.asd
+++ b/lazybones.asd
@@ -4,7 +4,7 @@
   :description "http route handling"
   :author "Colin Okay <okay@toyful.space>"
   :license  "AGPLv3"
-  :version "0.7.0"
+  :version "0.8.0"
   :serial t
   :depends-on (#:alexandria
                #:str
diff --git a/lazybones.lisp b/lazybones.lisp
index ec3d032..9d55fcf 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -75,6 +75,12 @@
     :initarg :vsn :initarg :version
     :initform "0.0.1"
     :type string)
+   (prefix
+    :accessor app-prefix
+    :initarg :prefix
+    :initform ""
+    :documentation "Effectively prepended to all endpoints for the
+    purposes of request handling.  E.g. \"/api\" is a good prefix." )
    (definitions
     :accessor app-definitions
     :initform (make-hash-table :test 'equal)
@@ -105,6 +111,7 @@
   (list 'setf 
         (ecase option
           ((:desc :description)  `(lazybones::app-description ,app))
+          (:prefix `(lazybones::app-prefix ,app))
           (:title `(lazybones::app-title ,app))
           (:version `(lazybones::app-version ,app))
           (:content-type `(lazybones::default-content-type ,app))
@@ -207,11 +214,16 @@ list of values, in the case of success, or NIL in the case of failure."
               into arguments
           finally (return (or arguments t)))))
 
+(defun strip-app-prefix (app path)
+  (multiple-value-bind (success suffix) (a:starts-with-subseq (app-prefix app) path :return-suffix t)
+    (unless success (error "~a is not prefixed by ~a" path (app-prefix app)))
+    suffix))
+
 (defun find-endpoint (app &optional (request *request*))
   (find-endpoint-matching-key
    app
    (request-method request)
-   (request-routekey request)))
+   (url-path->request-routekey (strip-app-prefix app (request-path request)))))
 
 (defun method-match-for-dispatch-p (req-method ep-method)
   "Either the arguments compare EQ or the first is :HEAD and the second is :GET."
@@ -256,10 +268,6 @@ ENDPOINT's handler function."
   "A routekey is used to match urls to endpoints that handle them."
   (str:split #\/ path))
 
-(defun request-routekey (request)
-  (url-path->request-routekey
-   (request-path request)))
-
 (defun parse-route-string-template (template)
   "Routes are of the form 
 
-- 
cgit v1.2.3