From 1c2a771832a835c4c262721c6a4ae28400ae818c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 27 Jun 2018 10:05:42 +0800 Subject: [PATCH] Everywhere: return_{none,some,nil,true,false} --- src/bin_client/client_rpc_commands.ml | 2 +- src/bin_node/node_run_command.ml | 20 +++++----- src/bin_signer/http_daemon.ml | 4 +- src/lib_clic/clic.ml | 28 +++++++------- src/lib_client_base/client_aliases.ml | 14 +++---- src/lib_client_base/client_confirmations.ml | 16 ++++---- src/lib_client_base/client_keys.ml | 12 +++--- src/lib_client_base_unix/client_config.ml | 6 +-- .../client_keys_commands.ml | 4 +- src/lib_error_monad/error_monad.ml | 30 ++++++++++----- src/lib_error_monad/error_monad_sig.ml | 15 ++++++++ src/lib_p2p/p2p.ml | 20 +++++----- src/lib_p2p/p2p_peer_state.ml | 2 +- src/lib_p2p/p2p_pool.ml | 4 +- src/lib_p2p/p2p_socket.ml | 8 ++-- src/lib_p2p/test/process.ml | 2 +- src/lib_p2p/test/test_p2p_io_scheduler.ml | 2 +- .../sigs/v1/error_monad.mli | 15 ++++++++ src/lib_protocol_updater/updater.ml | 12 +++--- src/lib_shell/block_validator.ml | 2 +- src/lib_shell/chain.ml | 2 +- src/lib_shell/chain_traversal.ml | 2 +- src/lib_shell/distributed_db.ml | 4 +- src/lib_shell/distributed_db_functors.ml | 4 +- src/lib_shell/monitor_directory.ml | 2 +- src/lib_shell/prevalidation.ml | 4 +- src/lib_shell/protocol_validator.ml | 2 +- src/lib_shell/state.ml | 27 +++++++------ src/lib_shell/worker.ml | 4 +- src/lib_signer_backends/encrypted.ml | 8 ++-- src/lib_signer_backends/http_gen.ml | 4 +- src/lib_signer_backends/ledger.ml | 8 ++-- src/lib_signer_backends/remote.ml | 10 ++--- src/lib_signer_backends/socket.ml | 4 +- src/lib_stdlib/lwt_dropbox.ml | 2 +- src/lib_stdlib_unix/lwt_lock_file.ml | 6 +-- src/lib_storage/context.ml | 2 +- src/lib_storage/store_helpers.ml | 4 +- .../lib_client/client_proto_context.ml | 4 +- .../lib_client/client_proto_contracts.ml | 4 +- src/proto_alpha/lib_client/injection.ml | 4 +- .../client_proto_context_commands.ml | 4 +- .../lib_delegate/client_baking_blocks.ml | 2 +- .../lib_delegate/client_baking_endorsement.ml | 12 +++--- .../lib_delegate/client_baking_forge.ml | 38 +++++++++---------- .../lib_delegate/client_baking_lib.ml | 6 +-- .../lib_delegate/test/proto_alpha_helpers.ml | 4 +- src/proto_alpha/lib_protocol/src/baking.ml | 4 +- .../lib_protocol/src/contract_services.ml | 4 +- .../lib_protocol/src/contract_storage.ml | 18 ++++----- .../lib_protocol/src/delegate_services.ml | 6 +-- .../lib_protocol/src/delegate_storage.ml | 12 +++--- .../lib_protocol/src/roll_storage.ml | 2 +- .../lib_protocol/src/script_interpreter.ml | 2 +- .../lib_protocol/src/storage_description.ml | 14 +++---- .../lib_protocol/src/storage_functors.ml | 20 +++++----- src/proto_alpha/lib_protocol/test/rolls.ml | 2 +- src/proto_genesis/lib_protocol/src/main.ml | 4 +- 58 files changed, 261 insertions(+), 222 deletions(-) diff --git a/src/bin_client/client_rpc_commands.ml b/src/bin_client/client_rpc_commands.ml index 05fad70ac..ad47af96a 100644 --- a/src/bin_client/client_rpc_commands.ml +++ b/src/bin_client/client_rpc_commands.ml @@ -92,7 +92,7 @@ let fill_in ?(show_optionals=true) input schema = Lwt.return acc else element (string_of_int n :: path) elt >>= fun json -> - (if n < min then Lwt.return true else input.continue title path) >>= function + (if n < min then Lwt.return_true else input.continue title path) >>= function | true -> fill_loop (json :: acc) min (succ n) max | false -> Lwt.return (json :: acc) in diff --git a/src/bin_node/node_run_command.ml b/src/bin_node/node_run_command.ml index 59df1198c..99e8322c9 100644 --- a/src/bin_node/node_run_command.ml +++ b/src/bin_node/node_run_command.ml @@ -119,16 +119,16 @@ let init_node ?sandbox ?checkpoint (config : Node_config_file.t) = | None -> Lwt.return_none | Some sandbox_param -> match sandbox_param with - | None -> Lwt.return None + | None -> Lwt.return_none | Some file -> Lwt_utils_unix.Json.read_file file >>= function | Error err -> lwt_warn "Can't parse sandbox parameters: %s" file >>= fun () -> lwt_debug "%a" pp_print_error err >>= fun () -> - Lwt.return None + Lwt.return_none | Ok json -> - Lwt.return (Some json) + Lwt.return_some json end >>= fun sandbox_param -> (* TODO "WARN" when pow is below our expectation. *) begin @@ -146,10 +146,10 @@ let init_node ?sandbox ?checkpoint (config : Node_config_file.t) = match listening_addr, sandbox with | Some addr, Some _ when Ipaddr.V6.(compare addr unspecified) = 0 -> - return None + return_none | Some addr, Some _ when not (Ipaddr.V6.is_private addr) -> fail (Non_private_sandbox addr) - | None, Some _ -> return None + | None, Some _ -> return_none | _ -> (Node_config_file.resolve_bootstrap_addrs config.p2p.bootstrap_peers) >>= fun trusted_points -> @@ -172,7 +172,7 @@ let init_node ?sandbox ?checkpoint (config : Node_config_file.t) = disable_mempool = config.p2p.disable_mempool ; } in - return (Some (p2p_config, config.p2p.limits)) + return_some (p2p_config, config.p2p.limits) end >>=? fun p2p_config -> let node_config : Node.config = { genesis ; @@ -201,7 +201,7 @@ let init_rpc (rpc_config: Node_config_file.rpc) node = match rpc_config.listen_addr with | None -> lwt_log_notice "Not listening to RPC calls." >>= fun () -> - return None + return_none | Some addr -> Node_config_file.resolve_rpc_listening_addrs addr >>= function | [] -> @@ -228,7 +228,7 @@ let init_rpc (rpc_config: Node_config_file.rpc) node = ~media_types:Media_type.all_media_types ~cors:{ allowed_origins = rpc_config.cors_origins ; allowed_headers = cors_headers } >>= fun server -> - return (Some server)) + return_some server) (function |Unix.Unix_error(Unix.EADDRINUSE, "bind","") -> fail (RPC_Port_already_in_use [(addr,port)]) @@ -284,7 +284,7 @@ let process sandbox verbosity checkpoint args = end >>=? fun () -> begin match checkpoint with - | None -> return None + | None -> return_none | Some s -> match String.split ',' s with | [ lvl ; block ] -> @@ -296,7 +296,7 @@ let process sandbox verbosity checkpoint args = | Some lvl -> return lvl end >>=? fun lvl -> - return (Some (lvl, block)) + return_some (lvl, block) | [] -> assert false | [_] -> failwith "Checkoints are expected to follow the format \ diff --git a/src/bin_signer/http_daemon.ml b/src/bin_signer/http_daemon.ml index a21949a46..64479cf91 100644 --- a/src/bin_signer/http_daemon.ml +++ b/src/bin_signer/http_daemon.ml @@ -23,9 +23,9 @@ let run (cctxt : #Client_context.wallet) ~hosts ?magic_bytes ~require_auth mode RPC_directory.register0 dir Signer_services.authorized_keys begin fun () () -> if require_auth then Handler.Authorized_key.load cctxt >>=? fun keys -> - return (Some (keys |> List.split |> snd |> List.map Signature.Public_key.hash)) + return_some (keys |> List.split |> snd |> List.map Signature.Public_key.hash) else - return None + return_none end in Lwt.catch (fun () -> diff --git a/src/lib_clic/clic.ml b/src/lib_clic/clic.ml index 5ef9e6307..28b009e45 100644 --- a/src/lib_clic/clic.ml +++ b/src/lib_clic/clic.ml @@ -564,8 +564,8 @@ let parse_arg : match spec with | Arg { parameter = (long, _) ; kind = { converter ; _ } ; _ } -> begin match TzString.Map.find long args_dict with - | exception Not_found -> return None - | [] -> return None + | exception Not_found -> return_none + | [] -> return_none | [ s ] -> (trace (Bad_option_argument ("--" ^ long, command)) @@ -595,9 +595,9 @@ let parse_arg : end | Switch { parameter = (long, _) ; _ } -> begin match TzString.Map.find long args_dict with - | exception Not_found -> return false - | [] -> return false - | [ _ ] -> return true + | exception Not_found -> return_false + | [] -> return_false + | [ _ ] -> return_true | _ :: _ -> fail (Multiple_occurences (long, command)) end | Constant c -> return c @@ -984,7 +984,7 @@ let rec list_args : type arg ctx. (arg, ctx) args -> string list = function let complete_func autocomplete cctxt = match autocomplete with - | None -> return [] + | None -> return_nil | Some autocomplete -> autocomplete cctxt let list_command_args (Command { options = Argument { spec ; _ } ; _ }) = @@ -994,8 +994,8 @@ let complete_arg : type a ctx. ctx -> (a, ctx) arg -> string list tzresult Lwt.t fun ctx -> function | Arg { kind = { autocomplete ; _ } ; _ } -> complete_func autocomplete ctx | DefArg { kind = { autocomplete ; _ } ; _ } -> complete_func autocomplete ctx - | Switch _ -> return [] - | Constant _ -> return [] + | Switch _ -> return_nil + | Constant _ -> return_nil let rec remaining_spec : type a ctx. TzString.Set.t -> (a, ctx) args -> string list = @@ -1013,7 +1013,7 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) = let arities = make_arities_dict args_spec TzString.Map.empty in let rec complete_spec : type a. string -> (a, ctx) args -> string list tzresult Lwt.t = fun name -> function - | NoArgs -> return [] + | NoArgs -> return_nil | AddArg (Constant _, rest) -> complete_spec name rest | AddArg (arg, rest) -> @@ -1057,7 +1057,7 @@ let complete_next_tree cctxt = function | TParam { autocomplete ; _ } -> complete_func autocomplete cctxt | TStop command -> return (list_command_args command) - | TEmpty -> return [] + | TEmpty -> return_nil let complete_tree cctxt tree index args = let rec help tree args ind = @@ -1069,14 +1069,14 @@ let complete_tree cctxt tree index args = | TPrefix { prefix ; _ }, hd :: tl -> begin try help (List.assoc hd prefix) tl (ind - 1) - with Not_found -> return [] + with Not_found -> return_nil end | TParam { tree ; _ }, _ :: tl -> help tree tl (ind - 1) | TStop Command { options = Argument { spec ; _ } ; conv ;_ }, args -> - complete_options (fun _ _ -> return []) args spec ind (conv cctxt) + complete_options (fun _ _ -> return_nil) args spec ind (conv cctxt) | (TParam _ | TPrefix _), [] - | TEmpty, _ -> return [] + | TEmpty, _ -> return_nil in help tree args index let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands cctxt = @@ -1097,7 +1097,7 @@ let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands cct else match ind 0 args with | None -> - return [] + return_nil | Some index -> begin let Argument { spec ; _ } = global_options in diff --git a/src/lib_client_base/client_aliases.ml b/src/lib_client_base/client_aliases.ml index 5a7225154..4116303a2 100644 --- a/src/lib_client_base/client_aliases.ml +++ b/src/lib_client_base/client_aliases.ml @@ -106,13 +106,13 @@ module Alias = functor (Entity : Entity) -> struct let autocomplete wallet = load wallet >>= function - | Error _ -> return [] + | Error _ -> return_nil | Ok list -> return (List.map fst list) let find_opt (wallet : #wallet) name = load wallet >>=? fun list -> - try return (Some (List.assoc name list)) - with Not_found -> return None + try return_some (List.assoc name list) + with Not_found -> return_none let find (wallet : #wallet) name = load wallet >>=? fun list -> @@ -122,16 +122,16 @@ module Alias = functor (Entity : Entity) -> struct let rev_find (wallet : #wallet) v = load wallet >>=? fun list -> - try return (Some (List.find (fun (_, v') -> v = v') list |> fst)) - with Not_found -> return None + try return_some (List.find (fun (_, v') -> v = v') list |> fst) + with Not_found -> return_none let mem (wallet : #wallet) name = load wallet >>=? fun list -> try ignore (List.assoc name list) ; - return true + return_true with - | Not_found -> return false + | Not_found -> return_false let add ~force (wallet : #wallet) name value = let keep = ref false in diff --git a/src/lib_client_base/client_confirmations.ml b/src/lib_client_base/client_confirmations.ml index c26e24951..826c37dd4 100644 --- a/src/lib_client_base/client_confirmations.ml +++ b/src/lib_client_base/client_confirmations.ml @@ -66,7 +66,7 @@ let wait_for_operation_inclusion "Error while fetching block (ignored): %a" pp_print_error err >>= fun () -> (* Will be retried when a new head arrives *) - Lwt.return [] in + Lwt.return_nil in (* Check whether a block as enough confirmations. This function assumes that the block predecessor has been processed already. *) @@ -81,9 +81,9 @@ let wait_for_operation_inclusion (n+1) Block_hash.pp hash >>= fun () -> Block_hash.Table.add blocks hash (Some (block_with_op, n+1)) ; if n+1 < confirmations then begin - return None + return_none end else - return (Some block_with_op) + return_some block_with_op | None -> Shell_services.Blocks.Operation_hashes.operation_hashes ctxt ~chain ~block () >>=? fun operations -> @@ -101,16 +101,16 @@ let wait_for_operation_inclusion match in_block with | None -> Block_hash.Table.add blocks hash None ; - return None + return_none | Some (i, j) -> begin ctxt#answer "Operation found in block: %a (pass: %d, offset: %d)" Block_hash.pp hash i j >>= fun () -> Block_hash.Table.add blocks hash (Some ((hash, i, j), 0)) ; if confirmations <= 0 then - return (Some (hash, i, j)) + return_some (hash, i, j) else begin - return None + return_none end end in @@ -138,8 +138,8 @@ let wait_for_operation_inclusion Lwt_stream.find_s (fun (hash, header) -> process hash header >>= function - | Ok None -> Lwt.return false - | Ok (Some _) -> Lwt.return true + | Ok None -> Lwt.return_false + | Ok (Some _) -> Lwt.return_true | Error err -> Lwt.fail (WrapError err)) stream >>= return) (function diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml index 54459dc11..a248bd4cb 100644 --- a/src/lib_client_base/client_keys.ml +++ b/src/lib_client_base/client_keys.ml @@ -219,12 +219,12 @@ let raw_get_key (cctxt : #Client_context.wallet) pkh = | Some n -> Secret_key.find_opt cctxt n >>=? fun sk_uri -> Public_key.find_opt cctxt n >>=? begin function - | None -> return None - | Some (_, Some pk) -> return (Some pk) + | None -> return_none + | Some (_, Some pk) -> return_some pk | Some (pk_uri, None) -> public_key pk_uri >>=? fun pk -> Public_key.update cctxt n (pk_uri, Some pk) >>=? fun () -> - return (Some pk) + return_some pk end >>=? fun pk -> return (n, pk, sk_uri) end >>= function @@ -268,7 +268,7 @@ let get_keys (cctxt : #Client_context.wallet) = end >>=? fun pk -> return (name, pkh, pk, sk_uri) end >>= function - | Ok r -> Lwt.return (Some r) + | Ok r -> Lwt.return_some r | Error _ -> Lwt.return_none end sks >>= fun keys -> return keys @@ -287,8 +287,8 @@ let list_keys cctxt = let alias_keys cctxt name = Public_key_hash.find cctxt name >>=? fun pkh -> raw_get_key cctxt pkh >>= function - | Ok (_name, pk, sk_uri) -> return (Some (pkh, pk, sk_uri)) - | Error _ -> return None + | Ok (_name, pk, sk_uri) -> return_some (pkh, pk, sk_uri) + | Error _ -> return_none let force_switch () = Clic.switch diff --git a/src/lib_client_base_unix/client_config.ml b/src/lib_client_base_unix/client_config.ml index 1cde125e9..a970670db 100644 --- a/src/lib_client_base_unix/client_config.ml +++ b/src/lib_client_base_unix/client_config.ml @@ -173,12 +173,12 @@ let wait_parameter () = parameter (fun _ wait -> match wait with - | "no" | "none" -> return None + | "no" | "none" -> return_none | _ -> try let w = int_of_string wait in if 0 <= w then - return (Some w) + return_some w else fail (Invalid_wait_arg wait) with _ -> fail (Invalid_wait_arg wait)) @@ -193,7 +193,7 @@ let protocol_parameter () = (Protocol_hash.to_b58check hash)) (Client_commands.get_versions ()) in - return (Some hash) + return_some hash with Not_found -> fail (Invalid_protocol_argument arg) ) diff --git a/src/lib_client_commands/client_keys_commands.ml b/src/lib_client_commands/client_keys_commands.ml index 23ba16622..d4cc212dc 100644 --- a/src/lib_client_commands/client_keys_commands.ml +++ b/src/lib_client_commands/client_keys_commands.ml @@ -123,8 +123,8 @@ let rec input_fundraiser_params (cctxt : #Client_context.io_wallet) = cctxt#prompt "%s %s: " msg prompt >>=? fun gen -> match default, String.lowercase_ascii gen with | default, "" -> return default - | _, "y" -> return true - | _, "n" -> return false + | _, "y" -> return_true + | _, "n" -> return_false | _, "q" -> failwith "Exit by user request." | _ -> get_boolean_answer cctxt ~msg ~default in cctxt#prompt "Enter the e-mail used for the paper wallet: " >>=? fun email -> diff --git a/src/lib_error_monad/error_monad.ml b/src/lib_error_monad/error_monad.ml index 97b7743b5..52dd4a4d8 100644 --- a/src/lib_error_monad/error_monad.ml +++ b/src/lib_error_monad/error_monad.ml @@ -319,6 +319,16 @@ module Make(Prefix : sig val id : string end) = struct let return_unit = Lwt.return (Ok ()) + let return_none = Lwt.return (Ok None) + + let return_some x = Lwt.return (Ok (Some x)) + + let return_nil = Lwt.return (Ok []) + + let return_true = Lwt.return (Ok true) + + let return_false = Lwt.return (Ok false) + let error s = Error [ s ] let ok v = Ok v @@ -342,7 +352,7 @@ module Make(Prefix : sig val id : string end) = struct let rec map_s f l = match l with - | [] -> return [] + | [] -> return_nil | h :: t -> f h >>=? fun rh -> map_s f t >>=? fun rt -> @@ -351,7 +361,7 @@ module Make(Prefix : sig val id : string end) = struct let mapi_s f l = let rec mapi_s f i l = match l with - | [] -> return [] + | [] -> return_nil | h :: t -> f i h >>=? fun rh -> mapi_s f (i+1) t >>=? fun rt -> @@ -362,7 +372,7 @@ module Make(Prefix : sig val id : string end) = struct let rec map_p f l = match l with | [] -> - return [] + return_nil | x :: l -> let tx = f x and tl = map_p f l in tx >>= fun x -> @@ -377,7 +387,7 @@ module Make(Prefix : sig val id : string end) = struct let rec mapi_p f i l = match l with | [] -> - return [] + return_nil | x :: l -> let tx = f i x and tl = mapi_p f (i+1) l in tx >>= fun x -> @@ -391,7 +401,7 @@ module Make(Prefix : sig val id : string end) = struct let rec map2_s f l1 l2 = match l1, l2 with - | [], [] -> return [] + | [], [] -> return_nil | _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.map2_s" | h1 :: t1, h2 :: t2 -> f h1 h2 >>=? fun rh -> @@ -401,7 +411,7 @@ module Make(Prefix : sig val id : string end) = struct let mapi2_s f l1 l2 = let rec mapi2_s i f l1 l2 = match l1, l2 with - | [], [] -> return [] + | [], [] -> return_nil | _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.mapi2_s" | h1 :: t1, h2 :: t2 -> f i h1 h2 >>=? fun rh -> @@ -420,7 +430,7 @@ module Make(Prefix : sig val id : string end) = struct let rec filter_map_s f l = match l with - | [] -> return [] + | [] -> return_nil | h :: t -> f h >>=? function | None -> filter_map_s f t @@ -430,7 +440,7 @@ module Make(Prefix : sig val id : string end) = struct let rec filter_map_p f l = match l with - | [] -> return [] + | [] -> return_nil | h :: t -> let th = f h and tt = filter_map_p f t in @@ -442,7 +452,7 @@ module Make(Prefix : sig val id : string end) = struct let rec filter_s f l = match l with - | [] -> return [] + | [] -> return_nil | h :: t -> f h >>=? function | false -> filter_s f t @@ -452,7 +462,7 @@ module Make(Prefix : sig val id : string end) = struct let rec filter_p f l = match l with - | [] -> return [] + | [] -> return_nil | h :: t -> let jh = f h and t = filter_p f t in diff --git a/src/lib_error_monad/error_monad_sig.ml b/src/lib_error_monad/error_monad_sig.ml index d794ee708..6c2846834 100644 --- a/src/lib_error_monad/error_monad_sig.ml +++ b/src/lib_error_monad/error_monad_sig.ml @@ -83,6 +83,21 @@ module type S = sig (** Sucessful return of [()] *) val return_unit : unit tzresult Lwt.t + (** Sucessful return of [None] *) + val return_none : 'a option tzresult Lwt.t + + (** [return_some x] is a sucessful return of [Some x] *) + val return_some : 'a -> 'a option tzresult Lwt.t + + (** Sucessful return of [[]] *) + val return_nil : 'a list tzresult Lwt.t + + (** Sucessful return of [true] *) + val return_true : bool tzresult Lwt.t + + (** Sucessful return of [false] *) + val return_false : bool tzresult Lwt.t + (** Erroneous result *) val error : error -> 'a tzresult diff --git a/src/lib_p2p/p2p.ml b/src/lib_p2p/p2p.ml index 6f94ad53e..14407a9dc 100644 --- a/src/lib_p2p/p2p.ml +++ b/src/lib_p2p/p2p.ml @@ -146,13 +146,13 @@ let create_maintenance_worker limits pool = let may_create_welcome_worker config limits pool = match config.listening_port with - | None -> Lwt.return None + | None -> Lwt.return_none | Some port -> P2p_welcome.run ~backlog:limits.backlog pool ?addr:config.listening_addr port >>= fun w -> - Lwt.return (Some w) + Lwt.return_some w type ('msg, 'peer_meta, 'conn_meta) connection = ('msg, 'peer_meta, 'conn_meta) P2p_pool.connection @@ -233,7 +233,7 @@ module Real = struct net.pool ~init:[] ~f:begin fun _peer_id conn acc -> (P2p_pool.is_readable conn >>= function - | Ok () -> Lwt.return (Some conn) + | Ok () -> Lwt.return_some conn | Error _ -> Lwt_utils.never_ending ()) :: acc end in Lwt.pick ( @@ -616,7 +616,7 @@ let build_rpc_directory net = RPC_directory.register0 dir P2p_services.Connections.S.list begin fun () () -> match net.pool with - | None -> return [] + | None -> return_nil | Some pool -> return @@ P2p_pool.Connection.fold @@ -632,7 +632,7 @@ let build_rpc_directory net = RPC_directory.register0 dir P2p_services.Peers.S.list begin fun q () -> match net.pool with - | None -> return [] + | None -> return_nil | Some pool -> return @@ P2p_pool.Peers.fold_known pool @@ -651,7 +651,7 @@ let build_rpc_directory net = RPC_directory.opt_register1 dir P2p_services.Peers.S.info begin fun peer_id () () -> match net.pool with - | None -> return None + | None -> return_none | Some pool -> return @@ Option.map ~f:(info_of_peer_info pool) @@ -713,9 +713,9 @@ let build_rpc_directory net = RPC_directory.register1 dir P2p_services.Peers.S.banned begin fun peer_id () () -> match net.pool with - | None -> return false + | None -> return_false | Some pool when (P2p_pool.Peers.get_trusted pool peer_id) -> - return false + return_false | Some pool -> return (P2p_pool.Peers.banned pool peer_id) end in @@ -726,7 +726,7 @@ let build_rpc_directory net = RPC_directory.register0 dir P2p_services.Points.S.list begin fun q () -> match net.pool with - | None -> return [] + | None -> return_nil | Some pool -> return @@ P2p_pool.Points.fold_known @@ -745,7 +745,7 @@ let build_rpc_directory net = RPC_directory.opt_register1 dir P2p_services.Points.S.info begin fun point () () -> match net.pool with - | None -> return None + | None -> return_none | Some pool -> return @@ Option.map diff --git a/src/lib_p2p/p2p_peer_state.ml b/src/lib_p2p/p2p_peer_state.ml index 5144a12a7..3a7272828 100644 --- a/src/lib_p2p/p2p_peer_state.ml +++ b/src/lib_p2p/p2p_peer_state.ml @@ -138,7 +138,7 @@ module Info = struct Lwt_utils_unix.Json.read_file path >>=? fun json -> return (Data_encoding.Json.destruct enc json) else - return [] + return_nil let save path peer_metadata_encoding peers = let open Data_encoding in diff --git a/src/lib_p2p/p2p_pool.ml b/src/lib_p2p/p2p_pool.ml index 508f9b206..5bce2b206 100644 --- a/src/lib_p2p/p2p_pool.ml +++ b/src/lib_p2p/p2p_pool.ml @@ -904,7 +904,7 @@ and create_connection pool p2p_conn id_point point_info peer_info _version = private_node_warn "Receive requests for peers addresses from %a" P2p_peer.Id.pp peer_id >>= fun () -> - Lwt.return [] + Lwt.return_nil ) ; swap_request = (fun _point _peer_id -> @@ -987,7 +987,7 @@ and list_known_points ?(ignore_private = false) pool conn = if P2p_socket.private_node conn.conn then private_node_warn "Private peer (%a) asked other peers addresses" P2p_peer.Id.pp (P2p_peer_state.Info.peer_id conn.peer_info) >>= fun () -> - Lwt.return [] + Lwt.return_nil else let knowns = P2p_point.Table.fold diff --git a/src/lib_p2p/p2p_socket.ml b/src/lib_p2p/p2p_socket.ml index 48b334771..01ac98b44 100644 --- a/src/lib_p2p/p2p_socket.ml +++ b/src/lib_p2p/p2p_socket.ml @@ -319,10 +319,10 @@ module Reader = struct let open Data_encoding.Binary in match status with | Success { result ; size ; stream } -> - return (Some (result, size, stream)) + return_some (result, size, stream) | Error _ -> lwt_debug "[read_message] incremental decoding error" >>= fun () -> - return None + return_none | Await decode_next_buf -> protect ~canceler:st.canceler begin fun () -> Crypto.read_chunk st.conn.fd st.conn.cryptobox_data @@ -341,12 +341,12 @@ module Reader = struct | None -> protect ~canceler:st.canceler begin fun () -> Lwt_pipe.push st.messages (Error [P2p_errors.Decoding_error]) >>= fun () -> - return None + return_none end | Some (msg, size, stream) -> protect ~canceler:st.canceler begin fun () -> Lwt_pipe.push st.messages (Ok (size, msg)) >>= fun () -> - return (Some stream) + return_some stream end end >>= function | Ok (Some stream) -> diff --git a/src/lib_p2p/test/process.ml b/src/lib_p2p/test/process.ml index 817d32f4a..8917081c8 100644 --- a/src/lib_p2p/test/process.ml +++ b/src/lib_p2p/test/process.ml @@ -141,7 +141,7 @@ let wait_all processes = | [] -> loop remaining | Ok () :: finished -> handle finished | Error err :: _ -> - Lwt.return (Some (err, remaining)) in + Lwt.return_some (err, remaining) in handle finished in loop (List.map (fun p -> p.termination) processes) >>= function | None -> diff --git a/src/lib_p2p/test/test_p2p_io_scheduler.ml b/src/lib_p2p/test/test_p2p_io_scheduler.ml index 73c45854e..db6d75222 100644 --- a/src/lib_p2p/test/test_p2p_io_scheduler.ml +++ b/src/lib_p2p/test/test_p2p_io_scheduler.ml @@ -37,7 +37,7 @@ let accept main_socket = let rec accept_n main_socket n = if n <= 0 then - return [] + return_nil else accept_n main_socket (n-1) >>=? fun acc -> accept main_socket >>=? fun conn -> diff --git a/src/lib_protocol_environment/sigs/v1/error_monad.mli b/src/lib_protocol_environment/sigs/v1/error_monad.mli index 66861ab17..293383c0e 100644 --- a/src/lib_protocol_environment/sigs/v1/error_monad.mli +++ b/src/lib_protocol_environment/sigs/v1/error_monad.mli @@ -75,6 +75,21 @@ val return : 'a -> 'a tzresult Lwt.t (** Sucessful return of [()] *) val return_unit : unit tzresult Lwt.t +(** Sucessful return of [None] *) +val return_none : 'a option tzresult Lwt.t + +(** [return_some x] is a sucessful return of [Some x] *) +val return_some : 'a -> 'a option tzresult Lwt.t + +(** Sucessful return of [[]] *) +val return_nil : 'a list tzresult Lwt.t + +(** Sucessful return of [true] *) +val return_true : bool tzresult Lwt.t + +(** Sucessful return of [false] *) +val return_false : bool tzresult Lwt.t + (** Erroneous result *) val error : error -> 'a tzresult diff --git a/src/lib_protocol_updater/updater.ml b/src/lib_protocol_updater/updater.ml index e3f8b7b21..2d260a94b 100644 --- a/src/lib_protocol_updater/updater.ml +++ b/src/lib_protocol_updater/updater.ml @@ -46,23 +46,23 @@ let do_compile hash p = end >>= function | Error err -> log_error "Error %a" pp_print_error err ; - Lwt.return false + Lwt.return_false | Ok (Unix.WSIGNALED _ | Unix.WSTOPPED _) -> log_error "INTERRUPTED COMPILATION (%s)" log_file; - Lwt.return false + Lwt.return_false | Ok (Unix.WEXITED x) when x <> 0 -> log_error "COMPILATION ERROR (%s)" log_file; - Lwt.return false + Lwt.return_false | Ok (Unix.WEXITED _) -> - try Dynlink.loadfile_private (plugin_file ^ ".cmxs"); Lwt.return true + try Dynlink.loadfile_private (plugin_file ^ ".cmxs"); Lwt.return_true with Dynlink.Error err -> log_error "Can't load plugin: %s (%s)" (Dynlink.error_message err) plugin_file; - Lwt.return false + Lwt.return_false let compile hash p = if Tezos_protocol_registerer.Registerer.mem hash then - Lwt.return true + Lwt.return_true else begin do_compile hash p >>= fun success -> let loaded = Tezos_protocol_registerer.Registerer.mem hash in diff --git a/src/lib_shell/block_validator.ml b/src/lib_shell/block_validator.ml index a0c34d163..4938f939b 100644 --- a/src/lib_shell/block_validator.ml +++ b/src/lib_shell/block_validator.ml @@ -382,7 +382,7 @@ let validate w bv.protocol_validator ?peer ~timeout:bv.limits.protocol_timeout block ; - return None + return_none | None -> map_p (map_p (fun op -> let op_hash = Operation.hash op in diff --git a/src/lib_shell/chain.ml b/src/lib_shell/chain.ml index 651966caa..73b3cd310 100644 --- a/src/lib_shell/chain.ml +++ b/src/lib_shell/chain.ml @@ -29,7 +29,7 @@ let head chain_state = let mem chain_state hash = State.read_chain_data chain_state begin fun chain_store data -> if Block_hash.equal (State.Block.hash data.current_head) hash then - Lwt.return true + Lwt.return_true else Store.Chain_data.In_main_branch.known (chain_store, hash) end diff --git a/src/lib_shell/chain_traversal.ml b/src/lib_shell/chain_traversal.ml index a3c6e7cd8..df5bce6b5 100644 --- a/src/lib_shell/chain_traversal.ml +++ b/src/lib_shell/chain_traversal.ml @@ -14,7 +14,7 @@ let path (b1: Block.t) (b2: Block.t) = invalid_arg "Chain_traversal.path" ; let rec loop acc current = if Block.equal b1 current then - Lwt.return (Some acc) + Lwt.return_some acc else Block.predecessor current >>= function | Some pred -> loop (current :: acc) pred diff --git a/src/lib_shell/distributed_db.ml b/src/lib_shell/distributed_db.ml index 43c2f8fff..e2802c402 100644 --- a/src/lib_shell/distributed_db.ml +++ b/src/lib_shell/distributed_db.ml @@ -138,7 +138,7 @@ module Operation_hashes_storage = struct | None -> Lwt.return_none | Some b -> State.Block.operation_hashes b i >>= fun (ops, _) -> - Lwt.return (Some ops) + Lwt.return_some ops let read_exn chain_state (h, i) = State.Block.read_exn chain_state h >>= fun b -> State.Block.operation_hashes b i >>= fun (ops, _) -> @@ -216,7 +216,7 @@ module Operations_storage = struct | None -> Lwt.return_none | Some b -> State.Block.operations b i >>= fun (ops, _) -> - Lwt.return (Some ops) + Lwt.return_some ops let read_exn chain_state (h, i) = State.Block.read_exn chain_state h >>= fun b -> State.Block.operations b i >>= fun (ops, _) -> diff --git a/src/lib_shell/distributed_db_functors.ml b/src/lib_shell/distributed_db_functors.ml index 8cab19058..f14f584bf 100644 --- a/src/lib_shell/distributed_db_functors.ml +++ b/src/lib_shell/distributed_db_functors.ml @@ -135,7 +135,7 @@ end = struct let read_opt s k = match Memory_table.find s.memory k with | exception Not_found -> Disk_table.read_opt s.disk k - | Found v -> Lwt.return (Some v) + | Found v -> Lwt.return_some v | Pending _ -> Lwt.return_none let read_exn s k = @@ -528,7 +528,7 @@ end = struct param ; queue = Lwt_pipe.create () ; pending = Table.create 17 ; - events = Lwt.return [] ; + events = Lwt.return_nil ; canceler = Lwt_canceler.create () ; worker = Lwt.return_unit ; } in diff --git a/src/lib_shell/monitor_directory.ml b/src/lib_shell/monitor_directory.ml index 5dd476a59..15336679c 100644 --- a/src/lib_shell/monitor_directory.ml +++ b/src/lib_shell/monitor_directory.ml @@ -29,7 +29,7 @@ let build_rpc_directory validator mainchain_validator = Chain.head chain_state >>= fun head -> let head_hash = State.Block.hash head in let head_header = State.Block.header head in - Lwt.return (Some (head_hash, head_header.shell.timestamp)) + Lwt.return_some (head_hash, head_header.shell.timestamp) end else begin Lwt.pick [ ( Lwt_stream.get block_stream >|= diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index c0f80fc9d..dcdc67a55 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -81,7 +81,7 @@ let start_prevalidation timestamp >>= fun predecessor_context -> begin match protocol_data with - | None -> return None + | None -> return_none | Some protocol_data -> match Data_encoding.Binary.of_bytes @@ -89,7 +89,7 @@ let start_prevalidation protocol_data with | None -> failwith "Invalid block header" - | Some protocol_data -> return (Some protocol_data) + | Some protocol_data -> return_some protocol_data end >>=? fun protocol_data -> Proto.begin_construction ~predecessor_context diff --git a/src/lib_shell/protocol_validator.ml b/src/lib_shell/protocol_validator.ml index 19e2b2598..ac9fce097 100644 --- a/src/lib_shell/protocol_validator.ml +++ b/src/lib_shell/protocol_validator.ml @@ -43,7 +43,7 @@ let rec worker_loop bv = (* no need to tag 'invalid' protocol on disk, the economic protocol prevents us from being spammed with protocol validation. *) - return true + return_true end >>=? fun _ -> match wakener with | None -> diff --git a/src/lib_shell/state.ml b/src/lib_shell/state.ml index 498f7181c..f9120bb82 100644 --- a/src/lib_shell/state.ml +++ b/src/lib_shell/state.ml @@ -674,8 +674,8 @@ module Block = struct end let read_opt chain_state ?pred hash = read chain_state ?pred hash >>= function - | Error _ -> Lwt.return None - | Ok v -> Lwt.return (Some v) + | Error _ -> Lwt.return_none + | Ok v -> Lwt.return_some v let read_exn chain_state ?(pred = 0) hash = Shared.use chain_state.block_store begin fun store -> begin @@ -696,8 +696,8 @@ module Block = struct return header.shell.predecessor let read_predecessor_opt chain_state hash = read_predecessor chain_state hash >>= function - | Error _ -> Lwt.return None - | Ok v -> Lwt.return (Some v) + | Error _ -> Lwt.return_none + | Ok v -> Lwt.return_some v let read_predecessor_exn chain_state hash = read_exn chain_state hash >>= fun { contents = { header } } -> Lwt.return header.shell.predecessor @@ -707,7 +707,7 @@ module Block = struct Lwt.return_none (* we are at genesis *) else read_exn chain_state header.shell.predecessor >>= fun block -> - Lwt.return (Some block) + Lwt.return_some block let predecessor_n b n = Shared.use b.chain_state.block_store begin fun block_store -> @@ -739,7 +739,7 @@ module Block = struct fail_when known_invalid (failure "Known invalid") >>=? fun () -> Store.Block.Contents.known (store, hash) >>= fun known -> if known then - return None + return_none else begin (* safety check: never ever commit a block that is not compatible with the current checkpoint. *) @@ -806,7 +806,7 @@ module Block = struct let block = { chain_state ; hash ; contents } in Lwt_watcher.notify chain_state.block_watcher block ; Lwt_watcher.notify chain_state.global_state.block_watcher block ; - return (Some block) + return_some block end end @@ -818,11 +818,11 @@ module Block = struct fail_when known_valid (failure "Known valid") >>=? fun () -> Store.Block.Invalid_block.known store hash >>= fun known_invalid -> if known_invalid then - return false + return_false else Store.Block.Invalid_block.store store hash { level = block_header.shell.level ; errors } >>= fun () -> - return true + return_true end let watcher (state : chain_state) = @@ -959,7 +959,7 @@ let read_block { global_data } ?pred hash = | None -> Block.read_opt chain_state ?pred hash >>= function | None -> acc - | Some block -> Lwt.return (Some block)) + | Some block -> Lwt.return_some block) chains Lwt.return_none end @@ -1079,11 +1079,11 @@ module Protocol = struct Shared.use global_state.protocol_store begin fun store -> Store.Protocol.Contents.known store hash >>= fun known -> if known then - Lwt.return None + Lwt.return_none else Store.Protocol.RawContents.store (store, hash) bytes >>= fun () -> Lwt_watcher.notify global_state.protocol_watcher hash ; - Lwt.return (Some hash) + Lwt.return_some hash end let remove global_state hash = @@ -1113,8 +1113,7 @@ module Current_mempool = struct let set chain_state ~head mempool = update_chain_data chain_state begin fun _chain_data_store data -> if Block_hash.equal head (Block.hash data.current_head) then - Lwt.return (Some { data with current_mempool = mempool }, - ()) + Lwt.return (Some { data with current_mempool = mempool }, ()) else Lwt.return (None, ()) end diff --git a/src/lib_shell/worker.ml b/src/lib_shell/worker.ml index 6dff472c1..8e57161e4 100644 --- a/src/lib_shell/worker.ml +++ b/src/lib_shell/worker.ml @@ -181,7 +181,7 @@ module Make match w.timeout with | None -> Lwt_pipe.pop message_queue >>= fun m -> - return (Some m) + return_some m | Some timeout -> Lwt_pipe.pop_with_timeout (Lwt_unix.sleep timeout) message_queue >>= fun m -> @@ -193,7 +193,7 @@ module Make match w.timeout with | None -> Lwt_dropbox.take message_box >>= fun m -> - return (Some m) + return_some m | Some timeout -> Lwt_dropbox.take_with_timeout (Lwt_unix.sleep timeout) message_box >>= fun m -> diff --git a/src/lib_signer_backends/encrypted.ml b/src/lib_signer_backends/encrypted.ml index 2c8a8620c..405170a57 100644 --- a/src/lib_signer_backends/encrypted.ml +++ b/src/lib_signer_backends/encrypted.ml @@ -38,11 +38,11 @@ module Raw = struct let encrypted_sk = MBytes.sub encrypted_sk salt_len (len - salt_len) in let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~salt ~password) in match Crypto_box.Secretbox.box_open key encrypted_sk nonce with - | None -> return None + | None -> return_none | Some bytes -> match Data_encoding.Binary.of_bytes Signature.Secret_key.encoding bytes with | None -> failwith "Corrupted wallet, deciphered key is invalid" - | Some sk -> return (Some sk) + | Some sk -> return_some sk end @@ -69,11 +69,11 @@ let rec interactive_decrypt_loop return sk let rec noninteractice_decrypt_loop ~encrypted_sk = function - | [] -> return None + | [] -> return_none | password :: passwords -> Raw.decrypt ~password ~encrypted_sk >>=? function | None -> noninteractice_decrypt_loop ~encrypted_sk passwords - | Some sk -> return (Some sk) + | Some sk -> return_some sk let decrypt_payload cctxt ?name encrypted_sk = match Base58.safe_decode encrypted_sk with diff --git a/src/lib_signer_backends/http_gen.ml b/src/lib_signer_backends/http_gen.ml index 23d6e9a6e..5b0a08a97 100644 --- a/src/lib_signer_backends/http_gen.ml +++ b/src/lib_signer_backends/http_gen.ml @@ -98,8 +98,8 @@ module Make(N : sig val scheme : string end) = struct P.authenticate authorized_keys (Signer_messages.Sign.Request.to_sign ~pkh ~data:msg) >>=? fun signature -> - return (Some signature) - | None -> return None + return_some signature + | None -> return_none end >>=? fun signature -> RPC_client.call_service ~logger: P.logger diff --git a/src/lib_signer_backends/ledger.ml b/src/lib_signer_backends/ledger.ml index 2276fe35f..3c5907f37 100644 --- a/src/lib_signer_backends/ledger.ml +++ b/src/lib_signer_backends/ledger.ml @@ -103,17 +103,17 @@ module Ledger = struct (cur_pkh, (pk, curve)) :: of_pkh end (false, [], []) curves in match pkh with - | None -> return (Some (create ~device_info ~of_curve ~of_pkh)) + | None -> return_some (create ~device_info ~of_curve ~of_pkh) | Some _ when pkh_found -> - return (Some (create ~device_info ~of_curve ~of_pkh)) - | _ -> return None + return_some (create ~device_info ~of_curve ~of_pkh) + | _ -> return_none end let find_ledgers ?pkh () = let ledgers = Hidapi.enumerate ~vendor_id ~product_id () in filter_map_s begin fun device_info -> match Hidapi.(open_path device_info.path) with - | None -> return None + | None -> return_none | Some h -> Lwt.finalize (fun () -> Ledger.of_hidapi ?pkh device_info h) diff --git a/src/lib_signer_backends/remote.ml b/src/lib_signer_backends/remote.ml index 5ff1d0ab6..9abd1e60d 100644 --- a/src/lib_signer_backends/remote.ml +++ b/src/lib_signer_backends/remote.ml @@ -96,16 +96,16 @@ let read_base_uri_from_env () = Sys.getenv_opt "TEZOS_SIGNER_TCP_HOST", Sys.getenv_opt "TEZOS_SIGNER_HTTP_HOST", Sys.getenv_opt "TEZOS_SIGNER_HTTPS_HOST" with - | None, None, None, None -> return None + | None, None, None, None -> return_none | Some path, None, None, None -> - return (Some (Socket.make_unix_base path)) + return_some (Socket.make_unix_base path) | None, Some host, None, None -> begin try let port = match Sys.getenv_opt "TEZOS_SIGNER_TCP_PORT" with | None -> 7732 | Some port -> int_of_string port in - return (Some (Socket.make_tcp_base host port)) + return_some (Socket.make_tcp_base host port) with Invalid_argument _ -> failwith "Failed to parse TEZOS_SIGNER_TCP_PORT.@." end @@ -115,7 +115,7 @@ let read_base_uri_from_env () = match Sys.getenv_opt "TEZOS_SIGNER_HTTP_PORT" with | None -> 6732 | Some port -> int_of_string port in - return (Some (Http.make_base host port)) + return_some (Http.make_base host port) with Invalid_argument _ -> failwith "Failed to parse TEZOS_SIGNER_HTTP_PORT.@." end @@ -125,7 +125,7 @@ let read_base_uri_from_env () = match Sys.getenv_opt "TEZOS_SIGNER_HTTPS_PORT" with | None -> 443 | Some port -> int_of_string port in - return (Some (Https.make_base host port)) + return_some (Https.make_base host port) with Invalid_argument _ -> failwith "Failed to parse TEZOS_SIGNER_HTTPS_PORT.@." end diff --git a/src/lib_signer_backends/socket.ml b/src/lib_signer_backends/socket.ml index 452f9cdd1..37dc5bc79 100644 --- a/src/lib_signer_backends/socket.ml +++ b/src/lib_signer_backends/socket.ml @@ -32,11 +32,11 @@ module Make(P : sig Lwt.return authorized_keys >>=? fun authorized_keys -> Lwt_unix.close conn >>= fun () -> begin match authorized_keys with - | No_authentication -> return None + | No_authentication -> return_none | Authorized_keys authorized_keys -> P.authenticate authorized_keys (Sign.Request.to_sign ~pkh ~data:msg) >>=? fun signature -> - return (Some signature) + return_some signature end end >>=? fun signature -> let req = { Sign.Request.pkh ; data = msg ; signature } in diff --git a/src/lib_stdlib/lwt_dropbox.ml b/src/lib_stdlib/lwt_dropbox.ml index 5b16f7fa6..6b478c015 100644 --- a/src/lib_stdlib/lwt_dropbox.ml +++ b/src/lib_stdlib/lwt_dropbox.ml @@ -78,7 +78,7 @@ let rec take_with_timeout timeout dropbox = | Some elt -> Lwt.cancel timeout ; dropbox.data <- None ; - Lwt.return (Some elt) + Lwt.return_some elt | None -> if Lwt.is_sleeping timeout then if dropbox.closed then diff --git a/src/lib_stdlib_unix/lwt_lock_file.ml b/src/lib_stdlib_unix/lwt_lock_file.ml index 3db0ce5c5..30349f0ba 100644 --- a/src/lib_stdlib_unix/lwt_lock_file.ml +++ b/src/lib_stdlib_unix/lwt_lock_file.ml @@ -37,14 +37,14 @@ let blocking_create | Some duration -> with_timeout (Lwt_unix.sleep duration) (fun _ -> create ()) let is_locked fn = - if not @@ Sys.file_exists fn then return false else + if not @@ Sys.file_exists fn then return_false else protect begin fun () -> Lwt_unix.openfile fn [Unix.O_RDONLY] 0o644 >>= fun fd -> Lwt.finalize (fun () -> Lwt.try_bind (fun () -> Lwt_unix.(lockf fd F_TEST 0)) - (fun () -> return false) - (fun _ -> return true)) + (fun () -> return_false) + (fun _ -> return_true)) (fun () -> Lwt_unix.close fd) end diff --git a/src/lib_storage/context.ml b/src/lib_storage/context.ml index 0de5440bb..b6ed4eb20 100644 --- a/src/lib_storage/context.ml +++ b/src/lib_storage/context.ml @@ -102,7 +102,7 @@ let checkout index key = | Some commit -> GitStore.Commit.tree commit >>= fun tree -> let ctxt = { index ; tree ; parents = [commit] } in - Lwt.return (Some ctxt) + Lwt.return_some ctxt let checkout_exn index key = checkout index key >>= function diff --git a/src/lib_storage/store_helpers.ml b/src/lib_storage/store_helpers.ml index f465dc58a..b3107c7a6 100644 --- a/src/lib_storage/store_helpers.ml +++ b/src/lib_storage/store_helpers.ml @@ -201,7 +201,7 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct let read_opt s i = read s i >>= function | Error _ -> Lwt.return_none - | Ok v -> Lwt.return (Some v) + | Ok v -> Lwt.return_some v let read_exn s i = read s i >>= function | Error _ -> Lwt.fail Not_found @@ -305,7 +305,7 @@ module Make_map (S : STORE) (I : INDEX) (V : VALUE) = struct let read_opt s i = read s i >>= function | Error _ -> Lwt.return_none - | Ok v -> Lwt.return (Some v) + | Ok v -> Lwt.return_some v let read_exn s i = read s i >>= function | Error _ -> Lwt.fail Not_found diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index afe6f80d1..3c1484598 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -32,8 +32,8 @@ let transfer (cctxt : #Proto_alpha.full) begin match arg with | Some arg -> parse_expression arg >>=? fun { expanded = arg } -> - return (Some arg) - | None -> return None + return_some arg + | None -> return_none end >>=? fun parameters -> let parameters = Option.map ~f:Script.lazy_expr parameters in let contents = Transaction { amount ; parameters ; destination } in diff --git a/src/proto_alpha/lib_client/client_proto_contracts.ml b/src/proto_alpha/lib_client/client_proto_contracts.ml index a2b7fcbea..3d34436d7 100644 --- a/src/proto_alpha/lib_client/client_proto_contracts.ml +++ b/src/proto_alpha/lib_client/client_proto_contracts.ml @@ -45,8 +45,8 @@ module ContractAlias = struct match Contract.is_implicit c with | Some hash -> begin Client_keys.Public_key_hash.rev_find cctxt hash >>=? function - | Some name -> return (Some ("key:" ^ name)) - | None -> return None + | Some name -> return_some ("key:" ^ name) + | None -> return_none end | None -> RawContractAlias.rev_find cctxt c diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 22972df66..034ae6840 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -46,11 +46,11 @@ let preapply (type t) | _ -> Signature.Generic_operation in begin match src_sk with - | None -> return None + | None -> return_none | Some src_sk -> Client_keys.sign cctxt ~watermark src_sk bytes >>=? fun signature -> - return (Some signature) + return_some signature end >>=? fun signature -> let op : _ Operation.t = { shell = { branch } ; diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 00e6e459a..a4c5d9206 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -35,9 +35,9 @@ let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_conte ~show_source: (not no_print_source) ?parsed:None) errs >>= fun () -> cctxt#error "%s" msg >>= fun () -> - Lwt.return None + Lwt.return_none | Ok data -> - Lwt.return (Some data) + Lwt.return_some data let file_parameter = Clic.parameter (fun _ p -> diff --git a/src/proto_alpha/lib_delegate/client_baking_blocks.ml b/src/proto_alpha/lib_delegate/client_baking_blocks.ml index 5659d69e9..58ce84cad 100644 --- a/src/proto_alpha/lib_delegate/client_baking_blocks.ml +++ b/src/proto_alpha/lib_delegate/client_baking_blocks.ml @@ -66,7 +66,7 @@ let blocks_from_current_cycle cctxt ?(chain = `Main) block ?(offset = 0l) () = Alpha_services.Helpers.levels_in_current_cycle cctxt ~offset (chain, block) >>= function | Error [RPC_context.Not_found _] -> - return [] + return_nil | Error _ as err -> Lwt.return err | Ok (first, last) -> let length = Int32.to_int (Int32.sub level (Raw_level.to_int32 first)) in diff --git a/src/proto_alpha/lib_delegate/client_baking_endorsement.ml b/src/proto_alpha/lib_delegate/client_baking_endorsement.ml index 74cf3557d..f9e95e74a 100644 --- a/src/proto_alpha/lib_delegate/client_baking_endorsement.ml +++ b/src/proto_alpha/lib_delegate/client_baking_endorsement.ml @@ -19,8 +19,8 @@ let get_signing_slots cctxt ?(chain = `Main) block delegate level = ~levels:[level] ~delegates:[delegate] (chain, block) >>=? function - | [{ slots }] -> return (Some slots) - | _ -> return None + | [{ slots }] -> return_some slots + | _ -> return_none let inject_endorsement (cctxt : #Proto_alpha.full) @@ -48,7 +48,7 @@ let check_endorsement cctxt level pkh = let previously_endorsed_level cctxt pkh new_lvl = State.get cctxt pkh >>=? function - | None -> return false + | None -> return_false | Some last_lvl -> return (Raw_level.(last_lvl >= new_lvl)) @@ -128,7 +128,7 @@ let allowed_to_endorse cctxt bi delegate = | None | Some [] -> lwt_debug "No slot found for %a/%s" Block_hash.pp_short bi.hash name >>= fun () -> - return false + return_false | Some (_ :: _ as slots) -> lwt_debug "Found slots for %a/%s (%d)" Block_hash.pp_short bi.hash name (List.length slots) >>= fun () -> @@ -136,9 +136,9 @@ let allowed_to_endorse cctxt bi delegate = | true -> lwt_debug "Level %a (or higher) previously endorsed: do not endorse." Raw_level.pp level >>= fun () -> - return false + return_false | false -> - return true + return_true let prepare_endorsement ~(max_past:int64) () (cctxt : #Proto_alpha.full) state bi = if Time.diff (Time.now ()) bi.Client_baking_blocks.timestamp > max_past then diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index b66a8ed31..6de629b67 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -146,9 +146,9 @@ let sort_operations_by_fee ?(threshold = Tez.zero) (operations : Proto_alpha.ope (fun op -> get_operation_fee op >>=? fun fee -> if Tez.(<) fee threshold then - return None + return_none else - return (Some (op, fee))) + return_some (op, fee)) operations >>=? fun operations -> let compare_fee (_, fee1) (_, fee2) = (* NOTE: inverted fee comparison to invert the order of sort *) @@ -354,7 +354,7 @@ module State = Daemon_state.Make(struct let name = "block" end) let previously_baked_level cctxt pkh new_lvl = State.get cctxt pkh >>=? function - | None -> return false + | None -> return_false | Some last_lvl -> return (Raw_level.(last_lvl >= new_lvl)) @@ -371,11 +371,11 @@ let get_baking_slot cctxt | Error errs -> lwt_log_error "Error while fetching baking possibilities:\n%a" pp_print_error errs >>= fun () -> - Lwt.return [] + Lwt.return_nil | Ok [] -> lwt_log_info "Found no baking rights for level %a" Raw_level.pp level >>= fun () -> - Lwt.return [] + Lwt.return_nil | Ok slots -> let slots = List.filter_map @@ -419,12 +419,12 @@ let get_unrevealed_nonces cctxt block ~offset:(-1l) () >>=? fun blocks -> filter_map_s (fun hash -> Client_baking_nonces.find cctxt hash >>=? function - | None -> return None + | None -> return_none | Some nonce -> Alpha_block_services.metadata cctxt ~chain ~block:(`Hash (hash, 0)) () >>=? fun { protocol_data = { level } } -> if force then - return (Some (hash, (level.level, nonce))) + return_some (hash, (level.level, nonce)) else Alpha_services.Nonce.get cctxt (chain, block) level.level >>=? function @@ -433,13 +433,13 @@ let get_unrevealed_nonces cctxt#warning "Found nonce for %a (level: %a)@." Block_hash.pp_short hash Level.pp level >>= fun () -> - return (Some (hash, (level.level, nonce))) + return_some (hash, (level.level, nonce)) | Missing _nonce_hash -> cctxt#error "Incoherent nonce for level %a" Raw_level.pp level.level >>= fun () -> - return None - | Forgotten -> return None - | Revealed _ -> return None) + return_none + | Forgotten -> return_none + | Revealed _ -> return_none) blocks let safe_get_unrevealed_nonces cctxt block = @@ -447,7 +447,7 @@ let safe_get_unrevealed_nonces cctxt block = | Ok r -> Lwt.return r | Error err -> lwt_warn "Cannot read nonces: %a@." pp_print_error err >>= fun () -> - Lwt.return [] + Lwt.return_nil let insert_block ?max_priority @@ -521,8 +521,8 @@ let filter_invalid_operations (cctxt : #full) state block_info (operations : pac Operation_hash.pp (Operation.hash_packed op) pp_print_error errs >>= fun () -> - return None - | Ok inc -> return (Some inc) + return_none + | Ok inc -> return_some inc in let filter_valid_operations inc ops = fold_left_s (fun (inc, acc) op -> @@ -534,10 +534,10 @@ let filter_invalid_operations (cctxt : #full) state block_info (operations : pac (* Invalid endorsements are detected during block finalization *) let is_valid_endorsement inc endorsement = validate_operation inc endorsement >>=? function - | None -> return None + | None -> return_none | Some inc' -> finalize_construction inc' >>= begin function - | Ok _ -> return (Some endorsement) - | Error _ -> return None + | Ok _ -> return_some endorsement + | Error _ -> return_none end in filter_valid_operations initial_inc votes >>=? fun (inc, votes) -> @@ -613,7 +613,7 @@ let bake_slot lwt_log_error "Client-side validation: error while filtering invalid operations :@\n%a" pp_print_error errs >>= fun () -> - return None + return_none | Ok operations -> Alpha_block_services.Helpers.Preapply.block cctxt ~chain ~block @@ -623,7 +623,7 @@ let bake_slot lwt_log_error "Error while prevalidating operations:@\n%a" pp_print_error errs >>= fun () -> - return None + return_none | Ok (shell_header, operations) -> lwt_debug "Computed candidate block after %a (slot %d): %a/%d fitness: %a" diff --git a/src/proto_alpha/lib_delegate/client_baking_lib.ml b/src/proto_alpha/lib_delegate/client_baking_lib.ml index faf906f48..9d389128b 100644 --- a/src/proto_alpha/lib_delegate/client_baking_lib.ml +++ b/src/proto_alpha/lib_delegate/client_baking_lib.ml @@ -87,7 +87,7 @@ let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes = Lwt.catch (fun () -> Client_baking_blocks.info cctxt (`Hash (hash, 0)) >>= function - | Ok bi -> Lwt.return (Some bi) + | Ok bi -> Lwt.return_some bi | Error _ -> Lwt.fail Not_found) (fun _ -> @@ -101,9 +101,9 @@ let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes = | None -> cctxt#warning "Cannot find nonces for block %a (ignoring)@." Block_hash.pp_short bi.hash >>= fun () -> - return None + return_none | Some nonce -> - return (Some (bi.hash, (bi.level, nonce)))) + return_some (bi.hash, (bi.level, nonce))) block_infos >>=? fun blocks -> do_reveal cctxt cctxt#block blocks diff --git a/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml index 279e94025..6a0f11afd 100644 --- a/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml @@ -565,7 +565,7 @@ module Endorse = struct !rpc_ctxt ~delegates:[delegate] ~levels:[level] (`Main, block) >>=? function | [{ slots }] -> return slots - | _ -> return [] + | _ -> return_nil let endorse (contract : Account.t) @@ -606,7 +606,7 @@ module Endorse = struct ~delegates:[delegate] (`Main, block) >>=? function | [{ level ; slots }] -> return (List.map (fun s -> (level, s)) slots) - | _ -> return [] + | _ -> return_nil end diff --git a/src/proto_alpha/lib_protocol/src/baking.ml b/src/proto_alpha/lib_protocol/src/baking.ml index c4d5b5910..fe9e6c907 100644 --- a/src/proto_alpha/lib_protocol/src/baking.ml +++ b/src/proto_alpha/lib_protocol/src/baking.ml @@ -275,6 +275,6 @@ let last_of_a_cycle ctxt l = let dawn_of_a_new_cycle ctxt = let level = Level.current ctxt in if last_of_a_cycle ctxt level then - return (Some level.cycle) + return_some level.cycle else - return None + return_none diff --git a/src/proto_alpha/lib_protocol/src/contract_services.ml b/src/proto_alpha/lib_protocol/src/contract_services.ml index 453a13875..eb7c85d9f 100644 --- a/src/proto_alpha/lib_protocol/src/contract_services.ml +++ b/src/proto_alpha/lib_protocol/src/contract_services.ml @@ -163,14 +163,14 @@ let register () = register_opt_field S.storage (fun ctxt contract -> Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with - | None -> return None + | None -> return_none | Some script -> let ctxt = Gas.set_unlimited ctxt in let open Script_ir_translator in parse_script ctxt script >>=? fun (Ex_script script, ctxt) -> unparse_script ctxt Readable script >>=? fun (script, _ctxt) -> Lwt.return (Script.force_decode script.storage) >>=? fun storage -> - return (Some storage)) ; + return_some storage) ; register_field S.info (fun ctxt contract -> Contract.get_balance ctxt contract >>=? fun balance -> Contract.get_manager ctxt contract >>=? fun manager -> diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index 2af9e8dec..adf9bc27e 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -275,12 +275,12 @@ let delete c contract = let allocated c contract = Storage.Contract.Counter.get_option c contract >>=? function - | None -> return false - | Some _ -> return true + | None -> return_false + | Some _ -> return_true let exists c contract = match Contract_repr.is_implicit contract with - | Some _ -> return true + | Some _ -> return_true | None -> allocated c contract let must_exist c contract = @@ -307,8 +307,8 @@ let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until = Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until -> filter_map_s (fun contract -> exists ctxt_until contract >>=? function - | true -> return (Some contract) - | false -> return None) + | true -> return_some contract + | false -> return_none) (Contract_repr.originated_contracts ~since ~until) let check_counter_increment c contract counter = @@ -369,9 +369,9 @@ let get_manager_key c contract = let is_manager_key_revealed c contract = Storage.Contract.Manager.get_option c contract >>=? function - | None -> return false - | Some (Manager_repr.Hash _) -> return false - | Some (Manager_repr.Public_key _) -> return true + | None -> return_false + | Some (Manager_repr.Hash _) -> return_false + | Some (Manager_repr.Public_key _) -> return_true let reveal_manager_key c contract public_key = Storage.Contract.Manager.get c contract >>=? function @@ -396,7 +396,7 @@ let get_balance c contract = let is_delegatable = Delegate_storage.is_delegatable let is_spendable c contract = match Contract_repr.is_implicit contract with - | Some _ -> return true + | Some _ -> return_true | None -> Storage.Contract.Spendable.mem c contract >>= return diff --git a/src/proto_alpha/lib_protocol/src/delegate_services.ml b/src/proto_alpha/lib_protocol/src/delegate_services.ml index 780b92484..a41ad4705 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_services.ml +++ b/src/proto_alpha/lib_protocol/src/delegate_services.ml @@ -175,7 +175,7 @@ let register () = (fun pkh -> Delegate.deactivated ctxt pkh) delegates >>= return else - return [] + return_nil end ; register1 S.info begin fun ctxt pkh () () -> Delegate.full_balance ctxt pkh >>=? fun balance -> @@ -354,10 +354,10 @@ module Baking_rights = struct let delegate = Signature.Public_key.hash pk in begin match pred_timestamp with - | None -> return None + | None -> return_none | Some pred_timestamp -> Baking.minimal_time ctxt priority pred_timestamp >>=? fun t -> - return (Some t) + return_some t end>>=? fun timestamp -> let acc = { level = level.level ; delegate ; priority ; timestamp } :: acc in diff --git a/src/proto_alpha/lib_protocol/src/delegate_storage.ml b/src/proto_alpha/lib_protocol/src/delegate_storage.ml index c71adb5b0..6de896ace 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/src/delegate_storage.ml @@ -116,7 +116,7 @@ let () = let is_delegatable c contract = match Contract_repr.is_implicit contract with | Some _ -> - return false + return_false | None -> Storage.Contract.Delegatable.mem c contract >>= return @@ -144,8 +144,8 @@ let unlink c contract balance = let known c delegate = Storage.Contract.Manager.get_option c (Contract_repr.implicit_contract delegate) >>=? function - | None | Some (Manager_repr.Hash _) -> return false - | Some (Manager_repr.Public_key _) -> return true + | None | Some (Manager_repr.Hash _) -> return_false + | Some (Manager_repr.Public_key _) -> return_true (* A delegate is registered if its "implicit account" delegates to itself. *) @@ -223,7 +223,7 @@ let set c contract delegate = set_base c is_delegatable contract delegate let set_from_script c contract delegate = - set_base c (fun _ _ -> return true) contract delegate + set_base c (fun _ _ -> return_true) contract delegate let remove ctxt contract = Storage.Contract.Balance.get ctxt contract >>=? fun balance -> @@ -386,10 +386,10 @@ let punish ctxt delegate cycle = let has_frozen_balance ctxt delegate cycle = let contract = Contract_repr.implicit_contract delegate in get_frozen_deposit ctxt contract cycle >>=? fun deposit -> - if Tez_repr.(deposit <> zero) then return true + if Tez_repr.(deposit <> zero) then return_true else get_frozen_fees ctxt contract cycle >>=? fun fees -> - if Tez_repr.(fees <> zero) then return true + if Tez_repr.(fees <> zero) then return_true else get_frozen_rewards ctxt contract cycle >>=? fun rewards -> return Tez_repr.(rewards <> zero) diff --git a/src/proto_alpha/lib_protocol/src/roll_storage.ml b/src/proto_alpha/lib_protocol/src/roll_storage.ml index f5b74c902..1c7fc095b 100644 --- a/src/proto_alpha/lib_protocol/src/roll_storage.ml +++ b/src/proto_alpha/lib_protocol/src/roll_storage.ml @@ -175,7 +175,7 @@ let traverse_rolls ctxt head = let get_rolls ctxt delegate = Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function - | None -> return [] + | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll let get_change c delegate = diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index f5972a3ad..b8d4332fe 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -96,7 +96,7 @@ let unparse_stack ctxt (stack, stack_ty) = let rec unparse_stack : type a. a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t = function - | Empty, Empty_t -> return [] + | Empty, Empty_t -> return_nil | Item (v, rest), Item_t (ty, rest_ty, annot) -> unparse_data ctxt Readable ty v >>=? fun (data, _ctxt) -> unparse_stack (rest, rest_ty) >>=? fun rest -> diff --git a/src/proto_alpha/lib_protocol/src/storage_description.ml b/src/proto_alpha/lib_protocol/src/storage_description.ml index df46401e4..d16b740f3 100644 --- a/src/proto_alpha/lib_protocol/src/storage_description.ml +++ b/src/proto_alpha/lib_protocol/src/storage_description.ml @@ -216,13 +216,13 @@ let build_directory : type key. key t -> key RPC_directory.t = fun dir path -> match !dir with | Empty -> Opt_handler { encoding = Data_encoding.unit ; - get = fun _ _ -> return None } + get = fun _ _ -> return_none } | Value { get ; encoding } -> let handler = Opt_handler { encoding ; get = - fun k i -> if Compare.Int.(i < 0) then return None else get k + fun k i -> if Compare.Int.(i < 0) then return_none else get k } in register path handler ; handler @@ -239,10 +239,10 @@ let build_directory : type key. key t -> key RPC_directory.t = { encoding = handler.encoding ; get = fun k i -> if Compare.Int.(i < 0) then - return None + return_none else handler.get k (i-1) >>=? fun v -> - return (Some v) } in + return_some v } in register path handler ; handler | IndexedDir { arg ; arg_encoding ; list ; subdir } -> @@ -265,8 +265,8 @@ let build_directory : type key. key t -> key RPC_directory.t = (fun (key, value) -> (key, Some value)) ; ] in let get k i = - if Compare.Int.(i < 0) then return None - else if Compare.Int.(i = 0) then return (Some []) + if Compare.Int.(i < 0) then return_none + else if Compare.Int.(i = 0) then return_some [] else list k >>=? fun keys -> map_p @@ -277,7 +277,7 @@ let build_directory : type key. key t -> key RPC_directory.t = handler.get (k, key) (i-1) >>=? fun value -> return (key, value)) keys >>=? fun values -> - return (Some values) in + return_some values in let handler = Opt_handler { encoding = Data_encoding.(list (dynamic_size encoding)) ; diff --git a/src/proto_alpha/lib_protocol/src/storage_functors.ml b/src/proto_alpha/lib_protocol/src/storage_functors.ml index decad07ed..3b5302bd3 100644 --- a/src/proto_alpha/lib_protocol/src/storage_functors.ml +++ b/src/proto_alpha/lib_protocol/src/storage_functors.ml @@ -85,11 +85,11 @@ module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE) Lwt.return (of_bytes ~key b) let get_option t = C.get_option t N.name >>= function - | None -> return None + | None -> return_none | Some b -> let key = C.absolute_key t N.name in match of_bytes ~key b with - | Ok v -> return (Some v) + | Ok v -> return_some v | Error _ as err -> Lwt.return err let init t v = C.init t N.name (to_bytes v) >>=? fun t -> @@ -200,8 +200,8 @@ module Make_data_set_storage (C : Raw_context.T) (I : INDEX) ~get:(fun c -> let (c, k) = unpack c in mem c k >>= function - | true -> return (Some true) - | false -> return None) + | true -> return_some true + | false -> return_none) (register_indexed_subcontext ~list:(fun c -> elements c >>= return) C.description I.args) @@ -227,11 +227,11 @@ module Make_indexed_data_storage Lwt.return (of_bytes ~key b) let get_option s i = C.get_option s (I.to_path i []) >>= function - | None -> return None + | None -> return_none | Some b -> let key = C.absolute_key s (I.to_path i []) in match of_bytes ~key b with - | Ok v -> return (Some v) + | Ok v -> return_some v | Error _ as err -> Lwt.return err let set s i v = C.set s (I.to_path i []) (to_bytes v) >>=? fun t -> @@ -634,8 +634,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) ~get:(fun c -> let (c, k) = unpack c in mem c k >>= function - | true -> return (Some true) - | false -> return None) + | true -> return_some true + | false -> return_none) (register_named_subcontext Raw_context.description N.name) Data_encoding.bool @@ -655,11 +655,11 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) Lwt.return (of_bytes ~key b) let get_option s i = Raw_context.get_option (pack s i) N.name >>= function - | None -> return None + | None -> return_none | Some b -> let key = Raw_context.absolute_key (pack s i) N.name in match of_bytes ~key b with - | Ok v -> return (Some v) + | Ok v -> return_some v | Error _ as err -> Lwt.return err let set s i v = Raw_context.set (pack s i) N.name (to_bytes v) >>=? fun c -> diff --git a/src/proto_alpha/lib_protocol/test/rolls.ml b/src/proto_alpha/lib_protocol/test/rolls.ml index 2cd899e8e..1404b2e37 100644 --- a/src/proto_alpha/lib_protocol/test/rolls.ml +++ b/src/proto_alpha/lib_protocol/test/rolls.ml @@ -24,7 +24,7 @@ let traverse_rolls ctxt head = let get_rolls ctxt delegate = Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>= wrap >>=? function - | None -> return [] + | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll let check_rolls b (account:Account.t) = diff --git a/src/proto_genesis/lib_protocol/src/main.ml b/src/proto_genesis/lib_protocol/src/main.ml index 0ed017a09..b2add7d17 100644 --- a/src/proto_genesis/lib_protocol/src/main.ml +++ b/src/proto_genesis/lib_protocol/src/main.ml @@ -168,12 +168,12 @@ let rpc_services = Services.rpc_services let sandbox_param_key = [ "sandbox_parameter" ] let get_sandbox_param ctxt = Context.get ctxt sandbox_param_key >>= function - | None -> return None + | None -> return_none | Some bytes -> match Data_encoding.Binary.of_bytes Data_encoding.json bytes with | None -> failwith "Internal error: failed to parse the sandbox parameter." - | Some json -> return (Some json) + | Some json -> return_some json let init ctxt block_header = Data.Init.tag_first_block ctxt >>=? fun ctxt ->