objective categorical abstract machine language personal data server
Fix db migration application
+24
-27
+2
-2
dune
+2
-2
dune
···
73
73
(action
74
74
(with-stdout-to
75
75
%{null}
76
-
(run ocaml-crunch -e sql -m plain . -o %{target})))))
76
+
(run ocaml-crunch -e sql -m plain ./data_store -o %{target})))))
77
77
78
78
(subdir
79
79
pegasus/lib/migrations/
···
84
84
(action
85
85
(with-stdout-to
86
86
%{null}
87
-
(run ocaml-crunch -e sql -m plain . -o %{target})))))
87
+
(run ocaml-crunch -e sql -m plain ./user_store -o %{target})))))
+1
-2
frontend/src/components/Button.mlx
+1
-2
frontend/src/components/Button.mlx
···
32
32
disabled:text-mist-80"
33
33
34
34
let[@react.component] make ?id ?name ?(kind = `Primary) ?(type_ = "button")
35
-
?formMethod ?onClick ?value ?disabled ?(className = "") ?ref
36
-
~children () =
35
+
?formMethod ?onClick ?value ?disabled ?(className = "") ?ref ~children () =
37
36
<button
38
37
?id
39
38
?name
+19
-21
pegasus/lib/migrations/migrations.ml
+19
-21
pegasus/lib/migrations/migrations.ml
···
32
32
|sql}]
33
33
end
34
34
35
-
let execute_raw db_path sql =
36
-
let db = Sqlite3.db_open db_path in
37
-
try
38
-
let rc = Sqlite3.exec db sql in
39
-
let _ = try Sqlite3.db_close db with _ -> true in
40
-
match rc with
35
+
let execute_raw conn sql =
36
+
let module C = (val conn : Caqti_lwt.CONNECTION) in
37
+
match C.driver_connection with
38
+
| Some (Caqti_driver_sqlite3.Driver_connection db) -> (
39
+
match Sqlite3.exec db sql with
41
40
| Sqlite3.Rc.OK ->
42
41
Lwt.return_ok ()
43
42
| _ ->
44
43
let err_msg = Sqlite3.errmsg db in
45
-
Lwt.return_error (Failure ("sql error: " ^ err_msg))
46
-
with e ->
47
-
let _ = try Sqlite3.db_close db with _ -> true in
48
-
Lwt.return_error e
44
+
Lwt.return_error
45
+
(Caqti_error.request_failed
46
+
~uri:(Uri.of_string "sqlite3://")
47
+
~query:sql (Caqti_error.Msg err_msg) ) )
48
+
| _ ->
49
+
Lwt.return_error
50
+
(Caqti_error.request_failed
51
+
~uri:(Uri.of_string "sqlite3://")
52
+
~query:sql (Caqti_error.Msg "driver_connection not available") )
49
53
50
54
let parse_migration_filename filename =
51
55
try
···
58
62
with _ -> None
59
63
60
64
let run_migration db (id, name, sql) =
61
-
(* I think it's better to do a transaction per migration, no harm in applying the ones that don't error *)
62
65
Util.use_pool db (fun conn ->
63
66
Util.transact conn (fun () ->
64
-
let module C = (val conn : Caqti_lwt.CONNECTION) in
65
-
let query =
66
-
Caqti_request.Infix.( ->. ) Caqti_type.unit Caqti_type.unit sql
67
-
in
68
-
let result = C.exec query () in
69
-
Lwt_result.map
70
-
(fun _ ->
71
-
let applied_at = Util.now_ms () in
72
-
Queries.record_migration ~id ~name ~applied_at conn )
73
-
result ) )
67
+
let open Lwt_result.Infix in
68
+
execute_raw conn sql
69
+
>>= fun () ->
70
+
let applied_at = Util.now_ms () in
71
+
Queries.record_migration ~id ~name ~applied_at conn ) )
74
72
75
73
type migration_type = Data_store | User_store
76
74
+2
-2
pegasus/lib/repository.ml
+2
-2
pegasus/lib/repository.ml
···
450
450
in
451
451
Lwt.return {commit= new_commit; results}
452
452
453
-
let load ?write ?(ensure_active = false) ?ds did : t Lwt.t =
453
+
let load ?write ?create ?(ensure_active = false) ?ds did : t Lwt.t =
454
454
let%lwt data_store_conn =
455
455
match ds with
456
456
| Some ds ->
···
459
459
Data_store.connect ?write ()
460
460
in
461
461
let%lwt user_db =
462
-
try%lwt User_store.connect did
462
+
try%lwt User_store.connect ?create ~write:true did
463
463
with _ ->
464
464
Errors.invalid_request ~name:"RepoNotFound"
465
465
"your princess is in another castle"