Merge remote-tracking branch 'upstream/main'

.gitignore

@@ -28,6 +28,16 @@ docker/music/*.m4a
 docker/music/*.aac
 docker/music/*.wma
 
+music/library
+# music/library/*/*.mp3
+# music/library/*/*.flac
+# music/library/*/*.ogg
+# music/library/*/*.wav
+# music/library/*/*.m4a
+# music/library/*/*.aac
+# music/library/*/*.wma
+
+
 # Docker build artifacts
 docker/.env
 docker/.dockerignore

asteroid.lisp

@@ -66,8 +66,7 @@
   (require-authentication)
   (with-error-handling
     (let* ((user (get-current-user))
-           (user-id-raw (gethash "_id" user))
+           (user-id (dm:id user))
-           (user-id (if (listp user-id-raw) (first user-id-raw) user-id-raw))
            (playlists (get-user-playlists user-id)))
       (api-output `(("status" . "success")
                     ("playlists" . ,(mapcar (lambda (playlist)
@@ -98,8 +97,7 @@
   (require-authentication)
   (with-error-handling
     (let* ((user (get-current-user))
-           (user-id-raw (gethash "_id" user))
+           (user-id (dm:id user)))
-           (user-id (if (listp user-id-raw) (first user-id-raw) user-id-raw)))
       (create-playlist user-id name description)
       (if (string= "true" (post/get "browser"))
           (redirect "/asteroid/")
@@ -666,8 +664,7 @@
       (api-output `(("loggedIn" . ,(if user t nil))
                     ("isAdmin" . ,(if (and user (user-has-role-p user :admin)) t nil))
                     ("username" . ,(if user 
-                                      (let ((username (gethash "username" user)))
+                                       (dm:field user "username")
-                                        (if (listp username) (first username) username))
                                       nil)))))))
 
 ;; User profile API endpoints
@@ -679,11 +676,11 @@
            (user (find-user-by-id user-id)))
       (if user
           (api-output `(("status" . "success")
-                        ("user" . (("username" . ,(first (gethash "username" user)))
+                        ("user" . (("username" . ,(dm:field user "username"))
-                                   ("email" . ,(first (gethash "email" user)))
+                                   ("email" . ,(dm:field user "email"))
-                                   ("role" . ,(first (gethash "role" user)))
+                                   ("role" . ,(dm:field user "role"))
-                                   ("created_at" . ,(first (gethash "created-date" user)))
+                                   ("created_at" . ,(dm:field user "created-at"))
-                                   ("last_active" . ,(first (gethash "last-login" user)))))))
+                                   ("last_active" . ,(dm:field user "last-active"))))))
           (signal-not-found "user" user-id)))))
 
 (define-api asteroid/user/listening-stats () ()
@@ -746,8 +743,8 @@
                  ;; Auto-login after successful registration
                  (let ((user (find-user-by-username username)))
                    (when user
-                     (let ((user-id (gethash "_id" user)))
+                     (let ((user-id (dm:id user)))
-                       (setf (session:field "user-id") (if (listp user-id) (first user-id) user-id)))))
+                       (setf (session:field "user-id") user-id))))
                  ;; Redirect new users to their profile page
                  (radiance:redirect "/asteroid/profile"))
                (clip:process-to-string

auth-routes.lisp

@@ -14,12 +14,11 @@
           (if user
               (progn
                 ;; Login successful - store user ID in session
-                (format t "Login successful for user: ~a~%" (gethash "username" user))
+                (format t "Login successful for user: ~a~%" (dm:field user "username"))
                 (handler-case
                     (progn
-                      (let* ((user-id (gethash "_id" user))
+                      (let* ((user-id (dm:id user))
-                             (user-role-raw (gethash "role" user))
+                             (user-role (dm:field user "role"))
-                             (user-role (if (listp user-role-raw) (first user-role-raw) user-role-raw))
                              (redirect-path (cond
                                               ;; Admin users go to admin dashboard
                                               ((string-equal user-role "admin") "/admin")
@@ -27,7 +26,8 @@
                                               (t "/profile"))))
                         (format t "User ID from DB: ~a~%" user-id)
                         (format t "User role: ~a, redirecting to: ~a~%" user-role redirect-path)
-                        (setf (session:field "user-id") (if (listp user-id) (first user-id) user-id))
+                        (setf (session:field "user-id") user-id)
+                        (format t "User ID #~a persisted in session.~%" (session:field "user-id"))
                         (radiance:redirect redirect-path)))
                   (error (e)
                     (format t "Session error: ~a~%" e)
@@ -61,15 +61,13 @@
       (let ((users (get-all-users)))
         (api-output `(("status" . "success")
                       ("users" . ,(mapcar (lambda (user)
-                                            `(("id" . ,(if (listp (gethash "_id" user)) 
+                                            `(("id" . ,(dm:id user))
-                                                          (first (gethash "_id" user)) 
+                                              ("username" . ,(dm:field user "username"))
-                                                          (gethash "_id" user)))
+                                              ("email" . ,(dm:field user "email"))
-                                              ("username" . ,(first (gethash "username" user)))
+                                              ("role" . ,(dm:field user "role"))
-                                              ("email" . ,(first (gethash "email" user)))
+                                              ("active" . ,(= (dm:field user "active") 1))
-                                              ("role" . ,(first (gethash "role" user)))
+                                              ("created-date" . ,(dm:field user "created-date"))
-                                              ("active" . ,(= (first (gethash "active" user)) 1))
+                                              ("last-login" . ,(dm:field user "last-login"))))
-                                              ("created-date" . ,(first (gethash "created-date" user)))
-                                              ("last-login" . ,(first (gethash "last-login" user)))))
                                           users)))))
     (error (e)
       (api-output `(("status" . "error")
@@ -120,10 +118,10 @@
     (unless (>= (length new-password) 8)
       (error 'validation-error :message "New password must be at least 8 characters"))
     
-    (let* ((user-id (session-field 'user-id))
+    (let* ((user-id (session:field "user-id"))
            (username (when user-id
                       (let ((user (find-user-by-id user-id)))
-                        (when user (gethash "username" user))))))
+                        (when user (dm:field user "username"))))))
       
       (unless username
         (error 'authentication-error :message "Not authenticated"))

database.lisp

@@ -47,3 +47,26 @@
   
   (format t "~2&Database collections initialized~%"))
 
+(defun data-model-as-alist (model)
+  "Converts a radiance data-model instance into a alist"
+  (unless (dm:hull-p model)
+    (loop for field in (dm:fields model)
+          collect (cons field (dm:field model field)))))
+
+(defun lambdalite-db-p ()
+  "Checks if application is using lambdalite as database backend"
+  (string= (string-upcase (package-name (db:implementation)))
+           "I-LAMBDALITE"))
+
+(defun data-model-save (data-model)
+  "Wrapper on data-model save method to bypass error using dm:save on lambdalite.
+It uses the same approach as dm:save under the hood through db:save."
+  (if (lambdalite-db-p)
+      (progn
+        (format t "Updating lambdalite collection '~a'~%" (dm:collection data-model))
+        (db:update (dm:collection data-model)
+                   (db:query (:= '_id (dm:id data-model)))
+                   (dm:field-table data-model)))
+      (progn
+        (format t "Updating database table '~a'~%" (dm:collection data-model))
+        (dm:save data-model))))

template/player.ctml

@@ -14,7 +14,7 @@
     <div class="nav">
       <a href="/asteroid">Home</a>
       <a href="/asteroid/profile">Profile</a>
-      <a href="/asteroid/admin">Admin</a>
+      <a href="/asteroid/admin" data-show-if-admin>Admin</a>
       <a href="/asteroid/login" data-show-if-logged-out>Login</a>
       <a href="/asteroid/register" data-show-if-logged-out>Register</a>
       <a href="/asteroid/logout" data-show-if-logged-in class="btn-logout">Logout</a>

template/profile.ctml

@@ -14,7 +14,7 @@
     <div class="nav">
       <a href="/asteroid">Home</a>
       <a href="/asteroid/player">Player</a>
-      <a href="/asteroid/admin">Admin</a>
+      <a href="/asteroid/admin" data-show-if-admin>Admin</a>
       <a href="/asteroid/logout" class="btn-logout">Logout</a>
     </div>
 

user-management.lisp

@@ -9,18 +9,19 @@
 ;; User management functions
 (defun create-user (username email password &key (role :listener) (active t))
   "Create a new user account"
-  (let* ((password-hash (hash-password password))
+  (let ((user (dm:hull "USERS"))
-         (user-data `(("username" ,username)
+        (password-hash (hash-password password)))
-                      ("email" ,email)
+    (setf (dm:field user "username") username
-                      ("password-hash" ,password-hash)
+          (dm:field user "email") email
-                      ("role" ,(string-downcase (symbol-name role)))
+          (dm:field user "password-hash") password-hash
-                      ("active" ,(if active 1 0))
+          (dm:field user "role") (string-downcase (symbol-name role))
-                      ("created-date" ,(local-time:timestamp-to-unix (local-time:now)))
+          (dm:field user "active") (if active 1 0)
-                      ("last-login" nil))))
+          (dm:field user "created-date") (local-time:timestamp-to-unix (local-time:now))
+          (dm:field user "last-login") nil)
     (handler-case
         (db:with-transaction ()
-          (format t "Inserting user data: ~a~%" user-data)
+          (format t "Inserting user data: ~a~%" user)
-          (let ((result (db:insert "USERS" user-data)))
+          (let ((result (dm:insert user)))
             (format t "Insert result: ~a~%" result)
             (format t "User created: ~a (~a)~%" username role)
             t))
@@ -31,38 +32,21 @@
 (defun find-user-by-username (username)
   "Find a user by username"
   (format t "Searching for user: ~a~%" username)
-  (format t "Available collections: ~a~%" (db:collections))
+  (let ((user (dm:get-one "USERS" (db:query (:= 'username username)))))
-  (format t "Trying to select from USERS collection...~%")
+    (when user
-  (let ((all-users-test (db:select "USERS" (db:query :all))))
+      (format t "Found user '~a' with id #~a~%" username (dm:id user))
-    (format t "Total users in USERS collection: ~a~%" (length all-users-test))
+      user)))
-    (dolist (user all-users-test)
-      (format t "User data: ~a~%" user)
-      (format t "Username field: ~a~%" (gethash "username" user))))
-  (let ((all-users (db:select "USERS" (db:query :all)))
-        (users nil))
-    (dolist (user all-users)
-      (format t "Comparing ~a with ~a~%" (gethash "username" user) username)
-      (let ((stored-username (gethash "username" user)))
-        (when (equal (if (listp stored-username) (first stored-username) stored-username) username)
-          (push user users))))
-    (format t "Query returned ~a users~%" (length users))
-    (when users 
-      (format t "First user: ~a~%" (first users))
-      (first users))))
 
 (defun find-user-by-id (user-id)
   "Find a user by ID"
   (format t "Looking for user with ID: ~a (type: ~a)~%" user-id (type-of user-id))
-  ;; Handle both integer and BIT types by iterating through all users
+  (let ((user (dm:get-one "USERS" (db:query (:= '_id user-id)))))
-  (let ((all-users (db:select "USERS" (db:query :all)))
+    (when user
-        (target-id (if (numberp user-id) user-id (parse-integer (format nil "~a" user-id)))))
+      (format t "Found user '~a' with id #~a~%"
-    (format t "Searching through ~a users for ID ~a~%" (length all-users) target-id)
+              (dm:field user "username")
-    (dolist (user all-users)
+              (dm:id user))
-      (let ((db-id (gethash "_id" user)))
+      user)))
-        (format t "Checking user with _id: ~a (type: ~a)~%" db-id (type-of db-id))
+
-        (when (equal db-id target-id)
-          (format t "Found matching user!~%")
-          (return user))))))
 
 (defun authenticate-user (username password)
   "Authenticate a user with username and password"
@@ -70,22 +54,23 @@
   (let ((user (find-user-by-username username)))
     (format t "User found: ~a~%" (if user "YES" "NO"))
     (when user
+      (let ((user-active (dm:field user "active"))
+            (user-password (dm:field user "password-hash")))
         (handler-case
             (progn
-            (format t "User active: ~a~%" (gethash "active" user))
+              (format t "User active: ~a~%" user-active)
-            (format t "Password hash from DB: ~a~%" (gethash "password-hash" user))
+              (format t "Password hash from DB: ~a~%" user-password)
               (format t "Password verification: ~a~%"
-                    (verify-password password (first (gethash "password-hash" user)))))
+                      (verify-password password user-password)))
           (error (e)
-          (format t "Error during user data access: ~a~%" e))))
+            (format t "Error during user data access: ~a~%" e)))
-    (when (and user
+        (when (and (= 1 user-active)
-               (= (first (gethash "active" user)) 1)
+                   (verify-password password user-password))
-               (verify-password password (first (gethash "password-hash" user))))
           ;; Update last login
-      (db:update "USERS" 
+          (setf (dm:field user "last-login") (local-time:timestamp-to-unix (local-time:now)))
-                 (db:query (:= "_id" (gethash "_id" user)))
+          ;; (dm:save user)
-                 `(("last-login" ,(local-time:timestamp-to-unix (local-time:now)))))
+          (data-model-save user)
-      user)))
+          user)))))
 
 (defun hash-password (password)
   "Hash a password using ironclad"
@@ -107,30 +92,22 @@
     (if user
         (handler-case
             (let ((new-hash (hash-password new-password))
-                  (user-id (gethash "_id" user)))
+                  (user-id (dm:id user)))
               (format t "Resetting password for user: ~a (ID: ~a, type: ~a)~%" username user-id (type-of user-id))
+              (format t "Old hash: ~a~%" (dm:field user "password-hash"))
               (format t "New hash: ~a~%" new-hash)
-              (format t "User hash table keys: ")
-              (maphash (lambda (k v) (format t "~a " k)) user)
-              (format t "~%")
-              (format t "Query: ~a~%" (db:query (:= "_id" user-id)))
-              (format t "Update data: ~a~%" `(("password-hash" ,new-hash)))
               ;; Try direct update with uppercase field name to match stored case
-              (format t "Attempting direct update with uppercase field name...~%")
+              (setf (dm:field user "password-hash") new-hash)
-              (db:update "USERS"
+              ;; (dm:save user)
-                         (db:query (:= "_id" user-id))
+              (data-model-save user)
-                         `(("PASSWORD-HASH" ,new-hash)))
-              (format t "Update complete, verifying...~%")
               ;; Verify the update worked
               (let ((updated-user (find-user-by-username username)))
                 (format t "Verification - fetching user again...~%")
-                (let ((updated-hash (gethash "PASSWORD-HASH" updated-user)))
+                (let ((updated-hash (dm:field updated-user "password-hash")))
                   (format t "Updated password hash in DB: ~a~%" updated-hash)
                   (format t "Expected hash: ~a~%" new-hash)
-                  (let ((match (if (listp updated-hash)
+                  (let ((match (string= updated-hash new-hash)))
-                                  (string= (first updated-hash) new-hash)
+                    (format t "Password update match: ~a~%" match)
-                                  (string= updated-hash new-hash))))
-                    (format t "Match: ~a~%" match)
                     (if match
                         (progn
                           (format t "Password reset successful for user: ~a~%" username)
@@ -148,9 +125,8 @@
 (defun user-has-role-p (user role)
   "Check if user has the specified role"
   (when user
-    (let* ((role-field (gethash "role" user))
+    (let* ((role-value (dm:field user "role"))
-           (role-string (if (listp role-field) (first role-field) role-field))
+           (user-role (intern (string-upcase role-value) :keyword)))
-           (user-role (intern (string-upcase role-string) :keyword)))
       (format t "User role: ~a, checking against: ~a~%" user-role role)
       (or (eq user-role role)
           (and (eq role :listener) (member user-role '(:dj :admin)))
@@ -225,12 +201,14 @@
 (defun update-user-role (user-id new-role)
   "Update a user's role"
   (handler-case
+      (let ((user (find-user-by-id user-id)))
+        (if user
             (progn
-        (db:update "USERS"
+              (setf (dm:field user "role") (string-downcase (symbol-name new-role)))
-                   (db:query (:= "_id" user-id))
+              ;; (dm:save user)
-                   `(("role" ,(string-downcase (symbol-name new-role)))))
+              (data-model-save user)
-        (format t "Updated user ~a role to ~a~%" user-id new-role)
               t)
+            (format t "Could not find user with id #~a~%" user-id)))
     (error (e)
       (format t "Error updating user role: ~a~%" e)
       nil)))
@@ -238,10 +216,10 @@
 (defun deactivate-user (user-id)
   "Deactivate a user account"
   (handler-case
-      (progn
+      (let ((user (find-user-by-id user-id)))
-        (db:update "USERS"
+        (setf (dm:field user "active") 0)
-                   (db:query (:= "_id" user-id))
+        ;; (dm:save user)
-                   `(("active" 0)))
+        (data-model-save user)
         (format t "Deactivated user ~a~%" user-id)
         t)
     (error (e)
@@ -251,10 +229,10 @@
 (defun activate-user (user-id)
   "Activate a user account"
   (handler-case
-      (progn
+      (let ((user (find-user-by-id user-id)))
-        (db:update "USERS"
+        (setf (dm:field user "active") 1)
-                   (db:query (:= "_id" user-id))
+        ;; (dm:save user)
-                   `(("active" 1)))
+        (data-model-save user)
         (format t "Activated user ~a~%" user-id)
         t)
     (error (e)
@@ -264,34 +242,34 @@
 (defun get-all-users ()
   "Get all users from database"
   (format t "Getting all users from database...~%")
-  (let ((users (db:select "USERS" (db:query :all))))
+  (let ((users (dm:get "USERS" (db:query :all))))
     (format t "Total users in database: ~a~%" (length users))
     (dolist (user users)
-      (format t "User: ~a~%" user)
+      (format t "User: ~a~%" (dm:field user "username"))
-      (format t "User _id field: ~a (type: ~a)~%" (gethash "_id" user) (type-of (gethash "_id" user))))
+      (format t "User _id field: ~a (type: ~a)~%" (dm:id user) (type-of (dm:id user))))
     users))
 
 (defun get-user-stats ()
   "Get user statistics"
   (let ((all-users (get-all-users)))
     `(("total-users" . ,(length all-users))
-      ("active-users" . ,(count-if (lambda (user) (gethash "active" user)) all-users))
+      ("active-users" . ,(count-if (lambda (user) (= 1 (dm:field user "active"))) all-users))
       ("listeners" . ,(count-if (lambda (user) 
-                                  (let ((role (gethash "role" user)))
+                                  (let ((role (dm:field user "role")))
-                                    (string= (if (listp role) (first role) role) "listener"))) all-users))
+                                    (string= role "listener"))) all-users))
       ("djs" . ,(count-if (lambda (user) 
-                            (let ((role (gethash "role" user)))
+                            (let ((role (dm:field user "role")))
-                              (string= (if (listp role) (first role) role) "dj"))) all-users))
+                              (string= role "dj"))) all-users))
       ("admins" . ,(count-if (lambda (user) 
-                               (let ((role (gethash "role" user)))
+                               (let ((role (dm:field user "role")))
-                                 (string= (if (listp role) (first role) role) "admin"))) all-users)))))
+                                 (string= role "admin"))) all-users)))))
 
 (defun create-default-admin ()
   "Create default admin user if no admin exists"
   (let ((existing-admins (remove-if-not 
                           (lambda (user) 
-                            (let ((role (gethash "role" user)))
+                            (let ((role (dm:field user "role")))
-                              (string= (if (listp role) (first role) role) "admin")))
+                              (string= role "admin")))
                           (get-all-users))))
     (unless existing-admins
       (format t "~%Creating default admin user...~%")