From 6f0cc397ae22fbc1da408a1d90dbf0e809432677 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Tue, 3 Apr 2018 11:44:11 +0200 Subject: [PATCH] Shell: move back hash encoders from `lib_base` to `lib_crypto` --- src/lib_base/blake2B.ml | 187 ------------------ src/lib_base/blake2B.mli | 75 ------- src/lib_base/chain_id.ml | 110 ----------- src/lib_base/crypto_box.ml | 32 --- src/lib_base/crypto_box.mli | 14 -- src/lib_base/ed25519.ml | 111 ----------- src/lib_base/ed25519.mli | 44 ----- src/lib_base/p2p_peer_id.ml | 2 +- src/lib_base/p2p_peer_id.mli | 2 +- src/lib_base/s.ml | 119 ----------- src/lib_base/tzPervasives.ml | 14 +- src/lib_base/tzPervasives.mli | 14 +- src/lib_crypto/base58.ml | 2 + src/lib_crypto/base58.mli | 1 + src/lib_crypto/blake2B.ml | 80 ++++++-- src/{lib_base => lib_crypto}/block_hash.ml | 6 +- src/{lib_base => lib_crypto}/block_hash.mli | 2 +- src/lib_crypto/chain_id.ml | 114 +++++++++++ src/{lib_base => lib_crypto}/chain_id.mli | 2 +- src/{lib_base => lib_crypto}/context_hash.ml | 6 +- src/{lib_base => lib_crypto}/context_hash.mli | 2 +- src/lib_crypto/crypto_box.ml | 22 +++ src/lib_crypto/crypto_box.mli | 4 + src/lib_crypto/ed25519.ml | 92 +++++++++ src/lib_crypto/ed25519.mli | 26 +++ src/lib_crypto/hash.ml | 115 +++++++++++ src/lib_crypto/jbuild | 10 +- .../operation_hash.ml | 6 +- .../operation_hash.mli | 2 +- .../operation_list_hash.ml | 6 +- .../operation_list_hash.mli | 2 +- .../operation_list_list_hash.ml | 6 +- .../operation_list_list_hash.mli | 2 +- src/{lib_base => lib_crypto}/protocol_hash.ml | 6 +- .../protocol_hash.mli | 2 +- src/lib_crypto/s.ml | 30 +++ .../main_embedded_packer.ml | 2 +- .../tezos_protocol_environment.ml | 91 ++++++++- .../test/helpers/helpers_operation.mli | 2 +- 39 files changed, 596 insertions(+), 769 deletions(-) delete mode 100644 src/lib_base/blake2B.ml delete mode 100644 src/lib_base/blake2B.mli delete mode 100644 src/lib_base/chain_id.ml delete mode 100644 src/lib_base/crypto_box.ml delete mode 100644 src/lib_base/crypto_box.mli delete mode 100644 src/lib_base/ed25519.ml delete mode 100644 src/lib_base/ed25519.mli rename src/{lib_base => lib_crypto}/block_hash.ml (79%) rename src/{lib_base => lib_crypto}/block_hash.mli (96%) create mode 100644 src/lib_crypto/chain_id.ml rename src/{lib_base => lib_crypto}/chain_id.mli (96%) rename src/{lib_base => lib_crypto}/context_hash.ml (79%) rename src/{lib_base => lib_crypto}/context_hash.mli (96%) create mode 100644 src/lib_crypto/hash.ml rename src/{lib_base => lib_crypto}/operation_hash.ml (79%) rename src/{lib_base => lib_crypto}/operation_hash.mli (96%) rename src/{lib_base => lib_crypto}/operation_list_hash.ml (78%) rename src/{lib_base => lib_crypto}/operation_list_hash.mli (90%) rename src/{lib_base => lib_crypto}/operation_list_list_hash.ml (78%) rename src/{lib_base => lib_crypto}/operation_list_list_hash.mli (89%) rename src/{lib_base => lib_crypto}/protocol_hash.ml (79%) rename src/{lib_base => lib_crypto}/protocol_hash.mli (96%) diff --git a/src/lib_base/blake2B.ml b/src/lib_base/blake2B.ml deleted file mode 100644 index 9cbd9c483..000000000 --- a/src/lib_base/blake2B.ml +++ /dev/null @@ -1,187 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Tezos_crypto -open Error_monad - -module Extend(H : Tezos_crypto.S.HASH) = struct - - include H - - let encoding = - let open Data_encoding in - splitted - ~binary: - (conv H.to_bytes H.of_bytes_exn (Fixed.bytes H.size)) - ~json: - (describe ~title: (H.title ^ " (Base58Check-encoded Blake2B hash)") @@ - conv H.to_b58check (Data_encoding.Json.wrap_error H.of_b58check_exn) string) - - let of_b58check s = - match H.of_b58check_opt s with - | Some x -> Ok x - | None -> - generic_error "Failed to read a base58-encoded hash (%s)" H.name - - let of_bytes s = - match H.of_bytes_opt s with - | Some x -> Ok x - | None -> - generic_error "Failed to deserialize a hash (%s)" H.name - - let rpc_arg = - RPC_arg.make - ~name:(Format.asprintf "hash.%s" H.name) - ~descr:(Format.asprintf "A b58check-encoded hash (%s)" H.name) - ~destruct: - (fun s -> - match H.of_b58check_opt s with - | None -> - Error (Format.asprintf - "failed to decode b58check-encoded hash (%s): %S" - H.name s) - | Some v -> Ok v) - ~construct:H.to_b58check - () - - let param ?(name=H.name) ?(desc=H.title) t = - Clic.param - ~name - ~desc (Clic.parameter (fun _ str -> Lwt.return (of_b58check str))) t - - module Set = struct - include Set.Make(struct type nonrec t = t let compare = compare end) - exception Found of elt - let random_elt s = - let n = Random.int (cardinal s) in - try - ignore - (fold (fun x i -> if i = n then raise (Found x) ; i+1) s 0 : int) ; - assert false - with Found x -> x - let encoding = - Data_encoding.conv - elements - (fun l -> List.fold_left (fun m x -> add x m) empty l) - Data_encoding.(list encoding) - end - - module Table = struct - include Hashtbl.Make(struct - type t = H.t - let hash = - if H.size >= 64 then - fun h -> Int64.to_int (MBytes.get_int64 (H.to_bytes h) 0) - else if H.size >= 32 then - fun h -> Int32.to_int (MBytes.get_int32 (H.to_bytes h) 0) - else - fun h -> - let r = ref 0 in - let h = H.to_bytes h in - for i = 0 to H.size / 8 - 1 do - r := MBytes.get_uint8 h i + 8 * !r - done ; - !r - let equal = H.equal - end) - let encoding arg_encoding = - Data_encoding.conv - (fun h -> fold (fun k v l -> (k, v) :: l) h []) - (fun l -> - let h = create (List.length l) in - List.iter (fun (k,v) -> add h k v) l ; - h) - Data_encoding.(list (tup2 encoding arg_encoding)) - end - - module Map = struct - include Map.Make(struct type nonrec t = t let compare = compare end) - let encoding arg_encoding = - Data_encoding.conv - bindings - (fun l -> List.fold_left (fun m (k,v) -> add k v m) empty l) - Data_encoding.(list (tup2 encoding arg_encoding)) - end - -end - -module Extend_merkle_tree(H : Tezos_crypto.S.MERKLE_TREE) = struct - - include Extend(H) - - type elt = H.elt - let elt_bytes = H.elt_bytes - - let empty = hash_bytes [] - - include Tezos_crypto.Blake2B.Generic_Merkle_tree(struct - type nonrec t = t - type nonrec elt = elt - let empty = empty - let leaf x = hash_bytes [H.elt_bytes x] - let node x y = hash_bytes [to_bytes x; to_bytes y] - end) - - let path_encoding = - let open Data_encoding in - mu "path" - (fun path_encoding -> - union [ - case (Tag 240) - (obj2 - (req "path" path_encoding) - (req "right" encoding)) - (function Left (p, r) -> Some (p, r) | _ -> None) - (fun (p, r) -> Left (p, r)) ; - case (Tag 15) - (obj2 - (req "left" encoding) - (req "path" path_encoding)) - (function Right (r, p) -> Some (r, p) | _ -> None) - (fun (r, p) -> Right (r, p)) ; - case (Tag 0) - unit - (function Op -> Some () | _ -> None) - (fun () -> Op) - ]) - -end - -module type Name = Blake2B.Name -module type PrefixedName = Blake2B.PrefixedName -module Make_minimal = Blake2B.Make_minimal -module Make - (R : sig - val register_encoding: - prefix: string -> - length:int -> - to_raw: ('a -> string) -> - of_raw: (string -> 'a option) -> - wrap: ('a -> Base58.data) -> - 'a Base58.encoding - end) - (K : Blake2B.PrefixedName) = - Extend(Blake2B.Make(R)(K)) -module Make_merkle_tree - (R : sig - val register_encoding: - prefix: string -> - length:int -> - to_raw: ('a -> string) -> - of_raw: (string -> 'a option) -> - wrap: ('a -> Base58.data) -> - 'a Base58.encoding - end) - (K : PrefixedName) - (Contents: sig - type t - val to_bytes: t -> MBytes.t - end) = - Extend_merkle_tree(Blake2B.Make_merkle_tree(R)(K)(Contents)) -module Generic_Merkle_tree = Blake2B.Generic_Merkle_tree diff --git a/src/lib_base/blake2B.mli b/src/lib_base/blake2B.mli deleted file mode 100644 index 42b7c9d88..000000000 --- a/src/lib_base/blake2B.mli +++ /dev/null @@ -1,75 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -(** Builds a new Hash type using Blake2B. *) - -(** The parameters for creating a new Hash type using - {!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 - include Name - val b58check_prefix : string -end - -module Make_minimal (Name : Name) : S.MINIMAL_HASH -module Make - (Register : sig - val register_encoding: - prefix: string -> - length: int -> - to_raw: ('a -> string) -> - of_raw: (string -> 'a option) -> - wrap: ('a -> Tezos_crypto.Base58.data) -> - 'a Tezos_crypto.Base58.encoding - end) - (Name : PrefixedName) : S.INTERNAL_HASH - -module Make_merkle_tree - (R : sig - val register_encoding: - prefix: string -> - length:int -> - to_raw: ('a -> string) -> - of_raw: (string -> 'a option) -> - wrap: ('a -> Tezos_crypto.Base58.data) -> - 'a Tezos_crypto.Base58.encoding - end) - (K : PrefixedName) - (Contents: sig - type t - val to_bytes: t -> MBytes.t - end) : S.INTERNAL_MERKLE_TREE with type elt = Contents.t - -module Generic_Merkle_tree (H : sig - type t - type elt - val empty : t - val leaf : elt -> t - val node : t -> t -> t - end) : sig - val compute : H.elt list -> H.t - type path = - | Left of path * H.t - | Right of H.t * path - | Op - val compute_path: H.elt list -> int -> path - val check_path: path -> H.elt -> H.t * int -end - -module Extend (H: Tezos_crypto.S.HASH) - : S.INTERNAL_HASH with type t = H.t -module Extend_merkle_tree (H: Tezos_crypto.S.MERKLE_TREE) - : S.INTERNAL_MERKLE_TREE with type t = H.t and type elt = H.elt diff --git a/src/lib_base/chain_id.ml b/src/lib_base/chain_id.ml deleted file mode 100644 index eae5d23ac..000000000 --- a/src/lib_base/chain_id.ml +++ /dev/null @@ -1,110 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -module Raw = struct - - type t = string - - let name = "Chain_id" - let title = "Network identifier" - - let extract bh = - MBytes.substring (Block_hash.to_bytes bh) 0 4 - let hash_bytes ?key l = extract (Block_hash.hash_bytes ?key l) - let hash_string ?key l = extract (Block_hash.hash_string ?key l) - - let size = 4 - - let compare = String.compare - let equal = String.equal - - let of_string s = - if String.length s <> size then None else Some s - let of_string_exn s = - match of_string s with - | None -> - let msg = - Printf.sprintf "%s.of_string: wrong string size (%d)" - name (String.length s) in - raise (Invalid_argument msg) - | Some h -> h - - let to_string s = s - let of_hex s = of_string (Hex.to_string (`Hex s)) - let of_hex_exn s = of_string_exn (Hex.to_string (`Hex s)) - let to_hex s = - let `Hex s = Hex.of_string (to_string s) in - s - - - let of_bytes_opt b = - if MBytes.length b <> size then - None - else - Some (MBytes.to_string b) - let of_bytes_exn b = - match of_bytes_opt b with - | None -> - let msg = - Printf.sprintf "%s.of_bytes: wrong string size (%d)" - name (MBytes.length b) in - raise (Invalid_argument msg) - | Some h -> h - let to_bytes = MBytes.of_string - - let read src off = of_bytes_exn @@ MBytes.sub src off size - let write dst off h = MBytes.blit (to_bytes h) 0 dst off size - - let path_length = 1 - let to_path key l = to_hex key :: l - let of_path path = - let path = String.concat "" path in - of_hex path - let of_path_exn path = - let path = String.concat "" path in - of_hex_exn path - - let prefix_path p = - let `Hex p = Hex.of_string p in - [ p ] - - let zero = - match of_hex (String.make (size * 2) '0') with - | Some c -> c - | None -> assert false - - type Tezos_crypto.Base58.data += Hash of t - - let b58check_encoding = - Tezos_crypto.Base58.register_encoding - ~prefix: Tezos_crypto.Base58.Prefix.chain_id - ~length: size - ~wrap: (fun s -> Hash s) - ~of_raw:of_string ~to_raw: (fun h -> h) - - let of_b58check_opt s = - Tezos_crypto.Base58.simple_decode b58check_encoding s - let of_b58check_exn s = - match Tezos_crypto.Base58.simple_decode b58check_encoding s with - | Some x -> x - | None -> Format.kasprintf Pervasives.failwith "Unexpected hash (%s)" name - let to_b58check s = Tezos_crypto.Base58.simple_encode b58check_encoding s - let to_short_b58check = to_b58check - - let pp ppf t = - Format.pp_print_string ppf (to_b58check t) - - let pp_short ppf t = - Format.pp_print_string ppf (to_short_b58check t) - -end - -include Blake2B.Extend(Raw) - -let of_block_hash bh = hash_bytes [Block_hash.to_bytes bh] diff --git a/src/lib_base/crypto_box.ml b/src/lib_base/crypto_box.ml deleted file mode 100644 index 5cc2dee89..000000000 --- a/src/lib_base/crypto_box.ml +++ /dev/null @@ -1,32 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -include Tezos_crypto.Crypto_box - -let public_key_encoding = - let open Data_encoding in - conv - public_key_to_bigarray - public_key_of_bigarray - (Fixed.bytes public_key_size) - -let secret_key_encoding = - let open Data_encoding in - conv - secret_key_to_bigarray - secret_key_of_bigarray - (Fixed.bytes secret_key_size) - -let nonce_encoding = - let open Data_encoding in - conv - nonce_to_bigarray - nonce_of_bigarray - (Fixed.bytes nonce_size) - diff --git a/src/lib_base/crypto_box.mli b/src/lib_base/crypto_box.mli deleted file mode 100644 index 447598ddd..000000000 --- a/src/lib_base/crypto_box.mli +++ /dev/null @@ -1,14 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -include (module type of Tezos_crypto.Crypto_box) - -val public_key_encoding : public_key Data_encoding.t -val secret_key_encoding : secret_key Data_encoding.t -val nonce_encoding : nonce Data_encoding.t diff --git a/src/lib_base/ed25519.ml b/src/lib_base/ed25519.ml deleted file mode 100644 index ab7ad48c3..000000000 --- a/src/lib_base/ed25519.ml +++ /dev/null @@ -1,111 +0,0 @@ - -module Public_key_hash = Blake2B.Extend (Tezos_crypto.Ed25519.Public_key_hash) - -module Public_key = struct - include Tezos_crypto.Ed25519.Public_key - let encoding = - let open Data_encoding in - splitted - ~json: - (describe - ~title: "An Ed25519 public key (Tezos_crypto.Base58Check encoded)" @@ - conv - (fun s -> to_b58check s) - (fun s -> - match of_b58check_opt s with - | Some x -> x - | None -> Data_encoding.Json.cannot_destruct - "Ed25519 public key: unexpected prefix.") - string) - ~binary: - (conv - to_bytes - of_bytes_exn - (Fixed.bytes size)) - let of_b58check s = - match of_b58check_opt s with - | Some x -> Ok x - | None -> - Error_monad.generic_error - "Failed to read a base58-encoded Ed25519 public key" - let param - ?(name="ed25519-public") - ?(desc="Ed25519 public key (b58check-encoded)") t = - Clic.(param ~name ~desc - (parameter (fun _ str -> Lwt.return (of_b58check str))) t) - -end - -module Secret_key = struct - include Tezos_crypto.Ed25519.Secret_key - let encoding = - let open Data_encoding in - splitted - ~json: - (describe - ~title: "An Ed25519 secret key (Tezos_crypto.Base58Check encoded)" @@ - conv - (fun s -> to_b58check s) - (fun s -> - match of_b58check_opt s with - | Some x -> x - | None -> Data_encoding.Json.cannot_destruct - "Ed25519 secret key: unexpected prefix.") - string) - ~binary: - (conv - to_bytes - of_bytes_exn - (Fixed.bytes size)) - let of_b58check s = - match of_b58check_opt s with - | Some x -> Ok x - | None -> - Error_monad.generic_error - "Failed to read a base58-encoded Ed25519 secret key" - let param - ?(name="ed25519-secret") - ?(desc="Ed25519 secret key (b58check-encoded)") t = - Clic.(param ~name ~desc - (parameter (fun _ str -> Lwt.return (of_b58check str))) t) -end - -module Signature = struct - include Tezos_crypto.Ed25519.Signature - let encoding = - let open Data_encoding in - splitted - ~json: - (describe - ~title: "An Ed25519 signature (Base58Check encoded)" @@ - conv - (fun s -> to_b58check s) - (fun s -> - match of_b58check_opt s with - | Some x -> x - | None -> Data_encoding.Json.cannot_destruct - "Ed25519 signature: unexpected prefix.") - string) - ~binary: - (conv - to_bytes - of_bytes_exn - (Fixed.bytes size)) - let of_b58check s = - match of_b58check_opt s with - | Some x -> Ok x - | None -> - Error_monad.generic_error - "Failed to read a base58-encoded Ed25519 signature" - let param - ?(name="ed25519-signature") - ?(desc="Ed25519 signature (b58check-encoded)") t = - Clic.(param ~name ~desc - (parameter (fun _ str -> Lwt.return (of_b58check str))) t) -end - -include (Tezos_crypto.Ed25519 : (module type of Tezos_crypto.Ed25519) - with module Public_key_hash := Public_key_hash - and module Public_key := Public_key - and module Secret_key := Secret_key - and module Signature := Signature) diff --git a/src/lib_base/ed25519.mli b/src/lib_base/ed25519.mli deleted file mode 100644 index e5a8e8e96..000000000 --- a/src/lib_base/ed25519.mli +++ /dev/null @@ -1,44 +0,0 @@ - -open Error_monad - -module Public_key_hash : - S.INTERNAL_HASH with type t = Tezos_crypto.Ed25519.Public_key_hash.t - -module Public_key : sig - include (module type of Tezos_crypto.Ed25519.Public_key) - val encoding: t Data_encoding.t - val param: - ?name:string -> - ?desc:string -> - ('a, 'b) Clic.params -> - (t -> 'a, 'b) Clic.params - val of_b58check: string -> t tzresult -end - -module Secret_key : sig - include (module type of Tezos_crypto.Ed25519.Secret_key) - val encoding: t Data_encoding.t - val param: - ?name:string -> - ?desc:string -> - ('a, 'b) Clic.params -> - (t -> 'a, 'b) Clic.params - val of_b58check: string -> t tzresult -end - -module Signature : sig - include (module type of Tezos_crypto.Ed25519.Signature) - val encoding: t Data_encoding.t - val param: - ?name:string -> - ?desc:string -> - ('a, 'b) Clic.params -> - (t -> 'a, 'b) Clic.params - val of_b58check: string -> t tzresult -end - -include (module type of Tezos_crypto.Ed25519) - with module Public_key_hash := Public_key_hash - and module Public_key := Public_key - and module Secret_key := Secret_key - and module Signature := Signature diff --git a/src/lib_base/p2p_peer_id.ml b/src/lib_base/p2p_peer_id.ml index 6eabf2609..7dfb5e1df 100644 --- a/src/lib_base/p2p_peer_id.ml +++ b/src/lib_base/p2p_peer_id.ml @@ -7,5 +7,5 @@ (* *) (**************************************************************************) -include Blake2B.Extend(Crypto_box.Public_key_hash) +include Crypto_box.Public_key_hash diff --git a/src/lib_base/p2p_peer_id.mli b/src/lib_base/p2p_peer_id.mli index a7371c132..dfe7023d1 100644 --- a/src/lib_base/p2p_peer_id.mli +++ b/src/lib_base/p2p_peer_id.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -include S.INTERNAL_HASH with type t = Crypto_box.Public_key_hash.t +include Tezos_crypto.S.HASH with type t = Crypto_box.Public_key_hash.t diff --git a/src/lib_base/s.ml b/src/lib_base/s.ml index 0de4ce991..ae42a7b15 100644 --- a/src/lib_base/s.ml +++ b/src/lib_base/s.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -open Error_monad - module type T = sig type t @@ -99,120 +97,3 @@ module type MAP = sig val map: ('a -> 'b) -> 'a t -> 'b t val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t end - -module type MINIMAL_HASH = Tezos_crypto.S.MINIMAL_HASH - -module type HASH = sig - - include Tezos_crypto.S.MINIMAL_HASH - - val encoding: t Data_encoding.t - - val to_b58check: t -> string - val to_short_b58check: t -> string - type Tezos_crypto.Base58.data += Hash of t - val b58check_encoding: t Tezos_crypto.Base58.encoding - - val of_b58check_exn: string -> t - val of_b58check_opt: string -> t option - - val pp: Format.formatter -> t -> unit - val pp_short: Format.formatter -> t -> unit - - val rpc_arg: t RPC_arg.t - - module Set : sig - include SET with type elt = t - val encoding: t Data_encoding.t - end - - module Map : sig - include MAP with type key = t - val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t - end - -end - -module type INTERNAL_HASH = sig - - include Tezos_crypto.S.HASH - - val of_b58check: string -> t tzresult - val of_bytes: MBytes.t -> t tzresult - - val encoding: t Data_encoding.t - val rpc_arg: t RPC_arg.t - - val param: - ?name:string -> - ?desc:string -> - ('a, 'arg) Clic.params -> - (t -> 'a, 'arg) Clic.params - - module Set : sig - include Set.S with type elt = t - val random_elt: t -> elt - val encoding: t Data_encoding.t - end - - module Map : sig - include Map.S with type key = t - val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t - end - - module Table : sig - include Hashtbl.S with type key = t - val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t - end - -end - -module type MERKLE_TREE = sig - type elt - include HASH - val compute: elt list -> t - val empty: t - type path = - | Left of path * t - | Right of t * path - | Op - val compute_path: elt list -> int -> path - val check_path: path -> elt -> t * int - val path_encoding: path Data_encoding.t -end - -module type INTERNAL_MERKLE_TREE = sig - - include Tezos_crypto.S.MERKLE_TREE - - val path_encoding: path Data_encoding.t - - val of_b58check: string -> t tzresult - val of_bytes: MBytes.t -> t tzresult - - val encoding: t Data_encoding.t - val rpc_arg: t RPC_arg.t - - val param: - ?name:string -> - ?desc:string -> - ('a, 'arg) Clic.params -> - (t -> 'a, 'arg) Clic.params - - module Set : sig - include Set.S with type elt = t - val random_elt: t -> elt - val encoding: t Data_encoding.t - end - - module Map : sig - include Map.S with type key = t - val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t - end - - module Table : sig - include Hashtbl.S with type key = t - val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t - end - -end diff --git a/src/lib_base/tzPervasives.ml b/src/lib_base/tzPervasives.ml index f9e544930..6fd1c174e 100644 --- a/src/lib_base/tzPervasives.ml +++ b/src/lib_base/tzPervasives.ml @@ -12,13 +12,9 @@ include Tezos_data_encoding include Tezos_error_monad include Tezos_rpc include Tezos_clic +include Tezos_crypto include Tezos_micheline -module Ed25519 = Ed25519 -module Crypto_box = Crypto_box -module Base58 = Tezos_crypto.Base58 -module Rand = Tezos_crypto.Rand - module List = struct include List include Tezos_stdlib.TzList @@ -34,14 +30,6 @@ module Block_header = Block_header module Operation = Operation module Protocol = Protocol -module Chain_id = Chain_id -module Block_hash = Block_hash -module Operation_hash = Operation_hash -module Operation_list_hash = Operation_list_hash -module Operation_list_list_hash = Operation_list_list_hash -module Context_hash = Context_hash -module Protocol_hash = Protocol_hash - module Test_chain_status = Test_chain_status module Preapply_result = Preapply_result diff --git a/src/lib_base/tzPervasives.mli b/src/lib_base/tzPervasives.mli index f2f6b58f9..de7038eff 100644 --- a/src/lib_base/tzPervasives.mli +++ b/src/lib_base/tzPervasives.mli @@ -12,11 +12,7 @@ include (module type of (struct include Tezos_data_encoding end)) include (module type of (struct include Tezos_error_monad end)) include (module type of (struct include Tezos_rpc end)) include (module type of (struct include Tezos_clic end)) - -module Ed25519 = Ed25519 -module Crypto_box = Crypto_box -module Base58 = Tezos_crypto.Base58 -module Rand = Tezos_crypto.Rand +include (module type of (struct include Tezos_crypto end)) module List : sig include (module type of (struct include List end)) @@ -37,14 +33,6 @@ module Preapply_result = Preapply_result module Block_locator = Block_locator module Mempool = Mempool -module Chain_id = Chain_id -module Block_hash = Block_hash -module Operation_hash = Operation_hash -module Operation_list_hash = Operation_list_hash -module Operation_list_list_hash = Operation_list_list_hash -module Context_hash = Context_hash -module Protocol_hash = Protocol_hash - module P2p_addr = P2p_addr module P2p_identity = P2p_identity module P2p_peer = P2p_peer diff --git a/src/lib_crypto/base58.ml b/src/lib_crypto/base58.ml index 7cc5ec0dc..097b6d34f 100644 --- a/src/lib_crypto/base58.ml +++ b/src/lib_crypto/base58.ml @@ -144,6 +144,8 @@ type 'a encoding = { wrap: 'a -> data ; } +let prefix { prefix ; _ } = prefix + let simple_decode ?alphabet { prefix ; of_raw ; _ } s = safe_decode ?alphabet s |> Option.apply ~f:(TzString.remove_prefix ~prefix) |> diff --git a/src/lib_crypto/base58.mli b/src/lib_crypto/base58.mli index 59a6e99b5..b5dc281fe 100644 --- a/src/lib_crypto/base58.mli +++ b/src/lib_crypto/base58.mli @@ -131,3 +131,4 @@ val raw_decode: ?alphabet:Alphabet.t -> string -> string option val partial_decode: ?alphabet:Alphabet.t -> string -> int -> string option val make_encoded_prefix: string -> int -> string * int +val prefix: 'a encoding -> string diff --git a/src/lib_crypto/blake2B.ml b/src/lib_crypto/blake2B.ml index a44cdb2b3..9683f4f00 100644 --- a/src/lib_crypto/blake2B.ml +++ b/src/lib_crypto/blake2B.ml @@ -7,6 +7,8 @@ (* *) (**************************************************************************) +open Error_monad + (*-- Type specific Hash builder ---------------------------------------------*) module type Name = sig @@ -68,6 +70,11 @@ module Make_minimal (K : Name) = struct K.name (MBytes.length b) in raise (Invalid_argument msg) | Some h -> h + let of_bytes s = + match of_bytes_opt s with + | Some x -> Ok x + | None -> + generic_error "Failed to deserialize a hash (%s)" K.name let to_bytes (Blake2b.Hash h) = Cstruct.to_bigarray h let read src off = of_bytes_exn @@ MBytes.sub src off size @@ -106,7 +113,7 @@ module Make_minimal (K : Name) = struct and p3 = if len >= 6 then String.sub p 4 2 else "" and p4 = if len >= 8 then String.sub p 6 2 else "" and p5 = if len >= 10 then String.sub p 8 2 else "" - and p6 = if len > 10 then String.sub p 10 (len - 10) else "" in + and p6 = if len > 10 then String.sub p 10 (min (len - 10) (size * 2 - 10)) else "" in [ p1 ; p2 ; p3 ; p4 ; p5 ; p6 ] let zero = @@ -130,31 +137,43 @@ module Make (R : sig (* Serializers *) + let raw_encoding = + let open Data_encoding in + conv to_bytes of_bytes_exn (Fixed.bytes size) + + let hash = + if size >= 8 then + fun h -> Int64.to_int (MBytes.get_int64 (to_bytes h) 0) + else if size >= 4 then + fun h -> Int32.to_int (MBytes.get_int32 (to_bytes h) 0) + else + fun h -> + let r = ref 0 in + let h = to_bytes h in + for i = 0 to size - 1 do + r := MBytes.get_uint8 h i + 8 * !r + done ; + !r + type Base58.data += Hash of t let b58check_encoding = R.register_encoding ~prefix: K.b58check_prefix - ~length:size + ~length: size ~wrap: (fun s -> Hash s) - ~of_raw:(fun h -> of_string h) ~to_raw:to_string + ~of_raw: (fun h -> of_string h) ~to_raw:to_string - let of_b58check_opt s = - Base58.simple_decode b58check_encoding s - let of_b58check_exn s = - match Base58.simple_decode b58check_encoding s with - | Some x -> x - | None -> Format.kasprintf Pervasives.failwith "Unexpected hash (%s)" K.name - let to_b58check s = Base58.simple_encode b58check_encoding s - - let to_short_b58check s = - String.sub (to_b58check s) 0 (10 + 2 * String.length K.b58check_prefix) - - let pp ppf t = - Format.pp_print_string ppf (to_b58check t) - - let pp_short ppf t = - Format.pp_print_string ppf (to_short_b58check t) + include Hash.Make(struct + type nonrec t = t + let title = title + let name = name + let b58check_encoding = b58check_encoding + let raw_encoding = raw_encoding + let compare = compare + let equal = equal + let hash = hash + end) end @@ -275,6 +294,29 @@ module Make_merkle_tree let node x y = hash_bytes [to_bytes x; to_bytes y] end) + let path_encoding = + let open Data_encoding in + mu "path" + (fun path_encoding -> + union [ + case (Tag 240) + (obj2 + (req "path" path_encoding) + (req "right" encoding)) + (function Left (p, r) -> Some (p, r) | _ -> None) + (fun (p, r) -> Left (p, r)) ; + case (Tag 15) + (obj2 + (req "left" encoding) + (req "path" path_encoding)) + (function Right (r, p) -> Some (r, p) | _ -> None) + (fun (r, p) -> Right (r, p)) ; + case (Tag 0) + unit + (function Op -> Some () | _ -> None) + (fun () -> Op) + ]) + end include diff --git a/src/lib_base/block_hash.ml b/src/lib_crypto/block_hash.ml similarity index 79% rename from src/lib_base/block_hash.ml rename to src/lib_crypto/block_hash.ml index 055da0dc7..85bca9c64 100644 --- a/src/lib_base/block_hash.ml +++ b/src/lib_crypto/block_hash.ml @@ -7,12 +7,12 @@ (* *) (**************************************************************************) -include Blake2B.Make (Tezos_crypto.Base58) (struct +include Blake2B.Make (Base58) (struct let name = "Block_hash" let title = "A Tezos block ID" - let b58check_prefix = Tezos_crypto.Base58.Prefix.block_hash + let b58check_prefix = Base58.Prefix.block_hash let size = None end) let () = - Tezos_crypto.Base58.check_encoded_prefix b58check_encoding "B" 51 + Base58.check_encoded_prefix b58check_encoding "B" 51 diff --git a/src/lib_base/block_hash.mli b/src/lib_crypto/block_hash.mli similarity index 96% rename from src/lib_base/block_hash.mli rename to src/lib_crypto/block_hash.mli index 92f5c99bf..f7841dc59 100644 --- a/src/lib_base/block_hash.mli +++ b/src/lib_crypto/block_hash.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -include S.INTERNAL_HASH +include S.HASH diff --git a/src/lib_crypto/chain_id.ml b/src/lib_crypto/chain_id.ml new file mode 100644 index 000000000..bd679fc63 --- /dev/null +++ b/src/lib_crypto/chain_id.ml @@ -0,0 +1,114 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Error_monad + +type t = string + +let name = "Chain_id" +let title = "Network identifier" + +let extract bh = + MBytes.substring (Block_hash.to_bytes bh) 0 4 +let hash_bytes ?key l = extract (Block_hash.hash_bytes ?key l) +let hash_string ?key l = extract (Block_hash.hash_string ?key l) + +let size = 4 + +let compare = String.compare +let equal = String.equal + +let of_string s = + if String.length s <> size then None else Some s +let of_string_exn s = + match of_string s with + | None -> + let msg = + Printf.sprintf "%s.of_string: wrong string size (%d)" + name (String.length s) in + raise (Invalid_argument msg) + | Some h -> h + +let to_string s = s +let of_hex s = of_string (Hex.to_string (`Hex s)) +let of_hex_exn s = of_string_exn (Hex.to_string (`Hex s)) +let to_hex s = + let `Hex s = Hex.of_string (to_string s) in + s + + +let of_bytes_opt b = + if MBytes.length b <> size then + None + else + Some (MBytes.to_string b) +let of_bytes_exn b = + match of_bytes_opt b with + | None -> + let msg = + Printf.sprintf "%s.of_bytes: wrong string size (%d)" + name (MBytes.length b) in + raise (Invalid_argument msg) + | Some h -> h +let of_bytes s = + match of_bytes_opt s with + | Some x -> Ok x + | None -> + generic_error "Failed to deserialize a hash (%s)" name +let to_bytes = MBytes.of_string + +let read src off = of_bytes_exn @@ MBytes.sub src off size +let write dst off h = MBytes.blit (to_bytes h) 0 dst off size + +let path_length = 1 +let to_path key l = to_hex key :: l +let of_path path = + let path = String.concat "" path in + of_hex path +let of_path_exn path = + let path = String.concat "" path in + of_hex_exn path + +let prefix_path p = + let `Hex p = Hex.of_string p in + [ p ] + +let zero = + match of_hex (String.make (size * 2) '0') with + | Some c -> c + | None -> assert false + +type Base58.data += Hash of t + +let b58check_encoding = + Base58.register_encoding + ~prefix: Base58.Prefix.chain_id + ~length: size + ~wrap: (fun s -> Hash s) + ~of_raw:of_string ~to_raw: (fun h -> h) + +let raw_encoding = + let open Data_encoding in + conv to_bytes of_bytes_exn (Fixed.bytes size) + +let hash h = + Int32.to_int (MBytes.get_int32 (to_bytes h) 0) + +let of_block_hash bh = hash_bytes [Block_hash.to_bytes bh] + +include Hash.Make(struct + type nonrec t = t + let title = title + let name = name + let b58check_encoding = b58check_encoding + let raw_encoding = raw_encoding + let compare = compare + let equal = equal + let hash = hash + end) diff --git a/src/lib_base/chain_id.mli b/src/lib_crypto/chain_id.mli similarity index 96% rename from src/lib_base/chain_id.mli rename to src/lib_crypto/chain_id.mli index 659841cd4..23d90d9c2 100644 --- a/src/lib_base/chain_id.mli +++ b/src/lib_crypto/chain_id.mli @@ -7,6 +7,6 @@ (* *) (**************************************************************************) -include S.INTERNAL_HASH +include S.HASH val of_block_hash: Block_hash.t -> t diff --git a/src/lib_base/context_hash.ml b/src/lib_crypto/context_hash.ml similarity index 79% rename from src/lib_base/context_hash.ml rename to src/lib_crypto/context_hash.ml index 51c9c821c..5a4c06550 100644 --- a/src/lib_base/context_hash.ml +++ b/src/lib_crypto/context_hash.ml @@ -7,12 +7,12 @@ (* *) (**************************************************************************) -include Blake2B.Make (Tezos_crypto.Base58) (struct +include Blake2B.Make (Base58) (struct let name = "Context_hash" let title = "A hash of context" - let b58check_prefix = Tezos_crypto.Base58.Prefix.context_hash + let b58check_prefix = Base58.Prefix.context_hash let size = None end) let () = - Tezos_crypto.Base58.check_encoded_prefix b58check_encoding "Co" 52 + Base58.check_encoded_prefix b58check_encoding "Co" 52 diff --git a/src/lib_base/context_hash.mli b/src/lib_crypto/context_hash.mli similarity index 96% rename from src/lib_base/context_hash.mli rename to src/lib_crypto/context_hash.mli index 92f5c99bf..f7841dc59 100644 --- a/src/lib_base/context_hash.mli +++ b/src/lib_crypto/context_hash.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -include S.INTERNAL_HASH +include S.HASH diff --git a/src/lib_crypto/crypto_box.ml b/src/lib_crypto/crypto_box.ml index 0e2861823..cf5edcc47 100644 --- a/src/lib_crypto/crypto_box.ml +++ b/src/lib_crypto/crypto_box.ml @@ -157,3 +157,25 @@ let secret_key_size = Box.skbytes let nonce_to_bigarray x = Cstruct.to_bigarray (Nonce.to_cstruct x) let nonce_of_bigarray x = Nonce.of_cstruct_exn (Cstruct.of_bigarray x) let nonce_size = Nonce.bytes + +let public_key_encoding = + let open Data_encoding in + conv + public_key_to_bigarray + public_key_of_bigarray + (Fixed.bytes public_key_size) + +let secret_key_encoding = + let open Data_encoding in + conv + secret_key_to_bigarray + secret_key_of_bigarray + (Fixed.bytes secret_key_size) + +let nonce_encoding = + let open Data_encoding in + conv + nonce_to_bigarray + nonce_of_bigarray + (Fixed.bytes nonce_size) + diff --git a/src/lib_crypto/crypto_box.mli b/src/lib_crypto/crypto_box.mli index c3f0f1542..21499d4f3 100644 --- a/src/lib_crypto/crypto_box.mli +++ b/src/lib_crypto/crypto_box.mli @@ -75,3 +75,7 @@ val secret_key_size : int val nonce_to_bigarray : nonce -> Cstruct.buffer val nonce_of_bigarray : Cstruct.buffer -> nonce val nonce_size : int + +val public_key_encoding : public_key Data_encoding.t +val secret_key_encoding : secret_key Data_encoding.t +val nonce_encoding : nonce Data_encoding.t diff --git a/src/lib_crypto/ed25519.ml b/src/lib_crypto/ed25519.ml index 7a6968c28..d7bde6e63 100644 --- a/src/lib_crypto/ed25519.ml +++ b/src/lib_crypto/ed25519.ml @@ -78,6 +78,37 @@ module Public_key = struct Public_key_hash.hash_bytes [ Cstruct.to_bigarray (Sign.to_cstruct v) ] + let encoding = + let open Data_encoding in + splitted + ~json: + (describe + ~title: "An Ed25519 public key (Tezos_crypto.Base58Check encoded)" @@ + conv + (fun s -> to_b58check s) + (fun s -> + match of_b58check_opt s with + | Some x -> x + | None -> Data_encoding.Json.cannot_destruct + "Ed25519 public key: unexpected prefix.") + string) + ~binary: + (conv + to_bytes + of_bytes_exn + (Fixed.bytes size)) + let of_b58check s = + match of_b58check_opt s with + | Some x -> Ok x + | None -> + Error_monad.generic_error + "Failed to read a base58-encoded Ed25519 public key" + let param + ?(name="ed25519-public") + ?(desc="Ed25519 public key (b58check-encoded)") t = + Clic.(param ~name ~desc + (parameter (fun _ str -> Lwt.return (of_b58check str))) t) + end module Secret_key = struct @@ -142,6 +173,37 @@ module Secret_key = struct Base58.check_encoded_prefix seed_encoding "edsk" 54 ; Base58.check_encoded_prefix secret_key_encoding "edsk" 98 + let encoding = + let open Data_encoding in + splitted + ~json: + (describe + ~title: "An Ed25519 secret key (Tezos_crypto.Base58Check encoded)" @@ + conv + (fun s -> to_b58check s) + (fun s -> + match of_b58check_opt s with + | Some x -> x + | None -> Data_encoding.Json.cannot_destruct + "Ed25519 secret key: unexpected prefix.") + string) + ~binary: + (conv + to_bytes + of_bytes_exn + (Fixed.bytes size)) + let of_b58check s = + match of_b58check_opt s with + | Some x -> Ok x + | None -> + Error_monad.generic_error + "Failed to read a base58-encoded Ed25519 secret key" + let param + ?(name="ed25519-secret") + ?(desc="Ed25519 secret key (b58check-encoded)") t = + Clic.(param ~name ~desc + (parameter (fun _ str -> Lwt.return (of_b58check str))) t) + end let sign key msg = @@ -198,6 +260,36 @@ module Signature = struct let concat msg signature = MBytes.concat msg signature + let encoding = + let open Data_encoding in + splitted + ~json: + (describe + ~title: "An Ed25519 signature (Base58Check encoded)" @@ + conv + (fun s -> to_b58check s) + (fun s -> + match of_b58check_opt s with + | Some x -> x + | None -> Data_encoding.Json.cannot_destruct + "Ed25519 signature: unexpected prefix.") + string) + ~binary: + (conv + to_bytes + of_bytes_exn + (Fixed.bytes size)) + let of_b58check s = + match of_b58check_opt s with + | Some x -> Ok x + | None -> + Error_monad.generic_error + "Failed to read a base58-encoded Ed25519 signature" + let param + ?(name="ed25519-signature") + ?(desc="Ed25519 signature (b58check-encoded)") t = + Clic.(param ~name ~desc + (parameter (fun _ str -> Lwt.return (of_b58check str))) t) end module Seed = struct diff --git a/src/lib_crypto/ed25519.mli b/src/lib_crypto/ed25519.mli index 1dcee47cc..55f16ad05 100644 --- a/src/lib_crypto/ed25519.mli +++ b/src/lib_crypto/ed25519.mli @@ -9,6 +9,8 @@ (** Tezos - Ed25519 cryptography *) +open Error_monad + (** {2 Hashed public keys for user ID} ***************************************) module Public_key_hash : S.HASH @@ -27,6 +29,7 @@ module Public_key : sig val of_b58check_exn: string -> t val of_b58check_opt: string -> t option + val of_b58check: string -> t tzresult val to_b58check: t -> string val to_hex: t -> Hex.t @@ -39,6 +42,13 @@ module Public_key : sig val size: int + val encoding: t Data_encoding.t + val param: + ?name:string -> + ?desc:string -> + ('a, 'b) Clic.params -> + (t -> 'a, 'b) Clic.params + end module Secret_key : sig @@ -53,6 +63,7 @@ module Secret_key : sig val of_b58check_exn: string -> t val of_b58check_opt: string -> t option + val of_b58check: string -> t tzresult val to_b58check: t -> string val of_bytes_exn: MBytes.t -> t @@ -61,6 +72,13 @@ module Secret_key : sig val size: int + val encoding: t Data_encoding.t + val param: + ?name:string -> + ?desc:string -> + ('a, 'b) Clic.params -> + (t -> 'a, 'b) Clic.params + end module Signature : sig @@ -73,12 +91,20 @@ module Signature : sig val of_b58check_exn: string -> t val of_b58check_opt: string -> t option + val of_b58check: string -> t tzresult val to_b58check: t -> string val of_bytes_exn: MBytes.t -> t val of_bytes_opt: MBytes.t -> t option val to_bytes: t -> MBytes.t + val encoding: t Data_encoding.t + val param: + ?name:string -> + ?desc:string -> + ('a, 'b) Clic.params -> + (t -> 'a, 'b) Clic.params + val size: int val zero: t diff --git a/src/lib_crypto/hash.ml b/src/lib_crypto/hash.ml new file mode 100644 index 000000000..0f2c52967 --- /dev/null +++ b/src/lib_crypto/hash.ml @@ -0,0 +1,115 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module Make(H : sig + type t + val title: string + val name: string + val b58check_encoding: t Base58.encoding + val raw_encoding: t Data_encoding.t + val compare: t -> t -> int + val equal: t -> t -> bool + val hash: t -> int + end) = struct + + let of_b58check_opt s = + Base58.simple_decode H.b58check_encoding s + let of_b58check_exn s = + match Base58.simple_decode H.b58check_encoding s with + | Some x -> x + | None -> Format.kasprintf Pervasives.failwith "Unexpected hash (%s)" H.name + let of_b58check s = + match of_b58check_opt s with + | Some x -> Ok x + | None -> + Error_monad.generic_error "Failed to read a base58-encoded hash (%s)" H.name + let to_b58check s = Base58.simple_encode H.b58check_encoding s + let to_short_b58check s = + String.sub + (to_b58check s) 0 + (10 + String.length (Base58.prefix H.b58check_encoding)) + + let pp ppf t = + Format.pp_print_string ppf (to_b58check t) + + let pp_short ppf t = + Format.pp_print_string ppf (to_short_b58check t) + + let encoding = + let open Data_encoding in + splitted + ~binary: + H.raw_encoding + ~json: + (describe ~title: (H.title ^ " (Base58Check-encoded Blake2B hash)") @@ + conv to_b58check (Data_encoding.Json.wrap_error of_b58check_exn) string) + + let rpc_arg = + RPC_arg.make + ~name:(Format.asprintf "hash.%s" H.name) + ~descr:(Format.asprintf "A b58check-encoded hash (%s)" H.name) + ~destruct: + (fun s -> + match of_b58check_opt s with + | None -> + Error (Format.asprintf + "failed to decode b58check-encoded hash (%s): %S" + H.name s) + | Some v -> Ok v) + ~construct:to_b58check + () + + let param ?(name=H.name) ?(desc=H.title) t = + Clic.param + ~name + ~desc (Clic.parameter (fun _ str -> Lwt.return (of_b58check str))) t + + module Set = struct + include Set.Make(struct type t = H.t let compare = H.compare end) + exception Found of elt + let random_elt s = + let n = Random.int (cardinal s) in + try + ignore + (fold (fun x i -> if i = n then raise (Found x) ; i+1) s 0 : int) ; + assert false + with Found x -> x + let encoding = + Data_encoding.conv + elements + (fun l -> List.fold_left (fun m x -> add x m) empty l) + Data_encoding.(list encoding) + end + + module Table = struct + include Hashtbl.Make(struct + type t = H.t + let hash = H.hash + let equal = H.equal + end) + let encoding arg_encoding = + Data_encoding.conv + (fun h -> fold (fun k v l -> (k, v) :: l) h []) + (fun l -> + let h = create (List.length l) in + List.iter (fun (k,v) -> add h k v) l ; + h) + Data_encoding.(list (tup2 encoding arg_encoding)) + end + + module Map = struct + include Map.Make(struct type t = H.t let compare = H.compare end) + let encoding arg_encoding = + Data_encoding.conv + bindings + (fun l -> List.fold_left (fun m (k,v) -> add k v m) empty l) + Data_encoding.(list (tup2 encoding arg_encoding)) + end + +end diff --git a/src/lib_crypto/jbuild b/src/lib_crypto/jbuild index d29306340..61cd0260f 100644 --- a/src/lib_crypto/jbuild +++ b/src/lib_crypto/jbuild @@ -4,8 +4,16 @@ ((name tezos_crypto) (public_name tezos-crypto) (flags (:standard -safe-string - -open Tezos_stdlib)) + -open Tezos_stdlib + -open Tezos_data_encoding + -open Tezos_error_monad + -open Tezos_rpc + -open Tezos_clic)) (libraries (tezos-stdlib + tezos-data-encoding + tezos-error-monad + tezos-rpc + tezos-clic lwt nocrypto blake2 diff --git a/src/lib_base/operation_hash.ml b/src/lib_crypto/operation_hash.ml similarity index 79% rename from src/lib_base/operation_hash.ml rename to src/lib_crypto/operation_hash.ml index e99507434..9d42ab52c 100644 --- a/src/lib_base/operation_hash.ml +++ b/src/lib_crypto/operation_hash.ml @@ -7,13 +7,13 @@ (* *) (**************************************************************************) -include Blake2B.Make (Tezos_crypto.Base58) (struct +include Blake2B.Make (Base58) (struct let name = "Operation_hash" let title = "A Tezos operation ID" - let b58check_prefix = Tezos_crypto.Base58.Prefix.operation_hash + let b58check_prefix = Base58.Prefix.operation_hash let size = None end) let () = - Tezos_crypto.Base58.check_encoded_prefix b58check_encoding "o" 51 + Base58.check_encoded_prefix b58check_encoding "o" 51 diff --git a/src/lib_base/operation_hash.mli b/src/lib_crypto/operation_hash.mli similarity index 96% rename from src/lib_base/operation_hash.mli rename to src/lib_crypto/operation_hash.mli index 92f5c99bf..f7841dc59 100644 --- a/src/lib_base/operation_hash.mli +++ b/src/lib_crypto/operation_hash.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -include S.INTERNAL_HASH +include S.HASH diff --git a/src/lib_base/operation_list_hash.ml b/src/lib_crypto/operation_list_hash.ml similarity index 78% rename from src/lib_base/operation_list_hash.ml rename to src/lib_crypto/operation_list_hash.ml index 9aae4c1ec..bffdaa7b9 100644 --- a/src/lib_base/operation_list_hash.ml +++ b/src/lib_crypto/operation_list_hash.ml @@ -7,12 +7,12 @@ (* *) (**************************************************************************) -include Blake2B.Make_merkle_tree (Tezos_crypto.Base58) (struct +include Blake2B.Make_merkle_tree (Base58) (struct let name = "Operation_list_hash" let title = "A list of operations" - let b58check_prefix = Tezos_crypto.Base58.Prefix.operation_list_hash + let b58check_prefix = Base58.Prefix.operation_list_hash let size = None end) (Operation_hash) let () = - Tezos_crypto.Base58.check_encoded_prefix b58check_encoding "Lo" 52 + Base58.check_encoded_prefix b58check_encoding "Lo" 52 diff --git a/src/lib_base/operation_list_hash.mli b/src/lib_crypto/operation_list_hash.mli similarity index 90% rename from src/lib_base/operation_list_hash.mli rename to src/lib_crypto/operation_list_hash.mli index 78b9a364b..45e38cdec 100644 --- a/src/lib_base/operation_list_hash.mli +++ b/src/lib_crypto/operation_list_hash.mli @@ -7,5 +7,5 @@ (* *) (**************************************************************************) -include S.INTERNAL_MERKLE_TREE with type elt = Operation_hash.t +include S.MERKLE_TREE with type elt = Operation_hash.t diff --git a/src/lib_base/operation_list_list_hash.ml b/src/lib_crypto/operation_list_list_hash.ml similarity index 78% rename from src/lib_base/operation_list_list_hash.ml rename to src/lib_crypto/operation_list_list_hash.ml index 96b340657..c80d68e69 100644 --- a/src/lib_base/operation_list_list_hash.ml +++ b/src/lib_crypto/operation_list_list_hash.ml @@ -7,12 +7,12 @@ (* *) (**************************************************************************) -include Blake2B.Make_merkle_tree (Tezos_crypto.Base58) (struct +include Blake2B.Make_merkle_tree (Base58) (struct let name = "Operation_list_list_hash" let title = "A list of list of operations" - let b58check_prefix = Tezos_crypto.Base58.Prefix.operation_list_list_hash + let b58check_prefix = Base58.Prefix.operation_list_list_hash let size = None end) (Operation_list_hash) let () = - Tezos_crypto.Base58.check_encoded_prefix b58check_encoding "LLo" 53 ; + Base58.check_encoded_prefix b58check_encoding "LLo" 53 ; diff --git a/src/lib_base/operation_list_list_hash.mli b/src/lib_crypto/operation_list_list_hash.mli similarity index 89% rename from src/lib_base/operation_list_list_hash.mli rename to src/lib_crypto/operation_list_list_hash.mli index fecb4916b..c67523fcb 100644 --- a/src/lib_base/operation_list_list_hash.mli +++ b/src/lib_crypto/operation_list_list_hash.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -include S.INTERNAL_MERKLE_TREE with type elt = Operation_list_hash.t +include S.MERKLE_TREE with type elt = Operation_list_hash.t diff --git a/src/lib_base/protocol_hash.ml b/src/lib_crypto/protocol_hash.ml similarity index 79% rename from src/lib_base/protocol_hash.ml rename to src/lib_crypto/protocol_hash.ml index 88c865fb7..b7c303309 100644 --- a/src/lib_base/protocol_hash.ml +++ b/src/lib_crypto/protocol_hash.ml @@ -7,13 +7,13 @@ (* *) (**************************************************************************) -include Blake2B.Make (Tezos_crypto.Base58) (struct +include Blake2B.Make (Base58) (struct let name = "Protocol_hash" let title = "A Tezos protocol ID" - let b58check_prefix = Tezos_crypto.Base58.Prefix.protocol_hash + let b58check_prefix = Base58.Prefix.protocol_hash let size = None end) let () = - Tezos_crypto.Base58.check_encoded_prefix b58check_encoding "P" 51 + Base58.check_encoded_prefix b58check_encoding "P" 51 diff --git a/src/lib_base/protocol_hash.mli b/src/lib_crypto/protocol_hash.mli similarity index 96% rename from src/lib_base/protocol_hash.mli rename to src/lib_crypto/protocol_hash.mli index 92f5c99bf..f7841dc59 100644 --- a/src/lib_base/protocol_hash.mli +++ b/src/lib_crypto/protocol_hash.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -include S.INTERNAL_HASH +include S.HASH diff --git a/src/lib_crypto/s.ml b/src/lib_crypto/s.ml index 1d143b82e..372bb5bcb 100644 --- a/src/lib_crypto/s.ml +++ b/src/lib_crypto/s.ml @@ -7,6 +7,7 @@ (* *) (**************************************************************************) +open Error_monad (** {2 Hash Types} ************************************************************) @@ -59,9 +60,11 @@ module type HASH = sig include MINIMAL_HASH + val of_bytes: Cstruct.buffer -> t tzresult val to_b58check: t -> string val to_short_b58check: t -> string + val of_b58check: string -> t tzresult val of_b58check_exn: string -> t val of_b58check_opt: string -> t option @@ -71,6 +74,31 @@ module type HASH = sig val pp: Format.formatter -> t -> unit val pp_short: Format.formatter -> t -> unit + val encoding: t Data_encoding.t + val rpc_arg: t RPC_arg.t + + val param: + ?name:string -> + ?desc:string -> + ('a, 'arg) Clic.params -> + (t -> 'a, 'arg) Clic.params + + module Set : sig + include Set.S with type elt = t + val random_elt: t -> elt + val encoding: t Data_encoding.t + end + + module Map : sig + include Map.S with type key = t + val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t + end + + module Table : sig + include Hashtbl.S with type key = t + val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t + end + end module type MERKLE_TREE = sig @@ -88,6 +116,8 @@ module type MERKLE_TREE = sig | Right of t * path | Op + val path_encoding: path Data_encoding.t + val compute_path: elt list -> int -> path val check_path: path -> elt -> t * int diff --git a/src/lib_protocol_compiler/main_embedded_packer.ml b/src/lib_protocol_compiler/main_embedded_packer.ml index d836e7243..80adbe051 100644 --- a/src/lib_protocol_compiler/main_embedded_packer.ml +++ b/src/lib_protocol_compiler/main_embedded_packer.ml @@ -21,7 +21,7 @@ let () = Format.printf {| module Source = struct let hash = - Some (Tezos_base.Protocol_hash.of_b58check_exn %S) + Some (Tezos_crypto.Protocol_hash.of_b58check_exn %S) let sources = Tezos_base.Protocol.%a end @.|} diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml index dfae8f796..292e46634 100644 --- a/src/lib_protocol_environment/tezos_protocol_environment.ml +++ b/src/lib_protocol_environment/tezos_protocol_environment.ml @@ -188,7 +188,94 @@ module Make (Context : CONTEXT) = struct module Data_encoding = Data_encoding module Time = Time module Ed25519 = Ed25519 - module S = Tezos_base.S + module S = struct + module type T = Tezos_base.S.T + module type HASHABLE = Tezos_base.S.HASHABLE + module type MINIMAL_HASH = sig + + type t + + val name: string + val title: string + + val hash_bytes: ?key:MBytes.t -> MBytes.t list -> t + val hash_string: ?key:string -> string list -> t + val size: int (* in bytes *) + val compare: t -> t -> int + val equal: t -> t -> bool + + val to_hex: t -> string + val of_hex: string -> t option + val of_hex_exn: string -> t + + val to_string: t -> string + val of_string: string -> t option + val of_string_exn: string -> t + + val to_bytes: t -> MBytes.t + val of_bytes_opt: MBytes.t -> t option + val of_bytes_exn: MBytes.t -> t + + val read: MBytes.t -> int -> t + val write: MBytes.t -> int -> t -> unit + + val to_path: t -> string list -> string list + val of_path: string list -> t option + val of_path_exn: string list -> t + + val prefix_path: string -> string list + val path_length: int + + val zero: t + + end + module type SET = Tezos_base.S.SET + module type MAP = Tezos_base.S.MAP + module type HASH = sig + + include MINIMAL_HASH + + val encoding: t Data_encoding.t + + val to_b58check: t -> string + val to_short_b58check: t -> string + type Base58.data += Hash of t + val b58check_encoding: t Base58.encoding + + val of_b58check_exn: string -> t + val of_b58check_opt: string -> t option + + val pp: Format.formatter -> t -> unit + val pp_short: Format.formatter -> t -> unit + + val rpc_arg: t RPC_arg.t + + module Set : sig + include SET with type elt = t + val encoding: t Data_encoding.t + end + + module Map : sig + include MAP with type key = t + val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t + end + + end + + module type MERKLE_TREE = sig + type elt + include HASH + val compute: elt list -> t + val empty: t + type path = + | Left of path * t + | Right of t * path + | Op + val compute_path: elt list -> int -> path + val check_path: path -> elt -> t * int + val path_encoding: path Data_encoding.t + end + end module Error_monad = struct type 'a shell_tzresult = 'a Error_monad.tzresult type shell_error = Error_monad.error = .. @@ -225,7 +312,7 @@ module Make (Context : CONTEXT) = struct module Operation_list_list_hash = Operation_list_list_hash module Context_hash = Context_hash module Protocol_hash = Protocol_hash - module Blake2B = Tezos_base.Blake2B + module Blake2B = Blake2B module Fitness = Fitness module Operation = Operation module Block_header = Block_header diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli index 2610bae2b..b12e90613 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli @@ -64,7 +64,7 @@ val sign : val main_of_proto : Helpers_account.t -> Tezos_base.Operation.shell_header -> - proto_operation -> (Main.operation * Tezos_base.Operation_hash.t) proto_tzresult + proto_operation -> (Main.operation * Operation_hash.t) proto_tzresult val apply_of_proto : Helpers_account.t option -> Tezos_base.Operation.shell_header ->