Coverage report: /home/ellis/comp/core/lib/rdb/rdb.lisp

Kind	Covered	All	%
expression	397	1168	34.0
branch	10	42	23.8

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

(in-package :rdb)

2

3

;;; rdb-opts

4

(flet ((%mktbl (accessor opts)

5

(let ((table (make-hash-table :test #'equal)))

6

(mapc (lambda (x) (setf (gethash (car x) table) (cdr x)))

7

(loop for y across opts

8

collect (cons y (format nil "~:@(~A-set-~x~)" accessor y))))

9

table)))

10

(defvar *rdb-opts-table*

11

(%mktbl 'rocksdb-options *rocksdb-options*))

12

(defvar *rdb-readopts-table*

13

(%mktbl 'rocksdb-readoptions *rocksdb-readoptions*))

14

(defvar *rdb-writeopts-table*

15

(%mktbl 'rocksdb-writeoptions *rocksdb-writeoptions*))

16

(defvar *rdb-backupopts-table*

17

(%mktbl 'rocksdb-backup-engine-options *rocksdb-backup-engine-options*))

18

(defvar *rdb-ingestopts-table*

19

(%mktbl 'rocksdb-ingestexternalfileoptions *rocksdb-ingestexternalfileoptions*))

20

(defvar *rdb-compactopts-table*

21

(%mktbl 'rocksdb-compactoptions *rocksdb-compactoptions*)))

22

23

(eval-always

24

(macrolet ((%def-opt (name &rest set-only)

25

`(progn

26

(defun ,(symbolicate '%set- name) (opt key val)

27

(funcall (,(symbolicate name '-setter) key) opt val))

28

(defun ,(symbolicate '%get- name) (opt key)

29

(if-let ((g (,(symbolicate name '-getter) key)))

30

(funcall g opt)

31

(warn 'opt-handler-missing :message key)))

32

(defun ,(symbolicate '% name '-no-getter-p) (key)

33

(let ((k (typecase key

34

(string (string-downcase key))

35

(symbol (string-downcase (symbol-name key)))

36

(t (string-downcase (format nil "~s" key))))))

37

(memq t (mapcar

38

(lambda (x) (equal k x))

39

',set-only)))))))

40

(%def-opt rdb-opt "parallelism" "enable-statistics")

41

(%def-opt rdb-readopt)

42

(%def-opt rdb-writeopt)

43

(%def-opt rdb-backupopt)

44

(%def-opt rdb-compactopt)

45

(%def-opt rdb-ingestopt))

46

47

(macrolet ((define-rdb-opt-struct (name opts creator &rest defaults)

48

(let ((%name (symbolicate (string-right-trim "S" name)))

49

(%make (symbolicate '%make- name)))

50

`(prog1

51

(defstruct (,name (:constructor ,%make))

52

(table (make-hash-table :test 'equal) :type hash-table)

53

(sap nil :type (or null alien)))

54

(eval-always

55

(defun ,(symbolicate 'make- name) (&rest opts)

56

(let ((obj (,%make :sap (,creator))))

57

(loop for (k v) on opts by #'cddr while v

58

do (let ((k (typecase k

59

                                               (string (string-downcase k))

60

                                               (symbol (string-downcase (symbol-name k)))

61

                                               (t (string-downcase (format nil "~s" k))))))

62

(setf (db-opt obj k) v)))

63

(push-sap* obj)

64

obj))

65

(defun ,(symbolicate 'make- name '*) (alien)

66

                         ,(format nil "Coerce ALIEN into a ~A struct. This function doesn't populate the

67

values in Lisp, just binds the sap." name)

68

(,%make :sap alien))

69

(defaccessor* db-opt

70

((self ,name) key)

71

(gethash key (db-opts self))

72

(val (self ,name) key &key push)

73

(prog1 (setf (gethash key (db-opts self)) val)

74

(when push (push-sap self key))))

75

(defmethod push-sap ((self ,name) key)

76

"Push KEY from slot :TABLE to the instance :SAP."

77

                         (,(symbolicate '%set- %name) (sap self) key (db-opt self key)))

78

(defmethod push-sap* ((self ,name))

79

"Initialized the SAP slot with values from TABLE."

80

(loop for k in (hash-table-keys (db-opts self))

81

                               ;; note how we don't handle any special cases here - we can

82

                               ;; always set an opt but sometimes we can't get it.

83

do (push-sap self k)))

84

(defmethod pull-sap ((self ,name) key)

85

                         (setf (gethash key (db-opts self)) (,(symbolicate '%get- %name) (sap self) key)))

86

(defmethod pull-sap* ((self ,name))

87

(let ((table (db-opts self)))

88

(loop for k in (hash-table-keys table)

89

unless (,(symbolicate '% %name '-no-getter-p) k)

90

do (pull-sap self k))

91

table))

92

(defmethod backfill-opts ((self ,name) &key full)

93

"Backfill the TABLE slot with values from SAP.

94

95

When FULL is non-nil, retrieve the full set of options available, not

96

just the keys currently present in TABLE."

97

(if full

98

(loop for k across ,opts

99

                                   unless (,(symbolicate '% %name '-no-getter-p) k)

100

do (pull-sap self k))

101

(pull-sap* self))

102

(db-opts self))

103

;; (defun ,(symbolicate 'default- name) ())

104

(defaccessor sap ((self ,name)) (,(symbolicate name '-sap) self))

105

                       (defaccessor db-opts ((self ,name)) (,(symbolicate name '-table) self))

106

(defun ,(symbolicate 'default- name) ()

107

(,(symbolicate 'make- name) ,@defaults))

108

                       (defvar ,(symbolicate '*default- name '*) (,(symbolicate 'default- name))))))))

109

(define-rdb-opt-struct rdb-opts *rocksdb-options* rocksdb-options-create

110

:create-if-missing t

111

:create-missing-column-families t

112

:parallelism (num-cpus)

113

:compression (rocksdb-compression-type :zstd))

114

(define-rdb-opt-struct rdb-readopts *rocksdb-readoptions* rocksdb-readoptions-create)

115

(define-rdb-opt-struct rdb-writeopts *rocksdb-writeoptions* rocksdb-writeoptions-create)

116

(define-rdb-opt-struct rdb-compactopts *rocksdb-compactoptions* rocksdb-compactoptions-create)

117

     (define-rdb-opt-struct rdb-backupopts *rocksdb-backup-engine-options* rocksdb-backup-engine-options-create)))

118

119

(defvar *default-kv* (make-kv))

120

121

;;; Iterator

122

(defstruct rdb-iter

123

(sap nil :type (or null (alien (* rocksdb-iterator)))))

124

125

(defaccessor sap ((self rdb-iter)) (rdb-iter-sap self))

126

127

(defmethod iter-valid-p ((self rdb-iter))

128

(rocksdb-iter-valid (sap self)))

129

130

(defmethod seek-to-first ((self rdb-iter))

131

(rocksdb-iter-seek-to-first (rdb-iter-sap self)))

132

133

(defmethod seek-to-last ((self rdb-iter))

134

(rocksdb-iter-seek-to-last (rdb-iter-sap self)))

135

136

(defmethod seek-for-prev ((self rdb-iter) (key vector) &key)

137

(rocksdb-iter-seek-for-prev (rdb-iter-sap self) (octets-to-alien key) (length key)))

138

139

(defmethod seek ((self rdb-iter) (key simple-vector) &key)

140

(rocksdb-iter-seek (rdb-iter-sap self) (octets-to-alien key) (length key)))

141

142

(defmethod next ((self rdb-iter))

143

(rocksdb-iter-next (rdb-iter-sap self)))

144

145

(defmethod prev ((self rdb-iter))

146

(rocksdb-iter-prev (rdb-iter-sap self)))

147

148

(defmethod key ((self rdb-iter))

149

(with-alien ((klen size-t))

150

(let ((key (rocksdb-iter-key (rdb-iter-sap self) (addr klen))))

151

(let ((k (make-octets klen)))

152

(clone-octets-from-alien key k)

153

(values

154

k

155

klen)))))

156

157

(defmethod val ((self rdb-iter))

158

(with-alien ((vlen size-t))

159

(let ((val (rocksdb-iter-value (sap self) (addr vlen))))

160

(let ((v (make-octets vlen)))

161

(clone-octets-from-alien val v)

162

(values

163

v

164

vlen)))))

165

166

(defmethod kv ((self rdb-iter))

167

(make-kv (key self) (val self)))

168

169

(defmethod timestamp ((self rdb-iter))

170

(with-alien ((tslen size-t))

171

(values

172

(rocksdb-iter-timestamp (sap self) (addr tslen))

173

tslen)))

174

175

;;; column family

176

(defstruct (rdb-cf (:constructor make-rdb-cf (name &key opts sap)))

177

"RDB Column Family structure. Contains a name, db-opts,

178

and a system-area-pointer to the underlying rocksdb_cf_t handle."

179

(name "" :type string)

180

(opts (default-rdb-opts) :type rdb-opts)

181

(sap nil :type (or null (alien (* rocksdb-column-family-handle)))))

182

183

(defaccessor column-opts ((self rdb-cf)) (rdb-cf-opts self))

184

(defaccessor sap ((self rdb-cf)) (rdb-cf-sap self))

185

(defaccessor name ((self rdb-cf)) (rdb-cf-name self))

186

187

(defmethod close-column ((self rdb-cf) &optional error)

188

(if-let ((sap (sap self)))

189

(setf (sap self) (rocksdb:rocksdb-column-family-handle-destroy sap))

190

(when error (rdb-error "column family is already closed."))))

191

192

(defmethod merge-key ((self rdb-cf) key val &key db (opts (rocksdb-writeoptions-create)))

193

(merge-cf-raw (sap db) (sap self) key val opts))

194

195

(defmethod merge-kv ((self rdb-cf) kv &key db (opts (rocksdb-writeoptions-create)))

196

(merge-cf-raw (sap db) (sap self) (kv-key kv) (kv-val kv) opts))

197

198

;;; rdb-stats

199

(defstruct (rdb-stats (:constructor make-rdb-stats (&optional sap)))

200

(sap nil :type (or null (alien (* rocksdb-statistics-histogram-data)))))

201

202

(defaccessor sap ((self rdb-stats)) (rdb-stats-sap self))

203

204

;;; metadata

205

(defstruct rdb-cf-metadata

206

(name "default" :type string)

207

(size 0 :type fixnum)

208

(level-count 7 :type fixnum)

209

(file-count 0 :type fixnum)

210

(sap nil :type (or null (alien (* rocksdb-column-family-metadata)))))

211

212

(defaccessor sap ((self rdb-cf-metadata)) (rdb-cf-metadata-sap self))

213

(defaccessor name ((self rdb-cf-metadata)) (rdb-cf-metadata-name self))

214

215

(defmethod db-metadata ((self rdb-cf-metadata) &optional (level 0))

216

(with-slots (sap) self

217

(if (null sap)

218

(warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.")

219

(make-rdb-level-metadata :sap (rocksdb-column-family-metadata-get-level-metadata sap level)))))

220

221

(defmethod print-object ((self rdb-cf-metadata) stream)

222

(print-unreadable-object (self stream :type t)

223

(with-slots (name size level-count file-count) self

224

(format stream "~A :size ~A :levels ~A :files ~A" name size level-count file-count))))

225

226

(defmethod pull-sap* ((self rdb-cf-metadata))

227

(with-slots (name size level-count file-count sap) self

228

(if (null sap)

229

(warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.")

230

(setf name (rocksdb-column-family-metadata-get-name sap)

231

size (rocksdb-column-family-metadata-get-size sap)

232

level-count (rocksdb-column-family-metadata-get-level-count sap)

233

file-count (rocksdb-column-family-metadata-get-file-count sap)))

234

self))

235

236

(defstruct rdb-level-metadata

237

(level 0 :type fixnum)

238

(size 0 :type fixnum)

239

(file-count 0 :type fixnum)

240

(sap nil :type (or null (alien (* rocksdb-level-metadata)))))

241

242

(defaccessor sap ((self rdb-level-metadata)) (rdb-level-metadata-sap self))

243

244

(defmethod db-metadata ((self rdb-level-metadata) &optional (file 0))

245

(if (null (sap self))

246

(warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.")

247

(make-rdb-sst-file-metadata :sap (rocksdb-level-metadata-get-sst-file-metadata (sap self) file))))

248

249

(defmethod print-object ((self rdb-level-metadata) stream)

250

(print-unreadable-object (self stream :type t)

251

(with-slots (level size file-count) self

252

(format stream "~A :size ~A :files ~A" level size file-count))))

253

254

(defmethod pull-sap* ((self rdb-level-metadata))

255

(with-slots (level size file-count sap) self

256

(if (null sap)

257

(warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.")

258

(setf level (rocksdb-level-metadata-get-level sap)

259

size (rocksdb-level-metadata-get-size sap)

260

file-count (rocksdb-level-metadata-get-file-count sap)))

261

self))

262

263

;; NOTE: we only store the sizes of largest and smallest key, not the

264

;; keys themselves. This may change in the future.

265

(defstruct rdb-sst-file-metadata

266

(relative-filename "" :type string)

267

(directory "" :type string)

268

(size 0 :type fixnum)

269

(smallestkey 0 :type fixnum)

270

(largestkey 0 :type fixnum)

271

(sap nil :type (or null (alien (* rocksdb-sst-file-metadata)))))

272

273

(defaccessor sap ((self rdb-sst-file-metadata)) (rdb-sst-file-metadata-sap self))

274

275

(defmethod print-object ((self rdb-sst-file-metadata) stream)

276

(print-unreadable-object (self stream :type t)

277

(with-slots (relative-filename directory size smallestkey largestkey) self

278

(format stream "~A :dir ~A :size ~A :smallest ~A :largest ~A"

279

relative-filename directory size smallestkey largestkey))))

280

281

(defmethod pull-sap* ((self rdb-sst-file-metadata))

282

(with-slots (relative-filename directory size smallestkey largestkey sap) self

283

(if (null sap)

284

(warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.")

285

(with-alien ((ssize size-t 0)

286

(lsize size-t 0))

287

(rocksdb-sst-file-metadata-get-largestkey sap (addr lsize))

288

(rocksdb-sst-file-metadata-get-smallestkey sap (addr ssize))

289

(setf relative-filename (rocksdb-sst-file-metadata-get-relative-filename sap)

290

directory (rocksdb-sst-file-metadata-get-directory sap)

291

size (rocksdb-sst-file-metadata-get-size sap)

292

largestkey lsize

293

smallestkey ssize)))

294

self))

295

296

;;; Snapshots

297

(defstruct rdb-snapshot

298

(sap nil :type (or null (alien (* rocksdb-snapshot)))))

299

300

(defaccessor sap ((self rdb-snapshot)) (rdb-snapshot-sap self))

301

(defmethod id ((self rdb-snapshot)) (rocksdb-snapshot-get-sequence-number (sap self)))

302

303

;;; Checkpoints

304

(defstruct rdb-checkpoint

305

(sap nil :type (or null (alien (* rocksdb-checkpoint))))

306

path)

307

308

(defaccessor sap ((self rdb-checkpoint)) (rdb-checkpoint-sap self))

309

(defaccessor path ((self rdb-checkpoint)) (rdb-checkpoint-path self))

310

311

(defun %make-checkpoint (rdb &optional path)

312

(let ((chk (with-errptr e

313

(make-rdb-checkpoint :sap (rocksdb-checkpoint-object-create (sap rdb) e)))))

314

(when path (setf (path chk) path))

315

chk))

316

317

;;; SST

318

(defstruct (sst-file-writer (:constructor %make-sst-file-writer (sap)))

319

(sap nil :type (or null (alien (* rocksdb-sstfilewriter)))))

320

321

(defun make-sst-file-writer (&optional comparator

322

env-opts

323

io-opts)

324

(let ((env (or env-opts (rocksdb-envoptions-create)))

325

(io (or io-opts (rocksdb-options-create))))

326

(%make-sst-file-writer

327

(if comparator

328

(create-sst-writer-with-comparator-raw comparator env io)

329

(create-sst-writer-raw env io)))))

330

331

(defun sst-file-size (writer)

332

(declare (sst-file-writer writer))

333

(sst-file-size-raw (sst-file-writer-sap writer)))

334

335

(defun open-sst (writer path)

336

(declare (sst-file-writer writer))

337

(open-sst-writer-raw (sst-file-writer-sap writer) path))

338

339

(defun finish-sst (writer)

340

(declare (sst-file-writer writer))

341

(finish-sst-writer-raw (sst-file-writer-sap writer)))

342

343

(defun destroy-sst (writer)

344

(declare (sst-file-writer writer))

345

(with-slots (sap) writer

346

(unless (null sap)

347

(destroy-sst-writer-raw sap)

348

(setf sap nil))))

349

350

(defmethod print-object ((self sst-file-writer) stream)

351

(print-unreadable-object (self stream :type t :identity t)

352

(format stream ":size ~A" (when (sst-file-writer-sap self) (sst-file-size self)))))

353

354

(defmethod put-key ((self sst-file-writer) key val)

355

(sst-put-raw (sst-file-writer-sap self) key val))

356

357

(defmethod put-key ((self sst-file-writer) (key simple-string) (val simple-string))

358

(sst-put-str-raw (sst-file-writer-sap self) key val))

359

360

(defmethod put-kv ((self sst-file-writer) (kv kv))

361

(sst-put-raw (sst-file-writer-sap self)

362

(kv-key kv) (kv-val kv)))

363

364

(defmethod delete-key ((self sst-file-writer) key &key)

365

(sst-delete-raw (sst-file-writer-sap self) key))

366

367

(defmethod delete-key-ts ((self sst-file-writer) key ts)

368

(sst-delete-ts-raw (sst-file-writer-sap self) key ts))

369

370

(defmethod delete-key-range ((self sst-file-writer) start end &key)

371

(sst-delete-range-raw (sst-file-writer-sap self) start end))

372

373

(defmethod put-key-ts ((self sst-file-writer) key val ts)

374

(sst-put-ts-raw (sst-file-writer-sap self) key val ts))

375

376

;;; rdb

377

(defstruct rdb

378

(name "" :type string)

379

(opts (default-rdb-opts) :type rdb-opts)

380

(sap nil :type (or null (alien (* rocksdb)))))

381

382

(defaccessor sap ((self rdb)) (rdb-sap self))

383

(defaccessor name ((self rdb)) (rdb-name self))

384

(defaccessor db ((self rdb)) (sap self))

385

(defaccessor db-opts ((self rdb)) (rdb-opts self))

386

387

(defmethod print-object ((self rdb) stream)

388

(print-unreadable-object (self stream :type t :identity t)

389

(format stream ":open ~A" (db-open-p self))))

390

391

(defmethod db-open-p ((self rdb))

392

(when (sap self) t))

393

394

(defmethod db-closed-p ((self rdb))

395

(unless (sap self) t))

396

397

(defun create-rdb (name &key opts schema open)

398

"Construct a new RDB instance from NAME.

399

400

OPTS = rdb-opts

401

CFS = (sequence rdb-cf)

402

SCHEMA = rdb-schema

403

OPEN = boolean

404

405

CFS are always added before the SCHEMA which is loaded with LOAD-SCHEMA.

406

407

When OPEN is non-nil, the database and all column families are opened and

408

internal sap slots are initialized."

409

(when (probe-file name) (log:trace! "attempting to create existing db: ~A" name))

410

(let* ((opts (or opts (default-rdb-opts)))

411

(obj

412

(make-rdb

413

:name

414

(string-right-trim '(#\/)

415

(typecase name

416

(pathname (namestring name))

417

(string name)

418

(t (error "invalid NAME: ~S" name))))

419

:opts opts)))

420

(when schema

421

(load-schema obj schema))

422

(when open

423

(open-db obj))

424

obj))

425

426

(defmethod backfill-opts ((self rdb) &key full)

427

(with-slots (opts) self

428

(if full

429

(loop for k across *rocksdb-options*

430

unless (%rdb-opt-no-getter-p k)

431

do (pull-sap opts k))

432

(pull-sap* opts))

433

(db-opts opts)))

434

435

(defmethod open-column ((self rdb) (col rdb-cf) &key)

436

(ifret (sap col)

437

(setf (sap col) (create-column self col))))

438

439

(defmethod create-column ((db rdb) (cf rdb-cf))

440

(create-cf-raw (sap db) (name cf) (sap (column-opts cf))))

441

442

(defmacro unless-null-db (slots self &body body)

443

`(with-slots (sap ,@slots) ,self

444

(unless (null sap)

445

,@body)))

446

447

(defmethod destroy-column ((cf rdb-cf) &optional error)

448

(with-slots (sap) cf

449

(unless (and (null sap) (when error (std-error "column is already closed")))

450

(setf sap (destroy-cf-raw sap)))))

451

452

(defaccessor* db-opt

453

((self rdb) key) (db-opt (db-opts self) key)

454

(new (self rdb) key &key push)

455

(prog1 (setf (db-opt (db-opts self) key) new)

456

(when push (push-sap (db-opts self) key))))

457

458

(defmethod push-opts ((self rdb))

459

(with-slots (opts) self

460

(push-sap* opts)))

461

462

(defmethod open-db ((self rdb))

463

(with-slots (name sap opts) self

464

(if sap

465

(progn

466

(cerror "Ignore and continue" 'open-db-error

467

:db sap

468

:message "Database is already open")

469

sap)

470

(setf sap (open-db-raw name (sap opts))))))

471

472

(defmethod db-prop ((self rdb) (propname string))

473

(unless-null-db () self

474

(rocksdb-property-value sap propname)))

475

476

(defmethod repair-db ((self rdb) &key)

477

(repair-db-raw (rdb-name self)))

478

479

(defmethod open-backup-engine ((self rdb) &key path)

480

(with-slots (opts) self

481

(open-backup-engine-raw path (sap opts))))

482

483

(defmethod backup-db ((self rdb) &key path)

484

(unless-null-db (opts) self

485

(if (null path)

486

(error 'open-backup-engine-error :db sap

487

                                          :message "PATH must not be nil when no backups exist")

488

(create-new-backup-raw (open-backup-engine self :path path) sap))))

489

490

(defmethod restore-db ((self rdb) (from string) &key id opts)

491

(unless-null-db (name) self

492

(restore-from-backup-raw (open-backup-engine self :path from) name from id opts)))

493

494

(defmethod snapshot-db ((self rdb))

495

(unless-null-db () self

496

(make-rdb-snapshot :sap (create-snapshot-raw sap))))

497

498

(defmethod db-metadata ((self rdb) &optional cf)

499

(make-rdb-cf-metadata :sap (get-metadata-raw (rdb-sap self) cf)))

500

501

(defmethod db-stats ((self rdb) &optional (htype (rocksdb-statistics-level "all")))

502

(make-rdb-stats (get-stats-raw (sap (rdb-opts self)) htype)))

503

504

(defmethod iter ((self rdb) &key cf (opts (rocksdb-readoptions-create)))

505

(let ((col (etypecase cf

506

(rdb-cf (rdb-cf-sap cf))

507

;; (string (rdb-cf-sap (find-column cf self)))

508

(null nil)

509

(alien cf))))

510

(unless-null-db () self

511

(make-rdb-iter :sap (if col

512

(create-cf-iter-raw sap col opts)

513

(create-iter-raw sap opts))))))

514

515

(defmethod print-stats ((self rdb) &optional stream)

516

(print (rocksdb-options-statistics-get-string (sap (rdb-opts self))) stream))

517

518

(defmethod flush-db ((self rdb) &key wait)

519

(flush-db-raw (rdb-sap self) wait))

520

521

(defmethod sync-db ((self rdb) (other null) &key wait)

522

(flush-db self :wait wait))

523

524

(defmethod shutdown-db ((self rdb) &key wait)

525

(log:trace! "shutting down database" (rdb-name self))

526

(when-let ((db (rdb-sap self)))

527

(rocksdb-cancel-all-background-work db wait)

528

(close-db self)))

529

530

(defmethod ingest-db ((self rdb) (files list) &key column (opts (rocksdb-ingestexternalfileoptions-create)))

531

(if column

532

(ingest-db-cf-raw (sap self) (sap column) files opts)

533

(ingest-db-raw (sap self) files opts)))

534

535

(defmethod close-db ((self rdb) &key &allow-other-keys)

536

(with-slots (sap opts) self

537

(unless (null sap)

538

(close-db-raw sap)

539

(setf (sap self) nil)

540

(setf (sap (db-opts self)) (rocksdb:rocksdb-options-destroy (sap (db-opts self)))))))

541

542

(defmethod destroy-db ((self rdb))

543

;; close all handles before destruction ensues

544

(close-db self)

545

(destroy-db-raw (rdb-name self)))

546

547

(defmethods put-key

548

(((self rdb) (key t) (val t))

549

(put-kv-raw

550

(rdb-sap self)

551

key

552

val))

553

(((self rdb) (key string) (val string))

554

(put-kv-raw

555

(rdb-sap self)

556

(sb-ext:string-to-octets key)

557

(sb-ext:string-to-octets val))))

558

559

(defmethod put-kv ((self rdb) (kv kv))

560

(put-kv-raw

561

(sap self)

562

(kv-key kv)

563

(kv-val kv)))

564

565

(defmethod multi-get ((self rdb) keys &key (data-type 'octet-vector) (opts (rocksdb-readoptions-create)) cf)

566

(if cf

567

(ecase data-type

568

(octet-vector (multi-get-cf-kv-raw (sap self) keys opts (sap cf)))

569

(string (multi-get-cf-kv-str-raw (sap self) keys opts (sap cf))))

570

(ecase data-type

571

(octet-vector (multi-get-kv-raw (sap self) keys opts))

572

(string (multi-get-kv-str-raw (sap self) keys opts)))))

573

574

(defmethod get-value ((self rdb) key)

575

(get-kv-raw (sap self) key (rocksdb-readoptions-create)))

576

577

(defmethod merge-key ((self rdb) key val &key (opts (rocksdb-writeoptions-create)))

578

(merge-kv-raw (sap self) key val opts))

579

580

(defmethod merge-key ((self rdb) (key string) (val string) &key (opts (rocksdb-writeoptions-create)))

581

(merge-kv-str-raw (sap self) key val opts))

582

583

(defmethod merge-kv ((self rdb) kv &key (opts (rocksdb-writeoptions-create)))

584

(merge-kv-raw (sap self) (kv-key kv) (kv-val kv) opts))

585

586

;;; Transaction DB

587

(defstruct rdb-transaction-db

588

(sap nil :type (or null (alien (* rocksdb-transactiondb))))

589

(opts (rocksdb-transactiondb-options-create)))

590

591

(defaccessor sap ((self rdb-transaction-db)) (rdb-transaction-db-sap self))

592

(defaccessor db-opts ((self rdb-transaction-db)) (rdb-transaction-db-opts self))

593

594

(defstruct rdb-optimistic-transaction-db

595

(sap nil :type (or null (alien (* rocksdb-optimistictransactiondb)))))

596

597

(defaccessor sap ((self rdb-optimistic-transaction-db)) (rdb-optimistic-transaction-db-sap self))

598

599

(defmethod open-transaction-db ((self rdb) &key path db-opts opts optimistic)

600

(let ((db-opts (or db-opts (default-rocksdb-options)))

601

(opts (or opts (rocksdb-transactiondb-options-create))))

602

(if optimistic

603

(make-rdb-optimistic-transaction-db

604

:sap (open-optimistictransactiondb-raw db-opts path))

605

(make-rdb-transaction-db

606

:sap (open-transactiondb-raw db-opts opts path)

607

:opts opts))))

608

609

(defmethod close-transaction-db ((self rdb-transaction-db))

610

(when-let ((sap (sap self)))

611

(rocksdb-transactiondb-close sap)))

612

613

(defmethod close-transaction-db ((self rdb-optimistic-transaction-db))

614

(when-let ((sap (sap self)))

615

(rocksdb-optimistictransactiondb-close sap)))

616

617

(defmethods get-val

618

(((self rdb-transaction-db) (key string) &key opts cf pinned)

619

(let ((sap (sap self))

620

(opts (or opts (rocksdb-readoptions-create))))

621

(if cf

622

(transactiondb-get-cf-str-raw sap (rdb-cf-sap (find-column cf self)) key opts pinned)

623

(transactiondb-get-kv-str-raw sap key opts pinned))))

624

(((self rdb-optimistic-transaction-db) (key string) &key opts cf pinned)

625

(let ((sap (sap self))

626

(opts (or opts (rocksdb-readoptions-create))))

627

(if cf

628

(transactiondb-get-cf-str-raw sap (rdb-cf-sap (find-column cf self)) key opts pinned)

629

(transactiondb-get-kv-str-raw sap key opts pinned))))

630

(((self rdb) key &key opts cf pinned)

631

(let ((opts (or opts (rocksdb-readoptions-create))))

632

(with-slots (sap) self

633

(etypecase cf

634

(rdb-cf (get-cf-raw sap (sap cf) key opts pinned))

635

(null (get-kv-raw sap key opts pinned))

636

(alien (get-cf-raw sap cf key opts pinned))))))

637

(((self rdb) (key string) &key opts cf pinned)

638

    (octets-to-string (get-val self (string-to-octets key) :opts (or opts (rocksdb-readoptions-create)) :cf cf :pinned pinned))))

639

640

(defmethod get-value ((self rdb-transaction-db) key)

641

(transactiondb-get-kv-raw self key))

642

643

;;; Transaction

644

(defstruct rdb-transaction

645

(sap nil :type (or null (alien (* rocksdb-transaction)))))

646

647

(defaccessor sap ((self rdb-transaction)) (rdb-transaction-sap self))

648

(defaccessor name ((self rdb-transaction)) (transaction-name-raw (sap self)))

649

650

(defmethod transaction-object-p ((self rdb-transaction)) t)

651

652

(defmethods make-transaction

653

(((self rdb-transaction-db)

654

&key name

655

txn

656

opts

657

write-opts)

658

(let ((opts (or opts (rocksdb-transaction-options-create)))

659

(write-opts (or write-opts (rocksdb-writeoptions-create))))

660

(let ((obj (make-rdb-transaction

661

:sap (rocksdb-transaction-begin (sap self) write-opts opts txn))))

662

(when name (setf (name obj) name))

663

obj)))

664

(((self rdb-optimistic-transaction-db)

665

&key name

666

txn

667

opts

668

write-opts)

669

(let ((opts (or opts (alien-sap (rocksdb-transaction-options-create))))

670

(write-opts (or write-opts (rocksdb-writeoptions-create))))

671

(let ((obj (make-rdb-transaction

672

:sap (rocksdb-optimistictransaction-begin (sap self) write-opts opts txn))))

673

(when name (setf (name obj) name))

674

obj))))

675

676

(defmethod prepare-transaction ((self rdb-transaction) &key)

677

(prepare-transaction-raw (sap self)))

678

679

(defmethod rollback-transaction ((self rdb-transaction) &key savepoint)

680

(rollback-transaction-raw (sap self) savepoint))

681

682

(defmethod abort-transaction ((self rdb-transaction) &key)

683

(rollback-transaction self)

684

(rocksdb-transaction-destroy (sap self)))

685

686

(defmethod commit-transaction ((self rdb-transaction) &key)

687

(commit-transaction-raw (sap self)))

688

689

(defun rdb-transaction-wbwi (self)

690

(rocksdb-transaction-get-writebach-wi (sap self)))

691

692

;;; Secondary DB

693

(defstruct rdb-secondary-db

694

(sap nil :type (or null (alien (* rocksdb))))

695

opts)

696

697

(defaccessor sap ((self rdb-secondary-db)) (rdb-secondary-db-sap self))

698

(defaccessor db-opts ((self rdb-secondary-db)) (rdb-secondary-db-opts self))

699

700

(defmethod open-secondary-db ((self rdb) &key path opts)

701

(make-rdb-secondary-db

702

:sap (open-db-secondary-raw opts (name self) path)

703

:opts opts))

704

705

(defmethod close-secondary-db ((self rdb-secondary-db))

706

(rocksdb-close (sap self)))

707

708

;;; Backup DB

709

(defstruct rdb-backup-engine

710

(sap nil :type (or null (alien (* rocksdb-backup-engine))))

711

opts)

712

713

(defaccessor sap ((self rdb-backup-engine)) (rdb-backup-engine-sap self))

714

(defaccessor db-opts ((self rdb-backup-engine)) (rdb-backup-engine-opts self))

715

716

(defmethod open-backup-engine ((self rdb-backup-engine) &key path)

717

(setf (sap self) (open-backup-engine-raw path (db-opts self))))

718

719

(defmethod close-backup-engine ((self rdb-backup-engine))

720

(close-backup-engine-raw (sap self)))

721

722

(defun rdb-backup-engine-info (be)

723

(etypecase be

724

(rdb-backup-engine (rocksdb-backup-engine-get-backup-info (sap be)))

725

(alien (rocksdb-backup-engine-get-backup-info be))))

726

727

;;; Write Batches

728

(defstruct rdb-writebatch

729

(sap nil :type (or null (alien (* rocksdb-writebatch)))))

730

731

(defaccessor sap ((self rdb-writebatch)) (rdb-writebatch-sap self))

732

(defmethod iter ((self rdb-writebatch) &key)

733

(rocksdb-writebatch-iterate (sap self) nil nil (alien-callable-function 'rocksdb-delete-value)))

734

(defun rdb-writebatch-data (wb &optional size)

735

(rocksdb-writebatch-data wb size))

736

737

;; WBWIs consist of a WriteBatch and an Index

738

(defstruct rdb-wbwi ;; wb reserved overwrite-key data savepoints params

739

(sap (create-wbwi) :type (or null (alien (* rocksdb-writebatch-wi)))))

740

741

(defaccessor sap ((self rdb-wbwi)) (rdb-wbwi-sap self))

742

(defun rdb-wbwi-count (self) (rocksdb-writebatch-wi-count (sap self)))

743

(defun rdb-wbwi-data (wbwi &optional size)

744

(rocksdb-writebatch-wi-data (sap wbwi) size))

745

(defmethod iter ((self rdb-wbwi) &key)

746

(rocksdb-writebatch-wi-iterate (sap self) nil nil (sb-alien:alien-callable-function 'rocksdb-delete-value)))

747

(defun rdb-wbwi-clear (wbwi)

748

(rocksdb-writebatch-wi-clear (sap wbwi)))

749

(defun rdb-wbwi-save (self)

750

(rocksdb-writebatch-wi-set-save-point self))

751

(defun rdb-wbwi-ts (self ts)

752

(with-errptr e

753

(rocksdb-writebatch-wi-update-timestamps

754

(sap self) (octets-to-alien ts) (length ts) nil nil e)))

755

(defmethod destroy-db ((self rdb-wbwi))

756

(setf (sap self) (rocksdb-writebatch-wi-destroy (sap self))))

757

(defmethod put-key ((self rdb-wbwi) (key vector) (val vector))

758

(rocksdb-writebatch-wi-put

759

(sap self)

760

(cast (octets-to-alien key) (array unsigned-char))

761

(length key)

762

(cast (octets-to-alien val) (array unsigned-char))

763

(length val)))

764

(defmethod put-key ((self rdb-wbwi) (key string) (val string))

765

(put-key self (string-to-octets key) (string-to-octets val)))

766

(defmethod put-kv ((self rdb-wbwi) (kv kv))

767

(put-key self (kv-key kv) (kv-val kv)))

768

(defmethod get-key ((self rdb-wbwi) (key string) &key)

769

(with-errptr e

770

(with-alien ((i size-t))

771

(std:clone-octets-from-alien

772

(rocksdb-writebatch-wi-get-from-batch

773

(sap self)

774

(default-rocksdb-options)

775

(cast (octets-to-alien (string-to-octets key)) (array unsigned-char))

776

(length key)

777

(addr i)

778

e)

779

(make-octets i)))))

780

781

(defun rdb-write (db batch &optional opts)

782

   (with-errptr e (rocksdb-write-writebatch-wi (sap db) (sap (or opts (make-rdb-writeopts))) (sap batch) e)))

783

784

(defun wbwi-put-kv-cf (wbwi column kv)

785

(wbwi-put-cf-raw (sap wbwi) (sap column) (kv-key kv) (kv-val kv)))

786

787

;;; Env

788

(defstruct rdb-env

789

(sap nil :type (or null (alien (* rocksdb-env))))

790

path

791

threads)

792

793

(defaccessor sap ((self rdb-env)) (rdb-env-sap self))

794

(defaccessor path ((self rdb-env)) (rdb-env-path self))

795

796

;;; Logger

797

(defun rdb-log-default (level &optional prefix)

798

(if prefix

799

(rocksdb-logger-create-stderr-logger level prefix)

800

(rocksdb-logger-create-callback-logger

801

level

802

(alien-sap (alien-callable-function 'rocksdb-log-default))

803

nil)))