Merge pull request #149 from mirage/get_into_bytes

Implement get_into_bytes

digestif.opam

@@ -50,6 +50,7 @@ depends: [
   "fpath"           {with-test}
   "rresult"         {with-test}
   "ocamlfind"       {with-test}
+  "crowbar"         {with-test}
 ]
 
 conflicts: [

fuzz/c/dune

@@ -0,0 +1,6 @@
+(executable
+ (name fuzz)
+ (libraries digestif.c crowbar))
+
+(rule
+ (copy# ../fuzz.ml fuzz.ml))

fuzz/dune

@@ -0,0 +1,25 @@
+(rule
+ (copy# fuzz.ml fuzz_c.ml))
+
+(rule
+ (copy# fuzz.ml fuzz_ocaml.ml))
+
+(executable
+ (name fuzz_c)
+ (modules fuzz_c)
+ (libraries digestif.c crowbar))
+
+(executable
+ (name fuzz_ocaml)
+ (modules fuzz_ocaml)
+ (libraries digestif.ocaml crowbar))
+
+(rule
+ (alias runtest)
+ (action
+  (run ./fuzz_ocaml.exe)))
+
+(rule
+ (alias runtest)
+ (action
+  (run ./fuzz_c.exe)))

fuzz/fuzz.ml

@@ -0,0 +1,32 @@
+open Crowbar
+
+type pack = Pack : 'a Digestif.hash -> pack
+
+let hash =
+  choose
+    [
+      const (Pack Digestif.sha1); const (Pack Digestif.sha256);
+      const (Pack Digestif.sha512);
+    ]
+
+let with_get_into_bytes off len (type ctx)
+    (module Hash : Digestif.S with type ctx = ctx) (ctx : ctx) =
+  let buf = Bytes.create len in
+  let () =
+    try Hash.get_into_bytes ctx ~off buf
+    with Invalid_argument e -> (
+      (* Skip if the invalid argument is valid; otherwise fail *)
+      match Bytes.sub buf off Hash.digest_size with
+      | _ -> failf "Hash.get_into_bytes: Invalid_argument %S" e
+      | exception Invalid_argument _ -> bad_test ()) in
+  Bytes.sub_string buf off Hash.digest_size
+
+let () =
+  add_test ~name:"get_into_bytes" [ hash; int8; range 1024; bytes ]
+  @@ fun (Pack hash) off len bytes ->
+  let (module Hash) = Digestif.module_of hash in
+  let ctx = Hash.empty in
+  let ctx = Hash.feed_string ctx bytes in
+  let a = with_get_into_bytes off len (module Hash) ctx in
+  let b = Hash.(to_raw_string (get ctx)) in
+  check_eq ~eq:String.equal a b

fuzz/ocaml/dune

@@ -0,0 +1,6 @@
+(executable
+ (name fuzz)
+ (libraries digestif.ocaml crowbar))
+
+(rule
+ (copy# ../fuzz.ml fuzz.ml))

src-c/digestif.ml

@@ -58,6 +58,7 @@ module type S = sig
   val of_raw_string : string -> t
   val of_raw_string_opt : string -> t option
   val to_raw_string : t -> string
+  val get_into_bytes : ctx -> ?off:int -> bytes -> unit
 end
 
 module type MAC = sig
@@ -142,6 +143,13 @@ module Unsafe (F : Foreign) (D : Desc) = struct
     By.fill res 0 digest_size '\000' ;
     F.Bytes.finalize t res 0 ;
     res
+
+  let get_into_bytes t ?(off = 0) buf =
+    if off < 0 || off >= Bytes.length buf
+    then invalid_arg "offset out of bounds" ;
+    if Bytes.length buf - off < digest_size
+    then invalid_arg "destination too small" ;
+    F.Bytes.finalize (Native.dup t) buf off
 end
 
 module Core (F : Foreign) (D : Desc) = struct

src-ocaml/digestif.ml

@@ -57,6 +57,7 @@ module type S = sig
   val of_raw_string : string -> t
   val of_raw_string_opt : string -> t option
   val to_raw_string : t -> string
+  val get_into_bytes : ctx -> ?off:int -> bytes -> unit
 end
 
 module type MAC = sig
@@ -122,6 +123,14 @@ module Unsafe (Hash : Hash) (D : Desc) = struct
     else unsafe_feed_bigstring ctx buf off len
 
   let unsafe_get = unsafe_get
+
+  let get_into_bytes ctx ?(off = 0) buf =
+    if off < 0 || off >= Bytes.length buf
+    then invalid_arg "offset out of bounds" ;
+    if Bytes.length buf - off < digest_size
+    then invalid_arg "destination too small" ;
+    let raw = unsafe_get (Hash.dup ctx) in
+    Bytes.blit raw 0 buf off digest_size
 end
 
 module Core (Hash : Hash) (D : Desc) = struct

src/digestif.mli

@@ -161,6 +161,21 @@ module type S = sig
 
   val to_raw_string : t -> string
   (** [to_raw_string s] is [(s :> string)]. *)
+
+  val get_into_bytes : ctx -> ?off:int -> bytes -> unit
+  (** [get_into_bytes ctx ?off buf] writes the result into the given [buf] at
+      [off] (defaults to [0]).
+
+      It's equivalent to:
+
+      {[
+        let get_into_bytes ctx ?(off = 0) buf =
+          let t = get ctx in
+          let str = to_raw_string t in
+          Bytes.blit_string str 0 buf off digest_size
+      ]}
+
+      except [get_into_bytes] does not allocate an intermediate string. *)
 end
 
 (** Some hash algorithms expose extra MAC constructs. The interface is similar