objective categorical abstract machine language personal data server
Set up migrations for user store
+87
-90
+13
-2
dune
+13
-2
dune
···
67
67
(subdir
68
68
pegasus/lib/migrations/
69
69
(rule
70
-
(target migrations_sql.ml)
70
+
(target data_store_migrations_sql.ml)
71
+
(deps
72
+
(source_tree ./data_store))
73
+
(action
74
+
(with-stdout-to
75
+
%{null}
76
+
(run ocaml-crunch -e sql -m plain . -o %{target})))))
77
+
78
+
(subdir
79
+
pegasus/lib/migrations/
80
+
(rule
81
+
(target user_store_migrations_sql.ml)
71
82
(deps
72
-
(source_tree .))
83
+
(source_tree ./user_store))
73
84
(action
74
85
(with-stdout-to
75
86
%{null}
+3
-7
pegasus/lib/data_store.ml
+3
-7
pegasus/lib/data_store.ml
···
20
20
type firehose_event = {seq: int; time: int; t: string; data: bytes}
21
21
22
22
type reserved_key =
23
-
{ key_did: string
24
-
; did: string option
25
-
; private_key: string
26
-
; created_at: int }
23
+
{key_did: string; did: string option; private_key: string; created_at: int}
27
24
end
28
25
29
26
open Types
···
75
72
76
73
let delete_actor =
77
74
[%rapper
78
-
execute
79
-
{sql| DELETE FROM actors WHERE did = %string{did}
75
+
execute {sql| DELETE FROM actors WHERE did = %string{did}
80
76
|sql}]
81
77
82
78
let update_actor_handle =
···
273
269
Util.mkfile_p Util.Constants.pegasus_db_filepath ~perm:0o644 ;
274
270
Util.connect_sqlite ?create ?write Util.Constants.pegasus_db_location
275
271
276
-
let init conn : unit Lwt.t = Migrations.run_migrations conn
272
+
let init conn : unit Lwt.t = Migrations.run_ds_migrations conn
277
273
278
274
let create_actor ~did ~handle ~email ~password ~signing_key conn =
279
275
let password_hash = Bcrypt.hash password |> Bcrypt.string_of_hash in
pegasus/lib/migrations/001_initial_schema.sql
pegasus/lib/migrations/data_store/001_initial_schema.sql
pegasus/lib/migrations/001_initial_schema.sql
pegasus/lib/migrations/data_store/001_initial_schema.sql
pegasus/lib/migrations/002_track_oauth_sessions.sql
pegasus/lib/migrations/data_store/002_track_oauth_sessions.sql
pegasus/lib/migrations/002_track_oauth_sessions.sql
pegasus/lib/migrations/data_store/002_track_oauth_sessions.sql
pegasus/lib/migrations/003_two_factor_auth.sql
pegasus/lib/migrations/data_store/003_two_factor_auth.sql
pegasus/lib/migrations/003_two_factor_auth.sql
pegasus/lib/migrations/data_store/003_two_factor_auth.sql
pegasus/lib/migrations/004_reserved_keys.sql
pegasus/lib/migrations/data_store/004_reserved_keys.sql
pegasus/lib/migrations/004_reserved_keys.sql
pegasus/lib/migrations/data_store/004_reserved_keys.sql
+37
-6
pegasus/lib/migrations/migrations.ml
+37
-6
pegasus/lib/migrations/migrations.ml
···
62
62
else None
63
63
with _ -> None
64
64
65
-
let run_migration conn (id, name, sql) =
65
+
let run_migration conn path (id, name, sql) =
66
66
let%lwt () = Lwt_io.printlf "running migration %03d: %s" id name in
67
-
let%lwt result = execute_raw Util.Constants.pegasus_db_filepath sql in
67
+
let%lwt result = execute_raw path sql in
68
68
let%lwt () =
69
69
match result with Ok () -> Lwt.return_unit | Error e -> raise e
70
70
in
···
74
74
in
75
75
Lwt_io.printlf "migration %03d applied successfully" id
76
76
77
-
let run_migrations conn =
77
+
let run_ds_migrations conn =
78
78
let%lwt () = Util.use_pool conn Queries.create_migrations_table in
79
79
let%lwt applied =
80
80
Util.use_pool conn Queries.get_applied_migrations
···
85
85
(fun filename ->
86
86
match parse_migration_filename filename with
87
87
| Some (id, name) when not (List.mem id applied) -> begin
88
-
match Migrations_sql.read filename with
88
+
match Data_store_migrations_sql.read filename with
89
89
| Some sql ->
90
90
Some (id, name, sql)
91
91
| None ->
···
93
93
end
94
94
| _ ->
95
95
None )
96
-
Migrations_sql.file_list
96
+
Data_store_migrations_sql.file_list
97
97
in
98
98
match pending with
99
99
| [] ->
···
102
102
let%lwt () =
103
103
Lwt_io.printlf "found %d pending migrations" (List.length pending)
104
104
in
105
-
Lwt_list.iter_s (run_migration conn) pending
105
+
Lwt_list.iter_s
106
+
(run_migration conn Util.Constants.pegasus_db_filepath)
107
+
pending
108
+
109
+
let run_us_migrations conn did =
110
+
let%lwt () = Util.use_pool conn Queries.create_migrations_table in
111
+
let%lwt applied =
112
+
Util.use_pool conn Queries.get_applied_migrations
113
+
>|= List.map (fun m -> m.id)
114
+
in
115
+
let pending =
116
+
List.filter_map
117
+
(fun filename ->
118
+
match parse_migration_filename filename with
119
+
| Some (id, name) when not (List.mem id applied) -> begin
120
+
match User_store_migrations_sql.read filename with
121
+
| Some sql ->
122
+
Some (id, name, sql)
123
+
| None ->
124
+
None
125
+
end
126
+
| _ ->
127
+
None )
128
+
User_store_migrations_sql.file_list
129
+
in
130
+
match pending with
131
+
| [] ->
132
+
Lwt.return_unit
133
+
| _ ->
134
+
Lwt_list.iter_s
135
+
(run_migration conn (Util.Constants.user_db_filepath did))
136
+
pending
+33
pegasus/lib/migrations/user_store/001_initial_schema.sql
+33
pegasus/lib/migrations/user_store/001_initial_schema.sql
···
1
+
CREATE TABLE IF NOT EXISTS mst (
2
+
cid TEXT NOT NULL PRIMARY KEY,
3
+
data BLOB NOT NULL
4
+
);
5
+
6
+
CREATE TABLE IF NOT EXISTS repo_commit (
7
+
id INTEGER PRIMARY KEY CHECK (id = 0),
8
+
cid TEXT NOT NULL,
9
+
data BLOB NOT NULL
10
+
);
11
+
12
+
CREATE TABLE IF NOT EXISTS records (
13
+
path TEXT NOT NULL PRIMARY KEY,
14
+
cid TEXT NOT NULL,
15
+
since TEXT NOT NULL,
16
+
data BLOB NOT NULL
17
+
);
18
+
19
+
CREATE INDEX IF NOT EXISTS records_cid_idx ON records (cid);
20
+
CREATE INDEX IF NOT EXISTS records_since_idx ON records (since);
21
+
22
+
CREATE TABLE IF NOT EXISTS blobs (
23
+
cid TEXT PRIMARY KEY,
24
+
mimetype TEXT NOT NULL
25
+
);
26
+
27
+
CREATE TABLE IF NOT EXISTS blobs_records (
28
+
record_path TEXT NOT NULL REFERENCES records(path),
29
+
blob_cid TEXT NOT NULL,
30
+
PRIMARY KEY (record_path, blob_cid)
31
+
);
32
+
33
+
CREATE INDEX IF NOT EXISTS blobs_records_blob_cid_idx ON blobs_records (blob_cid);
+1
-75
pegasus/lib/user_store.ml
+1
-75
pegasus/lib/user_store.ml
···
68
68
69
69
module Queries = struct
70
70
(* mst block storage *)
71
-
let create_blocks_tables conn =
72
-
let$! () =
73
-
[%rapper
74
-
execute
75
-
{sql| CREATE TABLE IF NOT EXISTS mst (
76
-
cid TEXT NOT NULL PRIMARY KEY,
77
-
data BLOB NOT NULL
78
-
)
79
-
|sql}]
80
-
() conn
81
-
in
82
-
[%rapper
83
-
execute
84
-
{sql| CREATE TABLE IF NOT EXISTS repo_commit (
85
-
id INTEGER PRIMARY KEY CHECK (id = 0),
86
-
cid TEXT NOT NULL,
87
-
data BLOB NOT NULL
88
-
)
89
-
|sql}]
90
-
() conn
91
-
92
71
let get_block cid =
93
72
[%rapper
94
73
get_opt
···
150
129
~cid ~data
151
130
152
131
(* record storage *)
153
-
let create_records_table conn =
154
-
let$! () =
155
-
[%rapper
156
-
execute
157
-
{sql| CREATE TABLE IF NOT EXISTS records (
158
-
path TEXT NOT NULL PRIMARY KEY,
159
-
cid TEXT NOT NULL,
160
-
since TEXT NOT NULL,
161
-
data BLOB NOT NULL
162
-
)
163
-
|sql}]
164
-
() conn
165
-
in
166
-
[%rapper
167
-
execute
168
-
{sql| CREATE INDEX IF NOT EXISTS records_cid_idx ON records (cid);
169
-
CREATE INDEX IF NOT EXISTS records_since_idx ON records (since);
170
-
|sql}]
171
-
() conn
172
-
173
132
let get_record =
174
133
[%rapper
175
134
get_opt
···
214
173
let delete_record path =
215
174
[%rapper execute {sql| DELETE FROM records WHERE path = %string{path} |sql}]
216
175
~path
217
-
218
-
(* blob storage *)
219
-
let create_blobs_tables conn =
220
-
let$! () =
221
-
[%rapper
222
-
execute
223
-
{sql| CREATE TABLE IF NOT EXISTS blobs (
224
-
cid TEXT PRIMARY KEY,
225
-
mimetype TEXT NOT NULL
226
-
)
227
-
|sql}]
228
-
() conn
229
-
in
230
-
let$! () =
231
-
[%rapper
232
-
execute
233
-
(* no `references` on blob_cid because blobs may be uploaded later *)
234
-
{sql| CREATE TABLE IF NOT EXISTS blobs_records (
235
-
record_path TEXT NOT NULL REFERENCES records(path),
236
-
blob_cid TEXT NOT NULL,
237
-
PRIMARY KEY (record_path, blob_cid)
238
-
)
239
-
|sql}]
240
-
() conn
241
-
in
242
-
[%rapper
243
-
execute
244
-
{sql| CREATE INDEX IF NOT EXISTS blobs_records_blob_cid_idx ON blobs_records (blob_cid) |sql}]
245
-
() conn
246
176
247
177
let get_blob =
248
178
[%rapper
···
362
292
in
363
293
Lwt.return {did; db}
364
294
365
-
let init t : unit Lwt.t =
366
-
let%lwt () = Util.use_pool t.db Queries.create_blocks_tables in
367
-
let%lwt () = Util.use_pool t.db Queries.create_records_table in
368
-
let%lwt () = Util.use_pool t.db Queries.create_blobs_tables in
369
-
Lwt.return_unit
295
+
let init t : unit Lwt.t = Migrations.run_us_migrations t.db t.did
370
296
371
297
(* mst blocks; implements Writable_blockstore *)
372
298