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

Merge branch 'master' into crypto-box

Browse Source
This commit is contained in:
Eitan Chatav 2016-11-16 17:09:24 -08:00
commit 65795dba2c
85 changed files with 1142 additions and 581 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/Makefile
View File

@ -12,7 +12,8 @@ all: ${TZCOMPILER} ${TZNODE} ${TZCLIENT}
## Protocol environment
############################################################################
PROTOCOL_ENV_INTFS := $(addprefix proto/environment/, \
PROTOCOL_ENV_INTFS := \
$(addprefix proto/environment/, \
pervasives.mli \
compare.mli \
\
@ -29,6 +30,8 @@ PROTOCOL_ENV_INTFS := $(addprefix proto/environment/, \
\
uri.mli \
data_encoding.mli \
error_monad.mli \
logging.mli \
time.mli \
base48.mli \
hash.mli \
@ -39,10 +42,7 @@ PROTOCOL_ENV_INTFS := $(addprefix proto/environment/, \
\
fitness.mli \
updater.mli \
) \
utils/logging.mli \
utils/error_monad_sig.ml \
utils/error_monad.mli
)
.INTERMEDIATE: node/updater/environment_gen
.SECONDARY: node/updater/proto_environment.mli
@ -73,9 +73,6 @@ clean::
EMBEDDED_PROTOCOL_LIB_CMIS := \
tmp/camlinternalFormatBasics.cmi \
utils/error_monad.cmi \
proto/environment/error_monad.mli \
proto/environment/logging.mli \
node/updater/proto_environment.cmi \
node/updater/register.cmi
@ -102,16 +99,15 @@ clean::
UTILS_LIB_INTFS := \
utils/mBytes.mli \
utils/utils.mli \
utils/base48.mli \
utils/hex_encode.mli \
utils/utils.mli \
utils/cli_entries.mli \
utils/compare.mli \
utils/data_encoding.mli \
utils/crypto_box.mli \
utils/time.mli \
utils/hash.mli \
utils/ed25519.mli \
utils/error_monad.mli \
utils/logging.mli \
utils/lwt_utils.mli \
@ -119,16 +115,15 @@ UTILS_LIB_INTFS := \
UTILS_LIB_IMPLS := \
utils/mBytes.ml \
utils/base48.ml \
utils/hex_encode.ml \
utils/utils.ml \
utils/hex_encode.ml \
utils/base48.ml \
utils/cli_entries.ml \
utils/compare.ml \
utils/data_encoding.ml \
utils/crypto_box.ml \
utils/time.ml \
utils/hash.ml \
utils/ed25519.ml \
utils/error_monad_sig.ml \
utils/error_monad.ml \
utils/logging.ml \
@ -320,7 +315,7 @@ proto/embedded_proto_%.cmxa: \
CLIENT_PROTO_INCLUDES := \
utils node/updater node/db node/net node/shell client \
$(shell ocamlfind query lwt ocplib-json-typed)
$(shell ocamlfind query lwt ocplib-json-typed sodium)
proto/client_embedded_proto_%.cmxa: \
${TZCOMPILER} \
@ -347,6 +342,7 @@ CLIENT_LIB_INTFS := \
client/client_version.mli \
client/client_node_rpcs.mli \
client/client_generic_rpcs.mli \
client/client_helpers.mli \
client/client_aliases.mli \
client/client_keys.mli \
client/client_protocols.mli \
@ -356,6 +352,7 @@ CLIENT_LIB_IMPLS := \
client/client_config.ml \
client/client_node_rpcs.ml \
client/client_generic_rpcs.ml \
client/client_helpers.ml \
client/client_aliases.ml \
client/client_keys.ml \
client/client_protocols.ml \

38
src/client/client_helpers.ml Normal file
View File

@ -0,0 +1,38 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Client_config
let () =
let open Cli_entries in
register_group "helpers" "Various helpers"
let unique = ref false
let unique_arg =
"-unique",
Arg.Set unique,
"Fail when there is more than one possible completion."
let commands () = Cli_entries.[
command
~desc: "Lookup for the possible completion of a \
given prefix of Base48Check-encoded hash. This actually \
works only for blocks, operations, public key and contract \
identifiers."
~args: [unique_arg]
(prefixes [ "complete" ] @@ string "prefix" "the prefix of the Base48Check-encoded hash to be completed" @@ stop)
(fun prefix () ->
Client_node_rpcs.complete ~block:(block ()) prefix >>= fun completions ->
match completions with
| [] -> Pervasives.exit 3
| _ :: _ :: _ when !unique -> Pervasives.exit 3
| completions ->
List.iter print_endline completions ;
Lwt.return_unit)
]

10
src/client/client_helpers.mli Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
val commands: unit -> Cli_entries.command list

2
src/client/client_keys.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
module Ed25519 = Environment.Ed25519
module Public_key_hash = Client_aliases.Alias (struct
type t = Ed25519.Public_key_hash.t
let encoding = Ed25519.Public_key_hash.encoding

4
src/client/client_keys.mli
View File

@ -7,8 +7,10 @@
(* *)
(**************************************************************************)
module Ed25519 = Environment.Ed25519
module Public_key_hash : Client_aliases.Alias with type t = Ed25519.public_key_hash
module Public_key_hash :
Client_aliases.Alias with type t = Ed25519.Public_key_hash.t
module Public_key : Client_aliases.Alias with type t = Ed25519.public_key
module Secret_key : Client_aliases.Alias with type t = Ed25519.secret_key

8
src/client/client_node_rpcs.ml
View File

@ -150,6 +150,12 @@ let inject_operation ?(wait = true) ?force operation =
call_service0 Services.inject_operation (operation, wait, force)
let inject_protocol ?(wait = true) ?force protocol =
call_service0 Services.inject_protocol (protocol, wait, force)
let complete ?block prefix =
match block with
| None ->
call_service1 Services.complete prefix ()
| Some block ->
call_service2 Services.Blocks.complete block prefix ()
let describe ?recurse path =
let prefix, arg = RPC.forge_request Services.describe () recurse in
get_json (prefix @ path) arg >>=
@ -196,6 +202,8 @@ module Blocks = struct
call_service1 Services.Blocks.pending_operations block ()
let info ?(operations = false) h =
call_service1 Services.Blocks.info h operations
let complete block prefix =
call_service2 Services.Blocks.complete block prefix ()
let list ?operations ?length ?heads ?delay ?min_date ?min_heads () =
call_service0 Services.Blocks.list
{ operations; length ; heads ; monitor = Some false ; delay ;

2
src/client/client_node_rpcs.mli
View File

@ -104,6 +104,8 @@ module Protocols : sig
(Protocol_hash.t * Store.protocol option) list Lwt.t
end
val complete: ?block:Blocks.block -> string -> string list Lwt.t
val describe: ?recurse:bool -> string list -> RPC.Description.directory_descr Lwt.t
(** Low-level *)

1
src/client/embedded/bootstrap/client_proto_context.ml
View File

@ -11,6 +11,7 @@ open Client_proto_args
open Client_proto_contracts
open Client_proto_programs
open Client_keys
module Ed25519 = Environment.Ed25519
let handle_error f () =
f () >>= Client_proto_rpcs.handle_error

4
src/client/embedded/bootstrap/client_proto_contracts.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
module Ed25519 = Environment.Ed25519
module RawContractAlias = Client_aliases.Alias (struct
type t = Contract.t
let encoding = Contract.encoding
@ -101,7 +103,7 @@ let get_delegate block source =
let may_check_key sourcePubKey sourcePubKeyHash =
match sourcePubKey with
| Some sourcePubKey ->
if not (Ed25519.equal_hash (Ed25519.hash sourcePubKey) sourcePubKeyHash)
if not (Ed25519.Public_key_hash.equal (Ed25519.hash sourcePubKey) sourcePubKeyHash)
then
failwith "Invalid public key in `client_proto_endorsement`"
else

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

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

1
src/client/embedded/bootstrap/client_proto_programs.ml
View File

@ -7,6 +7,7 @@
(* *)
(**************************************************************************)
module Ed25519 = Environment.Ed25519
open Client_proto_args
let report_parse_error _prefix exn _lexbuf =

2
src/client/embedded/bootstrap/mining/client_mining_endorsement.ml
View File

@ -10,6 +10,8 @@
open Logging.Client.Endorsement
open Cli_entries
module Ed25519 = Environment.Ed25519
module State : sig
val get_endorsement:

1
src/client/embedded/bootstrap/mining/client_mining_forge.ml
View File

@ -8,6 +8,7 @@
(**************************************************************************)
open Logging.Client.Mining
module Ed25519 = Environment.Ed25519
let generate_proof_of_work_nonce () =
Sodium.Random.Bigbytes.generate Constants.proof_of_work_nonce_size

2
src/client/embedded/bootstrap/mining/client_mining_operations.ml
View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
module Ed25519 = Environment.Ed25519
open Logging.Client.Mining
open Operation

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

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

1
src/client_main.ml
View File

@ -31,6 +31,7 @@ let main () =
Client_generic_rpcs.commands @
Client_keys.commands () @
Client_protocols.commands () @
Client_helpers.commands () @
Client_version.commands_for_version version in
Client_config.parse_args ~version
(Cli_entries.usage commands)

3
src/compiler/embedded_cmis.mli
View File

@ -8,8 +8,5 @@
(**************************************************************************)
val camlinternalFormatBasics_cmi: string
val error_monad_cmi: string
val error_monad_mli: string
val logging_mli: string
val proto_environment_cmi: string
val register_cmi: string

59
src/compiler/tezos_compiler.ml
View File

@ -258,31 +258,38 @@ let link_shared ?(static=false) output objects =
let create_register_file client file hash packname modules =
let unit = List.hd (List.rev modules) in
let error_monad = packname ^ ".Local_error_monad.Error_monad" in
let environment_module = packname ^ ".Local_environment.Environment" in
let error_monad_module = environment_module ^ ".Error_monad" in
let context_module = environment_module ^ ".Context" in
let hash_module = environment_module ^ ".Hash" in
create_file file
(Printf.sprintf
"module Packed_protocol = struct\n\
\ let hash = (Hash.Protocol_hash.of_b48check %S)\n\
\ let hash = (%s.Protocol_hash.of_b48check %S)\n\
\ type error = %s.error = ..\n\
\ type 'a tzresult = 'a %s.tzresult\n\
\ include %s.%s\n\
\ let error_encoding = %s.error_encoding ()\n\
\ let classify_errors = %s.classify_errors\n\
\ let pp = %s.pp\n\
\ let complete_b48prefix = %s.complete
\ end\n\
\ %s\n\
"
hash_module
(Protocol_hash.to_b48check hash)
error_monad
error_monad
error_monad_module
error_monad_module
packname (String.capitalize_ascii unit)
error_monad
error_monad
error_monad
error_monad_module
error_monad_module
error_monad_module
context_module
(if client then
"include Register.Make(Packed_protocol)"
else
"let () = Register.register (module Packed_protocol : PACKED_PROTOCOL)"))
Printf.sprintf
"let () = Register.register (%s.__cast (module Packed_protocol : %s.PACKED_PROTOCOL))" environment_module environment_module))
let mktemp_dir () =
Filename.get_temp_dir_name () //
@ -391,44 +398,30 @@ let main () =
if keep_object then
create_file (build_dir // ".tezos_compiler") (md5 ^ "\n");
Compenv.implicit_modules :=
if client then [ "Environment" ] else [ "Proto_environment" ] ;
(* Compile the /ad-hoc/ Error_monad. *)
List.iter (dump_cmi sigs_dir) tezos_protocol_env ;
at_exit (fun () -> List.iter (unlink_cmi sigs_dir) tezos_protocol_env ) ;
let error_monad_unit = "local_error_monad" in
let error_monad_ml = build_dir // error_monad_unit ^ ".ml" in
create_file error_monad_ml @@ Printf.sprintf {|
module Error_monad = struct
type error_category = [ `Branch | `Temporary | `Permanent ]
include Error_monad.Make()
end
module Logging = Logging.Make(struct let name = %S end)
let local_environment_unit = "local_environment" in
let local_environment_ml = build_dir // local_environment_unit ^ ".ml" in
create_file local_environment_ml @@ Printf.sprintf {|
module Environment = %s.Make(struct let name = %S end)()
|}
(if client then "Environment" else "Proto_environment")
logname ;
let error_monad_mli = build_dir // error_monad_unit ^ ".mli" in
create_file error_monad_mli @@ Printf.sprintf {|
module Error_monad : sig %s end
module Logging : sig %s end
|}
Embedded_cmis.error_monad_mli
Embedded_cmis.logging_mli ;
if not keep_object then
at_exit (fun () ->
safe_unlink error_monad_mli ;
safe_unlink error_monad_ml) ;
let error_monad_object =
safe_unlink local_environment_ml) ;
let local_environment_object =
compile_units
~ctxt
~for_pack:packname
~keep_object
~build_dir ~source_dir:build_dir [error_monad_unit]
~build_dir ~source_dir:build_dir [local_environment_unit]
in
Compenv.implicit_modules :=
!Compenv.implicit_modules @
[ "Local_error_monad"; "Error_monad" ; "Hash" ; "Logging" ];
[ "Local_environment"; "Environment" ;
"Error_monad" ; "Hash" ; "Logging" ];
(* Compile the protocol *)
let objects =
@ -437,7 +430,7 @@ let main () =
~update_needed
~keep_object ~for_pack:packname ~build_dir ~source_dir units in
pack_objects ~ctxt ~keep_object
packed_objects (error_monad_object @ objects) ;
packed_objects (local_environment_object @ objects) ;
(* Compiler the 'registering module' *)
List.iter (dump_cmi sigs_dir) register_env;

6
src/node/db/context.ml
View File

@ -30,6 +30,7 @@ module rec S : sig
val update_path: t -> IrminPath.t -> v -> unit Lwt.t
val mem: v -> IrminPath.t -> bool Lwt.t
val dir_mem: v -> IrminPath.t -> bool Lwt.t
val get: v -> IrminPath.t -> MBytes.t option Lwt.t
val set: v -> IrminPath.t -> MBytes.t-> v Lwt.t
val del: v -> IrminPath.t -> v Lwt.t
@ -187,6 +188,11 @@ let mem (module View : VIEW) key =
GitStore.FunView.mem View.v (data_key key) >>= fun v ->
Lwt.return v
let dir_mem (module View : VIEW) key =
let module GitStore = View.Store in
GitStore.FunView.dir_mem View.v (data_key key) >>= fun v ->
Lwt.return v
let raw_get (module View : VIEW) key =
let module GitStore = View.Store in
GitStore.FunView.get View.v key >>= function

6
src/node/db/ir_funview.ml
View File

@ -466,6 +466,11 @@ module Make (S: Irmin.S) = struct
| None -> Lwt.return false
| _ -> Lwt.return true
let dir_mem t k =
sub t k >>= function
| Some _ -> Lwt.return true
| None -> Lwt.return false
let list_aux t path =
sub t path >>= function
| None -> Lwt.return []
@ -662,6 +667,7 @@ end
module type S = sig
include Irmin.RO
val dir_mem: t -> key -> bool Lwt.t
val update: t -> key -> value -> t Lwt.t
val remove: t -> key -> t Lwt.t
val list: t -> key -> key list Lwt.t

1
src/node/db/ir_funview.mli
View File

@ -9,6 +9,7 @@
module type S = sig
include Irmin.RO
val dir_mem: t -> key -> bool Lwt.t
val update: t -> key -> value -> t Lwt.t
val remove: t -> key -> t Lwt.t
val list: t -> key -> key list Lwt.t

38
src/node/db/persist.ml
View File

@ -19,12 +19,12 @@ type value = MBytes.t
module type STORE = sig
type t
val mem: t -> key -> bool Lwt.t
val dir_mem: t -> key -> bool Lwt.t
val get: t -> key -> value option Lwt.t
val set: t -> key -> value -> t Lwt.t
val del: t -> key -> t Lwt.t
val list: t -> key list -> key list Lwt.t
val remove_rec: t -> key -> t Lwt.t
val keys: t -> key list Lwt.t
end
@ -37,7 +37,6 @@ module type BYTES_STORE = sig
val del: t -> key -> t Lwt.t
val list: t -> key list -> key list Lwt.t
val remove_rec: t -> key -> t Lwt.t
val keys: t -> key list Lwt.t
end
@ -49,7 +48,6 @@ module type TYPED_STORE = sig
val get: t -> key -> value option Lwt.t
val set: t -> key -> value -> t Lwt.t
val del: t -> key -> t Lwt.t
val keys: t -> key list Lwt.t
end
@ -583,3 +581,37 @@ module MakeBufferedPersistentTypedMap
(Map : Map.S with type key = K.t)
=
MakeBufferedPersistentMap(S)(K)(TypedValue(T))(Map)
module MakeHashResolver
(Store : sig
type t
val dir_mem: t -> string list -> bool Lwt.t
val list: t -> string list list -> string list list Lwt.t
val prefix: string list
end)
(H: HASH) = struct
let plen = List.length Store.prefix
let build path =
H.of_path @@
Utils.remove_elem_from_list plen path
let resolve t p =
let rec loop prefix = function
| [] ->
Lwt.return [build prefix]
| "" :: ds ->
Store.list t [ prefix] >>= fun prefixes ->
Lwt_list.map_p (fun prefix -> loop prefix ds) prefixes
>|= List.flatten
| [d] ->
Store.list t [prefix] >>= fun prefixes ->
Lwt_list.filter_map_p (fun prefix ->
match remove_prefix d (List.hd (List.rev prefix)) with
| None -> Lwt.return_none
| Some _ -> Lwt.return (Some (build prefix))
) prefixes
| d :: ds ->
Store.dir_mem t (prefix @ [d]) >>= function
| true -> loop (prefix @ [d]) ds
| false -> Lwt.return_nil in
loop Store.prefix (H.prefix_path p)
end

13
src/node/db/persist.mli
View File

@ -22,12 +22,12 @@ type value = MBytes.t
module type STORE = sig
type t
val mem: t -> key -> bool Lwt.t
val dir_mem: t -> key -> bool Lwt.t
val get: t -> key -> value option Lwt.t
val set: t -> key -> value -> t Lwt.t
val del: t -> key -> t Lwt.t
val list: t -> key list -> key list Lwt.t
val remove_rec: t -> key -> t Lwt.t
val keys: t -> key list Lwt.t
end
@ -258,3 +258,14 @@ module MakeBufferedPersistentTypedMap
and type key := K.t
and type value := T.value
and module Map := Map
module MakeHashResolver
(Store : sig
type t
val dir_mem: t -> string list -> bool Lwt.t
val list: t -> string list list -> string list list Lwt.t
val prefix: string list
end)
(H: HASH) : sig
val resolve : Store.t -> string -> H.t list Lwt.t
end

33
src/node/db/store.ml
View File

@ -50,6 +50,14 @@ module FS = struct
let file = file_of_key root key in
Lwt.return (Sys.file_exists file && not (Sys.is_directory file))
let dir_mem root key =
let file = file_of_key root key in
Lwt.return (Sys.file_exists file && Sys.is_directory file)
let exists root key =
let file = file_of_key root key in
Sys.file_exists file
let get root key =
mem root key >>= function
| true ->
@ -135,6 +143,7 @@ end
module type IMPERATIVE_STORE = sig
type t
val mem: t -> key -> bool Lwt.t
val dir_mem: t -> key -> bool Lwt.t
val get: t -> key -> value option Lwt.t
val get_exn: t -> key -> value Lwt.t
val set: t -> key -> value -> unit Lwt.t
@ -206,6 +215,7 @@ module Make (K : KEY) (V : Persist.VALUE) = struct
type key = K.t
type value = V.t
let mem t k = FS.mem t (K.to_path k)
let dir_mem t k = FS.dir_mem t (K.to_path k)
let get t k =
FS.get t (K.to_path k) >|= function
| None -> None
@ -307,6 +317,14 @@ module Block_errors_key = struct
end
module Block_errors = Make (Block_errors_key) (Errors_value)
module Block_resolver =
Persist.MakeHashResolver
(struct
include FS
let prefix = ["blocks"]
end)
(Block_hash)
module Block = struct
type t = FS.t
type key = Block_hash.t
@ -458,6 +476,15 @@ module Operation_errors_key = struct
end
module Operation_errors = Make (Operation_errors_key) (Errors_value)
module Operation_resolver =
Persist.MakeHashResolver
(struct
include FS
let mem t k = Lwt.return (exists t k)
let prefix = ["operations"]
end)
(Operation_hash)
module Operation = struct
type t = FS.t
type key = Operation_hash.t
@ -715,6 +742,12 @@ let net_destroy ~root { net_genesis } =
let init root =
raw_init ~root:(Filename.concat root "global") () >>= fun t ->
Base48.register_resolver
Block_hash.b48check_encoding
(fun s -> Block_resolver.resolve t s);
Base48.register_resolver
Operation_hash.b48check_encoding
(fun s -> Operation_resolver.resolve t s);
Lwt.return
{ block = Persist.share t ;
blockchain = Persist.share t ;

1
src/node/db/store.mli
View File

@ -27,6 +27,7 @@ end
module type IMPERATIVE_STORE = sig
type t
val mem: t -> key -> bool Lwt.t
val dir_mem: t -> key -> bool Lwt.t
val get: t -> key -> value option Lwt.t
val get_exn: t -> key -> value Lwt.t
val set: t -> key -> value -> unit Lwt.t

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

@ -330,7 +330,7 @@ module RPC = struct
let prevalidation_hash =
Block_hash.of_b48check
"Et22nEeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
let get_net node = function
| `Head _ | `Prevalidation -> node.global_validator, node.global_net
@ -498,6 +498,20 @@ module RPC = struct
Proto.fitness ctxt >>= fun fitness ->
return (fitness, r)
let complete node ?block str =
match block with
| None ->
Base48.complete str
| Some block ->
get_context node block >>= function
| None -> Lwt.fail Not_found
| Some ctxt ->
Context.get_protocol ctxt >>= fun protocol_hash ->
let (module Proto) = Updater.get_exn protocol_hash in
Base48.complete str >>= fun l1 ->
Proto.complete_b48prefix ctxt str >>= fun l2 ->
Lwt.return (l1 @ l2)
let context_dir node block =
get_context node block >>= function
| None -> Lwt.return None

6
src/node/shell/node.mli
View File

@ -72,6 +72,12 @@ module RPC : sig
val validate: t -> State.net_id -> Block_hash.t -> unit tzresult Lwt.t
val context_dir:
t -> block -> 'a RPC.directory option Lwt.t
val complete:
t -> ?block:block -> string -> string list Lwt.t
end
val shutdown: t -> unit Lwt.t

8
src/node/shell/node_rpc.ml
View File

@ -434,6 +434,14 @@ let build_rpc_directory node =
let implementation () =
RPC.Answer.return Data_encoding.Json.(schema (Error_monad.error_encoding ())) in
RPC.register0 dir RPC.Error.service implementation in
let dir =
RPC.register1 dir Services.complete
(fun s () ->
Node.RPC.complete node s >>= RPC.Answer.return) in
let dir =
RPC.register2 dir Services.Blocks.complete
(fun block s () ->
Node.RPC.complete node ~block s >>= RPC.Answer.return) in
let dir =
RPC.register_describe_directory_service dir Services.describe in
dir

28
src/node/shell/node_rpc_services.ml
View File

@ -255,6 +255,19 @@ module Blocks = struct
~output: (RPC.Error.wrap preapply_result_encoding)
RPC.Path.(block_path / "preapply")
let complete =
let prefix_arg =
let destruct s = Ok s
and construct s = s in
RPC.Arg.make ~name:"prefix" ~destruct ~construct () in
RPC.service
~description: "Try to complete a prefix of a Base48Check-encoded data. \
This RPC is actually able to complete hashes of \
block, operations, public_keys and contracts."
~input: empty
~output: (list string)
RPC.Path.(block_path / "complete" /: prefix_arg )
type list_param = {
operations: bool option ;
length: int option ;
@ -329,6 +342,8 @@ module Blocks = struct
~output: (obj1 (req "blocks" (list (list block_info_encoding))))
RPC.Path.(root / "blocks")
end
module Operations = struct
@ -583,6 +598,19 @@ let inject_protocol =
(obj1 (req "injectedProtocol" Protocol_hash.encoding)))
RPC.Path.(root / "inject_protocol")
let complete =
let prefix_arg =
let destruct s = Ok s
and construct s = s in
RPC.Arg.make ~name:"prefix" ~destruct ~construct () in
RPC.service
~description: "Try to complete a prefix of a Base48Check-encoded data. \
This RPC is actually able to complete hashes of \
block and hashes of operations."
~input: empty
~output: (list string)
RPC.Path.(root / "complete" /: prefix_arg )
let describe =
RPC.Description.service
~description: "RPCs documentation and input/output schema"

4
src/node/shell/node_rpc_services.mli
View File

@ -80,6 +80,8 @@ module Blocks : sig
val preapply:
(unit, unit * block, preapply_param, preapply_result tzresult) RPC.service
val complete: (unit, (unit * block) * string, unit, string list) RPC.service
val proto_path: (unit, unit * block) RPC.Path.path
end
@ -132,5 +134,7 @@ val inject_protocol:
(unit, unit,
(Store.protocol * bool * bool option), Protocol_hash.t tzresult) RPC.service
val complete: (unit, unit * string, unit, string list) RPC.service
val describe:
(unit, unit, bool option, RPC.Description.directory_descr) RPC.service

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

@ -7,6 +7,128 @@
(* *)
(**************************************************************************)
module Ed25519 = struct
type secret_key = Sodium.Sign.secret_key
type public_key = Sodium.Sign.public_key
type signature = MBytes.t
let sign key msg =
Sodium.Sign.Bigbytes.(of_signature @@ sign_detached key msg)
let check_signature public_key signature msg =
try
Sodium.Sign.Bigbytes.(verify public_key (to_signature signature) msg) ;
true
with _ -> false
let append_signature key msg =
MBytes.concat msg (sign key msg)
module Public_key_hash = Hash.Make_SHA256(Base48)(struct
let name = "Ed25519.Public_key_hash"
let title = "An Ed25519 public key ID"
let b48check_prefix = Base48.Prefix.ed25519_public_key_hash
end)
let hash v =
Public_key_hash.hash_bytes
[ Sodium.Sign.Bigbytes.of_public_key v ]
let generate_key () =
let secret, pub = Sodium.Sign.random_keypair () in
(hash pub, pub, secret)
type Base48.data +=
| Public_key of public_key
| Secret_key of secret_key
| Signature of signature
let b48check_public_key_encoding =
Base48.register_encoding
~prefix: Base48.Prefix.ed25519_public_key
~to_raw:(fun x -> Bytes.to_string (Sodium.Sign.Bytes.of_public_key x))
~of_raw:(fun x ->
try Some (Sodium.Sign.Bytes.to_public_key (Bytes.of_string x))
with _ -> None)
~wrap:(fun x -> Public_key x)
let b48check_secret_key_encoding =
Base48.register_encoding
~prefix: Base48.Prefix.ed25519_secret_key
~to_raw:(fun x -> Bytes.to_string (Sodium.Sign.Bytes.of_secret_key x))
~of_raw:(fun x ->
try Some (Sodium.Sign.Bytes.to_secret_key (Bytes.of_string x))
with _ -> None)
~wrap:(fun x -> Secret_key x)
let b48check_signature_encoding =
Base48.register_encoding
~prefix: Base48.Prefix.ed25519_signature
~to_raw:MBytes.to_string
~of_raw:(fun s -> Some (MBytes.of_string s))
~wrap:(fun x -> Signature x)
let public_key_encoding =
let open Data_encoding in
splitted
~json:
(describe
~title: "An Ed25519 public key (Base48Check encoded)" @@
conv
(fun s -> Base48.simple_encode b48check_public_key_encoding s)
(fun s ->
match Base48.simple_decode b48check_public_key_encoding s with
| Some x -> x
| None -> Data_encoding.Json.cannot_destruct
"Ed25519 public key: unexpected prefix.")
string)
~binary:
(conv
Sodium.Sign.Bigbytes.of_public_key
Sodium.Sign.Bigbytes.to_public_key
bytes)
let secret_key_encoding =
let open Data_encoding in
splitted
~json:
(describe
~title: "An Ed25519 secret key (Base48Check encoded)" @@
conv
(fun s -> Base48.simple_encode b48check_secret_key_encoding s)
(fun s ->
match Base48.simple_decode b48check_secret_key_encoding s with
| Some x -> x
| None -> Data_encoding.Json.cannot_destruct
"Ed25519 secret key: unexpected prefix.")
string)
~binary:
(conv
Sodium.Sign.Bigbytes.of_secret_key
Sodium.Sign.Bigbytes.to_secret_key
bytes)
let signature_encoding =
let open Data_encoding in
splitted
~json:
(describe
~title: "An Ed25519 signature (Base48Check encoded)" @@
conv
(fun s -> Base48.simple_encode b48check_signature_encoding s)
(fun s ->
match Base48.simple_decode b48check_signature_encoding s with
| Some x -> x
| None -> Data_encoding.Json.cannot_destruct
"Ed25519 signature: unexpected prefix.")
string)
~binary: (Fixed.bytes 64)
end
module Make(Param : sig val name: string end)() = struct
include Pervasives
module Pervasives = Pervasives
module Compare = Compare
@ -29,20 +151,26 @@ module MBytes = MBytes
module Uri = Uri
module Data_encoding = Data_encoding
module Time = Time
module Base48 = Base48
module Hash = Hash
module Ed25519 = Ed25519
module Hash = Hash
module Persist = Persist
module Context = Context
module RPC = RPC
module Fitness = Fitness
module Updater = Updater
(* Internal usage *)
module Error_monad_sig = Error_monad_sig
module Error_monad = Error_monad
module Logging = Logging
module Error_monad = struct
type error_category = [ `Branch | `Temporary | `Permanent ]
include Error_monad.Make()
end
module Logging = Logging.Make(Param)
module Base48 = struct
include Base48
include Make(struct type context = Context.t end)
end
module Context = struct
include Context
let register_resolver = Base48.register_resolver
let complete = Base48.complete
end
module type PACKED_PROTOCOL = sig
val hash : Protocol_hash.t
@ -50,4 +178,8 @@ module type PACKED_PROTOCOL = sig
val error_encoding : error Data_encoding.t
val classify_errors : error list -> [ `Branch | `Temporary | `Permanent ]
val pp : Format.formatter -> error -> unit
val complete_b48prefix :
?alphabet:string -> Context.t -> string -> string list Lwt.t
end
end

12
src/node/updater/environment_gen.ml
View File

@ -21,6 +21,11 @@ let dump_file oc file =
let included = ["Pervasives"]
let () =
Printf.fprintf mli
"module Make(Param : sig val name: string end)() : sig\n"
let () =
for i = 2 to Array.length Sys.argv - 1 do
let file = Sys.argv.(i) in
@ -36,10 +41,12 @@ let () =
dump_file mli file;
Printf.fprintf mli "end\n";
if unit = "Result" then begin
Printf.fprintf mli "type ('a, 'b) result = ('a, 'b) Result.result = Ok of 'a | Error of 'b\n";
Printf.fprintf mli
"type ('a, 'b) result = ('a, 'b) Result.result = Ok of 'a | Error of 'b\n";
end;
done
let () =
Printf.fprintf mli {|
module type PACKED_PROTOCOL = sig
@ -48,9 +55,12 @@ module type PACKED_PROTOCOL = sig
val error_encoding : error Data_encoding.t
val classify_errors : error list -> [ `Branch | `Temporary | `Permanent ]
val pp : Format.formatter -> error -> unit
val complete_b48prefix :
?alphabet:string -> Context.t -> string -> string list Lwt.t
end
val __cast: (module PACKED_PROTOCOL) -> (module Protocol.PACKED_PROTOCOL)
|}
let () =
Printf.fprintf mli "end\n" ;
close_out mli

6
src/node/updater/proto_environment.ml
View File

@ -7,7 +7,11 @@
(* *)
(**************************************************************************)
include Environment
module Make(Param : sig val name: string end)() = struct
include Environment.Make(Param)()
let __cast (type error) (module X : PACKED_PROTOCOL) =
(module X : Protocol.PACKED_PROTOCOL)
end

2
src/node/updater/protocol.mli
View File

@ -135,4 +135,6 @@ module type PACKED_PROTOCOL = sig
val error_encoding : error Data_encoding.t
val classify_errors : error list -> [ `Branch | `Temporary | `Permanent ]
val pp : Format.formatter -> error -> unit
val complete_b48prefix :
?alphabet:string -> Context.t -> string -> string list Lwt.t
end

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

@ -29,8 +29,7 @@ module Make(Proto : Protocol.PACKED_PROTOCOL) = struct
(function ecoerrors -> Ecoproto_error ecoerrors)
end
let register proto =
let module Proto = (val Proto_environment.__cast proto) in
let register (module Proto : Protocol.PACKED_PROTOCOL) =
let module V = struct
include Proto
include Make(Proto)

2
src/node/updater/register.mli
View File

@ -12,4 +12,4 @@ module Make(Proto : Protocol.PACKED_PROTOCOL) : sig
val wrap_error: 'a Proto.tzresult -> 'a tzresult
end
val register: (module Proto_environment.PACKED_PROTOCOL) -> unit
val register: (module Protocol.PACKED_PROTOCOL) -> unit

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

@ -16,6 +16,8 @@ module type REGISTRED_PROTOCOL = sig
val hash: Protocol_hash.t
include Protocol.PROTOCOL with type error := error
and type 'a tzresult := 'a tzresult
val complete_b48prefix :
?alphabet:string -> Context.t -> string -> string list Lwt.t
end
type net_id = Store.net_id = Net of Block_hash.t

2
src/node/updater/updater.mli
View File

@ -68,6 +68,8 @@ module type REGISTRED_PROTOCOL = sig
(* exception Ecoproto_error of error list *)
include Protocol.PROTOCOL with type error := error
and type 'a tzresult := 'a tzresult
val complete_b48prefix :
?alphabet:string -> Context.t -> string -> string list Lwt.t
end
type component = Tezos_compiler.Protocol.component = {

6
src/node_main.ml
View File

@ -12,15 +12,15 @@ open Logging.Node.Main
let genesis_block =
Block_hash.of_b48check
"qBeeesNtMrdyRDj6hSK2PxEN9R67brGSm64EFRjJSBTTqLcQCRHNR"
"eeHfgnr9QeDNvcMgSfATNeDeec4KG4CkHHkNNJt5B9xdVmsxhsHNR"
let genesis_protocol =
Protocol_hash.of_b48check
"TnrnfGHMCPAcxtMAHXdpfebbnn2XvPAxq7DHbpeJbKTkJQPgcgRGr"
"4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg"
let test_protocol =
Some (Protocol_hash.of_b48check
"JF7Fxgeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee")
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK")
let genesis_time =
Time.of_notation_exn "2016-08-01T00:00:00Z"

4
src/proto/bootstrap/.merlin
View File

@ -1,9 +1,9 @@
B ../../node/updater/
B _tzbuild
FLG -nopervasives
FLG -open Proto_environment
FLG -open Local_environment
FLG -open Environment
FLG -open Hash
FLG -open Local_error_monad
FLG -open Error_monad
FLG -open Logging
FLG -w -40

4
src/proto/bootstrap/TEZOS_PROTOCOL
View File

@ -1,8 +1,10 @@
{
"hash": "TnrnfGHMCPAcxtMAHXdpfebbnn2XvPAxq7DHbpeJbKTkJQPgcgRGr",
"hash": "4prgmSgbaeMKbgLtLjpsHaDD9QvG2dbC2bLq2XBmyxd2RJgLFpcAg",
"modules": [
"Misc",
"Tezos_hash",
"Qty_repr",
"Tez_repr",
"Period_repr",

6
src/proto/bootstrap/asset_repr.ml
View File

@ -22,10 +22,10 @@ let encoding =
module Map = struct
module Raw = Map.Make(struct
type t = asset * Ed25519.public_key_hash
type t = asset * Ed25519.Public_key_hash.t
let compare (a1, pk1) (a2, pk2) =
if Compare.Int32.(a1 = a2) then
Ed25519.compare_hash pk1 pk2
Ed25519.Public_key_hash.compare pk1 pk2
else
Compare.Int32.compare a1 a2
end)
@ -54,7 +54,7 @@ let encoding =
(Json.wrap_error of_tuple_list_exn)
(list
(tup2
(tup2 encoding Ed25519.public_key_hash_encoding)
(tup2 encoding Ed25519.Public_key_hash.encoding)
Tez_repr.encoding)))
end

2
src/proto/bootstrap/asset_repr.mli
View File

@ -17,6 +17,6 @@ module Map : sig
type t
val empty: t
val add:
t -> asset -> Ed25519.public_key_hash -> Tez_repr.tez -> t tzresult
t -> asset -> Ed25519.Public_key_hash.t -> Tez_repr.tez -> t tzresult
val encoding: t Data_encoding.t
end

4
src/proto/bootstrap/bootstrap_storage.ml
View File

@ -8,7 +8,7 @@
(**************************************************************************)
type account = {
public_key_hash : Ed25519.public_key_hash ;
public_key_hash : Ed25519.Public_key_hash.t ;
public_key : Ed25519.public_key ;
secret_key : Ed25519.secret_key ;
}
@ -94,7 +94,7 @@ let account_encoding =
(fun (public_key_hash, public_key, secret_key) ->
{ public_key_hash ; public_key ; secret_key })
(obj3
(req "publicKeyHash" Ed25519.public_key_hash_encoding)
(req "publicKeyHash" Ed25519.Public_key_hash.encoding)
(req "publicKey" Ed25519.public_key_encoding)
(req "secretKey" Ed25519.secret_key_encoding))

2
src/proto/bootstrap/bootstrap_storage.mli
View File

@ -8,7 +8,7 @@
(**************************************************************************)
type account = {
public_key_hash : Ed25519.public_key_hash ;
public_key_hash : Ed25519.Public_key_hash.t ;
public_key : Ed25519.public_key ;
secret_key : Ed25519.secret_key ;
}

22
src/proto/bootstrap/contract_repr.ml
View File

@ -10,15 +10,15 @@
open Tezos_hash
type descr = {
manager: Ed25519.public_key_hash ;
delegate: Ed25519.public_key_hash option ;
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
spendable: bool ;
delegatable: bool ;
script: Script_repr.t ;
}
type t =
| Default of Ed25519.public_key_hash
| Default of Ed25519.Public_key_hash.t
| Hash of Contract_hash.t
type contract = t
@ -29,12 +29,10 @@ let to_b48check = function
| Hash h -> Contract_hash.to_b48check h
let of_b48check s =
try
match Base48.decode s with
| Ed25519.Public_key_hash.Hash h -> ok (Default h)
| Contract_hash.Hash h -> ok (Hash h)
| Some (Ed25519.Public_key_hash.Hash h) -> ok (Default h)
| Some (Contract_hash.Hash h) -> ok (Hash h)
| _ -> error (Invalid_contract_notation s)
with _ -> error (Invalid_contract_notation s)
let encoding =
let open Data_encoding in
@ -50,7 +48,7 @@ let encoding =
splitted
~binary:
(union ~tag_size:`Uint8 [
case ~tag:0 Ed25519.public_key_hash_encoding
case ~tag:0 Ed25519.Public_key_hash.encoding
(function Default k -> Some k | _ -> None)
(fun k -> Default k) ;
case ~tag:1 Contract_hash.encoding
@ -96,8 +94,8 @@ let descr_encoding =
(fun (manager, delegate, spendable, delegatable, script) ->
{ manager; delegate; spendable; delegatable; script })
(obj5
(req "manager" Ed25519.public_key_hash_encoding)
(opt "delegate" Ed25519.public_key_hash_encoding)
(req "manager" Ed25519.Public_key_hash.encoding)
(opt "delegate" Ed25519.Public_key_hash.encoding)
(dft "spendable" bool false)
(dft "delegatable" bool false)
(req "script" Script_repr.encoding))
@ -105,7 +103,7 @@ let descr_encoding =
let generic_contract ~manager ~delegate ~spendable ~delegatable ~script =
match delegate, spendable, delegatable, script with
| Some delegate, true, false, Script_repr.No_script
when Ed25519.equal_hash manager delegate ->
when Ed25519.Public_key_hash.equal manager delegate ->
default_contract manager
| _ ->
let data =
@ -130,7 +128,7 @@ let arg =
let compare l1 l2 =
match l1, l2 with
| Default pkh1, Default pkh2 ->
Ed25519.compare_hash pkh1 pkh2
Ed25519.Public_key_hash.compare pkh1 pkh2
| Hash h1, Hash h2 ->
Contract_hash.compare h1 h2
| Default _, Hash _ -> -1

14
src/proto/bootstrap/contract_repr.mli
View File

@ -10,13 +10,13 @@
open Tezos_hash
type t = private
| Default of Ed25519.public_key_hash
| Default of Ed25519.Public_key_hash.t
| Hash of Contract_hash.t
type contract = t
type descr = {
manager: Ed25519.public_key_hash ;
delegate: Ed25519.public_key_hash option ;
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
spendable: bool ;
delegatable: bool ;
script: Script_repr.t ;
@ -24,13 +24,13 @@ type descr = {
include Compare.S with type t := contract
val default_contract : Ed25519.public_key_hash -> contract
val default_contract : Ed25519.Public_key_hash.t -> contract
val is_default : contract -> Ed25519.public_key_hash option
val is_default : contract -> Ed25519.Public_key_hash.t option
val generic_contract :
manager:Ed25519.public_key_hash ->
delegate:Ed25519.public_key_hash option ->
manager:Ed25519.Public_key_hash.t ->
delegate:Ed25519.Public_key_hash.t option ->
spendable:bool ->
delegatable:bool ->
script:Script_repr.t ->

14
src/proto/bootstrap/contract_storage.mli
View File

@ -33,9 +33,9 @@ val is_delegatable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t
val is_spendable : Storage.t -> Contract_repr.t -> bool tzresult Lwt.t
val get_descr: Storage.t -> Contract_repr.t -> Contract_repr.descr tzresult Lwt.t
val get_manager: Storage.t -> Contract_repr.t -> Ed25519.public_key_hash tzresult Lwt.t
val get_delegate: Storage.t -> Contract_repr.t -> Ed25519.public_key_hash tzresult Lwt.t
val get_delegate_opt: Storage.t -> Contract_repr.t -> Ed25519.public_key_hash option tzresult Lwt.t
val get_manager: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t
val get_delegate: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t tzresult Lwt.t
val get_delegate_opt: Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option tzresult Lwt.t
val get_balance: Storage.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
val get_assets: Storage.t -> Contract_repr.t -> Asset_repr.Map.t tzresult Lwt.t
val get_counter: Storage.t -> Contract_repr.t -> int32 tzresult Lwt.t
@ -49,7 +49,7 @@ val update_script_storage: Storage.t -> Contract_repr.t -> Script_repr.expr ->
Storage.t tzresult Lwt.t
(** fails if the contract is not delegatable *)
val set_delegate : Storage.t -> Contract_repr.t -> Ed25519.public_key_hash option -> Storage.t tzresult Lwt.t
val set_delegate : Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option -> Storage.t tzresult Lwt.t
val credit : Storage.t -> Contract_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
@ -60,14 +60,14 @@ val spend : Storage.t -> Contract_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt
val unconditional_spend : Storage.t -> Contract_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
val issue :
Storage.t -> Contract_repr.t -> Asset_repr.t -> Ed25519.public_key_hash -> Tez_repr.t -> Storage.t tzresult Lwt.t
Storage.t -> Contract_repr.t -> Asset_repr.t -> Ed25519.Public_key_hash.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
val originate :
Storage.t ->
balance:Tez_repr.t ->
manager:Ed25519.public_key_hash ->
manager:Ed25519.Public_key_hash.t ->
script:Script_repr.t ->
delegate:Ed25519.public_key_hash option ->
delegate:Ed25519.Public_key_hash.t option ->
spendable:bool ->
delegatable:bool ->
(Storage.t * Contract_repr.t) tzresult Lwt.t

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

@ -55,7 +55,7 @@ let reveal c level nonce =
type status = Storage.Seed.nonce_status =
| Unrevealed of {
nonce_hash: Tezos_hash.Nonce_hash.t ;
delegate_to_reward: Ed25519.public_key_hash ;
delegate_to_reward: Ed25519.Public_key_hash.t ;
reward_amount: Tez_repr.t ;
}
| Revealed of nonce

6
src/proto/bootstrap/nonce_storage.mli
View File

@ -21,17 +21,17 @@ val encoding: nonce Data_encoding.t
val record_hash:
Storage.t ->
Ed25519.public_key_hash -> Tez_repr.t ->
Ed25519.Public_key_hash.t -> Tez_repr.t ->
Nonce_hash.t -> Storage.t tzresult Lwt.t
val reveal:
Storage.t -> Level_repr.t -> nonce ->
(Storage.t * Ed25519.public_key_hash * Tez_repr.t) tzresult Lwt.t
(Storage.t * Ed25519.Public_key_hash.t * Tez_repr.t) tzresult Lwt.t
type status =
| Unrevealed of {
nonce_hash: Tezos_hash.Nonce_hash.t ;
delegate_to_reward: Ed25519.public_key_hash ;
delegate_to_reward: Ed25519.Public_key_hash.t ;
reward_amount: Tez_repr.t ;
}
| Revealed of nonce

16
src/proto/bootstrap/operation_repr.ml
View File

@ -46,18 +46,18 @@ and manager_operation =
destination: Contract_repr.contract ;
}
| Origination of {
manager: Ed25519.public_key_hash ;
delegate: Ed25519.public_key_hash option ;
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
script: Script_repr.t ;
spendable: bool ;
delegatable: bool ;
credit: Tez_repr.tez ;
}
| Issuance of {
asset: Asset_repr.asset * Ed25519.public_key_hash ;
asset: Asset_repr.asset * Ed25519.Public_key_hash.t ;
amount: Tez_repr.tez ;
}
| Delegation of Ed25519.public_key_hash option
| Delegation of Ed25519.Public_key_hash.t option
and delegate_operation =
| Endorsement of {
@ -99,11 +99,11 @@ module Encoding = struct
let origination_encoding =
(obj7
(req "kind" (constant "origination"))
(req "managerPubkey" Ed25519.public_key_hash_encoding)
(req "managerPubkey" Ed25519.Public_key_hash.encoding)
(req "balance" Tez_repr.encoding)
(opt "spendable" bool)
(opt "delegatable" bool)
(opt "delegate" Ed25519.public_key_hash_encoding)
(opt "delegate" Ed25519.Public_key_hash.encoding)
(req "script" Script_repr.encoding))
let origination_case tag =
@ -125,7 +125,7 @@ module Encoding = struct
let issuance_encoding =
(obj3
(req "kind" (constant "issuance"))
(req "asset" (tup2 Asset_repr.encoding Ed25519.public_key_hash_encoding))
(req "asset" (tup2 Asset_repr.encoding Ed25519.Public_key_hash.encoding))
(req "quantity" Tez_repr.encoding))
let issuance_case tag =
@ -138,7 +138,7 @@ module Encoding = struct
let delegation_encoding =
(obj2
(req "kind" (constant "delegation"))
(opt "delegate" Ed25519.public_key_hash_encoding))
(opt "delegate" Ed25519.Public_key_hash.encoding))
let delegation_case tag =
case ~tag delegation_encoding

8
src/proto/bootstrap/operation_repr.mli
View File

@ -46,18 +46,18 @@ and manager_operation =
destination: Contract_repr.contract ;
}
| Origination of {
manager: Ed25519.public_key_hash ;
delegate: Ed25519.public_key_hash option ;
manager: Ed25519.Public_key_hash.t ;
delegate: Ed25519.Public_key_hash.t option ;
script: Script_repr.t ;
spendable: bool ;
delegatable: bool ;
credit: Tez_repr.tez ;
}
| Issuance of {
asset: Asset_repr.t * Ed25519.public_key_hash ;
asset: Asset_repr.t * Ed25519.Public_key_hash.t ;
amount: Tez_repr.tez ;
}
| Delegation of Ed25519.public_key_hash option
| Delegation of Ed25519.Public_key_hash.t option
and delegate_operation =
| Endorsement of {

4
src/proto/bootstrap/reward_storage.mli
View File

@ -8,10 +8,10 @@
(**************************************************************************)
val record:
Storage.t -> Ed25519.public_key_hash -> Cycle_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
Storage.t -> Ed25519.Public_key_hash.t -> Cycle_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
val discard:
Storage.t -> Ed25519.public_key_hash -> Cycle_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
Storage.t -> Ed25519.Public_key_hash.t -> Cycle_repr.t -> Tez_repr.t -> Storage.t tzresult Lwt.t
val pay_due_rewards: Storage.t -> Storage.t tzresult Lwt.t

6
src/proto/bootstrap/roll_storage.mli
View File

@ -36,11 +36,11 @@ val clear_cycle :
val mining_rights_owner :
Storage.t -> Level_repr.t -> priority:int32 ->
Ed25519.public_key_hash tzresult Lwt.t
Ed25519.Public_key_hash.t tzresult Lwt.t
val endorsement_rights_owner :
Storage.t -> Level_repr.t -> slot:int ->
Ed25519.public_key_hash tzresult Lwt.t
Ed25519.Public_key_hash.t tzresult Lwt.t
module Contract : sig
@ -60,4 +60,4 @@ end
(**/**)
val get_contract_delegate:
Storage.t -> Contract_repr.t -> Ed25519.public_key_hash option tzresult Lwt.t
Storage.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option tzresult Lwt.t

22
src/proto/bootstrap/services.ml
View File

@ -191,7 +191,7 @@ module Context = struct
let pk_encoding =
(obj2
(req "hash" Ed25519.public_key_hash_encoding)
(req "hash" Ed25519.Public_key_hash.encoding)
(req "public_key" Ed25519.public_key_encoding))
let list custom_root =
@ -225,14 +225,14 @@ module Context = struct
RPC.service
~description: "Access the manager of a contract."
~input: empty
~output: (wrap_tzerror Ed25519.public_key_hash_encoding)
~output: (wrap_tzerror Ed25519.Public_key_hash.encoding)
RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "manager")
let delegate custom_root =
RPC.service
~description: "Access the delegate of a contract, if any."
~input: empty
~output: (wrap_tzerror (option Ed25519.public_key_hash_encoding))
~output: (wrap_tzerror (option Ed25519.Public_key_hash.encoding))
RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "delegate")
let counter custom_root =
@ -292,12 +292,12 @@ module Context = struct
(fun (manager,balance,spendable,delegate,script,assets,counter) ->
{manager;balance;spendable;delegate;script;assets;counter}) @@
obj7
(req "manager" Ed25519.public_key_hash_encoding)
(req "manager" Ed25519.Public_key_hash.encoding)
(req "balance" Tez.encoding)
(req "spendable" bool)
(req "delegate" @@ obj2
(req "setable" bool)
(opt "value" Ed25519.public_key_hash_encoding))
(opt "value" Ed25519.Public_key_hash.encoding))
(dft "script" Script.encoding No_script)
(req "assets" Asset.Map.encoding)
(req "counter" int32))
@ -404,7 +404,7 @@ module Helpers = struct
(req "mining_rights"
(list
(obj2
(req "delegate" Ed25519.public_key_hash_encoding)
(req "delegate" Ed25519.Public_key_hash.encoding)
(req "timestamp" Timestamp.encoding)))))
RPC.Path.(custom_root / "helpers" / "rights" / "mining")
@ -418,7 +418,7 @@ module Helpers = struct
obj2
(req "level" Raw_level.encoding)
(req "delegates"
(list Ed25519.public_key_hash_encoding)))
(list Ed25519.Public_key_hash.encoding)))
RPC.Path.(custom_root / "helpers" / "rights"
/ "mining" / "level" /: Raw_level.arg )
@ -447,7 +447,7 @@ module Helpers = struct
~input: empty
~output: (wrap_tzerror @@
obj1 (req "delegates"
(list Ed25519.public_key_hash_encoding)))
(list Ed25519.Public_key_hash.encoding)))
RPC.Path.(custom_root / "helpers" / "rights"
/ "mining" / "delegate" )
@ -460,7 +460,7 @@ module Helpers = struct
obj2
(req "level" Raw_level.encoding)
(req "delegates"
(list Ed25519.public_key_hash_encoding)))
(list Ed25519.Public_key_hash.encoding)))
RPC.Path.(custom_root / "helpers" / "rights" / "endorsement")
let endorsement_rights_for_level custom_root =
@ -472,7 +472,7 @@ module Helpers = struct
obj2
(req "level" Raw_level.encoding)
(req "delegates"
(list Ed25519.public_key_hash_encoding)))
(list Ed25519.Public_key_hash.encoding)))
RPC.Path.(custom_root / "helpers" / "rights"
/ "endorsement" / "level" /: Raw_level.arg )
@ -501,7 +501,7 @@ module Helpers = struct
~input: empty
~output: (wrap_tzerror @@
obj1 (req "delegates"
(list Ed25519.public_key_hash_encoding)))
(list Ed25519.Public_key_hash.encoding)))
RPC.Path.(custom_root / "helpers" / "rights"
/ "endorsement" / "delegate" )

43
src/proto/bootstrap/storage.ml
View File

@ -60,6 +60,8 @@ module Key = struct
let next_cycle_to_be_rewarded = store_root ["next_cycle_to_be_rewarded"]
let rewards = store_root ["rewards"]
let public_keys = ["public_keys" ; "ed25519"]
module Roll = struct
let store_root l = store_root ("rolls" :: l)
let next = store_root [ "next" ]
@ -86,15 +88,17 @@ module Key = struct
end
module Contract = struct
let store_root l = store_root ("contracts" :: l)
let set = store_root ["set"]
let pubkey_contract l = store_root ("pubkey" :: l)
let generic_contract l = store_root ("generic" :: l)
let contract_store c l =
store_root @@
match c with
| Contract_repr.Default k ->
"pubkey" :: Ed25519.hash_path k @ l
pubkey_contract @@ Ed25519.Public_key_hash.to_path k @ l
| Contract_repr.Hash h ->
"generic" :: Contract_hash.to_path h @ l
generic_contract @@ Contract_hash.to_path h @ l
let roll_list c = contract_store c ["roll_list"]
let change c = contract_store c ["change"]
let balance c = contract_store c ["balance"]
@ -197,10 +201,10 @@ module Roll = struct
module Owner_for_cycle =
Make_indexed_data_storage(struct
type key = Cycle_repr.t * Roll_repr.t
type value = Ed25519.public_key_hash
type value = Ed25519.Public_key_hash.t
let name = "roll owner for current cycle"
let key = Key.Cycle.roll_owner
let encoding = Ed25519.public_key_hash_encoding
let encoding = Ed25519.Public_key_hash.encoding
end)
module Contract_roll_list =
@ -235,6 +239,7 @@ module Contract = struct
let encoding = Data_encoding.int32
end)
(** FIXME REMOVE : use 'list' *)
module Set =
Make_data_set_storage(struct
type value = Contract_repr.t
@ -266,10 +271,10 @@ module Contract = struct
module Manager =
Make_indexed_data_storage(struct
type key = Contract_repr.t
type value = Ed25519.public_key_hash
type value = Ed25519.Public_key_hash.t
let name = "contract manager"
let key = Key.Contract.manager
let encoding = Ed25519.public_key_hash_encoding
let encoding = Ed25519.Public_key_hash.encoding
end)
module Spendable =
@ -293,10 +298,10 @@ module Contract = struct
module Delegate =
Make_indexed_data_storage(struct
type key = Contract_repr.t
type value = Ed25519.public_key_hash
type value = Ed25519.Public_key_hash.t
let name = "contract delegate"
let key = Key.Contract.delegate
let encoding = Ed25519.public_key_hash_encoding
let encoding = Ed25519.Public_key_hash.encoding
end)
module Counter =
@ -376,7 +381,7 @@ module Vote = struct
module Proposals =
Make_data_set_storage
(struct
type value = Protocol_hash.t * Ed25519.public_key_hash
type value = Protocol_hash.t * Ed25519.Public_key_hash.t
let name = "proposals"
let encoding =
Data_encoding.tup2
@ -401,7 +406,7 @@ module Public_key =
Make_iterable_data_storage (Ed25519.Public_key_hash)
(struct
type value = Ed25519.public_key
let key = ["public_keys"]
let key = Key.public_keys
let name = "public keys"
let encoding = Ed25519.public_key_encoding
end)
@ -413,7 +418,7 @@ module Seed = struct
type nonce_status =
| Unrevealed of {
nonce_hash: Tezos_hash.Nonce_hash.t ;
delegate_to_reward: Ed25519.public_key_hash ;
delegate_to_reward: Ed25519.Public_key_hash.t ;
reward_amount: Tez_repr.t ;
}
| Revealed of Seed_repr.nonce
@ -482,7 +487,7 @@ module Rewards = struct
module Amount =
Raw_make_iterable_data_storage(struct
type t = Ed25519.public_key_hash * Cycle_repr.t
type t = Ed25519.Public_key_hash.t * Cycle_repr.t
let prefix = Key.rewards
let length = Ed25519.Public_key_hash.path_len + 1
let to_path (pkh, c) =
@ -515,3 +520,15 @@ let fork_test_network (c, constants) =
Updater.fork_test_network c >>= fun c -> Lwt.return (c, constants)
let set_test_protocol (c, constants) h =
Updater.set_test_protocol c h >>= fun c -> Lwt.return (c, constants)
(** Resolver *)
let () =
Storage_functors.register_resolvers
(module Contract_hash)
[ Key.Contract.generic_contract [] ] ;
Storage_functors.register_resolvers
(module Ed25519.Public_key_hash)
[ Key.Contract.pubkey_contract [] ;
Key.public_keys ]

18
src/proto/bootstrap/storage.mli
View File

@ -109,7 +109,7 @@ module Roll : sig
module Owner_for_cycle : Indexed_data_storage
with type key = Cycle_repr.t * Roll_repr.t
and type value = Ed25519.public_key_hash
and type value = Ed25519.Public_key_hash.t
and type context := t
end
@ -144,13 +144,13 @@ module Contract : sig
(** The manager of a contract *)
module Manager : Indexed_data_storage
with type key = Contract_repr.t
and type value = Ed25519.public_key_hash
and type value = Ed25519.Public_key_hash.t
and type context := t
(** The delegate of a contract, if any. *)
module Delegate : Indexed_data_storage
with type key = Contract_repr.t
and type value = Ed25519.public_key_hash
and type value = Ed25519.Public_key_hash.t
and type context := t
module Spendable : Indexed_data_storage
@ -201,16 +201,16 @@ module Vote : sig
and type context := t
module Listings : Iterable_data_storage
with type key = Ed25519.public_key_hash
with type key = Ed25519.Public_key_hash.t
and type value = int32 (* number of rolls for the key. *)
and type context := t
module Proposals : Data_set_storage
with type value = Protocol_hash.t * Ed25519.public_key_hash
with type value = Protocol_hash.t * Ed25519.Public_key_hash.t
and type context := t
module Ballots : Iterable_data_storage
with type key = Ed25519.public_key_hash
with type key = Ed25519.Public_key_hash.t
and type value = Vote_repr.ballot
and type context := t
@ -220,7 +220,7 @@ end
(** Keys *)
module Public_key : Iterable_data_storage
with type key = Ed25519.public_key_hash
with type key = Ed25519.Public_key_hash.t
and type value = Ed25519.public_key
and type context := t
@ -234,7 +234,7 @@ module Seed : sig
type nonce_status =
| Unrevealed of {
nonce_hash: Tezos_hash.Nonce_hash.t ;
delegate_to_reward: Ed25519.public_key_hash ;
delegate_to_reward: Ed25519.Public_key_hash.t ;
reward_amount: Tez_repr.t ;
}
| Revealed of Seed_repr.nonce
@ -266,7 +266,7 @@ module Rewards : sig
and type context := t
module Amount : Iterable_data_storage
with type key = Ed25519.public_key_hash * Cycle_repr.t
with type key = Ed25519.Public_key_hash.t * Cycle_repr.t
and type value = Tez_repr.t
and type context := t

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

@ -202,10 +202,9 @@ end
module Make_data_set_storage (P : Single_data_description) = struct
module Key = struct
include Hash.Make_SHA256(struct
include Hash.Make_minimal_SHA256(struct
let name = P.name
let title = ("A " ^ P.name ^ "key")
let prefix = None
end)
let prefix = P.key
let length = path_len
@ -352,3 +351,31 @@ module Make_iterable_data_storage (H: HASH) (P: Single_data_description) =
let prefix = P.key
let length = path_len
end)(P)
let register_resolvers (module H : Hash.HASH) prefixes =
let module Set = Hash_set(H) in
let resolvers =
List.map
(fun prefix ->
let module R = Persist.MakeHashResolver(struct
include Context
let prefix = prefix
end)(H) in
R.resolve)
prefixes in
let resolve c m =
match resolvers with
| [resolve] -> resolve c m
| resolvers ->
Lwt_list.map_p (fun resolve -> resolve c m) resolvers >|= fun hs ->
List.fold_left
(fun acc hs -> List.fold_left (fun acc h -> Set.add h acc) acc hs)
Set.empty hs |>
Set.elements in
Context.register_resolver H.b48check_encoding resolve

2
src/proto/bootstrap/storage_functors.mli
View File

@ -98,3 +98,5 @@ module Raw_make_iterable_data_storage (K: Persist.KEY) (P: Data_description) :
and type value = P.value
and type context := context
val register_resolvers: (module Hash.HASH) -> string list list -> unit

7
src/proto/bootstrap/storage_helpers.mli
View File

@ -227,3 +227,10 @@ module Make_data_set_storage (P : Single_data_description) :
module Make_iterable_data_storage (H : HASH) (P: Single_data_description) :
Iterable_data_storage with type key = H.t and type value = P.value
module Make_hash_resolver
(K: sig val prefix: string list end)
(H: Hash.HASH) : sig
val register : Store.t -> unit
end

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

@ -39,7 +39,7 @@ module Script_int = Script_int_repr
module Script = Script_repr
type public_key = Ed25519.public_key
type public_key_hash = Ed25519.public_key_hash
type public_key_hash = Ed25519.Public_key_hash.t
type secret_key = Ed25519.secret_key
type signature = Ed25519.signature

2
src/proto/bootstrap/tezos_context.mli
View File

@ -26,7 +26,7 @@ module Nonce_hash_set = Tezos_hash.Nonce_hash_set
module Nonce_hash_map = Tezos_hash.Nonce_hash_map
type public_key = Ed25519.public_key
type public_key_hash = Ed25519.public_key_hash
type public_key_hash = Ed25519.Public_key_hash.t
type secret_key = Ed25519.secret_key
type signature = Ed25519.signature

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

@ -8,42 +8,44 @@
(**************************************************************************)
module Prefix = struct
let random_state_hash = Base48.Prefix.protocol_prefix ^ "\001"
let nonce_hash = Base48.Prefix.protocol_prefix ^ "\002"
let script_expr_hash = Base48.Prefix.protocol_prefix ^ "\003"
let proposition_hash = Base48.Prefix.protocol_prefix ^ "\004"
let contract_hash = Base48.Prefix.protocol_prefix ^ "\005"
let make x =
assert (Compare.String.(Base48.Prefix.protocol_prefix = "\015")) ;
String.make 1 (char_of_int ((x lsl 4) lor 15))
let public_key_hash = make 0
let contract_hash = make 1
let nonce_hash = make 2
let script_expr_hash = make 3
let random_state_hash = make 15 (* never used... *)
end
module State_hash = Hash.Make_SHA256(struct
module State_hash = Hash.Make_SHA256(Base48)(struct
let name = "random"
let title = "A random generation state"
let prefix = Some Prefix.random_state_hash
let b48check_prefix = Prefix.random_state_hash
end)
module State_hash_set = Hash_set(State_hash)
module State_hash_map = Hash_map(State_hash)
module Nonce_hash = Hash.Make_SHA256(struct
module Nonce_hash = Hash.Make_SHA256(Base48)(struct
let name = "cycle_nonce"
let title = "A nonce hash"
let prefix = Some Prefix.nonce_hash
let b48check_prefix = Prefix.nonce_hash
end)
module Nonce_hash_set = Hash_set(Nonce_hash)
module Nonce_hash_map = Hash_map(Nonce_hash)
module Script_expr_hash = Hash.Make_SHA256(struct
module Script_expr_hash = Hash.Make_SHA256(Base48)(struct
let name = "script_expr"
let title = "A script expression ID"
let prefix = Some Prefix.script_expr_hash
let b48check_prefix = Prefix.script_expr_hash
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(struct
module Contract_hash = Hash.Make_SHA256(Base48)(struct
let name = "Contract_hash"
let title = "A contract ID"
let prefix = Some Prefix.contract_hash
let b48check_prefix = Prefix.contract_hash
end)
module Contract_hash_set = Hash_set(Contract_hash)
module Contract_hash_map = Hash_map(Contract_hash)

6
src/proto/bootstrap/vote_storage.mli
View File

@ -8,7 +8,7 @@
(**************************************************************************)
val record_proposal:
Storage.t -> Protocol_hash.t -> Ed25519.public_key_hash ->
Storage.t -> Protocol_hash.t -> Ed25519.Public_key_hash.t ->
Storage.t tzresult Lwt.t
val get_proposals:
@ -23,7 +23,7 @@ type ballots = {
}
val record_ballot:
Storage.t -> Ed25519.public_key_hash -> Vote_repr.ballot ->
Storage.t -> Ed25519.Public_key_hash.t -> Vote_repr.ballot ->
Storage.t tzresult Lwt.t
val get_ballots: Storage.t -> ballots tzresult Lwt.t
val clear_ballots: Storage.t -> Storage.t Lwt.t
@ -33,7 +33,7 @@ val clear_listings: Storage.t -> Storage.t tzresult Lwt.t
val listing_size: Storage.t -> int32 tzresult Lwt.t
val in_listings:
Storage.t -> Ed25519.public_key_hash -> bool Lwt.t
Storage.t -> Ed25519.Public_key_hash.t -> bool Lwt.t
val get_current_quorum: Storage.t -> int32 tzresult Lwt.t
val set_current_quorum: Storage.t -> int32 -> Storage.t tzresult Lwt.t

5
src/proto/demo/.merlin
View File

@ -1,8 +1,9 @@
B ../../node/updater/
B _tzbuild
FLG -nopervasives
FLG -open Proto_environment
FLG -open Local_environment
FLG -open Environment
FLG -open Hash
FLG -open Local_error_monad
FLG -open Error_monad
FLG -open Logging
FLG -w -40

2
src/proto/demo/TEZOS_PROTOCOL
View File

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

27
src/proto/environment/base48.mli
View File

@ -1,15 +1,20 @@
type data = ..
val decode: ?alphabet:string -> string -> data
val encode: ?alphabet:string -> data -> string
val register:
prefix:string ->
read:(data -> string option) ->
build:(string -> data) ->
unit
module Prefix : sig
val protocol_prefix: string
end
type 'a encoding
val simple_decode: ?alphabet:string -> 'a encoding -> string -> 'a option
val simple_encode: ?alphabet:string -> 'a encoding -> 'a -> string
type data = ..
val register_encoding:
prefix: string ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> data) ->
'a encoding
val decode: ?alphabet:string -> string -> data option

6
src/proto/environment/context.mli
View File

@ -7,3 +7,9 @@ include Persist.STORE
val get_genesis_time: t -> Time.t Lwt.t
val get_genesis_block: t -> Block_hash.t Lwt.t
val register_resolver:
'a Base48.encoding -> (t -> string -> 'a list Lwt.t) -> unit
val complete:
?alphabet:string -> t -> string -> string list Lwt.t

16
src/proto/environment/ed25519.mli
View File

@ -22,25 +22,11 @@ val check_signature : public_key -> signature -> MBytes.t -> bool
module Public_key_hash : Hash.HASH
(** A Sha256 hash of an Ed25519 public key for use as an ID *)
type public_key_hash = Public_key_hash.t
(** Hashes an Ed25519 public key *)
val hash : public_key -> public_key_hash
(** For using IDs as keys in the database *)
val hash_path : public_key_hash -> string list
(** ID comparison *)
val equal_hash : public_key_hash -> public_key_hash -> bool
(** ID comparison *)
val compare_hash : public_key_hash -> public_key_hash -> int
val hash : public_key -> Public_key_hash.t
(** {2 Serializers} **********************************************************)
val public_key_hash_encoding : public_key_hash Data_encoding.t
val public_key_encoding : public_key Data_encoding.t
val secret_key_encoding : secret_key Data_encoding.t

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

@ -1,5 +1,5 @@
(** Tezos - Manipulation and creation of hashes *)
(** Tezos - Manipulation and creation of hashes *)
(** {2 Hash Types} ************************************************************)
@ -8,9 +8,14 @@
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. *)
module type HASH = sig
module type MINIMAL_HASH = sig
type t
val name: string
val title: string
val hash_bytes: MBytes.t list -> t
val hash_string: string list -> t
val size: int (* in bytes *)
@ -20,20 +25,30 @@ module type HASH = sig
val to_raw: t -> string
val of_hex: string -> t
val to_hex: t -> string
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t
val read: MBytes.t -> int -> t
val write: MBytes.t -> int -> t -> unit
val to_path: t -> string list
val of_path: string list -> t
val prefix_path: string -> string list
val path_len: int
end
module type HASH = sig
include MINIMAL_HASH
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val encoding: t Data_encoding.t
val pp: Format.formatter -> t -> unit
val pp_short: Format.formatter -> t -> unit
type Base48.data += Hash of t
val b48check_encoding: t Base48.encoding
end
(** {2 Building Hashes} *******************************************************)
@ -41,14 +56,30 @@ end
(** The parameters for creating a new Hash type using
{!Make_SHA256}. Both {!name} and {!title} are only informative,
used in error messages and serializers. *)
module type Name = sig
val name : string
val title : string
val prefix : string option
end
module type PrefixedName = sig
include Name
val b48check_prefix : string
end
(** Builds a new Hash type using Sha256. *)
module Make_SHA256 (Name:Name) : HASH
module Make_minimal_SHA256 (Name : Name) : MINIMAL_HASH
module Make_SHA256
(Register : sig
val register_encoding:
prefix: string ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> Base48.data) ->
'a Base48.encoding
end)
(Name : PrefixedName) : HASH
(** Builds a Set of values of some Hash type. *)
module Hash_set (Hash : HASH) : sig
@ -78,3 +109,4 @@ 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)

13
src/proto/environment/persist.mli
View File

@ -13,12 +13,12 @@ type value = MBytes.t
module type STORE = sig
type t
val mem: t -> key -> bool Lwt.t
val dir_mem: t -> key -> bool Lwt.t
val get: t -> key -> value option Lwt.t
val set: t -> key -> value -> t Lwt.t
val del: t -> key -> t Lwt.t
val list: t -> key list -> key list Lwt.t
val remove_rec: t -> key -> t Lwt.t
val keys: t -> key list Lwt.t
end
@ -196,3 +196,14 @@ module MakeBufferedPersistentTypedMap
and type key := K.t
and type value := T.value
and module Map := Map
module MakeHashResolver
(Store : sig
type t
val dir_mem: t -> key -> bool Lwt.t
val list: t -> key list -> key list Lwt.t
val prefix: string list
end)
(H: Hash.HASH) : sig
val resolve : Store.t -> string -> H.t list Lwt.t
end

163
src/utils/base48.ml
View File

@ -7,6 +7,11 @@
(* *)
(**************************************************************************)
open Utils
let (>>=) = Lwt.bind
let (>|=) = Lwt.(>|=)
let decode_alphabet alphabet =
let str = Bytes.make 256 '\255' in
for i = 0 to String.length alphabet - 1 do
@ -15,7 +20,7 @@ let decode_alphabet alphabet =
Bytes.to_string str
let default_alphabet =
"eXMNE9qvHPQDdcFx5J86rT7VRm2atAypGhgLfbS3CKjnksB4"
"eE2NXaQvHPqDdTJxfF36jb7VRmp9tAyMgG4L5cS8CKrnksBh"
let default_decode_alphabet = decode_alphabet default_alphabet
@ -85,74 +90,144 @@ let sha256 s =
computed_hash
let safe_encode ?alphabet s =
raw_encode ?alphabet (String.sub (sha256 (sha256 s)) 0 4 ^ s)
raw_encode ?alphabet (s ^ String.sub (sha256 (sha256 s)) 0 4)
let safe_decode ?alphabet s =
let s = raw_decode ?alphabet s in
let len = String.length s in
let msg_hash = String.sub s 0 4 in
let msg = String.sub s 4 (len-4) 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
invalid_arg "safe_decode" ;
msg
type data = ..
type kinds =
Kind : { prefix: string;
read: data -> string option ;
build: string -> data } -> kinds
type 'a encoding = {
prefix: string;
to_raw: 'a -> string ;
of_raw: string -> 'a option ;
wrap: 'a -> data ;
}
let kinds = ref ([] : kinds list)
let simple_decode ?alphabet { prefix ; of_raw } s =
safe_decode ?alphabet s |>
remove_prefix ~prefix |>
Utils.apply_option ~f:of_raw
let remove_prefix ~prefix s =
let x = String.length prefix in
let n = String.length s in
if n >= x && String.sub s 0 x = prefix then
Some (String.sub s x (n - x))
else
None
let simple_encode ?alphabet { prefix ; to_raw } d =
safe_encode ?alphabet (prefix ^ to_raw d)
exception Unknown_prefix
type registred_encoding = Encoding : 'a encoding -> registred_encoding
module MakeEncodings(E: sig
val encodings: registred_encoding list
end) = struct
let encodings = ref E.encodings
let ambiguous_prefix prefix encodings =
List.exists (fun (Encoding { prefix = s }) ->
remove_prefix s prefix <> None ||
remove_prefix prefix s <> None)
encodings
let register_encoding ~prefix ~to_raw ~of_raw ~wrap =
if ambiguous_prefix prefix !encodings then
Format.ksprintf invalid_arg
"Base48.register_encoding: duplicate prefix: %S" prefix ;
let encoding = { prefix ; to_raw ; of_raw ; wrap } in
encodings := Encoding encoding :: !encodings ;
encoding
let decode ?alphabet s =
let rec find s = function
| [] -> raise Unknown_prefix
| Kind { prefix ; build } :: kinds ->
| [] -> None
| Encoding { prefix ; of_raw ; wrap } :: encodings ->
match remove_prefix ~prefix s with
| None -> find s kinds
| Some msg -> build msg in
| None -> find s encodings
| Some msg -> of_raw msg |> Utils.map_option ~f:wrap in
let s = safe_decode ?alphabet s in
find s !kinds
find s !encodings
exception Unregistred_kind
end
let encode ?alphabet s =
type 'a resolver =
Resolver : {
encoding: 'h encoding ;
resolver: 'a -> string -> 'h list Lwt.t ;
} -> 'a resolver
module MakeResolvers(R: sig
type context
val encodings: registred_encoding list ref
end) = struct
let resolvers = ref []
let register_resolver
(type a)
(encoding : a encoding)
(resolver : R.context -> string -> a list Lwt.t) =
try
resolvers := Resolver { encoding ; resolver } :: !resolvers
with Not_found ->
invalid_arg "Base48.register_resolver: unregistred encodings"
type context = R.context
let complete ?alphabet context request =
(* One may extract from the prefix of a Base48-encoded value, a
prefix of the original encoded value. Given that `48 = 3 * 2^4`,
every "digits" in the Base48-prefix (i.e. a "bytes" in its ascii
representation), provides for sure 4 bits of the original data.
Hence, when we decode a prefix of a Base48-encoded value of
length `n`, the `n/2` first bytes of the decoded value are (for
sure) a prefix of the original value. *)
let n = String.length request in
let s = raw_decode request ?alphabet in
let partial = String.sub s 0 (n / 2) in
let rec find s = function
| [] -> raise Unregistred_kind
| Kind { prefix ; read } :: kinds ->
match read s with
| None -> find s kinds
| Some msg -> safe_encode ?alphabet (prefix ^ msg) in
try find s !kinds
with Not_found -> raise Unknown_prefix
| [] -> Lwt.return_nil
| Resolver { encoding ; resolver } :: resolvers ->
match remove_prefix ~prefix:encoding.prefix s with
| None -> find s resolvers
| Some msg ->
resolver context msg >|= fun msgs ->
filter_map
(fun msg ->
let res = simple_encode encoding ?alphabet msg in
Utils.remove_prefix ~prefix:request res |>
Utils.map_option ~f:(fun _ -> res))
msgs in
find partial !resolvers
let register ~prefix ~read ~build =
match List.find (fun (Kind {prefix=s}) -> remove_prefix s prefix <> None || remove_prefix prefix s <> None) !kinds with
| exception Not_found ->
kinds := Kind { prefix ; read ; build } :: !kinds
| Kind { prefix = s } ->
Format.kasprintf
Pervasives.failwith
"Base49.register: Conflicting prefixes: %S and %S." prefix s ;
end
include MakeEncodings(struct let encodings = [] end)
include MakeResolvers(struct
type context = unit
let encodings = encodings
end)
let register_resolver enc f = register_resolver enc (fun () s -> f s)
let complete ?alphabet s = complete ?alphabet () s
module Make(C: sig type context end) = struct
include MakeEncodings(struct let encodings = !encodings end)
include MakeResolvers(struct
type context = C.context
let encodings = encodings
end)
end
module Prefix = struct
let block_hash = "\000"
let operation_hash = "\001"
let protocol_hash = "\002"
let public_key_hash = "\003"
let public_key = "\004"
let secret_key = "\005"
let signature = "\006"
let protocol_prefix = "\255"
let ed25519_public_key_hash = "\003"
let ed25519_public_key = "\012"
let ed25519_secret_key = "\013"
let ed25519_signature = "\014"
let protocol_prefix = "\015"
end

144
src/utils/base48.mli
View File

@ -7,27 +7,131 @@
(* *)
(**************************************************************************)
(** {1 Prefixed Base48Check encodings} *)
(** Like Bitcoin's Base58Check, all the data encoded in Tezos are
prefixed with a constant which depends on the kind of encoded
data.
The [Prefix] exports all the prefix used by the Tezos Shell. Each
version of the economical protocol might complete this list.
Unlike Bitcoin's Base58Check, the prefix in the unencoded-data
is visible in the encoded data.
*)
module Prefix : sig
val block_hash: string
(** Prefix for block hashes: "\000".
(in Base48: "e" "f" or "g") *)
val operation_hash: string
(** Prefix for operation hashes: "\001".
(in Base48: "E" "F" or "G") *)
val protocol_hash: string
(** Prefix for protocol-version hashes: "\002".
(in Base48: "2" "3" or "4") *)
val ed25519_public_key_hash: string
(** Prefix for Ed25519 public key hashes: "\003". *)
val ed25519_public_key: string
(** Prefix for Ed25519 public key: "\012". *)
val ed25519_secret_key: string
(** Prefix for Ed25519 secret key: "\013". *)
val ed25519_signature: string
(** Prefix for Ed25519 signature key: "\014". *)
val protocol_prefix: string
(** Prefix for all the encodings defined by economical protocol:
"\015". *)
end
(** An extensible sum-type for decoded data: one case per known
"prefix". See for instance [Hash.Block_hash.Hash] or
[Environment.Ed25519.Public_key_hash]. *)
type data = ..
(** Abstract representation of registred encodings. The type paramater
is the type of the encoded data, for instance [Hash.Block_hash.t]. *)
type 'a encoding = private {
prefix: string;
to_raw: 'a -> string ;
of_raw: string -> 'a option ;
wrap: 'a -> data ;
}
(** Register a new encoding. The function might raise `Invalid_arg` if
the provided [prefix] overlap with a previously registred
prefix. The [to_raw] and [of_raw] are the ad-hoc
serialisation/deserialisation for the data. The [wrap] should wrap
the deserialised value into the extensible sum-type [data] (see
the generic function [decode]). *)
val register_encoding:
prefix: string ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> data) ->
'a encoding
(** Encoder for a given kind of data. *)
val simple_encode: ?alphabet:string -> 'a encoding -> 'a -> string
(** Decoder for a given kind of data. It returns [None] when
the decoded data does not start with the expected prefix. *)
val simple_decode: ?alphabet:string -> 'a encoding -> string -> 'a option
(** Generic decoder. It returns [None] when the decoded data does
not start with a registred prefix. *)
val decode: ?alphabet:string -> string -> data option
(** {2 Completion of partial Base48Check value} *)
(** Register a (global) resolver for a previsously
registred kind af data. *)
val register_resolver: 'a encoding -> (string -> 'a list Lwt.t) -> unit
(** Try to complete a prefix of a Base48Check encoded data, by using
the previously registered resolver associated to this kind of
data. Note that a prefix of [n] characters of a Base48-encoded
value provides at least [n/2] bytes of a prefix of the original value. *)
val complete: ?alphabet:string -> string -> string list Lwt.t
(** {1 Low-level: distinct registering function for economical protocol} *)
(** See [src/proto/environment/base48.mli]} for an inlined
documentation. *)
module Make(C: sig type context end) : sig
val register_encoding:
prefix: string ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> data) ->
'a encoding
val decode: ?alphabet:string -> string -> data option
val register_resolver:
'a encoding -> (C.context -> string -> 'a list Lwt.t) -> unit
val complete:
?alphabet:string -> C.context -> string -> string list Lwt.t
end
(** {2 Low-level Base48Check encodings} *)
(** Base48Check-encoding/decoding functions (with error detections). *)
val safe_encode: ?alphabet:string -> string -> string
val safe_decode: ?alphabet:string -> string -> string
type data = ..
(** Base48-encoding/decoding functions (without error detections). *)
val raw_encode: ?alphabet:string -> string -> string
val raw_decode: ?alphabet:string -> string -> string
val decode: ?alphabet:string -> string -> data
val encode: ?alphabet:string -> data -> string
val register:
prefix:string ->
read:(data -> string option) ->
build:(string -> data) ->
unit
module Prefix : sig
val block_hash: string
val operation_hash: string
val protocol_hash: string
val public_key_hash: string
val public_key: string
val secret_key: string
val signature: string
val protocol_prefix: string
end

134
src/utils/ed25519.ml
View File

@ -1,134 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(* Tezos - Ed25519 cryptography (simple interface to Sodium) *)
(*-- Signature ---------------------------------------------------------------*)
type secret_key = Sodium.Sign.secret_key
type public_key = Sodium.Sign.public_key
type signature = MBytes.t
let sign key msg =
Sodium.Sign.Bigbytes.(of_signature @@ sign_detached key msg)
let check_signature public_key signature msg =
try Sodium.Sign.Bigbytes.(verify public_key (to_signature signature) msg) ; true
with _ -> false
let append_signature key msg =
MBytes.concat msg (sign key msg)
(*-- Hashed public keys for user ID ------------------------------------------*)
module Public_key_hash = Hash.Make_SHA256(struct
let name = "Ed25519.Public_key_hash"
let title = "An Ed25519 public key ID"
let prefix = Some Base48.Prefix.public_key_hash
end)
type public_key_hash = Public_key_hash.t
let hash v =
Public_key_hash.hash_bytes
[ Sodium.Sign.Bigbytes.of_public_key v ]
let hash_path = Public_key_hash.to_path
let hash_hex = Public_key_hash.to_hex
let equal_hash = Public_key_hash.equal
let compare_hash = Public_key_hash.compare
let generate_key () =
let secret, pub = Sodium.Sign.random_keypair () in
(hash pub, pub, secret)
(*-- JSON Serializers --------------------------------------------------------*)
type Base48.data +=
| Public_key of public_key
| Secret_key of secret_key
| Signature of signature
let () =
Base48.register
~prefix:Base48.Prefix.public_key
~read:(function Public_key x -> Some (Bytes.to_string (Sodium.Sign.Bytes.of_public_key x)) | _ -> None)
~build:(fun x -> Public_key (Sodium.Sign.Bytes.to_public_key (Bytes.of_string x)))
let () =
Base48.register
~prefix:Base48.Prefix.secret_key
~read:(function Secret_key x -> Some (Bytes.to_string (Sodium.Sign.Bytes.of_secret_key x)) | _ -> None)
~build:(fun x -> Secret_key (Sodium.Sign.Bytes.to_secret_key (Bytes.of_string x)))
let () =
Base48.register
~prefix:Base48.Prefix.signature
~read:(function Signature x -> Some (MBytes.to_string x) | _ -> None)
~build:(fun x -> Signature (MBytes.of_string x))
let public_key_hash_encoding =
Public_key_hash.encoding
let public_key_encoding =
let open Data_encoding in
splitted
~json:
(describe
~title: "An Ed25519 public key (Base48Check encoded)" @@
conv
(fun s -> Base48.encode (Public_key s))
(fun s ->
match Base48.decode s with
| Public_key x -> x
| _ -> Data_encoding.Json.cannot_destruct
"Ed25519 public key: unexpected prefix.")
string)
~binary:
(conv
Sodium.Sign.Bigbytes.of_public_key
Sodium.Sign.Bigbytes.to_public_key
bytes)
let secret_key_encoding =
let open Data_encoding in
splitted
~json:
(describe
~title: "An Ed25519 secret key (Base48Check encoded)" @@
conv
(fun s -> Base48.encode (Secret_key s))
(fun s ->
match Base48.decode s with
| Secret_key x -> x
| _ -> Data_encoding.Json.cannot_destruct
"Ed25519 secret key: unexpected prefix.")
string)
~binary:
(conv
Sodium.Sign.Bigbytes.of_secret_key
Sodium.Sign.Bigbytes.to_secret_key
bytes)
let signature_encoding =
let open Data_encoding in
splitted
~json:
(describe
~title: "An Ed25519 signature (Base48Check encoded)" @@
conv
(fun s -> Base48.encode (Signature s))
(fun s ->
match Base48.decode s with
| Signature x -> x
| _ ->
Data_encoding.Json.cannot_destruct
"Ed25519 signature: unexpected prefix.")
string)
~binary: (Fixed.bytes 64)

63
src/utils/ed25519.mli
View File

@ -1,63 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(** Tezos - Ed25519 cryptography *)
(** {2 Signature} ************************************************************)
(** An Ed25519 public key *)
type public_key = Sodium.Sign.public_key
(** An Ed25519 secret key *)
type secret_key = Sodium.Sign.secret_key
(** The result of signing a sequence of bytes with a secret key *)
type signature
(** Signs a sequence of bytes with a secret key *)
val sign : secret_key -> MBytes.t -> signature
val append_signature : secret_key -> MBytes.t -> MBytes.t
(** Checks a signature *)
val check_signature : public_key -> signature -> MBytes.t -> bool
(** {2 Hashed public keys for user ID} ***************************************)
module Public_key_hash : Hash.HASH
(** A Sha256 hash of an Ed25519 public key for use as an ID *)
type public_key_hash = Public_key_hash.t
(** Hashes an Ed25519 public key *)
val hash : public_key -> public_key_hash
(** For using IDs as keys in the database *)
val hash_path : public_key_hash -> string list
(** ID comparison *)
val equal_hash : public_key_hash -> public_key_hash -> bool
(** ID comparison *)
val compare_hash : public_key_hash -> public_key_hash -> int
(** {2 Serializers} **********************************************************)
val public_key_hash_encoding : public_key_hash Data_encoding.t
val public_key_encoding : public_key Data_encoding.t
val secret_key_encoding : secret_key Data_encoding.t
val signature_encoding : signature Data_encoding.t
(** {2 Key pairs generation} *************************************************)
val generate_key : unit -> public_key_hash * public_key * secret_key

107
src/utils/hash.ml
View File

@ -15,9 +15,13 @@ open Utils
(*-- Signatures -------------------------------------------------------------*)
module type HASH = sig
module type MINIMAL_HASH = sig
type t
val name: string
val title: string
val hash_bytes: MBytes.t list -> t
val hash_string: string list -> t
val size: int (* in bytes *)
@ -27,34 +31,50 @@ module type HASH = sig
val to_raw: t -> string
val of_hex: string -> t
val to_hex: t -> string
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t
val read: MBytes.t -> int -> t
val write: MBytes.t -> int -> t -> unit
val to_path: t -> string list
val of_path: string list -> t
val prefix_path: string -> string list
val path_len: int
end
module type HASH = sig
include MINIMAL_HASH
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val encoding: t Data_encoding.t
val pp: Format.formatter -> t -> unit
val pp_short: Format.formatter -> t -> unit
type Base48.data += Hash of t
val b48check_encoding: t Base48.encoding
end
module type Name = sig
val name: string
val title: string
val prefix : string option
end
module type PrefixedName = sig
include Name
val b48check_prefix: string
end
(*-- Type specific Hash builder ---------------------------------------------*)
module Make_SHA256 (K : Name) = struct
module Make_minimal_SHA256 (K : Name) = struct
type t = string
include K
let size = 32 (* SHA256 *)
let of_raw s =
@ -70,25 +90,6 @@ module Make_SHA256 (K : Name) = struct
let of_hex s = of_raw (Hex_encode.hex_decode s)
let to_hex s = Hex_encode.hex_encode s
type Base48.data += Hash of t
let () =
match K.prefix with
| Some prefix ->
Base48.register
~prefix
~read:(function Hash x -> Some x | _ -> None)
~build:(fun x -> Hash x)
| None -> ()
let of_b48check s =
match Base48.decode s with
| Hash x -> x
| _ -> Format.kasprintf failwith "Unexpected hash (%s)" K.name
let to_b48check s = Base48.encode (Hash s)
let to_short_b48check s = String.sub (to_b48check s) 0 8
let compare = String.compare
let equal : t -> t -> bool = (=)
@ -141,18 +142,58 @@ module Make_SHA256 (K : Name) = struct
let equal = equal
end)
let path_len = 5
let path_len = 6
let to_path key =
let key = to_hex key in
[ String.sub key 0 2 ; String.sub key 2 2 ;
String.sub key 4 2 ; String.sub key 6 2 ;
String.sub key 8 (size * 2 - 8) ]
String.sub key 8 2 ; String.sub key 10 (size * 2 - 10) ]
let of_path path =
let path = String.concat "" path in
of_hex path
let prefix_path p =
let p = to_hex 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 ""
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
[ p1 ; p2 ; p3 ; p4 ; p5 ; p6 ]
end
module Make_SHA256 (R : sig
val register_encoding:
prefix: string ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> Base48.data) ->
'a Base48.encoding
end) (K : PrefixedName) = struct
include Make_minimal_SHA256(K)
(* Serializers *)
type Base48.data += Hash of t
let b48check_encoding =
R.register_encoding
~prefix: K.b48check_prefix
~wrap: (fun x -> Hash x)
~of_raw:(fun s -> Some s) ~to_raw
let of_b48check s =
match Base48.simple_decode b48check_encoding s with
| Some x -> x
| None -> Format.kasprintf failwith "Unexpected hash (%s)" K.name
let to_b48check s = Base48.simple_encode b48check_encoding s
let to_short_b48check s = String.sub (to_b48check s) 0 12
let encoding =
let open Data_encoding in
splitted
@ -207,10 +248,10 @@ module Hash_table (Hash : HASH)
(*-- Pre-instanciated hashes ------------------------------------------------*)
module Block_hash =
Make_SHA256 (struct
Make_SHA256 (Base48) (struct
let name = "Block_hash"
let title = "A Tezos block ID"
let prefix = Some Base48.Prefix.block_hash
let b48check_prefix = Base48.Prefix.block_hash
end)
module Block_hash_set = Hash_set (Block_hash)
@ -218,10 +259,10 @@ module Block_hash_map = Hash_map (Block_hash)
module Block_hash_table = Hash_table (Block_hash)
module Operation_hash =
Make_SHA256 (struct
Make_SHA256 (Base48) (struct
let name = "Operation_hash"
let title = "A Tezos operation ID"
let prefix = Some Base48.Prefix.operation_hash
let b48check_prefix = Base48.Prefix.operation_hash
end)
module Operation_hash_set = Hash_set (Operation_hash)
@ -229,10 +270,10 @@ module Operation_hash_map = Hash_map (Operation_hash)
module Operation_hash_table = Hash_table (Operation_hash)
module Protocol_hash =
Make_SHA256 (struct
Make_SHA256 (Base48) (struct
let name = "Protocol_hash"
let title = "A Tezos protocol ID"
let prefix = Some Base48.Prefix.protocol_hash
let b48check_prefix = Base48.Prefix.protocol_hash
end)
module Protocol_hash_set = Hash_set (Protocol_hash)

43
src/utils/hash.mli
View File

@ -17,9 +17,14 @@
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. *)
module type HASH = sig
module type MINIMAL_HASH = sig
type t
val name: string
val title: string
val hash_bytes: MBytes.t list -> t
val hash_string: string list -> t
val size: int (* in bytes *)
@ -29,20 +34,30 @@ module type HASH = sig
val to_raw: t -> string
val of_hex: string -> t
val to_hex: t -> string
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val to_bytes: t -> MBytes.t
val of_bytes: MBytes.t -> t
val read: MBytes.t -> int -> t
val write: MBytes.t -> int -> t -> unit
val to_path: t -> string list
val of_path: string list -> t
val prefix_path: string -> string list
val path_len: int
end
module type HASH = sig
include MINIMAL_HASH
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val encoding: t Data_encoding.t
val pp: Format.formatter -> t -> unit
val pp_short: Format.formatter -> t -> unit
type Base48.data += Hash of t
val b48check_encoding: t Base48.encoding
end
(** {2 Building Hashes} *******************************************************)
@ -50,14 +65,29 @@ end
(** The parameters for creating a new Hash type using
{!Make_SHA256}. Both {!name} and {!title} are only informative,
used in error messages and serializers. *)
module type Name = sig
val name : string
val title : string
val prefix : string option
end
module type PrefixedName = sig
include Name
val b48check_prefix : string
end
(** Builds a new Hash type using Sha256. *)
module Make_SHA256 (Name:Name) : HASH
module Make_minimal_SHA256 (Name : Name) : MINIMAL_HASH
module Make_SHA256
(Register : sig
val register_encoding:
prefix: string ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> Base48.data) ->
'a Base48.encoding
end)
(Name : PrefixedName) : HASH
(** Builds a Set of values of some Hash type. *)
module Hash_set (Hash : HASH) : sig
@ -101,3 +131,4 @@ module Protocol_hash : HASH
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)

12
src/utils/utils.ml
View File

@ -96,6 +96,10 @@ let map_option ~f = function
| None -> None
| Some x -> Some (f x)
let apply_option ~f = function
| None -> None
| Some x -> f x
let iter_option ~f = function
| None -> ()
| Some x -> f x
@ -122,6 +126,14 @@ let rec remove_elem_from_list nb = function
| l when nb <= 0 -> l
| _ :: tl -> remove_elem_from_list (nb - 1) tl
let remove_prefix ~prefix s =
let x = String.length prefix in
let n = String.length s in
if n >= x && String.sub s 0 x = prefix then
Some (String.sub s x (n - x))
else
None
let finalize f g = try let res = f () in g (); res with exn -> g (); raise exn
let read_file ?(bin=false) fn =

3
src/utils/utils.mli
View File

@ -27,6 +27,7 @@ val split_path: string -> string list
val split: char -> ?limit: int -> string -> string list
val map_option: f:('a -> 'b) -> 'a option -> 'b option
val apply_option: f:('a -> 'b option) -> 'a option -> 'b option
val iter_option: f:('a -> unit) -> 'a option -> unit
val unopt: 'a -> 'a option -> 'a
val unopt_list: 'a option list -> 'a list
@ -36,6 +37,8 @@ val display_paragraph: Format.formatter -> string -> unit
(** [remove nb list] remove the first [nb] elements from the list [list]. *)
val remove_elem_from_list: int -> 'a list -> 'a list
val remove_prefix: prefix:string -> string -> string option
val filter_map: ('a -> 'b option) -> 'a list -> 'b list
val finalize: (unit -> 'a) -> (unit -> unit) -> 'a

10
test/lib/assert.ml
View File

@ -7,6 +7,7 @@
(* *)
(**************************************************************************)
open Hash
open Kaputt.Abbreviations
include Kaputt.Assertion
@ -21,6 +22,15 @@ let equal_persist_list ?msg l1 l2 =
Printf.sprintf "[%s]" res in
Assert.make_equal_list ?msg (=) pr_persist l1 l2
let equal_block_hash_list ?msg l1 l2 =
let msg = format_msg msg in
let pr_block_hash = Block_hash.to_short_b48check in
Assert.make_equal_list ?msg Block_hash.equal pr_block_hash l1 l2
let equal_string_list ?msg l1 l2 =
let msg = format_msg msg in
Assert.make_equal_list ?msg (=) (fun x -> x) l1 l2
let equal_string_option ?msg o1 o2 =
let msg = format_msg msg in
let prn = function

16
test/lib/assert.mli
View File

@ -7,7 +7,7 @@
(* *)
(**************************************************************************)
open Hash
include (module type of struct include Kaputt.Assertion end)
val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
@ -17,6 +17,12 @@ val fail : string -> string -> ('a, Format.formatter, unit, 'b) format4 -> 'a
val equal_persist_list :
?msg:string -> Persist.key list -> Persist.key list -> unit
val equal_block_hash_list :
?msg:string -> Block_hash.t list -> Block_hash.t list -> unit
val equal_string_list :
?msg:string -> string list -> string list -> unit
val equal_string_option : ?msg:string -> string option -> string option -> unit
val equal_error_monad :
@ -26,14 +32,14 @@ val equal_block_map : ?msg:string -> eq:('a -> 'a -> bool) -> 'a -> 'a -> unit
val equal_operation :
?msg:string ->
(Hash.Operation_hash.t * State.Operation.operation) option ->
(Hash.Operation_hash.t * State.Operation.operation) option ->
(Operation_hash.t * State.Operation.operation) option ->
(Operation_hash.t * State.Operation.operation) option ->
unit
val equal_block :
?msg:string ->
(Hash.Block_hash.t * Store.block) option ->
(Hash.Block_hash.t * Store.block) option ->
(Block_hash.t * Store.block) option ->
(Block_hash.t * Store.block) option ->
unit
val equal_result :

2
test/test_basic.ml
View File

@ -78,7 +78,7 @@ let bootstrap_accounts () =
let create_account name =
let secret_key, public_key = Sodium.Sign.random_keypair () in
let public_key_hash = Ed25519.hash public_key in
let public_key_hash = Environment.Ed25519.hash public_key in
let contract = Contract.default_contract public_key_hash in
Lwt.return { name ; contract ; public_key_hash ; public_key ; secret_key }

4
test/test_context.ml
View File

@ -18,11 +18,11 @@ let (//) = Filename.concat
let genesis_block =
Block_hash.of_b48check
"Et22nEeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
let genesis_protocol =
Protocol_hash.of_b48check
"JF7Fxgeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
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
"Et22nEeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
let genesis_protocol =
Protocol_hash.of_b48check
"JF7Fxgeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
let genesis_time =
Time.of_seconds 0L

24
test/test_store.ml
View File

@ -18,11 +18,11 @@ let (//) = Filename.concat
let genesis_block =
Block_hash.of_b48check
"Et22nEeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
"eeeeeeeeeeeeeegqJHARhSaNXggmMs8K3tvsgn4rBprkvpFAMVD5d"
let genesis_protocol =
Protocol_hash.of_b48check
"JF7Fxgeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee"
"2gagXCT66nmJ2mKh3a6Aeysy9CHaHsAJyDEGSyFNeFAxGCJehsKpK"
let genesis_time =
Time.of_seconds 0L
@ -88,6 +88,11 @@ let b2 = lolblock "Tacatlopo"
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
Bytes.set raw 31 '\000' ;
Bytes.set raw 30 '\000' ;
Block_hash.of_raw @@ Bytes.to_string raw
let check_block s h b =
Block.full_get s h >>= function
@ -110,6 +115,20 @@ let test_block (s: Store.store) =
check_block s bh2 b2 >>= fun () ->
check_block s bh3 b3)
let test_expand (s: Store.store) =
Persist.use s.block (fun s ->
Block.full_set s bh1 b1 >>= fun () ->
Block.full_set s bh2 b2 >>= fun () ->
Block.full_set s bh3 b3 >>= fun () ->
Block.full_set s bh3' b3 >>= fun () ->
Base48.complete (Block_hash.to_short_b48check bh1) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b48check bh1] ;
Base48.complete (Block_hash.to_short_b48check bh2) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b48check bh2] ;
Base48.complete (Block_hash.to_short_b48check bh3) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b48check bh3] ;
Lwt.return_unit)
(** Generic store *)
@ -235,6 +254,7 @@ let test_hashmap (s: Store.store) =
let tests : (string * (store -> unit Lwt.t)) list = [
"init", test_init ;
"expand", test_expand ;
"operation", test_operation ;
"block", test_block ;
"generic", test_generic ;