Stdlib: make Option's interface close to Base's Option's interface

parent 7769fac9
Pipeline #61800867 failed with stages
in 16 minutes and 38 seconds
......@@ -181,7 +181,7 @@ module Description = struct
let open RPC_description in
(* TODO collect and display arg description (in path and in query) *)
Format.fprintf ppf "@[<h>%a@]%a"
Format.pp_print_text (Option.unopt ~default:"" service.description)
Format.pp_print_text (Option.value ~default:"" service.description)
Query.pp service.query
let pp ppf prefix service =
......
......@@ -532,7 +532,7 @@ let update
?rpc_tls
?log_output
?bootstrap_threshold
cfg = let data_dir = Option.unopt ~default:cfg.data_dir data_dir in
cfg = let data_dir = Option.value ~default:cfg.data_dir data_dir in
Node_data_version.ensure_data_dir data_dir >>=? fun () ->
let peer_table_size =
Option.map peer_table_size ~f:(fun i -> i, i / 4 * 3) in
......@@ -542,15 +542,15 @@ let update
let limits : P2p.limits = {
cfg.p2p.limits with
min_connections =
Option.unopt
Option.value
~default:cfg.p2p.limits.min_connections
min_connections ;
expected_connections =
Option.unopt
Option.value
~default:cfg.p2p.limits.expected_connections
expected_connections ;
max_connections =
Option.unopt
Option.value
~default:cfg.p2p.limits.max_connections
max_connections ;
max_download_speed =
......@@ -570,9 +570,9 @@ let update
} in
let p2p : p2p = {
expected_pow =
Option.unopt ~default:cfg.p2p.expected_pow expected_pow ;
Option.value ~default:cfg.p2p.expected_pow expected_pow ;
bootstrap_peers =
Option.unopt ~default:cfg.p2p.bootstrap_peers bootstrap_peers ;
Option.value ~default:cfg.p2p.bootstrap_peers bootstrap_peers ;
listen_addr =
Option.first_some listen_addr cfg.p2p.listen_addr ;
discovery_addr =
......@@ -594,14 +594,14 @@ let update
}
and log : Lwt_log_sink_unix.cfg = {
cfg.log with
output = Option.unopt ~default:cfg.log.output log_output ;
output = Option.value ~default:cfg.log.output log_output ;
}
and shell : shell = {
peer_validator_limits = cfg.shell.peer_validator_limits ;
block_validator_limits = cfg.shell.block_validator_limits ;
prevalidator_limits = cfg.shell.prevalidator_limits ;
chain_validator_limits =
Option.unopt_map
Option.value_map
~default:cfg.shell.chain_validator_limits
~f:(fun bootstrap_threshold ->
{ cfg.shell.chain_validator_limits
......
......@@ -65,10 +65,10 @@ let wrap
cors_origins cors_headers log_output =
let actual_data_dir =
Option.unopt ~default:Node_config_file.default_data_dir data_dir in
Option.value ~default:Node_config_file.default_data_dir data_dir in
let config_file =
Option.unopt ~default:(actual_data_dir // "config.json") config_file in
Option.value ~default:(actual_data_dir // "config.json") config_file in
let rpc_tls =
Option.map
......
......@@ -104,7 +104,7 @@ module System = struct
type t = Ptime.Span.t
let multiply_exn f s =
let open Ptime.Span in
Option.unopt_exn
Option.value_exn
(Failure "Time.System.Span.multiply_exn")
(of_float_s (f *. Ptime.Span.to_float_s s))
let of_seconds_exn f =
......
......@@ -401,8 +401,8 @@ let setup_formatter ppf format verbosity =
let push_ansi_format (fg, bg, b, u) =
let format = match !ansi_stack with
| (pfg, pbg, pb, pu) :: _ ->
(Option.unopt ~default: pfg fg,
Option.unopt ~default: pbg bg,
(Option.value ~default: pfg fg,
Option.value ~default: pbg bg,
pb || b,
pu || u)
| [] -> assert false in
......@@ -1171,7 +1171,7 @@ let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands cct
| [] -> None
| hd :: tl ->
if hd = prev_arg
then Some (Option.unopt ~default:(n + 1) (ind (n + 1) tl))
then Some (Option.value ~default:(n + 1) (ind (n + 1) tl))
else (ind (n + 1) tl) in
begin
if prev_arg = script
......@@ -1294,15 +1294,15 @@ let pp_cli_errors ppf ~executable_name ~global_options ~default errs =
| Option_expected_argument (arg, command) ->
Format.fprintf ppf
"Command line option @{<opt>%s@} expects an argument." arg ;
Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
Some (Option.value_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
| Bad_option_argument (arg, command) ->
Format.fprintf ppf
"Wrong value for command line option @{<opt>%s@}." arg ;
Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
Some (Option.value_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
| Multiple_occurences (arg, command) ->
Format.fprintf ppf
"Command line option @{<opt>%s@} appears multiple times." arg ;
Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
Some (Option.value_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
| No_manual_entry [ keyword ] ->
Format.fprintf ppf
"No manual entry that match @{<hilight>%s@}."
......@@ -1321,7 +1321,7 @@ let pp_cli_errors ppf ~executable_name ~global_options ~default errs =
Format.fprintf ppf
"Unexpected command line option @{<opt>%s@}."
option ;
Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
Some (Option.value_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
| Extra_arguments (extra, command) ->
Format.fprintf ppf
"Extra command line arguments:@, @[<h>%a@]."
......
......@@ -77,8 +77,8 @@ let pk_uri_parameter () = Clic.parameter (fun _ s ->
with Failure s -> failwith "Error while parsing URI: %s" s)
let pk_uri_param ?name ?desc params =
let name = Option.unopt ~default:"uri" name in
let desc = Option.unopt
let name = Option.value ~default:"uri" name in
let desc = Option.value
~default:"public key\n\
Varies from one scheme to the other.\n\
Use command `list signing schemes` for more \
......@@ -90,8 +90,8 @@ let sk_uri_parameter () = Clic.parameter (fun _ s ->
with Failure s -> failwith "Error while parsing URI: %s" s)
let sk_uri_param ?name ?desc params =
let name = Option.unopt ~default:"uri" name in
let desc = Option.unopt
let name = Option.value ~default:"uri" name in
let desc = Option.value
~default:"secret key\n\
Varies from one scheme to the other.\n\
Use command `list signing schemes` for more \
......@@ -181,13 +181,13 @@ let () =
(fun sk -> Signature_mismatch sk)
let neuterize sk_uri =
let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
let scheme = Option.value ~default:"" (Uri.scheme sk_uri) in
find_signer_for_key ~scheme >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.neuterize sk_uri
let public_key ?interactive pk_uri =
let scheme = Option.unopt ~default:"" (Uri.scheme pk_uri) in
let scheme = Option.value ~default:"" (Uri.scheme pk_uri) in
find_signer_for_key ~scheme >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.public_key ?interactive pk_uri
......@@ -197,7 +197,7 @@ let public_key_hash ?interactive pk_uri =
return (Signature.Public_key.hash pk, Some pk)
let sign cctxt ?watermark sk_uri buf =
let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
let scheme = Option.value ~default:"" (Uri.scheme sk_uri) in
find_signer_for_key ~scheme >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.sign ?watermark sk_uri buf >>=? fun signature ->
......@@ -227,19 +227,19 @@ let check ?watermark pk_uri signature buf =
return (Signature.check ?watermark pk signature buf)
let deterministic_nonce sk_uri data =
let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
let scheme = Option.value ~default:"" (Uri.scheme sk_uri) in
find_signer_for_key ~scheme >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.deterministic_nonce sk_uri data
let deterministic_nonce_hash sk_uri data =
let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
let scheme = Option.value ~default:"" (Uri.scheme sk_uri) in
find_signer_for_key ~scheme >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.deterministic_nonce_hash sk_uri data
let supports_deterministic_nonces sk_uri =
let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
let scheme = Option.value ~default:"" (Uri.scheme sk_uri) in
find_signer_for_key ~scheme >>=? fun signer ->
let module Signer = (val signer : SIGNER) in
Signer.supports_deterministic_nonces sk_uri
......
......@@ -144,10 +144,10 @@ module Cfg_file = struct
Some tls, Some web_port, remote_signer, confirmations, password_filename ))
(fun (base_dir, node_addr, node_port, tls, web_port,
remote_signer, confirmations, password_filename) ->
let node_addr = Option.unopt ~default:default.node_addr node_addr in
let node_port = Option.unopt ~default:default.node_port node_port in
let tls = Option.unopt ~default:default.tls tls in
let web_port = Option.unopt ~default:default.web_port web_port in
let node_addr = Option.value ~default:default.node_addr node_addr in
let node_port = Option.value ~default:default.node_port node_port in
let tls = Option.value ~default:default.tls tls in
let web_port = Option.value ~default:default.web_port web_port in
{ base_dir ; node_addr ; node_port ; tls ; web_port ;
remote_signer ; confirmations ; password_filename })
(obj8
......@@ -503,13 +503,13 @@ let parse_config_args (ctx : #Client_context.full) argv =
read_config_file config_file
end >>=? fun cfg ->
let tls = cfg.tls || tls in
let node_addr = Option.unopt ~default:cfg.node_addr node_addr in
let node_port = Option.unopt ~default:cfg.node_port node_port in
let node_addr = Option.value ~default:cfg.node_addr node_addr in
let node_port = Option.value ~default:cfg.node_port node_port in
Tezos_signer_backends.Remote.read_base_uri_from_env () >>=? fun remote_signer_env ->
let remote_signer =
Option.first_some remote_signer
(Option.first_some remote_signer_env cfg.remote_signer) in
let confirmations = Option.unopt ~default:cfg.confirmations confirmations in
let confirmations = Option.value ~default:cfg.confirmations confirmations in
let cfg = { cfg with tls ; node_port ; node_addr ;
remote_signer ; confirmations ; password_filename } in
if Sys.file_exists base_dir && not (Sys.is_directory base_dir) then begin
......
......@@ -377,7 +377,7 @@ let commands version : Client_context.full Clic.command list =
cctxt#message "%s: %s" name v
| _, Some uri ->
let scheme =
Option.unopt ~default:"unencrypted" @@
Option.value ~default:"unencrypted" @@
Uri.scheme (uri : sk_uri :> Uri.t) in
cctxt#message "%s: %s (%s sk known)" name v scheme
| Some _, _ ->
......
......@@ -138,7 +138,7 @@ let safe_encode ?alphabet s =
raw_encode ?alphabet (s ^ checksum s)
let safe_decode ?alphabet s =
raw_decode ?alphabet s |> Option.apply ~f:begin fun s ->
raw_decode ?alphabet s |> Option.bind ~f:begin fun s ->
let len = String.length s in
if len < 4 then None else
(* only if the string is long enough to extract a checksum do we check it *)
......@@ -164,8 +164,8 @@ let prefix { prefix ; _ } = prefix
let simple_decode ?alphabet { prefix ; of_raw ; _ } s =
safe_decode ?alphabet s |>
Option.apply ~f:(TzString.remove_prefix ~prefix) |>
Option.apply ~f:of_raw
Option.bind ~f:(TzString.remove_prefix ~prefix) |>
Option.bind ~f:of_raw
let simple_encode ?alphabet { prefix ; to_raw ; _ } d =
safe_encode ?alphabet (prefix ^ to_raw d)
......@@ -234,7 +234,7 @@ module MakeEncodings(E: sig
| None -> find s encodings
| Some msg -> of_raw msg |> Option.map ~f:wrap in
safe_decode ?alphabet s |>
Option.apply ~f:(fun s -> find s !encodings)
Option.bind ~f:(fun s -> find s !encodings)
end
......
......@@ -338,7 +338,7 @@ let describe (type x) (encoding : x Encoding.t) =
([ Anonymous_field (kind, Ref name) ], references)
| (Mu { kind ; name ; title ; description ; fix } as encoding) ->
let kind = (kind :> Kind.t) in
let title = Option.unopt ~default:name title in
let title = Option.value ~default:name title in
if List.mem name recursives
then ([ Anonymous_field (kind, Ref name) ], references)
else
......@@ -474,7 +474,7 @@ let describe (type x) (encoding : x Encoding.t) =
let name, references = union ref_name recursives references kind tag_size cases in
(Ref name, references)
| Mu { name ; title ; description ; fix ; _ } as encoding ->
let title = Option.unopt ~default:name title in
let title = Option.value ~default:name title in
if List.mem name recursives
then (Ref name, references)
else
......
......@@ -207,11 +207,11 @@ let rec read_rec : type ret. ret Encoding.t -> state -> ret
| String_enum (_, arr) ->
Atom.string_enum arr state
| Array (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
let max_length = Option.value ~default:max_int max_length in
let l = read_list List_too_long max_length e state in
Array.of_list l
| List (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
let max_length = Option.value ~default:max_int max_length in
read_list Array_too_long max_length e state
| (Obj (Req { encoding = e ; _ })) -> read_rec e state
| (Obj (Dft { encoding = e ; _ })) -> read_rec e state
......
......@@ -276,11 +276,11 @@ let rec read_rec
| String_enum (_, arr) ->
Atom.string_enum arr resume state k
| Array (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
let max_length = Option.value ~default:max_int max_length in
read_list Array_too_long max_length e state @@ fun (l, state) ->
k (Array.of_list l, state)
| List (max_length, e) ->
let max_length = Option.unopt ~default:max_int max_length in
let max_length = Option.value ~default:max_int max_length in
read_list List_too_long max_length e state k
| (Obj (Req { encoding = e ; _ })) -> read_rec whole e state k
| (Obj (Dft { encoding = e ; _ })) -> read_rec whole e state k
......
......@@ -223,7 +223,7 @@ module Make(Prefix : sig val id : string end) = struct
description ;
from_error ;
encoding_case ;
pp = Option.unopt ~default:(json_pp name encoding) pp }
pp = Option.value ~default:(json_pp name encoding) pp }
:: !error_kinds
let register_wrapped_error_kind
......@@ -712,7 +712,7 @@ let protect ?on_error ?canceler t =
| Ok _ -> res
| Error err ->
let canceled =
Option.unopt_map canceler ~default:false ~f:Lwt_canceler.canceled in
Option.value_map canceler ~default:false ~f:Lwt_canceler.canceled in
let err = if canceled then [Canceled] else err in
match on_error with
| None -> Lwt.return_error err
......
......@@ -683,7 +683,7 @@ module Lwt_log_sink = struct
(fun () ->
let ev = v () in
let section =
Option.unopt_map ~f:Section.to_lwt_log
Option.value_map ~f:Section.to_lwt_log
section ~default:default_section in
let level = M.level ev in
Format.kasprintf
......
......@@ -675,7 +675,7 @@ let build_rpc_directory net =
RPC_directory.opt_register1 dir P2p_services.Connections.S.info
begin fun peer_id () () ->
return @@
Option.apply net.pool ~f: begin fun pool ->
Option.bind net.pool ~f: begin fun pool ->
Option.map ~f:P2p_pool.Connection.info
(P2p_pool.Connection.find_by_peer_id pool peer_id)
end
......
......@@ -174,7 +174,7 @@ module Scheduler(IO : IO) = struct
canceler = Lwt_canceler.create () ;
worker = Lwt.return_unit ;
counter = Moving_average.create ~init:0 ~alpha ;
max_speed ; quota = Option.unopt ~default:0 max_speed ;
max_speed ; quota = Option.value ~default:0 max_speed ;
quota_updated = Lwt_condition.create () ;
readys = Lwt_condition.create () ;
readys_high = Queue.create () ;
......@@ -404,9 +404,9 @@ let write_now { write_queue ; _ } msg = Lwt_pipe.push_now write_queue msg
let read_from conn ?pos ?len buf msg =
let maxlen = MBytes.length buf in
let pos = Option.unopt ~default:0 pos in
let pos = Option.value ~default:0 pos in
assert (0 <= pos && pos < maxlen) ;
let len = Option.unopt ~default:(maxlen - pos) len in
let len = Option.value ~default:(maxlen - pos) len in
assert (len <= maxlen - pos) ;
match msg with
| Ok msg ->
......@@ -448,8 +448,8 @@ let read ?canceler conn ?pos ?len buf =
let read_full ?canceler conn ?pos ?len buf =
let maxlen = MBytes.length buf in
let pos = Option.unopt ~default:0 pos in
let len = Option.unopt ~default:(maxlen - pos) len in
let pos = Option.value ~default:0 pos in
let len = Option.value ~default:(maxlen - pos) len in
assert (0 <= pos && pos < maxlen) ;
assert (len <= maxlen - pos) ;
let rec loop pos len =
......
......@@ -138,7 +138,7 @@ let rec maintain st =
let Pool pool = st.pool in
let n_connected = P2p_pool.active_connections pool in
let older_than =
Option.unopt_exn
Option.value_exn
(Failure "P2p_maintenance.maintain: time overflow")
(Ptime.add_span (Systime_os.now ()) (Ptime.Span.neg st.config.greylist_timeout))
in
......
......@@ -125,7 +125,7 @@ module Info = struct
if Time.System.compare t1 t2 < 0 then a2 else a1
let log { events ; watchers ; _ } ?timestamp kind =
let time = Option.unopt ~default:(Systime_os.now ()) timestamp in
let time = Option.value ~default:(Systime_os.now ()) timestamp in
let event = Time.System.stamp ~time kind in
Ring.add events event ;
Lwt_watcher.notify watchers event
......@@ -186,7 +186,7 @@ let set_running
let set_greylisted timestamp point_info =
point_info.Info.greylisting_end <-
Option.unopt_exn
Option.value_exn
(Failure "P2p_point_state.set_greylisted: overflow in time")
(Ptime.add_span
timestamp
......@@ -213,7 +213,7 @@ let set_disconnected
point_info.greylisting_delay <-
point_info.greylisting.initial_delay ;
point_info.greylisting_end <-
Option.unopt_exn
Option.value_exn
(Failure "P2p_point_state.set_disconnected: overflow in time")
(Ptime.add_span timestamp
point_info.greylisting.disconnection_delay) ;
......
......@@ -464,7 +464,7 @@ let broadcast_bootstrap_msg pool =
(* this function duplicates bit of code from the modules below to avoid
creating mutually recursive modules *)
let connection_of_peer_id pool peer_id =
Option.apply
Option.bind
(P2p_peer.Table.find_opt pool.known_peer_ids peer_id) ~f:begin fun p ->
match P2p_peer_state.get p with
| Running { data ; _ } -> Some data
......@@ -497,7 +497,7 @@ module Points = struct
P2p_point.Table.find_opt known_points point
let get_trusted pool point =
Option.unopt_map ~default:false ~f:P2p_point_state.Info.trusted
Option.value_map ~default:false ~f:P2p_point_state.Info.trusted
(P2p_point.Table.find_opt pool.known_points point)
let set_trusted pool point =
......@@ -601,7 +601,7 @@ module Connection = struct
let trusted_node conn =
P2p_peer_state.Info.trusted conn.peer_info ||
Option.unopt_map
Option.value_map
~default:false
~f:P2p_point_state.Info.trusted
conn.point_info
......@@ -667,7 +667,7 @@ module Connection = struct
P2p_socket.remote_metadata conn
let find_by_peer_id pool peer_id =
Option.apply
Option.bind
(Peers.info pool peer_id)
~f:(fun p ->
match P2p_peer_state.get p with
......@@ -675,7 +675,7 @@ module Connection = struct
| _ -> None)
let find_by_point pool point =
Option.apply
Option.bind
(Points.info pool point)
~f:(fun p ->
match P2p_point_state.get p with
......@@ -738,7 +738,7 @@ let rec connect ?timeout pool point =
fail_when (Points.banned pool point)
(P2p_errors.Point_banned point) >>=? fun () ->
let timeout =
Option.unopt ~default:pool.config.connection_timeout timeout in
Option.value ~default:pool.config.connection_timeout timeout in
fail_unless
(active_connections pool <= pool.config.max_connections)
P2p_errors.Too_many_connections >>=? fun () ->
......@@ -852,7 +852,7 @@ and raw_authenticate pool ?point_info canceler fd point =
~p2p_versions:pool.custom_p2p_versions
info.announced_version in
let acceptable_point =
Option.unopt_map connection_point_info
Option.value_map connection_point_info
~default:(not pool.config.private_mode)
~f:begin fun connection_point_info ->
match P2p_point_state.get connection_point_info with
......
......@@ -230,7 +230,16 @@ module Make (Context : CONTEXT) = struct
module Nativeint = Nativeint
module Buffer = Buffer
module Format = Format
module Option = Option
module Option = struct
(* NOTE: changing the signature of protocol environments is not done
lightly. Thus we add this compatibility layer. *)
include Option
let map ~f v = map v ~f
let apply ~f v = bind v ~f
let iter ~f v = iter v ~f
let unopt ~default v = value v ~default
let unopt_map ~f ~default v = value_map v ~default ~f
end
module MBytes = MBytes
module Raw_hashes = struct
let sha256 msg = Hacl.Hash.SHA256.digest msg
......
......@@ -54,7 +54,7 @@ module Context = struct
if m == v then None else Some v
| [], (Key _ | Dir _), None -> Some empty
| n :: k, Dir m, _ -> begin
match raw_set (Option.unopt ~default:empty
match raw_set (Option.value ~default:empty
(StringMap.find_opt n m)) k v with
| None -> None
| Some rm when rm = empty ->
......
......@@ -201,7 +201,7 @@ let pp_rpc_error ppf err =
Format.fprintf ppf
"@[<v 2>The server refused connection to host \"%s\", \
please check the node settings for CORS allowed origins.@]"
(Option.unopt ~default:"" host)
(Option.value ~default:"" host)
type error +=
| Request_failed of { meth: RPC_service.meth ;
......@@ -267,7 +267,7 @@ let generic_call ?logger ?headers ?accept ?body ?media meth uri : (content, cont
request_failed meth uri (Unsupported_media_type media)
| `Not_acceptable acceptable ->
let proposed =
Option.unopt_map accept ~default:"" ~f:Media_type.accept_header in
Option.value_map accept ~default:"" ~f:Media_type.accept_header in
request_failed meth uri (Not_acceptable { proposed ; acceptable })
| `Bad_request msg ->
request_failed meth uri (Bad_request msg)
......@@ -376,7 +376,7 @@ let handle accept (meth, uri, ans) =
request_failed meth uri (Unsupported_media_type name)
| `Not_acceptable acceptable ->
let proposed =
Option.unopt_map (Some accept) ~default:"" ~f:Media_type.accept_header in
Option.value_map (Some accept) ~default:"" ~f:Media_type.accept_header in
request_failed meth uri (Not_acceptable { proposed ; acceptable })
| `Bad_request msg ->
request_failed meth uri (Bad_request msg)
......@@ -388,7 +388,7 @@ let handle accept (meth, uri, ans) =
| `Unexpected_content_type (body, media) ->
Cohttp_lwt.Body.to_string body >>= fun body ->
let received =
Option.unopt_map media ~default:"" ~f:(fun (l, r) -> l^"/"^r) in
Option.value_map media ~default:"" ~f:(fun (l, r) -> l^"/"^r) in
request_failed meth uri
(Unexpected_content_type { received ;
acceptable = List.map Media_type.name accept ;
......
......@@ -63,7 +63,7 @@ let get_next_baker_by_priority priority block =
~max_priority:(priority+1) block >>=? fun bakers ->
let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
timestamp; _ } = List.find (fun { Alpha_services.Delegate.Baking_rights.priority = p ; _ } -> p = priority) bakers in
return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
return (pkh, priority, Option.value_exn (Failure "") timestamp)
let get_next_baker_by_account pkh block =
Alpha_services.Delegate.Baking_rights.get rpc_ctxt
......@@ -71,7 +71,7 @@ let get_next_baker_by_account pkh block =
~max_priority:256 block >>=? fun bakers ->
let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
timestamp ; priority ; _ } = List.hd bakers in
return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
return (pkh, priority, Option.value_exn (Failure "") timestamp)
let get_next_baker_excluding excludes block =
Alpha_services.Delegate.Baking_rights.get rpc_ctxt
......@@ -82,7 +82,7 @@ let get_next_baker_excluding excludes block =
(fun { Alpha_services.Delegate.Baking_rights.delegate ; _ } ->
not (List.mem delegate excludes))
bakers in
return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
return (pkh, priority, Option.value_exn (Failure "") timestamp)
let dispatch_policy = function
| By_priority p -> get_next_baker_by_priority p
......
......@@ -55,7 +55,7 @@ let begin_construction ?(priority=0) ?timestamp ?seed_nonce_hash (predecessor :
Block.get_next_baker ~policy:(Block.By_priority priority)
predecessor >>=? fun (delegate, priority, real_timestamp) ->
Account.find delegate >>=? fun delegate ->
let timestamp = Option.unopt ~default:real_timestamp timestamp in
let timestamp = Option.value ~default:real_timestamp timestamp in
let contents = Block.Forge.contents ~priority ?seed_nonce_hash () in
let protocol_data = {
Block_header.contents ;
......
......@@ -70,7 +70,7 @@ let manager_operation
?public_key ~source ctxt operation =
Context.Contract.counter ctxt source >>=? fun counter ->
Context.Contract.manager ctxt source >>=? fun account ->
let public_key = Option.unopt ~default:account.pk public_key in
let public_key = Option.value ~default:account.pk public_key in
let counter = Z.succ counter in
Context.Contract.is_manager_key_revealed ctxt source >>=? function
| true ->
......@@ -134,10 +134,10 @@ let origination ?delegate ?script
?(spendable = true) ?(delegatable = true) ?(preorigination = None)
?public_key ?manager ?credit ?fee ?gas_limit ?storage_limit ctxt source =
Context.Contract.manager ctxt source >>=? fun account ->
let manager = Option.unopt ~default:account.pkh manager in
let manager = Option.value ~default:account.pkh manager in
let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in
let default_credit = Option.unopt_exn Impossible default_credit in
let credit = Option.unopt ~default:default_credit credit in
let default_credit = Option.value_exn Impossible default_credit in
let credit = Option.value ~default:default_credit credit in
let operation =
Origination {
manager ;
......
......@@ -204,7 +204,7 @@ let build_raw_rpc_directory
(* context *)
register1 S.Context.read begin fun block path q () ->
let depth = Option.unopt ~default:max_int q#depth in
let depth = Option.value ~default:max_int q#depth in
fail_unless (depth >= 0)
(Tezos_shell_services.Block_services.Invalid_depth_arg depth) >>=? fun () ->
State.Block.context block >>= fun context ->
......@@ -344,10 +344,11 @@ let get_block chain_state = function
else if n = 0 then
Lwt.return head
else
State.Block.read_opt chain_state ~pred:n (State.Block.hash head) >|= Option.unopt_assert ~loc:__POS__
State.Block.read_opt chain_state ~pred:n (State.Block.hash head)
>|= Option.value_assert ~loc:__POS__
| `Hash (hash, n) ->
if n < 0 then
State.Block.read_opt chain_state hash >|= Option.unopt_assert ~loc:__POS__ >>= fun block ->
State.Block.read_opt chain_state hash >|= Option.value_assert ~loc:__POS__ >>= fun block ->
Chain.head chain_state >>= fun head ->
let head_level = State.Block.level head in
let block_level = State.Block.level block in
......@@ -356,16 +357,18 @@ let get_block chain_state = function
if target < 0 then
Lwt.fail Not_found
else
State.Block.read_opt chain_state ~pred:target (State.Block.hash head) >|= Option.unopt_assert ~loc:__POS__
State.Block.read_opt chain_state ~pred:target (State.Block.hash head)
>|= Option.value_assert ~loc:__POS__
else
State.Block.read_opt chain_state ~pred:n hash >|= Option.unopt_assert ~loc:__POS__
State.Block.read_opt chain_state ~pred:n hash >|= Option.value_assert ~loc:__POS__
| `Level i ->
Chain.head chain_state >>= fun head ->
let target = Int32.(to_int (sub (State.Block.level head) i)) in
if target < 0 then
Lwt.fail Not_found
else
State.Block.read_opt chain_state ~pred:target (State.Block.hash head) >|= Option.unopt_assert ~loc:__POS__
State.Block.read_opt chain_state ~pred:target (State.Block.hash head)
>|= Option.value_assert ~loc:__POS__
let build_rpc_directory chain_state block =
get_block chain_state block >>= fun block ->
......
......@@ -29,14 +29,14 @@ let block_hash_tag = Tag.def ~doc:"Block hash" "block_hash" Block_hash.pp_short
let genesis chain_state =
let genesis = State.Chain.genesis chain_state in
State.Block.read_opt chain_state genesis.block >|= Option.unopt_assert ~loc:__POS__
State.Block.read_opt chain_state genesis.block <