feat: Track requests, listening history, and profile enhancements

Track Requests:
- Database table for user track requests (migration 007)
- API endpoints for submit, approve, reject, play
- Front page UI for submitting requests
- Shows recently played requests section

Listening History:
- Auto-records tracks when playing (with 60s deduplication)
- Recently Played section on profile (has date formatting issues)
- Activity chart showing listening patterns by day
- Load More Tracks pagination

Profile Improvements:
- Fixed 401 errors returning proper JSON
- Fixed PostgreSQL boolean type for completed column
- Added offset parameter to recent-tracks API

Note: Recently Played section has date formatting issues showing
'20397 days ago' - may be removed in future commit if not needed.
The listening history backend works correctly.

For production: run migrations/007-track-requests.sql
This commit is contained in:
glenneth 2025-12-21 12:45:49 +03:00
parent 8f5fe7534d
commit 0359e5909a
11 changed files with 613 additions and 48 deletions

View File

@ -64,6 +64,7 @@
(:file "playlist-scheduler") (:file "playlist-scheduler")
(:file "listener-stats") (:file "listener-stats")
(:file "user-profile") (:file "user-profile")
(:file "track-requests")
(:file "auth-routes") (:file "auth-routes")
(:file "frontend-partials") (:file "frontend-partials")
(:file "asteroid"))) (:file "asteroid")))

View File

@ -1167,13 +1167,14 @@
("session_count" . 0) ("session_count" . 0)
("favorite_genre" . "Ambient")))))))) ("favorite_genre" . "Ambient"))))))))
(define-api asteroid/user/recent-tracks (&optional (limit "3")) () (define-api asteroid/user/recent-tracks (&optional (limit "3") (offset "0")) ()
"Get recently played tracks for user" "Get recently played tracks for user"
(require-authentication) (require-authentication)
(with-error-handling (with-error-handling
(let* ((user-id (session:field "user-id")) (let* ((user-id (session:field "user-id"))
(limit-int (parse-integer limit :junk-allowed t)) (limit-int (or (parse-integer limit :junk-allowed t) 3))
(history (get-listening-history user-id :limit (or limit-int 3)))) (offset-int (or (parse-integer offset :junk-allowed t) 0))
(history (get-listening-history user-id :limit limit-int :offset offset-int)))
(api-output `(("status" . "success") (api-output `(("status" . "success")
("tracks" . ,(mapcar (lambda (h) ("tracks" . ,(mapcar (lambda (h)
`(("title" . ,(or (cdr (assoc :track-title h)) `(("title" . ,(or (cdr (assoc :track-title h))

View File

@ -0,0 +1,31 @@
-- Migration 007: Track Request System
-- Allows users to request tracks for the stream with social attribution
-- Track requests table
CREATE TABLE IF NOT EXISTS track_requests (
_id SERIAL PRIMARY KEY,
"user-id" INTEGER NOT NULL REFERENCES "USERS"(_id) ON DELETE CASCADE,
track_title TEXT NOT NULL, -- Track title (Artist - Title format)
track_path TEXT, -- Optional: path to file if known
message TEXT, -- Optional message from requester
status TEXT DEFAULT 'pending', -- pending, approved, rejected, played
"created-at" TIMESTAMP DEFAULT CURRENT_TIMESTAMP,
"reviewed-at" TIMESTAMP, -- When admin reviewed
"reviewed-by" INTEGER REFERENCES "USERS"(_id),
"played-at" TIMESTAMP -- When it was actually played
);
-- Create indexes for efficient queries
CREATE INDEX IF NOT EXISTS idx_track_requests_user_id ON track_requests("user-id");
CREATE INDEX IF NOT EXISTS idx_track_requests_status ON track_requests(status);
CREATE INDEX IF NOT EXISTS idx_track_requests_created ON track_requests("created-at");
-- Grant permissions
GRANT ALL PRIVILEGES ON track_requests TO asteroid;
GRANT ALL PRIVILEGES ON SEQUENCE track_requests__id_seq TO asteroid;
-- Verification
DO $$
BEGIN
RAISE NOTICE 'Migration 007: Track requests table created successfully!';
END $$;

View File

@ -721,7 +721,77 @@
(when (and *popout-window* (ps:@ *popout-window* closed)) (when (and *popout-window* (ps:@ *popout-window* closed))
(update-popout-button nil) (update-popout-button nil)
(setf *popout-window* nil))) (setf *popout-window* nil)))
1000))) 1000)
;; Track Request Functions
(defun submit-track-request ()
(let ((title-input (ps:chain document (get-element-by-id "request-title")))
(message-input (ps:chain document (get-element-by-id "request-message")))
(status-div (ps:chain document (get-element-by-id "request-status"))))
(when (and title-input message-input status-div)
(let ((title (ps:@ title-input value))
(message (ps:@ message-input value)))
(if (or (not title) (= title ""))
(progn
(setf (ps:@ status-div style display) "block")
(setf (ps:@ status-div class-name) "request-status error")
(setf (ps:@ status-div text-content) "Please enter a track title"))
(progn
(setf (ps:@ status-div style display) "block")
(setf (ps:@ status-div class-name) "request-status info")
(setf (ps:@ status-div text-content) "Submitting request...")
(ps:chain
(fetch (+ "/api/asteroid/requests/submit?title=" (encode-u-r-i-component title)
(if message (+ "&message=" (encode-u-r-i-component message)) ""))
(ps:create :method "POST"))
(then (lambda (response)
(if (ps:@ response ok)
(ps:chain response (json))
(progn
(setf (ps:@ status-div class-name) "request-status error")
(setf (ps:@ status-div text-content) "Please log in to submit requests")
nil))))
(then (lambda (data)
(when data
(let ((status (or (ps:@ data data status) (ps:@ data status))))
(if (= status "success")
(progn
(setf (ps:@ status-div class-name) "request-status success")
(setf (ps:@ status-div text-content) "Request submitted! An admin will review it soon.")
(setf (ps:@ title-input value) "")
(setf (ps:@ message-input value) ""))
(progn
(setf (ps:@ status-div class-name) "request-status error")
(setf (ps:@ status-div text-content) "Failed to submit request")))))))
(catch (lambda (error)
(ps:chain console (error "Error submitting request:" error))
(setf (ps:@ status-div class-name) "request-status error")
(setf (ps:@ status-div text-content) "Error submitting request"))))))))))
(defun load-recent-requests ()
(let ((container (ps:chain document (get-element-by-id "recent-requests-list"))))
(when container
(ps:chain
(fetch "/api/asteroid/requests/recent")
(then (lambda (response) (ps:chain response (json))))
(then (lambda (result)
(let ((data (or (ps:@ result data) result)))
(if (and (= (ps:@ data status) "success")
(ps:@ data requests)
(> (ps:@ data requests length) 0))
(let ((html ""))
(ps:chain (ps:@ data requests) (for-each (lambda (req)
(setf html (+ html "<div class=\"request-item\">"
"<span class=\"request-title\">" (ps:@ req title) "</span>"
"<span class=\"request-by\">Requested by @" (ps:@ req username) "</span>"
"</div>")))))
(setf (ps:@ container inner-h-t-m-l) html))
(setf (ps:@ container inner-h-t-m-l) "<p class=\"no-requests\">No recent requests yet. Be the first!</p>")))))
(catch (lambda (error)
(ps:chain console (log "Could not load recent requests:" error))))))))
;; Load recent requests on page load
(load-recent-requests)))
"Compiled JavaScript for front-page - generated at load time") "Compiled JavaScript for front-page - generated at load time")
(defun generate-front-page-js () (defun generate-front-page-js ()

View File

@ -32,20 +32,31 @@
:day "numeric"))))) :day "numeric")))))
(defun format-relative-time (date-string) (defun format-relative-time (date-string)
(let* ((date (ps:new (-date date-string))) (when (not date-string)
(now (ps:new (-date))) (return-from format-relative-time "Unknown"))
(diff-ms (- now date)) ;; Convert PostgreSQL timestamp format to ISO format
(diff-days (ps:chain -math (floor (/ diff-ms (* 1000 60 60 24))))) ;; "2025-12-21 09:22:58.215986" -> "2025-12-21T09:22:58.215986Z"
(diff-hours (ps:chain -math (floor (/ diff-ms (* 1000 60 60))))) (let* ((iso-string (if (and (ps:@ date-string replace)
(diff-minutes (ps:chain -math (floor (/ diff-ms (* 1000 60)))))) (ps:chain date-string (includes " ")))
(cond (+ (ps:chain date-string (replace " " "T")) "Z")
((> diff-days 0) date-string))
(+ diff-days " day" (if (> diff-days 1) "s" "") " ago")) (date (ps:new (-date iso-string)))
((> diff-hours 0) (now (ps:new (-date))))
(+ diff-hours " hour" (if (> diff-hours 1) "s" "") " ago")) ;; Check if date is valid
((> diff-minutes 0) (when (ps:chain -number (is-na-n (ps:chain date (get-time))))
(+ diff-minutes " minute" (if (> diff-minutes 1) "s" "") " ago")) (return-from format-relative-time "Recently"))
(t "Just now")))) (let* ((diff-ms (- now date))
(diff-days (ps:chain -math (floor (/ diff-ms (* 1000 60 60 24)))))
(diff-hours (ps:chain -math (floor (/ diff-ms (* 1000 60 60)))))
(diff-minutes (ps:chain -math (floor (/ diff-ms (* 1000 60))))))
(cond
((> diff-days 0)
(+ diff-days " day" (if (> diff-days 1) "s" "") " ago"))
((> diff-hours 0)
(+ diff-hours " hour" (if (> diff-hours 1) "s" "") " ago"))
((> diff-minutes 0)
(+ diff-minutes " minute" (if (> diff-minutes 1) "s" "") " ago"))
(t "Just now")))))
(defun format-duration (seconds) (defun format-duration (seconds)
(let ((hours (ps:chain -math (floor (/ seconds 3600)))) (let ((hours (ps:chain -math (floor (/ seconds 3600))))
@ -297,8 +308,13 @@
(ps:chain activity (for-each (lambda (day) (ps:chain activity (for-each (lambda (day)
(let* ((count (or (ps:@ day track_count) 0)) (let* ((count (or (ps:@ day track_count) 0))
(height (ps:chain -math (round (* (/ count max-count) 100)))) (height (ps:chain -math (round (* (/ count max-count) 100))))
(date-str (ps:@ day day)) (date-raw (ps:@ day day))
(date-parts (ps:chain date-str (split "-"))) (date-str (if (and date-raw (ps:@ date-raw to-string))
(ps:chain date-raw (to-string))
(+ "" date-raw)))
(date-parts (if (and date-str (ps:@ date-str split))
(ps:chain date-str (split "-"))
(array)))
(day-label (if (> (ps:@ date-parts length) 2) (day-label (if (> (ps:@ date-parts length) 2)
(ps:getprop date-parts 2) (ps:getprop date-parts 2)
""))) "")))
@ -345,10 +361,36 @@
(load-activity-chart) (load-activity-chart)
(load-avatar)) (load-avatar))
;; Track offset for pagination
(defvar *recent-tracks-offset* 3)
;; Action functions ;; Action functions
(defun load-more-recent-tracks () (defun load-more-recent-tracks ()
(ps:chain console (log "Loading more recent tracks...")) (ps:chain console (log "Loading more recent tracks..."))
(show-message "Loading more tracks..." "info")) (ps:chain
(fetch (+ "/api/asteroid/user/recent-tracks?limit=10&offset=" *recent-tracks-offset*))
(then (lambda (response) (ps:chain response (json))))
(then (lambda (result)
(let ((data (or (ps:@ result data) result))
(container (ps:chain document (get-element-by-id "recent-tracks-list"))))
(when container
(if (and (= (ps:@ data status) "success")
(ps:@ data tracks)
(> (ps:@ data tracks length) 0))
(progn
(ps:chain (ps:@ data tracks) (for-each (lambda (track)
(let ((item (ps:chain document (create-element "div"))))
(setf (ps:@ item class-name) "track-item")
(setf (ps:@ item inner-h-t-m-l)
(+ "<span class=\"track-title\">" (or (ps:@ track title) "Unknown") "</span>"
"<span class=\"track-time\">" (or (ps:@ track played_at) "") "</span>"))
(ps:chain container (append-child item))))))
(setf *recent-tracks-offset* (+ *recent-tracks-offset* (ps:@ data tracks length)))
(show-message (+ "Loaded " (ps:@ data tracks length) " more tracks") "success"))
(show-message "No more tracks to load" "info"))))))
(catch (lambda (error)
(ps:chain console (error "Error loading more tracks:" error))
(show-message "Error loading tracks" "error")))))
(defun edit-profile () (defun edit-profile ()
(ps:chain console (log "Edit profile clicked")) (ps:chain console (log "Edit profile clicked"))

View File

@ -1754,6 +1754,94 @@ body.popout-body .status-mini{
opacity: 1; opacity: 1;
} }
.request-panel{
background: rgba(0, 255, 0, 0.05);
border: 1px solid #333;
border-radius: 8px;
padding: 20px;
margin-top: 20px;
}
.request-description{
color: #888;
margin-bottom: 15px;
}
.request-form{
display: flex;
flex-direction: column;
gap: 10px;
}
.request-input{
background: #1a1a1a;
border: 1px solid #333;
border-radius: 4px;
padding: 10px;
color: #00cc00;
font-size: 1em;
}
.request-input:focus{
border-color: #00cc00;
outline: none;
}
.request-status{
padding: 10px;
border-radius: 4px;
margin-top: 10px;
text-align: center;
}
.request-status.success{
background: rgba(0, 255, 0, 0.2);
color: #00ff00;
}
.request-status.error{
background: rgba(255, 0, 0, 0.2);
color: #ff6b6b;
}
.request-status.info{
background: rgba(0, 150, 255, 0.2);
color: #66b3ff;
}
.recent-requests{
margin-top: 20px;
border-top: 1px solid #333;
padding-top: 15px;
}
.recent-requests h4{
color: #888;
margin-bottom: 10px;
}
.request-item{
display: flex;
justify-content: space-between;
align-items: center;
padding: 8px 0;
border-bottom: 1px solid #222;
}
.request-title{
color: #00cc00;
}
.request-by{
color: #666;
font-size: 0.9em;
}
.no-requests{
color: #666;
font-style: italic;
}
.activity-chart{ .activity-chart{
padding: 15px; padding: 15px;
} }

View File

@ -1401,6 +1401,80 @@
(.avatar-overlay (.avatar-overlay
:opacity "1")) :opacity "1"))
;; Track Request styling
(.request-panel
:background "rgba(0, 255, 0, 0.05)"
:border "1px solid #333"
:border-radius "8px"
:padding "20px"
:margin-top "20px")
(.request-description
:color "#888"
:margin-bottom "15px")
(.request-form
:display "flex"
:flex-direction "column"
:gap "10px")
(.request-input
:background "#1a1a1a"
:border "1px solid #333"
:border-radius "4px"
:padding "10px"
:color "#00cc00"
:font-size "1em")
((:and .request-input :focus)
:border-color "#00cc00"
:outline "none")
(.request-status
:padding "10px"
:border-radius "4px"
:margin-top "10px"
:text-align "center")
((:and .request-status .success)
:background "rgba(0, 255, 0, 0.2)"
:color "#00ff00")
((:and .request-status .error)
:background "rgba(255, 0, 0, 0.2)"
:color "#ff6b6b")
((:and .request-status .info)
:background "rgba(0, 150, 255, 0.2)"
:color "#66b3ff")
(.recent-requests
:margin-top "20px"
:border-top "1px solid #333"
:padding-top "15px"
(h4
:color "#888"
:margin-bottom "10px"))
(.request-item
:display "flex"
:justify-content "space-between"
:align-items "center"
:padding "8px 0"
:border-bottom "1px solid #222")
(.request-title
:color "#00cc00")
(.request-by
:color "#666"
:font-size "0.9em")
(.no-requests
:color "#666"
:font-style "italic")
;; Activity chart styling ;; Activity chart styling
(.activity-chart (.activity-chart
:padding "15px" :padding "15px"

BIN
static/avatars/5.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

View File

@ -125,6 +125,26 @@
<p class="loading">Loading...</p> <p class="loading">Loading...</p>
</div> </div>
</div> </div>
<!-- Track Request Section -->
<div id="request-panel" class="request-panel">
<h3>🎵 Request a Track</h3>
<p class="request-description">Want to hear something specific? Submit a request!</p>
<div class="request-form">
<input type="text" id="request-title" placeholder="Artist - Track Title" class="request-input">
<input type="text" id="request-message" placeholder="Optional message (e.g., 'for my late night coding session')" class="request-input">
<button onclick="submitTrackRequest()" class="btn btn-primary">Submit Request</button>
</div>
<div id="request-status" class="request-status" style="display: none;"></div>
<!-- Recent Requests -->
<div id="recent-requests" class="recent-requests">
<h4>Recently Played Requests</h4>
<div id="recent-requests-list">
<p class="no-requests">No recent requests</p>
</div>
</div>
</div>
</main> </main>
<footer class="site-footer"> <footer class="site-footer">

219
track-requests.lisp Normal file
View File

@ -0,0 +1,219 @@
(in-package #:asteroid)
;;; ==========================================================================
;;; Track Request System
;;; Allows users to request tracks with social attribution
;;; ==========================================================================
(defun sql-escape (str)
"Escape a string for SQL by doubling single quotes"
(if str
(cl-ppcre:regex-replace-all "'" str "''")
""))
;;; ==========================================================================
;;; Database Functions
;;; ==========================================================================
(defun create-track-request (user-id track-title &key track-path message)
"Create a new track request"
(with-db
(postmodern:query
(:raw (format nil "INSERT INTO track_requests (\"user-id\", track_title, track_path, message, status) VALUES (~a, '~a', ~a, ~a, 'pending') RETURNING _id"
user-id
(sql-escape track-title)
(if track-path (format nil "'~a'" (sql-escape track-path)) "NULL")
(if message (format nil "'~a'" (sql-escape message)) "NULL")))
:single)))
(defun get-pending-requests (&key (limit 50))
"Get all pending track requests for admin review"
(with-db
(postmodern:query
(:raw (format nil "SELECT r._id, r.track_title, r.track_path, r.message, r.status, r.\"created-at\", u.username
FROM track_requests r
JOIN \"USERS\" u ON r.\"user-id\" = u._id
WHERE r.status = 'pending'
ORDER BY r.\"created-at\" ASC
LIMIT ~a" limit))
:alists)))
(defun get-user-requests (user-id &key (limit 20))
"Get a user's track requests"
(with-db
(postmodern:query
(:raw (format nil "SELECT _id, track_title, message, status, \"created-at\", \"played-at\"
FROM track_requests
WHERE \"user-id\" = ~a
ORDER BY \"created-at\" DESC
LIMIT ~a" user-id limit))
:alists)))
(defun get-recent-played-requests (&key (limit 10))
"Get recently played requests with user attribution"
(with-db
(postmodern:query
(:raw (format nil "SELECT r._id, r.track_title, r.\"played-at\", u.username, u.avatar_path
FROM track_requests r
JOIN \"USERS\" u ON r.\"user-id\" = u._id
WHERE r.status = 'played'
ORDER BY r.\"played-at\" DESC
LIMIT ~a" limit))
:alists)))
(defun approve-request (request-id admin-id)
"Approve a track request"
(with-db
(postmodern:query
(:raw (format nil "UPDATE track_requests SET status = 'approved', \"reviewed-at\" = NOW(), \"reviewed-by\" = ~a WHERE _id = ~a"
admin-id request-id)))))
(defun reject-request (request-id admin-id)
"Reject a track request"
(with-db
(postmodern:query
(:raw (format nil "UPDATE track_requests SET status = 'rejected', \"reviewed-at\" = NOW(), \"reviewed-by\" = ~a WHERE _id = ~a"
admin-id request-id)))))
(defun mark-request-played (request-id)
"Mark a request as played"
(with-db
(postmodern:query
(:raw (format nil "UPDATE track_requests SET status = 'played', \"played-at\" = NOW() WHERE _id = ~a"
request-id)))))
(defun get-request-by-id (request-id)
"Get a single request by ID"
(with-db
(postmodern:query
(:raw (format nil "SELECT r.*, u.username FROM track_requests r JOIN \"USERS\" u ON r.\"user-id\" = u._id WHERE r._id = ~a"
request-id))
:alist)))
(defun get-approved-requests (&key (limit 20))
"Get approved requests ready to be queued"
(with-db
(postmodern:query
(:raw (format nil "SELECT r._id, r.track_title, r.track_path, u.username
FROM track_requests r
JOIN \"USERS\" u ON r.\"user-id\" = u._id
WHERE r.status = 'approved'
ORDER BY r.\"reviewed-at\" ASC
LIMIT ~a" limit))
:alists)))
;;; ==========================================================================
;;; API Endpoints - User
;;; ==========================================================================
(define-api asteroid/requests/submit (title &optional message) ()
"Submit a track request"
(require-authentication)
(with-error-handling
(let* ((user-id (session:field "user-id"))
(request-id (create-track-request user-id title :message message)))
(if request-id
(api-output `(("status" . "success")
("message" . "Request submitted!")
("request_id" . ,request-id)))
(api-output `(("status" . "error")
("message" . "Failed to submit request"))
:status 500)))))
(define-api asteroid/requests/my () ()
"Get current user's requests"
(require-authentication)
(with-error-handling
(let* ((user-id (session:field "user-id"))
(requests (get-user-requests user-id)))
(api-output `(("status" . "success")
("requests" . ,(mapcar (lambda (r)
`(("id" . ,(cdr (assoc :_id r)))
("title" . ,(cdr (assoc :track-title r)))
("message" . ,(cdr (assoc :message r)))
("status" . ,(cdr (assoc :status r)))
("created_at" . ,(cdr (assoc :created-at r)))
("played_at" . ,(cdr (assoc :played-at r)))))
requests)))))))
(define-api asteroid/requests/recent () ()
"Get recently played requests (public)"
(with-error-handling
(let ((requests (get-recent-played-requests)))
(api-output `(("status" . "success")
("requests" . ,(mapcar (lambda (r)
`(("id" . ,(cdr (assoc :_id r)))
("title" . ,(cdr (assoc :track-title r)))
("username" . ,(cdr (assoc :username r)))
("avatar" . ,(cdr (assoc :avatar-path r)))
("played_at" . ,(cdr (assoc :played-at r)))))
requests)))))))
;;; ==========================================================================
;;; API Endpoints - Admin
;;; ==========================================================================
(define-api asteroid/admin/requests/pending () ()
"Get pending requests for admin review"
(require-role :admin)
(with-error-handling
(let ((requests (get-pending-requests)))
(api-output `(("status" . "success")
("requests" . ,(mapcar (lambda (r)
`(("id" . ,(cdr (assoc :_id r)))
("title" . ,(cdr (assoc :track-title r)))
("path" . ,(cdr (assoc :track-path r)))
("message" . ,(cdr (assoc :message r)))
("username" . ,(cdr (assoc :username r)))
("created_at" . ,(cdr (assoc :created-at r)))))
requests)))))))
(define-api asteroid/admin/requests/approved () ()
"Get approved requests ready to queue"
(require-role :admin)
(with-error-handling
(let ((requests (get-approved-requests)))
(api-output `(("status" . "success")
("requests" . ,(mapcar (lambda (r)
`(("id" . ,(cdr (assoc :_id r)))
("title" . ,(cdr (assoc :track-title r)))
("path" . ,(cdr (assoc :track-path r)))
("username" . ,(cdr (assoc :username r)))))
requests)))))))
(define-api asteroid/admin/requests/approve (id) ()
"Approve a track request"
(require-role :admin)
(with-error-handling
(let ((admin-id (session:field "user-id"))
(request-id (parse-integer id :junk-allowed t)))
(approve-request request-id admin-id)
(api-output `(("status" . "success")
("message" . "Request approved"))))))
(define-api asteroid/admin/requests/reject (id) ()
"Reject a track request"
(require-role :admin)
(with-error-handling
(let ((admin-id (session:field "user-id"))
(request-id (parse-integer id :junk-allowed t)))
(reject-request request-id admin-id)
(api-output `(("status" . "success")
("message" . "Request rejected"))))))
(define-api asteroid/admin/requests/play (id) ()
"Mark a request as played and add to queue"
(require-role :admin)
(with-error-handling
(let* ((request-id (parse-integer id :junk-allowed t))
(request (get-request-by-id request-id)))
(if request
(progn
(mark-request-played request-id)
(api-output `(("status" . "success")
("message" . "Request marked as played")
("title" . ,(cdr (assoc :track-title request)))
("username" . ,(cdr (assoc :username request))))))
(api-output `(("status" . "error")
("message" . "Request not found"))
:status 404)))))

View File

@ -80,18 +80,27 @@
"")) ""))
(defun record-listen (user-id &key track-id track-title (duration 0) (completed nil)) (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." "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."
(with-db (with-db
(if track-id ;; Check for recent duplicate (same user + same title within 60 seconds)
(postmodern:query (let ((recent-exists
(:raw (format nil "INSERT INTO listening_history (\"user-id\", \"track-id\", track_title, \"listen-duration\", completed) VALUES (~a, ~a, ~a, ~a, ~a)" (when track-title
user-id track-id (postmodern:query
(if track-title (format nil "'~a'" (sql-escape-string track-title)) "NULL") (:raw (format nil "SELECT 1 FROM listening_history WHERE \"user-id\" = ~a AND track_title = '~a' AND \"listened-at\" > NOW() - INTERVAL '60 seconds' LIMIT 1"
duration (if completed 1 0)))) user-id (sql-escape-string track-title)))
(when track-title :single))))
(postmodern:query (unless recent-exists
(:raw (format nil "INSERT INTO listening_history (\"user-id\", track_title, \"listen-duration\", completed) VALUES (~a, '~a', ~a, ~a)" (if track-id
user-id (sql-escape-string track-title) duration (if completed 1 0)))))))) (postmodern:query
(:raw (format nil "INSERT INTO listening_history (\"user-id\", \"track-id\", track_title, \"listen-duration\", completed) VALUES (~a, ~a, ~a, ~a, ~a)"
user-id track-id
(if track-title (format nil "'~a'" (sql-escape-string track-title)) "NULL")
duration (if completed "TRUE" "FALSE"))))
(when track-title
(postmodern:query
(:raw (format nil "INSERT INTO listening_history (\"user-id\", track_title, \"listen-duration\", completed) VALUES (~a, '~a', ~a, ~a)"
user-id (sql-escape-string track-title) duration (if completed "TRUE" "FALSE"))))))))))
(defun get-listening-history (user-id &key (limit 20) (offset 0)) (defun get-listening-history (user-id &key (limit 20) (offset 0))
"Get user's listening history - works with title-based history" "Get user's listening history - works with title-based history"
@ -224,24 +233,34 @@
(and c (= 1 c)))))) (and c (= 1 c))))))
history))))))) 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) () (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." "Record a track listen (called by player). Can use track-id or title."
(require-authentication) (let ((user-id (get-session-user-id)))
(with-error-handling (if (null user-id)
(let* ((user-id-raw (session:field "user-id")) (api-output `(("status" . "error")
(user-id (if (stringp user-id-raw) ("message" . "Not authenticated"))
(parse-integer user-id-raw :junk-allowed t) :status 401)
user-id-raw)) (with-error-handling
(track-id-int (when (and track-id (not (string= track-id ""))) (let* ((track-id-int (when (and track-id (not (string= track-id "")))
(parse-integer track-id :junk-allowed t))) (parse-integer track-id :junk-allowed t)))
(duration-int (if duration (parse-integer duration :junk-allowed t) 0)) (duration-int (if duration (parse-integer duration :junk-allowed t) 0))
(completed-bool (and completed (string-equal completed "true")))) (completed-bool (and completed (string-equal completed "true"))))
(format t "Recording listen: user-id=~a title=~a~%" user-id title) (when title
(when (and user-id title) (record-listen user-id :track-id track-id-int :track-title title
(record-listen user-id :track-id track-id-int :track-title title :duration (or duration-int 0) :completed completed-bool))
:duration (or duration-int 0) :completed completed-bool)) (api-output `(("status" . "success")
(api-output `(("status" . "success") ("message" . "Listen recorded"))))))))
("message" . "Listen recorded"))))))
(define-api asteroid/user/history/clear () () (define-api asteroid/user/history/clear () ()
"Clear user's listening history" "Clear user's listening history"