Implement UUID version 7

src/uuidm.ml

@@ -163,6 +163,28 @@ let v4_gen seed =
   let rand = rand seed in
   function () -> v4_ocaml_random_uuid rand
 
+let v7 =
+  let open Int64 in
+  let ns_in_ms = 1_000_000L in
+  let sub_ms_frac_multiplier = unsigned_div minus_one ns_in_ms in
+  fun ts b ->
+    let u = Bytes.create 16 in
+    Bytes.blit b 0 u 8 8;
+    (* RFC9562 requires we use 48 bits for a timestamp in milliseconds, and
+       allows for 12 bits to store a sub-millisecond fraction. We get the
+       latter by multiplying to put the fraction in a 64-bit range, then
+       shifting into 12 bits. *)
+    let ms = unsigned_div ts ns_in_ms in
+    let ns = unsigned_rem ts ns_in_ms in
+    let sub_ms_frac = shift_right_logical (mul ns sub_ms_frac_multiplier) 52 in
+    Bytes.set_int64_be u 0 (shift_left ms 16);
+    Bytes.set_int16_be u 6 (to_int sub_ms_frac);
+    let b6 = 0b0111_0000 lor (Char.code (Bytes.get u 6) land 0b0000_1111) in
+    let b8 = 0b1000_0000 lor (Char.code (Bytes.get u 8) land 0b0011_1111) in
+    Bytes.set u 6 (Char.unsafe_chr b6);
+    Bytes.set u 8 (Char.unsafe_chr b8);
+    Bytes.unsafe_to_string u
+
 type version = [ `V3 of t * string | `V4 | `V5 of t * string ]
 let v = function
 | `V4 -> v4_ocaml_random_uuid default_rand

src/uuidm.mli

@@ -6,14 +6,18 @@
 (** Universally unique identifiers (UUIDs).
 
     [Uuidm] implements 128 bits universally unique identifiers version
-    3, 5 (name based with MD5, SHA-1 hashing) and 4 (random based)
-    according to {{:http://tools.ietf.org/html/rfc4122}RFC 4122}.
+    3, 5 (name based with MD5, SHA-1 hashing) 4, (random based) and 7 (random
+    and timestamp based) according to {{:http://tools.ietf.org/html/rfc9562}RFC 9562}
 
     {b References}
     {ul
     {- P. Leach et al.
     {e {{:http://tools.ietf.org/html/rfc4122}A universally unique identifier
-     (UUID) URN Namespace}}, 2005.}} *)
+     (UUID) URN Namespace}}, 2005.}}
+    {- K. Davis et al.
+    {e {{:http://tools.ietf.org/html/rfc9562}Universally unique identifiers
+     (UUIDs)}}, 2024.}}
+*)
 
 (** {1:uuids UUIDs} *)
 
@@ -41,6 +45,15 @@ val v4_gen : Random.State.t -> (unit -> t)
     suitably random but {e predictable} by an observer. If that is an
     issue for you, use {!v4} with random bytes generated by a CSPRNG. *)
 
+val v7 : int64 -> bytes -> t
+(** [v7 ts b] is a V7 UUID (random and timestamp based) that uses the first 8
+    bytes of [b] for randomness and takes [ts] to be the number of nanoseconds
+    since midnight 1 Jan 1970 UTC, leap seconds excluded. The timestamp will
+    be represented in the UUID - with a resolution of about 244 nanoseconds -
+    such that the ordering of UUIDs will match the ordering of timestamps.
+    Be aware that [ts] is interpreted as unsigned, and that most of the 64
+    bits taken from [b] are seen literally in the result. *)
+
 (** {2:informally_deprecated Informally deprecated}
 
     This interface is informally deprecated: it seems many people are

test/test.ml

@@ -36,6 +36,10 @@ let main () =
 	    "0012416f-9eec-3ed4-a8b0-3bceecde1cd9");
   assert (id_eq (Uuidm.v (`V5 (Uuidm.ns_dns, "www.example.org")))
 	    "74738ff5-5367-5958-9aee-98fffdcd1876");
+  assert (id_eq (Uuidm.v7 Int64.(add (mul 1_000_000L 0x1020_3040_5060L) 213135L)
+                          (Bytes.of_string "\x12\x34\x56\x78\
+                                            \x9a\xbc\xde\xf0"))
+                "10203040-5060-7369-9234-56789abcdef0");
   print_endline "Tests succeeded."
 
 let () = main ()