src/push-notifications.lisp

   1 (in-package #:lw2.backend)
   2
   3 (define-cache-database 'backend-push-notifications "push-subscriptions")
   4
   5 (export 'make-subscription)
   6 (defun make-subscription (auth-token endpoint expires)
   7   (cache-put "push-subscriptions"
   8              auth-token
   9              (alist :endpoint endpoint
  10                     :expires expires)
  11              :value-type :json))
  12
  13 (export 'find-subscription)
  14 (defun find-subscription (auth-token)
  15   (cache-get "push-subscriptions" auth-token :value-type :json))
  16
  17 (export 'delete-subscription)
  18 (defun delete-subscription (auth-token)
  19   (cache-del "push-subscriptions" auth-token))
  20
  21 (export 'send-all-notifications)
  22 (define-backend-function send-all-notifications ()
  23   (backend-push-notifications
  24    (let* ((all-subscriptions
  25            (with-collector (col)
  26              (call-with-cursor "push-subscriptions"
  27                                (lambda (db cursor)
  28                                  (declare (ignore db))
  29                                  (multiple-value-bind (value key) (cursor-get cursor :first)
  30                                    (loop while key do
  31                                         (col (cons key value))
  32                                         (multiple-value-setq (value key) (cursor-get cursor :next)))))
  33                                :read-only t)
  34              (col)))
  35           (current-time (local-time:now))
  36           (current-time-unix (local-time:timestamp-to-unix current-time)))
  37      (loop for (auth-token . subscription-json) in all-subscriptions
  38         do (log-and-ignore-errors
  39             (let* ((subscription (json:decode-json-from-string subscription-json))
  40                    (last-check-cons (or (assoc :last-check subscription) (cons :last-check nil)))
  41                    (since (if-let (unix (cdr last-check-cons)) (local-time:unix-to-timestamp unix))))
  42               (cond
  43                 ((let ((expires (cdr (assoc :expires subscription)))) (and expires (> current-time-unix expires)))
  44                  (delete-subscription auth-token))
  45                 ((sb-sys:with-deadline (:seconds 30)
  46                    (check-notifications (cache-get "auth-token-to-userid" auth-token) auth-token :since since))
  47                  (handler-case
  48                      (sb-sys:with-deadline (:seconds 30)
  49                        (send-notification (cdr (assoc :endpoint subscription))))
  50                    (dex:http-request-gone ()
  51                      (delete-subscription auth-token))
  52                    (:no-error (&rest args)
  53                      (declare (ignore args))
  54                      (setf (cdr last-check-cons) (local-time:timestamp-to-unix current-time))
  55                      (cache-put "push-subscriptions" auth-token (adjoin last-check-cons subscription) :value-type :json))))))))))
  56   (backend-base nil))