diff --git a/.gitignore b/.gitignore index dc0837c..4d55b48 100644 --- a/.gitignore +++ b/.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 diff --git a/asteroid.lisp b/asteroid.lisp index 5ecf4bf..bdd673e 100644 --- a/asteroid.lisp +++ b/asteroid.lisp @@ -66,8 +66,7 @@ (require-authentication) (with-error-handling (let* ((user (get-current-user)) - (user-id-raw (gethash "_id" user)) - (user-id (if (listp user-id-raw) (first user-id-raw) user-id-raw)) + (user-id (dm:id user)) (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 (if (listp user-id-raw) (first user-id-raw) user-id-raw))) + (user-id (dm:id user))) (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))) - (if (listp username) (first username) username)) + (dm:field user "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))) - ("email" . ,(first (gethash "email" user))) - ("role" . ,(first (gethash "role" user))) - ("created_at" . ,(first (gethash "created-date" user))) - ("last_active" . ,(first (gethash "last-login" user))))))) + ("user" . (("username" . ,(dm:field user "username")) + ("email" . ,(dm:field user "email")) + ("role" . ,(dm:field user "role")) + ("created_at" . ,(dm:field user "created-at")) + ("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))) - (setf (session:field "user-id") (if (listp user-id) (first user-id) user-id))))) + (let ((user-id (dm:id user))) + (setf (session:field "user-id") user-id)))) ;; Redirect new users to their profile page (radiance:redirect "/asteroid/profile")) (clip:process-to-string diff --git a/auth-routes.lisp b/auth-routes.lisp index 8810a41..3095b9a 100644 --- a/auth-routes.lisp +++ b/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)) - (user-role-raw (gethash "role" user)) - (user-role (if (listp user-role-raw) (first user-role-raw) user-role-raw)) + (let* ((user-id (dm:id user)) + (user-role (dm:field user "role")) (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)) - (first (gethash "_id" user)) - (gethash "_id" user))) - ("username" . ,(first (gethash "username" user))) - ("email" . ,(first (gethash "email" user))) - ("role" . ,(first (gethash "role" user))) - ("active" . ,(= (first (gethash "active" user)) 1)) - ("created-date" . ,(first (gethash "created-date" user))) - ("last-login" . ,(first (gethash "last-login" user))))) + `(("id" . ,(dm:id user)) + ("username" . ,(dm:field user "username")) + ("email" . ,(dm:field user "email")) + ("role" . ,(dm:field user "role")) + ("active" . ,(= (dm:field user "active") 1)) + ("created-date" . ,(dm:field user "created-date")) + ("last-login" . ,(dm:field user "last-login")))) 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")) diff --git a/database.lisp b/database.lisp index 8c141e0..d71903a 100644 --- a/database.lisp +++ b/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)))) diff --git a/template/player.ctml b/template/player.ctml index 987033e..22c611e 100644 --- a/template/player.ctml +++ b/template/player.ctml @@ -14,7 +14,7 @@
Home Profile - Admin + Admin Login Register Logout diff --git a/template/profile.ctml b/template/profile.ctml index c23e387..d7157ad 100644 --- a/template/profile.ctml +++ b/template/profile.ctml @@ -14,7 +14,7 @@
Home Player - Admin + Admin Logout
diff --git a/user-management.lisp b/user-management.lisp index f27effd..2967604 100644 --- a/user-management.lisp +++ b/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)) - (user-data `(("username" ,username) - ("email" ,email) - ("password-hash" ,password-hash) - ("role" ,(string-downcase (symbol-name role))) - ("active" ,(if active 1 0)) - ("created-date" ,(local-time:timestamp-to-unix (local-time:now))) - ("last-login" nil)))) + (let ((user (dm:hull "USERS")) + (password-hash (hash-password password))) + (setf (dm:field user "username") username + (dm:field user "email") email + (dm:field user "password-hash") password-hash + (dm:field user "role") (string-downcase (symbol-name role)) + (dm:field user "active") (if active 1 0) + (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) - (let ((result (db:insert "USERS" user-data))) + (format t "Inserting user data: ~a~%" user) + (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)) - (format t "Trying to select from USERS collection...~%") - (let ((all-users-test (db:select "USERS" (db:query :all)))) - (format t "Total users in USERS collection: ~a~%" (length all-users-test)) - (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)))) + (let ((user (dm:get-one "USERS" (db:query (:= 'username username))))) + (when user + (format t "Found user '~a' with id #~a~%" username (dm:id user)) + user))) (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 ((all-users (db:select "USERS" (db:query :all))) - (target-id (if (numberp user-id) user-id (parse-integer (format nil "~a" user-id))))) - (format t "Searching through ~a users for ID ~a~%" (length all-users) target-id) - (dolist (user all-users) - (let ((db-id (gethash "_id" 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)))))) + (let ((user (dm:get-one "USERS" (db:query (:= '_id user-id))))) + (when user + (format t "Found user '~a' with id #~a~%" + (dm:field user "username") + (dm:id user)) + 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 - (handler-case - (progn - (format t "User active: ~a~%" (gethash "active" user)) - (format t "Password hash from DB: ~a~%" (gethash "password-hash" user)) - (format t "Password verification: ~a~%" - (verify-password password (first (gethash "password-hash" user))))) - (error (e) - (format t "Error during user data access: ~a~%" e)))) - (when (and user - (= (first (gethash "active" user)) 1) - (verify-password password (first (gethash "password-hash" user)))) - ;; Update last login - (db:update "USERS" - (db:query (:= "_id" (gethash "_id" user))) - `(("last-login" ,(local-time:timestamp-to-unix (local-time:now))))) - user))) + (let ((user-active (dm:field user "active")) + (user-password (dm:field user "password-hash"))) + (handler-case + (progn + (format t "User active: ~a~%" user-active) + (format t "Password hash from DB: ~a~%" user-password) + (format t "Password verification: ~a~%" + (verify-password password user-password))) + (error (e) + (format t "Error during user data access: ~a~%" e))) + (when (and (= 1 user-active) + (verify-password password user-password)) + ;; Update last login + (setf (dm:field user "last-login") (local-time:timestamp-to-unix (local-time:now))) + ;; (dm:save user) + (data-model-save 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...~%") - (db:update "USERS" - (db:query (:= "_id" user-id)) - `(("PASSWORD-HASH" ,new-hash))) - (format t "Update complete, verifying...~%") + (setf (dm:field user "password-hash") new-hash) + ;; (dm:save user) + (data-model-save user) ;; 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) - (string= (first updated-hash) new-hash) - (string= updated-hash new-hash)))) - (format t "Match: ~a~%" match) + (let ((match (string= updated-hash new-hash))) + (format t "Password update 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)) - (role-string (if (listp role-field) (first role-field) role-field)) - (user-role (intern (string-upcase role-string) :keyword))) + (let* ((role-value (dm:field user "role")) + (user-role (intern (string-upcase role-value) :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 - (progn - (db:update "USERS" - (db:query (:= "_id" user-id)) - `(("role" ,(string-downcase (symbol-name new-role))))) - (format t "Updated user ~a role to ~a~%" user-id new-role) - t) + (let ((user (find-user-by-id user-id))) + (if user + (progn + (setf (dm:field user "role") (string-downcase (symbol-name new-role))) + ;; (dm:save user) + (data-model-save user) + 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 - (db:update "USERS" - (db:query (:= "_id" user-id)) - `(("active" 0))) + (let ((user (find-user-by-id user-id))) + (setf (dm:field user "active") 0) + ;; (dm:save user) + (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 - (db:update "USERS" - (db:query (:= "_id" user-id)) - `(("active" 1))) + (let ((user (find-user-by-id user-id))) + (setf (dm:field user "active") 1) + ;; (dm:save user) + (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 _id field: ~a (type: ~a)~%" (gethash "_id" user) (type-of (gethash "_id" user)))) + (format t "User: ~a~%" (dm:field user "username")) + (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))) - (string= (if (listp role) (first role) role) "listener"))) all-users)) + (let ((role (dm:field user "role"))) + (string= role "listener"))) all-users)) ("djs" . ,(count-if (lambda (user) - (let ((role (gethash "role" user))) - (string= (if (listp role) (first role) role) "dj"))) all-users)) + (let ((role (dm:field user "role"))) + (string= role "dj"))) all-users)) ("admins" . ,(count-if (lambda (user) - (let ((role (gethash "role" user))) - (string= (if (listp role) (first role) role) "admin"))) all-users))))) + (let ((role (dm:field user "role"))) + (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))) - (string= (if (listp role) (first role) role) "admin"))) + (let ((role (dm:field user "role"))) + (string= role "admin"))) (get-all-users)))) (unless existing-admins (format t "~%Creating default admin user...~%")