Closed yuliswe closed 7 years ago
yuliswe
commented
7 years ago This is some sort of draft. Things will be easier if the frontend can remember the ids and only use id to query (at least for now this is enough for our purpose). Haven't added projects yet (feeling lazy). I'm open to criticism.
e45lee
commented
7 years ago I was thinking of separating out the file/file name contents, say like this:
Contents table: {key: uuid, contents: string, history: string, last-revisions: [listof uuid], create_time: ...} Mapping table: {mapping_key: uuid, project_key: uuid, path: string, contents: uuid} Project table: {key: uuid, name: string, settings: any}
So that we can do conflicts easier (conflicts are just duplicate mappings in the mappings table from paths -> contents, and conflict resolution is simply deleting one duplicate mapping in the table -- we can even record merges by having multiple last-revisions in the contents table)
Also, the Dexie JS syncing code requires primary keys to be UUIDs (and not autoincrementing integers), and it'd be nice if we could use that to make our lives easier: http://dexie.org/docs/Syncable/Dexie.Syncable.js.
I'm not so sure we care about having all the types present in the backend (as that's less flexible -- specifically the Settings type).
We can use a modern SQLite with the JSON1 extension to make our lives easier.
On Sat, Feb 18, 2017 at 12:55 AM, Yu Li notifications@github.com wrote:
assumpition 1: one database per user. DB connection is kept open as long as seashell-main is running. assumpition 2: always use integer as the primary key. assumpition 3: each structure write to the DB must have an id field assumpition 4: each structure has a corresponding table assumpition 5: performace is not a concern (won't have so many entires anyways)
db lib -> abstract query -> interface -> other modules
query db <- translate to sql statments <- function call <- other modules query db <- sql statments <- write key <- write-file(struct file)
interface.rkt:
(require "query-abstraction.rkt") (provide (all-defined-out))
(define-type ID Integer)
(struct (X) Result ([success : Boolean] [recent : X] [conflicts : (Listof X)]))
(struct File ([id : ID] [path : String] [contents : Bytes] [last-modified : Date] [last-visited : Date] [create-date : Date] [revision : Integer]))
(struct Settings ([id : ID] [font-size : Int] [runner-fileID : ID] [theme : String] [recent-fileID : File]))
;; create file if not exists ignoring id, otherwise update the file of that id ;; Result-recent will be the file passed in (: write-file (-> File (Result File)))
;; throw user error if not exists (: read-file (-> ID Result))
;; create default settings if not exists (: read-settings (-> (Result Settings)))
(: write-settings (-> Settings (Result Settings)))
query-abstraction.rkt:
(require "db")
(provide get-one get-all)
(define-type Username String) (define-type Password String)
;; global variable (define db-connection ...)
;; create db is db is missing ;; set up db connection, mutate global variable ;; also set up tables if missing (: connect-db (-> Username Password Void))
;; which structure has a corresponding table (: db-structs (listof Identifier)) (define db-structs (list File Settings)
;; eg. (get-one 1 File) ;; look up the id in "X" table (: get-one (-> ID X X)) (define (get-one) (exec-query "select %a from %a where id = ?")))
;; select * from ... ;; eg. (get-all File) (: get-all (-> X (listof X)))
;; helpers
(: identifier->string (-> Identifier String)) (define (identifier->string id) (symbol->string (syntax-e id)))
;; turn structure accessor methods identifier to string (: fields->strings (-> Identifier (listof String)))
;; normalize a string to become table name, column names (: normalize-for-db (-> String String))
— You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub https://github.com/cs136/seashell/issues/665, or mute the thread https://github.com/notifications/unsubscribe-auth/ADK8ik1TCQc6gpL6ciz00rRToQAvA4Jjks5rdoe4gaJpZM4MFAoz .
-- Edward Lee
yuliswe
commented
7 years ago I was thinking of separating out the file/file name contents Contents table: {key: uuid, contents: string, history: string, last-revisions: [listof uuid], create_time: ...} Mapping table: {mapping_key: uuid, project_key: uuid, path: string, contents: uuid} Project table: {key: uuid, name: string, settings: any}
You mean separate out files and projects?
e45lee
commented
7 years ago No, I mean separate out file contents from their file names, and to use an intermediary table to translate [project_id, file_name] pairs to file_content_ids.
On Sat, Feb 18, 2017 at 8:25 AM, Yu Li notifications@github.com wrote:
I was thinking of separating out the file/file name contents Contents table: {key: uuid, contents: string, history: string, last-revisions: [listof uuid], create_time: ...} Mapping table: {mapping_key: uuid, project_key: uuid, path: string, contents: uuid} Project table: {key: uuid, name: string, settings: any} You mean separate out file and projects?
— You are receiving this because you commented. Reply to this email directly, view it on GitHub https://github.com/cs136/seashell/issues/665#issuecomment-280845434, or mute the thread https://github.com/notifications/unsubscribe-auth/ADK8il_8RG4sNxofCttw6ZOkm2tKKHbWks5rdvFFgaJpZM4MFAoz .
-- Edward Lee
e45lee
commented
7 years ago FWIW, Dexie's sync protocol requires that we keep a log of every change made to the database, so we can simply use that to look for old file contents.
On Sat, Feb 18, 2017 at 8:27 AM, Edward Lee e45lee@uwaterloo.ca wrote:
No, I mean separate out file contents from their file names, and to use an intermediary table to translate [project_id, file_name] pairs to file_content_ids.
On Sat, Feb 18, 2017 at 8:25 AM, Yu Li notifications@github.com wrote:
I was thinking of separating out the file/file name contents Contents table: {key: uuid, contents: string, history: string, last-revisions: [listof uuid], create_time: ...} Mapping table: {mapping_key: uuid, project_key: uuid, path: string, contents: uuid} Project table: {key: uuid, name: string, settings: any} You mean separate out file and projects?
— You are receiving this because you commented. Reply to this email directly, view it on GitHub https://github.com/cs136/seashell/issues/665#issuecomment-280845434, or mute the thread https://github.com/notifications/unsubscribe-auth/ADK8il_8RG4sNxofCttw6ZOkm2tKKHbWks5rdvFFgaJpZM4MFAoz .
-- Edward Lee
-- Edward Lee
e45lee
commented
7 years ago At the end of the day (and we should discuss this), it would be great if we could get rid of all the file/directory manipulation API calls (read/create/write/...) and just use sync to store/get changes from the server.
On Sat, Feb 18, 2017 at 8:31 AM, Edward Lee e45lee@uwaterloo.ca wrote:
FWIW, Dexie's sync protocol requires that we keep a log of every change made to the database, so we can simply use that to look for old file contents.
On Sat, Feb 18, 2017 at 8:27 AM, Edward Lee e45lee@uwaterloo.ca wrote:
No, I mean separate out file contents from their file names, and to use an intermediary table to translate [project_id, file_name] pairs to file_content_ids.
On Sat, Feb 18, 2017 at 8:25 AM, Yu Li notifications@github.com wrote:
I was thinking of separating out the file/file name contents Contents table: {key: uuid, contents: string, history: string, last-revisions: [listof uuid], create_time: ...} Mapping table: {mapping_key: uuid, project_key: uuid, path: string, contents: uuid} Project table: {key: uuid, name: string, settings: any} You mean separate out file and projects?
— You are receiving this because you commented. Reply to this email directly, view it on GitHub https://github.com/cs136/seashell/issues/665#issuecomment-280845434, or mute the thread https://github.com/notifications/unsubscribe-auth/ADK8il_8RG4sNxofCttw6ZOkm2tKKHbWks5rdvFFgaJpZM4MFAoz .
-- Edward Lee
-- Edward Lee
-- Edward Lee
yuliswe
commented
7 years ago You need a table for this? http://dexie.org/docs/Syncable/Dexie.Syncable.IDatabaseChange.html Is this just for files, or for each table you will need to create a changlog table?
yuliswe
commented
7 years ago I see what you mean. http://dexie.org/docs/Syncable/Dexie.Syncable.ISyncProtocol I think this requires the serverside to be running javascript..?
e45lee
commented
7 years ago No, as we have to implement the sync protocol ourselves; there's an example we could easily port to racket though. On Sat, Feb 18, 2017 at 9:17 AM Yu Li notifications@github.com wrote:
I see what you mean. http://dexie.org/docs/Syncable/Dexie.Syncable.ISyncProtocol I think this requires the serverside to be running javascript..?
— You are receiving this because you commented.
Reply to this email directly, view it on GitHub https://github.com/cs136/seashell/issues/665#issuecomment-280848289, or mute the thread https://github.com/notifications/unsubscribe-auth/ADK8iisNzT00Rmw0nr_b35tASLLgs0Bxks5rdv1fgaJpZM4MFAoz .
e45lee
commented
7 years ago Anyways, here's a partial implementation of the sync server. I've copied the tests from nponiros/sync_server.
When/if we get around to integrating this, we should split up this snippet into different modules.
#lang at-exp typed/racket
(require typed/json)
(require typed/db)
(require typed/db/sqlite3)
(require "typed-json-struct.rkt")
(: true? (All (A) (-> (Option A) Any : #:+ A)))
(define (true? x) x)
(: sqlite-connection (-> SQLite3-Database-Storage Connection))
(define (sqlite-connection path)
(virtual-connection
(connection-pool
(thunk (sqlite3-connect #:database path #:use-place #t)))))
(define compute-conn (sqlite-connection 'memory))
(: string-or-jsexpr->string (-> (U String JSExpr) String))
(define (string-or-jsexpr->string jsexpr)
(if (string? jsexpr) jsexpr (jsexpr->string jsexpr)))
(: jsexpr-or-string->jsexpr (-> (U String JSExpr) JSExpr))
(define (jsexpr-or-string->jsexpr x)
(if (string? x) (string->jsexpr x) x))
(: set-by-key-path (-> (U String JSExpr) String String String))
(define (set-by-key-path object key update)
(assert (query-value compute-conn "SELECT json_set(json($1), $2, json($3))"
(string-or-jsexpr->string object)
(string-append "$." key)
update) string?))
#|
(equal? (set-by-key-path @~a{{}} "foo" @~a{"value"}) "{\"foo\":\"value\"}")
(equal? (set-by-key-path @~a{{}} "foo.bar" @~a{"value"}) "{\"foo\":{\"bar\":\"value\"}}")
|#
(: delete-by-key-path (-> (U String JSExpr) String String))
(define (delete-by-key-path object key)
(assert (query-value compute-conn "SELECT json_remove(json($1), $2)"
(string-or-jsexpr->string object)
(string-append "$." key)) string?))
(: apply-modifications (-> (U String JSExpr) (U String (HashTable Symbol JSExpr)) String))
(define (apply-modifications _object _updates)
(define updates (assert (jsexpr-or-string->jsexpr _updates) hash?))
(for/fold ([object (string-or-jsexpr->string _object)])
([(_key _value) (in-hash updates)])
(define key-path (symbol->string _key))
(define update (jsexpr->string _value))
(set-by-key-path object key-path update)))
#|
(equal? (string->jsexpr (apply-modifications @~a{{"foo": "oldValue"}} @~a{{"foo": "newValue", "bar":2}}))
'#hasheq((bar . 2) (foo . "newValue")))
|#
(: fold-create-and-update (-> (U String JSExpr) (U String (HashTable Symbol JSExpr)) String))
(define (fold-create-and-update object update)
(apply-modifications object update))
#|
(equal?
(string->jsexpr (fold-create-and-update @~a{{"foo": "value"}} @~a{{"foo": "value2", "bar": "new Value"}}))
'#hasheq((bar . "new Value") (foo . "value2")))
|#
(: fold-update-and-update (-> (U String JSExpr) (U String JSExpr) String))
(define (fold-update-and-update _update-old _update-new)
(define update-old (assert (jsexpr-or-string->jsexpr _update-old) hash?))
(define update-new (assert (jsexpr-or-string->jsexpr _update-new) hash?))
(jsexpr->string (for/fold ([new-change update-old])
([(_key-new _value-new) (in-hash update-new)])
(define key-new (symbol->string _key-new))
(define-values (had-parent? updated-change)
(for/fold ([had-parent? : Boolean #f]
[updated-change : (HashTable Symbol JSExpr) new-change])
([(_key-old _) (in-hash update-old)])
(define key-old (symbol->string _key-old))
(cond
[(string-prefix? key-new (string-append key-old "."))
(define key-new-rest (substring key-new (add1 (string-length key-old))))
(values #t (hash-set updated-change
_key-old
(string->jsexpr (set-by-key-path
(hash-ref updated-change _key-old)
key-new-rest
(jsexpr->string _value-new)))))]
[else
(values (or had-parent? #f) updated-change)])))
(define new-updated-change
(cond
[had-parent? updated-change]
[else
(hash-set updated-change _key-new _value-new)]))
(define finalized-updated-change
(for/fold ([finalized-updated-change : (HashTable Symbol JSExpr) new-updated-change])
([(_key-old _) (in-hash update-old)])
(define key-old (symbol->string _key-old))
(cond
[(string-prefix? key-old (string-append key-new "."))
(hash-remove finalized-updated-change _key-old)]
[else finalized-updated-change])))
finalized-updated-change)))
#|
(equal?
(string->jsexpr (fold-update-and-update @~a{{"foo": "bar"}} @~a{{"bar": "baz"}}))
'#hasheq((bar . "baz") (foo . "bar")))
(equal?
(string->jsexpr (fold-update-and-update @~a{{"foo": "bar"}} @~a{{"foo": "baz"}}))
'#hasheq((foo . "baz")))
(equal?
(string->jsexpr (fold-update-and-update @~a{{"foo": {"bar": "baz", "baz": "bar"}}} @~a{{"foo.bar": "foobar"}}))
'#hasheq((foo . #hasheq((baz . "bar") (bar . "foobar")))))
(equal?
(string->jsexpr (fold-update-and-update @~a{{"foo.bar": "foobar"}} @~a{{"foo": {"bar": "baz"}}}))
'#hasheq((foo . #hasheq((bar . "baz")))))
|#
(define CREATE 1)
(define UPDATE 2)
(define DELETE 3)
(define SERVER_CLIENT_KEY "__SERVER_CHANGE")
(define SERVER_MERGE_KEY "__SERVER_MERGED_CHANGE")
(: in-transaction? (Parameter Boolean))
(define in-transaction? (make-parameter #f))
(struct database-change ([type : Integer] [client : String] [table : String] [key : String] [data : String]) #:transparent)
(: row->change (-> (Vectorof SQL-Datum) database-change))
(define (row->change row)
(define type (assert (vector-ref row 0) exact-integer?))
(define client (assert (vector-ref row 1) string?))
(define table (assert (vector-ref row 2) string?))
(define key (assert (vector-ref row 3) string?))
(define data (assert (vector-ref row 4) string?))
(database-change type client table key data))
(: reduce-changes (-> (Listof database-change) (HashTable (Pair String String) database-change)))
(define (reduce-changes changes)
(for/fold ([changes : (HashTable (Pair String String) database-change) (hash)])
([change : database-change changes])
(match-define (database-change type client table key data) change)
(define change-key (cons table key))
(cond
[(hash-has-key? changes change-key)
(define old-change (hash-ref changes change-key))
(match-define (database-change old-type old-client old-table old-key old-data) old-change)
(hash-set changes change-key
(cond
[(= old-type CREATE)
(cond
[(= type UPDATE) (database-change CREATE SERVER_MERGE_KEY table key (fold-create-and-update old-data data))]
[else change])]
[(= old-type UPDATE)
(cond
[(= type UPDATE) (database-change UPDATE SERVER_MERGE_KEY table key (fold-update-and-update old-data data))]
[else change])]
[(= old-type DELETE)
(cond
[(= type CREATE) change]
[else old-change])]
[else change]))]
[else (hash-set changes change-key change)])))
#|
(equal?
(reduce-changes (list (database-change CREATE "_test" "foo" "1" "{}")
(database-change UPDATE "_test" "foo" "2" "{}")
(database-change DELETE "_test" "bar" "1" "{}")))
(hash
'("foo" . "1")
(database-change 1 "_test" "foo" "1" "{}")
'("foo" . "2")
(database-change 2 "_test" "foo" "2" "{}")
'("bar" . "1")
(database-change 3 "_test" "bar" "1" "{}"))
)
(equal?
(reduce-changes (list (database-change CREATE "_test" "foo" "1" "{}")
(database-change CREATE "_test" "foo" "1" @~a{{"foo": "bar"}})))
(hash '("foo" . "1") (database-change 1 "_test" "foo" "1" "{\"foo\": \"bar\"}"))
)
(equal?
(reduce-changes (list (database-change CREATE "_test" "foo" "1" "{}")
(database-change DELETE "_test" "foo" "1" "false")))
(hash '("foo" . "1") (database-change 3 "_test" "foo" "1" "false"))
)
(equal?
(reduce-changes (list (database-change UPDATE "_test" "foo" "1" @~a{{"foo": "bar"}})
(database-change CREATE "_test" "foo" "1" @~a{{"foo": "bar baz"}})))
(hash '("foo" . "1") (database-change 1 "_test" "foo" "1" "{\"foo\": \"bar baz\"}")))
(equal?
(reduce-changes (list (database-change UPDATE "_test" "foo" "1" "{}")
(database-change DELETE "_test" "foo" "1" "false")))
(hash '("foo" . "1") (database-change 3 "_test" "foo" "1" "false"))
)
(equal?
(reduce-changes (list (database-change UPDATE "_test" "foo" "1" @~a{{"foo": "baz"}})
(database-change UPDATE "_test" "foo" "1" @~a{{"title": "bar"}})))
(hash
'("foo" . "1")
(database-change 2 "__SERVER_MERGED_CHANGE" "foo" "1" "{\"foo\":\"baz\",\"title\":\"bar\"}")))
(equal?
(reduce-changes (list (database-change DELETE "_test" "foo" "1" "false")
(database-change CREATE "_test" "foo" "1" @~a{{"foo": "bar"}})))
(hash '("foo" . "1") (database-change 1 "_test" "foo" "1" "{\"foo\": \"bar\"}")))
(equal?
(reduce-changes (list (database-change DELETE "_test" "foo" "1" "false")
(database-change DELETE "_test" "foo" "1" "false")))
(hash '("foo" . "1") (database-change 3 "_test" "foo" "1" "false")))
(equal?
(reduce-changes (list (database-change DELETE "_test" "foo" "1" "false")
(database-change UPDATE "_test" "foo" "1" @~a{{"foo": "bar"}})))
(hash '("foo" . "1") (database-change 3 "_test" "foo" "1" "false")))
|#
(: resolve-conflicts (-> (Listof database-change) (Listof database-change) (Listof database-change)))
(define (resolve-conflicts client-changes server-changes)
(define reduced-changes (reduce-changes server-changes))
(filter (inst true? database-change)
(for/list : (Listof (Option database-change))
([change : database-change client-changes])
(match-define (database-change client-type client client-table client-key client-data) change)
(define client-change-id (cons client-table client-key))
(cond
[(hash-has-key? reduced-changes client-change-id)
(define server-change (hash-ref reduced-changes client-change-id))
(define server-type (database-change-type server-change))
(define server-data (database-change-data server-change))
(cond
[(= UPDATE server-type)
(cond
[(= CREATE client-type)
(database-change client-type client client-table client-key
(apply-modifications client-data server-data))]
[(= DELETE client-type)
change]
[(= UPDATE client-type)
(define parsed-client-mods (assert (string->jsexpr client-data) hash?))
(define parsed-server-mods (assert (string->jsexpr server-data) hash?))
(define result (for/fold
([new-client-data : (HashTable Symbol JSExpr) parsed-client-mods])
([(_server-key _) (in-hash parsed-server-mods)])
(define server-key (symbol->string _server-key))
(for/fold
([temp-client-data : (HashTable Symbol JSExpr) (hash-remove new-client-data _server-key)])
([(_client-key _2) (in-hash parsed-client-mods)])
(define client-key (symbol->string _client-key))
(if (string-prefix? client-key (string-append server-key "."))
(hash-remove temp-client-data _client-key)
temp-client-data))))
(if (not (hash-empty? result))
(database-change client-type client client-table client-key
(jsexpr->string result))
#f)]
[else #f])]
[else #f])]
[else change]))))
#|
(equal?
(resolve-conflicts (list (database-change CREATE "_test" "foo" "1" "{}")) '())
(list (database-change 1 "_test" "foo" "1" "{}")))
(equal?
(resolve-conflicts '() (list (database-change 1 "_test" "foo" "1" "{}")))
'())
(equal?
(resolve-conflicts (list (database-change UPDATE "_test" "foo" "1" "{}"))
(list (database-change DELETE "_test" "foo" "1" "false")))
'())
(equal?
(resolve-conflicts (list (database-change CREATE "_test" "foo" "1" @~a{{"foo": "bar", "foobar": "foobar"}}))
(list (database-change UPDATE "_test" "foo" "1" @~a{{"foo": "baz", "bar": "bar"}})))
(list
(database-change 1 "_test" "foo" "1" "{\"foo\":\"baz\",\"foobar\":\"foobar\",\"bar\":\"bar\"}")))
(equal?
(resolve-conflicts (list (database-change DELETE "_test" "foo" "1" "false"))
(list (database-change UPDATE "_test" "foo" "1" @~a{{"foo": "baz", "bar": "bar"}})))
(list (database-change 3 "_test" "foo" "1" "false")))
(equal?
(resolve-conflicts (list (database-change UPDATE "_test" "foo" "1" @~a{{"foo" : "bar"}}))
(list (database-change UPDATE "_test" "foo" "1" @~a{{"foo" : "baz"}})))
'())
(equal?
(resolve-conflicts (list (database-change UPDATE "_test" "foo" "1" @~a{{"foo.bar" : "bar"}}))
(list (database-change UPDATE "_test" "foo" "1" @~a{{"foo" : "baz"}})))
'())
(equal?
(resolve-conflicts (list (database-change UPDATE "_test" "foo" "1" @~a{{"foo" : "bar", "foobar": "foobar"}}))
(list (database-change UPDATE "_test" "foo" "1" @~a{{"foo" : "baz", "bar": "bar"}})))
(list (database-change 2 "_test" "foo" "1" "{\"foobar\":\"foobar\"}")))
(equal?
(resolve-conflicts (list (database-change UPDATE "_test" "foo" "1" @~a{{"foo" : "bar"}}))
(list (database-change UPDATE "_test" "foo" "1" @~a{{"foo.bar" : "bar"}})))
(list (database-change 2 "_test" "foo" "1" "{\"foo\":\"bar\"}")))
|#
(define sync-database%
(class object%
(init [path : SQLite3-Database-Storage])
(: database Connection)
(define database (sqlite-connection path))
(super-new)
(query-exec database "CREATE TABLE IF NOT EXISTS _clients (id TEXT PRIMARY KEY, description TEXT)")
(query-exec database "INSERT OR IGNORE INTO _clients VALUES ($1, $2)" SERVER_CLIENT_KEY "Server-side Writes")
(query-exec database "CREATE TABLE IF NOT EXISTS _changes (revision INTEGER PRIMARY KEY AUTOINCREMENT,
type INTEGER,
client TEXT,
target_table TEXT,
target_key TEXT,
data TEXT DEFAULT 'false',
FOREIGN KEY(client) REFERENCES _clients(id))")
(query-exec database "CREATE TABLE IF NOT EXISTS _partials (client TEXT,
type INTEGER,
target_table TEXT,
target_key text,
data TEXT DEFAULT 'false',
FOREIGN KEY(client) REFERENCES _clients(id))")
(: write-transaction (All (A) (-> (-> A) A)))
(define/public (write-transaction thunk)
(define option (if (in-transaction?) #f 'immediate))
(parameterize ([in-transaction? #t])
(call-with-transaction database thunk #:option option)))
(: read-transaction (All (A) (-> (-> A) A)))
(define/public (read-transaction thunk)
(define option (if (in-transaction?) #f 'deferred))
(parameterize ([in-transaction? #t])
(call-with-transaction database thunk #:option option)))
(: current-revision (-> Integer))
(define/public (current-revision)
(define result (query-value database "SELECT MAX(revision) FROM _changes"))
(assert result exact-integer?))
(: fetch (-> String String (Option JSExpr)))
(define/public (fetch table key)
(define result (query-maybe-value database (format "SELECT json(data) FROM ~a WHERE id=$1" table) key))
(if (string? result)
(string->jsexpr result)
#f))
(: apply-create (->* (String String (U String (HashTable Symbol JSExpr))) ((Option String) Boolean) Any))
(define/public (apply-create table key object [_client #f] [_transaction #t])
(define data (string-or-jsexpr->string object))
(define todo (thunk
(query-exec database (format "CREATE TABLE IF NOT EXISTS '~a' (id TEXT PRIMARY KEY, data TEXT)" table))
(query-exec database (format "INSERT OR REPLACE INTO '~a' (id, data) VALUES ($1, $2)" table) key data)
(query-exec database "INSERT INTO _changes (client, type, target_table, target_key, data) VALUES ($1, $2, $3, $4, json($5))"
(or _client SERVER_CLIENT_KEY)
CREATE
table
key
data)))
(if _transaction (write-transaction todo) (todo)))
(: apply-partial-create (->* (String String (U String (HashTable Symbol JSExpr))) ((Option String)) Any))
(define/public (apply-partial-create table key object [_client #f])
(define data (string-or-jsexpr->string object))
(query-exec database "INSERT INTO _partials (client, type, target_table, target_key, data) VALUES ($1, $2, $3, $4, json($5))"
(or _client SERVER_CLIENT_KEY)
CREATE
table
key
data))
(: apply-update (->* (String String (HashTable Symbol JSExpr)) ((Option String) Boolean) Any))
(define/public (apply-update table key updates [_client #f] [_transaction #t])
(define data (string-or-jsexpr->string updates))
(define todo (thunk
(define exists? (query-maybe-value database "SELECT 1 FROM sqlite_master WHERE type = $1 AND name = $2" "table" table))
(when exists?
(hash-for-each updates
(lambda ([_key : Symbol] [_value : JSExpr])
(define key-path (string-append "$." (symbol->string _key)))
(define update (jsexpr->string _value))
(query-exec database (format "UPDATE ~a SET data = json_set(json(data), $1, json($2)) WHERE id=$3" table) key-path update key)))
(query-exec database "INSERT INTO _changes (client, type, target_table, target_key, data) VALUES ($1, $2, $3, $4, json($5))"
(or _client SERVER_CLIENT_KEY)
UPDATE
table
key
data))))
(if _transaction (write-transaction todo) (todo)))
(: apply-partial-update (->* (String String (HashTable Symbol JSExpr)) ((Option String)) Any))
(define/public (apply-partial-update table key updates [_client #f])
(define data (string-or-jsexpr->string updates))
(query-exec database "INSERT INTO _partials (client, type, target_table, target_key, data) VALUES ($1, $2, $3, $4, json($5))"
(or _client SERVER_CLIENT_KEY)
UPDATE
table
key
data))
(: apply-delete (->* (String String) ((Option String) Boolean) Any))
(define/public (apply-delete table key [_client #f] [_transaction #t])
(define todo (thunk
(define exists? (query-maybe-value database "SELECT 1 FROM sqlite_master WHERE type = $1 AND name = $2" "table" table))
(when exists?
(query-exec database (format "DELETE FROM ~a WHERE id = $1" table) key)
(query-exec database "INSERT INTO _changes (client, type, target_table, target_key) VALUES ($1, $2, $3, $4)"
(or _client SERVER_CLIENT_KEY)
DELETE
table
key))))
(if _transaction (write-transaction todo) (todo)))
(: apply-partial-delete (->* (String String) ((Option String)) Any))
(define/public (apply-partial-delete table key [_client #f])
(query-exec database "INSERT INTO _partials (client, type, target_table, target_key) VALUES ($1, $2, $3, $4)"
(or _client SERVER_CLIENT_KEY)
DELETE
table
key))
(: apply-partials (->* () (Integer (Option String)) Any))
(define/public (apply-partials [base 0] [_client #f])
(define client (or _client SERVER_CLIENT_KEY))
(write-transaction
(thunk
(define changes (map row->change (query-rows database "SELECT type, client, target_table, target_key, json(data) FROM _partials WHERE client = $1" client)))
(define server-changes (map row->change (query-rows database "SELECT type, client, target_table, target_key, json(data) FROM _changes WHERE revision >= $1" base)))
(define resolved-changes (resolve-conflicts changes server-changes))
(display resolved-changes)
(for ([change resolved-changes])
(match-define (database-change type client table key data) change)
(cond
[(= type CREATE) (apply-create table key data client #f)]
[(= type UPDATE) (apply-update table key (assert (string->jsexpr data) hash?) client #f)]
[(= type DELETE) (apply-delete table key client #f)]))
(query-exec database "DELETE FROM _partials WHERE client = $1" client))))
))
;(define foo (new sync-database% [path 'memory]))
;(send foo apply-create "test" "12345" #{(hash 'bar #{(hash) :: JSExpr}) :: (HashTable Symbol JSExpr)} #f)
;(send foo apply-update "test" "12345" #{(hash 'foo.baz 2) :: (HashTable Symbol JSExpr)} #f)
;(send foo fetch "test" "12345")
;(send foo apply-partial-update "test" "12345" #{(hash 'foo.baz 10) :: (HashTable Symbol JSExpr)} #f)
;(send foo apply-partial-delete "test" "X")
;(send foo fetch "test" "12345")
;(send foo apply-partials 3)
;(send foo fetch "test" "12345")This has landed as of this week.
assumpition 1: one database per user. DB connection is kept open as long as seashell-main is running. assumpition 2: always use integer as the primary key. assumpition 3: each structure written to the DB must have an id field assumpition 4: each structure has a corresponding table assumpition 5: performace is not a concern (won't have so many entires anyways)