Add: defendpoint example; Fix: tweak defendpoint docstring

author: colin <colin@cicadas.surf> 2024-05-12 09:53:55 -0700
committer: colin <colin@cicadas.surf> 2024-05-12 09:53:55 -0700
commit: 5cce96a68272bab5204b806116be98bee051a97d (patch)
tree: 09d1d4dfba1138b477f0125ec053de5626973700
parent: ce69e1b3c4846b17ca10406e2e7e08d9b46fc7ec (diff)
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")))
author	colin <colin@cicadas.surf>	2024-05-12 09:53:55 -0700
committer	colin <colin@cicadas.surf>	2024-05-12 09:53:55 -0700
commit	5cce96a68272bab5204b806116be98bee051a97d (patch)
tree	09d1d4dfba1138b477f0125ec053de5626973700
parent	ce69e1b3c4846b17ca10406e2e7e08d9b46fc7ec (diff)