From c4352d64a25d2c5d297d433320df05a5181fee2e Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Fri, 4 Feb 2022 14:56:48 -0600 Subject: initial work developing hunchentoot backend --- clpmfile | 1 + clpmfile.lock | 72 ++++++++++++++++++++++++++++--- lazybones-hunchentoot.lisp | 105 +++++++++++++++++++++++++++++++++++++++++++++ lazybones.asd | 9 +++- lazybones.lisp | 14 +----- package.lisp | 16 ++++++- 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 " + :author "Colin Okay " :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))) -- cgit v1.2.3