How to deal with 'a Lwt objects in a function?
My code is
Array.map (fun conn -> let* resp = (call_server conn
(RequestVoteArg({
candidateNumber = myState.myPersistentState.id;
term = myState.myPersistentState.currentTerm;
lastlogIndex = (Array.get myState.myPersistentState.logs ((Array.length myState.myPersistentState.logs) - 1)).index;
lastlogTerm = (Array.get myState.myPersistentState.logs ((Array.length myState.myPersistentState.logs) - 1)).term
}))) in (match resp with
| Error(s) -> Printf.printf "requestVote: connection failed: %s" s
| Ok(repl, s) ->
(match repl with
| RequestVoteRet(repl) ->
if repl.voteGranted then current_vote := !current_vote + 1;
if not (repl.term = (-1l)) then myState.myPersistentState.currentTerm <- repl.term;
Printf.printf "requestVote: status: %s" s
| _ -> failwith "Should not reach here")); conn) peers
But there is an error: This expression (conn in the end) has type H2_lwt_unix.Client.t but an expression was expected of type 'weak702 Lwt.t.
peers is an array of connections (type: H2_lwt_unix.Client.t).
The definition of call_server is:
val call_server: H2_lwt_unix.Client.t -> protobufArg -> (Types.protobufRet * Grpc.Status.t, Grpc.Status.t) result Lwt.t
and
let build_connection addr port =
let* addrs =
Lwt_unix.getaddrinfo addr (string_of_int port)
[ Unix.(AI_FAMILY PF_INET) ]
in
let socket = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
let* () = Lwt_unix.connect socket (List.hd addrs).Unix.ai_addr in
let error_handler _ = print_endline "error" in
let connection =
H2_lwt_unix.Client.create_connection ~error_handler socket
in connection
let call_server connection req =
let enc = Pbrt.Encoder.create() in
match req with
| RequestVoteArg(s) ->
let proto_s =
Proto.Proto_types.default_request_vote_arg ~candidate_number:s.candidateNumber ~term:s.term ~lastlog_term:s.lastlogTerm ~lastlog_index:s.lastlogIndex ()
in
Proto.Proto_pb.encode_request_vote_arg proto_s enc;
Client.call ~service:"raft.Proto" ~rpc:"RequestVote"
~do_request:(H2_lwt_unix.Client.request connection ~error_handler:ignore)
~handler:
(Client.Rpc.unary (Pbrt.Encoder.to_string enc) ~f:(fun decoder ->
(let+ decoder = decoder in
(match decoder with
| Some (decoder) ->
let decoder = Pbrt.Decoder.of_string decoder in
let reply = Proto.Proto_pb.decode_request_vote_reply decoder in
RequestVoteRet( { term=reply.term; voteGranted=reply.vote_granted } )
| None -> RequestVoteRet( { term=(-1l); voteGranted=false } ))))) ()
| AppendEntriesArg(s) ->
let proto_s =
Proto.Proto_types.default_append_entries_arg ~term: s.term ~leader_id:s.leaderID ~next_log_index:s.nextLogIndex ~next_log_term:s.nextLogTerm ~entries:(List.map (fun lg -> Proto.Proto_types.default_log ~command: lg.command ~term:lg.term ~index: lg.index ()) (Array.to_list (s.entries)) ) ()
in
Proto.Proto_pb.encode_append_entries_arg proto_s enc;
Client.call ~service:"raft.Proto" ~rpc:"AppendEntries"
~do_request:(H2_lwt_unix.Client.request connection ~error_handler:ignore)
~handler:
(Client.Rpc.unary (Pbrt.Encoder.to_string enc) ~f:(fun decoder ->
let+ decoder = decoder in
match decoder with
| Some(decoder) ->
let decoder = Pbrt.Decoder.of_string decoder in
let reply = Proto.Proto_pb.decode_append_entries_reply decoder in
AppendEntriesRet( { term=reply.term; success=reply.success } )
| None -> AppendEntriesRet( { term=(-1l); success=false } ))) ()
Your code can be simplified to:
let f (conn:H2_lwt_unix.Client.t) =
let* resp = ... in
...; conn
which fails because conn is a connection and not a promise of returning a connection.
The easiest fix is to wrap this value inside a Lwt promise with either
let f (conn:H2_lwt_unix.Client.t) =
let* resp = ... in
...; Lwt.return conn
or
let f (conn:H2_lwt_unix.Client.t) =
let+ resp = ... in
...; conn
Related
I'm implementing the Raft protocol and my code is as follows:
let rec request_vote_loop: int =
match myState.myRole with
| Follower -> 0
| Leader -> 1
| Candidate ->
let trigger = Domain.spawn(fun _ -> Chan.send c TriggerEvent) in
let request_vote_daemon = Domain.spawn(fun _ ->
let rec loop n =
if n = 0 then 0
else let msg = Chan.recv votes in
match msg with
| (status, id) ->
Domain.join (Array.get !arr id);
if status = 1 then (Array.get votePeers id) := true; (Chan.send c ReceiveVoteEvent); loop (n - 1)
in loop ((Array.length (!peers)) / 2 + 1 - !current_vote)) in
let evt = Chan.recv c in
match evt with
| TimeoutEvent -> myState.myRole <- Follower; 3
| AppendEntriesEvent(_) ->
myState.myRole <- Follower; 4
| ReceiveVoteEvent ->
if !current_vote > (Array.length (!peers) / 2) then
begin current_vote := !current_vote + 1; myState.myRole <- Leader; 3 end
else current_vote := !current_vote + 1; request_vote_loop
| TriggerEvent ->
arr := Array.make (Array.length (!peers)) (Domain.spawn (fun i ->
if (!(Array.get votePeers i)) then 0
else
let conn = Array.get !peers i in
Lwt_main.run
(let+ resp = call_server conn
(RequestVoteArg({
candidateNumber = myState.myPersistentState.id;
term = myState.myPersistentState.currentTerm;
lastlogIndex = (Array.get myState.myPersistentState.logs ((Array.length myState.myPersistentState.logs) - 1)).index;
lastlogTerm = (Array.get myState.myPersistentState.logs ((Array.length myState.myPersistentState.logs) - 1)).term
})) in (match resp with
| Error(s) -> Chan.send votes (0, i); Printf.printf "requestVote: connection failed: %s" s; 1
| Ok(repl, s) ->
(match repl with
| RequestVoteRet(repl) ->
if repl.voteGranted then begin Chan.send votes (1, i); Printf.printf "requestVote: status: %s, currentVote: %d" s !current_vote; 2 end
else
if not (repl.term = (-1l)) then begin myState.myPersistentState.currentTerm <- repl.term; Chan.send votes (0, i);
Printf.printf "requestVote failed because of term: status: %s, currentVote: %d" s !current_vote; 3 end
else Chan.send votes (0, i); Printf.printf "requestVote failed: status: %s" s; 4
| _ -> failwith "Should not reach here" ))))); request_vote_loop
| _ -> failwith "Should not reach here"
in print_endline (Int.to_string request_vote_loop)
But there's an error that "This kind of expression is not allowed as right-hand side of `let rec'", it said my function is of type unit. I don't know what happened...
Thanks in advance.
Your definition starts like this:
let rec request_vote_loop: int = ...
This doesn't define a function, it defines a simple value of type int. The reason is that there are no parameters given.
There's too much code to process (and furthermore it's not self-contained). But I suspect you want to define a function that doesn't take any parameters. The way to do this is to pass () (known as unit) as the parameter:
let rec request_vote_loop () : int = ...
The recursive calls look like this:
request_vote_loop ()
The final call looks like this:
Int.to_string (request_vote_loop ())
I need to take list of list of integers from file and use my func combine to it. See please on my code, where is my mistake?
# let f x l = List.filter ((<>) x) l
let rec comb = function
| [] -> []
| x::[] -> [[x]]
| l ->
List.fold_left (fun acc x -> acc # List.map (fun p -> x::p) ( comb ( f x l))) [ ] l ;;
let file = "example.dat"
let message = [[1;2];[3;4]]
let () =
let oc = open_out file in
fprintf oc "%s\n" message;
close_out oc;
let ic = open_in file in
try
let line = input_line ic in
print_endline line;
flush stdout;
close_in ic
with e ->
close_in_noerr ic;
raise e;;
Compilation fails here : fprintf oc "%s\n" message; because %s expects a string whereas message is of type int list list.
You have to iterate fprintf accross the list :
List.iter (fun l ->
List.iter (fun i -> fprintf oc "%d ") l) message;
The complete code :
let file = "example.dat"
let message = [[1;2];[3;4]]
let () =
let oc = open_out file in
List.iter (fun l -> List.iter (fun x -> fprintf oc "%d\n" x) l) message ;
close_out oc;
let ic = open_in file in
try
let line = input_line ic in
print_endline line;
flush stdout;
close_in ic
with e ->
close_in_noerr ic;
raise e;;
I'm following Real World OCaml to get started with the language, and, at one point, I am to make use of s-expressions in a module signature. Here's my mli file:
open Core.Std
(** Configuration type for query handlers *)
type config with sexp
(** Name of the query handler *)
val name : string
(** Query handler abstract type *)
type t
(** Create a query handler from an existing [config] *)
val create : config -> t
(** Evaluate a query, where both input and output an s-expressions. *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
But, when compiling an implementation of that interface, I get the following error:
File "Query_Handler.mli", line 4, characters 12-16:
Error: Syntax error
Command exited with code 2.
So I opened utop to try with sexp on a simpler example:
module type Test = sig
type t with sexp
end;;
But I get the following error:
Error: Parse Error: "end" expected after [sig_items] (in [module type])
However, sexplib is installed and neither the book nor my searches on the Internet mention any "prerequisites" for using this syntax.
I feel like I'm missing something. Any idea? :(
This is because the sexp library had been rewritten to use Extension Point, instead of Camlp4.
open Core.Std
module type Query_handler = sig
(** Configuration for a query handler. Note that this can be
Converted to and from an s-expression *)
type config [##deriving sexp]
(** The name of the query-handling service *)
val name : string
(** The state of the query handler *)
type t
(** Create a new query handler from a config *)
val create : config -> t
(** Evaluate a given query, where both input and output are
s-expressions *)
val eval : t -> Sexp.t -> Sexp.t Or_error.t
end
module Unique = struct
type config = int [##deriving sexp]
type t = { mutable next_id: int }
let name = "unique"
let create start_at = { next_id = start_at }
let eval t sexp =
match Or_error.try_with (fun () -> unit_of_sexp sexp) with
| Error _ as err -> err
| Ok () ->
let response = Ok (Int.sexp_of_t t.next_id) in
t.next_id <- t.next_id + 1;
response
end
module List_dir = struct
type config = string [##deriving sexp]
type t = { cwd: string }
(** [is_abs p] Returns true if [p] is an absolute path *)
let is_abs p =
String.length p > 0 && p.[0] = '/'
let name = "ls"
let create cwd = { cwd }
let eval t sexp =
match Or_error.try_with (fun () -> string_of_sexp sexp) with
| Error _ as err -> err
| Ok dir ->
let dir =
if is_abs dir then dir
else Filename.concat t.cwd dir
in
Ok (Array.sexp_of_t String.sexp_of_t (Sys.readdir dir))
end
module type Query_handler_instance = sig
module Query_handler : Query_handler
val this : Query_handler.t
end
let build_instance (type a)
(module Q : Query_handler with type config = a)
config =
(module struct
module Query_handler = Q
let this = Q.create config
end : Query_handler_instance)
let build_dispatch_table handlers =
let table = String.Table.create () in
List.iter handlers
~f:(fun ((module I : Query_handler_instance) as instance) ->
Hashtbl.replace table ~key:I.Query_handler.name ~data:instance);
table
let dispatch dispatch_table name_and_query =
match name_and_query with
| Sexp.List [Sexp.Atom name; query] ->
begin match Hashtbl.find dispatch_table name with
| None ->
Or_error.error "Could not find matching handler"
name String.sexp_of_t
| Some (module I : Query_handler_instance) ->
I.Query_handler.eval I.this query
end
| _ ->
Or_error.error_string "malformed query"
let rec cli dispatch_table =
printf ">>> %!";
let result =
match In_channel.input_line stdin with
| None -> `Stop
| Some line ->
match Or_error.try_with (fun () -> Sexp.of_string line) with
| Error e -> `Continue (Error.to_string_hum e)
| Ok query ->
begin match dispatch dispatch_table query with
| Error e -> `Continue (Error.to_string_hum e)
| Ok s -> `Continue (Sexp.to_string_hum s)
end;
in
match result with
| `Stop -> ()
| `Continue msg ->
printf "%s\n%!" msg;
cli dispatch_table
let unique_instance = build_instance (module Unique) 0
let list_dir_instance = build_instance (module List_dir) "/var"
module Loader = struct
type config = (module Query_handler) list sexp_opaque [##deriving sexp]
type t = { known : (module Query_handler) String.Table.t
; active : (module Query_handler_instance) String.Table.t
}
let name ="loader"
let create known_list =
let active = String.Table.create () in
let known = String.Table.create () in
List.iter known_list
~f:(fun ((module Q : Query_handler) as q) ->
Hashtbl.replace known ~key:Q.name ~data:q);
{ known; active }
let load t handler_name config =
if Hashtbl.mem t.active handler_name then
Or_error.error "Can't re-register an active handler"
handler_name String.sexp_of_t
else
match Hashtbl.find t.known handler_name with
| None ->
Or_error.error "Unknown handler" handler_name String.sexp_of_t
| Some (module Q : Query_handler) ->
let instance =
(module struct
module Query_handler = Q
let this = Q.create (Q.config_of_sexp config)
end : Query_handler_instance)
in
Hashtbl.replace t.active ~key:handler_name ~data:instance;
Ok Sexp.unit
let unload t handler_name =
if not (Hashtbl.mem t.active handler_name) then
Or_error.error "Handler not active" handler_name String.sexp_of_t
else if handler_name = name then
Or_error.error_string "It's unwise to unload yourself"
else (
Hashtbl.remove t.active handler_name;
Ok Sexp.unit
)
type request =
| Load of string * Sexp.t
| Unload of string
| Known_services
| Active_services [##deriving sexp]
let eval t sexp =
match Or_error.try_with (fun () -> request_of_sexp sexp) with
| Error _ as err -> err
| Ok resp ->
match resp with
| Load (name,config) -> load t name config
| Unload name -> unload t name
| Known_services ->
Ok [%sexp ((Hashtbl.keys t.known ) : string list)]
| Active_services ->
Ok [%sexp ((Hashtbl.keys t.active) : string list)]
end
This is my ~/.ocamlinit; just comment out the camlp4. utop should work happy.
#use "topfind";;
#warnings "+9"
#thread;;
(*camlp4;;*)
#require "core.top";;
#require "core_extended";;
#require "core_bench";;
#require "ppx_jane";;
#require "ctypes";;
#require "ctypes.foreign";;
I have a homework where i need to write 2 communication servers, one which generates natural numbers and the other which prints them. the generating server will be sending to the printing server. The servers should communicate over the shared channel chan.The main function should spawn a thread for each server.
`
val sender = fn : int -> unit
val receiver = fn : unit -> 'a
val main = fn : unit -> unit
`
And so far this is code i have written:
`
datatype 'a inflist = NIL
| CONS of 'a * (unit -> 'a inflist);
fun HD (CONS(a,b)) = a
| HD NIL = raise Subscript;
fun TL (CONS(a,b)) = b()
| TL NIL = raise Subscript;
fun NULL NIL = true
| NULL _ = false;
fun TAKE(xs, 0) = []
| TAKE(NIL, n) = raise Subscript
| TAKE(CONS(x,xf), n) = x::TAKE(xf(), n-1);
fun FROMN n = CONS (n,fn () => FROMN (n+1));
val natnumber = FROMN 0;
fun printGenList f (h::t) = (f h; printGenList f t);
fun printList l = printGenList (fn(e) => print(Int.toString(e)^" ")) l;
fun printPairList l = printGenList (fn(e,f) => print("("^Int.toString(e)^", "^Int.toString(f)^") ")) l;
CM.make "$cml/cml.cm";
open CML;
val chan: int chan = channel();
fun gen ch () = send (ch, printList(TAKE(natnumber,101)));
fun printnat ch () = recv (ch);
fun main () =
let
val ch = channel() :int chan ;
val _ = spawn (gen ch);
val _ = spawn (printnat ch);
in
()
end;
`
But i am not getting the output. Am i going wrong in my syntax or the logic?
I am new to SML and Concurrent ML. Please help me.
Why are you using a infinite list? There are simpler ways to implement this.
I'm trying to write a small Lwt (and batteries) port scanner to better
understand Lwt however I'm getting a strange exception whenever I try to scan
too many ports at a time with scan_ports_range. I'm suspecting my mechanism
for keeping a maximum number of connections open is not working...
Exception: Unix.Unix_error (Batteries.Unix.EMFILE, "socket","").
Fatal error: exception Sys_error("/home/(censored)/.opam/4.00.1/lib/utop: Too many open files")
(Which also crashes utop btw)
Code is below. To trigger the error evaluate:
scan_ports_range ~host:"127.0.0.1" (1000,2000)
Any critique/suggestions for my lwt style is also welcome since I've
only started learning it.
open Lwt
let addr_parts addr =
let (host, port) = String.split addr ":" in (host, int_of_string port)
let addr ~host ~port =
lwt entry = Lwt_unix.gethostbyname host in
if Array.length entry.Unix.h_addr_list = 0 then begin
failwith (Printf.sprintf "no address found for host %S\n" host)
end;
return (Unix.ADDR_INET (entry.Unix.h_addr_list.(0), port))
let test_connection ?(timeout=1.0) addr =
let fd = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
let connect_close =
(Lwt_unix.connect fd addr) >>= (fun () -> Lwt_unix.close fd) in
try_lwt
(pick [connect_close ; Lwt_unix.timeout timeout])
>>= (fun () -> return true)
with _ -> return false
let scan_ports ~host ~ports =
ports |> Lwt_list.map_p (fun port ->
lwt adr = addr ~host ~port in
test_connection adr >>= (fun res -> return (res,port)) )
>>= (fun l -> return ( l |> List.filter_map ( function
| false, _ -> None | true, port -> Some(port) ) ) )
let scan_ports_range ?(max_open=20) ~host (a, b) =
let rec loop acc enum =
match Enum.peek enum with
| None -> acc |> List.concat |> List.rev |> return
| Some _ ->
let ports = enum |> Enum.take max_open |> List.of_enum in
let open_ports = scan_ports ~host ~ports in
open_ports >>= (fun l -> loop (l::acc) enum )
in loop [] (a--b)
As a wild guess, I think you need to force the closing of the socket in case of timeout, so the cullprint might be:
pick [connect_close ; Lwt_unix.timeout timeout]
Here is the corrected code according to Thomas.
let test_connection ?(timeout=1.0) addr =
let fd = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
let connect_close =
(Lwt_unix.connect fd addr) >>= (fun () -> Lwt_unix.close fd) in
try_lwt
(pick [connect_close ; Lwt_unix.timeout timeout])
>>= (fun () -> return true)
with _ -> (Lwt_unix.close fd) >>= (fun () -> return false)