From e331fde7e53992bdf8a6dfbd17b87a062595d21a Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Mon, 16 Sep 2024 13:55:47 +0200 Subject: [PATCH 1/3] L2: move SQLite wrapper in its own library --- manifest/product_octez.ml | 17 +++ manifest/product_octez.mli | 2 + opam/octez-l2-libs.opam | 2 + src/lib_smart_rollup/index.mld | 1 + src/lib_sqlite/dune | 18 +++ src/lib_sqlite/sqlite.ml | 211 +++++++++++++++++++++++++++++++++ src/lib_sqlite/sqlite.mli | 148 +++++++++++++++++++++++ 7 files changed, 399 insertions(+) create mode 100644 src/lib_sqlite/dune create mode 100644 src/lib_sqlite/sqlite.ml create mode 100644 src/lib_sqlite/sqlite.mli diff --git a/manifest/product_octez.ml b/manifest/product_octez.ml index b0cc0d4b8525..bd052f2260b5 100644 --- a/manifest/product_octez.ml +++ b/manifest/product_octez.ml @@ -4415,6 +4415,23 @@ let octez_layer2_store = ~linkall:true ~conflicts:[Conflicts.checkseum] +let octez_sqlite = + octez_l2_lib + "sqlite" + ~internal_name:"octez_sqlite" + ~path:"src/lib_sqlite" + ~synopsis:"SQLite wrappers and helpers" + ~deps: + [ + octez_error_monad |> open_ |> open_ ~m:"TzLwtreslib" + |> open_ ~m:"Error_monad"; + caqti; + caqti_lwt; + caqti_lwt_unix; + ] + ~linkall:true + ~conflicts:[Conflicts.checkseum] + let _octez_layer2_indexed_store_test = tezt ["test_indexed_store"] diff --git a/manifest/product_octez.mli b/manifest/product_octez.mli index f9a481975a4b..269d9390cede 100644 --- a/manifest/product_octez.mli +++ b/manifest/product_octez.mli @@ -39,6 +39,8 @@ val octez_event_logging : Manifest.target val octez_layer2_store : Manifest.target +val octez_sqlite : Manifest.target + val octez_rpc_http_client_unix : Manifest.target val octez_rpc_http : Manifest.target diff --git a/opam/octez-l2-libs.opam b/opam/octez-l2-libs.opam index a8decab38841..e542b349cbf9 100644 --- a/opam/octez-l2-libs.opam +++ b/opam/octez-l2-libs.opam @@ -24,6 +24,8 @@ depends: [ "camlzip" { >= "1.12" & < "1.13" } "tar" "tar-unix" { >= "2.0.1" & < "3.0.0" } + "caqti" + "caqti-lwt" { >= "2.0.1" } "yaml" { >= "3.1.0" } "ppx_import" "qcheck-alcotest" { >= "0.20" } diff --git a/src/lib_smart_rollup/index.mld b/src/lib_smart_rollup/index.mld index ff42a47152c7..9e086f41b74c 100644 --- a/src/lib_smart_rollup/index.mld +++ b/src/lib_smart_rollup/index.mld @@ -6,6 +6,7 @@ It contains the following libraries: - {{!module-Octez_smart_rollup}Octez_smart_rollup}: Library for Smart Rollups - {{!module-Octez_smart_rollup_wasm_benchmark_lib}Octez_smart_rollup_wasm_benchmark_lib}: Smart Rollup WASM benchmark library +- {{!module-Octez_sqlite}Octez_sqlite}: SQLite wrappers and helpers - {{!module-Tezos_layer2_store}Tezos_layer2_store}: layer2 storage utils - {{!module-Tezos_scoru_wasm}Tezos_scoru_wasm} - {{!module-Tezos_scoru_wasm_durable_snapshot}Tezos_scoru_wasm_durable_snapshot}: Durable storage reference implementation diff --git a/src/lib_sqlite/dune b/src/lib_sqlite/dune new file mode 100644 index 000000000000..e0c50d69923a --- /dev/null +++ b/src/lib_sqlite/dune @@ -0,0 +1,18 @@ +; This file was automatically generated, do not edit. +; Edit file manifest/main.ml instead. + +(library + (name octez_sqlite) + (public_name octez-l2-libs.sqlite) + (instrumentation (backend bisect_ppx)) + (libraries + octez-libs.error-monad + caqti + caqti-lwt + caqti-lwt.unix) + (library_flags (:standard -linkall)) + (flags + (:standard) + -open Tezos_error_monad + -open Tezos_error_monad.TzLwtreslib + -open Tezos_error_monad.Error_monad)) diff --git a/src/lib_sqlite/sqlite.ml b/src/lib_sqlite/sqlite.ml new file mode 100644 index 000000000000..5cec0ae5f143 --- /dev/null +++ b/src/lib_sqlite/sqlite.ml @@ -0,0 +1,211 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2024 Nomadic Labs *) +(* Copyright (c) 2024 Functori *) +(* *) +(*****************************************************************************) + +type error += Caqti_error of string | File_already_exists of string + +(* Error registration *) +let () = + register_error_kind + `Permanent + ~id:"caqti_error" + ~title:"Error raised by Caqti" + ~description:"Caqti raised an error while processing a SQL statement" + ~pp:(fun ppf msg -> + Format.fprintf + ppf + "Caqti raised an error while processing a SQL statement: %s" + msg) + Data_encoding.(obj1 (req "caqti_error" string)) + (function Caqti_error err -> Some err | _ -> None) + (fun err -> Caqti_error err) + +let () = + register_error_kind + `Permanent + ~id:"caqti_file_already_exists" + ~title:"File already exists" + ~description:"Raise an error when the file already exists" + ~pp:(fun ppf path -> Format.fprintf ppf "The file %s already exists" path) + Data_encoding.(obj1 (req "file_already_exists" string)) + (function File_already_exists path -> Some path | _ -> None) + (fun path -> File_already_exists path) + +type pool = + ( Caqti_lwt.connection, + [Caqti_error.connect | `K_error of tztrace] ) + Caqti_lwt_unix.Pool.t + +type sqlite_journal_mode = Wal | Other + +module Db = struct + let wrap_caqti_lwt_result (p : ('a, Caqti_error.t) result Lwt.t) : + 'a tzresult Lwt.t = + let open Lwt_result_syntax in + let*! p in + match p with + | Ok p -> return p + | Error err -> fail [Caqti_error (Caqti_error.show err)] + + let wrap_caqti_result (p : ('a, Caqti_error.t) result) : 'a tzresult Lwt.t = + let open Lwt_result_syntax in + match p with + | Ok p -> return p + | Error err -> fail [Caqti_error (Caqti_error.show err)] + + let use_pool (pool : pool) (k : Caqti_lwt.connection -> 'a tzresult Lwt.t) = + let open Lwt_result_syntax in + let*! res = + Caqti_lwt_unix.Pool.use + (fun conn -> + let*! res = k conn in + match res with + | Ok res -> return res + | Error err -> fail (`K_error err)) + pool + in + match res with + | Ok err -> return err + | Error (`K_error err) -> fail err + | Error (#Caqti_error.connect as err) -> + fail [Caqti_error (Caqti_error.show err)] + + let start (module Db : Caqti_lwt.CONNECTION) = + wrap_caqti_lwt_result @@ Db.start () + + let commit (module Db : Caqti_lwt.CONNECTION) = + wrap_caqti_lwt_result @@ Db.commit () + + let rollback (module Db : Caqti_lwt.CONNECTION) = + wrap_caqti_lwt_result @@ Db.rollback () + + let exec (module Db : Caqti_lwt.CONNECTION) req arg = + wrap_caqti_lwt_result @@ Db.exec req arg + + let find (module Db : Caqti_lwt.CONNECTION) req arg = + wrap_caqti_lwt_result @@ Db.find req arg + + let find_opt (module Db : Caqti_lwt.CONNECTION) req arg = + wrap_caqti_lwt_result @@ Db.find_opt req arg + + let collect_list (module Db : Caqti_lwt.CONNECTION) req arg = + wrap_caqti_lwt_result @@ Db.collect_list req arg + + let rev_collect_list (module Db : Caqti_lwt.CONNECTION) req arg = + wrap_caqti_lwt_result @@ Db.rev_collect_list req arg + + let fold (module Db : Caqti_lwt.CONNECTION) req f x acc = + wrap_caqti_lwt_result @@ Db.fold req f x acc + + let fold_s (module Db : Caqti_lwt.CONNECTION) req f x acc = + wrap_caqti_lwt_result @@ Db.fold_s req f x acc + + let iter_s (module Db : Caqti_lwt.CONNECTION) req f x = + wrap_caqti_lwt_result @@ Db.iter_s req f x +end + +type t = Pool : {db_pool : pool} -> t + +type conn = + | Raw_connection of (module Caqti_lwt.CONNECTION) + | Ongoing_transaction of (module Caqti_lwt.CONNECTION) + +let assert_in_transaction conn = + match conn with + | Raw_connection _ -> assert false + | Ongoing_transaction _ -> () + +let with_connection conn k = + match conn with + | Ongoing_transaction conn -> k conn + | Raw_connection conn -> k conn + +let with_transaction conn k = + let open Lwt_result_syntax in + match conn with + | Raw_connection conn -> ( + let* () = Db.start conn in + let*! res = + Lwt.catch + (fun () -> k (Ongoing_transaction conn)) + (fun exn -> fail_with_exn exn) + in + match res with + | Ok x -> + let* () = Db.commit conn in + return x + | Error err -> + let* () = Db.rollback conn in + fail err) + | Ongoing_transaction _ -> + failwith "Internal error: attempting to perform a nested transaction" + +let use (Pool {db_pool}) k = + Db.use_pool db_pool @@ fun conn -> k (Raw_connection conn) + +(* Internal queries *) +module Q = struct + open Caqti_request.Infix + open Caqti_type.Std + + let journal_mode = + custom + ~encode:(function Wal -> Ok "wal" | Other -> Ok "delete") + ~decode:(function "wal" -> Ok Wal | _ -> Ok Other) + string + + let vacuum_request = (string ->. unit) @@ {|VACUUM main INTO ?|} + + module Journal_mode = struct + let get = (unit ->! journal_mode) @@ {|PRAGMA journal_mode|} + + (* It does not appear possible to write a request {|PRAGMA journal_mode=?|} + accepted by caqti, sadly. *) + + let set_wal = (unit ->! journal_mode) @@ {|PRAGMA journal_mode=wal|} + end +end + +let uri path perm = + let write_perm = + match perm with `Read_only -> false | `Read_write -> true + in + Uri.of_string Format.(sprintf "sqlite3:%s?write=%b" path write_perm) + +let set_wal_journal_mode store = + let open Lwt_result_syntax in + with_connection store @@ fun conn -> + let* current_mode = Db.find conn Q.Journal_mode.get () in + when_ (current_mode <> Wal) @@ fun () -> + let* _wal = Db.find conn Q.Journal_mode.set_wal () in + return_unit + +let vacuum ~conn ~output_db_file = + let open Lwt_result_syntax in + let*! exists = Lwt_unix.file_exists output_db_file in + let*? () = error_when exists (File_already_exists output_db_file) in + let* () = + with_connection conn @@ fun conn -> + Db.exec conn Q.vacuum_request output_db_file + in + let* db_pool = + Db.wrap_caqti_result + @@ Caqti_lwt_unix.connect_pool (uri output_db_file `Read_write) + in + let* () = use (Pool {db_pool}) set_wal_journal_mode in + return_unit + +let init ~path ~perm migration_code = + let open Lwt_result_syntax in + let* db_pool = + Db.wrap_caqti_result @@ Caqti_lwt_unix.connect_pool (uri path perm) + in + let store = Pool {db_pool} in + use store @@ fun conn -> + let* () = set_wal_journal_mode conn in + let* () = with_transaction conn migration_code in + return store diff --git a/src/lib_sqlite/sqlite.mli b/src/lib_sqlite/sqlite.mli new file mode 100644 index 000000000000..8d07ec8e7c7d --- /dev/null +++ b/src/lib_sqlite/sqlite.mli @@ -0,0 +1,148 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2024 Nomadic Labs *) +(* Copyright (c) 2024 Functori *) +(* *) +(*****************************************************************************) + +(** A handler to the database. *) +type t + +(** A direct connection to the database, allowing to interact with it. *) +type conn + +(** {2 Initialization and backup} *) + +(** [init ~path ~perm migratrion] returns a handler to the database located at + [path] and executes the given [migration] code. + + If [sqlite_journal_mode] is [`Force mode], then the journal mode of the + SQLite database is updated if necessary to match the requested + configuration. With [`Identity], the journal mode is left untouched. + + If [perm] is [`Read_only], then SQL requests requiring write access will + fail. With [`Read_write], they will succeed as expected. *) +val init : + path:string -> + perm:[`Read_only | `Read_write] -> + (conn -> unit tzresult Lwt.t) -> + t tzresult Lwt.t + +(** Rebuild the database in [output_db_file] using the + {{:https://www.sqlite.org/lang_vacuum.html}[VACUUM] sqlite command}. This + function is useful to backup the database. *) +val vacuum : conn:conn -> output_db_file:string -> unit tzresult Lwt.t + +(** {2 Database connections} *) + +(** [use db k] executes [k] with a fresh connection to [db]. *) +val use : t -> (conn -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t + +(** [with_transaction conn k] wraps the accesses to the database from [conn] made + in the continuation [k] within + {{:https://www.sqlite.org/lang_transaction.html}a SQL transaction}. If [k] + fails, the transaction is rollbacked. Otherwise, the transaction is + committed. *) +val with_transaction : conn -> (conn -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t + +(** [assert_in_transaction conn] raises an exception if a transaction has not + been started with [conn]. + + @raise Assert_failure *) +val assert_in_transaction : conn -> unit + +(** [with_connection conn k] allows to wraps atomic low level accesses to the + database from [conn]. [with_connection] can be used in the continuation of + {!with_transaction}. *) +val with_connection : conn -> ((module Caqti_lwt.CONNECTION) -> 'a) -> 'a + +(** {2 Database low level queries} *) + +(** Caqti convenience functions wrapped in the Tezos error monad. See + {!Caqti_connection_sig.Convenience}. *) +module Db : sig + (** [exec req x] performs [req] with parameters [x] and checks that no rows + are returned. *) + val exec : + (module Caqti_lwt.CONNECTION) -> + ('a, unit, [< `Zero]) Caqti_request.t -> + 'a -> + unit tzresult Lwt.t + + (** [find req x] performs [req] with parameters [x], checks that a single row + is retured, and returns it. *) + val find : + (module Caqti_lwt.CONNECTION) -> + ('a, 'b, [< `One]) Caqti_request.t -> + 'a -> + 'b tzresult Lwt.t + + (** [find_opt req x] performs [req] with parameters [x] and returns either + [None] if no rows are returned or [Some y] if a single now [y] is returned + and fails otherwise. *) + val find_opt : + (module Caqti_lwt.CONNECTION) -> + ('a, 'b, [< `One | `Zero]) Caqti_request.t -> + 'a -> + 'b option tzresult Lwt.t + + (** [collect_list request x] performs a [req] with parameters [x] and returns + a list of rows in order of retrieval. The accumulation is tail recursive + but slightly less efficient than {!rev_collect_list}. *) + val collect_list : + (module Caqti_lwt.CONNECTION) -> + ('a, 'b, [< `Many | `One | `Zero]) Caqti_request.t -> + 'a -> + 'b list tzresult Lwt.t + + (** [rev_collect_list request x] performs [request] with parameters [x] and + returns a list of rows in the reverse order of retrieval. The + accumulation is tail recursive and slighly more efficient than + {!collect_list}. *) + val rev_collect_list : + (module Caqti_lwt.CONNECTION) -> + ('a, 'b, [< `Many | `One | `Zero]) Caqti_request.t -> + 'a -> + 'b list tzresult Lwt.t + + (** [fold req f x acc] performs [req] with parameters [x] and passes [acc] + through the composition of [f y] across the result rows [y] in the order + of retrieval. *) + val fold : + (module Caqti_lwt.CONNECTION) -> + ('a, 'b, [< `Many | `One | `Zero]) Caqti_request.t -> + ('b -> 'c -> 'c) -> + 'a -> + 'c -> + 'c tzresult Lwt.t + + (** [fold_s req f x acc] performs [req] with parameters [x] and passes [acc] + through the monadic composition of [f y] across the returned rows [y] in + the order of retrieval. + + Please be aware of possible deadlocks when using resources from the + callback. In particular, if the same connection pool is invoked as the + one used to obtain the current connection, it will deadlock if the pool + has just run out of connections. An alternative is to collect the rows + first e.g. with {!fold} and do the nested queries after exiting.*) + val fold_s : + (module Caqti_lwt.CONNECTION) -> + ('a, 'b, [< `Many | `One | `Zero]) Caqti_request.t -> + ('b -> 'c -> ('c, Caqti_error.t) result Lwt.t) -> + 'a -> + 'c -> + 'c tzresult Lwt.t + + (** [iter_s req f x] performs [req] with parameters [x] and sequences calls to + [f y] for each result row [y] in the order of retrieval. + + Please see the warning in {!fold_s} about resource usage in the + callback. *) + val iter_s : + (module Caqti_lwt.CONNECTION) -> + ('a, 'b, [< `Many | `One | `Zero]) Caqti_request.t -> + ('b -> (unit, Caqti_error.t) result Lwt.t) -> + 'a -> + unit tzresult Lwt.t +end -- GitLab From ba23f3e30ebe17d50d70e7a371e6c6c63c001d82 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Mon, 16 Sep 2024 14:13:12 +0200 Subject: [PATCH 2/3] Evm node: use refactored sqlite wrapper --- etherlink/bin_node/dune | 2 + etherlink/bin_node/lib_dev/dune | 6 +- etherlink/bin_node/lib_dev/evm_store.ml | 184 +---------------------- etherlink/bin_node/lib_dev/evm_store.mli | 26 +--- manifest/product_etherlink.ml | 6 +- manifest/product_octez.ml | 1 + opam/octez-evm-node-libs.opam | 2 - opam/octez-evm-node.opam | 1 + opam/octez-l2-libs.opam | 1 + src/lib_sqlite/dune | 3 +- 10 files changed, 17 insertions(+), 215 deletions(-) diff --git a/etherlink/bin_node/dune b/etherlink/bin_node/dune index 47f9a2e4a7fc..beacb55d4c00 100644 --- a/etherlink/bin_node/dune +++ b/etherlink/bin_node/dune @@ -16,6 +16,7 @@ octez-version.value octez-shell-libs.client-base octez-shell-libs.client-base-unix + octez-l2-libs.sqlite octez-evm-node-libs.evm_node_lib_dev octez-evm-node-libs.evm_node_config) (link_flags @@ -29,4 +30,5 @@ -open Tezos_rpc_http -open Tezos_client_base -open Tezos_client_base_unix + -open Octez_sqlite -open Evm_node_config)) diff --git a/etherlink/bin_node/lib_dev/dune b/etherlink/bin_node/lib_dev/dune index 0391dfbb429c..57334feefa7a 100644 --- a/etherlink/bin_node/lib_dev/dune +++ b/etherlink/bin_node/lib_dev/dune @@ -16,10 +16,7 @@ octez-evm-node-libs.evm_node_lib_dev_encoding lwt-watcher lwt-exit - caqti - caqti-lwt - caqti-lwt.unix - caqti-driver-sqlite3 + octez-l2-libs.sqlite octez-shell-libs.client-base octez-evm-node-libs.evm_node_config octez-libs.context.sigs @@ -40,6 +37,7 @@ -open Tezos_workers -open Tezos_stdlib_unix -open Evm_node_lib_dev_encoding + -open Octez_sqlite -open Tezos_client_base -open Evm_node_config -open Tezos_scoru_wasm_helpers diff --git a/etherlink/bin_node/lib_dev/evm_store.ml b/etherlink/bin_node/lib_dev/evm_store.ml index fd7ba08a6c05..417d61f1d37b 100644 --- a/etherlink/bin_node/lib_dev/evm_store.ml +++ b/etherlink/bin_node/lib_dev/evm_store.ml @@ -7,15 +7,7 @@ (*****************************************************************************) open Filename.Infix - -type error += Caqti_error of string - -type pool = - ( Caqti_lwt.connection, - [Caqti_error.connect | `K_error of tztrace] ) - Caqti_lwt_unix.Pool.t - -type sqlite_journal_mode = Wal | Other +include Sqlite type levels = { l1_level : int32; @@ -23,65 +15,6 @@ type levels = { finalized : Ethereum_types.quantity; } -module Db = struct - let caqti (p : ('a, Caqti_error.t) result Lwt.t) : 'a tzresult Lwt.t = - let open Lwt_result_syntax in - let*! p in - match p with - | Ok p -> return p - | Error err -> fail [Caqti_error (Caqti_error.show err)] - - let caqti' (p : ('a, Caqti_error.t) result) : 'a tzresult Lwt.t = - let open Lwt_result_syntax in - match p with - | Ok p -> return p - | Error err -> fail [Caqti_error (Caqti_error.show err)] - - let use_pool (pool : pool) (k : Caqti_lwt.connection -> 'a tzresult Lwt.t) = - let open Lwt_result_syntax in - let*! res = - Caqti_lwt_unix.Pool.use - (fun conn -> - let*! res = k conn in - match res with - | Ok res -> return res - | Error err -> fail (`K_error err)) - pool - in - match res with - | Ok err -> return err - | Error (`K_error err) -> fail err - | Error (#Caqti_error.connect as err) -> - fail [Caqti_error (Caqti_error.show err)] - - let start (module Db : Caqti_lwt.CONNECTION) = caqti @@ Db.start () - - let collect_list (module Db : Caqti_lwt.CONNECTION) req arg = - caqti @@ Db.collect_list req arg - - let commit (module Db : Caqti_lwt.CONNECTION) = caqti @@ Db.commit () - - let rollback (module Db : Caqti_lwt.CONNECTION) = caqti @@ Db.rollback () - - let exec (module Db : Caqti_lwt.CONNECTION) req arg = caqti @@ Db.exec req arg - - let find (module Db : Caqti_lwt.CONNECTION) req arg = caqti @@ Db.find req arg - - let find_opt (module Db : Caqti_lwt.CONNECTION) req arg = - caqti @@ Db.find_opt req arg -end - -type t = Pool : {db_pool : pool} -> t - -type conn = - | Raw_connection of (module Caqti_lwt.CONNECTION) - | Ongoing_transaction of (module Caqti_lwt.CONNECTION) - -let assert_in_transaction conn = - match conn with - | Raw_connection _ -> assert false - | Ongoing_transaction _ -> () - module Q = struct open Caqti_request.Infix open Caqti_type.Std @@ -224,12 +157,6 @@ module Q = struct Ok {current_number; l1_level; finalized}) (t3 level l1_level level) - let journal_mode = - custom - ~encode:(function Wal -> Ok "wal" | Other -> Ok "delete") - ~decode:(function "wal" -> Ok Wal | _ -> Ok Other) - string - let table_exists = (string ->! bool) @@ {| @@ -239,8 +166,6 @@ module Q = struct AND name=? )|} - let vacuum_request = (string ->. unit) @@ {|VACUUM main INTO ?|} - module Schemas = struct let get_all = (unit ->* string) @@ -288,15 +213,6 @@ module Q = struct Evm_node_migrations.migrations version end - module Journal_mode = struct - let get = (unit ->! journal_mode) @@ {|PRAGMA journal_mode|} - - (* It does not appear possible to write a request {|PRAGMA journal_mode=?|} - accepted by caqti, sadly. *) - - let set_wal = (unit ->! journal_mode) @@ {|PRAGMA journal_mode=wal|} - end - module Blueprints = struct let insert = (t3 level timestamp payload ->. unit) @@ -520,42 +436,6 @@ module Q = struct end end -let with_connection conn k = - match conn with - | Ongoing_transaction conn -> k conn - | Raw_connection conn -> k conn - -let with_transaction conn k = - let open Lwt_result_syntax in - match conn with - | Raw_connection conn -> ( - let* () = Db.start conn in - let*! res = - Lwt.catch - (fun () -> k (Ongoing_transaction conn)) - (fun exn -> fail_with_exn exn) - in - - match res with - | Ok x -> - let* () = Db.commit conn in - return x - | Error err -> - let* () = Db.rollback conn in - fail err) - | Ongoing_transaction _ -> - failwith "Internal error: attempting to perform a nested transaction" - -module Journal_mode = struct - let set_wal_journal_mode store = - let open Lwt_result_syntax in - with_connection store @@ fun conn -> - let* current_mode = Db.find conn Q.Journal_mode.get () in - when_ (current_mode <> Wal) @@ fun () -> - let* _wal = Db.find conn Q.Journal_mode.set_wal () in - return_unit -end - module Schemas = struct let get_all store = with_connection store @@ fun conn -> @@ -599,43 +479,14 @@ module Migrations = struct Db.exec conn Q.Migrations.register_migration (id, M.name) end -let use (Pool {db_pool}) k = - Db.use_pool db_pool @@ fun conn -> k (Raw_connection conn) - -type error += File_already_exists of string - -let uri path perm = - let write_perm = - match perm with `Read_only -> false | `Read_write -> true - in - Uri.of_string Format.(sprintf "sqlite3:%s?write=%b" path write_perm) - -let vacuum ~conn ~output_db_file = - let open Lwt_result_syntax in - let*! exists = Lwt_unix.file_exists output_db_file in - let*? () = error_when exists (File_already_exists output_db_file) in - let* () = - with_connection conn @@ fun conn -> - Db.exec conn Q.vacuum_request output_db_file - in - let* db_pool = - Db.caqti' @@ Caqti_lwt_unix.connect_pool (uri output_db_file `Read_write) - in - let* () = use (Pool {db_pool}) Journal_mode.set_wal_journal_mode in - return_unit - let sqlite_file_name = "store.sqlite" let init ~data_dir ~perm () = let open Lwt_result_syntax in let path = data_dir // sqlite_file_name in let*! exists = Lwt_unix.file_exists path in - let* db_pool = Db.caqti' @@ Caqti_lwt_unix.connect_pool (uri path perm) in - let store = Pool {db_pool} in - use store @@ fun conn -> - let* () = Journal_mode.set_wal_journal_mode conn in - let* () = - with_transaction conn @@ fun conn -> + let migration conn = + Sqlite.assert_in_transaction conn ; let* () = if not exists then let* () = Migrations.create_table conn in @@ -660,7 +511,7 @@ let init ~data_dir ~perm () = in return_unit in - return store + Sqlite.init ~path ~perm migration module Context_hashes = struct let store store number hash = @@ -967,30 +818,3 @@ let reset store ~l2_level = let* () = Blocks.clear_after store l2_level in let* () = Transactions.clear_after store l2_level in return_unit - -(* Error registration *) -let () = - register_error_kind - `Permanent - ~id:"evm_node_dev_caqti_error" - ~title:"Error raised by Caqti" - ~description:"Caqti raised an error while processing a SQL statement" - ~pp:(fun ppf msg -> - Format.fprintf - ppf - "Caqti raised an error while processing a SQL statement: %s" - msg) - Data_encoding.(obj1 (req "caqti_error" string)) - (function Caqti_error err -> Some err | _ -> None) - (fun err -> Caqti_error err) - -let () = - register_error_kind - `Permanent - ~id:"evm_store_dev_file_already_exists" - ~title:"File already exists" - ~description:"Raise an error when the file already exists" - ~pp:(fun ppf path -> Format.fprintf ppf "The file %s already exists" path) - Data_encoding.(obj1 (req "file_already_exists" string)) - (function File_already_exists path -> Some path | _ -> None) - (fun path -> File_already_exists path) diff --git a/etherlink/bin_node/lib_dev/evm_store.mli b/etherlink/bin_node/lib_dev/evm_store.mli index db0eb3c1cb6c..be17562f6f67 100644 --- a/etherlink/bin_node/lib_dev/evm_store.mli +++ b/etherlink/bin_node/lib_dev/evm_store.mli @@ -6,11 +6,8 @@ (* *) (*****************************************************************************) -(** A handler to the node’s store. *) -type t - -(** A direct connection to the node’s store, allowing to interact with it. *) -type conn +(** The EVM node’s store is built around and SQLite database. *) +include module type of Sqlite (** [init ~data_dir ()] returns a handler to the EVM node store located under [data_dir]. If no store is located in [data_dir], an empty store is @@ -26,28 +23,9 @@ type conn val init : data_dir:string -> perm:[`Read_only | `Read_write] -> unit -> t tzresult Lwt.t -(** [use store k] executes [k] with a fresh connection to [store]. *) -val use : t -> (conn -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t - (** name of the sqlite file *) val sqlite_file_name : string -(** Run VACUUM sqlite request *) -val vacuum : conn:conn -> output_db_file:string -> unit tzresult Lwt.t - -(** [with_transaction conn k] wraps the accesses to the store from [conn] made - in the continuation [k] within - {{:https://www.sqlite.org/lang_transaction.html}a SQL transaction}. If [k] - fails, the transaction is rollbacked. Otherwise, the transaction is - committed. *) -val with_transaction : conn -> (conn -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t - -(** [assert_in_transaction conn] raises an exception if a transaction has not - been started with [conn]. - - @raise Assert_failure *) -val assert_in_transaction : conn -> unit - module Schemas : sig (** [get_all conn] returns the list of SQL statements allowing to recreate the tables in the current store. *) diff --git a/manifest/product_etherlink.ml b/manifest/product_etherlink.ml index e1c9813228e7..f19d38dd6dc1 100644 --- a/manifest/product_etherlink.ml +++ b/manifest/product_etherlink.ml @@ -178,10 +178,7 @@ let evm_node_lib_dev = evm_node_lib_dev_encoding |> open_; lwt_watcher; lwt_exit; - caqti; - caqti_lwt; - caqti_lwt_unix; - caqti_sqlite; + octez_sqlite |> open_; octez_client_base |> open_; evm_node_config |> open_; octez_context_sigs; @@ -261,6 +258,7 @@ let _evm_node = octez_version_value; octez_client_base |> open_; octez_client_base_unix |> open_; + octez_sqlite |> open_; evm_node_lib_dev; evm_node_config |> open_; ] diff --git a/manifest/product_octez.ml b/manifest/product_octez.ml index bd052f2260b5..e09c605a01b8 100644 --- a/manifest/product_octez.ml +++ b/manifest/product_octez.ml @@ -4428,6 +4428,7 @@ let octez_sqlite = caqti; caqti_lwt; caqti_lwt_unix; + caqti_sqlite; ] ~linkall:true ~conflicts:[Conflicts.checkseum] diff --git a/opam/octez-evm-node-libs.opam b/opam/octez-evm-node-libs.opam index 2bba7bb25949..1a4370987467 100644 --- a/opam/octez-evm-node-libs.opam +++ b/opam/octez-evm-node-libs.opam @@ -20,8 +20,6 @@ depends: [ "octez-version" "lwt-watcher" { = "0.2" } "lwt-exit" - "caqti" - "caqti-driver-sqlite3" { >= "2.0.1" } "octez-smart-rollup-wasm-debugger-lib" "tezos-dal-node-services" ] diff --git a/opam/octez-evm-node.opam b/opam/octez-evm-node.opam index 7fb8ad0b5f74..f37571ae8215 100644 --- a/opam/octez-evm-node.opam +++ b/opam/octez-evm-node.opam @@ -13,6 +13,7 @@ depends: [ "octez-libs" "octez-version" "octez-shell-libs" + "octez-l2-libs" "octez-evm-node-libs" { = version } ] build: [ diff --git a/opam/octez-l2-libs.opam b/opam/octez-l2-libs.opam index e542b349cbf9..708481e19358 100644 --- a/opam/octez-l2-libs.opam +++ b/opam/octez-l2-libs.opam @@ -26,6 +26,7 @@ depends: [ "tar-unix" { >= "2.0.1" & < "3.0.0" } "caqti" "caqti-lwt" { >= "2.0.1" } + "caqti-driver-sqlite3" { >= "2.0.1" } "yaml" { >= "3.1.0" } "ppx_import" "qcheck-alcotest" { >= "0.20" } diff --git a/src/lib_sqlite/dune b/src/lib_sqlite/dune index e0c50d69923a..37deed1b8826 100644 --- a/src/lib_sqlite/dune +++ b/src/lib_sqlite/dune @@ -9,7 +9,8 @@ octez-libs.error-monad caqti caqti-lwt - caqti-lwt.unix) + caqti-lwt.unix + caqti-driver-sqlite3) (library_flags (:standard -linkall)) (flags (:standard) -- GitLab From 097dc8878fcb5a07732a04c44e78ab6022861ff2 Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Fri, 27 Sep 2024 09:03:53 +0200 Subject: [PATCH 3/3] Evm store: fail when opening in read-only with missing migrations --- etherlink/bin_node/lib_dev/evm_store.ml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/etherlink/bin_node/lib_dev/evm_store.ml b/etherlink/bin_node/lib_dev/evm_store.ml index 417d61f1d37b..367fe270cc62 100644 --- a/etherlink/bin_node/lib_dev/evm_store.ml +++ b/etherlink/bin_node/lib_dev/evm_store.ml @@ -501,6 +501,15 @@ let init ~data_dir ~perm () = return_unit in let* migrations = Migrations.missing_migrations conn in + let*? () = + match (perm, migrations) with + | `Read_only, _ :: _ -> + error_with + "The store has %d missing migrations but was opened in read-only \ + mode." + (List.length migrations) + | _, _ -> Ok () + in let* () = List.iter_es (fun (i, ((module M : Evm_node_migrations.S) as mig)) -> -- GitLab