diff options
| -rw-r--r-- | examples/defendpoint-examples.lisp | 73 | ||||
| -rw-r--r-- | examples/dice-roller.lisp | 4 | ||||
| -rw-r--r-- | examples/kitchensink.lisp | 4 | ||||
| -rw-r--r-- | src/defendpoint.lisp | 26 | ||||
| -rw-r--r-- | src/package.lisp | 3 | ||||
| -rw-r--r-- | weekend.asd | 5 |
6 files changed, 96 insertions, 19 deletions
diff --git a/examples/defendpoint-examples.lisp b/examples/defendpoint-examples.lisp new file mode 100644 index 0000000..a59d09d --- /dev/null +++ b/examples/defendpoint-examples.lisp @@ -0,0 +1,73 @@ +(defpackage #:weekend.examples.defendpoint + (:use #:cl #:weekend) + (:import-from #:flatbind #:do>)) + +(in-package :weekend.examples.defendpoint) + +;;; The DICE ROLLER example, but this time with DEFENDPOINT: +(defparameter +digits+ "([0-9]+)") + +(defendpoint roller + :get :route "roll" (:rolls +digits+ parse-integer) "d" (:sides +digits+ parse-integer) + :returns "text/plain" + :parameters + (sides integer "The number of sides the die being rolled has.") + (rolls integer "The number of times to roll the die.") + :documentation "Roll a SIDES-sided die ROLLS times, and announce the total." + :handle (format nil "~ad~a = ~a" + rolls sides + (loop :repeat rolls :sum (1+ (random sides))))) + + +;;; EXAMPLE WITH MULTIPLE INTERACTING ENDPOINTS, AND A MIX-IN FOR +;;; AUTHENTICATION + +;; Serves a form used to identify a user +(defendpoint who-are-you + :get :route "who-are-you" + :returns "text/html;charset=utf-8" + :documentation "A form to identify yourself" + :handle (with-output-to-string (*standard-output*) + (princ "<html><head></head><body>") + (princ "<form method='POST' action='/my-name-is'>") + (princ "<input name='name' placeholder='Your Name'/>") + (princ "<button type=submit>Go!</button>") + (princ "</form></body></html>"))) + +;;; A mixin meant to grab the name from a cookie, used to authenticate +;;; all requests that need to have identified a user. +;;; If authentication fails, redirects to who-are-you. +(defclass identified () + ((name :accessor name :type string))) + +(defmethod authenticate ((req identified)) + (or + (do> + name :when= (get-cookie "weekend-eg-name") + :when (and (stringp name) (plusp (length name))) + (setf (name req) name)) + (endpoint-redirect 'who-are-you))) + + +;;; Endpoint that extends IDENTIFIED and just greets the identified. +(defendpoint you-seem-to-be + :using identified + :get :route "you-seem-to-be" + :returns "text/html;charset=utf-8" + :documentation "Just says hello to an identified uesr" + :handle (with-output-to-string (*standard-output*) + (princ "<html><head></head><body>") + (princ "<p>You seem to be ") + (princ name) ; INHERITED FROM IDENTIFIED + (princ ".</p></body></html>"))) + + +;;; POST endpoint that handles setting the name cookie +(defendpoint my-name-is + :post :to "my-name-is" + :parameters + (name string "The name supplied by the user") + :documentation "Set cookie for client's identity." + :handle (progn + (set-cookie "weekend-eg-name" :value name) + (endpoint-redirect 'you-seem-to-be))) diff --git a/examples/dice-roller.lisp b/examples/dice-roller.lisp index 465d252..45e2979 100644 --- a/examples/dice-roller.lisp +++ b/examples/dice-roller.lisp @@ -1,9 +1,9 @@ -(defpackage #:dice-roller +(defpackage #:weekend.examples.dice-roller (:use #:cl) (:local-nicknames (#:wknd #:weekend))) -(in-package #:dice-roller) +(in-package #:weekend.examples.dice-roller) (defconstant +digits+ "([0-9]+)") diff --git a/examples/kitchensink.lisp b/examples/kitchensink.lisp index 7fcf45b..f102de5 100644 --- a/examples/kitchensink.lisp +++ b/examples/kitchensink.lisp @@ -1,9 +1,9 @@ -(defpackage #:kitchensink +(defpackage #:weekend.examples.kitchensink (:use #:cl) (:local-nicknames (#:wknd #:weekend))) -(in-package #:kitchensink) +(in-package #:weekend.examples.kitchensink) (defparameter +fname+ "([^/]+)" "Match any ole character except /") diff --git a/src/defendpoint.lisp b/src/defendpoint.lisp index 872c336..0ac9ec9 100644 --- a/src/defendpoint.lisp +++ b/src/defendpoint.lisp @@ -60,8 +60,9 @@ PART is either (getf kwargs :documentation ""))))) (defun expand-endpoint-class - (name method pathspec handle return + (name method pathspec handle &key + return supers parameters properties @@ -129,9 +130,9 @@ PART is either (:@ supers (:? <supers>)) (:@ method <method>) (:@ pathspec <pathspec>) - (:@ return (:? <return>)) - (:@ params (:? <parameters>)) - (:@ props (:? <properties>)) + ; (:@ return (:? <return>)) +; (:@ params (:? <parameters>)) +; (:@ props (:? <properties>)) (:@ options (:* <option>)) (:@ handle <handle>) (:eof)) @@ -140,10 +141,10 @@ PART is either method pathspec handle - return +; return :supers supers - :parameters params - :properties props +; :parameters params +; :properties props (a:alist-plist options))) (<supers> :match (:seq (:or= :using :extends) (:+ <classname>)) @@ -154,7 +155,7 @@ PART is either (<method> :match (:or= :get :post :put :patch :head :delete)) (<pathspec> - :match (:seq (:or= :to :from :at :route) (:+ <pathpart>)) + :match (:seq (:or= :to :route) (:+ <pathpart>)) :then second) (<pathpart> :match (:item) @@ -162,25 +163,26 @@ PART is either :note "REGEX or (KWD REGEX &optional PARSER)") (<parameters> :match (:seq (:= :parameters) (:+ <param>)) - :then second) + :then (cons :parameters (second <parameters>))) (<param> :match (:item) :if parameter-spec-p :note "(NAME TYPE &optional DOCSTRING)") (<properties> :match (:seq (:= :properties) (:+ <prop>)) - :then second) + :then (cons :properties (second <properties>))) (<prop> :match (:item) :if property-spec-p :note "(NAME TYPE &key DEFAULT DOCSTRING)") (<option> - :match (:or <doc> <metaclass> <var> + :match (:or <return> <parameters> <properties> + <doc> <metaclass> <var> <authenticate> <authorize>)) (<return> :match (:seq (:= :returns) (:@ mimetype (:item))) :if (stringp mimetype) - :then second + :then (cons :return (second <return>)) :note "The mimetype returned from this endpoint.") (<doc> :match (:seq (:= :documentation) (:@ doc (:item))) diff --git a/src/package.lisp b/src/package.lisp index bb74e5f..e71c71b 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -32,7 +32,8 @@ ;; METACLASS #:endpoint #:register-body-parser - + #:defendpoint + ;; DOCGEN #:print-route-documentation #:print-all-route-documentation)) diff --git a/weekend.asd b/weekend.asd index e48b022..6e3b9f4 100644 --- a/weekend.asd +++ b/weekend.asd @@ -5,9 +5,10 @@ :author "colin <colin@cicadas.surf>" :license "AGPLv3.0" :version "0.0.1" - :depends-on (#:hunchentoot #:closer-mop #:alexandria #:flatbind) + :depends-on (#:hunchentoot #:closer-mop #:alexandria #:flatbind #:argot) :pathname "src/" :serial t :components ((:file "package") (:file "protocol") - (:file "endpoint"))) + (:file "endpoint") + (:file "defendpoint"))) |