objective categorical abstract machine language personal data server
Store commit separately from mst blocks
+32
-28
+32
-28
pegasus/lib/user_store.ml
+32
-28
pegasus/lib/user_store.ml
···
61
61
open Types
62
62
63
63
module Queries = struct
64
-
(* block storage *)
64
+
(* mst block storage *)
65
65
let create_blocks_tables conn =
66
66
let$! () =
67
67
[%rapper
68
68
execute
69
-
{sql| CREATE TABLE IF NOT EXISTS blocks (
70
-
cid TEXT NOT NULL PRIMARY KEY,
71
-
data BLOB NOT NULL
72
-
);
73
-
|sql}]
69
+
{sql| CREATE TABLE IF NOT EXISTS mst (
70
+
cid TEXT NOT NULL PRIMARY KEY,
71
+
data BLOB NOT NULL
72
+
);
73
+
|sql}]
74
74
() conn
75
75
in
76
76
[%rapper
77
77
execute
78
-
{sql| CREATE TABLE IF NOT EXISTS named_blocks (
79
-
name TEXT NOT NULL UNIQUE,
80
-
cid TEXT NOT NULL UNIQUE,
81
-
FOREIGN KEY (cid) REFERENCES blocks (cid)
78
+
{sql| CREATE TABLE IF NOT EXISTS commit (
79
+
id INTEGER PRIMARY KEY CHECK (id = 0),
80
+
cid TEXT NOT NULL,
81
+
data BLOB NOT NULL
82
82
);
83
83
|sql}]
84
84
() conn
···
86
86
let get_block cid =
87
87
[%rapper
88
88
get_opt
89
-
{sql| SELECT @CID{cid}, @Blob{data} FROM blocks WHERE cid = %CID{cid} |sql}
89
+
{sql| SELECT @CID{cid}, @Blob{data} FROM mst WHERE cid = %CID{cid} |sql}
90
90
record_out]
91
91
~cid
92
92
93
93
let get_blocks cids =
94
94
[%rapper
95
95
get_many
96
-
{sql| SELECT @CID{cid}, @Blob{data} FROM blocks WHERE cid IN (%list{%CID{cids}}) |sql}
96
+
{sql| SELECT @CID{cid}, @Blob{data} FROM mst WHERE cid IN (%list{%CID{cids}}) |sql}
97
97
record_out]
98
98
~cids
99
99
100
100
let has_block cid =
101
101
[%rapper
102
-
get_opt {sql| SELECT @CID{cid} FROM blocks WHERE cid = %CID{cid} |sql}]
102
+
get_opt {sql| SELECT @CID{cid} FROM mst WHERE cid = %CID{cid} |sql}]
103
103
~cid
104
104
105
105
let put_block cid block =
106
106
[%rapper
107
107
get_opt
108
-
{sql| INSERT INTO blocks (cid, data) VALUES (%CID{cid}, %Blob{block}) ON CONFLICT DO NOTHING RETURNING @CID{cid} |sql}]
108
+
{sql| INSERT INTO mst (cid, data) VALUES (%CID{cid}, %Blob{block}) ON CONFLICT DO NOTHING RETURNING @CID{cid} |sql}]
109
109
~cid ~block
110
110
111
111
let delete_block cid =
112
-
[%rapper execute {sql| DELETE FROM blocks WHERE cid = %CID{cid} |sql}] ~cid
112
+
[%rapper execute {sql| DELETE FROM mst WHERE cid = %CID{cid} |sql}] ~cid
113
113
114
114
let delete_blocks cids =
115
115
[%rapper
116
116
get_many
117
-
{sql| DELETE FROM blocks WHERE cid IN (%list{%CID{cids}}) RETURNING @CID{cid} |sql}]
117
+
{sql| DELETE FROM mst WHERE cid IN (%list{%CID{cids}}) RETURNING @CID{cid} |sql}]
118
118
~cids
119
119
120
-
let clear_blocks = [%rapper execute {sql| DELETE FROM blocks |sql}] ()
120
+
let clear_blocks = [%rapper execute {sql| DELETE FROM mst |sql}] ()
121
121
122
+
(* repo commit *)
122
123
let get_commit =
123
124
[%rapper
124
125
get_opt
125
-
{sql| SELECT @CID{cid}, @Blob{data} FROM blocks
126
-
LEFT JOIN named_blocks ON blocks.cid = named_blocks.cid
127
-
WHERE blocks.name = 'commit'
128
-
|sql}]
126
+
{sql| SELECT @CID{cid}, @Blob{data}
127
+
FROM commit WHERE id = 0
128
+
|sql}]
129
129
()
130
130
131
-
let put_commit cid block conn =
132
-
let$! _ = put_block cid block conn in
131
+
let put_commit cid data =
133
132
[%rapper
134
133
execute
135
-
{sql| INSERT INTO named_blocks (cid, name) VALUES (%CID{cid}, 'commit')
136
-
ON CONFLICT DO UPDATE SET cid = %CID{cid}
137
-
|sql}]
138
-
~cid conn
134
+
{sql| INSERT INTO commit (id, cid, data)
135
+
VALUES (0, %CID{cid}, %Blob{data})
136
+
ON CONFLICT(id) DO UPDATE SET
137
+
cid = excluded.cid,
138
+
data = excluded.data
139
+
|sql}]
140
+
~cid ~data
139
141
140
142
(* record storage *)
141
143
let create_records_table =
···
270
272
let$! () = Queries.create_blobs_tables conn in
271
273
Lwt.return_unit
272
274
273
-
(* blocks *)
275
+
(* mst blocks; implements Writable_blockstore *)
274
276
275
277
let get_bytes conn cid : Blob.t option Lwt.t =
276
278
Queries.get_block cid conn
···
313
315
let clear_blocks conn : unit Lwt.t =
314
316
let$! () = Queries.clear_blocks conn in
315
317
Lwt.return_unit
318
+
319
+
(* repo commit *)
316
320
317
321
let get_commit conn : (Cid.t * signed_commit) option Lwt.t =
318
322
Queries.get_commit conn