diff --git a/src/bin_attacker/attacker_minimal.ml b/src/bin_attacker/attacker_minimal.ml index cdca9ba6a..18b8ba20c 100644 --- a/src/bin_attacker/attacker_minimal.ml +++ b/src/bin_attacker/attacker_minimal.ml @@ -123,7 +123,7 @@ let try_action addr port action = | Ok conn -> action conn >>=? fun () -> P2p_connection.close conn >>= fun () -> - return () + return_unit let replicate n x = let rec replicate_acc acc n x = @@ -226,7 +226,7 @@ let long_chain n conn = let prev_ref = ref genesis_block_hashed in let rec loop k = if k < 1 then - return () + return_unit else let block = signed (block_forged ~prev:!prev_ref []) in prev_ref := Block_hash.hash_bytes [block] ; @@ -238,7 +238,7 @@ let lots_transactions amount fee n conn = let signed_op = signed (tx_forged amount fee) in let rec loop k = if k < 1 then - return () + return_unit else send conn (Operation signed_op) >>=? fun () -> loop (k-1) in diff --git a/src/bin_client/client_protocols_commands.ml b/src/bin_client/client_protocols_commands.ml index fb35f84ee..d84d81f82 100644 --- a/src/bin_client/client_protocols_commands.ml +++ b/src/bin_client/client_protocols_commands.ml @@ -27,7 +27,7 @@ let commands () = (fun () (cctxt : #Client_context.full) -> Shell_services.Protocol.list cctxt >>=? fun protos -> Lwt_list.iter_s (fun ph -> cctxt#message "%a" Protocol_hash.pp ph) protos >>= fun () -> - return () + return_unit ); command ~group ~desc: "Inject a new protocol into the node." @@ -42,15 +42,15 @@ let commands () = Shell_services.Injection.protocol cctxt proto >>= function | Ok hash -> cctxt#message "Injected protocol %a successfully" Protocol_hash.pp_short hash >>= fun () -> - return () + return_unit | Error err -> cctxt#error "Error while injecting protocol from %s: %a" dirname Error_monad.pp_print_error err >>= fun () -> - return ()) + return_unit) (fun exn -> cctxt#error "Error while injecting protocol from %s: %a" dirname Error_monad.pp_print_error [Error_monad.Exn exn] >>= fun () -> - return ()) + return_unit) ); command ~group ~desc: "Dump a protocol from the node's record of protocol." @@ -62,6 +62,6 @@ let commands () = Shell_services.Protocol.contents cctxt ph >>=? fun proto -> Lwt_utils_unix.Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>=? fun () -> cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () -> - return () + return_unit ) ; ] diff --git a/src/bin_client/client_rpc_commands.ml b/src/bin_client/client_rpc_commands.ml index 4987ef6ae..05fad70ac 100644 --- a/src/bin_client/client_rpc_commands.ml +++ b/src/bin_client/client_rpc_commands.ml @@ -106,7 +106,7 @@ let fill_in ?(show_optionals=true) input schema = element [] (Json_schema.root schema) let random_fill_in ?(show_optionals=true) schema = - let display _ = Lwt.return () in + let display _ = Lwt.return_unit in let int min max _ _ = let max = Int64.of_int max and min = Int64.of_int min in @@ -286,8 +286,8 @@ let list url (cctxt : #Client_context.full) = if !collected_args <> [] then begin cctxt#message "@,@[Dynamic parameter description:@ @ %a@]@." (Format.pp_print_list display_arg) !collected_args >>= fun () -> - return () - end else return () + return_unit + end else return_unit let schema meth url (cctxt : #Client_context.full) = @@ -299,21 +299,21 @@ let schema meth url (cctxt : #Client_context.full) = | exception Not_found -> cctxt#message "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> - return () + return_unit | { input = Some input ; output } -> let json = `O [ "input", Json_schema.to_json (fst input) ; "output", Json_schema.to_json (fst output) ] in cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () -> - return () + return_unit | { input = None ; output } -> let json = `O [ "output", Json_schema.to_json (fst output) ] in cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () -> - return () + return_unit end | _ -> cctxt#message "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> - return () + return_unit let format binary meth url (cctxt : #Client_context.io_rpcs) = let args = String.split '/' url in @@ -329,7 +329,7 @@ let format binary meth url (cctxt : #Client_context.io_rpcs) = | exception Not_found -> cctxt#message "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> - return () + return_unit | { input = Some input ; output } -> cctxt#message "@[\ @@ -338,19 +338,19 @@ let format binary meth url (cctxt : #Client_context.io_rpcs) = @]" pp input pp output >>= fun () -> - return () + return_unit | { input = None ; output } -> cctxt#message "@[\ @[Output format:@,%a@]@,\ @]" pp output >>= fun () -> - return () + return_unit end | _ -> cctxt#message "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> - return () + return_unit let fill_in ?(show_optionals=true) schema = let open Json_schema in @@ -363,13 +363,13 @@ let display_answer (cctxt : #Client_context.full) = function | `Ok json -> cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () -> - return () + return_unit | `Not_found _ -> cctxt#message "No service found at this URL\n%!" >>= fun () -> - return () + return_unit | `Unauthorized _ | `Error _ | `Forbidden _ | `Conflict _ -> cctxt#message "Unexpected server answer\n%!" >>= fun () -> - return () + return_unit let call meth raw_url (cctxt : #Client_context.full) = let uri = Uri.of_string raw_url in @@ -381,7 +381,7 @@ let call meth raw_url (cctxt : #Client_context.full) = cctxt#message "No service found at this URL with this method \ (but this is a valid prefix)\n%!" >>= fun () -> - return () + return_unit | { input = None } -> cctxt#generic_json_call meth uri >>=? display_answer cctxt @@ -389,14 +389,14 @@ let call meth raw_url (cctxt : #Client_context.full) = fill_in ~show_optionals:false (fst input) >>= function | Error msg -> cctxt#error "%s" msg >>= fun () -> - return () + return_unit | Ok json -> cctxt#generic_json_call meth ~body:json uri >>=? display_answer cctxt end | _ -> cctxt#message "No service found at this URL\n%!" >>= fun () -> - return () + return_unit let call_with_json meth raw_url json (cctxt: #Client_context.full) = let uri = Uri.of_string raw_url in diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml index 8f622966e..0a19d64e3 100644 --- a/src/bin_client/main_client.ml +++ b/src/bin_client/main_client.ml @@ -19,7 +19,7 @@ let display_warning_banner ctxt = \ Use your fundraiser keys @{AT YOUR OWN RISK@}.@,\ All transactions happening on the Betanet @{are expected to be valid in the Mainnet@}.@,\ \ In doubt, we recommend that you wait for the lunch of the Mainnet.@]@\n@." ; - Lwt.return () in + Lwt.return_unit in Shell_services.P2p.versions ctxt >>= function | Error _ -> default () | Ok versions -> @@ -34,7 +34,7 @@ let display_warning_banner ctxt = \ @{Tezos Zeronet DEVELOPMENT NETWORK@}.@,\ \ Do @{NOT@} use your fundraiser keys on this network.@,\ Zeronet is a testing network, with free tokens and frequent resets.@]@\n@." ; - Lwt.return () + Lwt.return_unit | "TEZOS" :: "ALPHANET" :: _date :: [] -> Format.eprintf "@[@{@{Warning@}@}@,@,\ @@ -45,7 +45,7 @@ let display_warning_banner ctxt = \ @{<warning>Tezos Alphanet DEVELOPMENT NETWORK.@}@,\ \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ \ Alphanet is a testing network, with free tokens.@]@\n@." ; - Lwt.return () + Lwt.return_unit | "TEZOS" :: "BETANET" :: _date :: [] -> Format.eprintf "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ @@ -58,7 +58,7 @@ let display_warning_banner ctxt = \ Use your fundraiser keys on this network @{<warning>AT YOUR OWN RISK@}.@,\ \ All transactions happening on the Betanet @{<warning>are expected to be valid in the Mainnet@}.@,\ \ If in doubt, we recommend that you wait for the Mainnet lunch.@]@\n@." ; - Lwt.return () + Lwt.return_unit | "TEZOS" :: _date :: [] -> Format.eprintf "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\ @@ -69,7 +69,7 @@ let display_warning_banner ctxt = \ @{<warning>Tezos TEST SANDBOX@}.@,\ \ Do @{<warning>NOT@} use your fundraiser keys on this network.@,\ You should not see this message if you are not a developer.@]@\n@." ; - Lwt.return () + Lwt.return_unit | _ -> default () let get_commands_for_version ctxt block protocol = diff --git a/src/bin_client/test/demo/main.ml b/src/bin_client/test/demo/main.ml index c4ef9fb5a..9ab66cbc9 100644 --- a/src/bin_client/test/demo/main.ml +++ b/src/bin_client/test/demo/main.ml @@ -83,7 +83,7 @@ let precheck_block ~ancestor_timestamp:_ (raw_block: block_header) = Fitness.to_int64 raw_block.shell.fitness >>=? fun _ -> - return () + return_unit let begin_application ~predecessor_context:context diff --git a/src/bin_node/node_config_command.ml b/src/bin_node/node_config_command.ml index 2dc87f128..289f18765 100644 --- a/src/bin_node/node_config_command.ml +++ b/src/bin_node/node_config_command.ml @@ -19,7 +19,7 @@ let show (args : Node_shared_arg.t) = Node_shared_arg.read_and_patch_config_file args >>=? fun cfg -> Node_config_file.check cfg >>= fun () -> print_endline @@ Node_config_file.to_string cfg ; - return () + return_unit let reset (args : Node_shared_arg.t) = if Sys.file_exists args.config_file then diff --git a/src/bin_node/node_data_version.ml b/src/bin_node/node_data_version.ml index 078cee603..f0bcfa4e3 100644 --- a/src/bin_node/node_data_version.ml +++ b/src/bin_node/node_data_version.ml @@ -100,7 +100,7 @@ let check_data_dir_version data_dir = fail_unless (String.equal data_version version) (Invalid_data_dir_version (data_version, version)) >>=? fun () -> - return () + return_unit let ensure_data_dir data_dir = let write_version () = diff --git a/src/bin_node/node_identity_command.ml b/src/bin_node/node_identity_command.ml index d9034cd8f..a38b4923f 100644 --- a/src/bin_node/node_identity_command.ml +++ b/src/bin_node/node_identity_command.ml @@ -16,7 +16,7 @@ let identity_file data_dir = data_dir // Node_data_version.default_identity_file let show { Node_config_file.data_dir } = Node_identity_file.read (identity_file data_dir) >>=? fun id -> Format.printf "Peer_id: %a.@." P2p_peer.Id.pp id.peer_id ; - return () + return_unit let generate { Node_config_file.data_dir ; p2p } = let identity_file = identity_file data_dir in @@ -31,7 +31,7 @@ let generate { Node_config_file.data_dir ; p2p } = Format.eprintf "Stored the new identity (%a) into '%s'.@." P2p_peer.Id.pp id.peer_id identity_file ; - return () + return_unit let check { Node_config_file.data_dir ; p2p = { expected_pow } } = Node_identity_file.read @@ -39,7 +39,7 @@ let check { Node_config_file.data_dir ; p2p = { expected_pow } } = Format.printf "Peer_id: %a. Proof of work is higher than %.2f.@." P2p_peer.Id.pp id.peer_id expected_pow ; - return () + return_unit (** Main *) diff --git a/src/bin_node/node_run_command.ml b/src/bin_node/node_run_command.ml index 9cff5bae0..59df1198c 100644 --- a/src/bin_node/node_run_command.ml +++ b/src/bin_node/node_run_command.ml @@ -261,7 +261,7 @@ let run ?verbosity ?sandbox ?checkpoint (config : Node_config_file.t) = Lwt_utils.may ~f:RPC_server.shutdown rpc >>= fun () -> lwt_log_notice "BYE (%d)" x >>= fun () -> Logging_unix.close () >>= fun () -> - return () + return_unit let process sandbox verbosity checkpoint args = let verbosity = @@ -279,8 +279,8 @@ let process sandbox verbosity checkpoint args = | Some _ -> if config.data_dir = Node_config_file.default_data_dir then failwith "Cannot use default data directory while in sandbox mode" - else return () - | None -> return () + else return_unit + | None -> return_unit end >>=? fun () -> begin match checkpoint with diff --git a/src/bin_signer/handler.ml b/src/bin_signer/handler.ml index 246fe5e25..ede757e9c 100644 --- a/src/bin_signer/handler.ml +++ b/src/bin_signer/handler.ml @@ -19,12 +19,12 @@ module Authorized_key = let check_magic_byte magic_bytes data = match magic_bytes with - | None -> return () + | None -> return_unit | Some magic_bytes -> let byte = MBytes.get_uint8 data 0 in if MBytes.length data > 1 && (List.mem byte magic_bytes) then - return () + return_unit else failwith "magic byte 0x%02X not allowed" byte @@ -38,7 +38,7 @@ let sign (MBytes.get_uint8 data 0) >>= fun () -> check_magic_byte magic_bytes data >>=? fun () -> begin match require_auth, signature with - | false, _ -> return () + | false, _ -> return_unit | true, None -> failwith "missing authentication signature field" | true, Some signature -> let to_sign = Signer_messages.Sign.Request.to_sign ~pkh ~data in @@ -47,7 +47,7 @@ let sign (fun acc (_, key) -> acc || Signature.check key signature to_sign) false keys then - return () + return_unit else failwith "invalid authentication signature" end >>=? fun () -> diff --git a/src/bin_signer/main_signer.ml b/src/bin_signer/main_signer.ml index f98afeb43..7adace05f 100644 --- a/src/bin_signer/main_signer.ml +++ b/src/bin_signer/main_signer.ml @@ -282,7 +282,7 @@ let main () = ~global_options:(global_options ()) commands cctxt >>=? fun completions -> List.iter print_endline completions ; - return () + return_unit | None -> Clic.dispatch commands cctxt remaining end diff --git a/src/bin_signer/socket_daemon.ml b/src/bin_signer/socket_daemon.ml index ba61a80b0..6c8ebc570 100644 --- a/src/bin_signer/socket_daemon.ml +++ b/src/bin_signer/socket_daemon.ml @@ -22,13 +22,13 @@ let run (cctxt : #Client_context.wallet) path ?magic_bytes ~require_auth = Handler.sign cctxt req ?magic_bytes ~require_auth >>= fun res -> Lwt_utils_unix.Socket.send fd encoding res >>= fun _ -> Lwt_unix.close fd >>= fun () -> - return () + return_unit | Public_key pkh -> let encoding = result_encoding Public_key.Response.encoding in Handler.public_key cctxt pkh >>= fun res -> Lwt_utils_unix.Socket.send fd encoding res >>= fun _ -> Lwt_unix.close fd >>= fun () -> - return () + return_unit | Authorized_keys -> let encoding = result_encoding Authorized_keys.Response.encoding in begin if require_auth then @@ -39,7 +39,7 @@ let run (cctxt : #Client_context.wallet) path ?magic_bytes ~require_auth = end >>= fun res -> Lwt_utils_unix.Socket.send fd encoding res >>= fun _ -> Lwt_unix.close fd >>= fun () -> - return () + return_unit end ; loop () in diff --git a/src/lib_clic/clic.ml b/src/lib_clic/clic.ml index 8d32ae74f..5ef9e6307 100644 --- a/src/lib_clic/clic.ml +++ b/src/lib_clic/clic.ml @@ -607,7 +607,7 @@ let rec parse_args : type a ctx. ?command:_ command -> (a, ctx) args -> string list TzString.Map.t -> ctx -> a tzresult Lwt.t = fun ?command spec args_dict ctx -> match spec with - | NoArgs -> return () + | NoArgs -> return_unit | AddArg (arg, rest) -> parse_arg ?command arg args_dict ctx >>=? fun arg -> parse_args ?command rest args_dict ctx >>|? fun rest -> @@ -637,7 +637,7 @@ type error += Help : 'a command option -> error let check_help_flag ?command = function | ("-help" | "--help") :: _ -> fail (Help command) - | _ -> return () + | _ -> return_unit let add_occurrence long value acc = try TzString.Map.add long (TzString.Map.find long acc) acc @@ -1196,7 +1196,7 @@ let add_manual ~executable_name ~global_options format ppf commands = let commands = List.map (fun c -> Ex c) commands in usage_internal ppf ~executable_name ~global_options ~highlights:keywords commands ; restore_formatter ppf state ; - return ()) ]) in + return_unit) ]) in Lazy.force with_manual let pp_cli_errors ppf ~executable_name ~global_options ~default errs = diff --git a/src/lib_client_base/client_aliases.ml b/src/lib_client_base/client_aliases.ml index 116ffc87c..5a7225154 100644 --- a/src/lib_client_base/client_aliases.ml +++ b/src/lib_client_base/client_aliases.ml @@ -138,12 +138,12 @@ module Alias = functor (Entity : Entity) -> struct load wallet >>=? fun list -> begin if force then - return () + return_unit else iter_s (fun (n, v) -> if n = name && v = value then begin keep := true ; - return () + return_unit end else if n = name && v <> value then begin failwith "another %s is already aliased as %s, \ @@ -155,14 +155,14 @@ module Alias = functor (Entity : Entity) -> struct use --force to insert duplicate" Entity.name n end else begin - return () + return_unit end) list end >>=? fun () -> let list = List.filter (fun (n, _) -> n <> name) list in let list = (name, value) :: list in if !keep then - return () + return_unit else wallet#write Entity.name list wallet_encoding @@ -199,7 +199,7 @@ module Alias = functor (Entity : Entity) -> struct let of_fresh (wallet : #wallet) force (Fresh s) = load wallet >>=? fun list -> begin if force then - return () + return_unit else iter_s (fun (n, v) -> @@ -212,7 +212,7 @@ module Alias = functor (Entity : Entity) -> struct Entity.name n value else - return ()) + return_unit) list end >>=? fun () -> return s diff --git a/src/lib_client_base/client_confirmations.ml b/src/lib_client_base/client_confirmations.ml index c691c3af9..c26e24951 100644 --- a/src/lib_client_base/client_confirmations.ml +++ b/src/lib_client_base/client_confirmations.ml @@ -14,9 +14,9 @@ let wait_for_bootstrapped (ctxt : #Client_context.full) = if not !display then ctxt#answer "Waiting for the node to be bootstrapped before injection..." >>= fun () -> display := true ; - Lwt.return () + Lwt.return_unit else - Lwt.return () + Lwt.return_unit end ; Monitor_services.bootstrapped ctxt >>=? fun (stream, _stop) -> Lwt_stream.iter_s @@ -26,10 +26,10 @@ let wait_for_bootstrapped (ctxt : #Client_context.full) = Block_hash.pp_short hash Time.pp_hum time Time.pp_hum (Time.now ()) - else Lwt.return ()) stream >>= fun () -> + else Lwt.return_unit) stream >>= fun () -> display := true ; ctxt#answer "Node is bootstrapped, ready for injecting operations." >>= fun () -> - return () + return_unit let wait_for_operation_inclusion (ctxt : #Client_context.full) diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml index 4e5ffd684..54459dc11 100644 --- a/src/lib_client_base/client_keys.ml +++ b/src/lib_client_base/client_keys.ml @@ -210,7 +210,7 @@ let register_key cctxt ?(force=false) (public_key_hash, pk_uri, sk_uri) ?public_ Public_key.add ~force cctxt name (pk_uri, public_key) >>=? fun () -> Secret_key.add ~force cctxt name sk_uri >>=? fun () -> Public_key_hash.add ~force cctxt name public_key_hash >>=? fun () -> - return () + return_unit let raw_get_key (cctxt : #Client_context.wallet) pkh = begin diff --git a/src/lib_client_base_unix/client_context_unix.ml b/src/lib_client_base_unix/client_context_unix.ml index bc4171d68..318820f75 100644 --- a/src/lib_client_base_unix/client_context_unix.ml +++ b/src/lib_client_base_unix/client_context_unix.ml @@ -91,10 +91,10 @@ class unix_logger ~base_dir = let log channel msg = match channel with | "stdout" -> print_endline msg ; - Lwt.return () + Lwt.return_unit | "stderr" -> prerr_endline msg ; - Lwt.return () + Lwt.return_unit | log -> let (//) = Filename.concat in Lwt_utils_unix.create_dir (base_dir // "logs" // log) >>= fun () -> diff --git a/src/lib_client_base_unix/client_main_run.ml b/src/lib_client_base_unix/client_main_run.ml index b3cfe3f2b..edc464e6c 100644 --- a/src/lib_client_base_unix/client_main_run.ml +++ b/src/lib_client_base_unix/client_main_run.ml @@ -22,7 +22,7 @@ let builtin_commands = Lwt_list.iter_s (fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver) (Client_commands.get_versions ()) >>= fun () -> - return ()) ; + return_unit) ; ] (* Duplicated from the node, here for now since the client still @@ -156,7 +156,7 @@ let main select_commands = ~script ~cur_arg ~prev_arg ~args:original_args ~global_options commands client_config >>=? fun completions -> List.iter print_endline completions ; - return () + return_unit | None -> Clic.dispatch commands client_config remaining end diff --git a/src/lib_client_commands/client_admin_commands.ml b/src/lib_client_commands/client_admin_commands.ml index 627a3b52a..e401ddf0b 100644 --- a/src/lib_client_commands/client_admin_commands.ml +++ b/src/lib_client_commands/client_admin_commands.ml @@ -24,6 +24,6 @@ let commands () = cctxt#message "Block %a no longer marked invalid." Block_hash.pp block >>= fun () -> - return ()) + return_unit) blocks) ; ] diff --git a/src/lib_client_commands/client_helpers_commands.ml b/src/lib_client_commands/client_helpers_commands.ml index a98422656..597bd7d88 100644 --- a/src/lib_client_commands/client_helpers_commands.ml +++ b/src/lib_client_commands/client_helpers_commands.ml @@ -33,7 +33,7 @@ let commands () = Clic.[ | _ :: _ :: _ when unique -> Pervasives.exit 3 | completions -> List.iter print_endline completions ; - return ()) ; + return_unit) ; command ~desc: "Wait for the node to be bootstrapped." no_options @@ -48,6 +48,6 @@ let commands () = Clic.[ Time.pp_hum time Time.pp_hum (Time.now ())) stream >>= fun () -> cctxt#answer "Bootstrapped." >>= fun () -> - return () + return_unit ) ] diff --git a/src/lib_client_commands/client_keys_commands.ml b/src/lib_client_commands/client_keys_commands.ml index f936ec038..23ba16622 100644 --- a/src/lib_client_commands/client_keys_commands.ml +++ b/src/lib_client_commands/client_keys_commands.ml @@ -109,12 +109,12 @@ let gen_keys_containing else begin if attempts mod 25_000 = 0 then cctxt#message "Tried %d keys without finding a match" attempts - else Lwt.return () end >>= fun () -> + else Lwt.return_unit end >>= fun () -> loop (attempts + 1) in loop 1 >>=? fun key_hash -> cctxt#message "Generated '%s' under the name '%s'." key_hash name >>= fun () -> - return () + return_unit end let rec input_fundraiser_params (cctxt : #Client_context.io_wallet) = @@ -234,7 +234,7 @@ let commands () : Client_context.io_wallet Clic.command list = Client_keys.neuterize sk_uri >>=? fun pk_uri -> begin Public_key.find_opt cctxt name >>=? function - | None -> return () + | None -> return_unit | Some (pk_uri_found, _) -> fail_unless (pk_uri = pk_uri_found || force) (failure @@ -260,7 +260,7 @@ let commands () : Client_context.io_wallet Clic.command list = Client_keys.neuterize sk_uri >>=? fun pk_uri -> begin Public_key.find_opt cctxt name >>=? function - | None -> return () + | None -> return_unit | Some (pk_uri_found, _) -> fail_unless (pk_uri = pk_uri_found || force) (failure @@ -313,7 +313,7 @@ let commands () : Client_context.io_wallet Clic.command list = cctxt#message "%s: %s (%s sk known)" name v scheme | Some _, _ -> cctxt#message "%s: %s (pk known)" name v - end >>= fun () -> return () + end >>= fun () -> return_unit end l) ; command ~group ~desc: "Show the keys associated with an implicit account." @@ -326,24 +326,24 @@ let commands () : Client_context.io_wallet Clic.command list = match key_info with | None -> cctxt#message "No keys found for address" >>= fun () -> - return () + return_unit | Some (pkh, pk, skloc) -> cctxt#message "Hash: %a" Signature.Public_key_hash.pp pkh >>= fun () -> match pk with - | None -> return () + | None -> return_unit | Some pk -> cctxt#message "Public Key: %a" Signature.Public_key.pp pk >>= fun () -> if show_private then match skloc with - | None -> return () + | None -> return_unit | Some skloc -> Secret_key.to_source skloc >>=? fun skloc -> cctxt#message "Secret Key: %s" skloc >>= fun () -> - return () + return_unit else - return ()) ; + return_unit) ; command ~group ~desc: "Forget one address." (args1 (Clic.switch diff --git a/src/lib_client_commands/client_p2p_commands.ml b/src/lib_client_commands/client_p2p_commands.ml index be11879be..2493aa7bb 100644 --- a/src/lib_client_commands/client_p2p_commands.ml +++ b/src/lib_client_commands/client_p2p_commands.ml @@ -84,7 +84,7 @@ let commands () = P2p_point.Id.pp p (if pi.trusted then "★" else " ") end points >>= fun () -> - return () + return_unit end ; command ~group ~desc: "Connect to a new point." @@ -133,7 +133,7 @@ let commands () = cctxt#message "The given ip address is %s" (if banned then "banned" else "not banned") >>= fun () -> - return () + return_unit ) ; command ~group ~desc: "Remove a peer ID from the blacklist and whitelist." @@ -173,7 +173,7 @@ let commands () = cctxt#message "The given peer ID is %s" (if banned then "banned" else "not banned") >>= fun () -> - return () + return_unit ) ; command ~group ~desc: "Clear all ACLs." diff --git a/src/lib_client_commands/client_report_commands.ml b/src/lib_client_commands/client_report_commands.ml index eb0b1cc13..4dc137916 100644 --- a/src/lib_client_commands/client_report_commands.ml +++ b/src/lib_client_commands/client_report_commands.ml @@ -49,7 +49,7 @@ let commands () = Format.fprintf ppf "@[<v>%a@]@." (Format.pp_print_list Block_hash.pp) (List.concat heads) ; - return ()) ; + return_unit) ; command ~group ~desc: "The blocks that have been marked invalid by the node." (args1 output_arg) (fixed [ "list" ; "rejected" ; "blocks" ]) @@ -57,10 +57,10 @@ let commands () = Shell_services.Invalid_blocks.list cctxt () >>=? function | [] -> Format.fprintf ppf "No invalid blocks." ; - return () + return_unit | _ :: _ as invalid -> Format.fprintf ppf "@[<v>%a@]@." (Format.pp_print_list print_invalid_blocks) invalid ; - return ()) ; + return_unit) ; ] diff --git a/src/lib_error_monad/error_monad.ml b/src/lib_error_monad/error_monad.ml index c43ada003..97b7743b5 100644 --- a/src/lib_error_monad/error_monad.ml +++ b/src/lib_error_monad/error_monad.ml @@ -317,6 +317,8 @@ module Make(Prefix : sig val id : string end) = struct let return v = Lwt.return (Ok v) + let return_unit = Lwt.return (Ok ()) + let error s = Error [ s ] let ok v = Ok v @@ -462,14 +464,14 @@ module Make(Prefix : sig val id : string end) = struct let rec iter_s f l = match l with - | [] -> return () + | [] -> return_unit | h :: t -> f h >>=? fun () -> iter_s f t let rec iter_p f l = match l with - | [] -> return () + | [] -> return_unit | x :: l -> let tx = f x and tl = iter_p f l in tx >>= fun tx_res -> @@ -482,7 +484,7 @@ module Make(Prefix : sig val id : string end) = struct let rec iter2_p f l1 l2 = match l1, l2 with - | [], [] -> return () + | [], [] -> return_unit | [], _ | _, [] -> invalid_arg "Error_monad.iter2_p" | x1 :: l1 , x2 :: l2 -> let tx = f x1 x2 and tl = iter2_p f l1 l2 in @@ -497,7 +499,7 @@ module Make(Prefix : sig val id : string end) = struct let iteri2_p f l1 l2 = let rec iteri2_p i f l1 l2 = match l1, l2 with - | [], [] -> return () + | [], [] -> return_unit | [], _ | _, [] -> invalid_arg "Error_monad.iteri2_p" | x1 :: l1 , x2 :: l2 -> let tx = f i x1 x2 and tl = iteri2_p (i+1) f l1 l2 in @@ -526,7 +528,7 @@ module Make(Prefix : sig val id : string end) = struct f h acc let rec join = function - | [] -> return () + | [] -> return_unit | t :: ts -> t >>= function | Error _ as err -> @@ -546,16 +548,16 @@ module Make(Prefix : sig val id : string end) = struct | ok -> Lwt.return ok let fail_unless cond exn = - if cond then return () else fail exn + if cond then return_unit else fail exn let fail_when cond exn = - if cond then fail exn else return () + if cond then fail exn else return_unit let unless cond f = - if cond then return () else f () + if cond then return_unit else f () let _when cond f = - if cond then f () else return () + if cond then f () else return_unit let pp_print_error ppf errors = match errors with @@ -599,7 +601,7 @@ module Make(Prefix : sig val id : string end) = struct let _assert b loc fmt = if b then - Format.ikfprintf (fun _ -> return ()) Format.str_formatter fmt + Format.ikfprintf (fun _ -> return_unit) Format.str_formatter fmt else Format.kasprintf (fun msg -> fail (Assert_error (loc, msg))) fmt diff --git a/src/lib_error_monad/error_monad_sig.ml b/src/lib_error_monad/error_monad_sig.ml index bad2f0f30..d794ee708 100644 --- a/src/lib_error_monad/error_monad_sig.ml +++ b/src/lib_error_monad/error_monad_sig.ml @@ -80,6 +80,9 @@ module type S = sig (** Sucessful return *) val return : 'a -> 'a tzresult Lwt.t + (** Sucessful return of [()] *) + val return_unit : unit 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 4f3826e91..6f94ad53e 100644 --- a/src/lib_p2p/p2p.ml +++ b/src/lib_p2p/p2p.ml @@ -261,7 +261,7 @@ module Real = struct lwt_debug "message sent to %a" P2p_peer.Id.pp (P2p_pool.Connection.info conn).peer_id >>= fun () -> - return () + return_unit | Error err -> lwt_debug "error sending message from %a: %a" P2p_peer.Id.pp @@ -366,13 +366,13 @@ type ('msg, 'peer_meta, 'conn_meta) net = ('msg, 'peer_meta, 'conn_meta) t let check_limits = let fail_1 v orig = - if not (v <= 0.) then return () + if not (v <= 0.) then return_unit else Error_monad.failwith "value of option %S cannot be negative or null@." orig in let fail_2 v orig = - if not (v < 0) then return () + if not (v < 0) then return_unit else Error_monad.failwith "value of option %S cannot be negative@." orig in @@ -397,10 +397,10 @@ let check_limits = "swap-linger" >>=? fun () -> begin match c.binary_chunks_size with - | None -> return () + | None -> return_unit | Some size -> P2p_socket.check_binary_chunks_size size end >>=? fun () -> - return () + return_unit let create ~config ~limits peer_cfg conn_cfg msg_cfg = check_limits limits >>=? fun () -> @@ -586,7 +586,7 @@ let build_rpc_directory net = | None -> failwith "The P2P layer is disabled." | Some pool -> P2p_pool.connect ~timeout:q#timeout pool point >>=? fun _conn -> - return () + return_unit end in (* Network : Connection *) @@ -821,10 +821,10 @@ let build_rpc_directory net = RPC_directory.register dir P2p_services.ACL.S.clear begin fun () () () -> match net.pool with - | None -> return () + | None -> return_unit | Some pool -> P2p_pool.acl_clear pool ; - return () + return_unit end in dir diff --git a/src/lib_p2p/p2p_io_scheduler.ml b/src/lib_p2p/p2p_io_scheduler.ml index 995b646a2..b674a3dc5 100644 --- a/src/lib_p2p/p2p_io_scheduler.ml +++ b/src/lib_p2p/p2p_io_scheduler.ml @@ -139,14 +139,14 @@ module Scheduler(IO : IO) = struct IO.push conn.out_param msg >>= function | Ok () | Error [ Canceled ] -> - return () + return_unit | Error ([P2p_errors.Connection_closed | Exn (Unix.Unix_error (EBADF, _, _) | Lwt_pipe.Closed)] as err) -> lwt_debug "Connection closed (push: %d, %s)" conn.id IO.name >>= fun () -> cancel conn err >>= fun () -> - return () + return_unit | Error err -> lwt_log_error "@[Unexpected error in connection (push: %d, %s):@ %a@]" @@ -187,7 +187,7 @@ module Scheduler(IO : IO) = struct canceler ; in_param ; out_param ; current_pop = Lwt.fail Not_found (* dummy *) ; - current_push = return () ; + current_push = return_unit ; counter = Moving_average.create ~init:0 ~alpha ; quota = 0 ; last_quota = 0 ; } in @@ -447,7 +447,7 @@ let read_full conn ?pos ?len buf = assert (len <= maxlen - pos) ; let rec loop pos len = if len = 0 then - return () + return_unit else read conn ~pos ~len buf >>=? fun read_len -> loop (pos + read_len) (len - read_len) in diff --git a/src/lib_p2p/p2p_maintenance.ml b/src/lib_p2p/p2p_maintenance.ml index 9162b46dc..552a9067d 100644 --- a/src/lib_p2p/p2p_maintenance.ml +++ b/src/lib_p2p/p2p_maintenance.ml @@ -124,7 +124,7 @@ let rec maintain st = (* end of maintenance when enough users have been reached *) Lwt_condition.broadcast st.just_maintained () ; lwt_debug "Maintenance step ended" >>= fun () -> - return () + return_unit end and too_few_connections st n_connected = @@ -175,7 +175,7 @@ let rec worker_loop st = P2p_pool.Pool_event.wait_too_few_connections pool ; (* limits *) P2p_pool.Pool_event.wait_too_many_connections pool ] >>= fun () -> - return () + return_unit end >>=? fun () -> let n_connected = P2p_pool.active_connections pool in if n_connected < st.bounds.min_threshold @@ -183,7 +183,7 @@ let rec worker_loop st = maintain st else begin P2p_pool.send_swap_request pool ; - return () + return_unit end end >>= function | Ok () -> worker_loop st diff --git a/src/lib_p2p/p2p_pool.ml b/src/lib_p2p/p2p_pool.ml index 0fa0c6c21..508f9b206 100644 --- a/src/lib_p2p/p2p_pool.ml +++ b/src/lib_p2p/p2p_pool.ml @@ -647,13 +647,13 @@ let config { config } = config let fail_unless_disconnected_point point_info = match P2p_point_state.get point_info with - | Disconnected -> return () + | Disconnected -> return_unit | Requested _ | Accepted _ -> fail P2p_errors.Pending_connection | Running _ -> fail P2p_errors.Connected let fail_unless_disconnected_peer_id peer_info = match P2p_peer_state.get peer_info with - | Disconnected -> return () + | Disconnected -> return_unit | Accepted _ -> fail P2p_errors.Pending_connection | Running _ -> fail P2p_errors.Connected @@ -702,7 +702,7 @@ let rec connect ?timeout pool point = protect ~canceler begin fun () -> log pool (Outgoing_connection point) ; Lwt_unix.connect fd uaddr >>= fun () -> - return () + return_unit end ~on_error: begin fun err -> lwt_debug "connect: %a -> disconnect" P2p_point.Id.pp point >>= fun () -> P2p_point_state.set_disconnected point_info ; diff --git a/src/lib_p2p/p2p_socket.ml b/src/lib_p2p/p2p_socket.ml index ace77b3ac..48b334771 100644 --- a/src/lib_p2p/p2p_socket.ml +++ b/src/lib_p2p/p2p_socket.ml @@ -403,7 +403,7 @@ module Writer = struct let send_message st buf = let rec loop = function - | [] -> return () + | [] -> return_unit | buf :: l -> protect ~canceler:st.canceler begin fun () -> Crypto.write_chunk st.conn.fd st.conn.cryptobox_data buf diff --git a/src/lib_p2p/test/test_p2p_banned_peers.ml b/src/lib_p2p/test/test_p2p_banned_peers.ml index fda991532..db8c72451 100644 --- a/src/lib_p2p/test/test_p2p_banned_peers.ml +++ b/src/lib_p2p/test/test_p2p_banned_peers.ml @@ -25,7 +25,7 @@ let test_empty _ = List.iter (fun (_peer,addr) -> assert_equal_bool ~msg:__LOC__ false (P2p_acl.banned_addr empty addr) ) peers ; - Lwt.return () + Lwt.return_unit ;; let test_ban _ = @@ -34,7 +34,7 @@ let test_ban _ = List.iter (fun (_,addr) -> assert_equal_bool ~msg:__LOC__ true (P2p_acl.banned_addr set addr) ) peers ; - Lwt.return () + Lwt.return_unit ;; let test_gc _ = @@ -48,7 +48,7 @@ let test_gc _ = List.iter (fun (_peer,addr) -> assert_equal_bool ~msg:__LOC__ false (P2p_acl.banned_addr set addr) ) peers ; - Lwt.return () + Lwt.return_unit let () = let wrap (n, f) = diff --git a/src/lib_p2p/test/test_p2p_io_scheduler.ml b/src/lib_p2p/test/test_p2p_io_scheduler.ml index 03aa9f4c7..73c45854e 100644 --- a/src/lib_p2p/test/test_p2p_io_scheduler.ml +++ b/src/lib_p2p/test/test_p2p_io_scheduler.ml @@ -72,7 +72,7 @@ let receive conn = P2p_io_scheduler.read conn buf >>= function | Ok _ -> loop () | Error [P2p_errors.Connection_closed] -> - Lwt.return () + Lwt.return_unit | Error err -> Lwt.fail (Error err) in loop () @@ -100,7 +100,7 @@ let server Lwt.join (List.map receive conns) >>= fun () -> iter_p P2p_io_scheduler.close conns >>=? fun () -> log_notice "OK %a" P2p_stat.pp (P2p_io_scheduler.global_stat sched) ; - return () + return_unit let max_size ?max_upload_speed () = match max_upload_speed with @@ -131,7 +131,7 @@ let client ?max_upload_speed ?write_queue_size addr port time _n = P2p_io_scheduler.close conn >>=? fun () -> let stat = P2p_io_scheduler.stat conn in lwt_log_notice "Client OK %a" P2p_stat.pp stat >>= fun () -> - return () + return_unit let run ?display_client_stat diff --git a/src/lib_p2p/test/test_p2p_pool.ml b/src/lib_p2p/test/test_p2p_pool.ml index b7946a248..ebb7c52a3 100644 --- a/src/lib_p2p/test/test_p2p_pool.ml +++ b/src/lib_p2p/test/test_p2p_pool.ml @@ -43,7 +43,7 @@ let conn_meta_config : metadata P2p_socket.metadata_config = { let sync ch = Process.Channel.push ch () >>=? fun () -> Process.Channel.pop ch >>=? fun () -> - return () + return_unit let rec sync_nodes nodes = iter_p @@ -57,7 +57,7 @@ let rec sync_nodes nodes = let sync_nodes nodes = sync_nodes nodes >>= function | Ok () | Error (Exn End_of_file :: _) -> - return () + return_unit | Error _ as err -> Lwt.return err @@ -104,7 +104,7 @@ let detach_node f points n = P2p_pool.destroy pool >>= fun () -> P2p_io_scheduler.shutdown sched >>= fun () -> lwt_log_info "Bye." >>= fun () -> - return () + return_unit end let detach_nodes run_node points = @@ -165,7 +165,7 @@ module Simple = struct iter_p (fun conn -> trace Read @@ P2p_pool.read conn >>=? fun Ping -> - return ()) + return_unit) conns let close_all conns = @@ -183,7 +183,7 @@ module Simple = struct sync channel >>=? fun () -> close_all conns >>= fun () -> lwt_log_info "All connections successfully closed." >>= fun () -> - return () + return_unit let run points = detach_nodes node points @@ -203,12 +203,12 @@ module Random_connections = struct if !rem mod total = 0 then lwt_log_info "Remaining: %d." (!rem / total) else - Lwt.return () + Lwt.return_unit end >>= fun () -> if n > 1 then connect_random pool total rem point (pred n) else - return () + return_unit let connect_random_all pool points n = let total = List.length points in @@ -219,7 +219,7 @@ module Random_connections = struct lwt_log_info "Begin random connections." >>= fun () -> connect_random_all pool points repeat >>=? fun () -> lwt_log_info "Random connections OK." >>= fun () -> - return () + return_unit let run points repeat = detach_nodes (node repeat) points diff --git a/src/lib_p2p/test/test_p2p_socket.ml b/src/lib_p2p/test/test_p2p_socket.ml index 902103185..23f8db4fa 100644 --- a/src/lib_p2p/test/test_p2p_socket.ml +++ b/src/lib_p2p/test/test_p2p_socket.ml @@ -51,7 +51,7 @@ let rec listen ?port addr = let sync ch = Process.Channel.push ch () >>=? fun () -> Process.Channel.pop ch >>=? fun () -> - return () + return_unit let rec sync_nodes nodes = iter_p @@ -65,7 +65,7 @@ let rec sync_nodes nodes = let sync_nodes nodes = sync_nodes nodes >>= function | Ok () | Error (Exn End_of_file :: _) -> - return () + return_unit | Error _ as err -> Lwt.return err @@ -75,14 +75,14 @@ let run_nodes client server = let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in server channel sched main_socket >>=? fun () -> P2p_io_scheduler.shutdown sched >>= fun () -> - return () + return_unit end >>= fun server_node -> Process.detach ~prefix:"client: " begin fun channel -> Lwt_utils_unix.safe_close main_socket >>= fun () -> let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in client channel sched default_addr port >>=? fun () -> P2p_io_scheduler.shutdown sched >>= fun () -> - return () + return_unit end >>= fun client_node -> let nodes = [ server_node ; client_node ] in Lwt.ignore_result (sync_nodes nodes) ; @@ -148,13 +148,13 @@ module Low_level = struct P2p_io_scheduler.read_full fd msg >>=? fun () -> _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> P2p_io_scheduler.close fd >>=? fun () -> - return () + return_unit let server _ch sched socket = raw_accept sched socket >>= fun (fd, _point) -> P2p_io_scheduler.write fd simple_msg >>=? fun () -> P2p_io_scheduler.close fd >>=? fun _ -> - return () + return_unit let run _dir = run_nodes client server @@ -177,13 +177,13 @@ module Kick = struct _assert (P2p_peer.Id.compare info.peer_id id2.peer_id = 0) __LOC__ "" >>=? fun () -> P2p_socket.kick auth_fd >>= fun () -> - return () + return_unit let client _ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> P2p_socket.accept auth_fd encoding >>= fun conn -> _assert (is_rejected conn) __LOC__ "" >>=? fun () -> - return () + return_unit let run _dir = run_nodes client server @@ -197,12 +197,12 @@ module Kicked = struct accept sched socket >>=? fun (_info, auth_fd) -> P2p_socket.accept auth_fd encoding >>= fun conn -> _assert (Kick.is_rejected conn) __LOC__ "" >>=? fun () -> - return () + return_unit let client _ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> P2p_socket.kick auth_fd >>= fun () -> - return () + return_unit let run _dir = run_nodes client server @@ -223,7 +223,7 @@ module Simple_message = struct _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> @@ -233,7 +233,7 @@ module Simple_message = struct _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let run _dir = run_nodes client server @@ -255,7 +255,7 @@ module Chunked_message = struct _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> @@ -266,7 +266,7 @@ module Chunked_message = struct _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let run _dir = run_nodes client server @@ -287,7 +287,7 @@ module Oversized_message = struct _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> @@ -297,7 +297,7 @@ module Oversized_message = struct _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> sync ch >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let run _dir = run_nodes client server @@ -314,7 +314,7 @@ module Close_on_read = struct P2p_socket.accept auth_fd encoding >>=? fun conn -> sync ch >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> @@ -323,7 +323,7 @@ module Close_on_read = struct P2p_socket.read conn >>= fun err -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let run _dir = run_nodes client server @@ -340,7 +340,7 @@ module Close_on_write = struct P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.close conn >>= fun _stat -> sync ch >>=? fun ()-> - return () + return_unit let client ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> @@ -350,7 +350,7 @@ module Close_on_write = struct P2p_socket.write_sync conn simple_msg >>= fun err -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let run _dir = run_nodes client server @@ -379,7 +379,7 @@ module Garbled_data = struct P2p_socket.read conn >>= fun err -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let client _ch sched addr port = connect sched addr port id2 >>=? fun auth_fd -> @@ -387,7 +387,7 @@ module Garbled_data = struct P2p_socket.read conn >>= fun err -> _assert (is_decoding_error err) __LOC__ "" >>=? fun () -> P2p_socket.close conn >>= fun _stat -> - return () + return_unit let run _dir = run_nodes client server diff --git a/src/lib_protocol_environment/sigs/v1/error_monad.mli b/src/lib_protocol_environment/sigs/v1/error_monad.mli index 40f32f650..66861ab17 100644 --- a/src/lib_protocol_environment/sigs/v1/error_monad.mli +++ b/src/lib_protocol_environment/sigs/v1/error_monad.mli @@ -72,6 +72,9 @@ val ok : 'a -> 'a tzresult (** Sucessful return *) val return : 'a -> 'a tzresult Lwt.t +(** Sucessful return of [()] *) +val return_unit : unit tzresult Lwt.t + (** Erroneous result *) val error : error -> 'a tzresult diff --git a/src/lib_protocol_environment/test/test_mem_context.ml b/src/lib_protocol_environment/test/test_mem_context.ml index fb28d2023..b934e10e5 100644 --- a/src/lib_protocol_environment/test/test_mem_context.ml +++ b/src/lib_protocol_environment/test/test_mem_context.ml @@ -55,7 +55,7 @@ let test_simple { block2 = ctxt } = Assert.equal_string_option (Some "Novembre") (c novembre) ; Context.get ctxt ["a";"c"] >>= fun juin -> Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ; - Lwt.return () + Lwt.return_unit let test_continuation { block3a = ctxt } = Context.get ctxt ["version"] >>= fun version -> @@ -66,7 +66,7 @@ let test_continuation { block3a = ctxt } = Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ; Context.get ctxt ["a";"d"] >>= fun mars -> Assert.equal_string_option ~msg:__LOC__ (Some "Mars") (c mars) ; - Lwt.return () + Lwt.return_unit let test_fork { block3b = ctxt } = Context.get ctxt ["version"] >>= fun version -> @@ -77,7 +77,7 @@ let test_fork { block3b = ctxt } = Assert.is_none ~msg:__LOC__ (c juin) ; Context.get ctxt ["a";"d"] >>= fun mars -> Assert.equal_string_option ~msg:__LOC__ (Some "Février") (c mars) ; - Lwt.return () + Lwt.return_unit let test_replay { genesis = ctxt0 } = Context.set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 -> @@ -96,7 +96,7 @@ let test_replay { genesis = ctxt0 } = Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ; Context.get ctxt4b ["a";"d"] >>= fun juillet -> Assert.equal_string_option ~msg:__LOC__ (Some "Juillet") (c juillet) ; - Lwt.return () + Lwt.return_unit let fold_keys s k ~init ~f = let rec loop k acc = @@ -131,7 +131,7 @@ let test_fold { genesis = ctxt } = Assert.equal_string_list_list ~msg:__LOC__ [["g";"h"]] l ; keys ctxt ["i"] >>= fun l -> Assert.equal_string_list_list ~msg:__LOC__ [] l ; - Lwt.return () + Lwt.return_unit (******************************************************************************) diff --git a/src/lib_shell/block_validator.ml b/src/lib_shell/block_validator.ml index c1b74aaf2..a0c34d163 100644 --- a/src/lib_shell/block_validator.ml +++ b/src/lib_shell/block_validator.ml @@ -79,7 +79,7 @@ let check_header (invalid_block hash (Unexpected_number_of_validation_passes header.shell.validation_passes) ) >>=? fun () -> - return () + return_unit let assert_no_duplicate_operations block live_operations operation_hashes = fold_left_s (fold_left_s (fun live_operations oph -> @@ -87,7 +87,7 @@ let assert_no_duplicate_operations block live_operations operation_hashes = (invalid_block block @@ Replayed_operation oph) >>=? fun () -> return (Operation_hash.Set.add oph live_operations))) live_operations operation_hashes >>=? fun _ -> - return () + return_unit let assert_operation_liveness block live_blocks operations = iter_s (iter_s (fun op -> @@ -110,7 +110,7 @@ let check_liveness chain_state pred hash operations_hashes operations = assert_no_duplicate_operations hash live_operations operations_hashes >>=? fun () -> assert_operation_liveness hash live_blocks operations >>=? fun () -> - return () + return_unit let may_patch_protocol ~level @@ -147,7 +147,7 @@ let apply_block Oversized_operation { operation = Operation.hash op ; size ; max = Proto.max_operation_data_length })) ops >>=? fun () -> - return ()) + return_unit) operations Proto.validation_passes >>=? fun () -> let operation_hashes = List.map (List.map Operation.hash) operations in check_liveness chain_state pred hash operation_hashes operations >>=? fun () -> @@ -254,7 +254,7 @@ let check_chain_liveness chain_db hash (header: Block_header.t) = Expired_chain { chain_id = State.Chain.id chain_state ; expiration = eol ; timestamp = header.shell.timestamp } - | None | Some _ -> return () + | None | Some _ -> return_unit let get_proto pred hash = State.Block.context pred >>= fun pred_context -> @@ -340,13 +340,13 @@ let on_completion | Ok (Some _) -> Worker.record_event w (Event.Validation_success (Request.view r, st)) ; - Lwt.return () + Lwt.return_unit | Ok None -> - Lwt.return () + Lwt.return_unit | Error errs -> Worker.record_event w (Event.Validation_failure (Request.view r, st, errs)) ; - Lwt.return () + Lwt.return_unit let table = Worker.create_table Queue @@ -355,10 +355,10 @@ let create limits db = type self = t let on_launch = on_launch let on_request = on_request - let on_close _ = Lwt.return () + let on_close _ = Lwt.return_unit let on_error = on_error let on_completion = on_completion - let on_no_request _ = return () + let on_no_request _ = return_unit end in Worker.launch table diff --git a/src/lib_shell/bootstrap_pipeline.ml b/src/lib_shell/bootstrap_pipeline.ml index 20f05e96d..0782a38c8 100644 --- a/src/lib_shell/bootstrap_pipeline.ml +++ b/src/lib_shell/bootstrap_pipeline.ml @@ -53,11 +53,11 @@ let assert_acceptable_header pipeline Chain.mem chain_state hash >>= fun in_chain -> fail_unless in_chain (Checkpoint_error (hash, Some pipeline.peer_id)) >>=? fun () -> - return () + return_unit else - return () + return_unit else - return () + return_unit let fetch_step pipeline (step : Block_locator.step) = lwt_log_info "fetching step %a -> %a (%d%s) from peer %a." @@ -103,7 +103,7 @@ let fetch_step pipeline (step : Block_locator.step) = end end headers >>=? fun () -> - return () + return_unit let headers_fetch_worker_loop pipeline = begin @@ -113,7 +113,7 @@ let headers_fetch_worker_loop pipeline = let seed = {Block_locator.sender_id=pipeline.peer_id; receiver_id=sender_id } in let steps = Block_locator.to_steps seed pipeline.locator in iter_s (fetch_step pipeline) steps >>=? fun () -> - return () + return_unit end >>= function | Ok () -> lwt_log_info "fetched all step from peer %a." @@ -210,7 +210,7 @@ let rec validation_worker_loop pipeline = lwt_log_info "validated block %a from peer %a." Block_hash.pp_short hash P2p_peer.Id.pp_short pipeline.peer_id >>= fun () -> - return () + return_unit end >>= function | Ok () -> validation_worker_loop pipeline | Error [Exn Lwt.Canceled | Canceled | Exn Lwt_pipe.Closed] -> @@ -286,7 +286,7 @@ let wait_workers pipeline = let wait pipeline = wait_workers pipeline >>= fun () -> match pipeline.errors with - | [] -> return () + | [] -> return_unit | errors -> Lwt.return_error errors let cancel pipeline = diff --git a/src/lib_shell/chain_traversal.ml b/src/lib_shell/chain_traversal.ml index 46a049337..a3c6e7cd8 100644 --- a/src/lib_shell/chain_traversal.ml +++ b/src/lib_shell/chain_traversal.ml @@ -87,7 +87,7 @@ let iter_predecessors ?max ?min_fitness ?min_date heads ~f = (fun b -> Time.(min_date <= Block.timestamp b)) in let rec loop () = match pop () with - | None -> Lwt.return () + | None -> Lwt.return_unit | Some b -> check_count () ; f b >>= fun () -> @@ -97,7 +97,7 @@ let iter_predecessors ?max ?min_fitness ?min_date heads ~f = if check_fitness p && check_date p then push p ; loop () in List.iter push heads ; - try loop () with Local.Exit -> Lwt.return () + try loop () with Local.Exit -> Lwt.return_unit let iter_predecessors ?max ?min_fitness ?min_date heads ~f = match heads with diff --git a/src/lib_shell/chain_validator.ml b/src/lib_shell/chain_validator.ml index 114b303f5..89d865ce6 100644 --- a/src/lib_shell/chain_validator.ml +++ b/src/lib_shell/chain_validator.ml @@ -167,10 +167,10 @@ let may_switch_test_chain w spawn_child block = nv.parameters.db chain_state nv.parameters.limits (* TODO: different limits main/test ? *) >>= fun child -> nv.child <- Some child ; - return () + return_unit end else begin (* Ignoring request... *) - return () + return_unit end in let check_child genesis protocol expiration current_time = @@ -196,7 +196,7 @@ let may_switch_test_chain w spawn_child block = else if not activated && not expired then create_child genesis protocol expiration else - return () in + return_unit in begin let block_header = State.Block.header block in @@ -252,7 +252,7 @@ let on_request (type a) w spawn_child (req : a Request.t) : a tzresult Lwt.t = begin match nv.prevalidator with | Some prevalidator -> Prevalidator.flush prevalidator block_hash - | None -> return () + | None -> return_unit end >>=? fun () -> may_switch_test_chain w spawn_child block >>= fun () -> Lwt_watcher.notify nv.new_head_input block ; @@ -267,7 +267,7 @@ let on_completion (type a) w (req : a Request.t) (update : a) request_status = let fitness = State.Block.fitness block in let request = State.Block.hash block in Worker.record_event w (Processed_block { request ; request_status ; update ; fitness }) ; - Lwt.return () + Lwt.return_unit let on_close w = let nv = Worker.state w in @@ -352,7 +352,7 @@ let rec create let on_close = on_close let on_error _ _ _ errs = Lwt.return (Error errs) let on_completion = on_completion - let on_no_request _ = return () + let on_no_request _ = return_unit end in let parameters = { max_child_ttl ; diff --git a/src/lib_shell/injection_directory.ml b/src/lib_shell/injection_directory.ml index 1d18bbc82..28878faea 100644 --- a/src/lib_shell/injection_directory.ml +++ b/src/lib_shell/injection_directory.ml @@ -21,7 +21,7 @@ let inject_block validator ?force ?chain bytes operations = read_chain_id validator chain >>= fun chain_id -> Validator.validate_block validator ?force ?chain_id bytes operations >>=? fun (hash, block) -> - return (hash, (block >>=? fun _ -> return ())) + return (hash, (block >>=? fun _ -> return_unit)) let inject_operation validator ?chain bytes = read_chain_id validator chain >>= fun chain_id -> @@ -49,7 +49,7 @@ let inject_protocol state ?force:_ proto = failwith "Previously registered protocol (%a)" Protocol_hash.pp_short hash - | Some _ -> return () + | Some _ -> return_unit in Lwt.return (hash, validation) @@ -65,19 +65,19 @@ let build_rpc_directory validator = register0 Injection_services.S.block begin fun q (raw, operations) -> inject_block validator ?chain:q#chain ~force:q#force raw operations >>=? fun (hash, wait) -> - (if q#async then return () else wait) >>=? fun () -> + (if q#async then return_unit else wait) >>=? fun () -> return hash end ; register0 Injection_services.S.operation begin fun q contents -> inject_operation validator ?chain:q#chain contents >>= fun (hash, wait) -> - (if q#async then return () else wait) >>=? fun () -> + (if q#async then return_unit else wait) >>=? fun () -> return hash end ; register0 Injection_services.S.protocol begin fun q protocol -> inject_protocol state ~force:q#force protocol >>= fun (hash, wait) -> - (if q#async then return () else wait) >>=? fun () -> + (if q#async then return_unit else wait) >>=? fun () -> return hash end ; diff --git a/src/lib_shell/peer_validator.ml b/src/lib_shell/peer_validator.ml index 3e884c916..9d7d667af 100644 --- a/src/lib_shell/peer_validator.ml +++ b/src/lib_shell/peer_validator.ml @@ -119,7 +119,7 @@ let bootstrap_new_branch w _ancestor _head unknown_prefix = debug w "done validating new branch from peer %a." P2p_peer.Id.pp_short pv.peer_id ; - return () + return_unit let validate_new_head w hash (header : Block_header.t) = let pv = Worker.state w in @@ -149,7 +149,7 @@ let validate_new_head w hash (header : Block_header.t) = Block_hash.pp_short hash P2p_peer.Id.pp_short pv.peer_id ; set_bootstrapped pv ; - return () + return_unit let only_if_fitness_increases w distant_header cont = let pv = Worker.state w in @@ -164,7 +164,7 @@ let only_if_fitness_increases w distant_header cont = Block_hash.pp_short (Block_header.hash distant_header) P2p_peer.Id.pp_short pv.peer_id ; (* Don't download a branch that cannot beat the current head. *) - return () + return_unit end else cont () let assert_acceptable_head w hash (header: Block_header.t) = @@ -190,7 +190,7 @@ let may_validate_new_head w hash (header : Block_header.t) = P2p_peer.Id.pp_short pv.peer_id ; set_bootstrapped pv ; pv.last_validated_head <- header ; - return () + return_unit end else if invalid_block then begin debug w "ignoring known invalid block %a from peer %a" @@ -212,7 +212,7 @@ let may_validate_new_head w hash (header : Block_header.t) = P2p_peer.Id.pp_short pv.peer_id ; Distributed_db.Request.current_branch pv.parameters.chain_db ~peer:pv.peer_id () ; - return () + return_unit end else begin only_if_fitness_increases w header @@ fun () -> assert_acceptable_head w hash header >>=? fun () -> @@ -242,7 +242,7 @@ let on_no_request w = P2p_peer.Id.pp_short pv.peer_id pv.parameters.limits.new_head_request_timeout ; Distributed_db.Request.current_head pv.parameters.chain_db ~peer:pv.peer_id () ; - return () + return_unit let on_request (type a) w (req : a Request.t) : a tzresult Lwt.t = let pv = Worker.state w in @@ -262,7 +262,7 @@ let on_request (type a) w (req : a Request.t) : a tzresult Lwt.t = let on_completion w r _ st = Worker.record_event w (Event.Request (Request.view r, st, None )) ; - Lwt.return () + Lwt.return_unit let on_error w r st errs = let pv = Worker.state w in @@ -287,7 +287,7 @@ let on_error w r st errs = | Ok _ -> Distributed_db.Request.current_head pv.parameters.chain_db ~peer:pv.peer_id () ; - return () + return_unit | Error _ -> (* TODO: punish *) debug w @@ -306,7 +306,7 @@ let on_close w = let pv = Worker.state w in Distributed_db.disconnect pv.parameters.chain_db pv.peer_id >>= fun () -> pv.parameters.notify_termination () ; - Lwt.return () + Lwt.return_unit let on_launch _ name parameters = let chain_state = Distributed_db.chain_state parameters.chain_db in @@ -365,7 +365,7 @@ let create let on_close = on_close let on_error = on_error let on_completion = on_completion - let on_no_request _ = return () + let on_no_request _ = return_unit end in Worker.launch table ~timeout: limits.new_head_request_timeout limits.worker_limits name parameters diff --git a/src/lib_shell/prevalidator.ml b/src/lib_shell/prevalidator.ml index 6c11d8145..d7ded3b57 100644 --- a/src/lib_shell/prevalidator.ml +++ b/src/lib_shell/prevalidator.ml @@ -250,10 +250,10 @@ let handle_unprocessed w pv = pv.pending Operation_hash.Map.empty } ; pv.pending <- Operation_hash.Map.empty ; - Lwt.return () + Lwt.return_unit | Ok validation_state -> match Operation_hash.Map.cardinal pv.pending with - | 0 -> Lwt.return () + | 0 -> Lwt.return_unit | n -> debug w "processing %d operations" n ; Prevalidation.prevalidate validation_state ~sort:true (Operation_hash.Map.bindings pv.pending) @@ -286,7 +286,7 @@ let handle_unprocessed w pv = Operation_hash.Map.empty ; advertise w pv (mempool_of_prevalidation_result validation_result) ; - Lwt.return () + Lwt.return_unit end >>= fun () -> pv.mempool <- { Mempool.known_valid = @@ -301,7 +301,7 @@ let handle_unprocessed w pv = Operation_hash.Set.empty } ; State.Current_mempool.set (Distributed_db.chain_state pv.chain_db) ~head:(State.Block.hash pv.predecessor) pv.mempool >>= fun () -> - Lwt.return () + Lwt.return_unit let fetch_operation w pv ?peer oph = debug w @@ -348,7 +348,7 @@ let on_inject pv op = return result end >>=? fun result -> if List.mem_assoc oph result.applied then - return () + return_unit else let try_in_map map proj or_else = try @@ -413,7 +413,7 @@ let on_flush w pv predecessor = pv.validation_state <- validation_state ; if not (Protocol_hash.equal old_protocol new_protocol) then pv.rpc_directory <- lazy (rpc_directory new_protocol) ; - return () + return_unit let on_advertise pv = match pv.advertisement with @@ -436,15 +436,15 @@ let on_request return (() : r) | Request.Notify (peer, mempool) -> on_notify w pv peer mempool ; - return () + return_unit | Request.Inject op -> on_inject pv op | Request.Arrived (oph, op) -> on_operation_arrived pv oph op ; - return () + return_unit | Request.Advertise -> on_advertise pv ; - return () + return_unit end >>=? fun r -> handle_unprocessed w pv >>= fun () -> return r @@ -498,12 +498,12 @@ let on_launch w _ (limits, chain_db) = let on_error w r st errs = Worker.record_event w (Event.Request (r, st, Some errs)) ; match r with - | Request.(View (Inject _)) -> return () + | Request.(View (Inject _)) -> return_unit | _ -> Lwt.return (Error errs) let on_completion w r _ st = - Worker.record_event w (Event.Request (Request.view r, st, None )) ; - Lwt.return () + Worker.record_event w (Event.Request (Request.view r, st, None)) ; + Lwt.return_unit let table = Worker.create_table Queue @@ -516,7 +516,7 @@ let create limits chain_db = let on_close = on_close let on_error = on_error let on_completion = on_completion - let on_no_request _ = return () + let on_no_request _ = return_unit end in Worker.launch table limits.worker_limits (State.Chain.id chain_state) diff --git a/src/lib_shell/protocol_validator.ml b/src/lib_shell/protocol_validator.ml index b374bd507..19e2b2598 100644 --- a/src/lib_shell/protocol_validator.ml +++ b/src/lib_shell/protocol_validator.ml @@ -47,7 +47,7 @@ let rec worker_loop bv = end >>=? fun _ -> match wakener with | None -> - return () + return_unit | Some wakener -> if valid then match Registered_protocol.get hash with @@ -63,7 +63,7 @@ let rec worker_loop bv = (Error [Invalid_protocol { hash ; error = Compilation_failed }]) ; - return () + return_unit end >>= function | Ok () -> worker_loop bv @@ -137,17 +137,17 @@ let fetch_and_compile_protocols pv ?peer ?timeout (block: State.Block.t) = let protocol = Context.get_protocol context >>= fun protocol_hash -> fetch_and_compile_protocol pv ?peer ?timeout protocol_hash >>=? fun _ -> - return () + return_unit and test_protocol = Context.get_test_chain context >>= function - | Not_running -> return () + | Not_running -> return_unit | Forking { protocol } | Running { protocol } -> fetch_and_compile_protocol pv ?peer ?timeout protocol >>=? fun _ -> - return () in + return_unit in protocol >>=? fun () -> test_protocol >>=? fun () -> - return () + return_unit let prefetch_and_compile_protocols pv ?peer ?timeout block = try ignore (fetch_and_compile_protocols pv ?peer ?timeout block) with _ -> () diff --git a/src/lib_shell/state.ml b/src/lib_shell/state.ml index 5d3600686..498f7181c 100644 --- a/src/lib_shell/state.ml +++ b/src/lib_shell/state.ml @@ -489,7 +489,7 @@ module Chain = struct (fun id -> locked_read global_state data id >>=? fun chain -> Chain_id.Table.add data.chains id chain ; - return ()) + return_unit) ids let read_all state = diff --git a/src/lib_shell/test/test_locator.ml b/src/lib_shell/test/test_locator.ml index 5683ce695..b7dbae13c 100644 --- a/src/lib_shell/test/test_locator.ml +++ b/src/lib_shell/test/test_locator.ml @@ -306,7 +306,7 @@ let test_locator base_dir = then Assert.fail_msg "Invalid locator %i" size) l_exp l_lin; - return () + return_unit in let stop = locator_limit + 20 in let rec loop size = @@ -314,7 +314,7 @@ let test_locator base_dir = check_locator size >>=? fun _ -> loop (size+5) ) - else return () + else return_unit in loop 1 diff --git a/src/lib_shell/test/test_state.ml b/src/lib_shell/test/test_state.ml index 26920bc10..0467798bd 100644 --- a/src/lib_shell/test/test_state.ml +++ b/src/lib_shell/test/test_state.ml @@ -120,7 +120,7 @@ let build_valid_chain state vtbl pred names = attempt None) pred names >>= fun _ -> - Lwt.return () + Lwt.return_unit let build_example_tree chain = let vtbl = Hashtbl.create 23 in @@ -159,11 +159,11 @@ let wrap_state_init f base_dir = genesis >>=? fun (state, chain) -> build_example_tree chain >>= fun vblock -> f { state ; chain ; vblock } >>=? fun () -> - return () + return_unit end let test_init (_ : state) = - return () + return_unit @@ -181,7 +181,7 @@ let test_read_block (s: state) = (* FIXME COMPARE read operations ??? *) Lwt.return_unit ) (vblocks s) >>= fun () -> - return () + return_unit (****************************************************************************) @@ -209,7 +209,7 @@ let test_path (s: state) = check_path "A2" "A6" ["A3"; "A4"; "A5"; "A6"] >>= fun () -> check_path "B2" "B6" ["B3"; "B4"; "B5"; "B6"] >>= fun () -> check_path "A1" "B3" ["A2"; "A3"; "B1"; "B2"; "B3"] >>= fun () -> - return () + return_unit (****************************************************************************) @@ -237,7 +237,7 @@ let test_ancestor s = check_ancestor "B1" "A3" (vblock s "A3") >>= fun () -> check_ancestor "A2" "B1" (vblock s "A2") >>= fun () -> check_ancestor "B1" "A2" (vblock s "A2") >>= fun () -> - return () + return_unit (****************************************************************************) @@ -269,7 +269,7 @@ let test_locator s = check_locator 4 "B8" ["B7";"B6";"B5";"B4"] >>= fun () -> check_locator 0 "A5" [] >>= fun () -> check_locator 100 "A5" ["A4";"A3";"A2";"A1";"Genesis"] >>= fun () -> - return () + return_unit (****************************************************************************) @@ -291,7 +291,7 @@ let compare s name heads l = let test_known_heads s = Chain.known_heads s.chain >>= fun heads -> compare s "initial" heads ["A8";"B8"] ; - return () + return_unit (****************************************************************************) @@ -306,7 +306,7 @@ let test_head s = Chain.head s.chain >>= fun head -> if not (Block_hash.equal (State.Block.hash head) (State.Block.hash @@ vblock s "A6")) then Assert.fail_msg "unexpected head" ; - return () + return_unit (****************************************************************************) @@ -360,7 +360,7 @@ let test_mem s = test_mem s "B1" >>= fun () -> test_mem s "B6" >>= fun () -> test_mem s "B8" >>= fun () -> - return () + return_unit (****************************************************************************) @@ -388,7 +388,7 @@ let test_new_blocks s = test s "A6" "A6" "A6" [] >>= fun () -> test s "A8" "A6" "A6" ["A7";"A8"] >>= fun () -> test s "A8" "B7" "A3" ["A4";"A5";"A6";"A7";"A8"] >>= fun () -> - return () + return_unit (****************************************************************************) diff --git a/src/lib_shell/worker.ml b/src/lib_shell/worker.ml index 6102b526c..6dff472c1 100644 --- a/src/lib_shell/worker.ml +++ b/src/lib_shell/worker.ml @@ -265,7 +265,7 @@ module Make List.iter (fun (_, ring) -> Ring.clear ring) w.event_log ; Lwt_unix.sleep (w.limits.zombie_lifetime -. w.limits.zombie_memory) >>= fun () -> Hashtbl.remove w.table.zombies w.id ; - Lwt.return ()) ; + Lwt.return_unit) ; Lwt.return_unit in let rec loop () = begin @@ -286,7 +286,7 @@ module Make w.current_request <- None ; Handlers.on_completion w request res Worker_types.{ pushed ; treated ; completed } >>= fun () -> - return () + return_unit | Some u -> Handlers.on_request w request >>= fun res -> Lwt.wakeup_later u res ; @@ -295,7 +295,7 @@ module Make w.current_request <- None ; Handlers.on_completion w request res Worker_types.{ pushed ; treated ; completed } >>= fun () -> - return () + return_unit end >>= function | Ok () -> loop () diff --git a/src/lib_signer_backends/encrypted.ml b/src/lib_signer_backends/encrypted.ml index 27e0e1c65..2c8a8620c 100644 --- a/src/lib_signer_backends/encrypted.ml +++ b/src/lib_signer_backends/encrypted.ml @@ -94,10 +94,10 @@ let decrypt_all (cctxt : #Client_context.io_wallet) = Secret_key.load cctxt >>=? fun sks -> iter_s begin fun (name, sk_uri) -> if Uri.scheme (sk_uri : sk_uri :> Uri.t) <> Some scheme then - return () + return_unit else decrypt cctxt ~name sk_uri >>=? fun _ -> - return () + return_unit end sks let rec read_passphrase (cctxt : #Client_context.io) = diff --git a/src/lib_signer_backends/ledger.ml b/src/lib_signer_backends/ledger.ml index dd07c9803..2276fe35f 100644 --- a/src/lib_signer_backends/ledger.ml +++ b/src/lib_signer_backends/ledger.ml @@ -254,7 +254,7 @@ let commands = | [] -> cctxt#message "No device found." >>= fun () -> cctxt#message "Make sure a Ledger Nano S is connected and in the Tezos Wallet app." >>= fun () -> - return () + return_unit | ledgers -> iter_s begin fun { Ledger.device_info = { Hidapi.path ; manufacturer_string ; @@ -303,7 +303,7 @@ let commands = | Ledgerwallet_tezos.Secp256r1 -> "p2") Signature.Public_key_hash.pp pkh)) of_curve >>= fun () -> - return () + return_unit end ledgers) ; Clic.command ~group @@ -341,7 +341,7 @@ let commands = Corresponding full public key: %a@]" Signature.Public_key_hash.pp pkh Signature.Public_key.pp pk >>= fun () -> - return () + return_unit ) ] diff --git a/src/lib_stdlib/lwt_canceler.ml b/src/lib_stdlib/lwt_canceler.ml index 0c46bcfee..74dc977a8 100644 --- a/src/lib_stdlib/lwt_canceler.ml +++ b/src/lib_stdlib/lwt_canceler.ml @@ -21,14 +21,14 @@ let create () = let cancelation = Lwt_condition.create () in let cancelation_complete = Lwt_condition.create () in { cancelation ; cancelation_complete ; - cancel_hook = (fun () -> Lwt.return ()) ; + cancel_hook = (fun () -> Lwt.return_unit) ; canceling = false ; canceled = false ; } let cancel st = if st.canceled then - Lwt.return () + Lwt.return_unit else if st.canceling then Lwt_condition.wait st.cancelation_complete else begin @@ -39,7 +39,7 @@ let cancel st = (fun () -> st.canceled <- true ; Lwt_condition.broadcast st.cancelation_complete () ; - Lwt.return ()) + Lwt.return_unit) end let on_cancel st cb = @@ -47,7 +47,7 @@ let on_cancel st cb = st.cancel_hook <- (fun () -> hook () >>= cb) let cancelation st = - if st.canceling then Lwt.return () + if st.canceling then Lwt.return_unit else Lwt_condition.wait st.cancelation let canceled st = st.canceling diff --git a/src/lib_stdlib/lwt_idle_waiter.ml b/src/lib_stdlib/lwt_idle_waiter.ml index 08162fc7e..0d7938644 100644 --- a/src/lib_stdlib/lwt_idle_waiter.ml +++ b/src/lib_stdlib/lwt_idle_waiter.ml @@ -39,7 +39,7 @@ let rec may_run_idle_tasks w = w.pending_tasks <- [] ; List.iter (fun u -> Lwt.wakeup u ()) pending_tasks ; may_run_idle_tasks w ; - Lwt.return ()) + Lwt.return_unit) let wrap_error f = Lwt.catch @@ -73,11 +73,11 @@ let when_idle w f = Lwt.on_cancel t (fun () -> canceled := true) ; let f () = if !canceled then - Lwt.return () + Lwt.return_unit else wrap_error f >>= fun res -> wakeup_error u res ; - Lwt.return () in + Lwt.return_unit in w.pending_idle <- f :: w.pending_idle ; may_run_idle_tasks w ; t diff --git a/src/lib_stdlib/lwt_utils.ml b/src/lib_stdlib/lwt_utils.ml index 634a6f7ba..aa6268ec1 100644 --- a/src/lib_stdlib/lwt_utils.ml +++ b/src/lib_stdlib/lwt_utils.ml @@ -60,10 +60,10 @@ let worker name ~run ~cancel = (fun () -> Lwt.catch run fail >>= fun () -> LC.signal stop (); - Lwt.return ()) ; + Lwt.return_unit) ; waiter >>= fun () -> log_info "%s worker ended" name ; - Lwt.return () + Lwt.return_unit let rec chop k l = @@ -162,6 +162,6 @@ let stable_sort cmp l = let sort = stable_sort let unless cond f = - if cond then Lwt.return () else f () + if cond then Lwt.return_unit else f () diff --git a/src/lib_stdlib_unix/lwt_lock_file.ml b/src/lib_stdlib_unix/lwt_lock_file.ml index df0999d39..3db0ce5c5 100644 --- a/src/lib_stdlib_unix/lwt_lock_file.ml +++ b/src/lib_stdlib_unix/lwt_lock_file.ml @@ -21,7 +21,7 @@ let create_inner Lwt_main.at_exit (fun () -> Lwt_unix.unlink fn) ; let pid_str = string_of_int @@ Unix.getpid () in Lwt_unix.write_string fd pid_str 0 (String.length pid_str) >>= fun _ -> - return () + return_unit end let create = create_inner Unix.F_TLOCK diff --git a/src/lib_stdlib_unix/lwt_utils_unix.ml b/src/lib_stdlib_unix/lwt_utils_unix.ml index dbfe9ce50..1124d1554 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.ml +++ b/src/lib_stdlib_unix/lwt_utils_unix.ml @@ -75,7 +75,7 @@ let remove_dir dir = Lwt_stream.iter_s (fun file -> if file = "." || file = ".." then - Lwt.return () + Lwt.return_unit else begin let file = Filename.concat dir file in if Sys.is_directory file @@ -87,7 +87,7 @@ let remove_dir dir = if Sys.file_exists dir && Sys.is_directory dir then remove dir else - Lwt.return () + Lwt.return_unit let rec create_dir ?(perm = 0o755) dir = Lwt_unix.file_exists dir >>= function @@ -167,7 +167,7 @@ module Json = struct Lwt_io.with_file ~mode:Output file begin fun chan -> let str = Data_encoding.Json.to_string ~minify:false json in Lwt_io.write chan str >>= fun _ -> - return () + return_unit end end @@ -363,7 +363,7 @@ module Socket = struct (* we set the beginning of the buf with the length of what is next *) MBytes.set_int16 buf 0 encoded_message_len ; write_mbytes fd buf >>= fun () -> - return () + return_unit let recv fd encoding = let header_buf = MBytes.create message_len_size in @@ -383,7 +383,7 @@ module Socket = struct end -let rec retry ?(log=(fun _ -> Lwt.return ())) ?(n=5) ?(sleep=1.) f = +let rec retry ?(log=(fun _ -> Lwt.return_unit)) ?(n=5) ?(sleep=1.) f = f () >>= function | Ok r -> Lwt.return (Ok r) | (Error error) as x -> diff --git a/src/lib_storage/test/test_context.ml b/src/lib_storage/test/test_context.ml index 4a40861ec..1b8730db6 100644 --- a/src/lib_storage/test/test_context.ml +++ b/src/lib_storage/test/test_context.ml @@ -116,7 +116,7 @@ let test_simple { idx ; block2 } = Assert.equal_string_option (Some "Novembre") (c novembre) ; get ctxt ["a";"c"] >>= fun juin -> Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ; - Lwt.return () + Lwt.return_unit let test_continuation { idx ; block3a } = checkout idx block3a >>= function @@ -131,7 +131,7 @@ let test_continuation { idx ; block3a } = Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ; get ctxt ["a";"d"] >>= fun mars -> Assert.equal_string_option ~msg:__LOC__ (Some "Mars") (c mars) ; - Lwt.return () + Lwt.return_unit let test_fork { idx ; block3b } = checkout idx block3b >>= function @@ -146,7 +146,7 @@ let test_fork { idx ; block3b } = Assert.is_none ~msg:__LOC__ (c juin) ; get ctxt ["a";"d"] >>= fun mars -> Assert.equal_string_option ~msg:__LOC__ (Some "Février") (c mars) ; - Lwt.return () + Lwt.return_unit let test_replay { idx ; genesis } = checkout idx genesis >>= function @@ -169,7 +169,7 @@ let test_replay { idx ; genesis } = Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ; get ctxt4b ["a";"d"] >>= fun juillet -> Assert.equal_string_option ~msg:__LOC__ (Some "Juillet") (c juillet) ; - Lwt.return () + Lwt.return_unit let fold_keys s k ~init ~f = let rec loop k acc = @@ -208,7 +208,7 @@ let test_fold { idx ; genesis } = Assert.equal_string_list_list ~msg:__LOC__ [["g";"h"]] l ; keys ctxt ["i"] >>= fun l -> Assert.equal_string_list_list ~msg:__LOC__ [] l ; - Lwt.return () + Lwt.return_unit (******************************************************************************) diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 28c6d1a1e..afe6f80d1 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -189,7 +189,7 @@ let source_to_keys (wallet : #Proto_alpha.full) ~chain ~block source = let save_contract ~force cctxt alias_name contract = RawContractAlias.add ~force cctxt alias_name contract >>=? fun () -> message_added_contract cctxt alias_name >>= fun () -> - return () + return_unit let originate_contract (cctxt : #Proto_alpha.full) @@ -305,7 +305,7 @@ let inject_activate_operation begin match confirmations with | None -> - return () + return_unit | Some _confirmations -> Alpha_services.Contract.balance cctxt (`Main, `Head 0) @@ -315,7 +315,7 @@ let inject_activate_operation Ed25519.Public_key_hash.pp pkh Client_proto_args.tez_sym Tez.pp balance >>= fun () -> - return () + return_unit end >>=? fun () -> match Apply_operation_result.pack_contents_list op result with | Apply_operation_result.Single_and_result diff --git a/src/proto_alpha/lib_client/client_proto_contracts.ml b/src/proto_alpha/lib_client/client_proto_contracts.ml index fee3345ec..a2b7fcbea 100644 --- a/src/proto_alpha/lib_client/client_proto_contracts.ml +++ b/src/proto_alpha/lib_client/client_proto_contracts.ml @@ -141,4 +141,4 @@ let may_check_key sourcePubKey sourcePubKeyHash = (Ed25519.Public_key.hash sourcePubKey) sourcePubKeyHash) (failure "Invalid public key in `client_proto_endorsement`") | None -> - return () + return_unit diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 54e1e6d3e..2a7cc84e4 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -33,7 +33,7 @@ let print_errors (cctxt : #Client_context.printer) errs ~show_source ~parsed = ~show_source ~parsed) errs >>= fun () -> cctxt#error "error running script" >>= fun () -> - return () + return_unit let print_big_map_diff ppf = function | None -> () @@ -60,7 +60,7 @@ let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = fu print_expr storage (Format.pp_print_list Operation_result.pp_internal_operation) operations print_big_map_diff maybe_diff >>= fun () -> - return () + return_unit | Error errs -> print_errors cctxt errs ~show_source ~parsed @@ -74,7 +74,7 @@ let print_trace_result (cctxt : #Client_context.printer) ~show_source ~parsed = (Format.pp_print_list Operation_result.pp_internal_operation) operations print_big_map_diff maybe_big_map_diff print_execution_trace trace >>= fun () -> - return () + return_unit | Error errs -> print_errors cctxt errs ~show_source ~parsed @@ -140,7 +140,7 @@ let print_typecheck_result "(@[<v 0>(types . %a)@ (errors . %a)@])" Michelson_v1_emacs.print_type_map (program, type_map) Michelson_v1_emacs.report_errors (program, errs) >>= fun () -> - return () + return_unit else match res with | Ok (type_map, gas) -> @@ -149,8 +149,8 @@ let print_typecheck_result Gas.pp gas >>= fun () -> if show_types then cctxt#message "%a" Micheline_printer.print_expr program >>= fun () -> - return () - else return () + return_unit + else return_unit | Error errs -> cctxt#warning "%a" (Michelson_v1_error_reporter.report_errors diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml index 7c4a4351b..22972df66 100644 --- a/src/proto_alpha/lib_client/injection.ml +++ b/src/proto_alpha/lib_client/injection.ml @@ -321,13 +321,13 @@ let may_patch_limits | Some contents -> simulate cctxt ~chain ~block ?branch contents >>=? fun (_, _, result) -> begin match detect_script_failure result with - | Ok () -> return () + | Ok () -> return_unit | Error _ -> cctxt#message "@[<v 2>This simulation failed:@,%a@]" Operation_result.pp_operation_result (contents, result.contents) >>= fun () -> - return () + return_unit end >>=? fun () -> let res = pack_contents_list contents result.contents in patch_list res @@ -345,7 +345,7 @@ let inject_operation preapply cctxt ~chain ~block ?branch ?src_sk contents >>=? fun (_oph, op, result) -> begin match detect_script_failure result with - | Ok () -> return () + | Ok () -> return_unit | Error _ as res -> cctxt#message "@[<v 2>This simulation failed:@,%a@]" 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 f6d82947d..00e6e459a 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 @@ -73,7 +73,7 @@ let commands () = then cctxt#message "%Ld" (Time.to_seconds v) else cctxt#message "%s" (Time.to_notation v) end >>= fun () -> - return () + return_unit end ; command ~group ~desc: "Lists all non empty contracts of the block." @@ -85,7 +85,7 @@ let commands () = Lwt_list.iter_s (fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias) contracts >>= fun () -> - return () + return_unit end ; command ~group ~desc: "Get the balance of a contract." @@ -98,7 +98,7 @@ let commands () = ~chain:`Main ~block:cctxt#block contract >>=? fun amount -> cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym >>= fun () -> - return () + return_unit end ; command ~group ~desc: "Get the storage of a contract." @@ -114,7 +114,7 @@ let commands () = cctxt#error "This is not a smart contract." | Some storage -> cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped storage >>= fun () -> - return () + return_unit end ; command ~group ~desc: "Get the manager of a contract." @@ -130,7 +130,7 @@ let commands () = Public_key_hash.to_source manager >>=? fun m -> cctxt#message "%s (%s)" m (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () -> - return () + return_unit end ; command ~group ~desc: "Get the delegate of a contract." @@ -144,13 +144,13 @@ let commands () = contract >>=? function | None -> cctxt#message "none" >>= fun () -> - return () + return_unit | Some delegate -> Public_key_hash.rev_find cctxt delegate >>=? fun mn -> Public_key_hash.to_source delegate >>=? fun m -> cctxt#message "%s (%s)" m (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () -> - return () + return_unit end ; command ~group ~desc: "Set the delegate of a contract." @@ -169,7 +169,7 @@ let commands () = ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run contract (Some delegate) ~fee ~src_pk ~manager_sk >>=? fun _ -> - return () + return_unit end ; command ~group ~desc: "Withdraw the delegate from a contract." @@ -185,7 +185,7 @@ let commands () = ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run contract None ~fee ~src_pk ~manager_sk >>=? fun _ -> - return () + return_unit end ; command ~group ~desc:"Open a new account." @@ -215,10 +215,10 @@ let commands () = ~fee ?delegate ~delegatable ~manager_pkh ~balance ~source ~src_pk ~src_sk () >>=? fun (_res, contract) -> if dry_run then - return () + return_unit else save_contract ~force cctxt alias_name contract >>=? fun () -> - return () + return_unit end ; command ~group ~desc: "Launch a smart contract on the blockchain." @@ -256,13 +256,13 @@ let commands () = ~fee ?gas_limit ?storage_limit ~delegate ~delegatable ~spendable ~initial_storage ~manager ~balance ~source ~src_pk ~src_sk ~code () >>= fun errors -> report_michelson_errors ~no_print_source ~msg:"origination simulation failed" cctxt errors >>= function - | None -> return () + | None -> return_unit | Some (_res, contract) -> if dry_run then - return () + return_unit else save_contract ~force cctxt alias_name contract >>=? fun () -> - return () + return_unit end ; command ~group ~desc: "Transfer tokens / call a smart contract." @@ -286,9 +286,9 @@ let commands () = ~dry_run ~source ~fee ~src_pk ~src_sk ~destination ~arg ~amount ?gas_limit ?storage_limit () >>= report_michelson_errors ~no_print_source ~msg:"transfer simulation failed" cctxt >>= function - | None -> return () + | None -> return_unit | Some (_res, _contracts) -> - return () + return_unit end; command ~group ~desc: "Reveal the public key of the contract manager." @@ -304,7 +304,7 @@ let commands () = reveal cctxt ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations ~source ~fee ~src_pk ~src_sk () >>=? fun _res -> - return () + return_unit end; command ~group ~desc: "Register the public key hash as a delegate." @@ -320,7 +320,7 @@ let commands () = ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run ~fee ~manager_sk:src_sk src_pk >>=? fun _res -> - return () + return_unit end; command ~group ~desc:"Register and activate an Alphanet/Zeronet faucet account." @@ -349,7 +349,7 @@ let commands () = activate_account cctxt ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations ~encrypted ~force key name >>=? fun _res -> - return () + return_unit ); command ~group ~desc:"Activate a fundraiser account." @@ -368,7 +368,7 @@ let commands () = ~block:cctxt#block ?confirmations:cctxt#confirmations ~dry_run name code >>=? fun _res -> - return () + return_unit ); command ~desc:"Wait until an operation is included in a block" @@ -408,7 +408,7 @@ let commands () = (failure "check-previous cannot be negative") >>=? fun () -> Client_confirmations.wait_for_operation_inclusion ctxt ~chain:`Main ~confirmations ~predecessors operation_hash >>=? fun _ -> - return () + return_unit end ; command ~group:binary_description ~desc:"Describe unsigned block header" @@ -419,7 +419,7 @@ let commands () = Data_encoding.Binary_schema.pp (Data_encoding.Binary.describe (Alpha_context.Block_header.unsigned_encoding)) >>= fun () -> - return () + return_unit end ; command ~group:binary_description ~desc:"Describe unsigned block header" @@ -430,7 +430,7 @@ let commands () = Data_encoding.Binary_schema.pp (Data_encoding.Binary.describe Alpha_context.Operation.unsigned_encoding) >>= fun () -> - return () + return_unit end ] diff --git a/src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml index 42e1043cb..686c0a05e 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml @@ -64,6 +64,6 @@ let commands () = @@ stop) (fun () (_, contract) (cctxt : Proto_alpha.full) -> cctxt#message "%a\n%!" Contract.pp contract >>= fun () -> - return ()) ; + return_unit) ; ] diff --git a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml index 9e9680fa7..cf9e35c07 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml @@ -91,7 +91,7 @@ let commands () = (fun () (cctxt : Proto_alpha.full) -> Program.load cctxt >>=? fun list -> Lwt_list.iter_s (fun (n, _) -> cctxt#message "%s" n) list >>= fun () -> - return ()) ; + return_unit) ; command ~group ~desc: "Add a script to the library." (args1 (Program.force_switch ())) @@ -118,7 +118,7 @@ let commands () = (fun () (_, program) (cctxt : Proto_alpha.full) -> Program.to_source program >>=? fun source -> cctxt#message "%s\n" source >>= fun () -> - return ()) ; + return_unit) ; command ~group ~desc: "Ask the node to run a script." (args3 trace_stack_switch amount_arg no_print_source_flag) @@ -161,7 +161,7 @@ let commands () = cctxt#message "(@[<v 0>(types . ())@ (errors . %a)@])" Michelson_v1_emacs.report_errors res_with_errors >>= fun () -> - return () + return_unit | (parsed, errors) -> cctxt#message "%a" (fun ppf () -> @@ -188,7 +188,7 @@ let commands () = | Ok gas -> cctxt#message "@[<v 0>Well typed@,Gas remaining: %a@]" Proto_alpha.Alpha_context.Gas.pp gas >>= fun () -> - return () + return_unit | Error errs -> cctxt#warning "%a" (Michelson_v1_error_reporter.report_errors @@ -230,7 +230,7 @@ let commands () = MBytes.pp_hex (Alpha_environment.Raw_hashes.sha256 bytes) MBytes.pp_hex (Alpha_environment.Raw_hashes.sha512 bytes) Proto_alpha.Alpha_context.Gas.pp remaining_gas >>= fun () -> - return () + return_unit | Error errs -> cctxt#warning "%a" (Michelson_v1_error_reporter.report_errors @@ -253,7 +253,7 @@ let commands () = (fun () bytes sk cctxt -> Client_keys.sign cctxt sk bytes >>=? fun signature -> cctxt#message "Signature: %a" Signature.pp signature >>= fun () -> - return ()) ; + return_unit) ; command ~group ~desc: "Check the signature of a byte sequence as per Michelson \ @@ -273,10 +273,10 @@ let commands () = | false -> cctxt#error "invalid signature" | true -> if quiet then - return () + return_unit else cctxt#message "Signature check successfull." >>= fun () -> - return () + return_unit ) ; ] diff --git a/src/proto_alpha/lib_delegate/client_baking_denunciation.ml b/src/proto_alpha/lib_delegate/client_baking_denunciation.ml index 0883e60cf..5f983789e 100644 --- a/src/proto_alpha/lib_delegate/client_baking_denunciation.ml +++ b/src/proto_alpha/lib_delegate/client_baking_denunciation.ml @@ -94,9 +94,9 @@ let process_endorsements (cctxt : #Proto_alpha.full) state ~chain | _ -> lwt_log_error "Inconsistent endorsement found %a" Operation_hash.pp hash >>= fun () -> - return () + return_unit ) endorsements >>=? fun () -> - return () + return_unit let process_block (cctxt : #Proto_alpha.full) state ~chain (header : Alpha_block_services.block_info) = let { Alpha_block_services.hash ; metadata = { protocol_data = { baker ; level = { level } } } } = header in @@ -167,7 +167,7 @@ let endorsements_index = 0 let process_new_block (cctxt : #Proto_alpha.full) state { hash ; chain_id ; level ; protocol ; next_protocol } = if Protocol_hash.(protocol <> next_protocol) then lwt_log_error "Protocol changing detected. Skipping the block." >>= fun () -> - return () + return_unit else lwt_debug "Block level : %a" Raw_level.pp level >>= fun () -> let chain = `Hash chain_id in @@ -182,7 +182,7 @@ let process_new_block (cctxt : #Proto_alpha.full) state { hash ; chain_id ; leve lwt_log_error "Error while fetching operations in block %a@\n%a" Block_hash.pp_short hash pp_print_error errs >>= fun () -> - return () + return_unit end >>=? fun () -> (* Processing endorsements *) begin Alpha_block_services.Operations.operations cctxt ~chain ~block () >>= function @@ -190,15 +190,15 @@ let process_new_block (cctxt : #Proto_alpha.full) state { hash ; chain_id ; leve if List.length operations > endorsements_index then let endorsements = List.nth operations endorsements_index in process_endorsements cctxt state ~chain endorsements level - else return () + else return_unit | Error errs -> lwt_log_error "Error while fetching operations in block %a@\n%a" Block_hash.pp_short hash pp_print_error errs >>= fun () -> - return () + return_unit end >>=? fun () -> cleanup_old_operations state ; - return () + return_unit let create (cctxt : #Proto_alpha.full) ~preserved_levels valid_blocks_stream = @@ -225,7 +225,7 @@ let create (cctxt : #Proto_alpha.full) ~preserved_levels valid_blocks_stream = ~cctxt ~stream:valid_blocks_stream ~state_maker - ~pre_loop:(fun _ _ _ -> return ()) + ~pre_loop:(fun _ _ _ -> return_unit) ~compute_timeout:(fun _ -> Lwt_utils.never_ending ()) - ~timeout_k:(fun _ _ () -> return ()) + ~timeout_k:(fun _ _ () -> return_unit) ~event_k:process_block diff --git a/src/proto_alpha/lib_delegate/client_baking_endorsement.ml b/src/proto_alpha/lib_delegate/client_baking_endorsement.ml index 19005456e..74cf3557d 100644 --- a/src/proto_alpha/lib_delegate/client_baking_endorsement.ml +++ b/src/proto_alpha/lib_delegate/client_baking_endorsement.ml @@ -39,12 +39,12 @@ let inject_endorsement let check_endorsement cctxt level pkh = State.get cctxt pkh >>=? function - | None -> return () + | None -> return_unit | Some recorded_level -> if Raw_level.(level = recorded_level) then Error_monad.failwith "Level %a already endorsed" Raw_level.pp recorded_level else - return () + return_unit let previously_endorsed_level cctxt pkh new_lvl = State.get cctxt pkh >>=? function @@ -116,7 +116,7 @@ let endorse_for_delegate cctxt block delegate = Raw_level.pp level name Operation_hash.pp_short oph >>= fun () -> - return () + return_unit let allowed_to_endorse cctxt bi delegate = Client_keys.Public_key_hash.name cctxt delegate >>=? fun name -> @@ -144,7 +144,7 @@ let prepare_endorsement ~(max_past:int64) () (cctxt : #Proto_alpha.full) state b if Time.diff (Time.now ()) bi.Client_baking_blocks.timestamp > max_past then lwt_log_info "Ignore block %a: forged too far the past" Block_hash.pp_short bi.hash >>= fun () -> - return () + return_unit else lwt_log_info "Received new block %a" Block_hash.pp_short bi.hash >>= fun () -> @@ -158,7 +158,7 @@ let prepare_endorsement ~(max_past:int64) () (cctxt : #Proto_alpha.full) state b block = bi ; delegates ; } ; - return () + return_unit let compute_timeout state = match state.pending with diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index 673902bfb..b66a8ed31 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -409,7 +409,7 @@ let compute_timeout { future_slots } = | (timestamp, _) :: _ -> match Client_baking_scheduling.sleep_until timestamp with | None -> - Lwt.return () + Lwt.return_unit | Some timeout -> timeout @@ -470,7 +470,7 @@ let insert_block | [] -> lwt_debug "Can't compute slots for %a" Block_hash.pp_short bi.hash >>= fun () -> - return () + return_unit | (_ :: _) as slots -> iter_p (fun ((timestamp, (_, _, delegate)) as slot) -> @@ -480,7 +480,7 @@ let insert_block name Block_hash.pp_short bi.hash >>= fun () -> state.future_slots <- insert_baking_slot slot state.future_slots ; - return () + return_unit ) slots @@ -657,7 +657,7 @@ let record_nonce_hash cctxt block_hash seed_nonce seed_nonce_hash = Client_baking_nonces.add cctxt block_hash seed_nonce |> trace_exn (Failure "Error while recording block") else - return () + return_unit let pp_operation_list_list = Format.pp_print_list @@ -724,12 +724,12 @@ let bake Raw_level.pp level priority Fitness.pp shell_header.fitness pp_operation_list_list operations >>= fun () -> - return () + return_unit end | _ -> (* no candidates, or none fit-enough *) lwt_debug "No valid candidates." >>= fun () -> - return () + return_unit diff --git a/src/proto_alpha/lib_delegate/client_baking_lib.ml b/src/proto_alpha/lib_delegate/client_baking_lib.ml index 3269ba233..faf906f48 100644 --- a/src/proto_alpha/lib_delegate/client_baking_lib.ml +++ b/src/proto_alpha/lib_delegate/client_baking_lib.ml @@ -47,13 +47,13 @@ let bake_block (cctxt : #Proto_alpha.full) let src_pkh = Signature.Public_key.hash src_pk in Client_baking_forge.State.record cctxt src_pkh level.level >>=? fun () -> begin match seed_nonce with - | None -> return () + | None -> return_unit | Some seed_nonce -> Client_baking_nonces.add cctxt block_hash seed_nonce |> trace_exn (Failure "Error while recording block") end >>=? fun () -> cctxt#message "Injected block %a" Block_hash.pp_short block_hash >>= fun () -> - return () + return_unit let endorse_block cctxt delegate = Client_keys.get_key cctxt delegate >>=? fun (_src_name, src_pk, src_sk) -> @@ -61,7 +61,7 @@ let endorse_block cctxt delegate = cctxt#block ~src_sk src_pk >>=? fun oph -> cctxt#answer "Operation successfully injected in the node." >>= fun () -> cctxt#answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> - return () + return_unit let get_predecessor_cycle (cctxt : #Client_context.printer) cycle = match Cycle.pred cycle with @@ -79,7 +79,7 @@ let do_reveal cctxt block blocks = Client_baking_revelation.forge_seed_nonce_revelation cctxt block nonces >>=? fun () -> Client_baking_nonces.dels cctxt (List.map fst blocks) >>=? fun () -> - return () + return_unit let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes = Lwt_list.filter_map_p diff --git a/src/proto_alpha/lib_delegate/client_baking_revelation.ml b/src/proto_alpha/lib_delegate/client_baking_revelation.ml index c7ab41b54..6f97aac2e 100644 --- a/src/proto_alpha/lib_delegate/client_baking_revelation.ml +++ b/src/proto_alpha/lib_delegate/client_baking_revelation.ml @@ -29,7 +29,7 @@ let forge_seed_nonce_revelation | [] -> cctxt#message "No nonce to reveal for block %a" Block_hash.pp_short hash >>= fun () -> - return () + return_unit | _ -> inject_seed_nonce_revelation cctxt ~chain block nonces >>=? fun oph -> cctxt#answer @@ -38,4 +38,4 @@ let forge_seed_nonce_revelation Block_hash.pp_short hash >>= fun () -> cctxt#answer "@[<v 2>Operation hash are:@ %a@]" (Format.pp_print_list Operation_hash.pp_short) oph >>= fun () -> - return () + return_unit diff --git a/src/proto_alpha/lib_delegate/client_baking_simulator.ml b/src/proto_alpha/lib_delegate/client_baking_simulator.ml index 2b36529bf..f2c4e43f1 100644 --- a/src/proto_alpha/lib_delegate/client_baking_simulator.ml +++ b/src/proto_alpha/lib_delegate/client_baking_simulator.ml @@ -77,4 +77,4 @@ let add_operation st ( op : Operation.packed ) = return { st with state ; rev_operations = op :: st.rev_operations } let finalize_construction inc = - Main.finalize_block inc.state >>=? fun _ -> return () + Main.finalize_block inc.state >>=? fun _ -> return_unit diff --git a/src/proto_alpha/lib_delegate/client_daemon.ml b/src/proto_alpha/lib_delegate/client_daemon.ml index 811d55359..8e8e2fa6f 100644 --- a/src/proto_alpha/lib_delegate/client_daemon.ml +++ b/src/proto_alpha/lib_delegate/client_daemon.ml @@ -14,7 +14,7 @@ module Endorser = struct cctxt `Main >>=? fun block_stream -> Client_baking_endorsement.create cctxt ~delay delegates block_stream >>=? fun () -> ignore min_date; - return () + return_unit end @@ -26,7 +26,7 @@ module Baker = struct Client_baking_forge.create cctxt ?threshold ?max_priority ~context_path delegates block_stream >>=? fun () -> ignore min_date; - return () + return_unit end @@ -35,6 +35,6 @@ module Accuser = struct let run (cctxt : #Proto_alpha.full) ~preserved_levels = Client_baking_blocks.monitor_valid_blocks cctxt ~chains:[ `Main ] () >>=? fun valid_blocks_stream -> Client_baking_denunciation.create cctxt ~preserved_levels valid_blocks_stream >>=? fun () -> - return () + return_unit end 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 a02a0609f..279e94025 100644 --- a/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml @@ -36,7 +36,7 @@ let no_write_context ?(block = `Head 0) config : #Client_context.full = object method write : type a. string -> a -> a Data_encoding.encoding -> unit Error_monad.tzresult Lwt.t = - fun _ _ _ -> return () + fun _ _ _ -> return_unit method with_lock : type a. (unit -> a Lwt.t) -> a Lwt.t = fun f -> f () method block = block method confirmations = None @@ -614,7 +614,7 @@ let display_level block = Alpha_block_services.metadata !rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } -> Format.eprintf "Level: %a@." Level.pp_full level ; - return () + return_unit let endorsement_security_deposit block = Constants_services.all !rpc_ctxt (`Main, block) >>=? fun c -> diff --git a/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml b/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml index 48aebdfe0..ffbe96d9d 100644 --- a/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml +++ b/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml @@ -65,7 +65,7 @@ let test_known_tez_litterals () = let vs = Tez_repr.of_string s in Assert.is_none ~msg:("Unexpected successful parsing of " ^ s) vs) known_bad_tez_litterals ; - return () + return_unit let test_random_tez_litterals () = for _ = 0 to 100_000 do @@ -91,7 +91,7 @@ let test_random_tez_litterals () = Assert.equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev end done ; - return () + return_unit open Tezos_micheline open Micheline diff --git a/src/proto_alpha/lib_delegate/test/test_rpc.ml b/src/proto_alpha/lib_delegate/test/test_rpc.ml index 4f72ed8a1..3f91fb4eb 100644 --- a/src/proto_alpha/lib_delegate/test/test_rpc.ml +++ b/src/proto_alpha/lib_delegate/test/test_rpc.ml @@ -50,10 +50,10 @@ let run blkid = let res = predicate result in Format.eprintf "/%s (%d) -> %B@." (String.concat "/" path) depth res ; success := !success && res ; - return () + return_unit ) tests >>=? fun () -> if !success then - return () + return_unit else failwith "Error!" diff --git a/src/proto_alpha/lib_delegate/test/test_vote.ml b/src/proto_alpha/lib_delegate/test/test_vote.ml index dc1d832df..528e57b85 100644 --- a/src/proto_alpha/lib_delegate/test/test_vote.ml +++ b/src/proto_alpha/lib_delegate/test/test_vote.ml @@ -90,7 +90,7 @@ let rpc_port = try int_of_string Sys.argv.(2) with _ -> 18400 let change_to_demo_proto () = init ~exe ~vote:true ~rpc_port () >>=? fun (_node_pid, hash) -> run_change_to_demo_proto (`Hash (hash, 0)) Account.bootstrap_accounts >>=? fun _blkh -> - return () + return_unit let tests = [ "change_to_demo_proto", (fun _ -> change_to_demo_proto ()) ; diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 9f210297c..007fb0e8b 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -350,13 +350,13 @@ let apply_manager_operation_content : match script with | None -> begin match parameters with - | None -> return () + | None -> return_unit | Some arg -> Lwt.return (Script.force_decode arg) >>=? fun arg -> match Micheline.root arg with | Prim (_, D_Unit, [], _) -> (* Allow [Unit] parameter to non-scripted contracts. *) - return () + return_unit | _ -> fail (Script_interpreter.Bad_contract_parameter destination) end >>=? fun () -> let result = diff --git a/src/proto_alpha/lib_protocol/src/baking.ml b/src/proto_alpha/lib_protocol/src/baking.ml index 0f2e2af1b..c4d5b5910 100644 --- a/src/proto_alpha/lib_protocol/src/baking.ml +++ b/src/proto_alpha/lib_protocol/src/baking.ml @@ -237,7 +237,7 @@ let check_proof_of_work_stamp ctxt block = block.Block_header.shell block.protocol_data.contents proof_of_work_threshold then - return () + return_unit else fail Invalid_stamp @@ -250,7 +250,7 @@ let check_signature block key = (shell, contents) in Signature.check ~watermark:Block_header key signature unsigned_header in if check_signature key block then - return () + return_unit else fail (Invalid_block_signature (Block_header.hash block, Signature.Public_key.hash key)) @@ -266,7 +266,7 @@ let check_fitness_gap ctxt (block : Block_header.t) = if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap)) else - return () + return_unit let last_of_a_cycle ctxt l = Compare.Int32.(Int32.succ l.Level.cycle_position = diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index 918739a71..2af9e8dec 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -285,12 +285,12 @@ let exists c contract = let must_exist c contract = exists c contract >>=? function - | true -> return () + | true -> return_unit | false -> fail (Non_existing_contract contract) let must_be_allocated c contract = allocated c contract >>=? function - | true -> return () + | true -> return_unit | false -> match Contract_repr.is_implicit contract with | Some pkh -> fail (Empty_implicit_contract pkh) @@ -315,7 +315,7 @@ let check_counter_increment c contract counter = Storage.Contract.Counter.get c contract >>=? fun contract_counter -> let expected = Z.succ contract_counter in if Compare.Z.(expected = counter) - then return () + then return_unit else if Compare.Z.(expected > counter) then fail (Counter_in_the_past (contract, expected, counter)) else diff --git a/src/proto_alpha/lib_protocol/src/delegate_storage.ml b/src/proto_alpha/lib_protocol/src/delegate_storage.ml index 3c69d5971..c71adb5b0 100644 --- a/src/proto_alpha/lib_protocol/src/delegate_storage.ml +++ b/src/proto_alpha/lib_protocol/src/delegate_storage.ml @@ -195,11 +195,11 @@ let set_base c is_delegatable contract delegate = when Signature.Public_key_hash.equal delegate current_delegate -> if self_delegation then Storage.Contract.Inactive_delegate.mem c contract >>= function - | true -> return () + | true -> return_unit | false -> fail Active_delegate else fail Current_delegate - | None | Some _ -> return () + | None | Some _ -> return_unit end >>=? fun () -> Storage.Contract.Balance.mem c contract >>= fun exists -> fail_when diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml index b60ca4135..17aef6430 100644 --- a/src/proto_alpha/lib_protocol/src/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml @@ -491,10 +491,10 @@ module Parse = struct Lwt.return (parse_operation raw) >>=? fun op -> begin match check with | Some true -> - return () (* FIXME *) + return_unit (* FIXME *) (* I.check_signature ctxt *) (* op.protocol_data.signature op.shell op.protocol_data.contents *) - | Some false | None -> return () + | Some false | None -> return_unit end >>|? fun () -> op end operations end ; diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index 6d63c60d0..f2fe667a6 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/src/proto_alpha/lib_protocol/src/raw_context.ml @@ -398,7 +398,7 @@ let check_inited ctxt = | Some bytes -> let s = MBytes.to_string bytes in if Compare.String.(s = version_value) then - return () + return_unit else storage_error (Incompatible_protocol_version s) @@ -432,13 +432,13 @@ let prepare ~level ~timestamp ~fitness ctxt = let check_first_block ctxt = Context.get ctxt version_key >>= function - | None -> return () + | None -> return_unit | Some bytes -> let s = MBytes.to_string bytes in if Compare.String.(s = version_value) then failwith "Internal error: previously initialized context." else if Compare.String.(s = "genesis") then - return () + return_unit else storage_error (Incompatible_protocol_version s) diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index 8d487fdcc..f5972a3ad 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -730,11 +730,11 @@ let rec interp logged_return (Item (amount, rest), ctxt) in let stack = (Item (arg, Empty)) in begin match log with - | None -> return () + | None -> return_unit | Some log -> unparse_stack ctxt (stack, code.bef) >>=? fun stack -> log := (code.loc, Gas.level ctxt, stack) :: !log ; - return () + return_unit end >>=? fun () -> step ctxt code stack >>=? fun (Item (ret, Empty), ctxt) -> return (ret, ctxt) diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index c26d2d96f..3595dd044 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -363,7 +363,7 @@ let unexpected expr exp_kinds exp_ns exp_prims = let check_kind kinds expr = let kind = kind expr in if List.mem kind kinds then - return () + return_unit else let loc = location expr in fail (Invalid_kind (loc, kinds, kind)) @@ -1147,8 +1147,8 @@ let rec parse_data if Compare.Int.(0 = (compare_comparable key_type value k)) then fail (Duplicate_map_keys (loc, strip_locations expr)) else fail (Unordered_map_keys (loc, strip_locations expr)) - else return () - | None -> return () + else return_unit + | None -> return_unit end >>=? fun () -> return (Some k, map_update k (Some (item_wrapper v)) map, ctxt) | Prim (loc, D_Elt, l, _) -> @@ -1403,8 +1403,8 @@ let rec parse_data if Compare.Int.(0 = (compare_comparable t value v)) then fail (Duplicate_set_values (loc, strip_locations expr)) else fail (Unordered_set_values (loc, strip_locations expr)) - else return () - | None -> return () + else return_unit + | None -> return_unit end >>=? fun () -> Lwt.return (Gas.consume ctxt (Michelson_v1_gas.Cost_of.set_update v false set)) >>=? fun ctxt -> return (Some v, set_update v true set, ctxt)) diff --git a/src/proto_alpha/lib_protocol/src/storage_description.ml b/src/proto_alpha/lib_protocol/src/storage_description.ml index c74b8b127..df46401e4 100644 --- a/src/proto_alpha/lib_protocol/src/storage_description.ml +++ b/src/proto_alpha/lib_protocol/src/storage_description.ml @@ -173,7 +173,7 @@ type _ opt_handler = let rec combine_object = function | [] -> Handler { encoding = Data_encoding.unit ; - get = fun _ _ -> return () } + get = fun _ _ -> return_unit } | (name, Opt_handler handler) :: fields -> let Handler handlers = combine_object fields in Handler { encoding = diff --git a/src/proto_alpha/lib_protocol/test/activation.ml b/src/proto_alpha/lib_protocol/test/activation.ml index fa5807b72..8bf377d6d 100644 --- a/src/proto_alpha/lib_protocol/test/activation.ml +++ b/src/proto_alpha/lib_protocol/test/activation.ml @@ -168,7 +168,7 @@ let activation_init () = let simple_init_with_commitments () = activation_init () >>=? fun (blk, _contracts, _secrets) -> Block.bake blk >>=? fun _ -> - return () + return_unit (** A single activation *) let single_activation () = @@ -196,7 +196,7 @@ let multi_activation_1 () = return blk ) blk secrets >>=? fun _ -> - return () + return_unit (** All in one bake *) let multi_activation_2 () = diff --git a/src/proto_alpha/lib_protocol/test/delegation.ml b/src/proto_alpha/lib_protocol/test/delegation.ml index 44a1e4eee..a8e7a19b0 100644 --- a/src/proto_alpha/lib_protocol/test/delegation.ml +++ b/src/proto_alpha/lib_protocol/test/delegation.ml @@ -19,7 +19,7 @@ open Test_tez interpret the other tests that use them. *) let expect_error err = function - | err0 :: _ when err = err0 -> return () + | err0 :: _ when err = err0 -> return_unit | _ -> failwith "Unexpected successful result" let expect_alpha_error err = @@ -27,13 +27,13 @@ let expect_alpha_error err = let expect_non_delegatable_contract = function | Alpha_environment.Ecoproto_error (Delegate_storage.Non_delegatable_contract _) :: _ -> - return () + return_unit | _ -> failwith "Contract is not delegatable and operation should fail." let expect_no_deletion_pkh pkh = function | Alpha_environment.Ecoproto_error (Delegate_storage.No_deletion pkh0) :: _ when pkh0 = pkh -> - return () + return_unit | _ -> failwith "Delegate can not be deleted and operation should fail." @@ -115,7 +115,7 @@ let bootstrap_manager_already_registered_delegate ~fee () = begin Incremental.add_operation ~expect_failure:(function | Alpha_environment.Ecoproto_error Delegate_storage.Active_delegate :: _ -> - return () + return_unit | _ -> failwith "Delegate is already active and operation should fail.") i sec_reg >>=? fun i -> @@ -147,7 +147,7 @@ let delegate_to_bootstrap_by_origination ~fee () = begin Incremental.add_operation i ~expect_failure:(function | Alpha_environment.Ecoproto_error Contract.Balance_too_low _ :: _ -> - return () + return_unit | _ -> failwith "Not enough balance for origination burn: operation should fail.") op >>=? fun i -> @@ -307,7 +307,7 @@ Not credited: let expect_unregistered_key pkh = function | Alpha_environment.Ecoproto_error Roll_storage.Unregistered_delegate pkh0 :: _ - when pkh = pkh0 -> return () + when pkh = pkh0 -> return_unit | _ -> failwith "Delegate key is not registered: operation should fail." (* A1: no self-delegation *) @@ -893,7 +893,7 @@ let double_registration () = (* credit 1μꜩ+ check balance *) Op.transaction (I i) bootstrap impl_contract (Tez.one_mutez) >>=? fun create_contract -> Incremental.add_operation i create_contract >>=? fun i -> - (* return () *) + (* return_unit *) (* self-delegation *) Op.delegation (I i) impl_contract (Some pkh) >>=? fun self_delegation -> Incremental.add_operation i self_delegation >>=? fun i -> diff --git a/src/proto_alpha/lib_protocol/test/double_baking.ml b/src/proto_alpha/lib_protocol/test/double_baking.ml index 2f559f44b..939fb6abe 100644 --- a/src/proto_alpha/lib_protocol/test/double_baking.ml +++ b/src/proto_alpha/lib_protocol/test/double_baking.ml @@ -91,7 +91,7 @@ let same_blocks () = Assert.proto_error ~loc:__LOC__ res begin function | Apply.Invalid_double_baking_evidence _ -> true | _ -> false end >>=? fun () -> - return () + return_unit (** Check that a double baking operation exposing two blocks with different levels fails *) diff --git a/src/proto_alpha/lib_protocol/test/helpers/assert.ml b/src/proto_alpha/lib_protocol/test/helpers/assert.ml index 5e70ed738..9fbb162f5 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/assert.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/assert.ml @@ -12,7 +12,7 @@ open Proto_alpha let error ~loc v f = match v with | Error err when List.exists f err -> - return () + return_unit | Ok _ -> failwith "Unexpected successful result (%s)" loc | Error err -> @@ -28,13 +28,13 @@ let equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b = if not (cmp a b) then failwith "@[@[[%s]@] - @[%s : %a is not equal to %a@]@]" loc msg pp a pp b else - return () + return_unit let not_equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b = if cmp a b then failwith "@[@[[%s]@] - @[%s : %a is equal to %a@]@]" loc msg pp a pp b else - return () + return_unit (* tez *) let equal_tez ~loc (a:Alpha_context.Tez.t) (b:Alpha_context.Tez.t) = diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index 930d9cc4d..73bb10eca 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -252,7 +252,7 @@ let genesis else return acc ) Tez_repr.zero initial_accounts >>=? fun _ -> failwith "Insufficient tokens in initial accounts to create one roll" - with Exit -> return () + with Exit -> return_unit end >>=? fun () -> let constants : Constants_repr.parametric = { diff --git a/src/proto_alpha/lib_protocol/test/origination.ml b/src/proto_alpha/lib_protocol/test/origination.ml index e18829641..9ae4a9e8f 100644 --- a/src/proto_alpha/lib_protocol/test/origination.ml +++ b/src/proto_alpha/lib_protocol/test/origination.ml @@ -132,7 +132,7 @@ let regular () = Context.get_endorser (B b) >>=? fun (account, _slots) -> Op.delegation (B b) new_contract (Some account) >>=? fun operation -> Block.bake ~operation b >>=? fun _ -> - return () + return_unit (*******************) (** ask source contract to pay a fee when originating a contract *) @@ -141,7 +141,7 @@ let regular () = let pay_fee () = register_origination ~credit:(Tez.of_int 2) ~fee:ten_tez () >>=? fun (b, contract, new_contract) -> transfer_and_check_balances b new_contract contract (Tez.of_int 2) >>=? fun _ -> - return () + return_unit (******************************************************) (** Errors *) @@ -189,7 +189,7 @@ let undelegatable fee () = begin let expect_failure = function | Alpha_environment.Ecoproto_error (Delegate_storage.Non_delegatable_contract _) :: _ -> - return () + return_unit | _ -> failwith "The contract is not delegatable, it fails!" in @@ -225,7 +225,7 @@ let credit fee () = begin let not_enough_money = function | Alpha_environment.Ecoproto_error (Proto_alpha.Contract_storage.Balance_too_low _) :: _ -> - return () + return_unit | _ -> failwith "The contract does not have enough money, it fails!" in Incremental.add_operation ~expect_failure:not_enough_money i operation >>=? fun i -> @@ -259,7 +259,7 @@ let origination_contract_from_origination_contract_not_enough_fund fee () = Op.origination ~fee (I inc) ~credit:amount contract >>=? fun (operation, orig_contract) -> let expect_failure = function | Alpha_environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> - return () + return_unit | _ -> failwith "The contract has not enough funds, it fails!" in @@ -378,7 +378,6 @@ let origination_contract_from_origination_contract () = Context.Contract.balance (B b) orig_contract >>=? fun credit0 -> Assert.equal_tez ~loc:__LOC__ credit0 credit - (******************************************************) let tests = [ diff --git a/src/proto_alpha/lib_protocol/test/transfer.ml b/src/proto_alpha/lib_protocol/test/transfer.ml index 6832912ba..e007784ea 100644 --- a/src/proto_alpha/lib_protocol/test/transfer.ml +++ b/src/proto_alpha/lib_protocol/test/transfer.ml @@ -68,7 +68,7 @@ let single_transfer ?fee ?expect_failure amount = transfer_and_check_balances ~loc:__LOC__ ?fee ?expect_failure b contract_1 contract_2 amount >>=? fun (b,_) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** single transfer without fee *) let block_with_a_single_transfer () = @@ -79,7 +79,7 @@ let transfer_zero_tez () = single_transfer ~expect_failure:( function | Alpha_environment.Ecoproto_error (Contract_storage.Empty_transaction _) :: _ -> - return () + return_unit | _ -> failwith "Empty transaction should fail") Tez.zero @@ -101,7 +101,7 @@ let block_originate_and_transfer_with_fee () = Incremental.add_operation b operation >>=? fun b -> transfer_and_check_balances ~loc:__LOC__ b ~fee:ten_tez contract new_contract ten_tez >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block, and two contracts; 2- Add a transfer from a current balance of a source contract @@ -113,7 +113,7 @@ let block_transfer_from_contract_balance () = Context.Contract.balance (I b) contract_1 >>=? fun balance -> transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 balance >>=? fun (b,_) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block and a single contract; 2- Add a transfer to a contract itself without fee into this block; @@ -128,7 +128,7 @@ let block_transfers_without_with_fee_to_self () = transfer_to_itself_and_check_balances ~loc:__LOC__ b ~fee:ten_tez contract ten_tez >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block, two contracts; 2- Add three transfers into the block; @@ -140,7 +140,7 @@ let four_transfers_bake_three_transfers () = n_transactions 3 b contract_1 contract_2 ten_tez >>=? fun b -> Op.transaction (I b) contract_1 contract_2 ten_tez >>=? fun _ -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a contract from a bootstrap contract; 2- Create two implicit contracts; @@ -163,7 +163,7 @@ let transfer_from_implicit_to_implicit_contract () = transfer_and_check_balances ~loc:__LOC__ ~fee:(Tez.of_int 3) b src dest ten_tez >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block, contract from bootstrap accounts, contract from originate; 2- Add a transfer from the bootstract contract into the implicit contract; @@ -183,7 +183,7 @@ let transfer_from_implicit_to_originated_contract () = transfer_and_check_balances ~loc:__LOC__ b src new_contract Alpha_context.Tez.one >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block with 2 contracts; 2- Originate 2 contracts from the previous ones; @@ -199,7 +199,7 @@ let transfer_from_originated_to_originated () = transfer_and_check_balances ~loc:__LOC__ b orig_contract_1 orig_contract_2 Alpha_context.Tez.one >>=? fun (b,_) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block, an originate contract, an impicit contract, a contract from bootstrap; @@ -216,7 +216,7 @@ let transfer_from_originated_to_implicit () = transfer_and_check_balances ~loc:__LOC__ b new_contract src Alpha_context.Tez.one >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** Checking that the sender of a transaction is the actual manager of the contract. @@ -231,7 +231,7 @@ let ownership_sender () = transfer_and_check_balances ~loc:__LOC__ b imcontract_1 contract_2 Tez.one >>=? fun (b,_) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (* Slow tests case *) @@ -240,7 +240,7 @@ let multiple_transfer n ?fee amount = Incremental.begin_construction b >>=? fun b -> n_transactions n b ?fee contract_1 contract_2 amount >>=? fun b -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block with two contracts; 2- Apply 100 transfers. *) @@ -280,7 +280,7 @@ let block_with_multiple_transfers_with_without_fee () = n_transactions 20 ~fee:ten b contracts.(1) contracts.(0) twenty >>=? fun b -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** 1- Create a block with two contracts; 2- Bake 10 blocks with a transfer each time. *) @@ -293,7 +293,7 @@ let build_a_chain () = >>=? fun (b, _) -> Incremental.finalize_block b ) b (1 -- 10) >>=? fun _ -> - return () + return_unit (*********************************************************************) (* Expected error test cases *) @@ -314,13 +314,13 @@ let balance_too_low fee () = Op.transaction ~fee (I i) contract_1 contract_2 Tez.max_tez >>=? fun op -> let expect_failure = function | Alpha_environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> - return () + return_unit | _ -> failwith "balance too low should fail" in if fee > balance1 then begin Incremental.add_operation ~expect_failure i op >>= fun _res -> - return () + return_unit end else begin Incremental.add_operation ~expect_failure i op >>=? fun i -> @@ -352,7 +352,7 @@ let balance_too_low_two_transfers fee () = two_third_of_balance >>=? fun operation -> let expect_failure = function | Alpha_environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> - return () + return_unit | _ -> failwith "balance too low should fail" in @@ -446,7 +446,7 @@ let random_transfer () = transfer_and_check_balances ~loc:__LOC__ b source dest amount end >>=? fun (b,_) -> Incremental.finalize_block b >>=? fun _ -> - return () + return_unit (** Transfer random transactions *) let random_multi_transactions () = diff --git a/src/proto_demo/lib_client/client_proto_main.ml b/src/proto_demo/lib_client/client_proto_main.ml index 08f39ce9a..0055ed3e1 100644 --- a/src/proto_demo/lib_client/client_proto_main.ml +++ b/src/proto_demo/lib_client/client_proto_main.ml @@ -21,17 +21,17 @@ let demo cctxt = cctxt.message "Calling the 'failing' RPC." >>= fun () -> Client_proto_rpcs.failing cctxt.rpc_config block 3 >>= function | Error [Environment.Ecoproto_error [Error.Demo_error 3]] -> - return () + return_unit | _ -> failwith "..." end >>=? fun () -> cctxt.message "Direct call to `demo_error`." >>= fun () -> begin Error.demo_error 101010 >|= Environment.wrap_error >>= function | Error [Environment.Ecoproto_error [Error.Demo_error 101010]] -> - return () + return_unit | _ -> failwith "...." end >>=? fun () -> cctxt.answer "All good!" >>= fun () -> - return () + return_unit let bake cctxt = Client_node_rpcs.Blocks.info cctxt.rpc_config block >>=? fun bi -> @@ -56,7 +56,7 @@ let bake cctxt = proto = MBytes.create 0 } >>=? fun bytes -> Client_node_rpcs.inject_block cctxt.rpc_config ~chain_id:bi.chain_id bytes [] >>=? fun hash -> cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () -> - return () + return_unit let handle_error cctxt = function | Ok res -> diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index ba4d896c8..f69dc91f0 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -77,7 +77,7 @@ let commands () = (Activate { protocol = hash ; fitness ; protocol_parameters }) sk >>=? fun hash -> cctxt#answer "Injected %a" Block_hash.pp_short hash >>= fun () -> - return () + return_unit end ; command ~desc: "Fork a test protocol" @@ -94,7 +94,7 @@ let commands () = delay = Int64.mul 24L 3600L }) sk >>=? fun hash -> cctxt#answer "Injected %a" Block_hash.pp_short hash >>= fun () -> - return () + return_unit end ; ] diff --git a/src/proto_genesis/lib_protocol/src/data.ml b/src/proto_genesis/lib_protocol/src/data.ml index d24e9e78a..2877f1d9d 100644 --- a/src/proto_genesis/lib_protocol/src/data.ml +++ b/src/proto_genesis/lib_protocol/src/data.ml @@ -128,7 +128,7 @@ module Init = struct | Some version -> if Compare.String.(version_value <> MBytes.to_string version) then failwith "Internal error: incompatible protocol version" ; - return () + return_unit let tag_first_block ctxt = Context.get ctxt version_key >>= function