Add Uuidm.v7_[non_]monotonic_gen (#14).

B0.ml

@@ -4,6 +4,7 @@ open B0_kit.V000
 
 let b0_std = B0_ocaml.libname "b0.std"
 let cmdliner = B0_ocaml.libname "cmdliner"
+let unix = B0_ocaml.libname "unix"
 let uuidm = B0_ocaml.libname "uuidm"
 
 (* Libraries *)
@@ -14,7 +15,8 @@ let uuidm_lib = B0_ocaml.lib uuidm ~srcs:[`Dir ~/"src"]
 
 let test ?(requires = []) = B0_ocaml.test ~requires:(uuidm :: requires)
 let perf = test ~/"test/perf.ml" ~run:false ~doc:"Test Uuidm performance"
-let examples = test ~/"test/examples.ml" ~run:false ~doc:"Sample code"
+let examples =
+  test ~/"test/examples.ml" ~run:false ~requires:[unix] ~doc:"Sample code"
 let test_uuidm =
   test ~/"test/test_uuidm.ml" ~requires:[b0_std] ~doc:"Test Uuidm"
 

CHANGES.md

@@ -2,6 +2,7 @@
 - Add `Uuidm.{v7,v7_ns}` to create time and random based V7 UUIDs. 
   Thanks to Robin Newton for the patch (#14) and Christian Linding
   and Pau Ruiz Safont for the help.
+- Add `Uuidm.v7_[non_]monotonic_gen` V7 UUID generators.
 - Add `Uuidm.v8` to create V8 custom UUIDs.
 - Add `Uuidm.max` the RFC 9569 Max UUID.
 - Add `Uuidm.{variant,version,time_ms}` UUID property accessors.

doc/index.mld

@@ -13,17 +13,19 @@ See the {{!quick}quick start}.
 
 {1:quick Quick start}
 
-{2:random Random V4 UUIDs}
+{2:random_based Random V4 UUIDs}
 
 The following [uuid] function can be used in your program to generate
-V4 random UUIDs. Read the {{!Uuidm.gen}warnings} about generators though.
+V4 random UUIDs.
 
 {[
 let uuid = Uuidm.v4_gen (Random.State.make_self_init ())
 let () = print_endline (Uuidm.to_string (uuid ()))
 let () = print_endline (Uuidm.to_string (uuid ()))
 ]}
 
+Make sure to read the {{!Uuidm.gen}warnings} about random generators.
+
 {2:name_based Name based V5 UUIDs}
 
 Name based V5 UUIDs can be used to generate [urn:uuid] URIs for atom
@@ -65,3 +67,36 @@ This assumes that
    to render them to RFC 3339 with a fixed time zone. Alternatively
    you can directly use the decimal representation of the timestamp
    as the data to hash.}}
+
+{2:time_based Monotonic time based V7 UUIDs}
+
+In order to generate monotonic time based V7 UUIDs we need to:
+
+{ul
+{- Provide a millisecond precision monotonic POSIX clock. {!Unix.gettimeofday}
+   can provide one but if your monotonicity requirements are paramount,
+   remember that it can go back in time.}
+{- Do something if the clock doesn't move between two UUID
+   generations. The {!Uuidm.v7_monotonic_gen} uses a counter which allows
+   to generate up to 4096 UUID per millisecond and returns [None] in case
+   of rollover during the millisecond. In the code below we {!Unix.sleepf}
+   for a millisecond if we reach the limit.}}
+
+{[
+let uuid_monotonic =
+  let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in
+  Uuidm.v7_monotonic_gen ~now_ms (Random.State.make_self_init ())
+
+let rec uuid () = match uuid_monotonic () with
+| None -> (* Too many UUIDs generated in a ms *) Unix.sleepf 1e-3; uuid ()
+| Some uuid -> uuid
+
+let () = print_endline (Uuidm.to_string (uuid ()))
+let () = print_endline (Uuidm.to_string (uuid ()))
+]}
+
+Depending on your application {!Uuidm.v7_monotonic_gen} may be a bit
+too simplistic, you can easily implement all sorts of other
+{{:https://www.rfc-editor.org/rfc/rfc9562#name-monotonicity-and-counters}
+generation schemes} using {!Uuidm.v7} or {!Uuidm.v7_ns}. Also, make
+sure to read the {{!Uuidm.gen}warnings} about generators. .

src/uuidm.ml

@@ -151,6 +151,8 @@ let v8 s = make (Bytes.of_string s) ~version:8
 
 (* Generators *)
 
+type posix_ms_clock = unit -> int64
+
 let v4_random rstate =
   let r0 = Random.State.bits64 rstate in
   let r1 = Random.State.bits64 rstate in
@@ -161,6 +163,24 @@ let v4_random rstate =
 
 let v4_gen rstate = function () -> v4_random rstate
 
+let v7_non_monotonic_gen ~now_ms rstate =
+  fun () ->
+  let t_ms = now_ms () in
+  let rand_a = Random.State.bits (* 30 bits *) rstate  in
+  let rand_b = Random.State.bits64 rstate in
+  v7 ~t_ms ~rand_a ~rand_b
+
+let v7_monotonic_gen ~now_ms rstate =
+  let last_ms = ref 0L in
+  let count = ref 0 in
+  fun () ->
+    let t_ms = now_ms () in
+    let rand_b = Random.State.bits64 rstate in
+    if not (Int64.equal t_ms !last_ms)
+    then (count := 0; last_ms := t_ms; Some (v7 ~t_ms ~rand_a:0 ~rand_b)) else
+    let rand_a = incr count; !count in
+    if rand_a >= 4096 then None else Some (v7 ~t_ms ~rand_a ~rand_b)
+
 (* Constants *)
 
 let nil = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"

src/uuidm.mli

@@ -47,13 +47,14 @@ val v5 : t -> string -> t
 (** [v5 ns n] is a
     {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-5}V5 UUID}
     (name based with SHA-1 hashing) named by [n] and
-    namespaced by [ns]. *)
+    namespaced by [ns]. See {{!page-index.name_based}this example}. *)
 
 val v7 : t_ms:int64 -> rand_a:bits12 -> rand_b:bits62 -> t
-(** [v7 t_ms ~rand_a ~rand_b] is a
+(** [v7 ~t_ms ~rand_a ~rand_b] is a
     {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-7}V7 UUID}
     (time and random based) using the 64-bit millisecond POSIX timestamp
-    [t_ms] and random bits [rand_a] and [rand_b].
+    [t_ms] and random bits [rand_a] and [rand_b]. See also
+    {!v7_non_monotonic_gen} and {!v7_monotonic_gen}.
 
     {b Warning.} The timestamp and the randomness are seen literally
     in the result. *)
@@ -63,8 +64,8 @@ val v7_ns : t_ns:int64 -> rand_b:bits62 -> t
     {{:https://www.rfc-editor.org/rfc/rfc9562#name-uuid-version-7}V7
     UUID} (time and random based) using the {e unsigned} 64-bit
     nanosecond POSIX timestamp [t_ns] and random bits [rand_b]. The
-    [rand_a] field is used with the timestamp's submilisecond (about
-    244 nanoseconds resolution).
+    [rand_a] field is used with the timestamp's submillisecond precision
+    with about 244 nanoseconds resolution.
 
     {b Warning.} The timestamp and the randomness are seen literally in
     the result. *)
@@ -84,16 +85,41 @@ val v8 : string -> t
     {- Sequences of UUIDs are generated with {!Random}. This is
        suitably random but {e predictable} by an observer. Use the
        base constuctors with random bytes generated by a
-       cryptographically secure pseudo-random number generator if that
+       cryptographically secure pseudorandom number generator (CSPRNG) if that
        is an issue.}
     {- Sequences of UUIDs generated from a given {!Random.State.t}
        value are not guaranteed to be stable across OCaml or Uuidm versions.
        Use the base constructors with your own
-       pseudo-random number generator if that is an issue.}} *)
+       pseudorandom number generator if that is an issue.}
+    {- Sequences of UUIDs generated using a {!posix_clock_ms} assume
+       the clock is monotonic in order to generate monotonic UUIDs.
+       If you derive them from {!Unix.gettimeofday} this may not be the case.}}
+*)
+
+type posix_ms_clock = unit -> int64
+(** The type for millisecond precision POSIX time clocks.  *)
 
 val v4_gen : Random.State.t -> (unit -> t)
-(** [v4_gen state] is a function that generates random V4 UUIDs (random
-    based) using [state]. See also {!v4}. *)
+(** [v4_gen state] is a function generating {!v4} UUIDs using
+    random [state]. See {{!page-index.random_based}this example}. *)
+
+val v7_non_monotonic_gen :
+  now_ms:posix_ms_clock -> Random.State.t -> (unit -> t)
+(** [v7_non_monotonic_gen ~now_ms state] is a function generating
+    {!v7} UUIDs using [now_ms] for the timestamp [t_ms] and random [state]
+    for [rand_a] and [rand_b]. UUIDs generated in the same millisecond
+    may not be be monotonic. Use {!v7_monotonic_gen} for that. *)
+
+val v7_monotonic_gen :
+  now_ms:posix_ms_clock -> Random.State.t -> (unit -> t option)
+(** [v7_monotonic_gen ~posix_now_ms state] is a function that
+    generates monotonic random {!v7} UUIDs using [now_ms] for the
+    timestamp [t_ms], [rand_a] as a counter if the clock did not move
+    between two UUID generations and [random] state for [rand_b]. This
+    allows to generate up to 4096 monotonic UUIDs per
+    millisecond. [None] is returned if the counter rolls-over until
+    the millisecond increments. See {{!page-index.time_based}this
+    example}.*)
 
 (** {1:constants Constants} *)
 

test/examples.ml

@@ -3,10 +3,23 @@
    SPDX-License-Identifier: CC0-1.0
   ---------------------------------------------------------------------------*)
 
+(* Code from the quick start *)
+
 let uuid = Uuidm.v4_gen (Random.State.make_self_init ())
 let () = print_endline (Uuidm.to_string (uuid ()))
 let () = print_endline (Uuidm.to_string (uuid ()))
 
 let feed_id ~feed_id = "urn:uuid:" ^ (Uuidm.to_string feed_id)
 let entry_id ~feed_id ~rfc3339_stamp =
   "urn:uuid:" ^ (Uuidm.to_string @@ Uuidm.v5 feed_id rfc3339_stamp)
+
+let uuid_monotonic =
+  let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in
+  Uuidm.v7_monotonic_gen ~now_ms (Random.State.make_self_init ())
+
+let rec uuid () = match uuid_monotonic () with
+| None -> (* Too many UUIDs generated in a ms *) Unix.sleepf 1e-3; uuid ()
+| Some uuid -> uuid
+
+let () = print_endline (Uuidm.to_string (uuid ()))
+let () = print_endline (Uuidm.to_string (uuid ()))