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

Everywhere: return_{none,some,nil,true,false}

Browse Source
This commit is contained in:
Raphaël Proust 2018-06-27 10:05:42 +08:00 committed by Grégoire Henry
parent 103d5355f2
commit 1c2a771832
58 changed files with 261 additions and 222 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin_client/client_rpc_commands.ml
View File

@ -92,7 +92,7 @@ let fill_in ?(show_optionals=true) input schema =
Lwt.return acc
else
element (string_of_int n :: path) elt >>= fun json ->
(if n < min then Lwt.return true else input.continue title path) >>= function
(if n < min then Lwt.return_true else input.continue title path) >>= function
| true -> fill_loop (json :: acc) min (succ n) max
| false -> Lwt.return (json :: acc)
in

20
src/bin_node/node_run_command.ml
View File

@ -119,16 +119,16 @@ let init_node ?sandbox ?checkpoint (config : Node_config_file.t) =
| None -> Lwt.return_none
| Some sandbox_param ->
match sandbox_param with
| None -> Lwt.return None
| None -> Lwt.return_none
| Some file ->
Lwt_utils_unix.Json.read_file file >>= function
| Error err ->
lwt_warn
"Can't parse sandbox parameters: %s" file >>= fun () ->
lwt_debug "%a" pp_print_error err >>= fun () ->
Lwt.return None
Lwt.return_none
| Ok json ->
Lwt.return (Some json)
Lwt.return_some json
end >>= fun sandbox_param ->
(* TODO "WARN" when pow is below our expectation. *)
begin
@ -146,10 +146,10 @@ let init_node ?sandbox ?checkpoint (config : Node_config_file.t) =
match listening_addr, sandbox with
| Some addr, Some _
when Ipaddr.V6.(compare addr unspecified) = 0 ->
return None
return_none
| Some addr, Some _ when not (Ipaddr.V6.is_private addr) ->
fail (Non_private_sandbox addr)
| None, Some _ -> return None
| None, Some _ -> return_none
| _ ->
(Node_config_file.resolve_bootstrap_addrs
config.p2p.bootstrap_peers) >>= fun trusted_points ->
@ -172,7 +172,7 @@ let init_node ?sandbox ?checkpoint (config : Node_config_file.t) =
disable_mempool = config.p2p.disable_mempool ;
}
in
return (Some (p2p_config, config.p2p.limits))
return_some (p2p_config, config.p2p.limits)
end >>=? fun p2p_config ->
let node_config : Node.config = {
genesis ;
@ -201,7 +201,7 @@ let init_rpc (rpc_config: Node_config_file.rpc) node =
match rpc_config.listen_addr with
| None ->
lwt_log_notice "Not listening to RPC calls." >>= fun () ->
return None
return_none
| Some addr ->
Node_config_file.resolve_rpc_listening_addrs addr >>= function
| [] ->
@ -228,7 +228,7 @@ let init_rpc (rpc_config: Node_config_file.rpc) node =
~media_types:Media_type.all_media_types
~cors:{ allowed_origins = rpc_config.cors_origins ;
allowed_headers = cors_headers } >>= fun server ->
return (Some server))
return_some server)
(function
|Unix.Unix_error(Unix.EADDRINUSE, "bind","") ->
fail (RPC_Port_already_in_use [(addr,port)])
@ -284,7 +284,7 @@ let process sandbox verbosity checkpoint args =
end >>=? fun () ->
begin
match checkpoint with
| None -> return None
| None -> return_none
| Some s ->
match String.split ',' s with
| [ lvl ; block ] ->
@ -296,7 +296,7 @@ let process sandbox verbosity checkpoint args =
| Some lvl ->
return lvl
end >>=? fun lvl ->
return (Some (lvl, block))
return_some (lvl, block)
| [] -> assert false
| [_] ->
failwith "Checkoints are expected to follow the format \

4
src/bin_signer/http_daemon.ml
View File

@ -23,9 +23,9 @@ let run (cctxt : #Client_context.wallet) ~hosts ?magic_bytes ~require_auth mode
RPC_directory.register0 dir Signer_services.authorized_keys begin fun () () ->
if require_auth then
Handler.Authorized_key.load cctxt >>=? fun keys ->
return (Some (keys |> List.split |> snd |> List.map Signature.Public_key.hash))
return_some (keys |> List.split |> snd |> List.map Signature.Public_key.hash)
else
return None
return_none
end in
Lwt.catch
(fun () ->

28
src/lib_clic/clic.ml
View File

@ -564,8 +564,8 @@ let parse_arg :
match spec with
| Arg { parameter = (long, _) ; kind = { converter ; _ } ; _ } ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return None
| [] -> return None
| exception Not_found -> return_none
| [] -> return_none
| [ s ] ->
(trace
(Bad_option_argument ("--" ^ long, command))
@ -595,9 +595,9 @@ let parse_arg :
end
| Switch { parameter = (long, _) ; _ } ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return false
| [] -> return false
| [ _ ] -> return true
| exception Not_found -> return_false
| [] -> return_false
| [ _ ] -> return_true
| _ :: _ -> fail (Multiple_occurences (long, command))
end
| Constant c -> return c
@ -984,7 +984,7 @@ let rec list_args : type arg ctx. (arg, ctx) args -> string list = function
let complete_func autocomplete cctxt =
match autocomplete with
| None -> return []
| None -> return_nil
| Some autocomplete -> autocomplete cctxt
let list_command_args (Command { options = Argument { spec ; _ } ; _ }) =
@ -994,8 +994,8 @@ let complete_arg : type a ctx. ctx -> (a, ctx) arg -> string list tzresult Lwt.t
fun ctx -> function
| Arg { kind = { autocomplete ; _ } ; _ } -> complete_func autocomplete ctx
| DefArg { kind = { autocomplete ; _ } ; _ } -> complete_func autocomplete ctx
| Switch _ -> return []
| Constant _ -> return []
| Switch _ -> return_nil
| Constant _ -> return_nil
let rec remaining_spec :
type a ctx. TzString.Set.t -> (a, ctx) args -> string list =
@ -1013,7 +1013,7 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
let arities = make_arities_dict args_spec TzString.Map.empty in
let rec complete_spec : type a. string -> (a, ctx) args -> string list tzresult Lwt.t =
fun name -> function
| NoArgs -> return []
| NoArgs -> return_nil
| AddArg (Constant _, rest) ->
complete_spec name rest
| AddArg (arg, rest) ->
@ -1057,7 +1057,7 @@ let complete_next_tree cctxt = function
| TParam { autocomplete ; _ } ->
complete_func autocomplete cctxt
| TStop command -> return (list_command_args command)
| TEmpty -> return []
| TEmpty -> return_nil
let complete_tree cctxt tree index args =
let rec help tree args ind =
@ -1069,14 +1069,14 @@ let complete_tree cctxt tree index args =
| TPrefix { prefix ; _ }, hd :: tl ->
begin
try help (List.assoc hd prefix) tl (ind - 1)
with Not_found -> return []
with Not_found -> return_nil
end
| TParam { tree ; _ }, _ :: tl ->
help tree tl (ind - 1)
| TStop Command { options = Argument { spec ; _ } ; conv ;_ }, args ->
complete_options (fun _ _ -> return []) args spec ind (conv cctxt)
complete_options (fun _ _ -> return_nil) args spec ind (conv cctxt)
| (TParam _ | TPrefix _), []
| TEmpty, _ -> return []
| TEmpty, _ -> return_nil
in help tree args index
let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands cctxt =
@ -1097,7 +1097,7 @@ let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands cct
else
match ind 0 args with
| None ->
return []
return_nil
| Some index ->
begin
let Argument { spec ; _ } = global_options in

14
src/lib_client_base/client_aliases.ml
View File

@ -106,13 +106,13 @@ module Alias = functor (Entity : Entity) -> struct
let autocomplete wallet =
load wallet >>= function
| Error _ -> return []
| Error _ -> return_nil
| Ok list -> return (List.map fst list)
let find_opt (wallet : #wallet) name =
load wallet >>=? fun list ->
try return (Some (List.assoc name list))
with Not_found -> return None
try return_some (List.assoc name list)
with Not_found -> return_none
let find (wallet : #wallet) name =
load wallet >>=? fun list ->
@ -122,16 +122,16 @@ module Alias = functor (Entity : Entity) -> struct
let rev_find (wallet : #wallet) v =
load wallet >>=? fun list ->
try return (Some (List.find (fun (_, v') -> v = v') list |> fst))
with Not_found -> return None
try return_some (List.find (fun (_, v') -> v = v') list |> fst)
with Not_found -> return_none
let mem (wallet : #wallet) name =
load wallet >>=? fun list ->
try
ignore (List.assoc name list) ;
return true
return_true
with
| Not_found -> return false
| Not_found -> return_false
let add ~force (wallet : #wallet) name value =
let keep = ref false in

16
src/lib_client_base/client_confirmations.ml
View File

@ -66,7 +66,7 @@ let wait_for_operation_inclusion
"Error while fetching block (ignored): %a"
pp_print_error err >>= fun () ->
(* Will be retried when a new head arrives *)
Lwt.return [] in
Lwt.return_nil in
(* Check whether a block as enough confirmations. This function
assumes that the block predecessor has been processed already. *)
@ -81,9 +81,9 @@ let wait_for_operation_inclusion
(n+1) Block_hash.pp hash >>= fun () ->
Block_hash.Table.add blocks hash (Some (block_with_op, n+1)) ;
if n+1 < confirmations then begin
return None
return_none
end else
return (Some block_with_op)
return_some block_with_op
| None ->
Shell_services.Blocks.Operation_hashes.operation_hashes
ctxt ~chain ~block () >>=? fun operations ->
@ -101,16 +101,16 @@ let wait_for_operation_inclusion
match in_block with
| None ->
Block_hash.Table.add blocks hash None ;
return None
return_none
| Some (i, j) -> begin
ctxt#answer
"Operation found in block: %a (pass: %d, offset: %d)"
Block_hash.pp hash i j >>= fun () ->
Block_hash.Table.add blocks hash (Some ((hash, i, j), 0)) ;
if confirmations <= 0 then
return (Some (hash, i, j))
return_some (hash, i, j)
else begin
return None
return_none
end
end in
@ -138,8 +138,8 @@ let wait_for_operation_inclusion
Lwt_stream.find_s
(fun (hash, header) ->
process hash header >>= function
| Ok None -> Lwt.return false
| Ok (Some _) -> Lwt.return true
| Ok None -> Lwt.return_false
| Ok (Some _) -> Lwt.return_true
| Error err ->
Lwt.fail (WrapError err)) stream >>= return)
(function

12
src/lib_client_base/client_keys.ml
View File

@ -219,12 +219,12 @@ let raw_get_key (cctxt : #Client_context.wallet) pkh =
| Some n ->
Secret_key.find_opt cctxt n >>=? fun sk_uri ->
Public_key.find_opt cctxt n >>=? begin function
| None -> return None
| Some (_, Some pk) -> return (Some pk)
| None -> return_none
| Some (_, Some pk) -> return_some pk
| Some (pk_uri, None) ->
public_key pk_uri >>=? fun pk ->
Public_key.update cctxt n (pk_uri, Some pk) >>=? fun () ->
return (Some pk)
return_some pk
end >>=? fun pk ->
return (n, pk, sk_uri)
end >>= function
@ -268,7 +268,7 @@ let get_keys (cctxt : #Client_context.wallet) =
end >>=? fun pk ->
return (name, pkh, pk, sk_uri)
end >>= function
| Ok r -> Lwt.return (Some r)
| Ok r -> Lwt.return_some r
| Error _ -> Lwt.return_none
end sks >>= fun keys ->
return keys
@ -287,8 +287,8 @@ let list_keys cctxt =
let alias_keys cctxt name =
Public_key_hash.find cctxt name >>=? fun pkh ->
raw_get_key cctxt pkh >>= function
| Ok (_name, pk, sk_uri) -> return (Some (pkh, pk, sk_uri))
| Error _ -> return None
| Ok (_name, pk, sk_uri) -> return_some (pkh, pk, sk_uri)
| Error _ -> return_none
let force_switch () =
Clic.switch

6
src/lib_client_base_unix/client_config.ml
View File

@ -173,12 +173,12 @@ let wait_parameter () =
parameter
(fun _ wait ->
match wait with
| "no" | "none" -> return None
| "no" | "none" -> return_none
| _ ->
try
let w = int_of_string wait in
if 0 <= w then
return (Some w)
return_some w
else
fail (Invalid_wait_arg wait)
with _ -> fail (Invalid_wait_arg wait))
@ -193,7 +193,7 @@ let protocol_parameter () =
(Protocol_hash.to_b58check hash))
(Client_commands.get_versions ())
in
return (Some hash)
return_some hash
with Not_found -> fail (Invalid_protocol_argument arg)
)

4
src/lib_client_commands/client_keys_commands.ml
View File

@ -123,8 +123,8 @@ let rec input_fundraiser_params (cctxt : #Client_context.io_wallet) =
cctxt#prompt "%s %s: " msg prompt >>=? fun gen ->
match default, String.lowercase_ascii gen with
| default, "" -> return default
| _, "y" -> return true
| _, "n" -> return false
| _, "y" -> return_true
| _, "n" -> return_false
| _, "q" -> failwith "Exit by user request."
| _ -> get_boolean_answer cctxt ~msg ~default in
cctxt#prompt "Enter the e-mail used for the paper wallet: " >>=? fun email ->

30
src/lib_error_monad/error_monad.ml
View File

@ -319,6 +319,16 @@ module Make(Prefix : sig val id : string end) = struct
let return_unit = Lwt.return (Ok ())
let return_none = Lwt.return (Ok None)
let return_some x = Lwt.return (Ok (Some x))
let return_nil = Lwt.return (Ok [])
let return_true = Lwt.return (Ok true)
let return_false = Lwt.return (Ok false)
let error s = Error [ s ]
let ok v = Ok v
@ -342,7 +352,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec map_s f l =
match l with
| [] -> return []
| [] -> return_nil
| h :: t ->
f h >>=? fun rh ->
map_s f t >>=? fun rt ->
@ -351,7 +361,7 @@ module Make(Prefix : sig val id : string end) = struct
let mapi_s f l =
let rec mapi_s f i l =
match l with
| [] -> return []
| [] -> return_nil
| h :: t ->
f i h >>=? fun rh ->
mapi_s f (i+1) t >>=? fun rt ->
@ -362,7 +372,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec map_p f l =
match l with
| [] ->
return []
return_nil
| x :: l ->
let tx = f x and tl = map_p f l in
tx >>= fun x ->
@ -377,7 +387,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec mapi_p f i l =
match l with
| [] ->
return []
return_nil
| x :: l ->
let tx = f i x and tl = mapi_p f (i+1) l in
tx >>= fun x ->
@ -391,7 +401,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec map2_s f l1 l2 =
match l1, l2 with
| [], [] -> return []
| [], [] -> return_nil
| _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.map2_s"
| h1 :: t1, h2 :: t2 ->
f h1 h2 >>=? fun rh ->
@ -401,7 +411,7 @@ module Make(Prefix : sig val id : string end) = struct
let mapi2_s f l1 l2 =
let rec mapi2_s i f l1 l2 =
match l1, l2 with
| [], [] -> return []
| [], [] -> return_nil
| _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.mapi2_s"
| h1 :: t1, h2 :: t2 ->
f i h1 h2 >>=? fun rh ->
@ -420,7 +430,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec filter_map_s f l =
match l with
| [] -> return []
| [] -> return_nil
| h :: t ->
f h >>=? function
| None -> filter_map_s f t
@ -430,7 +440,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec filter_map_p f l =
match l with
| [] -> return []
| [] -> return_nil
| h :: t ->
let th = f h
and tt = filter_map_p f t in
@ -442,7 +452,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec filter_s f l =
match l with
| [] -> return []
| [] -> return_nil
| h :: t ->
f h >>=? function
| false -> filter_s f t
@ -452,7 +462,7 @@ module Make(Prefix : sig val id : string end) = struct
let rec filter_p f l =
match l with
| [] -> return []
| [] -> return_nil
| h :: t ->
let jh = f h
and t = filter_p f t in

15
src/lib_error_monad/error_monad_sig.ml
View File

@ -83,6 +83,21 @@ module type S = sig
(** Sucessful return of [()] *)
val return_unit : unit tzresult Lwt.t
(** Sucessful return of [None] *)
val return_none : 'a option tzresult Lwt.t
(** [return_some x] is a sucessful return of [Some x] *)
val return_some : 'a -> 'a option tzresult Lwt.t
(** Sucessful return of [[]] *)
val return_nil : 'a list tzresult Lwt.t
(** Sucessful return of [true] *)
val return_true : bool tzresult Lwt.t
(** Sucessful return of [false] *)
val return_false : bool tzresult Lwt.t
(** Erroneous result *)
val error : error -> 'a tzresult

20
src/lib_p2p/p2p.ml
View File

@ -146,13 +146,13 @@ let create_maintenance_worker limits pool =
let may_create_welcome_worker config limits pool =
match config.listening_port with
| None -> Lwt.return None
| None -> Lwt.return_none
| Some port ->
P2p_welcome.run
~backlog:limits.backlog pool
?addr:config.listening_addr
port >>= fun w ->
Lwt.return (Some w)
Lwt.return_some w
type ('msg, 'peer_meta, 'conn_meta) connection =
('msg, 'peer_meta, 'conn_meta) P2p_pool.connection
@ -233,7 +233,7 @@ module Real = struct
net.pool ~init:[]
~f:begin fun _peer_id conn acc ->
(P2p_pool.is_readable conn >>= function
| Ok () -> Lwt.return (Some conn)
| Ok () -> Lwt.return_some conn
| Error _ -> Lwt_utils.never_ending ()) :: acc
end in
Lwt.pick (
@ -616,7 +616,7 @@ let build_rpc_directory net =
RPC_directory.register0 dir P2p_services.Connections.S.list
begin fun () () ->
match net.pool with
| None -> return []
| None -> return_nil
| Some pool ->
return @@
P2p_pool.Connection.fold
@ -632,7 +632,7 @@ let build_rpc_directory net =
RPC_directory.register0 dir P2p_services.Peers.S.list
begin fun q () ->
match net.pool with
| None -> return []
| None -> return_nil
| Some pool ->
return @@
P2p_pool.Peers.fold_known pool
@ -651,7 +651,7 @@ let build_rpc_directory net =
RPC_directory.opt_register1 dir P2p_services.Peers.S.info
begin fun peer_id () () ->
match net.pool with
| None -> return None
| None -> return_none
| Some pool ->
return @@
Option.map ~f:(info_of_peer_info pool)
@ -713,9 +713,9 @@ let build_rpc_directory net =
RPC_directory.register1 dir P2p_services.Peers.S.banned
begin fun peer_id () () ->
match net.pool with
| None -> return false
| None -> return_false
| Some pool when (P2p_pool.Peers.get_trusted pool peer_id) ->
return false
return_false
| Some pool ->
return (P2p_pool.Peers.banned pool peer_id)
end in
@ -726,7 +726,7 @@ let build_rpc_directory net =
RPC_directory.register0 dir P2p_services.Points.S.list
begin fun q () ->
match net.pool with
| None -> return []
| None -> return_nil
| Some pool ->
return @@
P2p_pool.Points.fold_known
@ -745,7 +745,7 @@ let build_rpc_directory net =
RPC_directory.opt_register1 dir P2p_services.Points.S.info
begin fun point () () ->
match net.pool with
| None -> return None
| None -> return_none
| Some pool ->
return @@
Option.map

2
src/lib_p2p/p2p_peer_state.ml
View File

@ -138,7 +138,7 @@ module Info = struct
Lwt_utils_unix.Json.read_file path >>=? fun json ->
return (Data_encoding.Json.destruct enc json)
else
return []
return_nil
let save path peer_metadata_encoding peers =
let open Data_encoding in

4
src/lib_p2p/p2p_pool.ml
View File

@ -904,7 +904,7 @@ and create_connection pool p2p_conn id_point point_info peer_info _version =
private_node_warn
"Receive requests for peers addresses from %a"
P2p_peer.Id.pp peer_id >>= fun () ->
Lwt.return []
Lwt.return_nil
) ;
swap_request =
(fun _point _peer_id ->
@ -987,7 +987,7 @@ and list_known_points ?(ignore_private = false) pool conn =
if P2p_socket.private_node conn.conn then
private_node_warn "Private peer (%a) asked other peers addresses"
P2p_peer.Id.pp (P2p_peer_state.Info.peer_id conn.peer_info) >>= fun () ->
Lwt.return []
Lwt.return_nil
else
let knowns =
P2p_point.Table.fold

8
src/lib_p2p/p2p_socket.ml
View File

@ -319,10 +319,10 @@ module Reader = struct
let open Data_encoding.Binary in
match status with
| Success { result ; size ; stream } ->
return (Some (result, size, stream))
return_some (result, size, stream)
| Error _ ->
lwt_debug "[read_message] incremental decoding error" >>= fun () ->
return None
return_none
| Await decode_next_buf ->
protect ~canceler:st.canceler begin fun () ->
Crypto.read_chunk st.conn.fd st.conn.cryptobox_data
@ -341,12 +341,12 @@ module Reader = struct
| None ->
protect ~canceler:st.canceler begin fun () ->
Lwt_pipe.push st.messages (Error [P2p_errors.Decoding_error]) >>= fun () ->
return None
return_none
end
| Some (msg, size, stream) ->
protect ~canceler:st.canceler begin fun () ->
Lwt_pipe.push st.messages (Ok (size, msg)) >>= fun () ->
return (Some stream)
return_some stream
end
end >>= function
| Ok (Some stream) ->

2
src/lib_p2p/test/process.ml
View File

@ -141,7 +141,7 @@ let wait_all processes =
| [] -> loop remaining
| Ok () :: finished -> handle finished
| Error err :: _ ->
Lwt.return (Some (err, remaining)) in
Lwt.return_some (err, remaining) in
handle finished in
loop (List.map (fun p -> p.termination) processes) >>= function
| None ->

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

@ -37,7 +37,7 @@ let accept main_socket =
let rec accept_n main_socket n =
if n <= 0 then
return []
return_nil
else
accept_n main_socket (n-1) >>=? fun acc ->
accept main_socket >>=? fun conn ->

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

@ -75,6 +75,21 @@ val return : 'a -> 'a tzresult Lwt.t
(** Sucessful return of [()] *)
val return_unit : unit tzresult Lwt.t
(** Sucessful return of [None] *)
val return_none : 'a option tzresult Lwt.t
(** [return_some x] is a sucessful return of [Some x] *)
val return_some : 'a -> 'a option tzresult Lwt.t
(** Sucessful return of [[]] *)
val return_nil : 'a list tzresult Lwt.t
(** Sucessful return of [true] *)
val return_true : bool tzresult Lwt.t
(** Sucessful return of [false] *)
val return_false : bool tzresult Lwt.t
(** Erroneous result *)
val error : error -> 'a tzresult

12
src/lib_protocol_updater/updater.ml
View File

@ -46,23 +46,23 @@ let do_compile hash p =
end >>= function
| Error err ->
log_error "Error %a" pp_print_error err ;
Lwt.return false
Lwt.return_false
| Ok (Unix.WSIGNALED _ | Unix.WSTOPPED _) ->
log_error "INTERRUPTED COMPILATION (%s)" log_file;
Lwt.return false
Lwt.return_false
| Ok (Unix.WEXITED x) when x <> 0 ->
log_error "COMPILATION ERROR (%s)" log_file;
Lwt.return false
Lwt.return_false
| Ok (Unix.WEXITED _) ->
try Dynlink.loadfile_private (plugin_file ^ ".cmxs"); Lwt.return true
try Dynlink.loadfile_private (plugin_file ^ ".cmxs"); Lwt.return_true
with Dynlink.Error err ->
log_error "Can't load plugin: %s (%s)"
(Dynlink.error_message err) plugin_file;
Lwt.return false
Lwt.return_false
let compile hash p =
if Tezos_protocol_registerer.Registerer.mem hash then
Lwt.return true
Lwt.return_true
else begin
do_compile hash p >>= fun success ->
let loaded = Tezos_protocol_registerer.Registerer.mem hash in

2
src/lib_shell/block_validator.ml
View File

@ -382,7 +382,7 @@ let validate w
bv.protocol_validator
?peer ~timeout:bv.limits.protocol_timeout
block ;
return None
return_none
| None ->
map_p (map_p (fun op ->
let op_hash = Operation.hash op in

2
src/lib_shell/chain.ml
View File

@ -29,7 +29,7 @@ let head chain_state =
let mem chain_state hash =
State.read_chain_data chain_state begin fun chain_store data ->
if Block_hash.equal (State.Block.hash data.current_head) hash then
Lwt.return true
Lwt.return_true
else
Store.Chain_data.In_main_branch.known (chain_store, hash)
end

2
src/lib_shell/chain_traversal.ml
View File

@ -14,7 +14,7 @@ let path (b1: Block.t) (b2: Block.t) =
invalid_arg "Chain_traversal.path" ;
let rec loop acc current =
if Block.equal b1 current then
Lwt.return (Some acc)
Lwt.return_some acc
else
Block.predecessor current >>= function
| Some pred -> loop (current :: acc) pred

4
src/lib_shell/distributed_db.ml
View File

@ -138,7 +138,7 @@ module Operation_hashes_storage = struct
| None -> Lwt.return_none
| Some b ->
State.Block.operation_hashes b i >>= fun (ops, _) ->
Lwt.return (Some ops)
Lwt.return_some ops
let read_exn chain_state (h, i) =
State.Block.read_exn chain_state h >>= fun b ->
State.Block.operation_hashes b i >>= fun (ops, _) ->
@ -216,7 +216,7 @@ module Operations_storage = struct
| None -> Lwt.return_none
| Some b ->
State.Block.operations b i >>= fun (ops, _) ->
Lwt.return (Some ops)
Lwt.return_some ops
let read_exn chain_state (h, i) =
State.Block.read_exn chain_state h >>= fun b ->
State.Block.operations b i >>= fun (ops, _) ->

4
src/lib_shell/distributed_db_functors.ml
View File

@ -135,7 +135,7 @@ end = struct
let read_opt s k =
match Memory_table.find s.memory k with
| exception Not_found -> Disk_table.read_opt s.disk k
| Found v -> Lwt.return (Some v)
| Found v -> Lwt.return_some v
| Pending _ -> Lwt.return_none
let read_exn s k =
@ -528,7 +528,7 @@ end = struct
param ;
queue = Lwt_pipe.create () ;
pending = Table.create 17 ;
events = Lwt.return [] ;
events = Lwt.return_nil ;
canceler = Lwt_canceler.create () ;
worker = Lwt.return_unit ;
} in

2
src/lib_shell/monitor_directory.ml
View File

@ -29,7 +29,7 @@ let build_rpc_directory validator mainchain_validator =
Chain.head chain_state >>= fun head ->
let head_hash = State.Block.hash head in
let head_header = State.Block.header head in
Lwt.return (Some (head_hash, head_header.shell.timestamp))
Lwt.return_some (head_hash, head_header.shell.timestamp)
end else begin
Lwt.pick [
( Lwt_stream.get block_stream >|=

4
src/lib_shell/prevalidation.ml
View File

@ -81,7 +81,7 @@ let start_prevalidation
timestamp >>= fun predecessor_context ->
begin
match protocol_data with
| None -> return None
| None -> return_none
| Some protocol_data ->
match
Data_encoding.Binary.of_bytes
@ -89,7 +89,7 @@ let start_prevalidation
protocol_data
with
| None -> failwith "Invalid block header"
| Some protocol_data -> return (Some protocol_data)
| Some protocol_data -> return_some protocol_data
end >>=? fun protocol_data ->
Proto.begin_construction
~predecessor_context

2
src/lib_shell/protocol_validator.ml
View File

@ -43,7 +43,7 @@ let rec worker_loop bv =
(* no need to tag 'invalid' protocol on disk,
the economic protocol prevents us from
being spammed with protocol validation. *)
return true
return_true
end >>=? fun _ ->
match wakener with
| None ->

27
src/lib_shell/state.ml
View File

@ -674,8 +674,8 @@ module Block = struct
end
let read_opt chain_state ?pred hash =
read chain_state ?pred hash >>= function
| Error _ -> Lwt.return None
| Ok v -> Lwt.return (Some v)
| Error _ -> Lwt.return_none
| Ok v -> Lwt.return_some v
let read_exn chain_state ?(pred = 0) hash =
Shared.use chain_state.block_store begin fun store ->
begin
@ -696,8 +696,8 @@ module Block = struct
return header.shell.predecessor
let read_predecessor_opt chain_state hash =
read_predecessor chain_state hash >>= function
| Error _ -> Lwt.return None
| Ok v -> Lwt.return (Some v)
| Error _ -> Lwt.return_none
| Ok v -> Lwt.return_some v
let read_predecessor_exn chain_state hash =
read_exn chain_state hash >>= fun { contents = { header } } ->
Lwt.return header.shell.predecessor
@ -707,7 +707,7 @@ module Block = struct
Lwt.return_none (* we are at genesis *)
else
read_exn chain_state header.shell.predecessor >>= fun block ->
Lwt.return (Some block)
Lwt.return_some block
let predecessor_n b n =
Shared.use b.chain_state.block_store begin fun block_store ->
@ -739,7 +739,7 @@ module Block = struct
fail_when known_invalid (failure "Known invalid") >>=? fun () ->
Store.Block.Contents.known (store, hash) >>= fun known ->
if known then
return None
return_none
else begin
(* safety check: never ever commit a block that is not compatible
with the current checkpoint. *)
@ -806,7 +806,7 @@ module Block = struct
let block = { chain_state ; hash ; contents } in
Lwt_watcher.notify chain_state.block_watcher block ;
Lwt_watcher.notify chain_state.global_state.block_watcher block ;
return (Some block)
return_some block
end
end
@ -818,11 +818,11 @@ module Block = struct
fail_when known_valid (failure "Known valid") >>=? fun () ->
Store.Block.Invalid_block.known store hash >>= fun known_invalid ->
if known_invalid then
return false
return_false
else
Store.Block.Invalid_block.store store hash
{ level = block_header.shell.level ; errors } >>= fun () ->
return true
return_true
end
let watcher (state : chain_state) =
@ -959,7 +959,7 @@ let read_block { global_data } ?pred hash =
| None ->
Block.read_opt chain_state ?pred hash >>= function
| None -> acc
| Some block -> Lwt.return (Some block))
| Some block -> Lwt.return_some block)
chains
Lwt.return_none
end
@ -1079,11 +1079,11 @@ module Protocol = struct
Shared.use global_state.protocol_store begin fun store ->
Store.Protocol.Contents.known store hash >>= fun known ->
if known then
Lwt.return None
Lwt.return_none
else
Store.Protocol.RawContents.store (store, hash) bytes >>= fun () ->
Lwt_watcher.notify global_state.protocol_watcher hash ;
Lwt.return (Some hash)
Lwt.return_some hash
end
let remove global_state hash =
@ -1113,8 +1113,7 @@ module Current_mempool = struct
let set chain_state ~head mempool =
update_chain_data chain_state begin fun _chain_data_store data ->
if Block_hash.equal head (Block.hash data.current_head) then
Lwt.return (Some { data with current_mempool = mempool },
())
Lwt.return (Some { data with current_mempool = mempool }, ())
else
Lwt.return (None, ())
end

4
src/lib_shell/worker.ml
View File

@ -181,7 +181,7 @@ module Make
match w.timeout with
| None ->
Lwt_pipe.pop message_queue >>= fun m ->
return (Some m)
return_some m
| Some timeout ->
Lwt_pipe.pop_with_timeout
(Lwt_unix.sleep timeout) message_queue >>= fun m ->
@ -193,7 +193,7 @@ module Make
match w.timeout with
| None ->
Lwt_dropbox.take message_box >>= fun m ->
return (Some m)
return_some m
| Some timeout ->
Lwt_dropbox.take_with_timeout
(Lwt_unix.sleep timeout) message_box >>= fun m ->

8
src/lib_signer_backends/encrypted.ml
View File

@ -38,11 +38,11 @@ module Raw = struct
let encrypted_sk = MBytes.sub encrypted_sk salt_len (len - salt_len) in
let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~salt ~password) in
match Crypto_box.Secretbox.box_open key encrypted_sk nonce with
| None -> return None
| None -> return_none
| Some bytes ->
match Data_encoding.Binary.of_bytes Signature.Secret_key.encoding bytes with
| None -> failwith "Corrupted wallet, deciphered key is invalid"
| Some sk -> return (Some sk)
| Some sk -> return_some sk
end
@ -69,11 +69,11 @@ let rec interactive_decrypt_loop
return sk
let rec noninteractice_decrypt_loop ~encrypted_sk = function
| [] -> return None
| [] -> return_none
| password :: passwords ->
Raw.decrypt ~password ~encrypted_sk >>=? function
| None -> noninteractice_decrypt_loop ~encrypted_sk passwords
| Some sk -> return (Some sk)
| Some sk -> return_some sk
let decrypt_payload cctxt ?name encrypted_sk =
match Base58.safe_decode encrypted_sk with

4
src/lib_signer_backends/http_gen.ml
View File

@ -98,8 +98,8 @@ module Make(N : sig val scheme : string end) = struct
P.authenticate
authorized_keys
(Signer_messages.Sign.Request.to_sign ~pkh ~data:msg) >>=? fun signature ->
return (Some signature)
| None -> return None
return_some signature
| None -> return_none
end >>=? fun signature ->
RPC_client.call_service
~logger: P.logger

8
src/lib_signer_backends/ledger.ml
View File

@ -103,17 +103,17 @@ module Ledger = struct
(cur_pkh, (pk, curve)) :: of_pkh
end (false, [], []) curves in
match pkh with
| None -> return (Some (create ~device_info ~of_curve ~of_pkh))
| None -> return_some (create ~device_info ~of_curve ~of_pkh)
| Some _ when pkh_found ->
return (Some (create ~device_info ~of_curve ~of_pkh))
| _ -> return None
return_some (create ~device_info ~of_curve ~of_pkh)
| _ -> return_none
end
let find_ledgers ?pkh () =
let ledgers = Hidapi.enumerate ~vendor_id ~product_id () in
filter_map_s begin fun device_info ->
match Hidapi.(open_path device_info.path) with
| None -> return None
| None -> return_none
| Some h ->
Lwt.finalize
(fun () -> Ledger.of_hidapi ?pkh device_info h)

10
src/lib_signer_backends/remote.ml
View File

@ -96,16 +96,16 @@ let read_base_uri_from_env () =
Sys.getenv_opt "TEZOS_SIGNER_TCP_HOST",
Sys.getenv_opt "TEZOS_SIGNER_HTTP_HOST",
Sys.getenv_opt "TEZOS_SIGNER_HTTPS_HOST" with
| None, None, None, None -> return None
| None, None, None, None -> return_none
| Some path, None, None, None ->
return (Some (Socket.make_unix_base path))
return_some (Socket.make_unix_base path)
| None, Some host, None, None -> begin
try
let port =
match Sys.getenv_opt "TEZOS_SIGNER_TCP_PORT" with
| None -> 7732
| Some port -> int_of_string port in
return (Some (Socket.make_tcp_base host port))
return_some (Socket.make_tcp_base host port)
with Invalid_argument _ ->
failwith "Failed to parse TEZOS_SIGNER_TCP_PORT.@."
end
@ -115,7 +115,7 @@ let read_base_uri_from_env () =
match Sys.getenv_opt "TEZOS_SIGNER_HTTP_PORT" with
| None -> 6732
| Some port -> int_of_string port in
return (Some (Http.make_base host port))
return_some (Http.make_base host port)
with Invalid_argument _ ->
failwith "Failed to parse TEZOS_SIGNER_HTTP_PORT.@."
end
@ -125,7 +125,7 @@ let read_base_uri_from_env () =
match Sys.getenv_opt "TEZOS_SIGNER_HTTPS_PORT" with
| None -> 443
| Some port -> int_of_string port in
return (Some (Https.make_base host port))
return_some (Https.make_base host port)
with Invalid_argument _ ->
failwith "Failed to parse TEZOS_SIGNER_HTTPS_PORT.@."
end

4
src/lib_signer_backends/socket.ml
View File

@ -32,11 +32,11 @@ module Make(P : sig
Lwt.return authorized_keys >>=? fun authorized_keys ->
Lwt_unix.close conn >>= fun () ->
begin match authorized_keys with
| No_authentication -> return None
| No_authentication -> return_none
| Authorized_keys authorized_keys ->
P.authenticate authorized_keys
(Sign.Request.to_sign ~pkh ~data:msg) >>=? fun signature ->
return (Some signature)
return_some signature
end
end >>=? fun signature ->
let req = { Sign.Request.pkh ; data = msg ; signature } in

2
src/lib_stdlib/lwt_dropbox.ml
View File

@ -78,7 +78,7 @@ let rec take_with_timeout timeout dropbox =
| Some elt ->
Lwt.cancel timeout ;
dropbox.data <- None ;
Lwt.return (Some elt)
Lwt.return_some elt
| None ->
if Lwt.is_sleeping timeout then
if dropbox.closed then

6
src/lib_stdlib_unix/lwt_lock_file.ml
View File

@ -37,14 +37,14 @@ let blocking_create
| Some duration -> with_timeout (Lwt_unix.sleep duration) (fun _ -> create ())
let is_locked fn =
if not @@ Sys.file_exists fn then return false else
if not @@ Sys.file_exists fn then return_false else
protect begin fun () ->
Lwt_unix.openfile fn [Unix.O_RDONLY] 0o644 >>= fun fd ->
Lwt.finalize (fun () ->
Lwt.try_bind
(fun () -> Lwt_unix.(lockf fd F_TEST 0))
(fun () -> return false)
(fun _ -> return true))
(fun () -> return_false)
(fun _ -> return_true))
(fun () -> Lwt_unix.close fd)
end

2
src/lib_storage/context.ml
View File

@ -102,7 +102,7 @@ let checkout index key =
| Some commit ->
GitStore.Commit.tree commit >>= fun tree ->
let ctxt = { index ; tree ; parents = [commit] } in
Lwt.return (Some ctxt)
Lwt.return_some ctxt
let checkout_exn index key =
checkout index key >>= function

4
src/lib_storage/store_helpers.ml
View File

@ -201,7 +201,7 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct
let read_opt s i =
read s i >>= function
| Error _ -> Lwt.return_none
| Ok v -> Lwt.return (Some v)
| Ok v -> Lwt.return_some v
let read_exn s i =
read s i >>= function
| Error _ -> Lwt.fail Not_found
@ -305,7 +305,7 @@ module Make_map (S : STORE) (I : INDEX) (V : VALUE) = struct
let read_opt s i =
read s i >>= function
| Error _ -> Lwt.return_none
| Ok v -> Lwt.return (Some v)
| Ok v -> Lwt.return_some v
let read_exn s i =
read s i >>= function
| Error _ -> Lwt.fail Not_found

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

@ -32,8 +32,8 @@ let transfer (cctxt : #Proto_alpha.full)
begin match arg with
| Some arg ->
parse_expression arg >>=? fun { expanded = arg } ->
return (Some arg)
| None -> return None
return_some arg
| None -> return_none
end >>=? fun parameters ->
let parameters = Option.map ~f:Script.lazy_expr parameters in
let contents = Transaction { amount ; parameters ; destination } in

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

@ -45,8 +45,8 @@ module ContractAlias = struct
match Contract.is_implicit c with
| Some hash -> begin
Client_keys.Public_key_hash.rev_find cctxt hash >>=? function
| Some name -> return (Some ("key:" ^ name))
| None -> return None
| Some name -> return_some ("key:" ^ name)
| None -> return_none
end
| None -> RawContractAlias.rev_find cctxt c

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

@ -46,11 +46,11 @@ let preapply (type t)
| _ -> Signature.Generic_operation in
begin
match src_sk with
| None -> return None
| None -> return_none
| Some src_sk ->
Client_keys.sign cctxt
~watermark src_sk bytes >>=? fun signature ->
return (Some signature)
return_some signature
end >>=? fun signature ->
let op : _ Operation.t =
{ shell = { branch } ;

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

@ -35,9 +35,9 @@ let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_conte
~show_source: (not no_print_source)
?parsed:None) errs >>= fun () ->
cctxt#error "%s" msg >>= fun () ->
Lwt.return None
Lwt.return_none
| Ok data ->
Lwt.return (Some data)
Lwt.return_some data
let file_parameter =
Clic.parameter (fun _ p ->

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

@ -66,7 +66,7 @@ let blocks_from_current_cycle cctxt ?(chain = `Main) block ?(offset = 0l) () =
Alpha_services.Helpers.levels_in_current_cycle
cctxt ~offset (chain, block) >>= function
| Error [RPC_context.Not_found _] ->
return []
return_nil
| Error _ as err -> Lwt.return err
| Ok (first, last) ->
let length = Int32.to_int (Int32.sub level (Raw_level.to_int32 first)) in

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

@ -19,8 +19,8 @@ let get_signing_slots cctxt ?(chain = `Main) block delegate level =
~levels:[level]
~delegates:[delegate]
(chain, block) >>=? function
| [{ slots }] -> return (Some slots)
| _ -> return None
| [{ slots }] -> return_some slots
| _ -> return_none
let inject_endorsement
(cctxt : #Proto_alpha.full)
@ -48,7 +48,7 @@ let check_endorsement cctxt level pkh =
let previously_endorsed_level cctxt pkh new_lvl =
State.get cctxt pkh >>=? function
| None -> return false
| None -> return_false
| Some last_lvl ->
return (Raw_level.(last_lvl >= new_lvl))
@ -128,7 +128,7 @@ let allowed_to_endorse cctxt bi delegate =
| None | Some [] ->
lwt_debug "No slot found for %a/%s"
Block_hash.pp_short bi.hash name >>= fun () ->
return false
return_false
| Some (_ :: _ as slots) ->
lwt_debug "Found slots for %a/%s (%d)"
Block_hash.pp_short bi.hash name (List.length slots) >>= fun () ->
@ -136,9 +136,9 @@ let allowed_to_endorse cctxt bi delegate =
| true ->
lwt_debug "Level %a (or higher) previously endorsed: do not endorse."
Raw_level.pp level >>= fun () ->
return false
return_false
| false ->
return true
return_true
let prepare_endorsement ~(max_past:int64) () (cctxt : #Proto_alpha.full) state bi =
if Time.diff (Time.now ()) bi.Client_baking_blocks.timestamp > max_past then

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

@ -146,9 +146,9 @@ let sort_operations_by_fee ?(threshold = Tez.zero) (operations : Proto_alpha.ope
(fun op ->
get_operation_fee op >>=? fun fee ->
if Tez.(<) fee threshold then
return None
return_none
else
return (Some (op, fee)))
return_some (op, fee))
operations >>=? fun operations ->
let compare_fee (_, fee1) (_, fee2) =
(* NOTE: inverted fee comparison to invert the order of sort *)
@ -354,7 +354,7 @@ module State = Daemon_state.Make(struct let name = "block" end)
let previously_baked_level cctxt pkh new_lvl =
State.get cctxt pkh >>=? function
| None -> return false
| None -> return_false
| Some last_lvl ->
return (Raw_level.(last_lvl >= new_lvl))
@ -371,11 +371,11 @@ let get_baking_slot cctxt
| Error errs ->
lwt_log_error "Error while fetching baking possibilities:\n%a"
pp_print_error errs >>= fun () ->
Lwt.return []
Lwt.return_nil
| Ok [] ->
lwt_log_info "Found no baking rights for level %a"
Raw_level.pp level >>= fun () ->
Lwt.return []
Lwt.return_nil
| Ok slots ->
let slots =
List.filter_map
@ -419,12 +419,12 @@ let get_unrevealed_nonces
cctxt block ~offset:(-1l) () >>=? fun blocks ->
filter_map_s (fun hash ->
Client_baking_nonces.find cctxt hash >>=? function
| None -> return None
| None -> return_none
| Some nonce ->
Alpha_block_services.metadata
cctxt ~chain ~block:(`Hash (hash, 0)) () >>=? fun { protocol_data = { level } } ->
if force then
return (Some (hash, (level.level, nonce)))
return_some (hash, (level.level, nonce))
else
Alpha_services.Nonce.get
cctxt (chain, block) level.level >>=? function
@ -433,13 +433,13 @@ let get_unrevealed_nonces
cctxt#warning "Found nonce for %a (level: %a)@."
Block_hash.pp_short hash
Level.pp level >>= fun () ->
return (Some (hash, (level.level, nonce)))
return_some (hash, (level.level, nonce))
| Missing _nonce_hash ->
cctxt#error "Incoherent nonce for level %a"
Raw_level.pp level.level >>= fun () ->
return None
| Forgotten -> return None
| Revealed _ -> return None)
return_none
| Forgotten -> return_none
| Revealed _ -> return_none)
blocks
let safe_get_unrevealed_nonces cctxt block =
@ -447,7 +447,7 @@ let safe_get_unrevealed_nonces cctxt block =
| Ok r -> Lwt.return r
| Error err ->
lwt_warn "Cannot read nonces: %a@." pp_print_error err >>= fun () ->
Lwt.return []
Lwt.return_nil
let insert_block
?max_priority
@ -521,8 +521,8 @@ let filter_invalid_operations (cctxt : #full) state block_info (operations : pac
Operation_hash.pp (Operation.hash_packed op)
pp_print_error errs
>>= fun () ->
return None
| Ok inc -> return (Some inc)
return_none
| Ok inc -> return_some inc
in
let filter_valid_operations inc ops =
fold_left_s (fun (inc, acc) op ->
@ -534,10 +534,10 @@ let filter_invalid_operations (cctxt : #full) state block_info (operations : pac
(* Invalid endorsements are detected during block finalization *)
let is_valid_endorsement inc endorsement =
validate_operation inc endorsement >>=? function
| None -> return None
| None -> return_none
| Some inc' -> finalize_construction inc' >>= begin function
| Ok _ -> return (Some endorsement)
| Error _ -> return None
| Ok _ -> return_some endorsement
| Error _ -> return_none
end
in
filter_valid_operations initial_inc votes >>=? fun (inc, votes) ->
@ -613,7 +613,7 @@ let bake_slot
lwt_log_error "Client-side validation: error while filtering invalid operations :@\n%a"
pp_print_error
errs >>= fun () ->
return None
return_none
| Ok operations ->
Alpha_block_services.Helpers.Preapply.block
cctxt ~chain ~block
@ -623,7 +623,7 @@ let bake_slot
lwt_log_error "Error while prevalidating operations:@\n%a"
pp_print_error
errs >>= fun () ->
return None
return_none
| Ok (shell_header, operations) ->
lwt_debug
"Computed candidate block after %a (slot %d): %a/%d fitness: %a"

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

@ -87,7 +87,7 @@ let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes =
Lwt.catch
(fun () ->
Client_baking_blocks.info cctxt (`Hash (hash, 0)) >>= function
| Ok bi -> Lwt.return (Some bi)
| Ok bi -> Lwt.return_some bi
| Error _ ->
Lwt.fail Not_found)
(fun _ ->
@ -101,9 +101,9 @@ let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes =
| None ->
cctxt#warning "Cannot find nonces for block %a (ignoring)@."
Block_hash.pp_short bi.hash >>= fun () ->
return None
return_none
| Some nonce ->
return (Some (bi.hash, (bi.level, nonce))))
return_some (bi.hash, (bi.level, nonce)))
block_infos >>=? fun blocks ->
do_reveal cctxt cctxt#block blocks

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

@ -565,7 +565,7 @@ module Endorse = struct
!rpc_ctxt ~delegates:[delegate] ~levels:[level]
(`Main, block) >>=? function
| [{ slots }] -> return slots
| _ -> return []
| _ -> return_nil
let endorse
(contract : Account.t)
@ -606,7 +606,7 @@ module Endorse = struct
~delegates:[delegate]
(`Main, block) >>=? function
| [{ level ; slots }] -> return (List.map (fun s -> (level, s)) slots)
| _ -> return []
| _ -> return_nil
end

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

@ -275,6 +275,6 @@ let last_of_a_cycle ctxt l =
let dawn_of_a_new_cycle ctxt =
let level = Level.current ctxt in
if last_of_a_cycle ctxt level then
return (Some level.cycle)
return_some level.cycle
else
return None
return_none

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

@ -163,14 +163,14 @@ let register () =
register_opt_field S.storage (fun ctxt contract ->
Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
match script with
| None -> return None
| None -> return_none
| Some script ->
let ctxt = Gas.set_unlimited ctxt in
let open Script_ir_translator in
parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
unparse_script ctxt Readable script >>=? fun (script, _ctxt) ->
Lwt.return (Script.force_decode script.storage) >>=? fun storage ->
return (Some storage)) ;
return_some storage) ;
register_field S.info (fun ctxt contract ->
Contract.get_balance ctxt contract >>=? fun balance ->
Contract.get_manager ctxt contract >>=? fun manager ->

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

@ -275,12 +275,12 @@ let delete c contract =
let allocated c contract =
Storage.Contract.Counter.get_option c contract >>=? function
| None -> return false
| Some _ -> return true
| None -> return_false
| Some _ -> return_true
let exists c contract =
match Contract_repr.is_implicit contract with
| Some _ -> return true
| Some _ -> return_true
| None -> allocated c contract
let must_exist c contract =
@ -307,8 +307,8 @@ let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until =
Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until ->
filter_map_s
(fun contract -> exists ctxt_until contract >>=? function
| true -> return (Some contract)
| false -> return None)
| true -> return_some contract
| false -> return_none)
(Contract_repr.originated_contracts ~since ~until)
let check_counter_increment c contract counter =
@ -369,9 +369,9 @@ let get_manager_key c contract =
let is_manager_key_revealed c contract =
Storage.Contract.Manager.get_option c contract >>=? function
| None -> return false
| Some (Manager_repr.Hash _) -> return false
| Some (Manager_repr.Public_key _) -> return true
| None -> return_false
| Some (Manager_repr.Hash _) -> return_false
| Some (Manager_repr.Public_key _) -> return_true
let reveal_manager_key c contract public_key =
Storage.Contract.Manager.get c contract >>=? function
@ -396,7 +396,7 @@ let get_balance c contract =
let is_delegatable = Delegate_storage.is_delegatable
let is_spendable c contract =
match Contract_repr.is_implicit contract with
| Some _ -> return true
| Some _ -> return_true
| None ->
Storage.Contract.Spendable.mem c contract >>= return

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

@ -175,7 +175,7 @@ let register () =
(fun pkh -> Delegate.deactivated ctxt pkh)
delegates >>= return
else
return []
return_nil
end ;
register1 S.info begin fun ctxt pkh () () ->
Delegate.full_balance ctxt pkh >>=? fun balance ->
@ -354,10 +354,10 @@ module Baking_rights = struct
let delegate = Signature.Public_key.hash pk in
begin
match pred_timestamp with
| None -> return None
| None -> return_none
| Some pred_timestamp ->
Baking.minimal_time ctxt priority pred_timestamp >>=? fun t ->
return (Some t)
return_some t
end>>=? fun timestamp ->
let acc =
{ level = level.level ; delegate ; priority ; timestamp } :: acc in

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

@ -116,7 +116,7 @@ let () =
let is_delegatable c contract =
match Contract_repr.is_implicit contract with
| Some _ ->
return false
return_false
| None ->
Storage.Contract.Delegatable.mem c contract >>= return
@ -144,8 +144,8 @@ let unlink c contract balance =
let known c delegate =
Storage.Contract.Manager.get_option
c (Contract_repr.implicit_contract delegate) >>=? function
| None | Some (Manager_repr.Hash _) -> return false
| Some (Manager_repr.Public_key _) -> return true
| None | Some (Manager_repr.Hash _) -> return_false
| Some (Manager_repr.Public_key _) -> return_true
(* A delegate is registered if its "implicit account"
delegates to itself. *)
@ -223,7 +223,7 @@ let set c contract delegate =
set_base c is_delegatable contract delegate
let set_from_script c contract delegate =
set_base c (fun _ _ -> return true) contract delegate
set_base c (fun _ _ -> return_true) contract delegate
let remove ctxt contract =
Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
@ -386,10 +386,10 @@ let punish ctxt delegate cycle =
let has_frozen_balance ctxt delegate cycle =
let contract = Contract_repr.implicit_contract delegate in
get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
if Tez_repr.(deposit <> zero) then return true
if Tez_repr.(deposit <> zero) then return_true
else
get_frozen_fees ctxt contract cycle >>=? fun fees ->
if Tez_repr.(fees <> zero) then return true
if Tez_repr.(fees <> zero) then return_true
else
get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
return Tez_repr.(rewards <> zero)

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

@ -175,7 +175,7 @@ let traverse_rolls ctxt head =
let get_rolls ctxt delegate =
Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function
| None -> return []
| None -> return_nil
| Some head_roll -> traverse_rolls ctxt head_roll
let get_change c delegate =

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

@ -96,7 +96,7 @@ let unparse_stack ctxt (stack, stack_ty) =
let rec unparse_stack
: type a. a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t
= function
| Empty, Empty_t -> return []
| Empty, Empty_t -> return_nil
| Item (v, rest), Item_t (ty, rest_ty, annot) ->
unparse_data ctxt Readable ty v >>=? fun (data, _ctxt) ->
unparse_stack (rest, rest_ty) >>=? fun rest ->

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

@ -216,13 +216,13 @@ let build_directory : type key. key t -> key RPC_directory.t =
fun dir path ->
match !dir with
| Empty -> Opt_handler { encoding = Data_encoding.unit ;
get = fun _ _ -> return None }
get = fun _ _ -> return_none }
| Value { get ; encoding } ->
let handler =
Opt_handler {
encoding ;
get =
fun k i -> if Compare.Int.(i < 0) then return None else get k
fun k i -> if Compare.Int.(i < 0) then return_none else get k
} in
register path handler ;
handler
@ -239,10 +239,10 @@ let build_directory : type key. key t -> key RPC_directory.t =
{ encoding = handler.encoding ;
get = fun k i ->
if Compare.Int.(i < 0) then
return None
return_none
else
handler.get k (i-1) >>=? fun v ->
return (Some v) } in
return_some v } in
register path handler ;
handler
| IndexedDir { arg ; arg_encoding ; list ; subdir } ->
@ -265,8 +265,8 @@ let build_directory : type key. key t -> key RPC_directory.t =
(fun (key, value) -> (key, Some value)) ;
] in
let get k i =
if Compare.Int.(i < 0) then return None
else if Compare.Int.(i = 0) then return (Some [])
if Compare.Int.(i < 0) then return_none
else if Compare.Int.(i = 0) then return_some []
else
list k >>=? fun keys ->
map_p
@ -277,7 +277,7 @@ let build_directory : type key. key t -> key RPC_directory.t =
handler.get (k, key) (i-1) >>=? fun value ->
return (key, value))
keys >>=? fun values ->
return (Some values) in
return_some values in
let handler =
Opt_handler {
encoding = Data_encoding.(list (dynamic_size encoding)) ;

20
src/proto_alpha/lib_protocol/src/storage_functors.ml
View File

@ -85,11 +85,11 @@ module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
Lwt.return (of_bytes ~key b)
let get_option t =
C.get_option t N.name >>= function
| None -> return None
| None -> return_none
| Some b ->
let key = C.absolute_key t N.name in
match of_bytes ~key b with
| Ok v -> return (Some v)
| Ok v -> return_some v
| Error _ as err -> Lwt.return err
let init t v =
C.init t N.name (to_bytes v) >>=? fun t ->
@ -200,8 +200,8 @@ module Make_data_set_storage (C : Raw_context.T) (I : INDEX)
~get:(fun c ->
let (c, k) = unpack c in
mem c k >>= function
| true -> return (Some true)
| false -> return None)
| true -> return_some true
| false -> return_none)
(register_indexed_subcontext
~list:(fun c -> elements c >>= return)
C.description I.args)
@ -227,11 +227,11 @@ module Make_indexed_data_storage
Lwt.return (of_bytes ~key b)
let get_option s i =
C.get_option s (I.to_path i []) >>= function
| None -> return None
| None -> return_none
| Some b ->
let key = C.absolute_key s (I.to_path i []) in
match of_bytes ~key b with
| Ok v -> return (Some v)
| Ok v -> return_some v
| Error _ as err -> Lwt.return err
let set s i v =
C.set s (I.to_path i []) (to_bytes v) >>=? fun t ->
@ -634,8 +634,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
~get:(fun c ->
let (c, k) = unpack c in
mem c k >>= function
| true -> return (Some true)
| false -> return None)
| true -> return_some true
| false -> return_none)
(register_named_subcontext Raw_context.description N.name)
Data_encoding.bool
@ -655,11 +655,11 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
Lwt.return (of_bytes ~key b)
let get_option s i =
Raw_context.get_option (pack s i) N.name >>= function
| None -> return None
| None -> return_none
| Some b ->
let key = Raw_context.absolute_key (pack s i) N.name in
match of_bytes ~key b with
| Ok v -> return (Some v)
| Ok v -> return_some v
| Error _ as err -> Lwt.return err
let set s i v =
Raw_context.set (pack s i) N.name (to_bytes v) >>=? fun c ->

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

@ -24,7 +24,7 @@ let traverse_rolls ctxt head =
let get_rolls ctxt delegate =
Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>= wrap >>=? function
| None -> return []
| None -> return_nil
| Some head_roll -> traverse_rolls ctxt head_roll
let check_rolls b (account:Account.t) =

4
src/proto_genesis/lib_protocol/src/main.ml
View File

@ -168,12 +168,12 @@ let rpc_services = Services.rpc_services
let sandbox_param_key = [ "sandbox_parameter" ]
let get_sandbox_param ctxt =
Context.get ctxt sandbox_param_key >>= function
| None -> return None
| None -> return_none
| Some bytes ->
match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
| None ->
failwith "Internal error: failed to parse the sandbox parameter."
| Some json -> return (Some json)
| Some json -> return_some json
let init ctxt block_header =
Data.Init.tag_first_block ctxt >>=? fun ctxt ->