;;;; user-profile.lisp - User profile features: favorites, listening history ;;;; Part of Asteroid Radio (in-package #:asteroid) ;;; ========================================================================== ;;; User Favorites - Track likes/ratings ;;; ========================================================================== (defun get-favorite (user-id track-id &optional track-title) "Gets a user's favorite track by id or name" (when (and user-id (or track-id track-title)) (let ((query (if track-id (db:query (:and (:= 'user-id user-id) (:= 'track-id track-id))) (when track-title (db:query (:and (:= 'user-id user-id) (:= 'track_title track-title))))))) (when query (dm:get-one "user_favorites" query))))) (defun add-favorite (user-id track-id &optional (rating 1) track-title) "Add a track to user's favorites with optional rating (1-5). If track-id is nil but track-title is provided, stores by title. When favorite already exists for user, returns it instead to avoid duplicates." (when (and user-id (or track-id track-title)) (let ((favorite (get-favorite user-id track-id track-title))) (if favorite favorite (let ((rating-val (max 1 (min 5 (or rating 1)))) (favorite (dm:hull "user_favorites"))) (setf (dm:field favorite "user-id") user-id) (setf (dm:field favorite "rating") rating-val) (when track-id (setf (dm:field favorite "track-id") track-id)) (when track-title (setf (dm:field favorite "track_title") track-title)) (dm:insert favorite)))))) (defun remove-favorite (user-id track-id &optional track-title) "Remove a track from user's favorites by track-id or title" (let ((favorite (get-favorite user-id track-id track-title))) (when favorite (dm:delete favorite)))) (defun update-favorite-rating (user-id track-id rating) "Update the rating for a favorited track" (when (null user-id) (return-from update-favorite-rating nil)) (let ((rating-val (max 1 (min 5 rating))) (favorite (get-favorite user-id track-id))) (unless favorite (error 'not-found-error :message (format nil "Favorite #~a not found for user #~a" track-id user-id))) (setf (dm:field favorite "rating-val") rating-val) (data-model-save favorite))) (defun get-user-favorites (user-id &key (limit 50) (offset 0)) "Get user's favorite tracks - works with both track-id and title-based favorites" (when user-id (dm:get "user_favorites" (db:query (:= 'user-id user-id)) :amount limit :skip offset :sort '(("created-date" :DESC))))) (defun is-track-favorited (user-id track-id) "Check if a track is in user's favorites, returns rating or nil" (when (and user-id track-id) (dm:get-one "user_favorites" (db:query (:and (:= 'user-id user-id) (:= 'track-id track-id)))))) (defun get-favorites-count (user-id) "Get total count of user's favorites" (when user-id (db:count "user_favorites" (db:query (:= 'user-id user-id))))) (defun get-track-favorite-count (track-title) "Get count of how many users have favorited a track by title" (if (and track-title (not (string= track-title ""))) (handler-case (let ((result (db:count "user_favorites" (db:query (:= 'track_title track-title))))) (or result 0)) (error (e) (declare (ignore e)) 0)) 0)) ;;; ========================================================================== ;;; Listening History - Per-user track play history ;;; ========================================================================== (defun get-recent-listen (user-id track-title) "Check if user has listened to this track in the last 60 seconds" (when (and user-id track-title) ;; Get recent listens and check timestamps manually since data-model ;; doesn't support interval comparisons directly (let ((recent (dm:get "listening_history" (db:query (:and (:= 'user-id user-id) (:= 'track_title track-title))) :amount 1 :sort '(("listened-at" :DESC))))) (when recent (let* ((listen (first recent)) (listened-at (dm:field listen "listened-at"))) ;; Check if within 60 seconds (listened-at is a timestamp) (when listened-at (let ((now (get-universal-time)) (listen-time (if (integerp listened-at) listened-at (get-universal-time)))) (< (- now listen-time) 60)))))))) (defun record-listen (user-id &key track-id track-title (duration 0) (completed nil)) "Record a track listen in user's history. Can use track-id or track-title. Prevents duplicate entries for the same track within 60 seconds." (when (and user-id (or track-id track-title)) ;; Check for recent duplicate (unless (get-recent-listen user-id track-title) (let ((listen (dm:hull "listening_history"))) (setf (dm:field listen "user-id") user-id) (setf (dm:field listen "listen-duration") (or duration 0)) (setf (dm:field listen "completed") (if completed 1 0)) (when track-id (setf (dm:field listen "track-id") track-id)) (when track-title (setf (dm:field listen "track_title") track-title)) (dm:insert listen))))) (defun get-listening-history (user-id &key (limit 20) (offset 0)) "Get user's listening history - works with title-based history" (when user-id (dm:get "listening_history" (db:query (:= 'user-id user-id)) :amount limit :skip offset :sort '(("listened-at" :DESC))))) (defun get-listening-stats (user-id) "Get aggregate listening statistics for a user" (when user-id (let* ((history (dm:get "listening_history" (db:query (:= 'user-id user-id)))) (tracks-played (length history)) (total-listen-time (reduce #'+ history :key (lambda (h) (or (dm:field h "listen-duration") 0)) :initial-value 0))) (list :tracks-played tracks-played :total-listen-time total-listen-time)))) (defun get-top-artists (user-id &key (limit 5)) "Get user's most listened artists - extracts artist from track_title" (when user-id (let* ((history (dm:get "listening_history" (db:query (:= 'user-id user-id)))) (artist-counts (make-hash-table :test 'equal))) ;; Count plays per artist (dolist (h history) (let* ((title (dm:field h "track_title")) (artist (when title (let ((pos (search " - " title))) (if pos (subseq title 0 pos) title))))) (when artist (incf (gethash artist artist-counts 0))))) ;; Convert to sorted list and take top N (let ((sorted (sort (loop for artist being the hash-keys of artist-counts using (hash-value count) collect (cons artist count)) #'> :key #'cdr))) (subseq sorted 0 (min limit (length sorted))))))) (defun clear-listening-history (user-id) "Clear all listening history for a user" (when user-id (let ((history (dm:get "listening_history" (db:query (:= 'user-id user-id))))) (dolist (entry history) (dm:delete entry))))) (defun get-listening-activity (user-id &key (days 30)) "Get listening activity aggregated by day for the last N days" (when user-id (let* ((history (dm:get "listening_history" (db:query (:= 'user-id user-id)))) (cutoff-time (- (get-universal-time) (* days 24 60 60))) (day-counts (make-hash-table :test 'equal))) ;; Filter to recent days and count per day (dolist (h history) (let ((listened-at (dm:field h "listened-at"))) (when (and listened-at (> listened-at cutoff-time)) ;; Convert universal time to date string (multiple-value-bind (sec min hour day month year) (decode-universal-time listened-at) (declare (ignore sec min hour)) (let ((date-key (format nil "~4,'0d-~2,'0d-~2,'0d" year month day))) (incf (gethash date-key day-counts 0))))))) ;; Convert to sorted list (sort (loop for day being the hash-keys of day-counts using (hash-value count) collect (cons day count)) #'string< :key #'car)))) ;;; ========================================================================== ;;; API Endpoints for User Favorites ;;; ========================================================================== (defun aget-profile (key alist) "Get value from alist using string-equal comparison for key (Postmodern returns uppercase keys)" (cdr (assoc key alist :test (lambda (a b) (string-equal (string a) (string b)))))) (define-api asteroid/user/favorites () () "Get current user's favorite tracks" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) (favorites (get-user-favorites user-id))) (api-output `(("status" . "success") ("favorites" . ,(or (mapcar (lambda (fav) `(("id" . ,(dm:id fav)) ("track_id" . ,(dm:field fav "track-id")) ("title" . ,(dm:field fav "track_title")) ("rating" . ,(dm:field fav "rating")))) favorites) (list))) ("count" . ,(get-favorites-count user-id))))))) (define-api asteroid/user/favorites/add (&optional track-id rating title) () "Add a track to user's favorites. Can use track-id or title." (require-authentication) (with-error-handling (let* ((user-id-raw (session:field "user-id")) (user-id (if (stringp user-id-raw) (parse-integer user-id-raw :junk-allowed t) user-id-raw)) (track-id-int (when (and track-id (not (string= track-id ""))) (parse-integer track-id :junk-allowed t))) (rating-int (if rating (parse-integer rating :junk-allowed t) 1))) (unless user-id (error 'authentication-error :message "User not authenticated")) (format t "Adding favorite: user-id=~a track-id=~a title=~a~%" user-id track-id-int title) (add-favorite user-id track-id-int (or rating-int 1) title) (api-output `(("status" . "success") ("message" . "Track added to favorites")))))) (define-api asteroid/user/favorites/remove (&optional track-id title) () "Remove a track from user's favorites by track-id or title" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) (track-id-int (when (and track-id (not (string= track-id ""))) (parse-integer track-id :junk-allowed t)))) (remove-favorite user-id track-id-int title) (api-output `(("status" . "success") ("message" . "Track removed from favorites")))))) (define-api asteroid/user/favorites/rate (track-id rating) () "Update rating for a favorited track" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) (track-id-int (parse-integer track-id)) (rating-int (parse-integer rating))) (update-favorite-rating user-id track-id-int rating-int) (api-output `(("status" . "success") ("message" . "Rating updated")))))) (define-api asteroid/user/favorites/check (track-id) () "Check if a track is in user's favorites" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) (track-id-int (parse-integer track-id)) (rating (is-track-favorited user-id track-id-int))) (api-output `(("status" . "success") ("favorited" . ,(if rating t nil)) ("rating" . ,rating)))))) ;;; ========================================================================== ;;; API Endpoints for Listening History ;;; ========================================================================== (define-api asteroid/user/history () () "Get current user's listening history" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) (history (get-listening-history user-id))) (api-output `(("status" . "success") ("history" . ,(mapcar (lambda (h) `(("id" . ,(dm:id h)) ("track_id" . ,(dm:field h "track-id")) ("title" . ,(dm:field h "track_title")) ("listened_at" . ,(dm:field h "listened-at")) ("listen_duration" . ,(dm:field h "listen-duration")) ("completed" . ,(let ((c (dm:field h "completed"))) (and c (= 1 c)))))) history))))))) (defun get-session-user-id () "Get user-id from session, handling BIT type from PostgreSQL" (let ((user-id-raw (session:field "user-id"))) (cond ((null user-id-raw) nil) ((integerp user-id-raw) user-id-raw) ((stringp user-id-raw) (parse-integer user-id-raw :junk-allowed t)) ((bit-vector-p user-id-raw) (parse-integer (format nil "~a" user-id-raw) :junk-allowed t)) (t (handler-case (parse-integer (format nil "~a" user-id-raw) :junk-allowed t) (error () nil)))))) (define-api asteroid/user/history/record (&optional track-id title duration completed) () "Record a track listen (called by player). Can use track-id or title." (let ((user-id (get-session-user-id))) (if (null user-id) (api-output `(("status" . "error") ("message" . "Not authenticated")) :status 401) (with-error-handling (let* ((track-id-int (when (and track-id (not (string= track-id ""))) (parse-integer track-id :junk-allowed t))) (duration-int (if duration (parse-integer duration :junk-allowed t) 0)) (completed-bool (and completed (string-equal completed "true")))) (when title (record-listen user-id :track-id track-id-int :track-title title :duration (or duration-int 0) :completed completed-bool)) (api-output `(("status" . "success") ("message" . "Listen recorded")))))))) (define-api asteroid/user/history/clear () () "Clear user's listening history" (require-authentication) (with-error-handling (let ((user-id (session:field "user-id"))) (clear-listening-history user-id) (api-output `(("status" . "success") ("message" . "Listening history cleared")))))) (define-api asteroid/user/activity (&optional (days "30")) () "Get listening activity by day for the last N days" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) (days-int (or (parse-integer days :junk-allowed t) 30)) (activity (get-listening-activity user-id :days days-int))) (api-output `(("status" . "success") ("activity" . ,(mapcar (lambda (a) `(("day" . ,(car a)) ("track_count" . ,(cdr a)))) activity))))))) ;;; ========================================================================== ;;; Avatar Management ;;; ========================================================================== (defun get-avatars-directory () "Get the path to the avatars directory" (merge-pathnames "static/avatars/" (asdf:system-source-directory :asteroid))) (defun save-avatar (user-id temp-file-path original-filename) "Save an avatar file from temp path and return the relative path" (let* ((extension (pathname-type original-filename)) (safe-ext (if (member extension '("png" "jpg" "jpeg" "gif" "webp") :test #'string-equal) extension "png")) (new-filename (format nil "~a.~a" user-id safe-ext)) (full-path (merge-pathnames new-filename (get-avatars-directory))) (relative-path (format nil "/asteroid/static/avatars/~a" new-filename))) ;; Copy from temp file to avatars directory (uiop:copy-file temp-file-path full-path) ;; Update database - use raw SQL for single field update to avoid timestamp issues (with-db (postmodern:query (:raw (format nil "UPDATE \"USERS\" SET avatar_path = '~a' WHERE _id = ~a" relative-path user-id)))) relative-path)) (defun get-user-avatar (user-id) "Get the avatar path for a user" (when user-id (let ((user (dm:get-one "USERS" (db:query (:= '_id user-id))))) (when user (dm:field user "avatar_path"))))) (define-api asteroid/user/avatar/upload () () "Upload a new avatar image" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) ;; Radiance wraps hunchentoot - post-var returns (path filename content-type) for files (file-info (radiance:post-var "avatar")) (temp-path (when (listp file-info) (first file-info))) (original-name (when (listp file-info) (second file-info)))) (format t "Avatar upload: file-info=~a temp-path=~a original-name=~a~%" file-info temp-path original-name) (if (and temp-path (probe-file temp-path)) (let ((avatar-path (save-avatar user-id temp-path (or original-name "avatar.png")))) (api-output `(("status" . "success") ("message" . "Avatar uploaded successfully") ("avatar_path" . ,avatar-path)))) (api-output `(("status" . "error") ("message" . "No file provided")) :status 400))))) (define-api asteroid/user/avatar () () "Get current user's avatar path" (require-authentication) (with-error-handling (let* ((user-id (session:field "user-id")) (avatar-path (get-user-avatar user-id))) (api-output `(("status" . "success") ("avatar_path" . ,avatar-path))))))