Incomplete list_keys support

examples/Makefile

@@ -4,7 +4,7 @@ CAMLP4=
 OCAMLC_OPTS=-package riakc
 OCAMLOPT_OPTS=$(OCAMLC_OPTS)
 
-cources=ping.ml client_id.ml server_info.ml list_buckets.ml
+cources=ping.ml client_id.ml server_info.ml list_buckets.ml list_keys.ml
 
 sources=$(cources)
 
@@ -22,7 +22,7 @@ all: native byte
 
 native-code: native
 
-native: ping.native client_id.native server_info.native list_buckets.native
+native: ping.native client_id.native server_info.native list_buckets.native list_keys.native
 
 ping.native: ping.cmx
 
@@ -32,9 +32,11 @@ server_info.native: server_info.cmx
 
 list_buckets.native: list_buckets.cmx
 
+list_keys.native: list_keys.cmx
+
 byte-code: byte
 
-byte: ping.byte client_id.byte server_info.byte list_buckets.byte
+byte: ping.byte client_id.byte server_info.byte list_buckets.byte list_keys.byte
 
 ping.byte: ping.cmo
 
@@ -44,6 +46,8 @@ server_info.byte: server_info.cmo
 
 list_buckets.byte: list_buckets.cmo
 
+list_keys.byte: list_keys.cmo
+
 test:
 
 clean:

examples/list_keys.ml

@@ -0,0 +1,33 @@
+open Core.Std
+open Async.Std
+
+let option_to_string = function
+  | Some v -> v
+  | None   -> "<none>"
+
+let ping () =
+  let open Deferred.Result.Monad_infix in
+  let host = Sys.argv.(1) in
+  let port = Int.of_string Sys.argv.(2) in
+  let b    = Sys.argv.(3) in
+  Riakc.Conn.connect host port >>= fun c ->
+  Riakc.Conn.list_keys c b     >>= fun keys ->
+  Riakc.Conn.close c           >>= fun () ->
+  return (Ok keys)
+
+let perform_ping () =
+  ping () >>| function
+    | Ok keys -> begin
+      List.iter
+	~f:(printf "%s\n")
+	keys;
+      shutdown 0
+    end
+    | Error _ -> begin
+      printf "Failed\n";
+      shutdown 1
+    end
+
+let () =
+  ignore (perform_ping ());
+  never_returns (Scheduler.go ())

lib/riakc/conn.ml

@@ -58,7 +58,8 @@ let read_payload r preamble =
 let do_request t f =
   let open Deferred.Result.Monad_infix in
   let preamble = String.create 4 in
-  Writer.write t.w (f ());
+  Deferred.return (f ())    >>= fun request ->
+  Writer.write t.w request;
   read_str t.r 0 preamble   >>= fun _ ->
   read_payload t.r preamble >>= fun payload ->
   Deferred.return (Response.of_string payload)
@@ -113,6 +114,15 @@ let list_buckets t =
     | Error err ->
       Error err
 
+let list_keys t bucket =
+  do_request t (Request.list_keys bucket) >>| function
+    | Ok (Response.Keys (keys, _)) ->
+      Ok keys
+    | Ok _ ->
+      Error `Wrong_type
+    | Error err ->
+      Error err
+
 let get t ?(opts = []) ~b ~k =
   failwith "nyi"
 

lib/riakc/conn.mli

@@ -43,6 +43,7 @@ val server_info :
   ((string option * string option), [> error | Response.error ]) Deferred.Result.t
 
 val list_buckets : t -> (string list, [> error | Response.error ]) Deferred.Result.t
+val list_keys    : t -> string -> (string list, [> error | Response.error ]) Deferred.Result.t
 
 val get :
   t ->

lib/riakc/pb_response.ml

@@ -14,3 +14,12 @@ let server_info =
 
 let list_buckets =
   P.bytes_rep 1 >>= P.return
+
+let list_keys =
+  P.bytes_rep 1 >>= fun keys ->
+  P.bool_opt  2 >>= function
+    | Some true ->
+      P.return (keys, true)
+    | _ ->
+      P.return (keys, false)
+

lib/riakc/pb_response.mli

@@ -1,3 +1,4 @@
 val client_id    : string Protobuf.Parser.t
 val server_info  : (string option * string option) Protobuf.Parser.t
 val list_buckets : string list Protobuf.Parser.t
+val list_keys    : (string list * bool) Protobuf.Parser.t

lib/riakc/request.ml

@@ -1,13 +1,32 @@
 open Core.Std
 
+module B = Protobuf.Builder
+
+let wrap_request mc s =
+  (* Add 1 for the mc *)
+  let l = String.length s + 1 in
+  let preamble_mc = String.create 5 in
+  preamble_mc.[0] <- Char.of_int_exn ((l lsr 24) land 0xff);
+  preamble_mc.[1] <- Char.of_int_exn ((l lsr 16) land 0xff);
+  preamble_mc.[2] <- Char.of_int_exn ((l lsr 8) land 0xff);
+  preamble_mc.[3] <- Char.of_int_exn (l land 0xff);
+  preamble_mc.[4] <- mc;
+  preamble_mc ^ s
+
 let ping () =
-  "\x00\x00\x00\x01\x01"
+  Ok (wrap_request '\x01' "")
 
 let client_id () =
-  "\x00\x00\x00\x01\x03"
+  Ok (wrap_request '\x03' "")
 
 let server_info () =
-  "\x00\x00\x00\x01\x07"
+  Ok (wrap_request '\x07' "")
 
 let list_buckets () =
-  "\x00\x00\x00\x01\x0F"
+  Ok (wrap_request '\x0F' "")
+
+let list_keys bucket () =
+  let open Result.Monad_infix in
+  let b = B.create () in
+  B.bytes b 1 bucket >>= fun () ->
+  Ok (wrap_request '\x11' (B.to_string b))

lib/riakc/request.mli

@@ -1,6 +1,7 @@
 open Core.Std
 
-val ping         : unit -> string
-val client_id    : unit -> string
-val server_info  : unit -> string
-val list_buckets : unit -> string
+val ping         : unit -> (string, [> Protobuf.Builder.error ]) Result.t
+val client_id    : unit -> (string, [> Protobuf.Builder.error ]) Result.t
+val server_info  : unit -> (string, [> Protobuf.Builder.error ]) Result.t
+val list_buckets : unit -> (string, [> Protobuf.Builder.error ]) Result.t
+val list_keys    : string -> unit -> (string, [> Protobuf.Builder.error ]) Result.t

lib/riakc/response.ml

@@ -11,6 +11,7 @@ type t =
   | Client_id of string
   | Server_info of (string option * string option)
   | Buckets of string list
+  | Keys of (string list * bool)
 
 type error = [ `Bad_payload | `Incomplete_payload | P.error ]
 
@@ -45,13 +46,19 @@ let parse_list_buckets payload =
   run payload Pb_response.list_buckets >>= fun buckets ->
   Ok (Buckets buckets)
 
+let parse_list_keys payload =
+  let open Result.Monad_infix in
+  run payload Pb_response.list_keys >>= fun (keys, d) ->
+  Ok (Keys (keys, d))
+
 let message_code =
   Int.Map.of_alist_exn
-    [ ( 0, parse_error)
-    ; ( 2, parse_ping)
-    ; ( 4, parse_client_id)
-    ; ( 8, parse_server_info)
-    ; (16, parse_list_buckets)
+    [ (0x00, parse_error)
+    ; (0x02, parse_ping)
+    ; (0x04, parse_client_id)
+    ; (0x08, parse_server_info)
+    ; (0x10, parse_list_buckets)
+    ; (0x12, parse_list_keys)
     ]
 
 let find_mc mc =

lib/riakc/response.mli

@@ -5,6 +5,7 @@ type t =
   | Client_id of string
   | Server_info of (string option * string option)
   | Buckets of string list
+  | Keys of (string list * bool)
 
 type error = [ `Bad_payload | `Incomplete_payload | Protobuf.Parser.error ]