Merge pull request #155 from reynir/feed-hmac

Implement feedable hmac

src-c/digestif.ml

@@ -18,6 +18,7 @@ module type S = sig
   val digest_size : int
 
   type ctx
+  type hmac
   type t
 
   val empty : ctx
@@ -29,6 +30,14 @@ module type S = sig
   val feedi_string : ctx -> String.t iter -> ctx
   val feedi_bigstring : ctx -> bigstring iter -> ctx
   val get : ctx -> t
+  val hmac_init : key:string -> hmac
+  val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac
+  val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac
+  val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac
+  val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac
+  val hmac_feedi_string : hmac -> String.t iter -> hmac
+  val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac
+  val hmac_get : hmac -> t
   val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t
   val digest_string : ?off:int -> ?len:int -> String.t -> t
   val digest_bigstring : ?off:int -> ?len:int -> bigstring -> t
@@ -211,6 +220,8 @@ end
 module Make (F : Foreign) (D : Desc) = struct
   include Core (F) (D)
 
+  type hmac = ctx * string
+
   let bytes_opad = By.make block_size '\x5c'
   let bytes_ipad = By.make block_size '\x36'
 
@@ -220,33 +231,40 @@ module Make (F : Foreign) (D : Desc) = struct
     | -1 -> By.rpad (By.unsafe_of_string key) block_size '\000'
     | _ -> By.of_string key
 
-  let hmaci_bytes ~key iter =
+  let hmac_init ~key =
     let key = norm_bytes key in
     let outer = Native.XOR.Bytes.xor key bytes_opad in
     let inner = Native.XOR.Bytes.xor key bytes_ipad in
     let ctx = feed_bytes empty inner in
-    let res = feedi_bytes ctx iter |> get in
-    let ctx = feed_bytes empty outer in
-    feed_string ctx (res :> string) |> get
+    (ctx, Bytes.unsafe_to_string outer)
+
+  let hmac_feed_bytes (t, outer) ?off ?len buf =
+    (feed_bytes t ?off ?len buf, outer)
+
+  let hmac_feed_string (t, outer) ?off ?len buf =
+    (feed_string t ?off ?len buf, outer)
+
+  let hmac_feed_bigstring (t, outer) ?off ?len buf =
+    (feed_bigstring t ?off ?len buf, outer)
+
+  let hmac_get (ctx, outer) =
+    feed_string (feed_string empty outer) (get ctx) |> get
+
+  let hmac_feedi_bytes (t, outer) iter = (feedi_bytes t iter, outer)
+  let hmac_feedi_string (t, outer) iter = (feedi_string t iter, outer)
+  let hmac_feedi_bigstring (t, outer) iter = (feedi_bigstring t iter, outer)
+
+  let hmaci_bytes ~key iter =
+    let t = hmac_init ~key in
+    hmac_feedi_bytes t iter |> hmac_get
 
   let hmaci_string ~key iter =
-    let key = norm_bytes key in
-    (* XXX(dinosaure): safe, [rpad] and [digest] have a read-only access. *)
-    let outer = Native.XOR.Bytes.xor key bytes_opad in
-    let inner = Native.XOR.Bytes.xor key bytes_ipad in
-    let ctx = feed_bytes empty inner in
-    let res = feedi_string ctx iter |> get in
-    let ctx = feed_bytes empty outer in
-    feed_string ctx (res :> string) |> get
+    let t = hmac_init ~key in
+    hmac_feedi_string t iter |> hmac_get
 
   let hmaci_bigstring ~key iter =
-    let key = norm_bytes key in
-    let outer = Native.XOR.Bytes.xor key bytes_opad in
-    let inner = Native.XOR.Bytes.xor key bytes_ipad in
-    let ctx = feed_bytes empty inner in
-    let res = feedi_bigstring ctx iter |> get in
-    let ctx = feed_bytes empty outer in
-    feed_string ctx (res :> string) |> get
+    let t = hmac_init ~key in
+    hmac_feedi_bigstring t iter |> hmac_get
 
   let hmac_bytes ~key ?off ?len buf =
     let buf =

src-ocaml/digestif.ml

@@ -17,6 +17,7 @@ module type S = sig
   val digest_size : int
 
   type ctx
+  type hmac
   type t
 
   val empty : ctx
@@ -28,6 +29,14 @@ module type S = sig
   val feedi_string : ctx -> String.t iter -> ctx
   val feedi_bigstring : ctx -> bigstring iter -> ctx
   val get : ctx -> t
+  val hmac_init : key:string -> hmac
+  val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac
+  val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac
+  val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac
+  val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac
+  val hmac_feedi_string : hmac -> String.t iter -> hmac
+  val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac
+  val hmac_get : hmac -> t
   val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t
   val digest_string : ?off:int -> ?len:int -> String.t -> t
   val digest_bigstring : ?off:int -> ?len:int -> bigstring -> t
@@ -192,6 +201,8 @@ end
 module Make (H : Hash) (D : Desc) = struct
   include Core (H) (D)
 
+  type hmac = ctx * string
+
   let bytes_opad = By.init block_size (fun _ -> '\x5c')
   let bytes_ipad = By.init block_size (fun _ -> '\x36')
 
@@ -201,33 +212,40 @@ module Make (H : Hash) (D : Desc) = struct
     | -1 -> By.rpad (Bytes.unsafe_of_string key) block_size '\000'
     | _ -> By.of_string key
 
-  let hmaci_bytes ~key iter =
+  let hmac_init ~key =
     let key = norm_bytes key in
     let outer = Xor.Bytes.xor key bytes_opad in
     let inner = Xor.Bytes.xor key bytes_ipad in
     let ctx = feed_bytes empty inner in
-    let res = feedi_bytes ctx iter |> get in
-    let ctx = feed_bytes empty outer in
-    feed_string ctx (res :> string) |> get
+    (ctx, Bytes.unsafe_to_string outer)
+
+  let hmac_feed_bytes (t, outer) ?off ?len buf =
+    (feed_bytes t ?off ?len buf, outer)
+
+  let hmac_feed_string (t, outer) ?off ?len buf =
+    (feed_string t ?off ?len buf, outer)
+
+  let hmac_feed_bigstring (t, outer) ?off ?len buf =
+    (feed_bigstring t ?off ?len buf, outer)
+
+  let hmac_get (ctx, outer) =
+    feed_string (feed_string empty outer) (get ctx) |> get
+
+  let hmac_feedi_bytes (t, outer) iter = (feedi_bytes t iter, outer)
+  let hmac_feedi_string (t, outer) iter = (feedi_string t iter, outer)
+  let hmac_feedi_bigstring (t, outer) iter = (feedi_bigstring t iter, outer)
+
+  let hmaci_bytes ~key iter =
+    let t = hmac_init ~key in
+    hmac_feedi_bytes t iter |> hmac_get
 
   let hmaci_string ~key iter =
-    let key = norm_bytes key in
-    (* XXX(dinosaure): safe, [rpad] and [digest] have a read-only access. *)
-    let outer = Xor.Bytes.xor key bytes_opad in
-    let inner = Xor.Bytes.xor key bytes_ipad in
-    let ctx = feed_bytes empty inner in
-    let res = feedi_string ctx iter |> get in
-    let ctx = feed_bytes empty outer in
-    feed_string ctx (res :> string) |> get
+    let t = hmac_init ~key in
+    hmac_feedi_string t iter |> hmac_get
 
   let hmaci_bigstring ~key iter =
-    let key = norm_bytes key in
-    let outer = Xor.Bytes.xor key bytes_opad in
-    let inner = Xor.Bytes.xor key bytes_ipad in
-    let ctx = feed_bytes empty inner in
-    let res = feedi_bigstring ctx iter |> get in
-    let ctx = feed_bytes empty outer in
-    feed_string ctx (res :> string) |> get
+    let t = hmac_init ~key in
+    hmac_feedi_bigstring t iter |> hmac_get
 
   let hmac_bytes ~key ?off ?len buf =
     let buf =

src/digestif.mli

@@ -18,6 +18,7 @@ module type S = sig
   (** Size of hash results, in bytes. *)
 
   type ctx
+  type hmac
   type t
 
   val empty : ctx
@@ -49,6 +50,34 @@ module type S = sig
   val get : ctx -> t
   (** [get t] is the digest corresponding to [t]. *)
 
+  val hmac_init : key:string -> hmac
+  (** Create a new hmac state. *)
+
+  val hmac_feed_bytes : hmac -> ?off:int -> ?len:int -> Bytes.t -> hmac
+  (** [hmac_feed_bytes msg t] adds informations in [msg] to [t]. [hmac_feed] is
+      analogous to appending:
+      [hmac_feed (hmac_feed t msg1) msg2 = hmac_feed t
+      (append msg1 msg2)] *)
+
+  val hmac_feed_string : hmac -> ?off:int -> ?len:int -> String.t -> hmac
+  (** Same as {!hmac_feed_bytes} but for {!String.t}. *)
+
+  val hmac_feed_bigstring : hmac -> ?off:int -> ?len:int -> bigstring -> hmac
+  (** Same as {!hmac_feed_bytes} but for {!bigstring}. *)
+
+  val hmac_feedi_bytes : hmac -> Bytes.t iter -> hmac
+  (** [hmac_feedi_bytes t iter = let r = ref t in iter (fun msg -> r := hmac_feed !r msg);
+      !r] *)
+
+  val hmac_feedi_string : hmac -> String.t iter -> hmac
+  (** Same as {!hmac_feedi_bytes} but for {!String.t}. *)
+
+  val hmac_feedi_bigstring : hmac -> bigstring iter -> hmac
+  (** Same as {!hmac_feedi_bytes} but for {!bigstring}. *)
+
+  val hmac_get : hmac -> t
+  (** [hmac_get t] is the hmac corresponding to [t]. *)
+
   val digest_bytes : ?off:int -> ?len:int -> Bytes.t -> t
   (** [digest_bytes msg] is the digest of [msg].
 

test/test.ml

@@ -3,10 +3,13 @@ type _ s = Bytes : Bytes.t s | String : String.t s | Bigstring : bigstring s
 and bigstring =
   (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
 
-let title : type a k. [ `HMAC | `Digest ] -> k Digestif.hash -> a s -> string =
+let title :
+    type a k.
+    [ `HMAC | `HMAC_feed | `Digest ] -> k Digestif.hash -> a s -> string =
  fun computation hash input ->
   let pp_computation ppf = function
     | `HMAC -> Fmt.string ppf "hmac"
+    | `HMAC_feed -> Fmt.string ppf "hmac_feed"
     | `Digest -> Fmt.string ppf "digest" in
   let pp_hash : type k. k Digestif.hash Fmt.t =
    fun ppf -> function
@@ -52,6 +55,31 @@ let test_hmac :
       let result = Digestif.hmaci_bigstring hash ~key (fun f -> f input) in
       Alcotest.(check test_hash) title expect result
 
+let test_hmac_feed :
+    type k a. a s -> k Digestif.hash -> string -> a -> k -> unit =
+ fun kind hash key input expect ->
+  let title = title `HMAC_feed hash kind in
+  let module H = (val Digestif.module_of hash) in
+  let test_hash = Alcotest.testable H.pp H.equal in
+  let hmac_ctx = H.hmac_init ~key in
+  let total_len =
+    match kind with
+    | Bytes -> Bytes.length input
+    | String -> String.length input
+    | Bigstring -> Bigarray.Array1.dim input in
+  let rec loop hmac_ctx off =
+    if off = total_len
+    then hmac_ctx
+    else
+      let len = min (total_len - off) 16 in
+      let hmac_ctx =
+        match kind with
+        | Bytes -> H.hmac_feed_bytes hmac_ctx ~off ~len input
+        | String -> H.hmac_feed_string hmac_ctx ~off ~len input
+        | Bigstring -> H.hmac_feed_bigstring hmac_ctx ~off ~len input in
+      loop hmac_ctx (off + len) in
+  Alcotest.check test_hash title expect (H.hmac_get (loop hmac_ctx 0))
+
 let test_digest : type k a. a s -> k Digestif.hash -> a -> k Digestif.t -> unit
     =
  fun kind hash input expect ->
@@ -80,6 +108,18 @@ let make_hmac :
  fun ~name kind hash key input expect ->
   (name, `Quick, fun () -> test_hmac kind hash key input expect)
 
+let make_hmac_feed :
+    type a k.
+    name:string ->
+    a s ->
+    k Digestif.hash ->
+    string ->
+    a ->
+    k ->
+    unit Alcotest.test_case =
+ fun ~name kind hash key input expect ->
+  (name, `Quick, fun () -> test_hmac_feed kind hash key input expect)
+
 let make_digest :
     type a k.
     name:string ->
@@ -104,6 +144,12 @@ let makes ~name kind hash keys inputs expects =
     (fun (key, input, expect) -> make_hmac ~name kind hash key input expect)
     (combine keys inputs expects)
 
+let makes' ~name kind hash keys inputs expects =
+  List.map
+    (fun (key, input, expect) ->
+      make_hmac_feed ~name kind hash key input expect)
+    (combine keys inputs expects)
+
 let to_bigstring s =
   let ln = Bytes.length s in
   let bi = Bigarray.Array1.create Bigarray.Char Bigarray.c_layout ln in
@@ -173,15 +219,17 @@ let results_sha224 =
   ]
   |> List.map (Digestif.of_hex Digestif.sha224)
 
-let results_sha256 =
-  [
-    "2178f5f21b4311607bf9347bcde5f6552edb9ec5aa13b954d53de2fbfd8b75de";
-    "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843";
-    "aa36cd61caddefe26b07ba1d3d07ea978ed575c9d1f921837dff9f73e019713e";
-    "a7c8b53d68678a8e6e4d403c6b97cf0f82c4ef7b835c41039c0a73aa4d627d05";
-    "b2a83b628f7e0da71c3879b81075775072d0d35935c62cc6c5a79b337ccccca1";
-  ]
-  |> List.map (Digestif.of_hex Digestif.sha256)
+let results_sha256, results_sha256' =
+  let raw_results_sha256 =
+    [
+      "2178f5f21b4311607bf9347bcde5f6552edb9ec5aa13b954d53de2fbfd8b75de";
+      "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843";
+      "aa36cd61caddefe26b07ba1d3d07ea978ed575c9d1f921837dff9f73e019713e";
+      "a7c8b53d68678a8e6e4d403c6b97cf0f82c4ef7b835c41039c0a73aa4d627d05";
+      "b2a83b628f7e0da71c3879b81075775072d0d35935c62cc6c5a79b337ccccca1";
+    ] in
+  ( List.map (Digestif.of_hex Digestif.sha256) raw_results_sha256,
+    List.map Digestif.SHA256.of_hex raw_results_sha256 )
 
 let results_sha384 =
   [
@@ -614,6 +662,9 @@ let tests () =
       ( "sha256 (bigstring)",
         makes ~name:"sha256" bigstring Digestif.sha256 keys_st inputs_bi
           results_sha256 );
+      ( "sha256 (feed bytes)",
+        makes' ~name:"sha256" bytes Digestif.sha256 keys_st inputs_by
+          results_sha256' );
       ( "sha384",
         makes ~name:"sha384" bytes Digestif.sha384 keys_st inputs_by
           results_sha384 );