You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
190 lines
6.2 KiB
190 lines
6.2 KiB
(defpackage :etascrobbler |
|
(:use :cl)) |
|
|
|
(in-package :etascrobbler) |
|
|
|
(setf (cl-who:html-mode) :html5) |
|
|
|
(defvar *title* "etascrobbler") |
|
|
|
;; Copied from TVL's panettone, with thanks to grfn |
|
(defmacro render (() &body body) |
|
`(who:with-html-output-to-string (*standard-output* nil :prologue t) |
|
(:html |
|
:lang "en" |
|
(:head |
|
(:title (who:esc *title*)) |
|
(:link :rel "stylesheet" :type "text/css" :href "//theta.eu.org/assets/webfonts/stylesheet.css") |
|
(:link :rel "stylesheet" :type "text/css" :href "//theta.eu.org/css/main.css") |
|
(:meta :name "viewport" |
|
:content "width=device-width,initial-scale=1")) |
|
(:header |
|
:class "site-header" |
|
(:div |
|
:class "wrapper" |
|
(:a |
|
:class "site-title" |
|
:href "/" |
|
(:img |
|
:src "//theta.eu.org/assets/img/logo.svg" |
|
:alt "η") |
|
" (eta)") |
|
(:nav |
|
:class "site-nav" |
|
(:div |
|
:class "trigger" |
|
"etascrobbler")))) |
|
(:div |
|
:class "page-content" |
|
(:div |
|
:class "wrapper" |
|
,@body))))) |
|
|
|
(defun get-last-scrobble () |
|
(tq::with-prepared-statement |
|
(get "SELECT artist, title, ts FROM plays ORDER by ts DESC LIMIT 1") |
|
(when (sqlite:step-statement get) |
|
(values-list (tq::column-values get))))) |
|
|
|
(defun count-all-scrobbles () |
|
(tq::with-prepared-statement |
|
(count "SELECT COUNT(*) FROM plays") |
|
(sqlite:step-statement count) |
|
(sqlite:statement-column-value count 0))) |
|
|
|
(hunchentoot:define-easy-handler (validate-token :uri "/1/validate-token") () |
|
(setf (hunchentoot:content-type*) "application/json") |
|
(cl-json:encode-json-to-string |
|
'((:code . 200) |
|
(:message . "token probably valid") |
|
(:valid . t) |
|
(:user . "eta")))) |
|
|
|
(defun insert-play (artist title ts &optional additional-info) |
|
(tq::with-prepared-statement |
|
(insert "INSERT INTO plays (artist, title, additional_info, ts) VALUES (?, ?, ?, ?)") |
|
(tq::bind-parameters insert artist title additional-info ts) |
|
(sqlite:step-statement insert))) |
|
|
|
(defun get-all-artists () |
|
(tq::with-prepared-statement |
|
(get "SELECT artist, COUNT(*) FROM plays GROUP BY artist ORDER BY artist ASC") |
|
(loop |
|
while (sqlite:step-statement get) |
|
collect (cons |
|
(sqlite:statement-column-value get 0) |
|
(sqlite:statement-column-value get 1))))) |
|
|
|
(defmacro cassoc (item alist) |
|
`(cdr (assoc ,item ,alist))) |
|
|
|
(defparameter *ok* "{\"status\": \"ok\"}") |
|
(defvar *nowplaying* nil) |
|
(defvar *nowplaying-ts* 0) |
|
|
|
(hunchentoot:define-easy-handler (now-playing :uri "/now-playing.json") () |
|
(unless *nowplaying* |
|
(setf (hunchentoot:return-code*) hunchentoot:+http-not-found+) |
|
(return-from now-playing "nope")) |
|
(setf (hunchentoot:content-type*) "application/json") |
|
(cl-json:encode-json-to-string |
|
`((:artist . ,(car *nowplaying*)) |
|
(:track . ,(cdr *nowplaying*)) |
|
(:since . ,(- (get-universal-time) *nowplaying-ts*))))) |
|
|
|
(hunchentoot:define-easy-handler (submit-listens :uri "/1/submit-listens") () |
|
(labels |
|
((fail (e) |
|
(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+) |
|
(format *error-output* "womp: ~A~%" e) |
|
(return-from submit-listens e))) |
|
(let* ((json |
|
(handler-case |
|
(cl-json:decode-json-from-string |
|
(hunchentoot:raw-post-data :force-text t)) |
|
(error (e) (fail (format nil "bad: ~A" e))))) |
|
(payload (or (first (cassoc :payload json)) |
|
(fail "no payload provided"))) |
|
(track-meta (or (cassoc :track--metadata payload) |
|
(fail "no track metadata provided"))) |
|
(artist-name (cassoc :artist--name track-meta)) |
|
(track-name (cassoc :track--name track-meta)) |
|
(listen-type (cassoc :listen--type json))) |
|
(setf (hunchentoot:content-type*) "application/json") |
|
(format *error-output* "~&[~A] ~A — ~A~%" listen-type artist-name track-name) |
|
(when (string= listen-type "playing_now") |
|
(setf *nowplaying-ts* (get-universal-time)) |
|
(setf *nowplaying* (cons artist-name track-name))) |
|
(unless (string= listen-type "single") |
|
(return-from submit-listens *ok*)) |
|
(insert-play |
|
(cassoc :artist--name track-meta) |
|
(cassoc :track--name track-meta) |
|
(cassoc :listened--at payload) |
|
(prin1-to-string (cassoc :additional--info track-meta))) |
|
*ok*))) |
|
|
|
(hunchentoot:define-easy-handler (root :uri "/") () |
|
(render () |
|
(:h1 |
|
"now playing") |
|
(:p |
|
"This shows what I was last listening to on any of my devices, and the song before that. " |
|
"This tiny webapp has observed " |
|
(:b |
|
(who:esc (princ-to-string (count-all-scrobbles)))) |
|
" songs being played so far.") |
|
(:p |
|
"This site is very beta. More information should be added shortly!") |
|
(when *nowplaying* |
|
(who:with-html-output (*standard-output*) |
|
(:div |
|
:class "book-meta" |
|
(:p |
|
:class "book-title" |
|
"🎵 " |
|
(who:esc (car *nowplaying*)) |
|
" — " |
|
(who:esc (cdr *nowplaying*)))))) |
|
(multiple-value-bind (artist title) |
|
(get-last-scrobble) |
|
(when artist |
|
(who:with-html-output (*standard-output*) |
|
(:p |
|
(:i |
|
"Previously: ") |
|
(who:esc artist) |
|
" — " |
|
(who:esc title))))) |
|
(let* ((artists (get-all-artists)) |
|
(len (length artists))) |
|
(who:with-html-output (*standard-output*) |
|
(:p |
|
:class "detail" |
|
"Artists (" |
|
(:strong |
|
(who:fmt "~D" len)) |
|
" total): " |
|
(loop |
|
for (artist . count) in artists |
|
for i from 1 |
|
when (> count 10) |
|
do (princ "<b>") |
|
when (> count 100) |
|
do (princ "<span style=\"color: #6b55d4;\">") |
|
do (who:esc artist) |
|
when (> count 10) |
|
do (princ "</b>") |
|
when (> count 100) |
|
do (princ "</span>") |
|
unless (eql len i) |
|
do (princ " · ") |
|
)))))) |
|
|
|
(defun main () |
|
(tq::connect-database) |
|
(hunchentoot:start |
|
(make-instance 'hunchentoot:easy-acceptor |
|
:address "::" |
|
:port 4242)) |
|
(loop (sleep 1)))
|
|
|