diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/dune | 4 | ||||
| -rw-r--r-- | lib/relation.ml | 19 | ||||
| -rw-r--r-- | lib/server.ml | 14 |
3 files changed, 22 insertions, 15 deletions
@@ -1,7 +1,7 @@ (library (name relational_engine) - (libraries ctypes ctypes-foreign data-encoding lwt lwt.unix lwt-exit) - (preprocess (pps ppx_deriving.show ppx_sexp_conv)) + (libraries ctypes ctypes-foreign data-encoding lwt lwt.unix lwt-exit ppx_protocol_conv_xml_light) + (preprocess (pps ppx_deriving.show ppx_sexp_conv ppx_protocol_conv)) ;; (c_library_flags -lssl -lcrypto -L %{env:LIBRESSL_LIB_PATH=}) ;; (foreign_stubs ;; (language cxx) diff --git a/lib/relation.ml b/lib/relation.ml index 1854875..5a896d4 100644 --- a/lib/relation.ml +++ b/lib/relation.ml @@ -1,14 +1,16 @@ -open Sexplib0 -open Sexplib0.Sexp_conv + module Protocol = struct - type tuple = string list [@@deriving sexp] + open Protocol_conv_xml + open Sexplib0.Sexp_conv + type tuple = + string list [@@deriving sexp, protocol ~driver:(module Xml_light)] type relation = { attribute_name: string; attribute_type: string; tuples: tuple } - [@@deriving sexp] - type t = relation list [@@deriving sexp] + [@@deriving sexp, protocol ~driver:(module Xml_light)] + type t = relation list [@@deriving sexp, protocol ~driver:(module Xml_light)] end let write_and_retrieve() = @@ -40,6 +42,9 @@ let write_and_retrieve() = let+ (_, Command.Read last_name) = Command.commit_and_perform (List.tl stream) locations command_read2 in (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string first_name); *) (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string last_name); *) - Ok (Sexp.to_string (Protocol.sexp_of_t [{attribute_name = "user/first-name"; attribute_type = "string"; tuples = List.map Bytes.to_string first_name}; - {attribute_name = "user/last-name"; attribute_type = "string"; tuples = List.map Bytes.to_string last_name}])) + let relation_result: Protocol.relation list = + [{attribute_name = "user/first-name"; attribute_type = "string"; tuples = List.map Bytes.to_string first_name}; + {attribute_name = "user/last-name"; attribute_type = "string"; tuples = List.map Bytes.to_string last_name}] in + Ok (Xml.to_string (Protocol.to_xml_light relation_result)) + (* (Sexp.to_string (Protocol.sexp_of_t )) *) [@@warning "-8"] (* Suppress pattern match incomplete warnings *) diff --git a/lib/server.ml b/lib/server.ml index 6544f81..22bee73 100644 --- a/lib/server.ml +++ b/lib/server.ml @@ -17,16 +17,18 @@ let client_read sock maxlen = let rec _read sock acc = Lwt_unix.read sock str 0 maxlen >>= fun recvlen -> Lwt_io.write_line Lwt_io.stdout (Printf.sprintf "[LOG] Received %d bytes from client" recvlen) - >>= fun () -> if recvlen <= maxlen - then Lwt.return (acc ^ (Bytes.to_string (Bytes.sub str 0 recvlen))) - else _read sock (acc ^ (Bytes.to_string (Bytes.sub str 0 recvlen))) - in _read sock "" + >>= fun () -> let acc = (acc ^ (Bytes.to_string (Bytes.sub str 0 recvlen))) in + if recvlen <= maxlen + then Lwt.return acc + else _read sock acc in + _read sock String.empty + >>= fun _ -> match Relation.write_and_retrieve() with | Ok results -> return results | Error err -> return err let rec socket_read sock = + (* (Int32.of_int (String.length results))) *) Lwt_unix.accept sock >>= fun (client, _) -> client_read client 512 - >>= fun results -> Lwt_io.write_line Lwt_io.stdout results - >>= fun () -> return results + (* >>= fun results -> Lwt_unix.send client (Data_encoding.Binary.to_bytes_exn Data_encoding.Encoding.int32 5l) 0 1 [] *) >>= fun results -> Lwt_unix.send client (Bytes.of_string results) 0 (String.length results) [] >>= fun _ -> Lwt_unix.wait_write client >>= fun () -> Lwt_unix.close client |