etascrobbler/scrobble.lisp

(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 " &middot; ")
           ))))))

(defun main ()
  (tq::connect-database)
  (hunchentoot:start
   (make-instance 'hunchentoot:easy-acceptor
		  :address "::"
                  :port 4242))
  (loop (sleep 1)))