Browse files

Add DELETE support

  • Loading branch information...
1 parent 7c7cd01 commit e1251fb0572fb50ca9e0a6ce7c7ab38445b938ef orbitz committed Mar 17, 2013
View
6 examples/Makefile
@@ -6,7 +6,7 @@ OCAMLOPT_OPTS=$(OCAMLC_OPTS)
cources=ping.ml client_id.ml server_info.ml \
list_buckets.ml list_keys.ml bucket_props.ml \
- get.ml put.ml
+ get.ml put.ml delete.ml
sources=$(cources)
@@ -46,6 +46,8 @@ get.native: get.cmx
put.native: put.cmx
+delete.native: delete.cmx
+
byte-code: byte
byte: $(byte_bin)
@@ -66,6 +68,8 @@ get.byte: get.cmo
put.byte: put.cmo
+delete.byte: delete.cmo
+
test:
clean:
View
35 examples/delete.ml
@@ -0,0 +1,35 @@
+open Core.Std
+open Async.Std
+
+let fail s =
+ printf "%s\n" s;
+ shutdown 1
+
+let exec () =
+ let host = Sys.argv.(1) in
+ let port = Int.of_string Sys.argv.(2) in
+ let b = Sys.argv.(3) in
+ let k = Sys.argv.(4) in
+ Riakc.Conn.with_conn
+ ~host
+ ~port
+ (fun c -> Riakc.Conn.delete c ~b k)
+
+let eval () =
+ exec () >>| function
+ | Ok () -> begin
+ printf "Deleted\n";
+ shutdown 0
+ end
+ | Error `Bad_conn -> fail "Bad_conn"
+ | Error `Bad_payload -> fail "Bad_payload"
+ | Error `Incomplete_payload -> fail "Incomplete_payload"
+ | Error `Notfound -> fail "Notfound"
+ | Error `Incomplete -> fail "Incomplete"
+ | Error `Overflow -> fail "Overflow"
+ | Error `Unknown_type -> fail "Unknown_type"
+ | Error `Wrong_type -> fail "Wrong_type"
+
+let () =
+ ignore (eval ());
+ never_returns (Scheduler.go ())
View
2 examples/get.ml
@@ -42,7 +42,7 @@ let exec () =
Riakc.Conn.with_conn
~host
~port
- (fun c -> Riakc.Conn.get c b k)
+ (fun c -> Riakc.Conn.get c ~b k)
let eval () =
exec () >>| function
View
15 lib/riakc/conn.ml
@@ -145,7 +145,7 @@ let bucket_props t bucket =
| Error err ->
Error err
-let get t ?(opts = []) ~b ~k =
+let get t ?(opts = []) ~b k =
do_request
t
(Request.get (Opts.Get.get_of_opts opts ~b ~k))
@@ -174,3 +174,16 @@ let put t ?(opts = []) ~b ?k robj =
Error `Wrong_type
| Error err ->
Error err
+
+let delete t ?(opts = []) ~b k =
+ do_request
+ t
+ (Request.delete (Opts.Delete.delete_of_opts opts ~b ~k))
+ Response.delete
+ >>| function
+ | Ok [()] ->
+ Ok ()
+ | Ok _ ->
+ Error `Wrong_type
+ | Error err ->
+ Error err
View
9 lib/riakc/conn.mli
@@ -28,7 +28,7 @@ val get :
t ->
?opts:Opts.Get.t list ->
b:string ->
- k:string ->
+ string ->
([ `Maybe_siblings ] Robj.t, [> Opts.Get.error ]) Deferred.Result.t
val put :
@@ -38,3 +38,10 @@ val put :
?k:string ->
[ `No_siblings ] Robj.t ->
(([ `Maybe_siblings ] Robj.t * string option), [> Opts.Put.error ]) Deferred.Result.t
+
+val delete :
+ t ->
+ ?opts:Opts.Delete.t list ->
+ b:string ->
+ string ->
+ (unit, [> Opts.Delete.error ]) Deferred.Result.t
View
55 lib/riakc/opts.ml
@@ -167,3 +167,58 @@ module Put = struct
~init:p
opts
end
+
+module Delete = struct
+ type error = [ `Bad_conn | Response.error ]
+
+ type t =
+ | Timeout of int
+ | Rw of Quorum.t
+ | R of Quorum.t
+ | W of Quorum.t
+ | Pr of Quorum.t
+ | Pw of Quorum.t
+ | Dw of Quorum.t
+
+ type delete = { bucket : string
+ ; key : string
+ ; rw : Int32.t option
+ ; vclock : string option
+ ; r : Int32.t option
+ ; w : Int32.t option
+ ; pr : Int32.t option
+ ; pw : Int32.t option
+ ; dw : Int32.t option
+ }
+
+ let delete_of_opts opts ~b ~k =
+ let d = { bucket = b
+ ; key = k
+ ; rw = None
+ ; vclock = None
+ ; r = None
+ ; w = None
+ ; pr = None
+ ; pw = None
+ ; dw = None
+ }
+ in
+ List.fold_left
+ ~f:(fun d -> function
+ | Timeout _ ->
+ d
+ | Rw n ->
+ { d with rw = Some (Quorum.to_int32 n) }
+ | R n ->
+ { d with w = Some (Quorum.to_int32 n) }
+ | W n ->
+ { d with dw = Some (Quorum.to_int32 n) }
+ | Pr n ->
+ { d with pr = Some (Quorum.to_int32 n) }
+ | Pw n ->
+ { d with pw = Some (Quorum.to_int32 n) }
+ | Dw n ->
+ { d with dw = Some (Quorum.to_int32 n) })
+ ~init:d
+ opts
+end
View
26 lib/riakc/opts.mli
@@ -66,3 +66,29 @@ module Put : sig
val put_of_opts : t list -> b:string -> k:string option -> [ `No_siblings ] Robj.t -> put
end
+
+module Delete : sig
+ type error = [ `Bad_conn | Response.error ]
+
+ type t =
+ | Timeout of int
+ | Rw of Quorum.t
+ | R of Quorum.t
+ | W of Quorum.t
+ | Pr of Quorum.t
+ | Pw of Quorum.t
+ | Dw of Quorum.t
+
+ type delete = { bucket : string
+ ; key : string
+ ; rw : Int32.t option
+ ; vclock : string option
+ ; r : Int32.t option
+ ; w : Int32.t option
+ ; pr : Int32.t option
+ ; pw : Int32.t option
+ ; dw : Int32.t option
+ }
+
+ val delete_of_opts : t list -> b:string -> k:string -> delete
+end
View
15 lib/riakc/request.ml
@@ -77,3 +77,18 @@ let put p () =
B.bool_opt b 10 if_none_match >>= fun () ->
B.bool_opt b 11 return_head >>= fun () ->
Ok (wrap_request '\x0B' (B.to_string b))
+
+let delete d () =
+ let open Opts.Delete in
+ let open Result.Monad_infix in
+ let b = B.create () in
+ B.bytes b 1 d.bucket >>= fun () ->
+ B.bytes b 2 d.key >>= fun () ->
+ B.int32_opt b 3 d.rw >>= fun () ->
+ B.bytes_opt b 4 d.vclock >>= fun () ->
+ B.int32_opt b 5 d.r >>= fun () ->
+ B.int32_opt b 6 d.w >>= fun () ->
+ B.int32_opt b 7 d.pr >>= fun () ->
+ B.int32_opt b 8 d.pw >>= fun () ->
+ B.int32_opt b 9 d.dw >>= fun () ->
+ Ok (wrap_request '\x0D' (B.to_string b))
View
1 lib/riakc/request.mli
@@ -8,3 +8,4 @@ val list_keys : string -> unit -> (string, [> Protobuf.Builder.error ]) Resul
val bucket_props : string -> unit -> (string, [> Protobuf.Builder.error ]) Result.t
val get : Opts.Get.get -> unit -> (string, [> Protobuf.Builder.error ]) Result.t
val put : Opts.Put.put -> unit -> (string, [> Protobuf.Builder.error ]) Result.t
+val delete : Opts.Delete.delete -> unit -> (string, [> Protobuf.Builder.error ]) Result.t
View
6 lib/riakc/response.ml
@@ -96,6 +96,12 @@ let put payload =
run '\x0C' payload Pb_response.put >>= fun (c, vclock, key) ->
Ok (Done (Robj.of_pb c vclock None, key))
+let delete = function
+ | "\x0E" ->
+ Ok (Done ())
+ | _ ->
+ Error `Bad_payload
+
let parse_length s =
let bits = Bitstring.bitstring_of_string s in
let to_int = Int32.to_int in
View
1 lib/riakc/response.mli
@@ -17,5 +17,6 @@ val list_keys : string -> (string list t, [> error ]) Result.t
val bucket_props : string -> (props t, [> error ]) Result.t
val get : string -> ([ `Maybe_siblings ] Robj.t t, [> error ]) Result.t
val put : string -> (([ `Maybe_siblings ] Robj.t * string option) t, [> error ]) Result.t
+val delete : string -> (unit t, [> error ]) Result.t
val parse_length : string -> (int, [> error ]) Result.t

0 comments on commit e1251fb

Please sign in to comment.