balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Everywhere: return_unit

Browse Source
This commit is contained in:
Raphaël Proust 2018-06-26 17:07:12 +08:00 committed by Grégoire Henry
parent 7fcd986b93
commit 103d5355f2
93 changed files with 413 additions and 406 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/bin_attacker/attacker_minimal.ml
View File

@ -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

10
src/bin_client/client_protocols_commands.ml
View File

@ -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
) ;
]

34
src/bin_client/client_rpc_commands.ml
View File

@ -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 "@,@[<v 2>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
"@[<v 0>\
@ -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
"@[<v 0>\
@[<v 2>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

10
src/bin_client/main_client.ml
View File

@ -19,7 +19,7 @@ let display_warning_banner ctxt =
\ Use your fundraiser keys @{<warning>AT YOUR OWN RISK@}.@,\
All transactions happening on the Betanet @{<warning>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 =
\ @{<warning>Tezos Zeronet DEVELOPMENT NETWORK@}.@,\
\ Do @{<warning>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
"@[<v 2>@{<warning>@{<title>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 =

2
src/bin_client/test/demo/main.ml
View File

@ -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

2
src/bin_node/node_config_command.ml
View File

@ -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

2
src/bin_node/node_data_version.ml
View File

@ -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 () =

6
src/bin_node/node_identity_command.ml
View File

@ -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 *)

6
src/bin_node/node_run_command.ml
View File

@ -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

8
src/bin_signer/handler.ml
View File

@ -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 () ->

2
src/bin_signer/main_signer.ml
View File

@ -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

6
src/bin_signer/socket_daemon.ml
View File

@ -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

6
src/lib_clic/clic.ml
View File

@ -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 =

12
src/lib_client_base/client_aliases.ml
View File

@ -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

8
src/lib_client_base/client_confirmations.ml
View File

@ -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)

2
src/lib_client_base/client_keys.ml
View File

@ -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

4
src/lib_client_base_unix/client_context_unix.ml
View File

@ -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 () ->

4
src/lib_client_base_unix/client_main_run.ml
View File

@ -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

2
src/lib_client_commands/client_admin_commands.ml
View File

@ -24,6 +24,6 @@ let commands () =
cctxt#message
"Block %a no longer marked invalid."
Block_hash.pp block >>= fun () ->
return ())
return_unit)
blocks) ;
]

4
src/lib_client_commands/client_helpers_commands.ml
View File

@ -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
)
]

20
src/lib_client_commands/client_keys_commands.ml
View File

@ -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

6
src/lib_client_commands/client_p2p_commands.ml
View File

@ -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."

6
src/lib_client_commands/client_report_commands.ml
View File

@ -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) ;
]

22
src/lib_error_monad/error_monad.ml
View File

@ -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

3
src/lib_error_monad/error_monad_sig.ml
View File

@ -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

16
src/lib_p2p/p2p.ml
View File

@ -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

8
src/lib_p2p/p2p_io_scheduler.ml
View File

@ -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

6
src/lib_p2p/p2p_maintenance.ml
View File

@ -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

6
src/lib_p2p/p2p_pool.ml
View File

@ -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 ;

2
src/lib_p2p/p2p_socket.ml
View File

@ -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

6
src/lib_p2p/test/test_p2p_banned_peers.ml
View File

@ -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) =

6
src/lib_p2p/test/test_p2p_io_scheduler.ml
View File

@ -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

16
src/lib_p2p/test/test_p2p_pool.ml
View File

@ -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

44
src/lib_p2p/test/test_p2p_socket.ml
View File

@ -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

3
src/lib_protocol_environment/sigs/v1/error_monad.mli
View File

@ -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

10
src/lib_protocol_environment/test/test_mem_context.ml
View File

@ -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
(******************************************************************************)

20
src/lib_shell/block_validator.ml
View File

@ -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

14
src/lib_shell/bootstrap_pipeline.ml
View File

@ -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 =

4
src/lib_shell/chain_traversal.ml
View File

@ -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

12
src/lib_shell/chain_validator.ml
View File

@ -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 ;

10
src/lib_shell/injection_directory.ml
View File

@ -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 ;

20
src/lib_shell/peer_validator.ml
View File

@ -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

26
src/lib_shell/prevalidator.ml
View File

@ -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)

12
src/lib_shell/protocol_validator.ml
View File

@ -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 _ -> ()

2
src/lib_shell/state.ml
View File

@ -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 =

4
src/lib_shell/test/test_locator.ml
View File

@ -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

22
src/lib_shell/test/test_state.ml
View File

@ -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
(****************************************************************************)

6
src/lib_shell/worker.ml
View File

@ -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 ()

4
src/lib_signer_backends/encrypted.ml
View File

@ -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) =

6
src/lib_signer_backends/ledger.ml
View File

@ -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
)
]

8
src/lib_stdlib/lwt_canceler.ml
View File

@ -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

6
src/lib_stdlib/lwt_idle_waiter.ml
View File

@ -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

6
src/lib_stdlib/lwt_utils.ml
View File

@ -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 ()

2
src/lib_stdlib_unix/lwt_lock_file.ml
View File

@ -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

10
src/lib_stdlib_unix/lwt_utils_unix.ml
View File

@ -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 ->

10
src/lib_storage/test/test_context.ml
View File

@ -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
(******************************************************************************)

6
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -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

2
src/proto_alpha/lib_client/client_proto_contracts.ml
View File

@ -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

12
src/proto_alpha/lib_client/client_proto_programs.ml
View File

@ -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

6
src/proto_alpha/lib_client/injection.ml
View File

@ -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@]"

46
src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
View File

@ -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
]

2
src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml
View File

@ -64,6 +64,6 @@ let commands () =
@@ stop)
(fun () (_, contract) (cctxt : Proto_alpha.full) ->
cctxt#message "%a\n%!" Contract.pp contract >>= fun () ->
return ()) ;
return_unit) ;
]

16
src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml
View File

@ -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
) ;
]

18
src/proto_alpha/lib_delegate/client_baking_denunciation.ml
View File

@ -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

10
src/proto_alpha/lib_delegate/client_baking_endorsement.ml
View File

@ -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

12
src/proto_alpha/lib_delegate/client_baking_forge.ml
View File

@ -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

8
src/proto_alpha/lib_delegate/client_baking_lib.ml
View File

@ -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

4
src/proto_alpha/lib_delegate/client_baking_revelation.ml
View File

@ -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

2
src/proto_alpha/lib_delegate/client_baking_simulator.ml
View File

@ -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

6
src/proto_alpha/lib_delegate/client_daemon.ml
View File

@ -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

4
src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml
View File

@ -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 ->

4
src/proto_alpha/lib_delegate/test/test_michelson_parser.ml
View File

@ -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

4
src/proto_alpha/lib_delegate/test/test_rpc.ml
View File

@ -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!"

2
src/proto_alpha/lib_delegate/test/test_vote.ml
View File

@ -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 ()) ;

4
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -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 =

6
src/proto_alpha/lib_protocol/src/baking.ml
View File

@ -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 =

6
src/proto_alpha/lib_protocol/src/contract_storage.ml
View File

@ -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

4
src/proto_alpha/lib_protocol/src/delegate_storage.ml
View File

@ -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

4
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -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 ;

6
src/proto_alpha/lib_protocol/src/raw_context.ml
View File

@ -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)

4
src/proto_alpha/lib_protocol/src/script_interpreter.ml
View File

@ -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)

10
src/proto_alpha/lib_protocol/src/script_ir_translator.ml
View File

@ -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))

2
src/proto_alpha/lib_protocol/src/storage_description.ml
View File

@ -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 =

4
src/proto_alpha/lib_protocol/test/activation.ml
View File

@ -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 () =

14
src/proto_alpha/lib_protocol/test/delegation.ml
View File

@ -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 ->

2
src/proto_alpha/lib_protocol/test/double_baking.ml
View File

@ -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 *)

6
src/proto_alpha/lib_protocol/test/helpers/assert.ml
View File

@ -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) =

2
src/proto_alpha/lib_protocol/test/helpers/block.ml
View File

@ -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 = {

11
src/proto_alpha/lib_protocol/test/origination.ml
View File

@ -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 = [

36
src/proto_alpha/lib_protocol/test/transfer.ml
View File

@ -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 () =

8
src/proto_demo/lib_client/client_proto_main.ml
View File

@ -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 ->

4
src/proto_genesis/lib_client/client_proto_main.ml
View File

@ -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 ;
]

2
src/proto_genesis/lib_protocol/src/data.ml
View File

@ -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