diff --git a/.gitignore b/.gitignore index 5a906b72..14d9afab 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,4 @@ *.exe /result* /socket/redis.sock +_opam diff --git a/src/client.ml b/src/client.ml index 20c66b1a..e2b1fdcb 100644 --- a/src/client.ml +++ b/src/client.ml @@ -1118,27 +1118,33 @@ module MakeClient(Mode: Mode) = struct let command = "MSETNX" :: (interleave items) in send_request connection command >>= return_bool - let set connection ?ex:(ex=0) ?px:(px=0) ?nx:(nx=false) ?xx:(xx=false) key value = + let set connection ?ex:(ex=0) ?px:(px=0) ?nx:(nx=false) ?xx:(xx=false) ?keepttl:(keepttl=false) key value = match (nx, xx) with | (true, true) -> IO.fail (Invalid_argument "SET command can contain only one of NX or XX options.") | _ -> - let ex = match ex with - | 0 -> [] - | _ -> ["EX"; string_of_int ex] in - let px = match px with - | 0 -> [] - | _ -> ["PX"; string_of_int px] in - let nx = match nx with - | false -> [] - | true -> ["NX"] in - let xx = match xx with - | false -> [] - | true -> ["XX"] in - let base_command = [ "SET"; key; value; ] in - let args = List.concat [ex; px; nx; xx] in - let command = List.concat [base_command; args] in - send_request connection command >>= return_ok_or_nil + if keepttl && (ex > 0 || px > 0) then + IO.fail (Invalid_argument "SET command cannot combine KEEPTTL with EX or PX options.") + else + let ex = match ex with + | 0 -> [] + | _ -> ["EX"; string_of_int ex] in + let px = match px with + | 0 -> [] + | _ -> ["PX"; string_of_int px] in + let nx = match nx with + | false -> [] + | true -> ["NX"] in + let xx = match xx with + | false -> [] + | true -> ["XX"] in + let keepttl = match keepttl with + | false -> [] + | true -> ["KEEPTTL"] in + let base_command = [ "SET"; key; value; ] in + let args = List.concat [ex; px; nx; xx; keepttl] in + let command = List.concat [base_command; args] in + send_request connection command >>= return_ok_or_nil let setex connection key seconds value = let seconds = string_of_int seconds in @@ -2012,27 +2018,33 @@ module MakeClient(Mode: Mode) = struct | _ -> assert false ) responses - let set ?ex:(ex=0) ?px:(px=0) ?nx:(nx=false) ?xx:(xx=false) key value = + let set ?ex:(ex=0) ?px:(px=0) ?nx:(nx=false) ?xx:(xx=false) ?keepttl:(keepttl=false) key value = match (nx, xx) with | (true, true) -> raise (Invalid_argument "SET command can contain only one of NX or XX options.") | _ -> - let ex = match ex with - | 0 -> [] - | _ -> ["EX"; string_of_int ex] in - let px = match px with - | 0 -> [] - | _ -> ["PX"; string_of_int px] in - let nx = match nx with - | false -> [] - | true -> ["NX"] in - let xx = match xx with - | false -> [] - | true -> ["XX"] in - let base_command = [ "SET"; key; value; ] in - let args = List.concat [ex; px; nx; xx] in - let command = List.concat [base_command; args] in - command + if keepttl && (ex > 0 || px > 0) then + raise (Invalid_argument "SET command cannot combine KEEPTTL with EX or PX options.") + else + let ex = match ex with + | 0 -> [] + | _ -> ["EX"; string_of_int ex] in + let px = match px with + | 0 -> [] + | _ -> ["PX"; string_of_int px] in + let nx = match nx with + | false -> [] + | true -> ["NX"] in + let xx = match xx with + | false -> [] + | true -> ["XX"] in + let keepttl = match keepttl with + | false -> [] + | true -> ["KEEPTTL"] in + let base_command = [ "SET"; key; value; ] in + let args = List.concat [ex; px; nx; xx; keepttl] in + let command = List.concat [base_command; args] in + command let del keys = "DEL" :: keys diff --git a/src/s.ml b/src/s.ml index d78c94bc..1a18001e 100644 --- a/src/s.ml +++ b/src/s.ml @@ -317,10 +317,11 @@ module type Client = sig (** Sets the given keys to their respective values. MSETNX will not perform any operation at all even if just a single key already exists. *) val msetnx : connection -> (string * string) list -> bool IO.t - (** Set key to hold the string value. *) + (** Set key to hold the string value. + @param keepttl retain the existing TTL on the key (since Redis 6.0). *) val set : connection -> - ?ex:int -> ?px:int -> ?nx:bool -> ?xx:bool -> + ?ex:int -> ?px:int -> ?nx:bool -> ?xx:bool -> ?keepttl:bool -> string -> string -> bool IO.t (** Set key to hold the string value and set key to timeout after a given number of seconds. *) @@ -803,7 +804,7 @@ module type Client = sig val empty : command - val set : ?ex:int -> ?px:int -> ?nx:bool -> ?xx:bool -> string -> string -> command + val set : ?ex:int -> ?px:int -> ?nx:bool -> ?xx:bool -> ?keepttl:bool -> string -> string -> command (** Delete a key; returns the number of keys removed. *) val del : string list -> command diff --git a/test/test.ml b/test/test.ml index 659d4a0b..3bb8e08b 100644 --- a/test/test.ml +++ b/test/test.ml @@ -143,7 +143,9 @@ end = struct Client.set conn ~ex:20 key value >>= io_assert "Can set ex key which is already set" ((=) true) >>= fun () -> Client.set conn ~px:200 key value >>= - io_assert "Can set ex key which is already set" ((=) true) >>= fun () -> + io_assert "Can set px key which is already set" ((=) true) >>= fun () -> + Client.set conn ~keepttl:true key value >>= + io_assert "Can set key with keepttl" ((=) true) >>= fun () -> Client.get conn key >>= io_assert "Key and value mismatch" ((=) (Some value)) >>= fun () -> Client.getset conn key value >>= @@ -254,7 +256,15 @@ end = struct Client.persist conn key >>= io_assert "Can't remove existing timeout on key" ((=) true) >>= fun () -> Client.ttl conn key >>= - io_assert "Can't check expiration timeout for key" ((=) None) + io_assert "Can't check expiration timeout for key" ((=) None) >>= fun () -> + (* Set key with a 100s TTL, then overwrite with keepttl and verify TTL is retained *) + Client.set conn ~ex:100 key value >>= + io_assert "Can set key with ex" ((=) true) >>= fun () -> + Client.set conn ~keepttl:true key value >>= + io_assert "Can set key with keepttl" ((=) true) >>= fun () -> + Client.ttl conn key >>= + io_assert "TTL should be retained after set with keepttl" + (function None -> false | Some x -> x > 0 && x <= 100) let test_case_expireat conn = let key = redis_string_bucket () in