2018-02-04 21:39:34 +04:00
|
|
|
(*---------------------------------------------------------------------------
|
|
|
|
Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
|
|
|
|
Distributed under the ISC license, see terms at the end of the file.
|
|
|
|
---------------------------------------------------------------------------*)
|
|
|
|
|
|
|
|
module Blake2b = struct
|
2018-04-17 12:37:49 +04:00
|
|
|
type t = Bigstring.t
|
2018-02-04 21:39:34 +04:00
|
|
|
|
|
|
|
external sizeof_state : unit -> int =
|
|
|
|
"sizeof_blake2b_state" [@@noalloc]
|
|
|
|
|
|
|
|
let bytes = sizeof_state ()
|
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
external init : Bigstring.t -> int -> int =
|
2018-02-04 21:39:34 +04:00
|
|
|
"ml_blake2b_init" [@@noalloc]
|
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
external outlen : Bigstring.t -> int =
|
2018-02-04 21:39:34 +04:00
|
|
|
"blake2b_state_outlen" [@@noalloc]
|
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
let outlen t = outlen t
|
2018-02-04 21:39:34 +04:00
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
external init_key : Bigstring.t -> int -> Bigstring.t -> int =
|
2018-02-04 21:39:34 +04:00
|
|
|
"ml_blake2b_init_key" [@@noalloc]
|
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
external update : Bigstring.t -> Bigstring.t -> int =
|
2018-02-04 21:39:34 +04:00
|
|
|
"ml_blake2b_update" [@@noalloc]
|
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
external final : Bigstring.t -> Bigstring.t -> int =
|
2018-02-04 21:39:34 +04:00
|
|
|
"ml_blake2b_final" [@@noalloc]
|
|
|
|
|
|
|
|
external direct :
|
2018-04-17 12:37:49 +04:00
|
|
|
Bigstring.t -> Bigstring.t -> Bigstring.t -> int =
|
2018-02-04 21:39:34 +04:00
|
|
|
"ml_blake2b" [@@noalloc]
|
|
|
|
|
|
|
|
let or_fail ~msg f =
|
|
|
|
match f () with
|
|
|
|
| 0 -> ()
|
|
|
|
| _ -> failwith msg
|
|
|
|
|
|
|
|
let init ?key size =
|
|
|
|
if size < 1 || size > 64 then
|
|
|
|
invalid_arg "Blake2b.init: size must be between 1 and 64" ;
|
2018-04-17 12:37:49 +04:00
|
|
|
let t = Bigstring.create bytes in
|
2018-02-04 21:39:34 +04:00
|
|
|
begin match key with
|
2018-02-08 13:51:00 +04:00
|
|
|
| Some key ->
|
|
|
|
or_fail ~msg:"Blake2b.init"
|
2018-04-17 12:37:49 +04:00
|
|
|
(fun () -> init_key t size key)
|
2018-02-08 13:51:00 +04:00
|
|
|
| None ->
|
|
|
|
or_fail ~msg:"Blake2b.init"
|
2018-04-17 12:37:49 +04:00
|
|
|
(fun () -> init t size)
|
2018-02-04 21:39:34 +04:00
|
|
|
end ;
|
|
|
|
t
|
|
|
|
|
|
|
|
let update t buf =
|
2018-04-17 12:37:49 +04:00
|
|
|
or_fail ~msg:"Blake2b.update" (fun () -> update t buf)
|
2018-02-04 21:39:34 +04:00
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
type hash = Hash of Bigstring.t
|
2018-02-04 21:39:34 +04:00
|
|
|
|
|
|
|
let final t =
|
|
|
|
let len = outlen t in
|
2018-04-17 12:37:49 +04:00
|
|
|
let buf = Bigstring.create len in
|
|
|
|
or_fail ~msg:"Blake2b.final" (fun () -> final t buf) ;
|
2018-02-04 21:39:34 +04:00
|
|
|
Hash buf
|
|
|
|
|
2018-04-17 12:37:49 +04:00
|
|
|
let direct ?(key=Bigstring.create 0) inbuf len =
|
2018-02-04 21:39:34 +04:00
|
|
|
if len < 1 || len > 64 then
|
|
|
|
invalid_arg "Blake2b.direct: size must be between 1 and 64" ;
|
2018-04-17 12:37:49 +04:00
|
|
|
let outbuf = Bigstring.create len in
|
|
|
|
or_fail ~msg:"Blake2b.direct" (fun () -> direct outbuf inbuf key) ;
|
2018-02-04 21:39:34 +04:00
|
|
|
Hash outbuf
|
|
|
|
end
|
|
|
|
|
|
|
|
(*---------------------------------------------------------------------------
|
|
|
|
Copyright (c) 2018 Vincent Bernardoff
|
|
|
|
|
|
|
|
Permission to use, copy, modify, and/or distribute this software for any
|
|
|
|
purpose with or without fee is hereby granted, provided that the above
|
|
|
|
copyright notice and this permission notice appear in all copies.
|
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
|
|
|
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
|
|
|
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
|
|
|
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
|
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
|
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
|
|
|
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
|
|
---------------------------------------------------------------------------*)
|