keystore/keystore.rkt

#lang racket/base

(require racket/contract
         racket/serialize
         racket/port
         db
         )

(provide ks-open
         ks-close
         ks-set!
         ks-get
         ks-drop!
         ks-exists?
         ks-keys
         ks-keys-glob
         ks-key-values-glob
         ks-key-values
         ks-key-values-raw
         ks-keys-raw
         ks-key-count
         ks-transaction
         ks-commit
         )

(define-struct keystore
  (file path dbh)
  #:transparent
  )

(define keystore*? keystore?)
(set! keystore? (λ (ks)
                  (and (keystore*? ks)
                       (connection? (keystore-dbh ks))
                       (connected? (keystore-dbh ks)))))

(define/contract (ks-open file)
  (-> (or/c path? string? symbol?) keystore?)
  (let ((path (if (symbol? file)
                  (build-path (find-system-path 'cache-dir) (format "ks-~a.db" file))
                  (build-path file))))
    (let ((dbh (sqlite3-connect #:database path #:mode 'create)))
      (query-exec dbh "CREATE TABLE IF NOT EXISTS keystore(key varchar primary key, value varchar, str_key varchar);")
      (query-exec dbh "CREATE INDEX IF NOT EXISTS keystore_idx on keystore(str_key);")
      (make-keystore file path dbh))))

(define/contract (ks-close ksh)
  (-> keystore? boolean?)
  (let ((dbh (keystore-dbh ksh)))
    (disconnect dbh)
    #t))

(define/contract (ks-set! ksh key value)
  (-> keystore? any/c any/c boolean?)
   (ks-set!* (keystore-dbh ksh) (value->string key) (format "~a" key) (value->string value)))

(define/contract (ks-exists? ksh key)
  (-> keystore? any/c boolean?)
  (ks-exists?* (keystore-dbh ksh) (value->string key)))

(define/contract (ks-get ksh key . default-value)
  (-> keystore? any/c ... any/c any/c)
  (ks-get* (keystore-dbh ksh) (value->string key) default-value))

(define/contract (ks-drop! ksh key)
  (-> keystore? any/c boolean?)
  (ks-drop!* (keystore-dbh ksh) (value->string key)))

(define/contract (ks-key-values-glob ksh gl)
  (-> keystore? string? list?)
  (map (λ (row)
         (cons (string->value (vector-ref row 0)) (string->value (vector-ref row 1))))
       (query-rows (keystore-dbh ksh)
                   "SELECT key, value FROM keystore WHERE str_key GLOB $1"
                   (string-downcase gl))))

(define/contract (ks-key-count ksh)
  (-> keystore? number?)
  (let ((l (query-rows (keystore-dbh ksh)
                       "SELECT count(*) FROM keystore")))
    (vector-ref (car l) 0)))

(define/contract (ks-keys-glob ksh sqlite-like)
  (-> keystore? string? list?)
  (map (λ (row)
         (string->value (vector-ref row 0)))
       (query-rows (keystore-dbh ksh)
                   "SELECT key FROM keystore WHERE str_key GLOB $1"
                   (string-downcase sqlite-like))))

(define/contract (ks-keys ksh)
  (-> keystore? list?)
  (ks-keys* (keystore-dbh ksh)))

(define/contract (ks-key-values ksh)
  (-> keystore? list?)
  (ks-key-values* (keystore-dbh ksh)))

(define/contract (ks-keys-raw ksh)
  (-> keystore? list?)
  (map vector->list 
       (query-rows (keystore-dbh ksh) "SELECT key, str_key FROM keystore")))

(define/contract (ks-key-values-raw ksh)
  (-> keystore? list?)
  (map vector->list 
       (query-rows (keystore-dbh ksh) "SELECT key, str_key, value FROM keystore")))

(define-syntax ks-transaction
  (syntax-rules ()
    ((_ ks b1 ...)
     (with-handlers ([exn? (λ (e)
                             (query-exec (keystore-dbh ks) "ROLLBACK")
                             (raise e))])
       (query-exec (keystore-dbh ks) "BEGIN")
       (let ((r (begin b1 ...)))
         (query-exec (keystore-dbh ks) "COMMIT")
         r)))))

(define/contract (ks-commit ks)
  (-> keystore? boolean?)
  (query-exec (keystore-dbh ks) "COMMIT")
  (query-exec (keystore-dbh ks) "BEGIN")
  #t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal working
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (ks-set!* dbh key str-key value)
  (query-exec dbh "INSERT OR REPLACE INTO keystore VALUES($1, $2, $3)"
              key value (string-downcase str-key))
  #t)

(define (ks-exists?* dbh key)
  (> (query-value dbh "SELECT COUNT(*) FROM keystore WHERE key = $1" key) 0))

(define (ks-get* dbh key default-value)
  (if (ks-exists?* dbh key)
      (string->value (query-value dbh "SELECT value FROM keystore WHERE key = $1" key))
      (if (null? default-value)
          'ks-nil
          (car default-value))
      )
  )

(define (ks-drop!* dbh key)
  (query-exec dbh "DELETE FROM keystore WHERE key = $1" key)
  #t)

(define (ks-keys* dbh)
  (map (λ (row)
         (string->value (vector-ref row 0)))
       (query-rows dbh "SELECT key FROM keystore")))

(define (ks-key-values* dbh)
  (map (λ (row)
         (cons (string->value (vector-ref row 0))
               (string->value (vector-ref row 1))))
       (query-rows dbh "SELECT key, value FROM keystore")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; serialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (value->string v)
  (call-with-output-string
   (λ (out) (write (serialize v) out))))

(define (string->value v)
  (deserialize
   (call-with-input-string v (λ (in) (read in)))))