updated api to use body-vars

5 files changed, 331 insertions, 71 deletions

diff --git a/src/api.lisp b/src/api.lisp
index 943beae..022a9ad 100644
--- a/src/api.lisp
+++ b/src/api.lisp
@@ -40,25 +40,12 @@ Any failures result in an HTTP 404."
          (unless (typep ,class ',class )
            (lzb:http-err 404
                          (format nil "No ~a with id ~a"
-                                 ',class key )))))))
-
-(defmacro with-json-body ((&rest var-names) &body body)
-  "VAR-NAMES should be symbols. Under the hood these names are converted
-into javascript-styled keyword symbols using
-PARENSCRIPT:SYMBOL-TO-JS-STRING, which are then passed to
-DERRIDA:WITH-PLIST."
-  (let* ((plist-bindings
-           (mapcar (lambda (var) (list var (util:jsonify-symbol var))) var-names))
-         (keywords
-           (mapcar #'second plist-bindings)))
-    `(let ((lzb:*allowed-keywords* ',keywords))
-       (with-plist ,plist-bindings (lzb:request-body)
-         ,@body))))
-
-(defmacro defendpoint/session (method path &body body)
+                                 ',class key)))))))
+
+(defmacro defendpoint/session (method path body-vars &body code)
   (let ((full-path
           (concatenate 'string "/session/:*session* a-session:" path)))
-    `(defendpoint* ,method ,full-path () () ,@body)))
+    `(defendpoint* ,method ,full-path () (:body-vars ,body-vars) ,@code)))
 
 
 ;;; ARGUMENT VALIDATORS
@@ -96,39 +83,37 @@ be non-empty strings."
 
 ;;; ENDPOINTS
 
-(defendpoint* :post "/session" () ()
+(defendpoint* :post "/session" ()
+  (:body-vars (username password))
   "Create a new session for a user. The request body MUST contain two
 fields: \"username\" and \"password\"."
-  (with-json-body (username password) 
-    (a:if-let (user (model:login-user username password))
-      (json:to-json
-       (list +api-token-key+ (model:key (model:make-session user))))
-      (lzb:http-err 403))))
+  (a:if-let (user (model:login-user username password))
+    (json:to-json
+     (list +api-token-key+ (model:key (model:make-session user))))
+    (lzb:http-err 403)))
 
 (defendpoint* :post "/user"
-  () ()
+  () (:body-vars (username password code))
   "Create a user with USERNAME and PASSWORD by redeeming an invite CODE.
 The JSON body must contain properties \"code\", \"username\", and
 \"password\"."
-  (with-json-body (code username password)
-    (if (model:use-invite-with-code code username password)
-        "true"
-        "false")))
+  (if (model:use-invite-with-code code username password)
+      "true"
+      "false"))
 
 ;;; PLAYLIST ENDPOINTS
 
-(defendpoint/session :get "/playlist/:pl a-playlist:"
+(defendpoint/session :get "/playlist/:pl a-playlist:" ()
   "Return a PLAYLIST identified by its key."
   (json:to-json pl))
 
-(defendpoint/session :post "/playlist"
+(defendpoint/session :post "/playlist" (title)
   "Create a new playlist. The request body must contain the field \"title\"."
-  (with-json-body (title)
-    (check-title title)
-    (json:to-json
-     (model:new-playlist (model:user *session*) :title title))))
+  (check-title title)
+  (json:to-json
+   (model:new-playlist (model:user *session*) :title title)))
 
-(defendpoint/session :patch "/playlist/:pl a-playlist:"
+(defendpoint/session :patch "/playlist/:pl a-playlist:" (title trackids)
   "Update a playlist with fields in the request body. 
 
 Fields include \"title\" and \"trackIds\". All fields are optional.
@@ -137,28 +122,26 @@ If title is provided it is validated. If trackIds is provided, each of
 its members is validated, returning ao 404 if no track can be found
 witht he given id."
   (check-can-edit pl)
-  (with-json-body (title track-ids)
-    (when title (check-title title))
-    (let ((tracks (mapcar #'a-track track-ids)))
-      (model:update-playlist pl title tracks))
-    "true"))
+  (when title (check-title title))
+  (let ((tracks (mapcar #'a-track trackids)))
+    (model:update-playlist pl title tracks))
+  "true")
 
-(defendpoint/session :post "/add-track/:pl a-playlist:"
+(defendpoint/session :post "/add-track/:pl a-playlist:" (url)
   (check-can-edit pl)
   (let ((user (model:user *session*)))  ; need to capture lexically
                                         ; b/c of closures below
-    (with-json-body (url)
-      (downloader:fetch-track
-       url
-       (lambda (track)
-         (model:append-track pl track)
-         (mail:send user (list :|newTrack| (model:key track)
-                               :|playlist| (model:key pl))))
-       (lambda (e)
-         (logger:logerror (list :error e :url url))
-         (mail:send user (list :|fetchError| url)))))))
-
-(defendpoint/session :delete "/playlist/:pl a-playlist:"
+    (downloader:fetch-track
+     url
+     (lambda (track)
+       (model:append-track pl track)
+       (mail:send user (list :|newTrack| (model:key track)
+                             :|playlist| (model:key pl))))
+     (lambda (e)
+       (logger:logerror (list :error e :url url))
+       (mail:send user (list :|fetchError| url))))))
+
+(defendpoint/session :delete "/playlist/:pl a-playlist:" ()
   "Owners can delete their playlists."
   (check-ownership pl)
   (model:destroy-playlist pl)
@@ -166,36 +149,33 @@ witht he given id."
 
 ;;; USER ENDPOINTS
 
-(defendpoint/session :patch "/user/:user a-user:/add-playlist/:pl a-playlist:"
+(defendpoint/session :patch "/user/:u a-user:/add-playlist/:pl a-playlist:" ()
   "Owners can add collaborators to their playlists"
   (check-ownership pl)
-  (model:add-editor pl user)
+  (model:add-editor pl u)
   "true")
 
-(defendpoint/session :patch "/user/:user a-user:/remove-playlist/:pl a-playlist:"
+(defendpoint/session :patch "/user/:u a-user:/remove-playlist/:pl a-playlist:" ()
   "Owners can remove collaborators from their playlists"
   (check-ownership pl)
-  (model:remove-editor pl user)
+  (model:remove-editor pl u)
   "true")
 
 ;;; TRACK ENDPOINTS
 
-(defendpoint/session :get "/track/:track a-track:"
+(defendpoint/session :get "/track/:tr a-track:" ()
   "Fetch the metadata related to a particular track"
-  (json:to-json track))
+  (json:to-json tr))
 
-(defendpoint/session :patch "/track/:track a-track:"
+(defendpoint/session :patch "/track/:tr a-track:" (title artist album)
   "Any logged in user can edit track metadata"
-  (with-json-body (title artist album)
-    (model:update-track-info track  (or artist "") (or album "") (or title ""))
-    "true"))
+  (model:update-track-info tr  (or artist "") (or album "") (or title ""))
+  "true")
 
 ;;; MAILBOX ENDPOINTS
 
-(defendpoint/session :get "/notifications"
+(defendpoint/session :get "/notifications" ()
   "Get the messages, if any, for the user session."
   (mail:deliver (model:user *session*)))
 
 
-
-
diff --git a/src/config.lisp b/src/config.lisp
index 6a90322..5bdd4e8 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -20,7 +20,9 @@
    (swank-port :std nil :doc "If set, swank is started on this port.")
    (host :std "0.0.0.0")
    (port :ir :std 4919)
-   (downloader-threads :ir :std 5)))
+   (downloader-threads :ir :std 5)
+   (yt-dlp-path :std ()))
+  )
 
 (defun static-directory* (&optional (config *config*))
   (static-directory config))
diff --git a/src/model.lisp b/src/model.lisp
index 984283d..650e238 100644
--- a/src/model.lisp
+++ b/src/model.lisp
@@ -27,7 +27,9 @@
    #:playlist
    #:user
    #:track
-
+   #:artist
+   #:tracks
+   #:title
    ;; queries (non-transactional)
    #:login-user
    #:can-edit-p
diff --git a/src/site.lisp b/src/site.lisp
index 41d6c45..6b84c71 100644
--- a/src/site.lisp
+++ b/src/site.lisp
@@ -21,6 +21,280 @@
 
 ;;; MACROS
 
-;;; UTILITIES
+(defmacro defpage
+    (path (&key
+             (title "")
+             params
+             (auth t)
+             setup)
+     &body body)
+  "PATH is a LAYZBONES ENDPOINT path, and can contain variables.
 
-;;; PAGES 
+TITLE is a form that is evalued in the context of the current request,
+including any bindings from the PATH or QUERY params.
+
+PARAMS are optional query parameters, parsed like they would be for an
+lazybones endpoint definition.
+
+AUTH is an arbitrary expression evaluated in the context of current
+request. If it returns null, then a 403 is returned. Otherwise the
+body is returned.
+
+SETUP is a form, evaluted after AUTH, but before the body expands. It
+can do anything; e.g. setting headers.
+
+BODY is SPINNERET code defining the body (but not the header) of a
+page."
+  `(defendpoint* :get ,path ,params ()
+     (unless ,auth
+       (lzb:http-err 403))
+     ,setup
+     (with-html-string
+       (:doctype)
+       (:head
+        (:title ,title)
+        (:meta :charset "UTF-8")
+        (:meta :name "viewport" :content "width=device-width, initial-scale=1.0")
+        (:link :rel "stylesheet" :href "/css/theme.css"))
+       (:body
+        ,@body))))
+
+(ps:defpsmacro defmodule (name &body definitions)
+  "Defines a javascript module called NAME. DEFINITIONS is a list of
+defining forms that look like one of
+
+(DEFPRIVATE VAR EXPR) 
+
+or 
+
+(DEFPUBLIC VAR EXPR)
+
+Everything defined as DEFPRIVAGE is only accessible from within the
+module. Anything named DEFPUBLIC can be accessed from outside the
+module with a name like `name.var` in JS, or (ps:chain name var) in
+parenscript.
+
+DEFPRIVATEs are all hoisted to the top of the module, and are defined
+sequentially.
+
+E.g.
+
+(defmodule -arith 
+  (defprivate local-adder (lambda (x y) (+ x y)))
+  (defprivate x-factor 10) 
+  (defprivate local-mult (lambda (z) (* x-factor z)))
+  (defpublic adder local-adder) 
+  (defpublic scale-up local-mult) 
+  (defpublic update-scale-factor (lambda (x) (setf x-factor x))))
+
+this would generate
+
+if ('undefined' === typeof Arith) {
+    var Arith = (function (module562) {
+        var localAdder = function (x, y) {
+            return x + y;
+        };
+        var xFactor = 10;
+        var localMult = function (z) {
+            return xFactor * z;
+        };
+        module562.adder = localAdder;
+        module562.scaleUp = localMult;
+        module562.updateScaleFactor = function (x) {
+            return xFactor = x;
+        };
+        return module562;
+    })({  });
+};
+"
+  (let ((module (gensym "MODULE")))
+    (multiple-value-bind (locals exports)
+        (loop :for (define name form) :in definitions
+              :do (assert (member define '(defpublic defprivate)))
+              :if (eq define 'defprivate)
+                :collect (list name form) :into locals
+              :else
+                :collect `(setf (ps:chain ,module ,name) ,form) :into exports
+              :finally (return (values locals exports)))
+      `(defvar ,name
+         ((lambda (,module)
+            (let* ,locals
+              ,@exports
+              ,module))
+          (ps:create))))))
+
+(defmacro two-columns (col1 col2)
+  "A Two-Column Layout Macro"
+  `(with-html
+     (:div :class "container two-cols"
+           (:div ,col1)
+           (:div ,col2))))
+
+;;; HELPERS
+
+(defun playlist-title-string (pl)
+  (concatenate 'string "~ " (model:title pl)))
+
+;;; REQUEST AUTH AND HELPERS
+
+(defun can-view-playlist-p (pl)
+  t)
+
+;;; PAGE ELEMENTS
+
+;;; LOGIN PAGE
+
+;;; HOME PAGE
+
+;;; USER PAGE
+
+;;; EXPLORE PAGE
+
+;;; PLAYLIST PAGE
+
+(defun ps-prev-track ()
+  (ps:ps (ps:chain -vampire (play-previous-track))))
+
+(defun ps-next-track ()
+  (ps:ps (ps:chain -vampire (play-next-track))))
+
+(defun ps-play/pause ()
+  (ps:ps (ps:chain -vampire (toggle-playback))))
+
+(defun ps-play-track (track)
+  (ps:ps (ps:chain -vampire (play-track (ps:lisp (model:key track))))))
+
+(defun previous-track-button ()
+  (with-html
+    (:button
+     :class "audio-control-button"
+     :id "previous-track"
+     :onclick (:raw (ps-prev-track))
+     "⏮")))
+
+(defun next-track-button ()
+  (with-html
+    (:button
+     :class "audio-control-button"
+     :id "next-track"
+     :onclick (:raw (ps-next-track))
+     "⏭")))
+
+(defun play/pause-button ()
+  (with-html
+    (:button
+     :class "audio-control-button"
+     :id "play-pause"
+     :onclick (:raw (ps-play/pause))
+     "⏯")))
+
+(defun now-playing-view (pl)
+  (with-html
+    (:div :class "now-playing"
+          (:img :id "now-playing-img" :src (or (model::cover-image pl) ""))
+          (:div :class "playback-controls"
+                (previous-track-button)
+                (play/pause-button)
+                (next-track-button)))))
+
+(defun playlist-track-item (track)
+  "Generates a view of TRACK as it should appear in a list of tracks."
+  (with-html
+    (:li
+     :class "track-list-item"
+     :onclick (:raw (ps-play-track track))
+     (:div
+      (:span :class "track-title" (model:title track))
+      (:span :class "track-duration" (write-to-string (model::duration track))))
+     (when (and (stringp (model:artist track))
+                (plusp (length (model:artist track))))
+       (:div (:span :class "track-artist" (model:artist track)))))))
+
+(defun playlist-tracks-view (playlist)
+  (with-html
+    (:ol
+     :class "track-list"
+     :id "track-list"
+     (dolist (track (model:tracks playlist))
+       (playlist-track-item track)))))
+
+(defun playlist-title-view (playlist)
+  (with-html
+    (:h3 :class "playlist-title"
+         (model:title playlist)
+         " -- "
+         (:span "playlist-duration"
+                (util:secs-to-hms (model::playlist-duration playlist))))))
+
+
+(defun playlist-control-app (playlist)
+  (with-html
+    (:script
+     (:raw
+      (ps:ps
+        (defmodule -vampire
+
+          (defprivate stop-media-playback
+              (lambda ()))
+          
+          (defprivate forward-one-track
+            (lambda ()))
+
+          (defprivate back-one-track
+            (lambda ()))
+
+          (defprivate start-media-playback
+            (lambda ()))
+
+          (defprivate media-now-playing-p
+            (lambda ()))
+            
+          (defpublic play-next-track
+              (lambda ()
+                (stop-media-playback)
+                (when (forward-one-track)
+                  (start-media-playback))))
+          
+          (defpublic play-previous-track
+              (lambda ()
+                (stop-media-playback)
+                (when (back-one-track)
+                  (start-media-playback))))
+          
+          (defpublic toggle-playback
+              (lambda ()
+                (if (media-now-playing-p)
+                    (stop-media-playback)
+                    (start-media-playback))))
+
+          (defpublic play-track
+            (lambda (key)
+              (stop-media-playback)
+              (set-track-to key)
+              (start-media-playback)))
+
+          ;; moocow
+          ))))))
+
+
+
+(defpage "/playlist/:pl a-playlist:"
+    (:title (playlist-title-string pl)
+     :auth (can-view-playlist-p pl))
+  (two-columns
+   (:div
+    (playlist-title-view pl)
+    (playlist-tracks-view pl))
+   (:div
+    (now-playing-view pl)))
+  (playlist-control-app pl))
+
+;;; CSS
+
+(defendpoint* :get "/css/theme.css" () ()
+  (setf (lzb:response-header :content-type) "text/css")
+  (lass:compile-and-write
+   (let ()
+     '(div
+       :background "#222222"
+       :color "white"))))
diff --git a/vampire.asd b/vampire.asd
index 2751128..152d2bb 100644
--- a/vampire.asd
+++ b/vampire.asd
@@ -7,8 +7,9 @@
   :version "0.2.0"
   :pathname "src/"
   :serial t
-  :depends-on (#:lazybones-hunchentoot
+  :depends-on (#:lazybones/backend/hunchentoot
                #:spinneret
+               #:lass
                #:parenscript
                #:bknr.datastore
                #:legion
@@ -23,6 +24,7 @@
                 :serial t
                 :components ((:file "handle-static-file-monkeypatch")))
                (:file "utilities")
+               (:file "logger")
                (:file "config")
                (:file "downloader")
                (:file "model")