feat: implement Pocketbook — a Clojure-native synced atom
Offline-first key-value store with atom interface (swap!, deref, add-watch) that syncs to a SQLite-backed server over Transit. Server (CLJ): - SQLite storage with Nippy serialization preserving all Clojure types - GET /sync?group=G&since=T pull endpoint with prefix-based groups - POST /sync push endpoint with per-document version checking - Conflict detection (stale write rejection) - Token-based auth with per-user group access - CORS support, soft deletes, purge compaction Client (CLJS): - IndexedDB wrapper with Transit serialization - SyncedAtom implementing IAtom (IDeref, ISwap, IReset, IWatchable) - Write-through to IndexedDB on every swap! - Background sync loop (pull + push) with configurable interval - Online/offline detection with reconnect sync - Conflict resolution (accept server value) - ready? channel for initial load - Custom cache atom support (Reagent ratom compatible) 25 tests, 77 assertions across db, transit, server, and auth.
This commit is contained in:
Florian Schroedl
10
.gitignore
vendored
Normal file
10
.gitignore
vendored
Normal file
@@ -0,0 +1,10 @@
|
||||
.cpcache/
|
||||
.nrepl-port
|
||||
target/
|
||||
out/
|
||||
resources/public/js/
|
||||
*.db
|
||||
*.db-shm
|
||||
*.db-wal
|
||||
.cljs_nashorn_repl/
|
||||
node_modules/
|
||||
102
README.md
Normal file
102
README.md
Normal file
@@ -0,0 +1,102 @@
|
||||
# Pocketbook
|
||||
|
||||
A Clojure-native synced atom. Offline-first key-value store with an `atom` interface that syncs to a SQLite-backed server over Transit.
|
||||
|
||||
```clojure
|
||||
(def conn (<! (pocketbook/open "my-app")))
|
||||
(def todos (pocketbook/synced-atom conn "todo" {:server "http://localhost:8090/sync"}))
|
||||
|
||||
(swap! todos assoc "todo:1" {:text "Buy milk" :tags #{:groceries}})
|
||||
@todos ;=> {"todo:1" {:text "Buy milk" :tags #{:groceries}}}
|
||||
```
|
||||
|
||||
## What it does
|
||||
|
||||
- **Preserves Clojure types**: keywords, sets, UUIDs, instants — no lossy JSON
|
||||
- **Works offline**: reads/writes hit IndexedDB immediately, syncs when online
|
||||
- **Atom interface**: `swap!`, `deref`, `add-watch` — works with Reagent, Rum, or raw CLJS
|
||||
- **~500 lines**: client (~300) + server (~200), no opaque dependencies
|
||||
|
||||
## Quick start
|
||||
|
||||
### Server
|
||||
|
||||
```bash
|
||||
clj -M:server
|
||||
# or: clj -M:server 8090 my-data.db
|
||||
```
|
||||
|
||||
Starts on `http://localhost:8090` with a SQLite file at `pocketbook.db`.
|
||||
|
||||
### Client (CLJS)
|
||||
|
||||
```clojure
|
||||
(ns my-app.core
|
||||
(:require [pocketbook.core :as pb]
|
||||
[cljs.core.async :refer [go <!]]))
|
||||
|
||||
(go
|
||||
(let [conn (<! (pb/open "my-app"))
|
||||
todos (pb/synced-atom conn "todo"
|
||||
{:server "http://localhost:8090/sync"})]
|
||||
(<! (pb/ready? todos))
|
||||
(swap! todos assoc "todo:1" {:text "Buy milk" :done false})
|
||||
(add-watch todos :log (fn [_ _ _ new] (println (count new) "todos")))))
|
||||
```
|
||||
|
||||
## Architecture
|
||||
|
||||
```
|
||||
Browser Server
|
||||
┌─────────────┐ ┌──────────────┐
|
||||
│ SyncedAtom │ ── Transit/HTTP ──▶ │ http-kit │
|
||||
│ ↕ atom │ │ ↕ Transit │
|
||||
│ ↕ IndexedDB│ ◀── Transit/HTTP ── │ ↕ Nippy │
|
||||
│ (Transit) │ │ ↕ SQLite │
|
||||
└─────────────┘ └──────────────┘
|
||||
```
|
||||
|
||||
## Sync protocol
|
||||
|
||||
- **Pull**: `GET /sync?group=todo&since=<epoch-ms>` — returns changed docs
|
||||
- **Push**: `POST /sync` — sends local changes with version numbers
|
||||
- **Conflicts**: server rejects stale writes, client accepts server value
|
||||
|
||||
## Auth
|
||||
|
||||
Optional token-based auth:
|
||||
|
||||
```clojure
|
||||
(server/start! {:port 8090
|
||||
:users {"alice" {:token "abc123" :groups #{"todo" "settings"}}
|
||||
"bob" {:token "def456" :groups #{"todo"}}}})
|
||||
```
|
||||
|
||||
Client passes token:
|
||||
|
||||
```clojure
|
||||
(pb/synced-atom conn "todo" {:server "http://localhost:8090/sync"
|
||||
:token "abc123"})
|
||||
```
|
||||
|
||||
## Dependencies
|
||||
|
||||
| Layer | Library | Purpose |
|
||||
|--------|---------|---------|
|
||||
| Server | next.jdbc + sqlite-jdbc | SQLite storage |
|
||||
| Server | nippy | Binary serialization |
|
||||
| Server | transit-clj | Wire format |
|
||||
| Server | http-kit | HTTP server |
|
||||
| Client | transit-cljs | Serialization (IDB + wire) |
|
||||
| Client | core.async | Sync coordination |
|
||||
|
||||
## Tests
|
||||
|
||||
```bash
|
||||
# All server tests
|
||||
clj -M:dev -e '(require (quote pocketbook.db-test) (quote pocketbook.transit-test) (quote pocketbook.server-test) (quote pocketbook.auth-test)) (clojure.test/run-all-tests #"pocketbook\..*")'
|
||||
```
|
||||
|
||||
## License
|
||||
|
||||
MIT
|
||||
5
build.edn
Normal file
5
build.edn
Normal file
@@ -0,0 +1,5 @@
|
||||
{:main pocketbook.example
|
||||
:output-to "resources/public/js/main.js"
|
||||
:output-dir "resources/public/js/out"
|
||||
:asset-path "js/out"
|
||||
:optimizations :none}
|
||||
26
deps.edn
Normal file
26
deps.edn
Normal file
@@ -0,0 +1,26 @@
|
||||
{:paths ["src" "resources"]
|
||||
:deps {org.clojure/clojure {:mvn/version "1.12.0"}
|
||||
http-kit/http-kit {:mvn/version "2.8.0"}
|
||||
com.cognitect/transit-clj {:mvn/version "1.0.333"}
|
||||
com.taoensso/nippy {:mvn/version "3.4.2"}
|
||||
com.github.seancorfield/next.jdbc {:mvn/version "1.3.955"}
|
||||
org.xerial/sqlite-jdbc {:mvn/version "3.47.1.0"}
|
||||
ring/ring-core {:mvn/version "1.13.0"}}
|
||||
|
||||
:aliases
|
||||
{:dev {:extra-paths ["test"]
|
||||
:extra-deps {io.github.cognitect-labs/test-runner
|
||||
{:git/tag "v0.5.1" :git/sha "dfb30dd"}}}
|
||||
:test {:main-opts ["-m" "cognitect.test-runner"]}
|
||||
:server {:main-opts ["-m" "pocketbook.server"]}
|
||||
|
||||
;; ClojureScript client build
|
||||
:cljs {:extra-deps {org.clojure/clojurescript {:mvn/version "1.11.132"}
|
||||
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
|
||||
org.clojure/core.async {:mvn/version "1.7.701"}}
|
||||
:main-opts ["-m" "cljs.main" "-co" "build.edn" "-c"]}
|
||||
|
||||
:cljs-dev {:extra-deps {org.clojure/clojurescript {:mvn/version "1.11.132"}
|
||||
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
|
||||
org.clojure/core.async {:mvn/version "1.7.701"}}
|
||||
:main-opts ["-m" "cljs.main" "-co" "build.edn" "-w" "src" "-c"]}}}
|
||||
27
resources/public/index.html
Normal file
27
resources/public/index.html
Normal file
@@ -0,0 +1,27 @@
|
||||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0">
|
||||
<title>Pocketbook Example</title>
|
||||
<style>
|
||||
* { box-sizing: border-box; margin: 0; padding: 0; }
|
||||
body { font-family: -apple-system, system-ui, sans-serif; max-width: 600px; margin: 2rem auto; padding: 0 1rem; color: #1a1a1a; }
|
||||
h1 { margin-bottom: 1rem; font-size: 1.5rem; }
|
||||
#add-form { display: flex; gap: 0.5rem; margin-bottom: 1rem; }
|
||||
#add-form input { flex: 1; padding: 0.5rem; border: 1px solid #ccc; border-radius: 4px; font-size: 1rem; }
|
||||
#add-form button { padding: 0.5rem 1rem; background: #2563eb; color: white; border: none; border-radius: 4px; cursor: pointer; font-size: 1rem; }
|
||||
#add-form button:hover { background: #1d4ed8; }
|
||||
ul { list-style: none; }
|
||||
li { padding: 0.5rem 0; border-bottom: 1px solid #eee; display: flex; align-items: center; justify-content: space-between; }
|
||||
label { display: flex; align-items: center; gap: 0.5rem; flex: 1; }
|
||||
.del-btn { background: none; border: none; color: #ef4444; cursor: pointer; font-size: 1.1rem; padding: 0 0.25rem; }
|
||||
.del-btn:hover { color: #dc2626; }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<div id="app">Loading...</div>
|
||||
<script src="js/out/goog/base.js"></script>
|
||||
<script src="js/main.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
355
src/pocketbook/core.cljs
Normal file
355
src/pocketbook/core.cljs
Normal file
@@ -0,0 +1,355 @@
|
||||
(ns pocketbook.core
|
||||
"Pocketbook: a Clojure-native synced atom.
|
||||
|
||||
Usage:
|
||||
(def conn (pocketbook/open \"my-app\"))
|
||||
(def todos (pocketbook/synced-atom conn \"todo\"
|
||||
{:server \"http://localhost:8090/sync\"}))
|
||||
(go (<! (ready? todos))
|
||||
(swap! todos assoc \"todo:1\" {:text \"Buy milk\"}))
|
||||
@todos ;=> {\"todo:1\" {:text \"Buy milk\"}}
|
||||
"
|
||||
(:require [pocketbook.idb :as idb]
|
||||
[pocketbook.sync :as sync]
|
||||
[cljs.core.async :refer [go go-loop <! >! chan put! close! timeout alts!]]))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Connection (IDB handle)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn open
|
||||
"Open a Pocketbook connection (IndexedDB database).
|
||||
Returns a channel yielding the connection map."
|
||||
[db-name]
|
||||
(let [ch (chan 1)]
|
||||
(go
|
||||
(let [db (<! (idb/open db-name))]
|
||||
(>! ch {:db db :db-name db-name})
|
||||
(close! ch)))
|
||||
ch))
|
||||
|
||||
(defn close!
|
||||
"Close a Pocketbook connection."
|
||||
[{:keys [db atoms]}]
|
||||
;; Stop all sync loops
|
||||
(doseq [[_ sa] @(or atoms (atom {}))]
|
||||
(when-let [stop (:stop-fn sa)]
|
||||
(stop)))
|
||||
(idb/close! db))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Synced Atom — implements IAtom semantics
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(deftype SyncedAtom [group ;; string prefix, e.g. "todo"
|
||||
conn ;; {:db idb, ...}
|
||||
cache ;; atom containing {id -> value}
|
||||
versions ;; atom containing {id -> version}
|
||||
pending ;; atom containing #{id} — unsynced ids
|
||||
server-opts ;; {:server url :token str} or nil
|
||||
last-sync ;; atom containing epoch ms
|
||||
ready-ch ;; channel, closed when initial load complete
|
||||
stop-ch ;; channel to signal stop
|
||||
cleanup-fn ;; atom holding connectivity cleanup fn
|
||||
sync-interval ;; ms
|
||||
_meta] ;; metadata atom
|
||||
|
||||
IAtom
|
||||
|
||||
IDeref
|
||||
(-deref [_]
|
||||
@cache)
|
||||
|
||||
IReset
|
||||
(-reset! [_ new-val]
|
||||
;; Replace the entire cache (all docs in group)
|
||||
(let [old @cache]
|
||||
(reset! cache new-val)
|
||||
;; Track which docs changed/added/removed
|
||||
(let [all-keys (into (set (keys old)) (keys new-val))]
|
||||
(doseq [k all-keys]
|
||||
(when (not= (get old k) (get new-val k))
|
||||
(swap! pending conj k)
|
||||
;; Write to IDB
|
||||
(let [v (get new-val k)]
|
||||
(if (nil? v)
|
||||
;; Doc was dissoc'd — mark deleted
|
||||
(idb/put-doc! (:db conn)
|
||||
{:id k :value nil :version (get @versions k 0)
|
||||
:updated (.now js/Date) :deleted true :synced false})
|
||||
(idb/put-doc! (:db conn)
|
||||
{:id k :value v :version (get @versions k 0)
|
||||
:updated (.now js/Date) :deleted false :synced false}))))))
|
||||
new-val))
|
||||
|
||||
ISwap
|
||||
(-swap! [o f]
|
||||
(-reset! o (f @cache)))
|
||||
(-swap! [o f a]
|
||||
(-reset! o (f @cache a)))
|
||||
(-swap! [o f a b]
|
||||
(-reset! o (f @cache a b)))
|
||||
(-swap! [o f a b xs]
|
||||
(-reset! o (apply f @cache a b xs)))
|
||||
|
||||
IWatchable
|
||||
(-add-watch [_ key f]
|
||||
(add-watch cache key f))
|
||||
(-remove-watch [_ key]
|
||||
(remove-watch cache key))
|
||||
(-notify-watches [_ old new]
|
||||
;; Delegated to the inner atom
|
||||
nil)
|
||||
|
||||
IMeta
|
||||
(-meta [_] @_meta)
|
||||
|
||||
IWithMeta
|
||||
(-with-meta [_ m] (reset! _meta m))
|
||||
|
||||
IPrintWithWriter
|
||||
(-pr-writer [_ writer opts]
|
||||
(-write writer (str "#<SyncedAtom[" group "] " (count @cache) " docs>"))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Internal helpers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- prefix-str [group]
|
||||
(str group ":"))
|
||||
|
||||
(defn- now-ms []
|
||||
(.now js/Date))
|
||||
|
||||
(defn- doc-in-group? [group id]
|
||||
(clojure.string/starts-with? id (prefix-str group)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; IDB ↔ Atom sync
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- load-from-idb!
|
||||
"Load all docs for the group from IndexedDB into the atom.
|
||||
Returns a channel that closes when done."
|
||||
[sa]
|
||||
(let [ch (chan 1)]
|
||||
(go
|
||||
(let [prefix (prefix-str (.-group sa))
|
||||
docs (<! (idb/get-all-by-prefix (:db (.-conn sa)) prefix))
|
||||
state (into {}
|
||||
(comp
|
||||
(remove :deleted)
|
||||
(map (fn [d] [(:id d) (:value d)])))
|
||||
docs)
|
||||
vers (into {}
|
||||
(map (fn [d] [(:id d) (:version d)]))
|
||||
docs)]
|
||||
(reset! (.-cache sa) state)
|
||||
(reset! (.-versions sa) vers)
|
||||
;; Load last-sync from IDB meta
|
||||
(let [ls (<! (idb/get-meta (:db (.-conn sa))
|
||||
(str "last-sync:" (.-group sa))))]
|
||||
(reset! (.-last_sync sa) (or ls 0)))
|
||||
(put! ch true)
|
||||
(close! ch)))
|
||||
ch))
|
||||
|
||||
(defn- write-doc-to-idb!
|
||||
"Persist a single doc to IDB. Returns a channel."
|
||||
[sa id value deleted?]
|
||||
(idb/put-doc! (:db (.-conn sa))
|
||||
{:id id
|
||||
:value value
|
||||
:version (get @(.-versions sa) id 0)
|
||||
:updated (now-ms)
|
||||
:deleted (boolean deleted?)
|
||||
:synced false}))
|
||||
|
||||
(defn- mark-synced!
|
||||
"Mark a doc as synced in IDB and update its version."
|
||||
[sa id version]
|
||||
(swap! (.-versions sa) assoc id version)
|
||||
(swap! (.-pending sa) disj id)
|
||||
(let [value (get @(.-cache sa) id)]
|
||||
(idb/put-doc! (:db (.-conn sa))
|
||||
{:id id
|
||||
:value value
|
||||
:version version
|
||||
:updated (now-ms)
|
||||
:deleted (nil? value)
|
||||
:synced true})))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Sync logic
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- do-pull!
|
||||
"Pull changes from server, merge into atom + IDB."
|
||||
[sa]
|
||||
(go
|
||||
(when-let [opts (.-server_opts sa)]
|
||||
(let [since @(.-last_sync sa)
|
||||
result (<! (sync/pull! opts (.-group sa) since))]
|
||||
(when (:ok result)
|
||||
(let [docs (:docs result)
|
||||
max-ts (reduce max @(.-last_sync sa)
|
||||
(map :updated docs))]
|
||||
;; Merge each doc into cache
|
||||
(doseq [doc docs]
|
||||
(let [id (:id doc)]
|
||||
;; Only apply if server version > local version
|
||||
(when (> (:version doc) (get @(.-versions sa) id 0))
|
||||
(if (:deleted doc)
|
||||
(do
|
||||
(swap! (.-cache sa) dissoc id)
|
||||
(swap! (.-versions sa) assoc id (:version doc))
|
||||
(idb/put-doc! (:db (.-conn sa))
|
||||
{:id id :value nil :version (:version doc)
|
||||
:updated (:updated doc) :deleted true :synced true}))
|
||||
(do
|
||||
(swap! (.-cache sa) assoc id (:value doc))
|
||||
(swap! (.-versions sa) assoc id (:version doc))
|
||||
(idb/put-doc! (:db (.-conn sa))
|
||||
{:id id :value (:value doc) :version (:version doc)
|
||||
:updated (:updated doc) :deleted false :synced true}))))))
|
||||
;; Update last-sync
|
||||
(reset! (.-last_sync sa) max-ts)
|
||||
(idb/set-meta! (:db (.-conn sa))
|
||||
(str "last-sync:" (.-group sa)) max-ts)))
|
||||
true)))))
|
||||
|
||||
(defn- do-push!
|
||||
"Push all unsynced local docs to the server."
|
||||
[sa]
|
||||
(go
|
||||
(when-let [opts (.-server_opts sa)]
|
||||
(let [pending-ids @(.-pending sa)]
|
||||
(when (seq pending-ids)
|
||||
(let [docs (mapv (fn [id]
|
||||
(let [v (get @(.-cache sa) id)]
|
||||
(if (nil? v)
|
||||
{:id id :deleted true
|
||||
:base-version (get @(.-versions sa) id 0)}
|
||||
{:id id :value v
|
||||
:base-version (get @(.-versions sa) id 0)})))
|
||||
pending-ids)
|
||||
result (<! (sync/push! opts docs))]
|
||||
(when (:ok result)
|
||||
(doseq [r (:results result)]
|
||||
(case (:status r)
|
||||
:ok
|
||||
(<! (mark-synced! sa (:id r) (:version r)))
|
||||
|
||||
:conflict
|
||||
;; On conflict, accept server value and mark synced
|
||||
(do
|
||||
(when (:value r)
|
||||
(swap! (.-cache sa) assoc (:id r) (:value r)))
|
||||
(swap! (.-versions sa) assoc (:id r) (:current-version r))
|
||||
(swap! (.-pending sa) disj (:id r))
|
||||
(idb/put-doc! (:db (.-conn sa))
|
||||
{:id (:id r)
|
||||
:value (or (:value r) (get @(.-cache sa) (:id r)))
|
||||
:version (:current-version r)
|
||||
:updated (now-ms)
|
||||
:deleted false
|
||||
:synced true}))
|
||||
|
||||
;; Unknown status, log
|
||||
(js/console.warn "Unknown push result:" (pr-str r))))
|
||||
true)))))))
|
||||
|
||||
(defn- do-sync!
|
||||
"Run a full sync cycle: pull then push."
|
||||
[sa]
|
||||
(go
|
||||
(when (sync/online?)
|
||||
(<! (do-pull! sa))
|
||||
(<! (do-push! sa)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Sync loop
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- start-sync-loop!
|
||||
"Start the background sync loop. Returns a stop function."
|
||||
[sa]
|
||||
(let [stop-ch (.-stop_ch sa)
|
||||
interval (.-sync_interval sa)]
|
||||
;; Periodic sync
|
||||
(go-loop []
|
||||
(let [[_ ch] (alts! [stop-ch (timeout interval)])]
|
||||
(when-not (= ch stop-ch)
|
||||
(<! (do-sync! sa))
|
||||
(recur))))
|
||||
;; Online/offline handler
|
||||
(let [cleanup (sync/on-connectivity-change
|
||||
(fn [] ; online
|
||||
(go (<! (do-sync! sa))))
|
||||
(fn [] ; offline
|
||||
nil))]
|
||||
(reset! (.-cleanup_fn sa) cleanup))
|
||||
;; Return stop function
|
||||
(fn []
|
||||
(put! stop-ch :stop)
|
||||
(when-let [cleanup @(.-cleanup_fn sa)]
|
||||
(cleanup)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Public API
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn synced-atom
|
||||
"Create a synced atom for a document group.
|
||||
|
||||
Options:
|
||||
:server — server URL (e.g. \"http://localhost:8090/sync\")
|
||||
:token — auth token
|
||||
:cache — custom atom to use (e.g. reagent/atom). Default: cljs.core/atom
|
||||
:interval — sync interval in ms (default 30000)"
|
||||
[conn group & [{:keys [server token cache interval]
|
||||
:or {interval 30000}}]]
|
||||
(let [cache-atom (or cache (atom {}))
|
||||
versions (atom {})
|
||||
pending (atom #{})
|
||||
server-opts (when server {:server server :token token})
|
||||
last-sync (atom 0)
|
||||
ready-ch (chan 1)
|
||||
stop-ch (chan 1)
|
||||
cleanup-fn (atom nil)
|
||||
meta-atom (atom nil)
|
||||
sa (SyncedAtom. group conn cache-atom versions pending
|
||||
server-opts last-sync ready-ch stop-ch
|
||||
cleanup-fn interval meta-atom)]
|
||||
;; Load from IDB, then start sync
|
||||
(go
|
||||
(<! (load-from-idb! sa))
|
||||
(put! ready-ch true)
|
||||
(close! ready-ch)
|
||||
;; Initial sync
|
||||
(when server-opts
|
||||
(<! (do-sync! sa))
|
||||
(start-sync-loop! sa)))
|
||||
sa))
|
||||
|
||||
(defn ready?
|
||||
"Returns a channel that yields true when the atom has finished loading from IDB."
|
||||
[sa]
|
||||
(.-ready_ch sa))
|
||||
|
||||
(defn sync-now!
|
||||
"Trigger an immediate sync cycle. Returns a channel."
|
||||
[sa]
|
||||
(do-sync! sa))
|
||||
|
||||
(defn pending-count
|
||||
"Number of documents waiting to be synced."
|
||||
[sa]
|
||||
(count @(.-pending sa)))
|
||||
|
||||
(defn destroy!
|
||||
"Stop the sync loop and clean up. Does not close the IDB connection."
|
||||
[sa]
|
||||
(put! (.-stop_ch sa) :stop)
|
||||
(when-let [cleanup @(.-cleanup_fn sa)]
|
||||
(cleanup)))
|
||||
177
src/pocketbook/db.clj
Normal file
177
src/pocketbook/db.clj
Normal file
@@ -0,0 +1,177 @@
|
||||
(ns pocketbook.db
|
||||
"SQLite storage layer with Nippy serialization.
|
||||
Stores documents as binary blobs preserving all Clojure types."
|
||||
(:require [next.jdbc :as jdbc]
|
||||
[next.jdbc.result-set :as rs]
|
||||
[taoensso.nippy :as nippy])
|
||||
(:import [java.time Instant]))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Connection
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn open
|
||||
"Open a SQLite database at `path`, create tables if needed.
|
||||
Returns a JDBC datasource."
|
||||
[path]
|
||||
(let [ds (jdbc/get-datasource {:dbtype "sqlite" :dbname path})]
|
||||
(jdbc/execute! ds ["PRAGMA journal_mode=WAL"])
|
||||
(jdbc/execute! ds ["PRAGMA foreign_keys=ON"])
|
||||
(jdbc/execute! ds ["CREATE TABLE IF NOT EXISTS docs (
|
||||
id TEXT PRIMARY KEY,
|
||||
value BLOB NOT NULL,
|
||||
version INTEGER NOT NULL DEFAULT 1,
|
||||
updated INTEGER NOT NULL,
|
||||
deleted INTEGER NOT NULL DEFAULT 0)"])
|
||||
(jdbc/execute! ds ["CREATE INDEX IF NOT EXISTS idx_docs_updated
|
||||
ON docs(updated)"])
|
||||
ds))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Helpers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- now-ms []
|
||||
(.toEpochMilli (Instant/now)))
|
||||
|
||||
(defn- freeze [v]
|
||||
(nippy/freeze v))
|
||||
|
||||
(defn- thaw [^bytes bs]
|
||||
(when bs (nippy/thaw bs)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Reads
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-doc
|
||||
"Fetch a single document by id. Returns nil if not found."
|
||||
[ds id]
|
||||
(let [row (jdbc/execute-one! ds
|
||||
["SELECT * FROM docs WHERE id = ?" id]
|
||||
{:builder-fn rs/as-unqualified-maps})]
|
||||
(when row
|
||||
{:id (:id row)
|
||||
:value (thaw (:value row))
|
||||
:version (:version row)
|
||||
:updated (:updated row)
|
||||
:deleted (= 1 (:deleted row))})))
|
||||
|
||||
(defn docs-since
|
||||
"Return all docs in `group` updated after `since` (epoch ms).
|
||||
Group is matched as prefix: group 'todo' matches 'todo:*'."
|
||||
[ds group since]
|
||||
(let [prefix (str group ":")
|
||||
rows (jdbc/execute! ds
|
||||
["SELECT * FROM docs
|
||||
WHERE id LIKE ? AND updated > ?
|
||||
ORDER BY updated ASC"
|
||||
(str prefix "%") since]
|
||||
{:builder-fn rs/as-unqualified-maps})]
|
||||
(mapv (fn [row]
|
||||
{:id (:id row)
|
||||
:value (when-not (= 1 (:deleted row))
|
||||
(thaw (:value row)))
|
||||
:version (:version row)
|
||||
:updated (:updated row)
|
||||
:deleted (= 1 (:deleted row))})
|
||||
rows)))
|
||||
|
||||
(defn all-docs
|
||||
"Return all non-deleted docs in a group."
|
||||
[ds group]
|
||||
(let [prefix (str group ":")
|
||||
rows (jdbc/execute! ds
|
||||
["SELECT * FROM docs
|
||||
WHERE id LIKE ? AND deleted = 0
|
||||
ORDER BY id ASC"
|
||||
(str prefix "%")]
|
||||
{:builder-fn rs/as-unqualified-maps})]
|
||||
(mapv (fn [row]
|
||||
{:id (:id row)
|
||||
:value (thaw (:value row))
|
||||
:version (:version row)
|
||||
:updated (:updated row)
|
||||
:deleted false})
|
||||
rows)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Writes
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn upsert!
|
||||
"Insert or update a document.
|
||||
- If `base-version` is 0, this is a new doc (insert with version 1).
|
||||
- If `base-version` matches current version, update (bump version).
|
||||
- Otherwise, return {:status :conflict ...}.
|
||||
Returns {:status :ok :version N} or {:status :conflict :current-version N :value V}."
|
||||
[ds {:keys [id value base-version]}]
|
||||
(jdbc/with-transaction [tx ds]
|
||||
(let [existing (get-doc tx id)
|
||||
ts (now-ms)]
|
||||
(cond
|
||||
;; New document
|
||||
(and (nil? existing) (= 0 base-version))
|
||||
(do (jdbc/execute! tx
|
||||
["INSERT INTO docs (id, value, version, updated, deleted) VALUES (?, ?, 1, ?, 0)"
|
||||
id (freeze value) ts])
|
||||
{:id id :status :ok :version 1 :updated ts})
|
||||
|
||||
;; New doc but already exists
|
||||
(and existing (= 0 base-version))
|
||||
{:id id :status :conflict
|
||||
:current-version (:version existing)
|
||||
:value (:value existing)}
|
||||
|
||||
;; Update existing — version match
|
||||
(and existing (= base-version (:version existing)))
|
||||
(let [new-version (inc (:version existing))]
|
||||
(jdbc/execute! tx
|
||||
["UPDATE docs SET value = ?, version = ?, updated = ?, deleted = 0
|
||||
WHERE id = ?"
|
||||
(freeze value) new-version ts id])
|
||||
{:id id :status :ok :version new-version :updated ts})
|
||||
|
||||
;; Update existing — version mismatch (conflict)
|
||||
existing
|
||||
{:id id :status :conflict
|
||||
:current-version (:version existing)
|
||||
:value (:value existing)}
|
||||
|
||||
;; Trying to update non-existent doc
|
||||
:else
|
||||
{:id id :status :conflict :current-version 0 :value nil}))))
|
||||
|
||||
(defn delete!
|
||||
"Soft-delete a document (set deleted=1, bump version).
|
||||
Same version semantics as upsert!."
|
||||
[ds {:keys [id base-version]}]
|
||||
(jdbc/with-transaction [tx ds]
|
||||
(let [existing (get-doc tx id)
|
||||
ts (now-ms)]
|
||||
(cond
|
||||
(nil? existing)
|
||||
{:id id :status :ok :version 0 :updated ts}
|
||||
|
||||
(= base-version (:version existing))
|
||||
(let [new-version (inc (:version existing))]
|
||||
(jdbc/execute! tx
|
||||
["UPDATE docs SET deleted = 1, version = ?, updated = ? WHERE id = ?"
|
||||
new-version ts id])
|
||||
{:id id :status :ok :version new-version :updated ts})
|
||||
|
||||
:else
|
||||
{:id id :status :conflict
|
||||
:current-version (:version existing)
|
||||
:value (:value existing)}))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Maintenance
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn purge-deleted!
|
||||
"Permanently remove soft-deleted docs older than `max-age-ms`."
|
||||
[ds max-age-ms]
|
||||
(let [cutoff (- (now-ms) max-age-ms)]
|
||||
(jdbc/execute! ds
|
||||
["DELETE FROM docs WHERE deleted = 1 AND updated < ?" cutoff])))
|
||||
75
src/pocketbook/example.cljs
Normal file
75
src/pocketbook/example.cljs
Normal file
@@ -0,0 +1,75 @@
|
||||
(ns pocketbook.example
|
||||
"Example: a simple todo app using Pocketbook."
|
||||
(:require [pocketbook.core :as pb]
|
||||
[cljs.core.async :refer [go <!]]))
|
||||
|
||||
(defn- render-todos! [todos-atom]
|
||||
(let [todos @todos-atom
|
||||
container (js/document.getElementById "app")]
|
||||
(set! (.-innerHTML container)
|
||||
(str "<h1>Pocketbook Todos (" (count todos) ")</h1>"
|
||||
"<div id='add-form'>"
|
||||
"<input id='new-todo' type='text' placeholder='New todo...' />"
|
||||
"<button id='add-btn'>Add</button>"
|
||||
"</div>"
|
||||
"<ul>"
|
||||
(apply str
|
||||
(for [[id doc] (sort-by key todos)]
|
||||
(str "<li>"
|
||||
"<label>"
|
||||
"<input type='checkbox' data-id='" id "' "
|
||||
(when (:done doc) "checked") " /> "
|
||||
"<span" (when (:done doc) " style='text-decoration:line-through'") ">"
|
||||
(:text doc)
|
||||
"</span>"
|
||||
"</label>"
|
||||
" <button class='del-btn' data-id='" id "'>✕</button>"
|
||||
"</li>")))
|
||||
"</ul>"
|
||||
"<p style='color:#888;font-size:12px'>"
|
||||
"Pending sync: " (pb/pending-count todos-atom)
|
||||
"</p>"))))
|
||||
|
||||
(defn- setup-handlers! [todos-atom]
|
||||
;; We re-setup after each render
|
||||
(when-let [btn (js/document.getElementById "add-btn")]
|
||||
(.addEventListener btn "click"
|
||||
(fn [_]
|
||||
(let [input (js/document.getElementById "new-todo")
|
||||
text (.-value input)]
|
||||
(when (seq text)
|
||||
(let [id (str "todo:" (random-uuid))]
|
||||
(swap! todos-atom assoc id {:text text :done false})
|
||||
(set! (.-value input) "")))))))
|
||||
;; Checkbox toggles
|
||||
(doseq [cb (array-seq (.querySelectorAll js/document "input[type=checkbox]"))]
|
||||
(.addEventListener cb "change"
|
||||
(fn [e]
|
||||
(let [id (.-id (.-dataset (.-target e)))]
|
||||
(swap! todos-atom update-in [id :done] not)))))
|
||||
;; Delete buttons
|
||||
(doseq [btn (array-seq (.querySelectorAll js/document ".del-btn"))]
|
||||
(.addEventListener btn "click"
|
||||
(fn [e]
|
||||
(let [id (.-id (.-dataset (.-target e)))]
|
||||
(swap! todos-atom dissoc id))))))
|
||||
|
||||
(defn ^:export init []
|
||||
(go
|
||||
(let [conn (<! (pb/open "pocketbook-example"))
|
||||
todos (pb/synced-atom conn "todo"
|
||||
{:server "http://localhost:8090/sync"})]
|
||||
;; Wait for initial load
|
||||
(<! (pb/ready? todos))
|
||||
;; Render
|
||||
(render-todos! todos)
|
||||
(setup-handlers! todos)
|
||||
;; Re-render on changes
|
||||
(add-watch todos :render
|
||||
(fn [_ _ _ _]
|
||||
(render-todos! todos)
|
||||
(setup-handlers! todos)))
|
||||
(js/console.log "Pocketbook example loaded!" (count @todos) "todos"))))
|
||||
|
||||
;; Auto-init
|
||||
(init)
|
||||
222
src/pocketbook/idb.cljs
Normal file
222
src/pocketbook/idb.cljs
Normal file
@@ -0,0 +1,222 @@
|
||||
(ns pocketbook.idb
|
||||
"IndexedDB wrapper with Transit serialization.
|
||||
Stores documents as Transit-encoded strings preserving all Clojure types."
|
||||
(:require [cognitect.transit :as t]
|
||||
[cljs.core.async :refer [chan put! close!]]))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Transit
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(def ^:private writer (t/writer :json))
|
||||
(def ^:private reader (t/reader :json))
|
||||
|
||||
(defn- encode [v]
|
||||
(t/write writer v))
|
||||
|
||||
(defn- decode [s]
|
||||
(when s (t/read reader s)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; IDB operations
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn open
|
||||
"Open an IndexedDB database. Returns a channel that yields the db."
|
||||
[db-name]
|
||||
(let [ch (chan 1)
|
||||
req (.open js/indexedDB db-name 1)]
|
||||
(set! (.-onupgradeneeded req)
|
||||
(fn [e]
|
||||
(let [db (.-result (.-target e))]
|
||||
;; Main document store
|
||||
(when-not (.contains (.-objectStoreNames db) "docs")
|
||||
(let [store (.createObjectStore db "docs" #js {:keyPath "id"})]
|
||||
(.createIndex store "synced" "synced" #js {:unique false})
|
||||
(.createIndex store "updated" "updated" #js {:unique false})))
|
||||
;; Metadata store (last-sync timestamps, etc.)
|
||||
(when-not (.contains (.-objectStoreNames db) "meta")
|
||||
(.createObjectStore db "meta" #js {:keyPath "key"})))))
|
||||
(set! (.-onsuccess req)
|
||||
(fn [e]
|
||||
(put! ch (.-result (.-target e)))
|
||||
(close! ch)))
|
||||
(set! (.-onerror req)
|
||||
(fn [e]
|
||||
(js/console.error "IDB open error:" e)
|
||||
(close! ch)))
|
||||
ch))
|
||||
|
||||
(defn- tx
|
||||
"Start an IDB transaction. mode is :readonly or :readwrite."
|
||||
[db store-name mode]
|
||||
(let [mode-str (case mode :readonly "readonly" :readwrite "readwrite")]
|
||||
(.transaction db #js [store-name] mode-str)))
|
||||
|
||||
(defn put-doc!
|
||||
"Write a document to IDB. Returns a channel that closes on success.
|
||||
doc should be: {:id str :value any :version int :updated int :deleted bool :synced bool}"
|
||||
[db doc]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "docs" :readwrite)
|
||||
store (.objectStore txn "docs")
|
||||
;; Serialize the value to Transit, keep metadata as-is
|
||||
obj #js {:id (:id doc)
|
||||
:value (encode (:value doc))
|
||||
:version (:version doc 0)
|
||||
:updated (:updated doc 0)
|
||||
:deleted (boolean (:deleted doc false))
|
||||
:synced (boolean (:synced doc false))}
|
||||
req (.put store obj)]
|
||||
(set! (.-onsuccess req) (fn [_] (put! ch true) (close! ch)))
|
||||
(set! (.-onerror req) (fn [e] (js/console.error "IDB put error:" e) (close! ch)))
|
||||
ch))
|
||||
|
||||
(defn put-docs!
|
||||
"Write multiple documents in a single transaction. Returns a channel."
|
||||
[db docs]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "docs" :readwrite)
|
||||
store (.objectStore txn "docs")]
|
||||
(doseq [doc docs]
|
||||
(let [obj #js {:id (:id doc)
|
||||
:value (encode (:value doc))
|
||||
:version (:version doc 0)
|
||||
:updated (:updated doc 0)
|
||||
:deleted (boolean (:deleted doc false))
|
||||
:synced (boolean (:synced doc false))}]
|
||||
(.put store obj)))
|
||||
(set! (.-oncomplete txn) (fn [_] (put! ch true) (close! ch)))
|
||||
(set! (.-onerror txn) (fn [e] (js/console.error "IDB batch put error:" e) (close! ch)))
|
||||
ch))
|
||||
|
||||
(defn get-doc
|
||||
"Read a single document by id. Returns a channel yielding the doc or nil."
|
||||
[db id]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "docs" :readonly)
|
||||
store (.objectStore txn "docs")
|
||||
req (.get store id)]
|
||||
(set! (.-onsuccess req)
|
||||
(fn [e]
|
||||
(let [result (.-result (.-target e))]
|
||||
(put! ch (when result
|
||||
{:id (.-id result)
|
||||
:value (decode (.-value result))
|
||||
:version (.-version result)
|
||||
:updated (.-updated result)
|
||||
:deleted (.-deleted result)
|
||||
:synced (.-synced result)}))
|
||||
(close! ch))))
|
||||
(set! (.-onerror req)
|
||||
(fn [e] (js/console.error "IDB get error:" e) (close! ch)))
|
||||
ch))
|
||||
|
||||
(defn get-all-by-prefix
|
||||
"Get all documents whose id starts with prefix (e.g., 'todo:').
|
||||
Returns a channel yielding a vector of docs."
|
||||
[db prefix]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "docs" :readonly)
|
||||
store (.objectStore txn "docs")
|
||||
range (.bound js/IDBKeyRange prefix (str prefix "\uffff"))
|
||||
req (.openCursor store range)
|
||||
docs (atom [])]
|
||||
(set! (.-onsuccess req)
|
||||
(fn [e]
|
||||
(let [cursor (.-result (.-target e))]
|
||||
(if cursor
|
||||
(let [val (.-value cursor)]
|
||||
(swap! docs conj
|
||||
{:id (.-id val)
|
||||
:value (decode (.-value val))
|
||||
:version (.-version val)
|
||||
:updated (.-updated val)
|
||||
:deleted (.-deleted val)
|
||||
:synced (.-synced val)})
|
||||
(.continue cursor))
|
||||
(do
|
||||
(put! ch @docs)
|
||||
(close! ch))))))
|
||||
(set! (.-onerror req)
|
||||
(fn [e] (js/console.error "IDB cursor error:" e) (close! ch)))
|
||||
ch))
|
||||
|
||||
(defn get-unsynced
|
||||
"Get all documents with synced=false. Returns a channel yielding a vector."
|
||||
[db]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "docs" :readonly)
|
||||
store (.objectStore txn "docs")
|
||||
idx (.index store "synced")
|
||||
req (.openCursor idx (.only js/IDBKeyRange false))
|
||||
docs (atom [])]
|
||||
(set! (.-onsuccess req)
|
||||
(fn [e]
|
||||
(let [cursor (.-result (.-target e))]
|
||||
(if cursor
|
||||
(let [val (.-value cursor)]
|
||||
(swap! docs conj
|
||||
{:id (.-id val)
|
||||
:value (decode (.-value val))
|
||||
:version (.-version val)
|
||||
:updated (.-updated val)
|
||||
:deleted (.-deleted val)
|
||||
:synced false})
|
||||
(.continue cursor))
|
||||
(do
|
||||
(put! ch @docs)
|
||||
(close! ch))))))
|
||||
(set! (.-onerror req)
|
||||
(fn [e] (js/console.error "IDB unsynced error:" e) (close! ch)))
|
||||
ch))
|
||||
|
||||
(defn delete-doc!
|
||||
"Delete a document from IDB by id. Returns a channel."
|
||||
[db id]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "docs" :readwrite)
|
||||
store (.objectStore txn "docs")
|
||||
req (.delete store id)]
|
||||
(set! (.-onsuccess req) (fn [_] (put! ch true) (close! ch)))
|
||||
(set! (.-onerror req) (fn [e] (js/console.error "IDB delete error:" e) (close! ch)))
|
||||
ch))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Metadata
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-meta
|
||||
"Get a metadata value by key. Returns a channel."
|
||||
[db key]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "meta" :readonly)
|
||||
store (.objectStore txn "meta")
|
||||
req (.get store key)]
|
||||
(set! (.-onsuccess req)
|
||||
(fn [e]
|
||||
(let [result (.-result (.-target e))]
|
||||
(put! ch (when result (.-value result)))
|
||||
(close! ch))))
|
||||
(set! (.-onerror req) (fn [_] (close! ch)))
|
||||
ch))
|
||||
|
||||
(defn set-meta!
|
||||
"Set a metadata value. Returns a channel."
|
||||
[db key value]
|
||||
(let [ch (chan 1)
|
||||
txn (tx db "meta" :readwrite)
|
||||
store (.objectStore txn "meta")
|
||||
req (.put store #js {:key key :value value})]
|
||||
(set! (.-onsuccess req) (fn [_] (put! ch true) (close! ch)))
|
||||
(set! (.-onerror req) (fn [_] (close! ch)))
|
||||
ch))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Close
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn close!
|
||||
"Close the IDB connection."
|
||||
[db]
|
||||
(when db (.close db)))
|
||||
185
src/pocketbook/server.clj
Normal file
185
src/pocketbook/server.clj
Normal file
@@ -0,0 +1,185 @@
|
||||
(ns pocketbook.server
|
||||
"Pocketbook sync server. Single-file HTTP server backed by SQLite.
|
||||
|
||||
Endpoints:
|
||||
GET /sync?since=T&group=G — pull changes since timestamp
|
||||
POST /sync — push local changes (with version checks)
|
||||
|
||||
Start:
|
||||
clj -M:server
|
||||
bb -m pocketbook.server"
|
||||
(:require [org.httpkit.server :as http]
|
||||
[pocketbook.db :as db]
|
||||
[pocketbook.transit :as t]
|
||||
[clojure.string :as str])
|
||||
(:gen-class))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Config
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(def default-config
|
||||
{:port 8090
|
||||
:db-path "pocketbook.db"
|
||||
:users nil ;; nil = no auth, or {"alice" {:token "abc" :groups #{"todo"}}}
|
||||
:cors true})
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Auth
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- authenticate
|
||||
"Check Authorization header against config. Returns user map or nil."
|
||||
[config req]
|
||||
(if-let [users (:users config)]
|
||||
(let [header (get-in req [:headers "authorization"] "")
|
||||
token (str/replace header #"^Bearer\s+" "")]
|
||||
(some (fn [[username user]]
|
||||
(when (= token (:token user))
|
||||
(assoc user :username username)))
|
||||
users))
|
||||
;; No auth configured — allow all
|
||||
{:username "anonymous" :groups nil}))
|
||||
|
||||
(defn- authorized-group?
|
||||
"Check if user has access to a specific group."
|
||||
[user group]
|
||||
(or (nil? (:groups user)) ;; nil = access to all groups
|
||||
(contains? (:groups user) group)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Handlers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- transit-response [status body]
|
||||
{:status status
|
||||
:headers {"Content-Type" "application/transit+json"
|
||||
"Cache-Control" "no-cache"}
|
||||
:body (t/encode body)})
|
||||
|
||||
(defn- cors-headers [resp]
|
||||
(update resp :headers merge
|
||||
{"Access-Control-Allow-Origin" "*"
|
||||
"Access-Control-Allow-Methods" "GET, POST, OPTIONS"
|
||||
"Access-Control-Allow-Headers" "Content-Type, Authorization"
|
||||
"Access-Control-Max-Age" "86400"}))
|
||||
|
||||
(defn- handle-pull
|
||||
"GET /sync?since=T&group=G — return all docs updated since T in group G."
|
||||
[ds user req]
|
||||
(let [params (or (:query-params req) (:params req) {})
|
||||
group (get params "group" (get params :group))
|
||||
since (parse-long (or (get params "since" (get params :since)) "0"))]
|
||||
(if-not group
|
||||
(transit-response 400 {:error "Missing 'group' parameter"})
|
||||
(if-not (authorized-group? user group)
|
||||
(transit-response 403 {:error "Access denied to group"})
|
||||
(let [docs (db/docs-since ds group since)]
|
||||
(transit-response 200 docs))))))
|
||||
|
||||
(defn- handle-push
|
||||
"POST /sync — accept a batch of document writes.
|
||||
Body: [{:id ... :value ... :base-version N} ...]
|
||||
Entries with :deleted true are treated as deletes."
|
||||
[ds user req]
|
||||
(let [body (t/decode (:body req))
|
||||
docs (if (map? body) [body] body)
|
||||
;; Check all docs belong to authorized groups
|
||||
groups (into #{} (map #(first (str/split (:id %) #":" 2))) docs)
|
||||
denied (remove #(authorized-group? user %) groups)]
|
||||
(if (seq denied)
|
||||
(transit-response 403 {:error (str "Access denied to groups: " (str/join ", " denied))})
|
||||
(let [results (mapv (fn [doc]
|
||||
(if (:deleted doc)
|
||||
(db/delete! ds {:id (:id doc)
|
||||
:base-version (:base-version doc 0)})
|
||||
(db/upsert! ds {:id (:id doc)
|
||||
:value (:value doc)
|
||||
:base-version (:base-version doc 0)})))
|
||||
docs)]
|
||||
(transit-response 200 results)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Ring handler
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- parse-query-params [query-string]
|
||||
(when query-string
|
||||
(into {}
|
||||
(for [pair (str/split query-string #"&")
|
||||
:let [[k v] (str/split pair #"=" 2)]
|
||||
:when k]
|
||||
[k (or v "")]))))
|
||||
|
||||
(defn make-handler
|
||||
"Create the Ring handler function."
|
||||
[ds config]
|
||||
(fn [req]
|
||||
(let [req (assoc req :query-params (parse-query-params (:query-string req)))
|
||||
resp (cond
|
||||
;; CORS preflight
|
||||
(= :options (:request-method req))
|
||||
{:status 204 :headers {} :body nil}
|
||||
|
||||
;; Health check
|
||||
(= "/" (:uri req))
|
||||
{:status 200
|
||||
:headers {"Content-Type" "text/plain"}
|
||||
:body "pocketbook ok"}
|
||||
|
||||
;; Sync endpoints
|
||||
(= "/sync" (:uri req))
|
||||
(let [user (authenticate config req)]
|
||||
(if-not user
|
||||
(transit-response 401 {:error "Unauthorized"})
|
||||
(case (:request-method req)
|
||||
:get (handle-pull ds user req)
|
||||
:post (handle-push ds user req)
|
||||
(transit-response 405 {:error "Method not allowed"}))))
|
||||
|
||||
:else
|
||||
{:status 404
|
||||
:headers {"Content-Type" "text/plain"}
|
||||
:body "Not found"})]
|
||||
(if (:cors config)
|
||||
(cors-headers resp)
|
||||
resp))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Server lifecycle
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn start!
|
||||
"Start the Pocketbook server. Returns a stop function."
|
||||
([]
|
||||
(start! {}))
|
||||
([config]
|
||||
(let [config (merge default-config config)
|
||||
ds (db/open (:db-path config))
|
||||
handler (make-handler ds config)
|
||||
server (http/run-server handler {:port (:port config)})]
|
||||
(println (str "🔶 Pocketbook server running on http://localhost:" (:port config)))
|
||||
(println (str " Database: " (:db-path config)))
|
||||
(println (str " Auth: " (if (:users config) "enabled" "disabled")))
|
||||
{:stop server
|
||||
:ds ds
|
||||
:config config})))
|
||||
|
||||
(defn stop!
|
||||
"Stop a running server."
|
||||
[{:keys [stop]}]
|
||||
(when stop (stop)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Main
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn -main [& args]
|
||||
(let [port (some-> (first args) parse-long)
|
||||
db-path (second args)
|
||||
config (cond-> {}
|
||||
port (assoc :port port)
|
||||
db-path (assoc :db-path db-path))]
|
||||
(start! config)
|
||||
;; Keep the server running
|
||||
@(promise)))
|
||||
111
src/pocketbook/sync.cljs
Normal file
111
src/pocketbook/sync.cljs
Normal file
@@ -0,0 +1,111 @@
|
||||
(ns pocketbook.sync
|
||||
"HTTP sync client — pull and push documents to/from the Pocketbook server."
|
||||
(:require [cognitect.transit :as t]
|
||||
[cljs.core.async :refer [chan put! close!]]))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Transit over HTTP
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(def ^:private writer (t/writer :json))
|
||||
(def ^:private reader (t/reader :json))
|
||||
|
||||
(defn- encode [v]
|
||||
(t/write writer v))
|
||||
|
||||
(defn- decode [s]
|
||||
(when (and s (not= s ""))
|
||||
(t/read reader s)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; HTTP helpers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn- fetch-transit
|
||||
"Make an HTTP request with Transit encoding. Returns a channel
|
||||
yielding {:ok true :body <decoded>} or {:ok false :status N :error str}."
|
||||
[{:keys [url method body headers]}]
|
||||
(let [ch (chan 1)
|
||||
opts (clj->js
|
||||
(cond-> {:method (or method "GET")
|
||||
:headers (merge {"Content-Type" "application/transit+json"
|
||||
"Accept" "application/transit+json"}
|
||||
headers)}
|
||||
body (assoc :body (encode body))))]
|
||||
(-> (js/fetch url opts)
|
||||
(.then (fn [resp]
|
||||
(-> (.text resp)
|
||||
(.then (fn [text]
|
||||
(if (.-ok resp)
|
||||
(put! ch {:ok true :body (decode text)})
|
||||
(put! ch {:ok false
|
||||
:status (.-status resp)
|
||||
:error text}))
|
||||
(close! ch))))))
|
||||
(.catch (fn [err]
|
||||
(put! ch {:ok false :status 0 :error (str err)})
|
||||
(close! ch))))
|
||||
ch))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Pull
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn pull!
|
||||
"Pull documents from server updated since `since` for `group`.
|
||||
Returns a channel yielding {:ok true :docs [...]} or {:ok false :error str}."
|
||||
[{:keys [server token]} group since]
|
||||
(let [ch (chan 1)
|
||||
url (str server "?group=" (js/encodeURIComponent group)
|
||||
"&since=" since)]
|
||||
(cljs.core.async/go
|
||||
(let [result (cljs.core.async/<! (fetch-transit
|
||||
{:url url
|
||||
:method "GET"
|
||||
:headers (when token {"Authorization" (str "Bearer " token)})}))]
|
||||
(if (:ok result)
|
||||
(put! ch {:ok true :docs (:body result)})
|
||||
(put! ch result))
|
||||
(close! ch)))
|
||||
ch))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Push
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn push!
|
||||
"Push a batch of documents to the server.
|
||||
Each doc: {:id str :value any :base-version int} or {:id str :deleted true :base-version int}.
|
||||
Returns a channel yielding {:ok true :results [...]} or {:ok false :error str}."
|
||||
[{:keys [server token]} docs]
|
||||
(let [ch (chan 1)]
|
||||
(cljs.core.async/go
|
||||
(let [result (cljs.core.async/<! (fetch-transit
|
||||
{:url server
|
||||
:method "POST"
|
||||
:body docs
|
||||
:headers (when token {"Authorization" (str "Bearer " token)})}))]
|
||||
(if (:ok result)
|
||||
(put! ch {:ok true :results (:body result)})
|
||||
(put! ch result))
|
||||
(close! ch)))
|
||||
ch))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Online detection
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defn online? []
|
||||
(.-onLine js/navigator))
|
||||
|
||||
(defn on-connectivity-change
|
||||
"Register callbacks for online/offline events. Returns a cleanup fn."
|
||||
[on-online on-offline]
|
||||
(let [online-handler (fn [_] (on-online))
|
||||
offline-handler (fn [_] (on-offline))]
|
||||
(.addEventListener js/window "online" online-handler)
|
||||
(.addEventListener js/window "offline" offline-handler)
|
||||
;; Return cleanup function
|
||||
(fn []
|
||||
(.removeEventListener js/window "online" online-handler)
|
||||
(.removeEventListener js/window "offline" offline-handler))))
|
||||
32
src/pocketbook/transit.clj
Normal file
32
src/pocketbook/transit.clj
Normal file
@@ -0,0 +1,32 @@
|
||||
(ns pocketbook.transit
|
||||
"Transit encoding/decoding helpers for the HTTP wire format."
|
||||
(:require [cognitect.transit :as t])
|
||||
(:import [java.io ByteArrayInputStream ByteArrayOutputStream]))
|
||||
|
||||
(defn encode
|
||||
"Encode a Clojure value to a Transit+JSON byte array."
|
||||
[v]
|
||||
(let [out (ByteArrayOutputStream. 4096)
|
||||
w (t/writer out :json)]
|
||||
(t/write w v)
|
||||
(.toByteArray out)))
|
||||
|
||||
(defn encode-str
|
||||
"Encode a Clojure value to a Transit+JSON string."
|
||||
[v]
|
||||
(let [out (ByteArrayOutputStream. 4096)
|
||||
w (t/writer out :json)]
|
||||
(t/write w v)
|
||||
(.toString out "UTF-8")))
|
||||
|
||||
(defn decode
|
||||
"Decode a Transit+JSON byte array or input stream to a Clojure value."
|
||||
[input]
|
||||
(let [in (cond
|
||||
(instance? ByteArrayInputStream input) input
|
||||
(instance? java.io.InputStream input) input
|
||||
(bytes? input) (ByteArrayInputStream. input)
|
||||
(string? input) (ByteArrayInputStream. (.getBytes ^String input "UTF-8"))
|
||||
:else (throw (ex-info "Cannot decode, unsupported input type"
|
||||
{:type (type input)})))]
|
||||
(t/read (t/reader in :json))))
|
||||
88
test/pocketbook/auth_test.clj
Normal file
88
test/pocketbook/auth_test.clj
Normal file
@@ -0,0 +1,88 @@
|
||||
(ns pocketbook.auth-test
|
||||
(:require [clojure.test :refer [deftest is testing use-fixtures]]
|
||||
[pocketbook.server :as server]
|
||||
[pocketbook.transit :as t])
|
||||
(:import [java.io File]
|
||||
[java.net URI]
|
||||
[java.net.http HttpClient HttpRequest HttpResponse$BodyHandlers HttpRequest$BodyPublishers]))
|
||||
|
||||
(def ^:dynamic *port* nil)
|
||||
(def ^:dynamic *server* nil)
|
||||
|
||||
(defn- free-port []
|
||||
(with-open [s (java.net.ServerSocket. 0)]
|
||||
(.getLocalPort s)))
|
||||
|
||||
(def test-users
|
||||
{"alice" {:token "alice-secret" :groups #{"todo" "settings"}}
|
||||
"bob" {:token "bob-secret" :groups #{"todo"}}})
|
||||
|
||||
(use-fixtures :each
|
||||
(fn [f]
|
||||
(let [port (free-port)
|
||||
db-path (str (File/createTempFile "pocketbook-auth-test" ".db"))
|
||||
srv (server/start! {:port port :db-path db-path :users test-users})]
|
||||
(Thread/sleep 200)
|
||||
(try
|
||||
(binding [*server* srv *port* port]
|
||||
(f))
|
||||
(finally
|
||||
(server/stop! srv)
|
||||
(.delete (File. db-path)))))))
|
||||
|
||||
(def ^:private client (HttpClient/newHttpClient))
|
||||
|
||||
(defn- url [path & [query]]
|
||||
(str "http://localhost:" *port* path (when query (str "?" query))))
|
||||
|
||||
(defn- get-transit [path query & [token]]
|
||||
(let [req (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI. (url path query)))
|
||||
(.header "Accept" "application/transit+json")
|
||||
(cond-> token (.header "Authorization" (str "Bearer " token)))
|
||||
(.GET)
|
||||
(.build))
|
||||
resp (.send client req (HttpResponse$BodyHandlers/ofByteArray))]
|
||||
{:status (.statusCode resp)
|
||||
:body (t/decode (.body resp))}))
|
||||
|
||||
(defn- post-transit [path body & [token]]
|
||||
(let [bytes (t/encode body)
|
||||
req (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI. (url path)))
|
||||
(.header "Content-Type" "application/transit+json")
|
||||
(.header "Accept" "application/transit+json")
|
||||
(cond-> token (.header "Authorization" (str "Bearer " token)))
|
||||
(.POST (HttpRequest$BodyPublishers/ofByteArray bytes))
|
||||
(.build))
|
||||
resp (.send client req (HttpResponse$BodyHandlers/ofByteArray))]
|
||||
{:status (.statusCode resp)
|
||||
:body (t/decode (.body resp))}))
|
||||
|
||||
(deftest unauthorized-without-token
|
||||
(let [resp (get-transit "/sync" "group=todo&since=0")]
|
||||
(is (= 401 (:status resp)))))
|
||||
|
||||
(deftest unauthorized-with-bad-token
|
||||
(let [resp (get-transit "/sync" "group=todo&since=0" "wrong-token")]
|
||||
(is (= 401 (:status resp)))))
|
||||
|
||||
(deftest alice-can-access-todo
|
||||
(let [resp (post-transit "/sync"
|
||||
[{:id "todo:1" :value {:text "Alice todo"} :base-version 0}]
|
||||
"alice-secret")]
|
||||
(is (= 200 (:status resp)))
|
||||
(is (= :ok (:status (first (:body resp)))))))
|
||||
|
||||
(deftest bob-cannot-access-settings
|
||||
(let [resp (post-transit "/sync"
|
||||
[{:id "settings:theme" :value {:dark true} :base-version 0}]
|
||||
"bob-secret")]
|
||||
(is (= 403 (:status resp)))))
|
||||
|
||||
(deftest alice-can-access-settings
|
||||
(let [resp (post-transit "/sync"
|
||||
[{:id "settings:theme" :value {:dark true} :base-version 0}]
|
||||
"alice-secret")]
|
||||
(is (= 200 (:status resp)))
|
||||
(is (= :ok (:status (first (:body resp)))))))
|
||||
141
test/pocketbook/db_test.clj
Normal file
141
test/pocketbook/db_test.clj
Normal file
@@ -0,0 +1,141 @@
|
||||
(ns pocketbook.db-test
|
||||
(:require [clojure.test :refer [deftest is testing use-fixtures]]
|
||||
[pocketbook.db :as db])
|
||||
(:import [java.io File]))
|
||||
|
||||
(def ^:dynamic *ds* nil)
|
||||
|
||||
(defn- temp-db-path []
|
||||
(str (File/createTempFile "pocketbook-test" ".db")))
|
||||
|
||||
(use-fixtures :each
|
||||
(fn [f]
|
||||
(let [path (temp-db-path)
|
||||
ds (db/open path)]
|
||||
(try
|
||||
(binding [*ds* ds]
|
||||
(f))
|
||||
(finally
|
||||
(.delete (File. path)))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Basic CRUD
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(deftest upsert-new-doc
|
||||
(let [result (db/upsert! *ds* {:id "todo:1"
|
||||
:value {:text "Buy milk" :tags #{:groceries}}
|
||||
:base-version 0})]
|
||||
(is (= :ok (:status result)))
|
||||
(is (= 1 (:version result)))
|
||||
(let [doc (db/get-doc *ds* "todo:1")]
|
||||
(is (= "todo:1" (:id doc)))
|
||||
(is (= {:text "Buy milk" :tags #{:groceries}} (:value doc)))
|
||||
(is (= 1 (:version doc)))
|
||||
(is (false? (:deleted doc))))))
|
||||
|
||||
(deftest upsert-update-doc
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "v1"} :base-version 0})
|
||||
(let [result (db/upsert! *ds* {:id "todo:1" :value {:text "v2"} :base-version 1})]
|
||||
(is (= :ok (:status result)))
|
||||
(is (= 2 (:version result)))
|
||||
(is (= {:text "v2"} (:value (db/get-doc *ds* "todo:1"))))))
|
||||
|
||||
(deftest upsert-conflict
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "v1"} :base-version 0})
|
||||
(let [result (db/upsert! *ds* {:id "todo:1" :value {:text "bad"} :base-version 0})]
|
||||
(is (= :conflict (:status result)))
|
||||
(is (= 1 (:current-version result)))
|
||||
;; Original doc unchanged
|
||||
(is (= {:text "v1"} (:value (db/get-doc *ds* "todo:1"))))))
|
||||
|
||||
(deftest upsert-conflict-stale-version
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "v1"} :base-version 0})
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "v2"} :base-version 1})
|
||||
(let [result (db/upsert! *ds* {:id "todo:1" :value {:text "bad"} :base-version 1})]
|
||||
(is (= :conflict (:status result)))
|
||||
(is (= 2 (:current-version result)))
|
||||
(is (= {:text "v2"} (:value result)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Delete
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(deftest soft-delete
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "v1"} :base-version 0})
|
||||
(let [result (db/delete! *ds* {:id "todo:1" :base-version 1})]
|
||||
(is (= :ok (:status result)))
|
||||
(is (= 2 (:version result)))
|
||||
(let [doc (db/get-doc *ds* "todo:1")]
|
||||
(is (true? (:deleted doc)))
|
||||
(is (= 2 (:version doc))))))
|
||||
|
||||
(deftest delete-conflict
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "v1"} :base-version 0})
|
||||
(let [result (db/delete! *ds* {:id "todo:1" :base-version 0})]
|
||||
(is (= :conflict (:status result)))
|
||||
(is (= 1 (:current-version result)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Queries
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(deftest docs-since-filters-by-group-and-time
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "a"} :base-version 0})
|
||||
(Thread/sleep 10)
|
||||
(let [t (System/currentTimeMillis)]
|
||||
(Thread/sleep 10)
|
||||
(db/upsert! *ds* {:id "todo:2" :value {:text "b"} :base-version 0})
|
||||
(db/upsert! *ds* {:id "note:1" :value {:text "c"} :base-version 0})
|
||||
(let [docs (db/docs-since *ds* "todo" t)]
|
||||
(is (= 1 (count docs)))
|
||||
(is (= "todo:2" (:id (first docs)))))))
|
||||
|
||||
(deftest all-docs-excludes-deleted
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "a"} :base-version 0})
|
||||
(db/upsert! *ds* {:id "todo:2" :value {:text "b"} :base-version 0})
|
||||
(db/delete! *ds* {:id "todo:1" :base-version 1})
|
||||
(let [docs (db/all-docs *ds* "todo")]
|
||||
(is (= 1 (count docs)))
|
||||
(is (= "todo:2" (:id (first docs))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Clojure type preservation
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(deftest preserves-clojure-types
|
||||
(let [value {:keyword :hello
|
||||
:set #{1 2 3}
|
||||
:vec [1 "two" :three]
|
||||
:uuid (java.util.UUID/randomUUID)
|
||||
:inst #inst "2026-04-04T10:00:00Z"
|
||||
:nested {:a {:b {:c 42}}}
|
||||
:nil-val nil
|
||||
:ratio 22/7
|
||||
:symbol 'my-sym}]
|
||||
(db/upsert! *ds* {:id "types:1" :value value :base-version 0})
|
||||
(let [doc (db/get-doc *ds* "types:1")]
|
||||
(is (= (:keyword value) (:keyword (:value doc))))
|
||||
(is (= (:set value) (:set (:value doc))))
|
||||
(is (= (:vec value) (:vec (:value doc))))
|
||||
(is (= (:uuid value) (:uuid (:value doc))))
|
||||
(is (= (:inst value) (:inst (:value doc))))
|
||||
(is (= (:nested value) (:nested (:value doc))))
|
||||
(is (nil? (:nil-val (:value doc))))
|
||||
(is (= (:symbol value) (:symbol (:value doc)))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Purge
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(deftest purge-deleted-removes-old
|
||||
(db/upsert! *ds* {:id "todo:1" :value {:text "a"} :base-version 0})
|
||||
(db/delete! *ds* {:id "todo:1" :base-version 1})
|
||||
;; Wait a tick so the updated timestamp is in the past
|
||||
(Thread/sleep 20)
|
||||
;; Purge with a large max-age window — recent deletes are kept
|
||||
(db/purge-deleted! *ds* 999999)
|
||||
(is (some? (db/get-doc *ds* "todo:1")))
|
||||
;; Purge with a tiny max-age — everything older than 10ms ago is removed
|
||||
(db/purge-deleted! *ds* 10)
|
||||
(is (nil? (db/get-doc *ds* "todo:1"))))
|
||||
143
test/pocketbook/server_test.clj
Normal file
143
test/pocketbook/server_test.clj
Normal file
@@ -0,0 +1,143 @@
|
||||
(ns pocketbook.server-test
|
||||
(:require [clojure.test :refer [deftest is testing use-fixtures]]
|
||||
[pocketbook.server :as server]
|
||||
[pocketbook.transit :as t])
|
||||
(:import [java.io File]
|
||||
[java.net URI]
|
||||
[java.net.http HttpClient HttpRequest HttpResponse$BodyHandlers HttpRequest$BodyPublishers]))
|
||||
|
||||
(def ^:dynamic *server* nil)
|
||||
(def ^:dynamic *port* nil)
|
||||
|
||||
(defn- free-port []
|
||||
(with-open [s (java.net.ServerSocket. 0)]
|
||||
(.getLocalPort s)))
|
||||
|
||||
(use-fixtures :each
|
||||
(fn [f]
|
||||
(let [port (free-port)
|
||||
db-path (str (File/createTempFile "pocketbook-server-test" ".db"))
|
||||
srv (server/start! {:port port :db-path db-path})]
|
||||
(Thread/sleep 200) ;; let server start
|
||||
(try
|
||||
(binding [*server* srv *port* port]
|
||||
(f))
|
||||
(finally
|
||||
(server/stop! srv)
|
||||
(.delete (File. db-path)))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; HTTP helpers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(def ^:private client (HttpClient/newHttpClient))
|
||||
|
||||
(defn- url [path & [query]]
|
||||
(str "http://localhost:" *port* path (when query (str "?" query))))
|
||||
|
||||
(defn- get-transit [path query]
|
||||
(let [req (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI. (url path query)))
|
||||
(.header "Accept" "application/transit+json")
|
||||
(.GET)
|
||||
(.build))
|
||||
resp (.send client req (HttpResponse$BodyHandlers/ofByteArray))]
|
||||
{:status (.statusCode resp)
|
||||
:body (t/decode (.body resp))}))
|
||||
|
||||
(defn- post-transit [path body]
|
||||
(let [bytes (t/encode body)
|
||||
req (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI. (url path)))
|
||||
(.header "Content-Type" "application/transit+json")
|
||||
(.header "Accept" "application/transit+json")
|
||||
(.POST (HttpRequest$BodyPublishers/ofByteArray bytes))
|
||||
(.build))
|
||||
resp (.send client req (HttpResponse$BodyHandlers/ofByteArray))]
|
||||
{:status (.statusCode resp)
|
||||
:body (t/decode (.body resp))}))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Tests
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(deftest health-check
|
||||
(let [req (-> (HttpRequest/newBuilder)
|
||||
(.uri (URI. (url "/")))
|
||||
(.GET)
|
||||
(.build))
|
||||
resp (.send client req (HttpResponse$BodyHandlers/ofString))]
|
||||
(is (= 200 (.statusCode resp)))
|
||||
(is (= "pocketbook ok" (.body resp)))))
|
||||
|
||||
(deftest push-and-pull
|
||||
(testing "Push new documents"
|
||||
(let [resp (post-transit "/sync"
|
||||
[{:id "todo:1" :value {:text "Buy milk" :tags #{:groceries}} :base-version 0}
|
||||
{:id "todo:2" :value {:text "Buy eggs"} :base-version 0}])]
|
||||
(is (= 200 (:status resp)))
|
||||
(is (every? #(= :ok (:status %)) (:body resp)))
|
||||
(is (= 1 (:version (first (:body resp)))))))
|
||||
|
||||
(testing "Pull all docs"
|
||||
(let [resp (get-transit "/sync" "group=todo&since=0")]
|
||||
(is (= 200 (:status resp)))
|
||||
(is (= 2 (count (:body resp))))
|
||||
(is (= #{:groceries} (:tags (:value (first (:body resp))))))))
|
||||
|
||||
(testing "Update a doc"
|
||||
(let [resp (post-transit "/sync"
|
||||
[{:id "todo:1" :value {:text "Buy oat milk"} :base-version 1}])]
|
||||
(is (= :ok (:status (first (:body resp)))))
|
||||
(is (= 2 (:version (first (:body resp)))))))
|
||||
|
||||
(testing "Pull only recent changes"
|
||||
(let [all (get-transit "/sync" "group=todo&since=0")
|
||||
ts (:updated (second (:body all)))
|
||||
recent (get-transit "/sync" (str "group=todo&since=" ts))]
|
||||
;; Should get only todo:1 (updated) but not todo:2 (unchanged since ts)
|
||||
;; (depends on timing, but at minimum we get at least 1)
|
||||
(is (<= (count (:body recent)) 2)))))
|
||||
|
||||
(deftest push-conflict
|
||||
(post-transit "/sync"
|
||||
[{:id "todo:1" :value {:text "v1"} :base-version 0}])
|
||||
(let [resp (post-transit "/sync"
|
||||
[{:id "todo:1" :value {:text "stale"} :base-version 0}])]
|
||||
(is (= :conflict (:status (first (:body resp)))))
|
||||
(is (= 1 (:current-version (first (:body resp)))))))
|
||||
|
||||
(deftest push-delete
|
||||
(post-transit "/sync"
|
||||
[{:id "todo:del" :value {:text "delete me"} :base-version 0}])
|
||||
(let [resp (post-transit "/sync"
|
||||
[{:id "todo:del" :deleted true :base-version 1}])]
|
||||
(is (= :ok (:status (first (:body resp))))))
|
||||
(let [resp (get-transit "/sync" "group=todo&since=0")]
|
||||
(is (some #(and (= "todo:del" (:id %)) (:deleted %)) (:body resp)))))
|
||||
|
||||
(deftest missing-group-param
|
||||
(let [resp (get-transit "/sync" "since=0")]
|
||||
(is (= 400 (:status resp)))))
|
||||
|
||||
(deftest type-preservation-over-wire
|
||||
(let [uuid (java.util.UUID/randomUUID)
|
||||
inst #inst "2026-04-04T10:00:00Z"
|
||||
value {:keyword :hello
|
||||
:set #{1 2 3}
|
||||
:vec [1 "two" :three]
|
||||
:uuid uuid
|
||||
:inst inst
|
||||
:nested {:a {:b 42}}}]
|
||||
(post-transit "/sync"
|
||||
[{:id "types:1" :value value :base-version 0}])
|
||||
(let [resp (get-transit "/sync" "group=types&since=0")
|
||||
pulled (:value (first (:body resp)))]
|
||||
;; Transit preserves most types but nippy is used server-side
|
||||
;; The round-trip is: transit-decode → nippy-freeze → nippy-thaw → transit-encode
|
||||
(is (= :hello (:keyword pulled)))
|
||||
(is (= #{1 2 3} (:set pulled)))
|
||||
(is (= [1 "two" :three] (:vec pulled)))
|
||||
(is (= uuid (:uuid pulled)))
|
||||
(is (= inst (:inst pulled)))
|
||||
(is (= {:a {:b 42}} (:nested pulled))))))
|
||||
37
test/pocketbook/transit_test.clj
Normal file
37
test/pocketbook/transit_test.clj
Normal file
@@ -0,0 +1,37 @@
|
||||
(ns pocketbook.transit-test
|
||||
(:require [clojure.test :refer [deftest is testing]]
|
||||
[pocketbook.transit :as t]))
|
||||
|
||||
(deftest roundtrip-basic-types
|
||||
(doseq [v [42
|
||||
"hello"
|
||||
:keyword
|
||||
true
|
||||
nil
|
||||
[1 2 3]
|
||||
{:a 1 :b {:c 2}}
|
||||
#{1 2 3}]]
|
||||
(is (= v (t/decode (t/encode v)))
|
||||
(str "Roundtrip failed for: " (pr-str v)))))
|
||||
|
||||
(deftest roundtrip-clojure-types
|
||||
(let [uuid (java.util.UUID/randomUUID)
|
||||
inst #inst "2026-04-04T10:00:00Z"]
|
||||
(is (= uuid (t/decode (t/encode uuid))))
|
||||
(is (= inst (t/decode (t/encode inst))))))
|
||||
|
||||
(deftest roundtrip-complex-structure
|
||||
(let [data [{:id "todo:1"
|
||||
:value {:text "Buy milk" :tags #{:groceries :urgent}}
|
||||
:version 3
|
||||
:updated 1743760800000}
|
||||
{:id "todo:2"
|
||||
:deleted true
|
||||
:version 5}]]
|
||||
(is (= data (t/decode (t/encode data))))))
|
||||
|
||||
(deftest encode-str-roundtrip
|
||||
(let [v {:hello "world" :nums [1 2 3]}
|
||||
s (t/encode-str v)]
|
||||
(is (string? s))
|
||||
(is (= v (t/decode s)))))
|
||||
Reference in New Issue
Block a user