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
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)))
|
||||
Reference in New Issue
Block a user