initial work developing hunchentoot backend

6 files changed, 196 insertions, 21 deletions

diff --git a/clpmfile b/clpmfile
index 75cfbbd..9282378 100644
--- a/clpmfile
+++ b/clpmfile
@@ -4,3 +4,4 @@
 (:source "quicklisp" :url "https://beta.quicklisp.org/dist/quicklisp.txt" :type :quicklisp)
 
 (:asd "lazybones.asd")
+(:asd "lazybones-hunchentoot.asd")
diff --git a/clpmfile.lock b/clpmfile.lock
index d63a8e6..650a906 100644
--- a/clpmfile.lock
+++ b/clpmfile.lock
@@ -9,6 +9,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 :sources
+(:implicit-file :type :file-system :system-files ("lazybones-hunchentoot.asd"))
 (:implicit-file :type :file-system :system-files ("lazybones.asd"))
 ("quicklisp" :url "https://beta.quicklisp.org/dist/quicklisp.txt" :type
  :quicklisp)
@@ -19,6 +20,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 :requirements
+(:asd-file :name "lazybones-hunchentoot.asd")
 (:asd-file :name "lazybones.asd")
 
 
@@ -31,9 +33,11 @@
 ("babel" :version "2020-09-25" :source "quicklisp" :systems ("babel"))
 ("bordeaux-threads" :version "2020-06-10" :source "quicklisp" :systems
  ("bordeaux-threads"))
-("cffi" :version "2021-04-11" :source "quicklisp" :systems ("cffi"))
+("cffi" :version "2021-04-11" :source "quicklisp" :systems
+ ("cffi" "cffi-grovel" "cffi-toolchain"))
 ("chunga" :version "2020-04-27" :source "quicklisp" :systems ("chunga"))
 ("cl+ssl" :version "2021-12-30" :source "quicklisp" :systems ("cl+ssl"))
+("cl-annot" :version "2015-06-08" :source "quicklisp" :systems ("cl-annot"))
 ("cl-base64" :version "2020-10-16" :source "quicklisp" :systems ("cl-base64"))
 ("cl-change-case" :version "2021-04-11" :source "quicklisp" :systems
  ("cl-change-case"))
@@ -41,16 +45,28 @@
 ("cl-ppcre" :version "2019-05-21" :source "quicklisp" :systems
  ("cl-ppcre" "cl-ppcre-unicode"))
 ("cl-str" :version "2021-05-31" :source "quicklisp" :systems ("str"))
+("cl-syntax" :version "2015-04-07" :source "quicklisp" :systems
+ ("cl-syntax" "cl-syntax-annot"))
 ("cl-unicode" :version "2021-02-28" :source "quicklisp" :systems ("cl-unicode"))
+("closer-mop" :version "2021-12-30" :source "quicklisp" :systems ("closer-mop"))
+("fast-io" :version "2020-09-25" :source "quicklisp" :systems ("fast-io"))
 ("flexi-streams" :version "2021-08-07" :source "quicklisp" :systems
  ("flexi-streams"))
 ("hunchentoot" :version "2020-06-10" :source "quicklisp" :systems
  ("hunchentoot"))
+("jonathan" :version "2020-09-25" :source "quicklisp" :systems ("jonathan"))
+("lazybones-hunchentoot.asd" :version :newest :source :implicit-file :systems
+ ("lazybones-hunchentoot"))
 ("lazybones.asd" :version :newest :source :implicit-file :systems ("lazybones"))
 ("md5" :version "2021-06-30" :source "quicklisp" :systems ("md5"))
+("named-readtables" :version "2021-12-09" :source "quicklisp" :systems
+ ("named-readtables"))
+("proc-parse" :version "2019-08-13" :source "quicklisp" :systems ("proc-parse"))
 ("rfc2388" :version "2018-08-31" :source "quicklisp" :systems ("rfc2388"))
 ("split-sequence" :version "2021-05-31" :source "quicklisp" :systems
  ("split-sequence"))
+("static-vectors" :version "2021-06-30" :source "quicklisp" :systems
+ ("static-vectors"))
 ("trivial-backtrace" :version "2020-06-10" :source "quicklisp" :systems
  ("trivial-backtrace"))
 ("trivial-features" :version "2021-12-09" :source "quicklisp" :systems
@@ -59,6 +75,8 @@
  ("trivial-garbage"))
 ("trivial-gray-streams" :version "2021-01-24" :source "quicklisp" :systems
  ("trivial-gray-streams"))
+("trivial-types" :version "2012-04-07" :source "quicklisp" :systems
+ ("trivial-types"))
 ("usocket" :version "2019-12-27" :source "quicklisp" :systems ("usocket"))
 
 
@@ -67,27 +85,42 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 :reverse-dependencies
-("alexandria" ((:system :name "lazybones") (:system :name "alexandria"))
+("alexandria" ((:system :name "static-vectors") (:system :name "alexandria"))
+ ((:system :name "proc-parse") (:system :name "alexandria"))
+ ((:system :name "lazybones") (:system :name "alexandria"))
  ((:system :name "hunchentoot") (:system :name "alexandria"))
+ ((:system :name "fast-io") (:system :name "alexandria"))
  ((:system :name "cl-fad") (:system :name "alexandria"))
+ ((:system :name "cl-annot") (:system :name "alexandria"))
  ((:system :name "cl+ssl") (:system :name "alexandria"))
+ ((:system :name "cffi-grovel") (:system :name "alexandria"))
  ((:system :name "cffi") (:system :name "alexandria"))
  ((:system :name "bordeaux-threads") (:system :name "alexandria"))
  ((:system :name "babel") (:system :name "alexandria")))
 
-("babel" ((:system :name "cffi") (:system :name "babel")))
+("babel" ((:system :name "proc-parse") (:system :name "babel"))
+ ((:system :name "jonathan") (:system :name "babel"))
+ ((:system :name "cffi") (:system :name "babel")))
 
 ("bordeaux-threads"
  ((:system :name "hunchentoot") (:system :name "bordeaux-threads"))
  ((:system :name "cl-fad") (:system :name "bordeaux-threads"))
  ((:system :name "cl+ssl") (:system :name "bordeaux-threads")))
 
-("cffi" ((:system :name "cl+ssl") (:system :name "cffi")))
+("cffi" ((:system :name "static-vectors") (:system :name "cffi"))
+ ((:system :name "static-vectors") (:system :name "cffi-grovel"))
+ ((:system :name "cl+ssl") (:system :name "cffi"))
+ ((:system :name "cffi-toolchain") (:system :name "cffi"))
+ ((:system :name "cffi-grovel") (:system :name "cffi"))
+ ((:system :name "cffi-grovel") (:system :name "cffi-toolchain")))
 
 ("chunga" ((:system :name "hunchentoot") (:system :name "chunga")))
 
 ("cl+ssl" ((:system :name "hunchentoot") (:system :name "cl+ssl")))
 
+("cl-annot" ((:system :name "jonathan") (:system :name "cl-annot"))
+ ((:system :name "cl-syntax-annot") (:system :name "cl-annot")))
+
 ("cl-base64" ((:system :name "hunchentoot") (:system :name "cl-base64")))
 
 ("cl-change-case" ((:system :name "str") (:system :name "cl-change-case")))
@@ -97,6 +130,7 @@
 ("cl-ppcre" ((:system :name "str") (:system :name "cl-ppcre"))
  ((:system :name "str") (:system :name "cl-ppcre-unicode"))
  ((:system :name "lazybones") (:system :name "cl-ppcre"))
+ ((:system :name "jonathan") (:system :name "cl-ppcre"))
  ((:system :name "hunchentoot") (:system :name "cl-ppcre"))
  ((:system :name "cl-unicode") (:system :name "cl-ppcre"))
  ((:system :name "cl-ppcre-unicode") (:system :name "cl-ppcre"))
@@ -105,22 +139,44 @@
 
 ("cl-str" ((:system :name "lazybones") (:system :name "str")))
 
+("cl-syntax" ((:system :name "jonathan") (:system :name "cl-syntax"))
+ ((:system :name "jonathan") (:system :name "cl-syntax-annot"))
+ ((:system :name "cl-syntax-annot") (:system :name "cl-syntax")))
+
 ("cl-unicode" ((:system :name "cl-ppcre-unicode") (:system :name "cl-unicode")))
 
+("closer-mop" ((:system :name "lazybones") (:system :name "closer-mop")))
+
+("fast-io" ((:system :name "jonathan") (:system :name "fast-io")))
+
 ("flexi-streams"
  ((:system :name "hunchentoot") (:system :name "flexi-streams"))
  ((:system :name "cl+ssl") (:system :name "flexi-streams")))
 
-("hunchentoot" ((:system :name "lazybones") (:system :name "hunchentoot")))
+("hunchentoot"
+ ((:system :name "lazybones-hunchentoot") (:system :name "hunchentoot")))
+
+("jonathan" ((:system :name "lazybones") (:system :name "jonathan")))
 
-("lazybones.asd" (t (:asd-file :name "lazybones.asd")))
+("lazybones-hunchentoot.asd" (t (:asd-file :name "lazybones-hunchentoot.asd")))
+
+("lazybones.asd"
+ ((:system :name "lazybones-hunchentoot") (:system :name "lazybones"))
+ (t (:asd-file :name "lazybones.asd")))
 
 ("md5" ((:system :name "hunchentoot") (:system :name "md5")))
 
+("named-readtables"
+ ((:system :name "cl-syntax") (:system :name "named-readtables")))
+
+("proc-parse" ((:system :name "jonathan") (:system :name "proc-parse")))
+
 ("rfc2388" ((:system :name "hunchentoot") (:system :name "rfc2388")))
 
 ("split-sequence" ((:system :name "usocket") (:system :name "split-sequence")))
 
+("static-vectors" ((:system :name "fast-io") (:system :name "static-vectors")))
+
 ("trivial-backtrace"
  ((:system :name "hunchentoot") (:system :name "trivial-backtrace")))
 
@@ -133,9 +189,13 @@
 
 ("trivial-gray-streams"
  ((:system :name "flexi-streams") (:system :name "trivial-gray-streams"))
+ ((:system :name "fast-io") (:system :name "trivial-gray-streams"))
  ((:system :name "cl+ssl") (:system :name "trivial-gray-streams"))
  ((:system :name "chunga") (:system :name "trivial-gray-streams")))
 
+("trivial-types" ((:system :name "jonathan") (:system :name "trivial-types"))
+ ((:system :name "cl-syntax") (:system :name "trivial-types")))
+
 ("usocket" ((:system :name "hunchentoot") (:system :name "usocket"))
  ((:system :name "cl+ssl") (:system :name "usocket")))
 
diff --git a/lazybones-hunchentoot.lisp b/lazybones-hunchentoot.lisp
index f9c0af6..9d91b54 100644
--- a/lazybones-hunchentoot.lisp
+++ b/lazybones-hunchentoot.lisp
@@ -1,2 +1,107 @@
 ;;;; lazybones-hunchentoot.lisp -- hunchentoot backend for lazybones
 
+(defpackage #:lazybones.backend/hunchentoot
+  (:use #:cl #:lazybones.backend)
+  (:local-nicknames (#:h #:hunchentoot )))
+
+(in-package :lazybones.backend/hunchentoot)
+
+(defun request-path (request)
+  "Returns the PATH part of the REQUEST URL.
+
+See Also: https://en.wikipedia.org/wiki/URL#Syntax."
+  (h:script-name request))
+
+(defun request-host (request)
+  "Returns the HOST part of the REQUEST URL. 
+
+See Also: https://en.wikipedia.org/wiki/URL#Syntax"
+  (h:host request))
+
+(defun request-url (request)
+  "Returns the full url of  REQUST"
+  (h:request-uri* request))
+
+(defun request-port (request)
+  "The port associated with REQUEST."
+  (h:local-port* request))
+
+(defun request-query-string (request)
+  "Returns the full query string of the URL associated with REQUEST
+
+See Also: https://en.wikipedia.org/wiki/URL#Syntax"
+  (h:query-string request))
+
+(defun request-parameter  (name request)
+  "Returns the the value of the query parameter named NAME, or NIL
+  if there there is none."
+  (h:get-parameter name request))
+
+(defun request-parameters (request)
+  "Returns an alist of parameters associated with  REQUEST. Each
+member of the list looks like (NAME . VALUE) where both are strings."
+  (h:get-parameters request))
+
+(defun request-headers (request)
+  "Returns an alist of headers associated with REQUEST. Each member of
+the list looks like (HEADER-NAME . VALUE) where HEADER-NAME is a
+keyword or a string and VALUE is a string."
+  (h:headers-in request))
+
+(defun request-header (header-name request)
+  "Returns the string value of the REQUEST header named HEADER-NAME. 
+HEADER-NAME can be a keyword or a string."
+  (h:header-in header-name request))
+
+(defun request-method (request)
+  "Returns a keyword representing the http method of the request."
+  (h:request-method request))
+
+(defparameter +hunchentoot-pre-decoded-content-types+
+  '("multipart/form-data" "application/x-www-form-urlencoded"))
+
+(defun pre-decoded-body-p (request)
+  (member (request-header :content-type request)
+          +hunchentoot-pre-decoded-content-types+
+          :test #'string-equal))
+
+(defparameter +hunchentoot-methods-with-body+
+  '(:post :put :patch))
+
+(defun request-body (request &key (want-stream-p nil))
+  "Returns the decoded request body. The value returned depends upon
+the value of the Content-Type request header."
+  (when (member (request-method request) +hunchentoot-methods-with-body+)
+    (let ((pre-decoded-body-p
+            (pre-decoded-body-p request))
+          (content-type
+            (request-header :content-type request))) 
+      (cond
+        ;; try to get a stream on request
+        (want-stream-p                
+         ;; can't do it if the body is already decoded - return nil so
+         ;; that request-body can be called again
+         (unless pre-decoded-body-p 
+           (h:raw-post-data :request request :want-stream t)))
+
+        (pre-decoded-body-p
+         (format-as-lazybones-document
+          (h:post-parameters request)))
+
+        ((string-equal "application/json" content-type)
+         (jonathan:parse
+          (h:raw-post-data :request request :external-format :utf8 ))) ; TODO don't hardcode the format
+
+        (t
+         ;; default case is to return a bytevector
+         (h:raw-post-data :request request :force-binary t))))))
+
+(defun format-as-lazybones-document (post-parameters)
+  "internal function. Formats all the post parmaeters (see docstring
+  on hunchentoot:post-parameters) into a plist with keyword keys, as
+  is the convention for lazybones."
+  (loop for (k . value) in post-parameters
+        collect (alexandria:make-keyword k)
+        collect value))
+
+
diff --git a/lazybones.asd b/lazybones.asd
index 3be3d94..a0ee531 100644
--- a/lazybones.asd
+++ b/lazybones.asd
@@ -2,10 +2,15 @@
 
 (asdf:defsystem #:lazybones
   :description "http route handling"
-  :author "Colin Okay <cbeok@protonmail.com>"
+  :author "Colin Okay <okay@toyful.space>"
   :license  "AGPLv3"
   :version "0.2.0"
   :serial t
-  :depends-on (#:hunchentoot #:alexandria #:str #:cl-ppcre)
+  :depends-on (#:alexandria
+               #:str
+               #:cl-ppcre
+               #:closer-mop
+               #:jonathan)
   :components ((:file "package")
                (:file "lazybones")))
+
diff --git a/lazybones.lisp b/lazybones.lisp
index 735fbd5..d72189b 100644
--- a/lazybones.lisp
+++ b/lazybones.lisp
@@ -2,7 +2,7 @@
 
 (in-package #:lazybones)
 
-;;; Generic Functions
+;;; DYNAMIC VARIABLES 
 
 (defgeneric handle-request (what request)
   (:documentation "Implemented for APP and ENDPOINT instances."))
@@ -10,20 +10,10 @@
 (defgeneric dispatch-handler-p (endpoint request)
   (:documentation "T if ENDPOINT should handle REQUEST, NIL otherwise"))
 
-(defgeneric uri-path (request)
-  (:documentation "Returns the path associated with the request"))
-
-(defgeneric uri-query (request &key rawp)
-  (:documentation "Returns the whole query associated with a
-  request. If RAWP is truthy, should return the raw query
-  string. Otherwise should parse it somehow."))
-
-(defgeneric request-body (request)
-  (:documentation "Returns the body of a request that has one, or NIL if not."))
-
 (defgeneric request-authorized-p (endpoint request)
   (:documentation "Returns T if the REQUEST has authorization to dispatch the handler for ENDPOINT"))
 
+
 ;;; LAZYBONES CLASSES
 
 (defclass app ()
diff --git a/package.lisp b/package.lisp
index d4e3783..436eb7f 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,7 +1,21 @@
 ;;;; package.lisp
 
+(defpackage #:lazybones.backend
+  (:export
+   #:request-url
+   #:request-path
+   #:request-host
+   #:request-port
+   #:request-query-string
+   #:request-parameter
+   #:request-parameters
+   #:request-headers 
+   #:request-header
+   #:request-method
+   #:request-body))
+
 (defpackage #:lazybones
-  (:use #:cl)
+  (:use #:cl #:lazybones.backend)
   (:local-nicknames (#:a #:alexandria)
                     (#:re #:cl-ppcre)))