From 0b81d396d2fec2169c6f08b88fc4454e4b5bd62a Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Wed, 26 Mar 2025 11:17:45 +0000 Subject: [PATCH 1/7] Agnostic_baker: Refactor parameters module --- scripts/proto_manager.sh | 5 +- src/lib_agnostic_baker/daemon.ml | 8 +-- src/lib_agnostic_baker/parameters.ml | 90 +++++++++++++++------------ src/lib_agnostic_baker/parameters.mli | 16 +++-- 4 files changed, 64 insertions(+), 55 deletions(-) diff --git a/scripts/proto_manager.sh b/scripts/proto_manager.sh index 0d150b3a9a03..02bc2731e519 100755 --- a/scripts/proto_manager.sh +++ b/scripts/proto_manager.sh @@ -779,9 +779,8 @@ function copy_source() { ## update agnostic_baker ## add protocol as active before alpha in parameters.ml if ! grep -q "${long_hash}" src/lib_agnostic_baker/parameters.ml; then - ## look for | "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" -> ("alpha", Active) - ## and add | "${longhash}" ) as full_hash -> (String.sub full_hash 0 8, Active) - sed -i.old -e "/| \"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK\" ->/a \ | \"${long_hash}\" as full_hash -> (String.sub full_hash 0 8, Active)" src/lib_agnostic_baker/parameters.ml + ## look for "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" and add "${longhash};" + sed -i.old -e "/ \"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK\" /a \"${long_hash}\"; " src/lib_agnostic_baker/parameters.ml ocamlformat -i src/lib_agnostic_baker/parameters.ml commit "src: add protocol to agnostic_baker" fi diff --git a/src/lib_agnostic_baker/daemon.ml b/src/lib_agnostic_baker/daemon.ml index 0647353d0e05..d5d92df913cc 100644 --- a/src/lib_agnostic_baker/daemon.ml +++ b/src/lib_agnostic_baker/daemon.ml @@ -16,11 +16,6 @@ end open Agnostic_baker_errors -(* Number of extra levels to keep the old baker alive before shutting it down. - This extra time is used to avoid halting the chain in cases such as - reorganization or high round migration blocks. *) -let extra_levels_for_old_baker = 3 - type process = {thread : int Lwt.t; canceller : int Lwt.u} type baker = {protocol_hash : Protocol_hash.t; process : process} @@ -228,7 +223,8 @@ let monitor_voting_periods ~state head_stream = ~state ~current_protocol_hash ~next_protocol_hash - ~level_to_kill_old_baker:(head_level + extra_levels_for_old_baker) + ~level_to_kill_old_baker: + (head_level + Parameters.extra_levels_for_old_baker) [@profiler.record_s {verbosity = Notice} "hot_swap_baker"]) else return_unit in diff --git a/src/lib_agnostic_baker/parameters.ml b/src/lib_agnostic_baker/parameters.ml index 7e67520deb12..a353bf47b7f3 100644 --- a/src/lib_agnostic_baker/parameters.ml +++ b/src/lib_agnostic_baker/parameters.ml @@ -6,6 +6,8 @@ (* *) (*****************************************************************************) +(* Default parameter values *) + let default_node_endpoint = Format.sprintf "http://localhost:%d" @@ -23,6 +25,10 @@ let log_config ~base_dir = ~log_cfg:Tezos_base_unix.Logs_simple_config.default_cfg () +let extra_levels_for_old_baker = 3 + +(* Protocol status *) + type status = Active | Frozen let pp_status fmt status = @@ -42,9 +48,7 @@ let status_encoding = [ case ~title:"active" - ~description: - "Active protocols are currently used on a network, and thus, they \ - have dedicated delegate binaries." + ~description:"Active protocols are currently used on a network." (Tag 0) (constant "active") (function Active -> Some () | _ -> None) @@ -52,48 +56,54 @@ let status_encoding = case ~title:"frozen" ~description: - "Frozen protocols are currently unused on any network, and thus, \ - they do not have dedicated delegate binaries." + "Frozen protocols are not currently used on any network." (Tag 1) (constant "frozen") (function Frozen -> Some () | _ -> None) (fun () -> Frozen); ]) -(* From Manifest/Product_octez/Protocol*) -let protocol_info = function - | ( "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" - | "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P" - | "PtCJ7pwoxe8JasnHY8YonnLYjcVHmhiARPJvqcC6VfHT5s8k8sY" - | "PsYLVpVvgbLhAhoqAkMFUo6gudkJ9weNXhUYCiLDzcUpFpkk8Wt" - | "PsddFKi32cMJ2qPjf43Qv5GDWLDPZb3T3bF6fLKiF5HtvHNU7aP" - | "Pt24m4xiPbLDhVgVfABUjirbmda3yohdN82Sp9FeuAXJ4eV9otd" - | "PsBABY5HQTSkA4297zNHfsZNKtxULfL18y95qb3m53QJiXGmrbU" - | "PsBabyM1eUXZseaJdmXFApDSBqj8YBfwELoxZHHW77EMcAbbwAS" - | "PsCARTHAGazKbHtnKfLzQg3kms52kSRpgnDY982a9oYsSXRLQEb" - | "PsDELPH1Kxsxt8f9eWbxQeRxkjfbxoqM52jvs5Y5fBxWWh4ifpo" - | "PtEdoTezd3RHSC31mpxxo1npxFjoWWcFgQtxapi51Z8TLu6v6Uq" - | "PtEdo2ZkT9oKpimTah6x2embF25oss54njMuPzkJTEi5RqfdZFA" - | "PsFLorenaUUuikDWvMDr6fGBRG8kt3e3D3fHoXK1j1BFRxeSH4i" - | "PtGRANADsDU8R9daYKAgWnQYAJ64omN1o3KMGVCykShA97vQbvV" - | "PtHangz2aRngywmSRGGvrcTyMbbdpWdpFKuS4uMWxg2RaH9i1qx" - | "Psithaca2MLRFYargivpo7YvUr7wUDqyxrdhC5CQq78mRvimz6A" - | "PtJakart2xVj7pYXJBXrqHgd82rdkLey5ZeeGwDgPp9rhQUbSqY" - | "PtKathmankSpLLDALzWw7CGD2j2MtyveTwboEYokqUCP4a1LxMg" - | "PtLimaPtLMwfNinJi9rCfDPWea8dFgTZ1MeJ9f1m2SRic6ayiwW" - | "PtMumbai2TmsJHNGRkD8v8YDbtao7BLUC3wjASn1inAKLFCjaH1" - | "PtNairobiyssHuh87hEhfVBGCVrK3WnS8Z2FT4ymB5tAa4r1nQf" - | "ProxfordYmVfjWnRcgjWH36fW6PArwqykTFzotUxRs6gmTcZDuH" - | "PtParisBxoLz5gzMmn3d9WBQNoPSZakgnkMC2VNuQ3KXfUtUQeZ" ) as full_hash -> - (String.sub full_hash 0 8, Frozen) - | ( "PsParisCZo7KAh1Z1smVd9ZMZ1HHn5gkzbM94V3PLCpknFWhUAi" - | "PsQuebecnLByd3JwTiGadoG4nGWi3HYiLXUjkibeFV8dCFeVMUg" ) as full_hash -> - (String.sub full_hash 0 8, Active) - | "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" -> ("alpha", Active) - | "PsRiotumaAMotcRoDWW1bysEhQy2n1M5fy8JgRp8jjRfHGmfeA7" as full_hash -> - (String.sub full_hash 0 8, Active) - | _ -> (*We assume that unmatched protocols are next ones*) ("next", Active) +(** Lists of known protocol hashes for [Frozen] and [Active] protocols, corresponding + to [Manifest/Product_octez/Protocol] module. *) +let frozen_protocols = + [ + "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"; + "Ps9mPmXaRzmzk35gbAYNCAw6UXdE2qoABTHbN2oEEc1qM7CwT9P"; + "PtCJ7pwoxe8JasnHY8YonnLYjcVHmhiARPJvqcC6VfHT5s8k8sY"; + "PsYLVpVvgbLhAhoqAkMFUo6gudkJ9weNXhUYCiLDzcUpFpkk8Wt"; + "PsddFKi32cMJ2qPjf43Qv5GDWLDPZb3T3bF6fLKiF5HtvHNU7aP"; + "Pt24m4xiPbLDhVgVfABUjirbmda3yohdN82Sp9FeuAXJ4eV9otd"; + "PsBABY5HQTSkA4297zNHfsZNKtxULfL18y95qb3m53QJiXGmrbU"; + "PsBabyM1eUXZseaJdmXFApDSBqj8YBfwELoxZHHW77EMcAbbwAS"; + "PsCARTHAGazKbHtnKfLzQg3kms52kSRpgnDY982a9oYsSXRLQEb"; + "PsDELPH1Kxsxt8f9eWbxQeRxkjfbxoqM52jvs5Y5fBxWWh4ifpo"; + "PtEdoTezd3RHSC31mpxxo1npxFjoWWcFgQtxapi51Z8TLu6v6Uq"; + "PtEdo2ZkT9oKpimTah6x2embF25oss54njMuPzkJTEi5RqfdZFA"; + "PsFLorenaUUuikDWvMDr6fGBRG8kt3e3D3fHoXK1j1BFRxeSH4i"; + "PtGRANADsDU8R9daYKAgWnQYAJ64omN1o3KMGVCykShA97vQbvV"; + "PtHangz2aRngywmSRGGvrcTyMbbdpWdpFKuS4uMWxg2RaH9i1qx"; + "Psithaca2MLRFYargivpo7YvUr7wUDqyxrdhC5CQq78mRvimz6A"; + "PtJakart2xVj7pYXJBXrqHgd82rdkLey5ZeeGwDgPp9rhQUbSqY"; + "PtKathmankSpLLDALzWw7CGD2j2MtyveTwboEYokqUCP4a1LxMg"; + "PtLimaPtLMwfNinJi9rCfDPWea8dFgTZ1MeJ9f1m2SRic6ayiwW"; + "PtMumbai2TmsJHNGRkD8v8YDbtao7BLUC3wjASn1inAKLFCjaH1"; + "PtNairobiyssHuh87hEhfVBGCVrK3WnS8Z2FT4ymB5tAa4r1nQf"; + "ProxfordYmVfjWnRcgjWH36fW6PArwqykTFzotUxRs6gmTcZDuH"; + "PtParisBxoLz5gzMmn3d9WBQNoPSZakgnkMC2VNuQ3KXfUtUQeZ"; + "PsParisCZo7KAh1Z1smVd9ZMZ1HHn5gkzbM94V3PLCpknFWhUAi"; + ] -let protocol_short_hash h = fst (protocol_info (Protocol_hash.to_b58check h)) +(** If this list format is modified, subsequent modifications must be carried onto + the agnostic baker section from [scripts/proto_manager.sh]. *) +let active_protocols = + [ + "PsQuebecnLByd3JwTiGadoG4nGWi3HYiLXUjkibeFV8dCFeVMUg"; + "PsRiotumaAMotcRoDWW1bysEhQy2n1M5fy8JgRp8jjRfHGmfeA7"; + "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"; + ] -let protocol_status h = snd (protocol_info (Protocol_hash.to_b58check h)) +let protocol_status proto_hash = + match Protocol_hash.to_b58check proto_hash with + | hash when List.mem ~equal:String.equal hash active_protocols -> Active + | hash when List.mem ~equal:String.equal hash frozen_protocols -> Frozen + | _ -> (* We assume that unmatched protocols are "next" ones *) Active diff --git a/src/lib_agnostic_baker/parameters.mli b/src/lib_agnostic_baker/parameters.mli index 79f7c870b154..3675d5ecfe54 100644 --- a/src/lib_agnostic_baker/parameters.mli +++ b/src/lib_agnostic_baker/parameters.mli @@ -15,10 +15,14 @@ val default_daily_logs_path : string option val log_config : base_dir:string -> Tezos_base.Internal_event_config.t -(** Status of a protocol, based on Manifest/Product_octez/Protocol. A - protocol is considered as [Active] while it is running on a network, - and thus, have dedicated binaries. Otherwise, the protocol is - [Frozen] as not running anymore and no associated binaries. +(** Number of extra levels to keep the old baker alive before shutting it down. + This extra time is used to avoid halting the chain in cases such as + reorganization or high round migration blocks. *) +val extra_levels_for_old_baker : int + +(** Status of a protocol, based on [Manifest/Product_octez/Protocol]. A + protocol is considered as [Active] while it is running on a network. + Otherwise, the protocol is [Frozen]. Warning, it is needed to update status for each new protocol added. *) @@ -28,6 +32,6 @@ val pp_status : Format.formatter -> status -> unit val status_encoding : status t -val protocol_short_hash : Protocol_hash.t -> string - +(** [protocol_status proto_hash] returns whether the given [proto_hash] is + [Active] or [Frozen]. *) val protocol_status : Protocol_hash.t -> status -- GitLab From e6bb5ff7b6692dabb4f54b3e2db59cf3b40ff560 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Wed, 26 Mar 2025 11:51:58 +0000 Subject: [PATCH 2/7] Agnostic_baker: Refactor daemon module --- src/lib_agnostic_baker/daemon.ml | 123 +++++++++++++++--------------- src/lib_agnostic_baker/daemon.mli | 12 +-- 2 files changed, 66 insertions(+), 69 deletions(-) diff --git a/src/lib_agnostic_baker/daemon.ml b/src/lib_agnostic_baker/daemon.ml index d5d92df913cc..67aa07adfb5f 100644 --- a/src/lib_agnostic_baker/daemon.ml +++ b/src/lib_agnostic_baker/daemon.ml @@ -6,6 +6,9 @@ (* *) (*****************************************************************************) +open Agnostic_baker_errors +module Events = Agnostic_baker_events + module Profiler = struct include (val Profiler.wrap Agnostic_baker_profiler.agnostic_baker_profiler) @@ -14,14 +17,24 @@ module Profiler = struct Agnostic_baker_profiler.agnostic_baker_profiler end -open Agnostic_baker_errors - type process = {thread : int Lwt.t; canceller : int Lwt.u} type baker = {protocol_hash : Protocol_hash.t; process : process} +type baker_to_kill = {baker : baker; level_to_kill : int} + +type state = { + node_endpoint : string; + mutable current_baker : baker option; + mutable old_baker : baker_to_kill option; +} + +type t = state + +(* ---- Baker Process Management ---- *) + (** [run_thread ~protocol_hash ~baker_commands ~cancel_promise ~logs_path] - returns the main running thread for the baker given its protocol [~procol_hash], + returns the main running thread for the baker given its protocol [~protocol_hash], corresponding commands [~baker_commands] and Lwt cancellation promise [~cancel_promise]. The event logs are stored according to [~logs_path]. *) @@ -30,8 +43,6 @@ let run_thread ~protocol_hash ~baker_commands ~cancel_promise ~logs_path = Client_commands.register protocol_hash @@ fun _network -> baker_commands in - let select_commands _ _ = Lwt_result_syntax.return baker_commands in - (* This call is not strictly necessary as the parameters are initialized lazily the first time a Sapling operation (validation or forging) is done. This is what the client does. @@ -50,7 +61,7 @@ let run_thread ~protocol_hash ~baker_commands ~cancel_promise ~logs_path = [ Client_main_run.lwt_run (module Config) - ~select_commands + ~select_commands:(fun _ _ -> Lwt_result_syntax.return baker_commands) (* The underlying logging from the baker must not be initialised, otherwise we double log. *) ~disable_logging:true (); @@ -60,7 +71,7 @@ let run_thread ~protocol_hash ~baker_commands ~cancel_promise ~logs_path = (** [spawn_baker protocol_hash] spawns a new baker process for the given [protocol_hash]. *) let spawn_baker protocol_hash = let open Lwt_result_syntax in - let*! () = Agnostic_baker_events.(emit starting_baker) protocol_hash in + let*! () = Events.(emit starting_baker) protocol_hash in let cancel_promise, canceller = Lwt.wait () in let* thread = let*? plugin = @@ -76,46 +87,9 @@ let spawn_baker protocol_hash = ~cancel_promise ~logs_path:Parameters.default_daily_logs_path in - let*! () = Agnostic_baker_events.(emit baker_running) protocol_hash in + let*! () = Events.(emit baker_running) protocol_hash in return {protocol_hash; process = {thread; canceller}} -type baker_to_kill = {baker : baker; level_to_kill : int} - -type 'a state = { - node_endpoint : string; - mutable current_baker : baker option; - mutable old_baker : baker_to_kill option; -} - -type 'a t = 'a state - -(** [monitor_heads ~node_addr] creates a stream which returns the data - of the heads of the current network; this information is received - from the RPC calls at the endpoint given by [~node_addr]. *) -let monitor_heads ~node_addr = - let open Lwt_result_syntax in - let uri = Format.sprintf "%s/monitor/heads/main" node_addr in - let* _, body = Rpc_services.request_uri ~node_addr ~uri in - let cohttp_stream = Cohttp_lwt.Body.to_stream body in - let buffer = Buffer.create 2048 in - let stream, push = Lwt_stream.create () in - let on_chunk v = push (Some v) and on_close () = push None in - let rec loop () = - let*! v = Lwt_stream.get cohttp_stream in - match v with - | None -> - on_close () ; - Lwt.return_unit - | Some chunk -> - Buffer.add_string buffer chunk ; - let data = Buffer.contents buffer in - Buffer.reset buffer ; - on_chunk data ; - loop () - in - ignore (loop () : unit Lwt.t) ; - return stream - (** [hot_swap_baker ~state ~current_protocol_hash ~next_protocol_hash ~level_to_kill_old_baker] moves the current baker into the old baker slot (to be killed later) and spawns a new baker for [~next_protocol_hash] *) @@ -129,11 +103,10 @@ let hot_swap_baker ~state ~current_protocol_hash ~next_protocol_hash in let next_proto_status = Parameters.protocol_status next_protocol_hash in let*! () = - Agnostic_baker_events.(emit protocol_encountered) - (next_proto_status, next_protocol_hash) + Events.(emit protocol_encountered) (next_proto_status, next_protocol_hash) in let*! () = - Agnostic_baker_events.(emit become_old_baker) + Events.(emit become_old_baker) (current_protocol_hash, level_to_kill_old_baker) in state.old_baker <- @@ -156,9 +129,7 @@ let maybe_kill_old_baker state node_addr = ~node_addr [@profiler.record_s {verbosity = Notice} "get_level"]) in if head_level >= level_to_kill then ( - let*! () = - Agnostic_baker_events.(emit stopping_baker) baker.protocol_hash - in + let*! () = Events.(emit stopping_baker) baker.protocol_hash in Lwt.wakeup baker.process.canceller 0 [@profiler.record_f {verbosity = Notice} "kill old baker"] ; @@ -166,6 +137,35 @@ let maybe_kill_old_baker state node_addr = return_unit) else return_unit +(* ---- Baker and Chain Monitoring ---- *) + +(** [monitor_heads ~node_addr] creates a stream which returns the data + of the heads of the current network; this information is received + from the RPC calls at the endpoint given by [~node_addr]. *) +let monitor_heads ~node_addr = + let open Lwt_result_syntax in + let uri = Format.sprintf "%s/monitor/heads/main" node_addr in + let* _, body = Rpc_services.request_uri ~node_addr ~uri in + let cohttp_stream = Cohttp_lwt.Body.to_stream body in + let buffer = Buffer.create 2048 in + let stream, push = Lwt_stream.create () in + let on_chunk v = push (Some v) and on_close () = push None in + let rec loop () = + let*! v = Lwt_stream.get cohttp_stream in + match v with + | None -> + on_close () ; + Lwt.return_unit + | Some chunk -> + Buffer.add_string buffer chunk ; + let data = Buffer.contents buffer in + Buffer.reset buffer ; + on_chunk data ; + loop () + in + ignore (loop () : unit Lwt.t) ; + return stream + (** [monitor_voting_periods ~state head_stream] continuously monitors [heads_stream] to detect protocol changes. It will: - Shut down an old baker it its time has come; @@ -192,8 +192,7 @@ let monitor_voting_periods ~state head_stream = [@profiler.record_s {verbosity = Notice} "get_current_period"]) in let*! () = - Agnostic_baker_events.(emit period_status) - (block_hash, period_kind, remaining) + Events.(emit period_status) (block_hash, period_kind, remaining) in let* () = (maybe_kill_old_baker @@ -243,12 +242,14 @@ let baker_thread ~state = in if retcode = 0 then return_unit else tzfail Baker_process_error +(* ---- Agnostic Baker Bootstrap ---- *) + (** [may_start_initial_baker state] recursively waits for an [active] protocol and spawns a baker for it. If the protocol is [frozen] (not [active] anymore), it waits for a head with an [active] protocol. *) let may_start_initial_baker state = let open Lwt_result_syntax in - let*! () = Agnostic_baker_events.(emit experimental_binary) () in + let*! () = Events.(emit experimental_binary) () in let rec may_start ?last_known_proto ~head_stream () = let* protocol_hash = Rpc_services.get_next_protocol_hash ~node_addr:state.node_endpoint @@ -259,8 +260,7 @@ let may_start_initial_baker state = | None -> Lwt.return_unit | Some h -> if not (Protocol_hash.equal h protocol_hash) then - Agnostic_baker_events.(emit protocol_encountered) - (proto_status, protocol_hash) + Events.(emit protocol_encountered) (proto_status, protocol_hash) else Lwt.return_unit in match proto_status with @@ -274,12 +274,9 @@ let may_start_initial_baker state = | Some v -> return v | None -> let*! () = - Agnostic_baker_events.(emit protocol_encountered) - (proto_status, protocol_hash) - in - let*! () = - Agnostic_baker_events.(emit waiting_for_active_protocol) () + Events.(emit protocol_encountered) (proto_status, protocol_hash) in + let*! () = Events.(emit waiting_for_active_protocol) () in monitor_heads ~node_addr:state.node_endpoint in let*! v = Lwt_stream.get head_stream in @@ -299,10 +296,10 @@ let create ~node_endpoint = let run state = let open Lwt_result_syntax in let node_addr = state.node_endpoint in - let*! () = Agnostic_baker_events.(emit starting_daemon) () in + let*! () = Events.(emit starting_daemon) () in let _ccid = Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> - let*! () = Agnostic_baker_events.(emit stopping_daemon) () in + let*! () = Events.(emit stopping_daemon) () in Lwt.return_unit) in let* () = may_start_initial_baker state in diff --git a/src/lib_agnostic_baker/daemon.mli b/src/lib_agnostic_baker/daemon.mli index 618a7547cd7f..bbc1bfabd215 100644 --- a/src/lib_agnostic_baker/daemon.mli +++ b/src/lib_agnostic_baker/daemon.mli @@ -9,7 +9,7 @@ (** Daemon handling the baker's life cycle. It is used to [create] and [run] a protocol-agnostic process which uses the existing - baking binaries in an adaptive way, depending on the current protocol obtained + baking processes in an adaptive way, depending on the current protocol obtained from the chain. It relies on a [state] which contains the [endpoint] to contact the running node, @@ -18,14 +18,14 @@ To do so, it also spawns a "monitoring" process which follows the heads of the chain, as reported by the node from the [state], more precisely which monitors the voting period. By doing that, it decides when to swap to a different baking - binary. + process. *) -type 'a t +type t (** [create ~node_endpoint] returns a non initialized daemon. *) -val create : node_endpoint:string -> 'a t +val create : node_endpoint:string -> t -(** [run t] Runs the daemon responsible for the spawn/stop of the +(** [run daemon] Runs the daemon responsible for the spawn/stop of the baker daemons. *) -val run : 'a t -> unit tzresult Lwt.t +val run : t -> unit tzresult Lwt.t -- GitLab From 1e01f34cc66bca29d980544574e0de42319a5329 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Wed, 26 Mar 2025 12:13:46 +0000 Subject: [PATCH 3/7] Agnostic_baker: Refactor main module --- manifest/product_octez.ml | 1 + opam/octez-experimental-agnostic-baker.opam | 1 + src/bin_agnostic_baker/dune | 2 ++ src/bin_agnostic_baker/main_agnostic_baker.ml | 17 +++++++------- .../agnostic_baker_config.ml | 13 +++++++++++ src/lib_agnostic_baker/daemon.ml | 22 +++++-------------- 6 files changed, 31 insertions(+), 25 deletions(-) create mode 100644 src/lib_agnostic_baker/agnostic_baker_config.ml diff --git a/manifest/product_octez.ml b/manifest/product_octez.ml index 830f199187f2..5f3eb0d04b81 100644 --- a/manifest/product_octez.ml +++ b/manifest/product_octez.ml @@ -8616,6 +8616,7 @@ let _octez_experimental_agnostic_baker = bls12_381_archive; octez_base |> open_ ~m:"TzPervasives" |> open_; octez_base_unix |> open_; + octez_client_base_unix |> open_; octez_experimental_agnostic_baker_lib |> open_; octez_profiler |> open_; ] diff --git a/opam/octez-experimental-agnostic-baker.opam b/opam/octez-experimental-agnostic-baker.opam index eab07475ebd5..8924250713f5 100644 --- a/opam/octez-experimental-agnostic-baker.opam +++ b/opam/octez-experimental-agnostic-baker.opam @@ -13,6 +13,7 @@ depends: [ "octez-libs" { = version } "octez-rust-deps" { = version } "bls12-381" { = version } + "octez-shell-libs" { = version } "octez-experimental-agnostic-baker-lib" { = version } "octez-protocol-021-PsQuebec-libs" { = version } "octez-protocol-022-PsRiotum-libs" { = version } diff --git a/src/bin_agnostic_baker/dune b/src/bin_agnostic_baker/dune index d184c7a2c707..73b805b34530 100644 --- a/src/bin_agnostic_baker/dune +++ b/src/bin_agnostic_baker/dune @@ -11,6 +11,7 @@ bls12-381.archive octez-libs.base octez-libs.base.unix + octez-shell-libs.client-base-unix octez-experimental-agnostic-baker-lib octez-libs.octez-profiler octez-protocol-021-PsQuebec-libs.agnostic-baker @@ -30,6 +31,7 @@ -open Tezos_base.TzPervasives -open Tezos_base -open Tezos_base_unix + -open Tezos_client_base_unix -open Octez_experimental_agnostic_baker -open Tezos_profiler)) diff --git a/src/bin_agnostic_baker/main_agnostic_baker.ml b/src/bin_agnostic_baker/main_agnostic_baker.ml index 88c054c752d6..29e8d1e38c17 100644 --- a/src/bin_agnostic_baker/main_agnostic_baker.ml +++ b/src/bin_agnostic_baker/main_agnostic_baker.ml @@ -26,7 +26,7 @@ let lwt_run ~args () = let open Lwt_result_syntax in let base_dir = Option.value - ~default:Tezos_client_base_unix.Client_config.Cfg_file.default.base_dir + ~default:Client_config.Cfg_file.default.base_dir (Run_args.get_base_dir args) in let*! () = @@ -41,7 +41,7 @@ let lwt_run ~args () = return_unit let run ~args () = - let open Lwt_result_syntax in + let open Lwt_syntax in let main_promise = Lwt.catch (lwt_run ~args) (function | Failure msg -> failwith "%s" msg @@ -49,8 +49,8 @@ let run ~args () = in Stdlib.exit (Tezos_base_unix.Event_loop.main_run (fun () -> - let*! retcode = - let*! r = Lwt_exit.wrap_and_exit main_promise in + let* retcode = + let* r = Lwt_exit.wrap_and_exit main_promise in match r with | Ok () -> Lwt.return 0 | Error errs -> @@ -59,15 +59,16 @@ let run ~args () = in Format.pp_print_flush Format.err_formatter () ; Format.pp_print_flush Format.std_formatter () ; - let*! () = Tezos_base_unix.Internal_event_unix.close () in - Lwt.return retcode)) + let* () = Tezos_base_unix.Internal_event_unix.close () in + return retcode)) let () = - let open Tezos_client_base_unix in let args = Array.to_list Sys.argv in if Run_args.(is_help_cmd args || is_version_cmd args || is_man_cmd args) then + (* No need to run the baker commands, we just need to get their description, + therefore we do not obtain the protocol plugin. *) Client_main_run.run - (module Daemon_config) + (module Agnostic_baker_config) ~select_commands:(fun _ _ -> Lwt_result_syntax.return @@ Commands.baker_commands ()) else run ~args () diff --git a/src/lib_agnostic_baker/agnostic_baker_config.ml b/src/lib_agnostic_baker/agnostic_baker_config.ml new file mode 100644 index 000000000000..8a7524c646ca --- /dev/null +++ b/src/lib_agnostic_baker/agnostic_baker_config.ml @@ -0,0 +1,13 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* Copyright (c) 2025 Trilitech *) +(* *) +(*****************************************************************************) + +(* Agnostic Baker Daemon configuration *) + +include Tezos_client_base_unix.Daemon_config + +(* All logging must be centralised in a single place. *) +let default_daily_logs_path = Parameters.default_daily_logs_path diff --git a/src/lib_agnostic_baker/daemon.ml b/src/lib_agnostic_baker/daemon.ml index 67aa07adfb5f..0e0a6232660e 100644 --- a/src/lib_agnostic_baker/daemon.ml +++ b/src/lib_agnostic_baker/daemon.ml @@ -33,12 +33,10 @@ type t = state (* ---- Baker Process Management ---- *) -(** [run_thread ~protocol_hash ~baker_commands ~cancel_promise ~logs_path] +(** [run_thread ~protocol_hash ~baker_commands ~cancel_promise] returns the main running thread for the baker given its protocol [~protocol_hash], - corresponding commands [~baker_commands] and Lwt cancellation promise [~cancel_promise]. - - The event logs are stored according to [~logs_path]. *) -let run_thread ~protocol_hash ~baker_commands ~cancel_promise ~logs_path = + corresponding commands [~baker_commands] and cancellation [~cancel_promise]. *) +let run_thread ~protocol_hash ~baker_commands ~cancel_promise = let () = Client_commands.register protocol_hash @@ fun _network -> baker_commands in @@ -52,15 +50,10 @@ let run_thread ~protocol_hash ~baker_commands ~cancel_promise ~logs_path = validation will not be more expensive. *) let () = Tezos_sapling.Core.Validator.init_params () in - let module Config = struct - include Daemon_config - - let default_daily_logs_path = logs_path - end in Lwt.pick [ Client_main_run.lwt_run - (module Config) + (module Agnostic_baker_config) ~select_commands:(fun _ _ -> Lwt_result_syntax.return baker_commands) (* The underlying logging from the baker must not be initialised, otherwise we double log. *) ~disable_logging:true @@ -80,12 +73,7 @@ let spawn_baker protocol_hash = [@profiler.record_f {verbosity = Notice} "proto_plugin_for_protocol"]) in let baker_commands = Commands.baker_commands ~plugin () in - return - @@ run_thread - ~protocol_hash - ~baker_commands - ~cancel_promise - ~logs_path:Parameters.default_daily_logs_path + return @@ run_thread ~protocol_hash ~baker_commands ~cancel_promise in let*! () = Events.(emit baker_running) protocol_hash in return {protocol_hash; process = {thread; canceller}} -- GitLab From 0b8716bdc10461b3becc4bd15ef6fd9f1c122a39 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Tue, 1 Apr 2025 10:34:17 +0100 Subject: [PATCH 4/7] Agnostic_baker: Refactor Client_main_run logging and remove duplicated code --- src/bin_agnostic_baker/main_agnostic_baker.ml | 6 +- src/lib_agnostic_baker/parameters.ml | 10 --- src/lib_agnostic_baker/parameters.mli | 2 - src/lib_client_base_unix/client_main_run.ml | 65 ++++++++++--------- src/lib_client_base_unix/client_main_run.mli | 12 ++++ 5 files changed, 49 insertions(+), 46 deletions(-) diff --git a/src/bin_agnostic_baker/main_agnostic_baker.ml b/src/bin_agnostic_baker/main_agnostic_baker.ml index 29e8d1e38c17..8012ba1a2252 100644 --- a/src/bin_agnostic_baker/main_agnostic_baker.ml +++ b/src/bin_agnostic_baker/main_agnostic_baker.ml @@ -26,13 +26,11 @@ let lwt_run ~args () = let open Lwt_result_syntax in let base_dir = Option.value - ~default:Client_config.Cfg_file.default.base_dir + ~default:Agnostic_baker_config.default_base_dir (Run_args.get_base_dir args) in let*! () = - Tezos_base_unix.Internal_event_unix.init - ~config:(Parameters.log_config ~base_dir) - () + Client_main_run.init_logging (module Agnostic_baker_config) ~base_dir () in () [@profiler.overwrite may_start_profiler base_dir] ; let daemon = Daemon.create ~node_endpoint:(Run_args.get_endpoint args) in diff --git a/src/lib_agnostic_baker/parameters.ml b/src/lib_agnostic_baker/parameters.ml index a353bf47b7f3..3dafdfffd569 100644 --- a/src/lib_agnostic_baker/parameters.ml +++ b/src/lib_agnostic_baker/parameters.ml @@ -15,16 +15,6 @@ let default_node_endpoint = let default_daily_logs_path = Some "octez-experimental-agnostic-baker" -let log_config ~base_dir = - let daily_logs_path = - default_daily_logs_path - |> Option.map Filename.Infix.(fun logdir -> base_dir // "logs" // logdir) - in - Tezos_base_unix.Internal_event_unix.make_with_defaults - ?enable_default_daily_logs_at:daily_logs_path - ~log_cfg:Tezos_base_unix.Logs_simple_config.default_cfg - () - let extra_levels_for_old_baker = 3 (* Protocol status *) diff --git a/src/lib_agnostic_baker/parameters.mli b/src/lib_agnostic_baker/parameters.mli index 3675d5ecfe54..6c14efc8c06a 100644 --- a/src/lib_agnostic_baker/parameters.mli +++ b/src/lib_agnostic_baker/parameters.mli @@ -13,8 +13,6 @@ val default_node_endpoint : string (** Default logs path for the agnostic baker. *) val default_daily_logs_path : string option -val log_config : base_dir:string -> Tezos_base.Internal_event_config.t - (** Number of extra levels to keep the old baker alive before shutting it down. This extra time is used to avoid halting the chain in cases such as reorganization or high round migration blocks. *) diff --git a/src/lib_client_base_unix/client_main_run.ml b/src/lib_client_base_unix/client_main_run.ml index d0b5af5c0191..57c1115e5888 100644 --- a/src/lib_client_base_unix/client_main_run.ml +++ b/src/lib_client_base_unix/client_main_run.ml @@ -419,6 +419,35 @@ let warn_if_argv0_name_not_octez () = expected_name executable_name +let init_logging (module C : M) ?(parsed_args : Client_config.cli_args option) + ?parsed_config_file ~base_dir () = + let open Tezos_base_unix.Internal_event_unix in + let daily_logs_path = + C.default_daily_logs_path + |> Option.map Filename.Infix.(fun logdir -> base_dir // "logs" // logdir) + in + (* Update config with color logging switch and advertise levels *) + let log_cfg = + let colors = + match parsed_args with + | None -> None + | Some parsed_args -> parsed_args.log_coloring + in + Tezos_base_unix.Logs_simple_config.create_cfg + ?advertise_levels:C.advertise_log_levels + ?colors + () + in + let config = + make_with_defaults ?enable_default_daily_logs_at:daily_logs_path ~log_cfg () + in + match parsed_config_file with + | None -> init ~config () + | Some cf -> ( + match cf.Client_config.Cfg_file.internal_events with + | None -> init ~config () + | Some config -> init ~config ()) + (* Main (lwt) entry *) let main (module C : M) ~select_commands ?(disable_logging = false) () = let open Lwt_result_syntax in @@ -481,36 +510,12 @@ let main (module C : M) ~select_commands ?(disable_logging = false) () = let*! () = if disable_logging then Lwt.return_unit else - let open Tezos_base_unix.Internal_event_unix in - let daily_logs_path = - C.default_daily_logs_path - |> Option.map - Filename.Infix.(fun logdir -> base_dir // "logs" // logdir) - in - (* Update config with color logging switch and advertise levels *) - let log_cfg = - let colors = - match parsed_args with - | None -> None - | Some parsed_args -> parsed_args.log_coloring - in - Tezos_base_unix.Logs_simple_config.create_cfg - ?advertise_levels:C.advertise_log_levels - ?colors - () - in - let config = - make_with_defaults - ?enable_default_daily_logs_at:daily_logs_path - ~log_cfg - () - in - match parsed_config_file with - | None -> init ~config () - | Some cf -> ( - match cf.Client_config.Cfg_file.internal_events with - | None -> init ~config () - | Some config -> init ~config ()) + init_logging + (module C) + ?parsed_args + ?parsed_config_file + ~base_dir + () in let rpc_config = let rpc_config : RPC_client_unix.config = diff --git a/src/lib_client_base_unix/client_main_run.mli b/src/lib_client_base_unix/client_main_run.mli index 33ac0a77d4b6..4848e81b35d4 100644 --- a/src/lib_client_base_unix/client_main_run.mli +++ b/src/lib_client_base_unix/client_main_run.mli @@ -95,6 +95,18 @@ val register_default_signer : Client_context.io_wallet -> unit +(** [init_logging (module M) ?parsed_args ?parsed_config_file ~base_dir ()] + starts the logging process based on optional parsed arguments [?parse_args], + optional configuration file [?parsed_config_file], with output in the + [~base_dir] directory. *) +val init_logging : + (module M) -> + ?parsed_args:Client_config.cli_args -> + ?parsed_config_file:Client_config.Cfg_file.t -> + base_dir:string -> + unit -> + unit Lwt.t + val run : (module M) -> select_commands: -- GitLab From 221a457d4fc2721e6bbba59e0c2999987e30b5cc Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Wed, 26 Mar 2025 13:44:35 +0000 Subject: [PATCH 5/7] Agnostic_baker: Add commands module documentation --- src/lib_agnostic_baker/commands.mli | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/lib_agnostic_baker/commands.mli b/src/lib_agnostic_baker/commands.mli index c81df4040674..ded33916227f 100644 --- a/src/lib_agnostic_baker/commands.mli +++ b/src/lib_agnostic_baker/commands.mli @@ -5,6 +5,13 @@ (* *) (*****************************************************************************) +(** [baker_commands ?plugin ()] returns a list of CLI commands available for + controlling a baker process in the Tezos client context. + + - If [?plugin] is provided, the returned commands are fully functional and use + the protocol-specific baking implementation defined in the plugin. + - If [?plugin] is omitted, the function returns only the command specifications, + which can be used for documentation without actual execution. *) val baker_commands : ?plugin:(module Protocol_plugin_sig.S) -> unit -> -- GitLab From 3ad7ce98ea075094484687a736c6866bb3c02c76 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Wed, 26 Mar 2025 14:32:32 +0000 Subject: [PATCH 6/7] Agnostic_baker: Refactor Rpc_services module --- src/lib_agnostic_baker/rpc_services.ml | 128 ++++++++---------------- src/lib_agnostic_baker/rpc_services.mli | 26 +++-- 2 files changed, 59 insertions(+), 95 deletions(-) diff --git a/src/lib_agnostic_baker/rpc_services.ml b/src/lib_agnostic_baker/rpc_services.ml index c2415fc5cbc1..e959b25d9106 100644 --- a/src/lib_agnostic_baker/rpc_services.ml +++ b/src/lib_agnostic_baker/rpc_services.ml @@ -2,18 +2,21 @@ (* *) (* SPDX-License-Identifier: MIT *) (* Copyright (c) 2024 Nomadic Labs, *) +(* Copyright (c) 2025 Trilitech *) (* *) (*****************************************************************************) open Cohttp_lwt_unix open Agnostic_baker_errors +(* RPC helper functions *) + let request_uri ~node_addr ~uri = let open Lwt_result_syntax in Lwt.catch (fun () -> - let*! r = Client.get (Uri.of_string uri) in - return r) + let*! resp = Client.get (Uri.of_string uri) in + return resp) (function | Unix.(Unix_error (ECONNREFUSED, _, _)) -> tzfail (Cannot_connect_to_node node_addr) @@ -43,103 +46,60 @@ let call_and_wrap_rpc ~node_addr ~uri ~f = in raise Not_found -let get_level ~node_addr = +(* Field extraction helpers *) + +(** [get_field ~name json] extracts the field [~name] from the JSON object [json]. + It fails if [json] is not an object or if the field is missing. *) +let get_field ~name = let open Lwt_result_syntax in - let f json = - (* Level field in the RPC result *) - let name = "level" in - let* v = - match json with - | `O fields -> ( - match List.assoc_opt ~equal:( = ) name fields with - | None -> tzfail (Cannot_decode_node_data ("missing field " ^ name)) - | Some node -> return node) - | _ -> tzfail (Cannot_decode_node_data "not an object") - in - let level = Ezjsonm.get_int v in - return level - in + function + | `O fields -> ( + match List.assoc_opt ~equal:( = ) name fields with + | None -> tzfail (Cannot_decode_node_data ("missing field " ^ name)) + | Some v -> return v) + | _ -> tzfail (Cannot_decode_node_data "not an object") + +(** [get_int_field ~name json] extracts an integer field named [~name] from [json]. *) +let get_int_field ~name json = + let open Lwt_result_syntax in + let+ v = get_field ~name json in + Ezjsonm.get_int v + +(** [get_string_field ~name json] extracts a string field named [~name] from [json]. *) +let get_string_field ~name json = + let open Lwt_result_syntax in + let+ v = get_field ~name json in + Ezjsonm.get_string v + +(* RPC specific functions *) + +let get_level ~node_addr = let uri = Format.sprintf "%s/chains/main/blocks/head/header/shell" node_addr in - call_and_wrap_rpc ~node_addr ~uri ~f + call_and_wrap_rpc ~node_addr ~uri ~f:(get_int_field ~name:"level") let get_block_hash ~node_addr = let open Lwt_result_syntax in - let f json = - (* Hash field in the RPC result *) - let name = "hash" in - let* v = - match json with - | `O fields -> ( - match List.assoc_opt ~equal:( = ) name fields with - | None -> tzfail (Cannot_decode_node_data ("missing field " ^ name)) - | Some node -> return node) - | _ -> tzfail (Cannot_decode_node_data "not an object") - in - let block_hash = Block_hash.of_b58check_exn @@ Ezjsonm.get_string v in - return block_hash - in let uri = Format.sprintf "%s/chains/main/blocks/head/header" node_addr in - call_and_wrap_rpc ~node_addr ~uri ~f + call_and_wrap_rpc ~node_addr ~uri ~f:(fun json -> + let+ block_hash = get_string_field ~name:"hash" json in + Block_hash.of_b58check_exn block_hash) let get_next_protocol_hash ~node_addr = let open Lwt_result_syntax in - let f json = - (* Next_protocol hash field in the RPC result *) - let name = "next_protocol" in - let* v = - match json with - | `O fields -> ( - match List.assoc_opt ~equal:( = ) name fields with - | None -> tzfail (Cannot_decode_node_data ("missing field " ^ name)) - | Some node -> return node) - | _ -> tzfail (Cannot_decode_node_data "not an object") - in - let hash = Protocol_hash.of_b58check_exn (Ezjsonm.get_string v) in - return hash - in let uri = Format.sprintf "%s/chains/main/blocks/head/metadata" node_addr in - call_and_wrap_rpc ~node_addr ~uri ~f + call_and_wrap_rpc ~node_addr ~uri ~f:(fun json -> + let+ next_protocol = get_string_field ~name:"next_protocol" json in + Protocol_hash.of_b58check_exn next_protocol) let get_current_period ~node_addr = let open Lwt_result_syntax in - let voting_period_field = "voting_period" in - let kind_field = "kind" in - let remaining_field = "remaining" in - let f json = - let* kind = - match json with - | `O fields -> ( - match List.assoc_opt ~equal:( = ) voting_period_field fields with - | None -> - tzfail - (Cannot_decode_node_data ("missing field " ^ voting_period_field)) - | Some node -> ( - match node with - | `O fields -> ( - match List.assoc_opt ~equal:( = ) kind_field fields with - | None -> - tzfail - (Cannot_decode_node_data - ("missing field " ^ voting_period_field)) - | Some node -> return @@ Ezjsonm.get_string node) - | _ -> tzfail (Cannot_decode_node_data "not an object"))) - | _ -> tzfail (Cannot_decode_node_data "not an object") - in - let* remaining = - match json with - | `O fields -> ( - match List.assoc_opt ~equal:( = ) remaining_field fields with - | None -> - tzfail - (Cannot_decode_node_data ("missing field " ^ remaining_field)) - | Some node -> return @@ Ezjsonm.get_int node) - | _ -> tzfail (Cannot_decode_node_data "not an object") - in - return (kind, remaining) - in let uri = Format.sprintf "%s/chains/main/blocks/head/votes/current_period" node_addr in - call_and_wrap_rpc ~node_addr ~uri ~f + call_and_wrap_rpc ~node_addr ~uri ~f:(fun json -> + let* voting_period = get_field ~name:"voting_period" json in + let* kind = get_string_field ~name:"kind" voting_period in + let+ remaining = get_int_field ~name:"remaining" json in + (kind, remaining)) diff --git a/src/lib_agnostic_baker/rpc_services.mli b/src/lib_agnostic_baker/rpc_services.mli index 904ac48456d9..b8e1acb6a995 100644 --- a/src/lib_agnostic_baker/rpc_services.mli +++ b/src/lib_agnostic_baker/rpc_services.mli @@ -2,30 +2,34 @@ (* *) (* SPDX-License-Identifier: MIT *) (* Copyright (c) 2024 Nomadic Labs, *) +(* Copyright (c) 2025 Trilitech *) (* *) (*****************************************************************************) -(** [request_uri ~node_addr ~uri] is a raw call that will return the - Cohttp response of an RPC call, given a [~uri], against the - [~node_addr]. *) +(** [request_uri ~node_addr ~uri] issues an HTTP [GET] request to the [~uri] and + returns the response and its body. In case the connection is refused, + it fails with a connection error on [~node_addr]. *) val request_uri : node_addr:string -> uri:string -> (Cohttp_lwt_unix.Response.t * Cohttp_lwt.Body.t) tzresult Lwt.t -(** [get_level ~node_addr] returns the level of the block. *) +(** [get_level ~node_addr] retrieves the current block level from the node at + [~node_addr]. *) val get_level : node_addr:string -> (int, error trace) result Lwt.t -(** [get_level ~node_addr] returns the hash of the block. *) +(** [get_block_hash ~node_addr] retrieves the hash of the current block from the node + at [~node_addr]. *) val get_block_hash : node_addr:string -> (Block_hash.t, error trace) result Lwt.t -(** [get_next_protocol_hash ~node_addr] returns the protocol hash - contained in the [next_protocol] field of the metadata of a - block. *) +(** [get_next_protocol_hash ~node_addr] retrieves the protocol hash from the [next_protocol] + field in the metadata of the current block, as seen by the node at [~node_addr]. *) val get_next_protocol_hash : node_addr:string -> Protocol_hash.t tzresult Lwt.t -(** [get_current_period ~node_addr] returns the current voting - period in addition to the number of remaining blocks until the end - of the period. *) +(** [get_current_period ~node_addr] retrieves the current voting period information + from the node at [~node_addr]. It returns a pair [(kind, remaining)] where: + - [kind] is a string representing the voting period kind, and + - [remaining] is the number of blocks remaining until the end of the voting period. *) + val get_current_period : node_addr:string -> (string * int) tzresult Lwt.t -- GitLab From d4a5150257786f90b43bd13167132339ae9ebbc2 Mon Sep 17 00:00:00 2001 From: Gabriel Moise Date: Wed, 26 Mar 2025 14:57:32 +0000 Subject: [PATCH 7/7] Agnostic_baker: Fix documentation for Run_args module --- src/lib_agnostic_baker/run_args.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib_agnostic_baker/run_args.mli b/src/lib_agnostic_baker/run_args.mli index 8483915b1e85..73cb30d6d98c 100644 --- a/src/lib_agnostic_baker/run_args.mli +++ b/src/lib_agnostic_baker/run_args.mli @@ -19,6 +19,6 @@ val is_man_cmd : string list -> bool amongst [args], and in its absence using the default node RPC port. *) val get_endpoint : string list -> string -(** [get_base_dir] returns the value associated to the [--base-dir] argument - amonsgst [args]. *) +(** [get_base_dir args] returns the value associated to the [--base-dir] argument + amongst [args]. *) val get_base_dir : string list -> string option -- GitLab