1.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2+++ b/lisp/lib/rdb/pkg.lisp Mon Oct 23 23:33:06 2023 -0400
1.3@@ -0,0 +1,205 @@
1.4+;;; rdb.lisp --- High-level RocksDB API
1.5+
1.6+;; a thin ORM for working with RocksDB storage.
1.7+
1.8+;; Low-level bindings are in rocksdb.lisp.
1.9+
1.10+;; Commentary:
1.11+
1.12+;; Code:
1.13+(uiop:define-package :rdb/pkg
1.14+ (:nicknames :rdb)
1.15+ (:use :cl :std/alien :std/fu :rocksdb)
1.16+ (:import-from :sb-ext :string-to-octets :octets-to-string)
1.17+ (:reexport :rocksdb)
1.18+ (:export
1.19+ ;; opts
1.20+ :make-rdb-opts
1.21+ :rdb-opts
1.22+ :default-rdb-opts
1.23+ ;; db
1.24+ :open-db
1.25+ :with-open-db
1.26+ ;; iter
1.27+ :create-iter :with-iter
1.28+ :iter-key :iter-key-str
1.29+ :iter-val :iter-val-str
1.30+ ;; err
1.31+ :unable-to-open-db
1.32+ :unable-to-put-key-value-to-db
1.33+ :unable-to-get-value-to-db))
1.34+
1.35+(in-package :rdb/pkg)
1.36+
1.37+(defstruct rdb-opts
1.38+ (create-if-missing nil :type boolean)
1.39+ (total-threads 1 :type integer) ;; numcpus is default
1.40+ (max-open-files 10000 :type integer)
1.41+ (use-fsync nil :type boolean)
1.42+ (disable-auto-compations nil :type boolean))
1.43+
1.44+;; unsafe
1.45+(defun bind-rocksdb-opts% (opts)
1.46+ (let ((o (rocksdb-options-create)))
1.47+ (with-slots (create-if-missing total-threads) opts
1.48+ (rocksdb-options-set-create-if-missing o create-if-missing)
1.49+ (rocksdb-options-increase-parallelism o total-threads))
1.50+ o))
1.51+
1.52+(defun default-rdb-opts ()
1.53+ (make-rdb-opts
1.54+ :create-if-missing t
1.55+ :total-threads 4))
1.56+
1.57+(defun default-rocksdb-options% ()
1.58+ (bind-rocksdb-opts% (default-rdb-opts)))
1.59+
1.60+(defmacro with-open-db ((db-var db-path &optional opt) &body body)
1.61+ `(let ((,db-var (open-db ,db-path ,opt)))
1.62+ (unwind-protect (progn ,@body)
1.63+ (rocksdb-close ,db-var))))
1.64+
1.65+(defmacro with-iter ((iter-var db &optional opt) &body body)
1.66+ `(let ((,iter-var (create-iter ,db ,opt)))
1.67+ (unwind-protect (progn ,@body)
1.68+ (rocksdb-iter-destroy ,iter-var))))
1.69+
1.70+;;; Conditions
1.71+(define-condition unable-to-open-db (error)
1.72+ ((db-path :initarg :db-path
1.73+ :reader db-path)
1.74+ (error-message :initarg :error-message
1.75+ :reader error-message)))
1.76+
1.77+(defmethod print-object ((obj unable-to-open-db) stream)
1.78+ (print-unreadable-object (obj stream :type t :identity t)
1.79+ (format stream "error-message=~A" (error-message obj))))
1.80+
1.81+(define-condition unable-to-put-key-value-to-db (error)
1.82+ ((db :initarg :db
1.83+ :reader db)
1.84+ (key :initarg :key
1.85+ :reader key)
1.86+ (val :initarg :val
1.87+ :reader val)
1.88+ (error-message :initarg :error-message
1.89+ :reader error-message)))
1.90+
1.91+(define-condition unable-to-get-value-to-db (error)
1.92+ ((db :initarg :db
1.93+ :reader db)
1.94+ (key :initarg :key
1.95+ :reader key)
1.96+ (error-message :initarg :error-message
1.97+ :reader error-message)))
1.98+
1.99+;;; API
1.100+(defun open-db (db-path &optional opts)
1.101+ (let ((opts (if opts (bind-rocksdb-opts% opts) (default-rocksdb-options%))))
1.102+ (with-alien ((e rocksdb-errptr))
1.103+ (let* ((db-path (if (pathnamep db-path)
1.104+ (namestring db-path)
1.105+ db-path))
1.106+ (db (rocksdb-open opts db-path e)))
1.107+ (if (null-alien e)
1.108+ db
1.109+ (error 'unable-to-open-db
1.110+ :db-path db-path
1.111+ :error-message e))))))
1.112+
1.113+(defun put-kv (db key val &optional opts)
1.114+ (let ((opts (or opts (rocksdb-writeoptions-create)))
1.115+ (klen (length key))
1.116+ (vlen (length val)))
1.117+ (with-alien ((errptr rocksdb-errptr nil)
1.118+ (k (* char) (make-alien char klen))
1.119+ (v (* char) (make-alien char vlen)))
1.120+ (loop for x across key
1.121+ for i from 0 below klen
1.122+ do (setf (deref k i) x))
1.123+ (loop for y across val
1.124+ for i from 0 below vlen
1.125+ do (setf (deref v i) y))
1.126+ (rocksdb-put db
1.127+ opts
1.128+ k
1.129+ klen
1.130+ v
1.131+ vlen
1.132+ errptr)
1.133+ (unless (null-alien errptr)
1.134+ (error 'unable-to-put-key-value-to-db
1.135+ :db db
1.136+ :key key
1.137+ :val val
1.138+ :error-message (alien-sap errptr))))))
1.139+
1.140+(defun put-kv-str (db key val &optional opt)
1.141+ (let ((key-octets (string-to-octets key))
1.142+ (val-octets (string-to-octets val)))
1.143+ (put-kv db key-octets val-octets opt)))
1.144+
1.145+(defun get-kv (db key &optional opt)
1.146+ (let ((opt (or opt (rocksdb-readoptions-create)))
1.147+ (key (string-to-octets key))
1.148+ (klen (length key)))
1.149+ (with-alien ((vlen (* size-t))
1.150+ (errptr rocksdb-errptr nil)
1.151+ (k (* char) (make-alien char klen)))
1.152+ (loop for x across key
1.153+ for i from 0 below klen
1.154+ do (setf (deref k i) x))
1.155+
1.156+ (let* ((val (rocksdb-get db
1.157+ opt
1.158+ k
1.159+ klen
1.160+ vlen
1.161+ errptr))
1.162+ (vlen (deref vlen)))
1.163+ (unless (null-alien errptr)
1.164+ (error 'unable-to-get-value-to-db
1.165+ :db db
1.166+ :key key
1.167+ :error-message (alien-sap errptr)))
1.168+ ;; helps if we know the vlen beforehand, would need a custom
1.169+ ;; C-side function probably.
1.170+ (let ((v (make-array vlen :element-type 'unsigned-byte)))
1.171+ (loop for i from 0 below vlen
1.172+ with x = (deref val i)
1.173+ do (setf (aref v i) x))
1.174+ (map 'vector #'code-char v))))))
1.175+
1.176+ (defun get-kv-str (db key &optional opt)
1.177+ (let ((k (string-to-octets key)))
1.178+ (let ((v (get-kv db k opt)))
1.179+ (when v (print v)))))
1.180+
1.181+(defun create-iter (db &optional opt)
1.182+ (unless opt
1.183+ (setq opt (rocksdb-readoptions-create)))
1.184+ (rocksdb-create-iterator db opt))
1.185+
1.186+(defun iter-key (iter)
1.187+ (with-alien ((klen-ptr (* unsigned-int)))
1.188+ (let* ((key-ptr (rocksdb-iter-key iter klen-ptr))
1.189+ (klen (deref klen-ptr))
1.190+ (k (make-array klen :element-type '(unsigned-byte 8))))
1.191+ (loop for i from 0 below klen with x = (deref key-ptr i) do (setf (aref k i) x))
1.192+ k)))
1.193+
1.194+(defun iter-key-str (iter)
1.195+ (when-let ((k (iter-key iter)))
1.196+ (octets-to-string k)))
1.197+
1.198+ (defun iter-val (iter)
1.199+ (with-alien ((vlen-ptr (* unsigned-int)))
1.200+ (let* ((val-ptr (rocksdb-iter-value iter vlen-ptr))
1.201+ (vlen (deref vlen-ptr))
1.202+ (v (make-array vlen :element-type '(unsigned-byte 8))))
1.203+ (loop for i from 0 below vlen with x = (deref val-ptr i) do (setf (aref v i) x))
1.204+ v)))
1.205+
1.206+ (defun iter-val-str (iter)
1.207+ (when-let ((v (iter-val iter)))
1.208+ (octets-to-string v)))
