balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'crypto-box' into 'master'

Browse Source 
Crypto box

Requesting code review for proof-of-work code

See merge request !115
This commit is contained in:
Grégoire Henry 2016-11-25 19:56:07 +01:00
commit 2d61ded08b
25 changed files with 214 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/.merlin
View File

@ -23,7 +23,6 @@ PKG cohttp
PKG compiler-libs.optcomp
PKG conduit
PKG config-file
PKG cryptokit
PKG cstruct
PKG dynlink
PKG ezjsonm

3
src/Makefile
View File

@ -121,9 +121,9 @@ UTILS_LIB_IMPLS := \
utils/cli_entries.ml \
utils/compare.ml \
utils/data_encoding.ml \
utils/crypto_box.ml \
utils/time.ml \
utils/hash.ml \
utils/crypto_box.ml \
utils/error_monad_sig.ml \
utils/error_monad.ml \
utils/logging.ml \
@ -133,7 +133,6 @@ UTILS_LIB_IMPLS := \
UTILS_PACKAGES := \
base64 \
calendar \
cryptokit \
cstruct \
ezjsonm \
lwt \

2
src/client/embedded/bootstrap/client_proto_main.ml
View File

@ -9,7 +9,7 @@
let protocol =
Protocol_hash.of_b48check
"4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg"
"4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd"
let () =
Client_version.register protocol @@

2
src/client/embedded/demo/client_proto_main.ml
View File

@ -9,7 +9,7 @@
let protocol =
Protocol_hash.of_b48check
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
let demo () =
let block = Client_config.block () in

65
src/node/net/p2p.ml
View File

@ -135,7 +135,8 @@ module Make (P: PARAMS) = struct
port : int option ;
versions : version list ;
public_key : Crypto_box.public_key ;
nonce : Crypto_box.nonce ;
proof_of_work : Crypto_box.nonce ;
message_nonce : Crypto_box.nonce ;
}
| Disconnect
| Bootstrap
@ -146,20 +147,21 @@ module Make (P: PARAMS) = struct
let open Data_encoding in
union ~tag_size:`Uint16
([ case ~tag:0x00
(obj5
(obj6
(req "gid" (Fixed.string gid_length))
(req "port" uint16)
(req "pubKey" Crypto_box.public_key_encoding)
(req "nonce" Crypto_box.nonce_encoding)
(req "proof_of_work" Crypto_box.nonce_encoding)
(req "message_nonce" Crypto_box.nonce_encoding)
(req "versions" (Variable.list version_encoding)))
(function
| Connect { gid ; port ; versions ; public_key ; nonce } ->
| Connect { gid ; port ; versions ; public_key ; proof_of_work; message_nonce } ->
let port = match port with None -> 0 | Some port -> port in
Some (gid, port, public_key, nonce, versions)
Some (gid, port, public_key, proof_of_work, message_nonce, versions)
| _ -> None)
(fun (gid, port, public_key, nonce, versions) ->
(fun (gid, port, public_key, proof_of_work, message_nonce, versions) ->
let port = if port = 0 then None else Some port in
Connect { gid ; port ; versions ; public_key ; nonce });
Connect { gid ; port ; versions ; public_key ; proof_of_work; message_nonce });
case ~tag:0x01 null
(function Disconnect -> Some () | _ -> None)
(fun () -> Disconnect);
@ -384,7 +386,7 @@ module Make (P: PARAMS) = struct
(including the one sent when the connection is alive). Returns a
canceler. *)
let connect_to_peer
config limits my_gid my_public_key my_secret_key
config limits my_gid my_public_key my_secret_key my_proof_of_work
socket (addr, port) push white_listed =
(* a non exception-based cancelation mechanism *)
let cancelation, cancel, on_cancel = canceler () in
@ -400,15 +402,25 @@ module Make (P: PARAMS) = struct
send_msg socket buf
(Connect { gid = my_gid ;
public_key = my_public_key ;
nonce = local_nonce ;
proof_of_work = my_proof_of_work ;
message_nonce = local_nonce ;
port = config.incoming_port ;
versions = P.supported_versions }) >>= fun _ ->
pick [ (LU.sleep limits.peer_answer_timeout >>= fun () -> return Disconnect) ;
recv_msg socket buf ] >>= function
| Connect { gid; port = listening_port; versions ; public_key ; nonce } ->
| Connect { gid; port = listening_port; versions ; public_key ; proof_of_work ; message_nonce } ->
debug "(%a) connection requested from %a @@ %a:%d"
pp_gid my_gid pp_gid gid Ipaddr.pp_hum addr port ;
begin match common_version P.supported_versions versions with
let work_proved =
Crypto_box.check_proof_of_work
public_key proof_of_work Crypto_box.default_target in
if not work_proved then
begin
debug "connection rejected (invalid proof of work)";
cancel ()
end
else
begin match common_version P.supported_versions versions with
| None ->
debug "(%a) connection rejected (incompatible versions) from %a:%d"
pp_gid my_gid Ipaddr.pp_hum addr port ;
@ -417,7 +429,7 @@ module Make (P: PARAMS) = struct
if config.closed_network then
match listening_port with
| Some port when white_listed (addr, port) ->
connected buf local_nonce version gid public_key nonce listening_port
connected buf local_nonce version gid public_key message_nonce listening_port
| Some port ->
debug "(%a) connection rejected (out of the closed network) from %a:%d"
pp_gid my_gid Ipaddr.pp_hum addr port ;
@ -427,8 +439,8 @@ module Make (P: PARAMS) = struct
pp_gid my_gid Ipaddr.pp_hum addr ;
cancel ()
else
connected buf local_nonce version gid public_key nonce listening_port
end
connected buf local_nonce version gid public_key message_nonce listening_port
end
| Advertise peers ->
(* alternatively, one can refuse a connection but reply with
some peers, so we accept this info *)
@ -526,10 +538,11 @@ module Make (P: PARAMS) = struct
let peers_file_encoding =
let open Data_encoding in
obj4
obj5
(req "gid" string)
(req "public_key" Crypto_box.public_key_encoding)
(req "secret_key" Crypto_box.secret_key_encoding)
(req "proof_of_work" Crypto_box.nonce_encoding)
(req "peers"
(obj3
(req "known"
@ -699,12 +712,14 @@ module Make (P: PARAMS) = struct
on_cancel (fun () -> close_msg_queue () ; return ()) ;
(* fill the known peers pools from last time *)
Data_encoding.Json.read_file config.peers_file >>= fun res ->
let known_peers, black_list, my_gid, my_public_key, my_secret_key =
let known_peers, black_list, my_gid, my_public_key, my_secret_key, my_proof_of_work =
let init_peers () =
let my_gid =
fresh_gid () in
let (my_secret_key, my_public_key) =
Crypto_box.random_keypair () in
let my_proof_of_work =
Crypto_box.generate_proof_of_work my_public_key Crypto_box.default_target in
let known_peers =
let source = { unreachable_since = None ;
connections = None ;
@ -717,23 +732,23 @@ module Make (P: PARAMS) = struct
PeerMap.empty config.known_peers in
let black_list =
BlackList.empty in
known_peers, black_list, my_gid, my_public_key, my_secret_key in
known_peers, black_list, my_gid, my_public_key, my_secret_key, my_proof_of_work in
match res with
| None ->
let known_peers, black_list, my_gid,
my_public_key, my_secret_key = init_peers () in
my_public_key, my_secret_key, my_proof_of_work = init_peers () in
debug "(%a) peer cache initiated" pp_gid my_gid ;
ref known_peers, ref black_list, my_gid,
my_public_key, my_secret_key
my_public_key, my_secret_key, my_proof_of_work
| Some json ->
match Data_encoding.Json.destruct peers_file_encoding json with
| exception _ ->
let known_peers, black_list, my_gid,
my_public_key, my_secret_key = init_peers () in
my_public_key, my_secret_key, my_proof_of_work = init_peers () in
debug "(%a) peer cache reset" pp_gid my_gid ;
ref known_peers, ref black_list,
my_gid, my_public_key, my_secret_key
| (my_gid, my_public_key, my_secret_key, (k, b, w)) ->
my_gid, my_public_key, my_secret_key, my_proof_of_work
| (my_gid, my_public_key, my_secret_key, my_proof_of_work, (k, b, w)) ->
let white_list =
List.fold_right PointSet.add w PointSet.empty in
let known_peers =
@ -761,7 +776,7 @@ module Make (P: PARAMS) = struct
BlackList.empty b in
debug "(%a) peer cache loaded" pp_gid my_gid ;
ref known_peers, ref black_list,
my_gid, my_public_key, my_secret_key
my_gid, my_public_key, my_secret_key, my_proof_of_work
in
(* some peer reachability predicates *)
let black_listed (addr, _) =
@ -781,6 +796,7 @@ module Make (P: PARAMS) = struct
(my_gid,
my_public_key,
my_secret_key,
my_proof_of_work,
PeerMap.fold
(fun (addr, port) gid source (k, b, w) ->
let infos = match gid, source.connections with
@ -1047,7 +1063,7 @@ module Make (P: PARAMS) = struct
else
let canceler =
connect_to_peer
config limits my_gid my_public_key my_secret_key
config limits my_gid my_public_key my_secret_key my_proof_of_work
socket (addr, port) enqueue_event white_listed in
debug "(%a) incoming peer @@ %a:%d"
pp_gid my_gid Ipaddr.pp_hum addr port ;
@ -1272,4 +1288,3 @@ module Make (P: PARAMS) = struct
let get_metadata net gid = net.get_metadata gid
let set_metadata net gid meta = net.set_metadata gid meta
end

2
src/node/shell/node.ml
View File

@ -330,7 +330,7 @@ module RPC = struct
let prevalidation_hash =
Block_hash.of_b48check
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
let get_net node = function
| `Head _ | `Prevalidation -> node.global_validator, node.global_net

3
src/node/updater/environment.ml
View File

@ -25,10 +25,11 @@ module Ed25519 = struct
let append_signature key msg =
MBytes.concat msg (sign key msg)
module Public_key_hash = Hash.Make_SHA256(Base48)(struct
module Public_key_hash = Hash.Make_Blake2B(Base48)(struct
let name = "Ed25519.Public_key_hash"
let title = "An Ed25519 public key ID"
let b48check_prefix = Base48.Prefix.ed25519_public_key_hash
let size = Some 20
end)
let hash v =

8
src/node_main.ml
View File

@ -12,18 +12,18 @@ open Logging.Node.Main
let genesis_block =
Block_hash.of_b48check
"eeHfgnr9QeDNvcMgSfATNeDeec4KG4CkHHkNNJt5B9xdVmsxhsHNR"
"grHGHkVfgJb5gPaRd5AtQsa65g9GyLcXgQsHbSnQ5SD5DEp2ctqck"
let genesis_protocol =
Protocol_hash.of_b48check
"4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg"
"4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd"
let test_protocol =
Some (Protocol_hash.of_b48check
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK")
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3")
let genesis_time =
Time.of_notation_exn "2016-08-01T00:00:00Z"
Time.of_notation_exn "2016-11-01T00:00:00Z"
let genesis = {
Store.time = genesis_time ;

2
src/proto/bootstrap/TEZOS_PROTOCOL
View File

@ -1,5 +1,5 @@
{
"hash": "4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg",
"hash": "4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd",
"modules": [
"Misc",

2
src/proto/bootstrap/mining.ml
View File

@ -133,7 +133,7 @@ let first_endorsement_slots
select_delegate delegate delegate_list max_priority
let check_hash hash stamp_threshold =
let bytes = Block_hash.to_raw hash in
let bytes = Block_hash.to_string hash in
let word = String.get_int64 bytes 0 in
Compare.Uint64.(word < stamp_threshold)

3
src/proto/bootstrap/storage_functors.ml
View File

@ -202,9 +202,10 @@ end
module Make_data_set_storage (P : Single_data_description) = struct
module Key = struct
include Hash.Make_minimal_SHA256(struct
include Hash.Make_minimal_Blake2B(struct
let name = P.name
let title = ("A " ^ P.name ^ "key")
let size = None
end)
let prefix = P.key
let length = path_len

12
src/proto/bootstrap/tezos_hash.ml
View File

@ -18,34 +18,38 @@ module Prefix = struct
let random_state_hash = make 15 (* never used... *)
end
module State_hash = Hash.Make_SHA256(Base48)(struct
module State_hash = Hash.Make_Blake2B(Base48)(struct
let name = "random"
let title = "A random generation state"
let b48check_prefix = Prefix.random_state_hash
let size = None
end)
module State_hash_set = Hash_set(State_hash)
module State_hash_map = Hash_map(State_hash)
module Nonce_hash = Hash.Make_SHA256(Base48)(struct
module Nonce_hash = Hash.Make_Blake2B(Base48)(struct
let name = "cycle_nonce"
let title = "A nonce hash"
let b48check_prefix = Prefix.nonce_hash
let size = None
end)
module Nonce_hash_set = Hash_set(Nonce_hash)
module Nonce_hash_map = Hash_map(Nonce_hash)
module Script_expr_hash = Hash.Make_SHA256(Base48)(struct
module Script_expr_hash = Hash.Make_Blake2B(Base48)(struct
let name = "script_expr"
let title = "A script expression ID"
let b48check_prefix = Prefix.script_expr_hash
let size = None
end)
module Script_expr_hash_set = Hash_set(Script_expr_hash)
module Script_expr_hash_map = Hash_map(Script_expr_hash)
module Contract_hash = Hash.Make_SHA256(Base48)(struct
module Contract_hash = Hash.Make_Blake2B(Base48)(struct
let name = "Contract_hash"
let title = "A contract ID"
let b48check_prefix = Prefix.contract_hash
let size = Some 20
end)
module Contract_hash_set = Hash_set(Contract_hash)
module Contract_hash_map = Hash_map(Contract_hash)

2
src/proto/demo/TEZOS_PROTOCOL
View File

@ -1,4 +1,4 @@
{
"hash": "2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK",
"hash": "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3",
"modules": ["Error", "Services", "Main"]
}

12
src/proto/environment/hash.mli
View File

@ -21,10 +21,10 @@ module type MINIMAL_HASH = sig
val size: int (* in bytes *)
val compare: t -> t -> int
val equal: t -> t -> bool
val of_raw: string -> t
val to_raw: t -> string
val of_hex: string -> t
val to_hex: t -> string
val of_string: string -> t
val to_string: t -> string
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t
val read: MBytes.t -> int -> t
@ -54,12 +54,13 @@ end
(** {2 Building Hashes} *******************************************************)
(** The parameters for creating a new Hash type using
{!Make_SHA256}. Both {!name} and {!title} are only informative,
{!Make_Blake2B}. Both {!name} and {!title} are only informative,
used in error messages and serializers. *)
module type Name = sig
val name : string
val title : string
val size : int option
end
module type PrefixedName = sig
@ -69,8 +70,8 @@ end
(** Builds a new Hash type using Sha256. *)
module Make_minimal_SHA256 (Name : Name) : MINIMAL_HASH
module Make_SHA256
module Make_minimal_Blake2B (Name : Name) : MINIMAL_HASH
module Make_Blake2B
(Register : sig
val register_encoding:
prefix: string ->
@ -109,4 +110,3 @@ module Operation_hash_map : module type of Hash_map (Operation_hash)
module Protocol_hash : HASH
module Protocol_hash_set : Set.S with type elt = Protocol_hash.t
module Protocol_hash_map : module type of Hash_map (Protocol_hash)

1
src/tezos-deps.opam
View File

@ -18,7 +18,6 @@ depends: [
"calendar"
"cohttp" {>= "0.21" }
"config-file"
"cryptokit"
"git"
"git-unix"
"irmin-watcher" (* for `irmin.unix` *)

19
src/utils/base48.ml
View File

@ -83,22 +83,25 @@ let raw_decode ?alphabet s =
String.sub res 0 (String.length res - res_tzeros) ^
String.make zeros '\000'
let sha256 s =
let hash = Cryptokit.Hash.sha256 () in
hash#add_string s;
let computed_hash = hash#result in hash#wipe;
computed_hash
let checksum s =
let bytes = Bytes.of_string s in
let hash =
let open Sodium.Generichash in
let state = init ~size:32 () in
Bytes.update state bytes ;
Bytes.of_hash (final state) in
Bytes.sub_string hash 0 4
(* Prepend a 4 byte cryptographic checksum before encoding string s *)
(* Prepend a 4 bytes cryptographic checksum before encoding string s *)
let safe_encode ?alphabet s =
raw_encode ?alphabet (s ^ String.sub (sha256 (sha256 s)) 0 4)
raw_encode ?alphabet (s ^ checksum s)
let safe_decode ?alphabet s =
let s = raw_decode ?alphabet s in
let len = String.length s in
let msg = String.sub s 0 (len-4)
and msg_hash = String.sub s (len-4) 4 in
if msg_hash <> String.sub (sha256 (sha256 msg)) 0 4 then
if msg_hash <> checksum msg then
invalid_arg "safe_decode" ;
msg

36
src/utils/crypto_box.ml
View File

@ -15,6 +15,8 @@ type secret_key = Sodium.Box.secret_key
type public_key = Sodium.Box.public_key
type channel_key = Sodium.Box.channel_key
type nonce = Sodium.Box.nonce
type target = int64 list (* used as unsigned intergers... *)
exception TargetNot256Bit
let random_keypair = Sodium.Box.random_keypair
let random_nonce = Sodium.Box.random_nonce
@ -24,6 +26,39 @@ let box_open sk pk msg nonce =
try Some (Sodium.Box.Bigbytes.box_open sk pk msg nonce) with
| Sodium.Verification_failure -> None
let make_target target =
if List.length target > 8 then raise TargetNot256Bit ;
target
(* Compare a SHA256 hash to a 256bits-target prefix.
The prefix is a list of "unsigned" int64. *)
let compare_target hash target =
let hash = Hash.Generic_hash.to_string hash in
let rec check offset = function
| [] -> true
| x :: xs ->
Compare.Uint64.(EndianString.BigEndian.get_int64 hash offset < x)
&& check (offset + 8) xs in
check 0 target
let default_target =
(* FIXME we use an easy target until we allow custom configuration. *)
[ Int64.shift_left 1L 48 ]
let check_proof_of_work pk nonce target =
let hash =
Hash.Generic_hash.hash_bytes [
Sodium.Box.Bigbytes.of_public_key pk ;
Sodium.Box.Bigbytes.of_nonce nonce ;
] in
compare_target hash target
let generate_proof_of_work pk target =
let rec loop nonce =
if check_proof_of_work pk nonce target then nonce
else loop (increment_nonce nonce) in
loop (random_nonce ())
let public_key_encoding =
let open Data_encoding in
conv
@ -44,4 +79,3 @@ let nonce_encoding =
Sodium.Box.Bigbytes.of_nonce
Sodium.Box.Bigbytes.to_nonce
(Fixed.bytes Sodium.Box.nonce_size)

7
src/utils/crypto_box.mli
View File

@ -13,9 +13,12 @@ type nonce
val random_nonce : unit -> nonce
val increment_nonce : ?step:int -> nonce -> nonce
val nonce_encoding : nonce Data_encoding.t
type target
val make_target : (* unsigned *) Int64.t list -> target
val default_target : target
type secret_key
type public_key
@ -28,3 +31,5 @@ val box : secret_key -> public_key -> MBytes.t -> nonce -> MBytes.t
val box_open : secret_key -> public_key -> MBytes.t -> nonce -> MBytes.t option
val check_proof_of_work : public_key -> nonce -> target -> bool
val generate_proof_of_work : public_key -> target -> nonce

121
src/utils/hash.ml
View File

@ -13,6 +13,17 @@ let (>|=) = Lwt.(>|=)
open Utils
let () =
let expected_primitive = "blake2b"
and primitive = Sodium.Generichash.primitive in
if primitive <> expected_primitive then begin
Printf.eprintf
"FATAL ERROR: \
invalid value for Sodium.Generichash.primitive: %S (expected %S)@."
primitive expected_primitive ;
exit 1
end
(*-- Signatures -------------------------------------------------------------*)
module type MINIMAL_HASH = sig
@ -27,10 +38,10 @@ module type MINIMAL_HASH = sig
val size: int (* in bytes *)
val compare: t -> t -> int
val equal: t -> t -> bool
val of_raw: string -> t
val to_raw: t -> string
val of_hex: string -> t
val to_hex: t -> string
val of_string: string -> t
val to_string: t -> string
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t
val read: MBytes.t -> int -> t
@ -60,6 +71,7 @@ end
module type Name = sig
val name: string
val title: string
val size: int option
end
module type PrefixedName = sig
@ -69,56 +81,61 @@ end
(*-- Type specific Hash builder ---------------------------------------------*)
module Make_minimal_SHA256 (K : Name) = struct
module Make_minimal_Blake2B (K : Name) = struct
type t = string
type t = Sodium.Generichash.hash
include K
let size = 32 (* SHA256 *)
let size =
match K.size with
| None -> 32
| Some x -> x
let of_raw s =
let of_string s =
if String.length s <> size then begin
let msg =
Printf.sprintf "%s.of_raw: wrong string size for %S (%d)"
K.name s (String.length s) in
Printf.sprintf "%s.of_string: wrong string size (%d)"
K.name (String.length s) in
raise (Invalid_argument msg)
end;
s
let to_raw s = s
end ;
Sodium.Generichash.Bytes.to_hash (Bytes.of_string s)
let to_string s = Bytes.to_string (Sodium.Generichash.Bytes.of_hash s)
let of_hex s = of_raw (Hex_encode.hex_decode s)
let to_hex s = Hex_encode.hex_encode s
let of_hex s = of_string (Hex_encode.hex_decode s)
let to_hex s = Hex_encode.hex_encode (to_string s)
let compare = String.compare
let equal : t -> t -> bool = (=)
let compare = Sodium.Generichash.compare
let equal x y = compare x y = 0
let of_bytes b =
let s = MBytes.to_string b in
if String.length s <> size then begin
if MBytes.length b <> size then begin
let msg =
Printf.sprintf "%s.of_bytes: wrong string size for %S (%d)"
K.name s (String.length s) in
Printf.sprintf "%s.of_bytes: wrong string size (%d)"
K.name (MBytes.length b) in
raise (Invalid_argument msg)
end;
s
let to_bytes = MBytes.of_string
end ;
Sodium.Generichash.Bigbytes.to_hash b
let to_bytes = Sodium.Generichash.Bigbytes.of_hash
let read src off = MBytes.substring src off size
let write dst off h = MBytes.blit_from_string h 0 dst off size
let read src off = of_bytes @@ MBytes.sub src off size
let write dst off h = MBytes.blit (to_bytes h) 0 dst off size
let hash_bytes l =
let hash = Cryptokit.Hash.sha256 () in
(* FIXME... bigstring... *)
List.iter (fun b -> hash#add_string (MBytes.to_string b)) l;
let r = hash#result in hash#wipe; r
let open Sodium.Generichash in
let state = init ~size () in
List.iter (Bigbytes.update state) l ;
final state
let hash_string l =
let hash = Cryptokit.Hash.sha256 () in
List.iter (fun b -> hash#add_string b) l;
let r = hash#result in hash#wipe; r
let open Sodium.Generichash in
let state = init ~size () in
List.iter
(fun s -> Bytes.update state (BytesLabels.unsafe_of_string s))
l ;
final state
module Set = Set.Make(struct type t = string let compare = compare end)
module Set = Set.Make(struct type nonrec t = t let compare = compare end)
let fold_read f buf off len init =
let last = off + len * size in
@ -133,12 +150,15 @@ module Make_minimal_SHA256 (K : Name) = struct
in
loop init off
module Map = Map.Make(struct type t = string let compare = compare end)
module Map = Map.Make(struct type nonrec t = t let compare = compare end)
module Table =
(* TODO improve *)
Hashtbl.Make(struct
type t = string
let hash s = Int64.to_int (EndianString.BigEndian.get_int64 s 0)
type nonrec t = t
let hash s =
Int64.to_int
(EndianString.BigEndian.get_int64
(Bytes.unsafe_to_string (Sodium.Generichash.Bytes.of_hash s))
0)
let equal = equal
end)
@ -153,7 +173,7 @@ module Make_minimal_SHA256 (K : Name) = struct
of_hex path
let prefix_path p =
let p = to_hex p in
let p = Hex_encode.hex_encode p in
let len = String.length p in
let p1 = if len >= 2 then String.sub p 0 2 else ""
and p2 = if len >= 4 then String.sub p 2 2 else ""
@ -165,7 +185,7 @@ module Make_minimal_SHA256 (K : Name) = struct
end
module Make_SHA256 (R : sig
module Make_Blake2B (R : sig
val register_encoding:
prefix: string ->
to_raw: ('a -> string) ->
@ -174,7 +194,7 @@ module Make_SHA256 (R : sig
'a Base48.encoding
end) (K : PrefixedName) = struct
include Make_minimal_SHA256(K)
include Make_minimal_Blake2B(K)
(* Serializers *)
@ -183,8 +203,8 @@ module Make_SHA256 (R : sig
let b48check_encoding =
R.register_encoding
~prefix: K.b48check_prefix
~wrap: (fun x -> Hash x)
~of_raw:(fun s -> Some s) ~to_raw
~wrap: (fun s -> Hash s)
~of_raw:(fun h -> Some (of_string h)) ~to_raw:to_string
let of_b48check s =
match Base48.simple_decode b48check_encoding s with
@ -240,7 +260,7 @@ module Hash_table (Hash : HASH)
type t = Hash.t
let equal = Hash.equal
let hash v =
let raw_hash = Hash.to_raw v in
let raw_hash = Hash.to_string v in
let int64_hash = EndianString.BigEndian.get_int64 raw_hash 0 in
Int64.to_int int64_hash
end)
@ -248,10 +268,11 @@ module Hash_table (Hash : HASH)
(*-- Pre-instanciated hashes ------------------------------------------------*)
module Block_hash =
Make_SHA256 (Base48) (struct
Make_Blake2B (Base48) (struct
let name = "Block_hash"
let title = "A Tezos block ID"
let b48check_prefix = Base48.Prefix.block_hash
let size = None
end)
module Block_hash_set = Hash_set (Block_hash)
@ -259,10 +280,11 @@ module Block_hash_map = Hash_map (Block_hash)
module Block_hash_table = Hash_table (Block_hash)
module Operation_hash =
Make_SHA256 (Base48) (struct
Make_Blake2B (Base48) (struct
let name = "Operation_hash"
let title = "A Tezos operation ID"
let b48check_prefix = Base48.Prefix.operation_hash
let size = None
end)
module Operation_hash_set = Hash_set (Operation_hash)
@ -270,12 +292,21 @@ module Operation_hash_map = Hash_map (Operation_hash)
module Operation_hash_table = Hash_table (Operation_hash)
module Protocol_hash =
Make_SHA256 (Base48) (struct
Make_Blake2B (Base48) (struct
let name = "Protocol_hash"
let title = "A Tezos protocol ID"
let b48check_prefix = Base48.Prefix.protocol_hash
let size = None
end)
module Protocol_hash_set = Hash_set (Protocol_hash)
module Protocol_hash_map = Hash_map (Protocol_hash)
module Protocol_hash_table = Hash_table (Protocol_hash)
module Generic_hash =
Make_minimal_Blake2B (struct
let name = "Generic_hash"
let title = ""
let size = None
end)

14
src/utils/hash.mli
View File

@ -13,7 +13,7 @@
(** {2 Hash Types} ************************************************************)
(** The signature of an abstract hash type, as produced by functor
{!Make_SHA256}. The {!t} type is abstracted for separating the
{!Make_Blake2B}. The {!t} type is abstracted for separating the
various kinds of hashes in the system at typing time. Each type is
equipped with functions to use it as is of as keys in the database
or in memory sets and maps. *)
@ -30,10 +30,10 @@ module type MINIMAL_HASH = sig
val size: int (* in bytes *)
val compare: t -> t -> int
val equal: t -> t -> bool
val of_raw: string -> t
val to_raw: t -> string
val of_hex: string -> t
val to_hex: t -> string
val of_string: string -> t
val to_string: t -> string
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t
val read: MBytes.t -> int -> t
@ -63,12 +63,13 @@ end
(** {2 Building Hashes} *******************************************************)
(** The parameters for creating a new Hash type using
{!Make_SHA256}. Both {!name} and {!title} are only informative,
{!Make_Blake2B}. Both {!name} and {!title} are only informative,
used in error messages and serializers. *)
module type Name = sig
val name : string
val title : string
val size : int option
end
module type PrefixedName = sig
@ -77,8 +78,8 @@ module type PrefixedName = sig
end
(** Builds a new Hash type using Sha256. *)
module Make_minimal_SHA256 (Name : Name) : MINIMAL_HASH
module Make_SHA256
module Make_minimal_Blake2B (Name : Name) : MINIMAL_HASH
module Make_Blake2B
(Register : sig
val register_encoding:
prefix: string ->
@ -132,3 +133,4 @@ module Protocol_hash_set : module type of Hash_set (Protocol_hash)
module Protocol_hash_map : module type of Hash_map (Protocol_hash)
module Protocol_hash_table : module type of Hash_table (Protocol_hash)
module Generic_hash : MINIMAL_HASH

1
test/Makefile
View File

@ -28,7 +28,6 @@ PACKAGES := \
cohttp.lwt \
compiler-libs.optcomp \
config-file \
cryptokit \
cstruct \
dynlink \
ezjsonm \

2
test/attic/test_p2p.ml
View File

@ -1,6 +1,6 @@
(*
ocamlfind ocamlopt \
-package 'lwt,lwt.unix,lwt.log,ezjsonm,ocplib-endian,config-file,cryptokit,cstruct' \
-package 'lwt,lwt.unix,lwt.log,ezjsonm,ocplib-endian,config-file,cstruct' \
../core/utils.cmx ../core/logs.cmx ../core/mMBytes.cmx ../core/json.cmx \
netbits.cmx p2p.cmx test_p2p.ml -linkpkg \
-o test_p2p && ./test_p2p

4
test/test_context.ml
View File

@ -18,11 +18,11 @@ let (//) = Filename.concat
let genesis_block =
Block_hash.of_b48check
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
let genesis_protocol =
Protocol_hash.of_b48check
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
let genesis_time =
Time.of_seconds 0L

4
test/test_state.ml
View File

@ -16,11 +16,11 @@ let (//) = Filename.concat
let genesis_block =
Block_hash.of_b48check
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
let genesis_protocol =
Protocol_hash.of_b48check
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
let genesis_time =
Time.of_seconds 0L

8
test/test_store.ml
View File

@ -18,11 +18,11 @@ let (//) = Filename.concat
let genesis_block =
Block_hash.of_b48check
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
let genesis_protocol =
Protocol_hash.of_b48check
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
let genesis_time =
Time.of_seconds 0L
@ -89,10 +89,10 @@ let bh2 = Store.Block.hash b2.data
let b3 = lolblock ~operations:[oph1;oph2] "Persil"
let bh3 = Store.Block.hash b3.data
let bh3' =
let raw = Bytes.of_string @@ Block_hash.to_raw bh3 in
let raw = Bytes.of_string @@ Block_hash.to_string bh3 in
Bytes.set raw 31 '\000' ;
Bytes.set raw 30 '\000' ;
Block_hash.of_raw @@ Bytes.to_string raw
Block_hash.of_string @@ Bytes.to_string raw
let check_block s h b =
Block.full_get s h >>= function