chatikbot/db.lisp

(in-package #:chatikbot)

(defvar *db-name* "db.sqlite" "SQLite database name")

(defun db-path ()
  (merge-pathnames *db-name*
                   (asdf:component-pathname
                    (asdf:find-system '#:chatikbot))))

(defmacro with-db ((db) &body body)
  `(sqlite:with-open-database (,db (db-path) :busy-timeout 30)
     (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON")
     ,@body))

(defun db-execute (sql &rest parameters)
  (with-db (db)
    (apply #'sqlite:execute-non-query db sql parameters)))

(defun db-select (sql &rest parameters)
  (with-db (db)
    (apply #'sqlite:execute-to-list db sql parameters)))

(defmacro def-db-init (() &body body)
  `(add-hook :db-init #'(lambda ()
                          (handler-case (progn ,@body)
                            (error (e) (log:error e)))
                          (values))))

(defun db-init ()
  (with-db (db)
    (run-hooks :db-init)
    ;; Finance
    (sqlite:execute-non-query db "create table if not exists finance (ts, usd, eur, gbp, brent, btc)")
    (sqlite:execute-non-query db "create index if not exists fin_ts_ids on finance (ts)")

    ;; Foursquare
    (sqlite:execute-non-query db "create table if not exists fsq_chat_users (chat_id, user_id)")
    (sqlite:execute-non-query db "create index if not exists fsq_chat_users_chat_idx on fsq_chat_users (chat_id)")
    (sqlite:execute-non-query db "create index if not exists fsq_chat_users_user_idx on fsq_chat_users (user_id)")
    (sqlite:execute-non-query db "create table if not exists fsq_seen (id, created_at)")
    (sqlite:execute-non-query db "create index if not exists fsq_seen_idx on fsq_seen (id)")

    ;; RSS
    (sqlite:execute-non-query db "create table if not exists rss_feeds (id INTEGER PRIMARY KEY, url, title, next_fetch, period)")
    (sqlite:execute-non-query db "create unique index if not exists rss_feeds_url_idx on rss_feeds (url)")
    (sqlite:execute-non-query db "create table if not exists rss_items (id INTEGER PRIMARY KEY, feed_id REFERENCES rss_feeds, guid, link, title, published)")
    (sqlite:execute-non-query db "create index if not exists rss_items_idx on rss_items (feed_id, guid)")

    (sqlite:execute-non-query db "create table if not exists rss_chat_feeds (chat_id, feed_id REFERENCES rss_feeds)")
    (sqlite:execute-non-query db "create index if not exists rss_chat_feeds_chat_idx on rss_chat_feeds (chat_id)")
    (sqlite:execute-non-query db "create index if not exists rss_chat_feeds_feed_idx on rss_chat_feeds (feed_id)")

    ;; VK
    (sqlite:execute-non-query db "create table if not exists vk_walls (domain, last_id, next_fetch, period)")
    (sqlite:execute-non-query db "create unique index if not exists vk_walls_domain_idx on vk_walls (domain)")

    (sqlite:execute-non-query db "create table if not exists vk_chat_walls (chat_id, domain)")
    (sqlite:execute-non-query db "create index if not exists vk_chat_walls_chat_idx on vk_chat_walls (chat_id)")
    (sqlite:execute-non-query db "create index if not exists vk_chat_walls_domain_idx on vk_chat_walls (domain)")))

;; Finance
(defun db-add-finance (ts usd eur gbp brent btc)
  (with-db (db)
    (sqlite:execute-non-query db "insert into finance (ts, usd, eur, gbp, brent, btc) values (?, ?, ?, ?, ?, ?)"
                              ts usd eur gbp brent btc)))

(defun db-get-last-finance ()
  (with-db (db)
    (sqlite:execute-one-row-m-v db "select ts, usd, eur, gbp, brent, btc from finance order by ts desc limit 1")))


(defparameter +db-finance-map+ '(("usd" . "USD/RUB")
                                 ("eur" . "EUR/RUB")
                                 ("gbp" . "GBP/RUB")
                                 ("brent" . "Brent")
                                 ("btc" . "BTC/USD")))

(defun db-get-series (after-ts &optional (fields '("usd" "eur" "gbp" "brent")) (avg 60))
  (when fields
    (let ((sql (format nil
                       "select ts/~a*~:*~a,~{avg(~a) as ~:*~a~^,~} from finance where ts >= ? group by ts/~a order by ts"
                       avg fields avg)))
      (with-db (db)
        (values
         (sqlite:execute-to-list db sql (local-time:timestamp-to-unix after-ts))
         (sublis +db-finance-map+ fields :test #'equal))))))

;; Foursquare
(defun db-fsq-get-chat-users (chat-id)
  (flatten (with-db (db)
             (sqlite:execute-to-list db "select user_id from fsq_chat_users where chat_id = ?" chat-id))))

(defun db-fsq-get-user-chats (user-id)
  (flatten (with-db (db)
             (sqlite:execute-to-list db "select chat_id from fsq_chat_users where user_id = ?" user-id))))

(defun db-fsq-set-chat-users (chat-id users)
  (with-db (db)
    (sqlite:with-transaction db
      (sqlite:execute-non-query db "delete from fsq_chat_users where chat_id = ?" chat-id)
      (dolist (user-id users)
        (sqlite:execute-non-query db "insert into fsq_chat_users (chat_id, user_id) values (?, ?)" chat-id user-id)))))

(defun db-fsq-add-seen (id created-at)
  (with-db (db)
    (sqlite:execute-non-query db "insert into fsq_seen (id, created_at) values (?, ?)" id created-at)))

(defun db-fsq-has-seen (id)
  (with-db (db)
    (sqlite:execute-single db "select id from fsq_seen where id = ? limit 1" id)))

(defun db-fsq-last-created ()
  (with-db (db)
    (sqlite:execute-single db "select created_at from fsq_seen order by created_at desc limit 1")))


;; RSS
(defun %make-feed (row)
  (when row
    (make-feed :id (nth 0 row)
               :url (nth 1 row)
               :title (nth 2 row)
               :next-fetch (when (nth 3 row) (local-time:unix-to-timestamp (nth 3 row)))
               :period (nth 4 row))))

(defun db-rss-get-feed-by-url (url)
  (with-db (db)
    (%make-feed (car (sqlite:execute-to-list db "select id, url, title, next_fetch, period from rss_feeds where url = ?" url)))))

(defun db-rss-add-feed (feed)
  (with-slots (url title period) feed
    (let ((next-fetch (feed-next-fetch-unix feed)))
      (with-db (db)
        (sqlite:execute-non-query db "insert into rss_feeds (url, title, next_fetch, period) values (?, ?, ?, ?)"
                                  url title next-fetch period)
        (setf (feed-id feed) (sqlite:last-insert-rowid db))
        feed))))

(defun db-rss-update-feed (feed)
  (with-slots (id title period) feed
    (let ((next-fetch (feed-next-fetch-unix feed)))
      (with-db (db)
        (sqlite:execute-non-query db "update rss_feeds set title = ?, next_fetch = ?, period = ? where id = ?"
                                  title next-fetch period id)))))

(defun db-rss-get-active-feeds ()
  (with-db (db)
    (mapcar #'%make-feed
            (sqlite:execute-to-list db "select id, url, title, next_fetch, period from rss_feeds where exists (select 1 from rss_chat_feeds where feed_id=id)"))))

(defun db-rss-get-chat-feeds (chat-id)
  (with-db (db)
    (mapcar #'%make-feed
            (sqlite:execute-to-list db "select id, url, title, next_fetch, period from rss_feeds where id in (select feed_id from rss_chat_feeds where chat_id  = ?)" chat-id))))

(defun db-rss-get-feed-chats (feed)
  (with-slots (id) feed
    (flatten (with-db (db)
               (sqlite:execute-to-list db "select chat_id from rss_chat_feeds where feed_id = ?" id)))))

(defun db-rss-set-chat-feeds (chat-id feeds)
  (with-db (db)
    (sqlite:with-transaction db
      (sqlite:execute-non-query db "delete from rss_chat_feeds where chat_id = ?" chat-id)
      (dolist (feed feeds)
        (with-slots (id) feed
          (sqlite:execute-non-query db "insert into rss_chat_feeds (chat_id, feed_id) values (?, ?)" chat-id id))))))

(defun db-rss-item-exists (item)
  (let ((feed-id (feed-id (feed-item-feed item)))
        (guid (feed-item-guid item)))
    (with-db (db)
      (sqlite:execute-single db "select id from rss_items where feed_id = ? and guid = ? limit 1"
                             feed-id guid))))

(defun db-rss-add-item (item)
  (let ((feed-id (feed-id (feed-item-feed item)))
        (published (feed-item-published-unix item)))
    (with-slots (guid link title) item
      (with-db (db)
        (sqlite:execute-non-query db "insert into rss_items (feed_id, guid, link, title, published) values (?, ?, ?, ?, ?)"
                                  feed-id guid link title published)))))

(defun %make-feed-item (feed row)
  (when row
    (make-feed-item :feed feed
                    :guid (nth 0 row)
                    :link (nth 1 row)
                    :title (nth 2 row)
                    :published (when (nth 3 row) (local-time:unix-to-timestamp (nth 3 row))))))

(defun db-rss-last-feed-items (feed &optional (limit 10))
  (with-slots (id) feed
    (with-db (db)
      (mapcar #'(lambda (row) (%make-feed-item feed row))
              (sqlite:execute-to-list db "select guid, link, title, published from rss_items where feed_id = ? order by published desc, id desc limit ?" id limit)))))


;; VK
(defun db-vk-ensure-domain (domain last-id)
  (with-db (db)
    (unless (sqlite:execute-single db "select domain from vk_walls where domain = ?" domain)
      (sqlite:execute-non-query db "insert into vk_walls (domain, last_id, period) values (?, ?, 300)" domain last-id))))

(defun db-vk-get-domain-chats (domain)
  (with-db (db)
    (flatten (sqlite:execute-to-list db "select chat_id from vk_chat_walls where domain = ?" domain))))

(defun db-vk-get-chat-domains (chat-id)
  (with-db (db)
    (flatten (sqlite:execute-to-list db "select domain from vk_chat_walls where chat_id  = ?" chat-id))))

(defun db-vk-add-chat-domain (chat-id domain)
  (with-db (db)
    (sqlite:execute-non-query db "insert into vk_chat_walls (chat_id, domain) values (?, ?)" chat-id domain)))

(defun db-vk-remove-chat-domain (chat-id domain)
  (with-db (db)
    (sqlite:execute-non-query db "delete from vk_chat_walls where chat_id = ? and domain = ?" chat-id domain)))

(defun db-vk-get-active-walls ()
  (with-db (db)
    (sqlite:execute-to-list db "select domain, last_id, next_fetch, period from vk_walls w where exists (select 1 from vk_chat_walls where domain=w.domain)")))

(defun db-vk-update-wall (domain last-id next-fetch period)
  (with-db (db)
    (sqlite:execute-to-list db "update vk_walls set last_id = ?, next_fetch = ?, period = ? where domain = ?" last-id next-fetch period domain)))