Switch to Base58.

Base48 was fun but... hell yeah... let's stay standard.

Public encoding of hash:

```
  Block:      "B..." (len: 51)
  Operation:  "o..." (len: 51)
  Protocol:   "P..." (len: 51)

  Ed25519:    "tz1.." (len: 36)
  Contract:   "TZ1.." (len: 36)

  NetworkdId: "id.." (len: 30)
```

Other internal prefixes (in the RPC):

```
  Hash of Michelson's expression: "expr..." (len: 54)

  Ed25519 public key: "edpk..." (len: 54)
  Ed25519 secret key: "edsk..." (len: 98)
  Ed25519 signature:  "edsig.." (len: 99)

  Hash of a random seed nonce: "nce...." (len: 53)
  Random seed:                 "rng...." (len: 53)
```
This commit is contained in:
Grégoire Henry 2017-02-19 18:22:32 +01:00
parent 5be99fca06
commit fc53f3b233
52 changed files with 685 additions and 508 deletions

1
.gitignore vendored
View File

@ -42,6 +42,7 @@
/test/test-p2p-io-scheduler
/test/test-p2p-connection
/test/test-p2p-connection-pool
/test/generate_hash
/test/LOG
*~

View File

@ -38,6 +38,7 @@ PKG ipv6-multicast
PKG irmin
PKG lwt
PKG mtime.os
PKG nocrypto
PKG ocplib-endian
PKG ocplib-json-typed
PKG ocplib-ocamlres

View File

@ -36,7 +36,7 @@ $(addprefix proto/environment/, \
error_monad.mli \
logging.mli \
time.mli \
base48.mli \
base58.mli \
hash.mli \
ed25519.mli \
persist.mli \
@ -150,7 +150,7 @@ minutils.cma: ${MINUTILS_LIB_IMPLS:.ml=.cmo}
############################################################################
UTILS_LIB_INTFS := \
utils/base48.mli \
utils/base58.mli \
utils/cli_entries.mli \
utils/data_encoding_ezjsonm.mli \
utils/crypto_box.mli \
@ -166,7 +166,7 @@ UTILS_LIB_INTFS := \
utils/ring.mli \
UTILS_LIB_IMPLS := \
utils/base48.ml \
utils/base58.ml \
utils/cli_entries.ml \
utils/error_monad_sig.ml \
utils/error_monad.ml \
@ -189,6 +189,7 @@ UTILS_PACKAGES := \
ezjsonm \
ipaddr.unix \
mtime.os \
nocrypto \
sodium \
zarith \
$(COVERAGEPKG) \

View File

@ -14,8 +14,8 @@ module Proto = Client_embedded_proto_bootstrap
module Ed25519 = Proto.Local_environment.Environment.Ed25519
(* the genesis block and network *)
let genesis_block_hashed = Block_hash.of_b48check
"grHGHkVfgJb5gPaRd5AtQsa65g9GyLcXgQsHbSnQ5SD5DEp2ctqck"
let genesis_block_hashed = Block_hash.of_b58check
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let network = Store.Net genesis_block_hashed
(* the bootstrap accounts and actions like signing to do with them *)

View File

@ -18,14 +18,14 @@ let unique_arg =
let commands () = Cli_entries.[
command
~desc: "Lookup for the possible completion of a \
given prefix of Base48Check-encoded hash. This actually \
given prefix of Base58Check-encoded hash. This actually \
works only for blocks, operations, public key and contract \
identifiers."
~args: [unique_arg]
(prefixes [ "complete" ] @@
string
~name: "prefix"
~desc: "the prefix of the Base48Check-encoded hash to be completed" @@
~desc: "the prefix of the Base58Check-encoded hash to be completed" @@
stop)
(fun prefix cctxt ->
Client_node_rpcs.complete cctxt ~block:(block ()) prefix >>= fun completions ->

View File

@ -12,8 +12,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
let of_source _ s = Lwt.return (Ed25519.Public_key_hash.of_b48check s)
let to_source _ p = Lwt.return (Ed25519.Public_key_hash.to_b48check p)
let of_source _ s = Lwt.return (Ed25519.Public_key_hash.of_b58check s)
let to_source _ p = Lwt.return (Ed25519.Public_key_hash.to_b58check p)
let name = "public key hash"
end)

View File

@ -19,7 +19,7 @@ let commands () =
else
Lwt.fail_with (dn ^ " is not a directory") in
let check_hash _ ph =
Lwt.wrap1 Protocol_hash.of_b48check ph in
Lwt.wrap1 Protocol_hash.of_b58check ph in
[
command ~group ~desc: "list known protocols"
(prefixes [ "list" ; "protocols" ] stop)

View File

@ -54,7 +54,7 @@ let list_contracts cctxt block =
let kind = match Contract.is_default h with
| Some _ -> " (default)"
| None -> "" in
cctxt.message "%s%s%s" (Contract.to_b48check h) kind nm >>= fun () ->
cctxt.message "%s%s%s" (Contract.to_b58check h) kind nm >>= fun () ->
return ())
contracts

View File

@ -13,11 +13,11 @@ module RawContractAlias = Client_aliases.Alias (struct
type t = Contract.t
let encoding = Contract.encoding
let of_source _ s =
match Contract.of_b48check s with
match Contract.of_b58check s with
| Error _ -> Lwt.fail (Failure "bad contract notation")
| Ok s -> Lwt.return s
let to_source _ s =
Lwt.return (Contract.to_b48check s)
Lwt.return (Contract.to_b58check s)
let name = "contract"
end)
@ -75,14 +75,14 @@ module ContractAlias = struct
Lwt.catch
(fun () -> find cctxt s)
(fun _ ->
match Contract.of_b48check s with
match Contract.of_b58check s with
| Error _ -> Lwt.fail (Failure "bad contract notation")
| Ok v -> Lwt.return (s, v)))
next
let name cctxt contract =
rev_find cctxt contract >|= function
| None -> Contract.to_b48check contract
| None -> Contract.to_b58check contract
| Some name -> name
end
@ -148,14 +148,14 @@ let commands () =
(fun cctxt ->
RawContractAlias.load cctxt >>= fun list ->
Lwt_list.iter_s (fun (n, v) ->
let v = Contract.to_b48check v in
let v = Contract.to_b58check v in
cctxt.message "%s: %s" n v)
list >>= fun () ->
Client_keys.Public_key_hash.load cctxt >>= fun list ->
Lwt_list.iter_s (fun (n, v) ->
RawContractAlias.mem cctxt n >>= fun mem ->
let p = if mem then "key:" else "" in
let v = Contract.to_b48check (Contract.default_contract v) in
let v = Contract.to_b58check (Contract.default_contract v) in
cctxt.message "%s%s: %s" p n v)
list >>= fun () ->
Lwt.return ()) ;

View File

@ -8,8 +8,8 @@
(**************************************************************************)
let protocol =
Protocol_hash.of_b48check
"4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd"
Protocol_hash.of_b58check
"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"
let () =
Client_commands.register protocol @@

View File

@ -22,5 +22,5 @@ let root =
let root =
RPC.register root Services.hash @@ fun block () ->
Client_node_rpcs.(call_service1 cctxt Node_rpc_services.Blocks.hash block ()) >>= fun res ->
RPC.Answer.return (Hash.Block_hash.to_b48check res) in
RPC.Answer.return (Hash.Block_hash.to_b58check res) in
root

View File

@ -8,8 +8,8 @@
(**************************************************************************)
let protocol =
Protocol_hash.of_b48check
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
Protocol_hash.of_b58check
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let demo cctxt =
let block = Client_config.block () in

View File

@ -266,19 +266,19 @@ let create_register_file client file hash packname modules =
create_file file
(Printf.sprintf
"module Packed_protocol = struct\n\
\ let hash = (%s.Protocol_hash.of_b48check %S)\n\
\ let hash = (%s.Protocol_hash.of_b58check %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
\ let complete_b58prefix = %s.complete
\ end\n\
\ %s\n\
"
hash_module
(Protocol_hash.to_b48check hash)
(Protocol_hash.to_b58check hash)
error_monad_module
error_monad_module
packname (String.capitalize_ascii unit)

View File

@ -108,6 +108,11 @@ let rec remove_elem_from_list nb = function
| l when nb <= 0 -> l
| _ :: tl -> remove_elem_from_list (nb - 1) tl
let has_prefix ~prefix s =
let x = String.length prefix in
let n = String.length s in
n >= x && String.sub s 0 x = prefix
let remove_prefix ~prefix s =
let x = String.length prefix in
let n = String.length s in
@ -116,6 +121,16 @@ let remove_prefix ~prefix s =
else
None
let common_prefix s1 s2 =
let last = min (String.length s1) (String.length s2) in
let rec loop i =
if last <= i then last
else if s1.[i] = s2.[i] then
loop (i+1)
else
i in
loop 0
let finalize f g = try let res = f () in g (); res with exn -> g (); raise exn
let read_file ?(bin=false) fn =

View File

@ -31,7 +31,10 @@ 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 has_prefix: prefix:string -> string -> bool
val remove_prefix: prefix:string -> string -> string option
val common_prefix: string -> string -> int
val filter_map: ('a -> 'b option) -> 'a list -> 'b list

View File

@ -82,7 +82,7 @@ let invalid_context_key = ["invalid_context"]
let exists (module GitStore : STORE) key =
GitStore.of_branch_id
Irmin.Task.none (Block_hash.to_b48check key) GitStore.local_repo >>= fun t ->
Irmin.Task.none (Block_hash.to_b58check key) GitStore.local_repo >>= fun t ->
let store = t () in
GitStore.read store genesis_block_key >>= function
| Some _ ->
@ -102,7 +102,7 @@ let checkout ((module GitStore : STORE) as index) key =
Lwt.return None
else
GitStore.of_branch_id
Irmin.Task.none (Block_hash.to_b48check key) GitStore.local_repo >>= fun t ->
Irmin.Task.none (Block_hash.to_b58check key) GitStore.local_repo >>= fun t ->
let store = t () in
GitStore.FunView.of_path store [] >>= fun v ->
lwt_debug "<- Context.checkout %a OK"
@ -142,7 +142,7 @@ let commit (module GitStore : STORE) block key (module View : VIEW) =
let task =
Irmin.Task.create
~date:(Time.to_seconds block.Store.shell.timestamp) ~owner:"tezos" in
GitStore.clone task View.s (Block_hash.to_b48check key) >>= function
GitStore.clone task View.s (Block_hash.to_b58check key) >>= function
| `Empty_head -> Lwt.fail (Empty_head (GitStore.path, key))
| `Duplicated_branch -> Lwt.fail (Preexistent_context (GitStore.path, key))
| `Ok store ->
@ -157,13 +157,13 @@ let commit_invalid (module GitStore : STORE) block key exns =
Irmin.Task.create
~date:(Time.to_seconds block.Store.shell.timestamp) ~owner:"tezos" in
GitStore.of_branch_id
task (Block_hash.to_b48check key) GitStore.local_repo >>= fun t ->
task (Block_hash.to_b58check key) GitStore.local_repo >>= fun t ->
let msg =
Format.asprintf "%a %a"
Fitness.pp block.shell.fitness
Block_hash.pp_short key in
let store = t msg in
GitStore.clone Irmin.Task.none store (Block_hash.to_b48check key) >>= function
GitStore.clone Irmin.Task.none store (Block_hash.to_b58check key) >>= function
| `Empty_head ->
GitStore.update store invalid_context_key
(MBytes.of_string @@ Data_encoding_ezjsonm.to_string @@
@ -257,7 +257,7 @@ let init ?patch_context ~root =
let create_genesis_context (module GitStore : STORE) genesis test_protocol =
GitStore.of_branch_id
Irmin.Task.none (Block_hash.to_b48check genesis.Store.block)
Irmin.Task.none (Block_hash.to_b58check genesis.Store.block)
GitStore.local_repo >>= fun t ->
let store = t () in
GitStore.FunView.of_path store [] >>= fun v ->

View File

@ -742,11 +742,11 @@ 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
Base58.register_resolver
Block_hash.b58check_encoding
(fun s -> Block_resolver.resolve t s);
Base48.register_resolver
Operation_hash.b48check_encoding
Base58.register_resolver
Operation_hash.b58check_encoding
(fun s -> Operation_resolver.resolve t s);
Lwt.return
{ block = Persist.share t ;

View File

@ -13,11 +13,11 @@ let genesis = {
Store.time =
Time.of_notation_exn "2016-11-01T00:00:00Z" ;
block =
Block_hash.of_b48check
"grHGHkVfgJb5gPaRd5AtQsa65g9GyLcXgQsHbSnQ5SD5DEp2ctqck" ;
Block_hash.of_b58check
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z" ;
protocol =
Protocol_hash.of_b48check
"4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd" ;
Protocol_hash.of_b58check
"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" ;
}
let (//) = Filename.concat

View File

@ -342,8 +342,8 @@ module RPC = struct
State.Valid_block.read_exn node.state hash >|= convert
let prevalidation_hash =
Block_hash.of_b48check
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
Block_hash.of_b58check
"BLockPrevaLidationPrevaLidationPrevaLidationPrZ4mr6"
let get_net node = function
| `Head _ | `Prevalidation -> node.global_validator, node.global_net
@ -514,15 +514,15 @@ module RPC = struct
let complete node ?block str =
match block with
| None ->
Base48.complete str
Base58.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 ->
Base58.complete str >>= fun l1 ->
Proto.complete_b58prefix ctxt str >>= fun l2 ->
Lwt.return (l1 @ l2)
let context_dir node block =

View File

@ -102,7 +102,7 @@ module Blocks = struct
| ["test_prevalidation"] -> Ok `Test_prevalidation
| ["head"; n] -> Ok (`Head (int_of_string n))
| ["test_head"; n] -> Ok (`Test_head (int_of_string n))
| [h] -> Ok (`Hash (Block_hash.of_b48check h))
| [h] -> Ok (`Hash (Block_hash.of_b58check h))
| _ -> raise Exit
with _ -> Error "Cannot parse block identifier."
@ -124,7 +124,7 @@ module Blocks = struct
| `Test_head 0 -> "test_head"
| `Test_head n -> Printf.sprintf "test_head~%d" n
| `Test_prevalidation -> "test_prevalidation"
| `Hash h -> Block_hash.to_b48check h in
| `Hash h -> Block_hash.to_b58check h in
let destruct = parse_block in
RPC.Arg.make ~name ~descr ~construct ~destruct ()
@ -297,7 +297,7 @@ module Blocks = struct
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. \
~description: "Try to complete a prefix of a Base58Check-encoded data. \
This RPC is actually able to complete hashes of \
block, operations, public_keys and contracts."
~input: empty
@ -388,9 +388,9 @@ module Operations = struct
let name = "operation_id" in
let descr =
"A operation identifier in hexadecimal." in
let construct = Operation_hash.to_b48check in
let construct = Operation_hash.to_b58check in
let destruct h =
try Ok (Operation_hash.of_b48check h)
try Ok (Operation_hash.of_b58check h)
with _ -> Error "Can't parse hash" in
RPC.Arg.make ~name ~descr ~construct ~destruct ()
@ -439,9 +439,9 @@ module Protocols = struct
let name = "protocol_id" in
let descr =
"A protocol identifier in hexadecimal." in
let construct = Protocol_hash.to_b48check in
let construct = Protocol_hash.to_b58check in
let destruct h =
try Ok (Protocol_hash.of_b48check h)
try Ok (Protocol_hash.of_b58check h)
with _ -> Error "Can't parse hash" in
RPC.Arg.make ~name ~descr ~construct ~destruct ()
@ -639,7 +639,7 @@ let complete =
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. \
~description: "Try to complete a prefix of a Base58Check-encoded data. \
This RPC is actually able to complete hashes of \
block and hashes of operations."
~input: empty

View File

@ -25,13 +25,16 @@ module Ed25519 = struct
let append_signature key msg =
MBytes.concat msg (sign key msg)
module Public_key_hash = Hash.Make_Blake2B(Base48)(struct
module Public_key_hash = Hash.Make_Blake2B(Base58)(struct
let name = "Ed25519.Public_key_hash"
let title = "An Ed25519 public key ID"
let b48check_prefix = Base48.Prefix.ed25519_public_key_hash
let b58check_prefix = Base58.Prefix.ed25519_public_key_hash
let size = Some 20
end)
let () =
Base58.check_encoded_prefix Public_key_hash.b58check_encoding "tz1" 36
let hash v =
Public_key_hash.hash_bytes
[ Sodium.Sign.Bigbytes.of_public_key v ]
@ -40,46 +43,54 @@ module Ed25519 = struct
let secret, pub = Sodium.Sign.random_keypair () in
(hash pub, pub, secret)
type Base48.data +=
type Base58.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
let b58check_public_key_encoding =
Base58.register_encoding
~prefix: Base58.Prefix.ed25519_public_key
~length:Sodium.Sign.public_key_size
~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
let b58check_secret_key_encoding =
Base58.register_encoding
~prefix: Base58.Prefix.ed25519_secret_key
~length:Sodium.Sign.secret_key_size
~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
let b58check_signature_encoding =
Base58.register_encoding
~prefix: Base58.Prefix.ed25519_signature
~length:Sodium.Sign.signature_size
~to_raw:MBytes.to_string
~of_raw:(fun s -> Some (MBytes.of_string s))
~wrap:(fun x -> Signature x)
let () =
Base58.check_encoded_prefix b58check_public_key_encoding "edpk" 54 ;
Base58.check_encoded_prefix b58check_secret_key_encoding "edsk" 98 ;
Base58.check_encoded_prefix b58check_signature_encoding "edsig" 99
let public_key_encoding =
let open Data_encoding in
splitted
~json:
(describe
~title: "An Ed25519 public key (Base48Check encoded)" @@
~title: "An Ed25519 public key (Base58Check encoded)" @@
conv
(fun s -> Base48.simple_encode b48check_public_key_encoding s)
(fun s -> Base58.simple_encode b58check_public_key_encoding s)
(fun s ->
match Base48.simple_decode b48check_public_key_encoding s with
match Base58.simple_decode b58check_public_key_encoding s with
| Some x -> x
| None -> Data_encoding.Json.cannot_destruct
"Ed25519 public key: unexpected prefix.")
@ -95,11 +106,11 @@ module Ed25519 = struct
splitted
~json:
(describe
~title: "An Ed25519 secret key (Base48Check encoded)" @@
~title: "An Ed25519 secret key (Base58Check encoded)" @@
conv
(fun s -> Base48.simple_encode b48check_secret_key_encoding s)
(fun s -> Base58.simple_encode b58check_secret_key_encoding s)
(fun s ->
match Base48.simple_decode b48check_secret_key_encoding s with
match Base58.simple_decode b58check_secret_key_encoding s with
| Some x -> x
| None -> Data_encoding.Json.cannot_destruct
"Ed25519 secret key: unexpected prefix.")
@ -115,11 +126,11 @@ module Ed25519 = struct
splitted
~json:
(describe
~title: "An Ed25519 signature (Base48Check encoded)" @@
~title: "An Ed25519 signature (Base58Check encoded)" @@
conv
(fun s -> Base48.simple_encode b48check_signature_encoding s)
(fun s -> Base58.simple_encode b58check_signature_encoding s)
(fun s ->
match Base48.simple_decode b48check_signature_encoding s with
match Base58.simple_decode b58check_signature_encoding s with
| Some x -> x
| None -> Data_encoding.Json.cannot_destruct
"Ed25519 signature: unexpected prefix.")
@ -171,14 +182,17 @@ module Make(Param : sig val name: string end)() = struct
include Error_monad.Make()
end
module Logging = Logging.Make(Param)
module Base48 = struct
include Base48
module Base58 = struct
include Base58
let simple_encode enc s = simple_encode enc s
let simple_decode enc s = simple_decode enc s
include Make(struct type context = Context.t end)
let decode s = decode s
end
module Context = struct
include Context
let register_resolver = Base48.register_resolver
let complete = Base48.complete
let register_resolver = Base58.register_resolver
let complete ctxt s = Base58.complete ctxt s
end
module type PACKED_PROTOCOL = sig
@ -187,8 +201,7 @@ module Make(Param : sig val name: string end)() = struct
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
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
end

View File

@ -55,8 +55,7 @@ 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
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
val __cast: (module PACKED_PROTOCOL) -> (module Protocol.PACKED_PROTOCOL)
|}

View File

@ -135,6 +135,5 @@ 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
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end

View File

@ -16,8 +16,7 @@ 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
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
type net_id = Store.net_id = Net of Block_hash.t
@ -158,16 +157,16 @@ let create_files dir units =
Lwt.return files
let extract dirname hash units =
let source_dir = dirname // Protocol_hash.to_short_b48check hash // "src" in
let source_dir = dirname // Protocol_hash.to_short_b58check hash // "src" in
create_files source_dir units >|= fun _files ->
Tezos_compiler.Meta.to_file source_dir ~hash
(List.map (fun {name} -> String.capitalize_ascii name) units)
let do_compile hash units =
let datadir = get_datadir () in
let source_dir = datadir // Protocol_hash.to_short_b48check hash // "src" in
let log_file = datadir // Protocol_hash.to_short_b48check hash // "LOG" in
let plugin_file = datadir // Protocol_hash.to_short_b48check hash //
let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in
let log_file = datadir // Protocol_hash.to_short_b58check hash // "LOG" in
let plugin_file = datadir // Protocol_hash.to_short_b58check hash //
Format.asprintf "protocol_%a.cmxs" Protocol_hash.pp hash
in
create_files source_dir units >>= fun _files ->

View File

@ -68,8 +68,7 @@ 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
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
type component = Tezos_compiler.Protocol.component = {

View File

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

View File

@ -24,12 +24,12 @@ type contract = t
type error += Invalid_contract_notation of string
let to_b48check = function
| Default pbk -> Ed25519.Public_key_hash.to_b48check pbk
| Hash h -> Contract_hash.to_b48check h
let to_b58check = function
| Default pbk -> Ed25519.Public_key_hash.to_b58check pbk
| Hash h -> Contract_hash.to_b58check h
let of_b48check s =
match Base48.decode s with
let of_b58check s =
match Base58.decode s with
| Some (Ed25519.Public_key_hash.Hash h) -> ok (Default h)
| Some (Contract_hash.Hash h) -> ok (Hash h)
| _ -> error (Invalid_contract_notation s)
@ -57,9 +57,9 @@ let encoding =
])
~json:
(conv
to_b48check
to_b58check
(fun s ->
match of_b48check s with
match of_b58check s with
| Ok s -> s
| Error _ -> Json.cannot_destruct "Invalid contract notation.")
string)
@ -113,13 +113,13 @@ let generic_contract ~manager ~delegate ~spendable ~delegatable ~script =
Hash (Contract_hash.hash_bytes [data])
let arg =
let construct = to_b48check in
let construct = to_b58check in
let destruct hash =
match of_b48check hash with
match of_b58check hash with
| Error _ -> Error "Cannot parse contract id"
| Ok contract -> Ok contract in
RPC.Arg.make
~descr: "A contract identifier encoded in b48check."
~descr: "A contract identifier encoded in b58check."
~name: "contract_id"
~construct
~destruct

View File

@ -40,9 +40,9 @@ val generic_contract :
type error += Invalid_contract_notation of string
val to_b48check: contract -> string
val to_b58check: contract -> string
val of_b48check: string -> contract tzresult
val of_b58check: string -> contract tzresult
(** {2 Serializers} ***********************************************************)

View File

@ -42,7 +42,7 @@ let () =
~pp:(fun ppf (contract, exp, found) ->
Format.fprintf ppf
"Unexpected counter %ld for contract %s (expected %ld)"
found (Contract_repr.to_b48check contract) exp)
found (Contract_repr.to_b58check contract) exp)
Data_encoding.
(obj3
(req "contract" Contract_repr.encoding)
@ -309,4 +309,4 @@ let init c =
Storage.Contract.Global_counter.init c 0l
let pp fmt c =
Format.pp_print_string fmt (Contract_repr.to_b48check c)
Format.pp_print_string fmt (Contract_repr.to_b58check c)

View File

@ -300,7 +300,7 @@ let rec unparse_data
| Timestamp_t, t ->
String (-1, Timestamp.to_notation t)
| Contract_t _, (_, _, c) ->
String (-1, Contract.to_b48check c)
String (-1, Contract.to_b58check c)
| Signature_t, s ->
let text =
Hex_encode.hex_encode
@ -309,7 +309,7 @@ let rec unparse_data
| Tez_t, v ->
String (-1, Tez.to_string v)
| Key_t, k ->
String (-1, Ed25519.Public_key_hash.to_b48check k)
String (-1, Ed25519.Public_key_hash.to_b58check k)
| Pair_t (tl, tr), (l, r) ->
let l = unparse_data tl l in
let r = unparse_data tr r in
@ -671,7 +671,7 @@ let rec parse_data
traced (fail (Invalid_kind (location expr, [ String_kind ; Int_kind ], kind expr)))
(* IDs *)
| Key_t, String (_, s) -> begin try
return (Ed25519.Public_key_hash.of_b48check s)
return (Ed25519.Public_key_hash.of_b58check s)
with _ -> fail (error ())
end
| Key_t, expr ->
@ -691,7 +691,7 @@ let rec parse_data
(* Contracts *)
| Contract_t (ty1, ty2), String (loc, s) ->
traced @@
(Lwt.return (Contract.of_b48check s)) >>=? fun c ->
(Lwt.return (Contract.of_b58check s)) >>=? fun c ->
parse_contract ctxt ty1 ty2 loc c >>=? fun _ ->
return (ty1, ty2, c)
| Contract_t _, expr ->

View File

@ -137,7 +137,7 @@ let code_encoding =
let hash_expr data =
let bytes = Data_encoding.Binary.to_bytes expr_encoding data in
Script_expr_hash.(hash_bytes [ bytes ] |> to_b48check)
Script_expr_hash.(hash_bytes [ bytes ] |> to_b58check)
type t =
| No_script

View File

@ -177,9 +177,9 @@ module Context = struct
module Key = struct
let public_key_hash_arg =
let construct = Ed25519.Public_key_hash.to_b48check in
let construct = Ed25519.Public_key_hash.to_b58check in
let destruct hash =
match Ed25519.Public_key_hash.of_b48check hash with
match Ed25519.Public_key_hash.of_b58check hash with
| exception _ -> Error "Cannot parse public key hash"
| public_key_hash -> Ok public_key_hash in
RPC.Arg.make

View File

@ -377,6 +377,6 @@ let register_resolvers (module H : Hash.HASH) prefixes =
Set.empty hs |>
Set.elements in
Context.register_resolver H.b48check_encoding resolve
Context.register_resolver H.b58check_encoding resolve

View File

@ -308,8 +308,8 @@ module Contract : sig
type contract = t
val arg: contract RPC.Arg.arg
val to_b48check: contract -> string
val of_b48check: string -> contract tzresult
val to_b58check: contract -> string
val of_b58check: string -> contract tzresult
val default_contract: public_key_hash -> contract
val is_default: contract -> public_key_hash option

View File

@ -8,48 +8,55 @@
(**************************************************************************)
module Prefix = struct
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... *)
(* 20 *)
let contract_hash = "\003\099\029" (* TZ(36) *)
(* 32 *)
let nonce_hash = "\069\220\169" (* nce(53) *)
let script_expr_hash = "\013\044\064\027" (* expr(54) *)
let random_state_hash = "\076\064\204" (* rng(53): never used... *)
end
module State_hash = Hash.Make_Blake2B(Base48)(struct
module State_hash = Hash.Make_Blake2B(Base58)(struct
let name = "random"
let title = "A random generation state"
let b48check_prefix = Prefix.random_state_hash
let b58check_prefix = Prefix.random_state_hash
let size = None
end)
module State_hash_set = Hash_set(State_hash)
module State_hash_map = Hash_map(State_hash)
module Nonce_hash = Hash.Make_Blake2B(Base48)(struct
module Nonce_hash = Hash.Make_Blake2B(Base58)(struct
let name = "cycle_nonce"
let title = "A nonce hash"
let b48check_prefix = Prefix.nonce_hash
let b58check_prefix = Prefix.nonce_hash
let size = None
end)
module Nonce_hash_set = Hash_set(Nonce_hash)
module Nonce_hash_map = Hash_map(Nonce_hash)
module Script_expr_hash = Hash.Make_Blake2B(Base48)(struct
module Script_expr_hash = Hash.Make_Blake2B(Base58)(struct
let name = "script_expr"
let title = "A script expression ID"
let b48check_prefix = Prefix.script_expr_hash
let b58check_prefix = Prefix.script_expr_hash
let size = None
end)
module Script_expr_hash_set = Hash_set(Script_expr_hash)
module Script_expr_hash_map = Hash_map(Script_expr_hash)
module Contract_hash = Hash.Make_Blake2B(Base48)(struct
module Contract_hash = Hash.Make_Blake2B(Base58)(struct
let name = "Contract_hash"
let title = "A contract ID"
let b48check_prefix = Prefix.contract_hash
let b58check_prefix = Prefix.contract_hash
let size = Some 20
end)
module Contract_hash_set = Hash_set(Contract_hash)
module Contract_hash_map = Hash_map(Contract_hash)
let () =
Base58.check_encoded_prefix Contract_hash.b58check_encoding "TZ1" 36 ;
Base58.check_encoded_prefix Script_expr_hash.b58check_encoding "expr" 54 ;
Base58.check_encoded_prefix Nonce_hash.b58check_encoding "nce" 53 ;
Base58.check_encoded_prefix State_hash.b58check_encoding "rng" 53

View File

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

View File

@ -1,20 +0,0 @@
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

View File

@ -0,0 +1,19 @@
type 'a encoding
val simple_decode: 'a encoding -> string -> 'a option
val simple_encode: 'a encoding -> 'a -> string
type data = ..
val register_encoding:
prefix: string ->
length: int ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> data) ->
'a encoding
val check_encoded_prefix: 'a encoding -> string -> int -> unit
val decode: string -> data option

View File

@ -9,7 +9,6 @@ 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
'a Base58.encoding -> (t -> string -> 'a list Lwt.t) -> unit
val complete:
?alphabet:string -> t -> string -> string list Lwt.t
val complete: t -> string -> string list Lwt.t

View File

@ -40,14 +40,14 @@ module type HASH = sig
include MINIMAL_HASH
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val of_b58check: string -> t
val to_b58check: t -> string
val to_short_b58check: 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
type Base58.data += Hash of t
val b58check_encoding: t Base58.encoding
end
@ -65,7 +65,7 @@ end
module type PrefixedName = sig
include Name
val b48check_prefix : string
val b58check_prefix : string
end
(** Builds a new Hash type using Sha256. *)
@ -75,10 +75,11 @@ module Make_Blake2B
(Register : sig
val register_encoding:
prefix: string ->
length: int ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> Base48.data) ->
'a Base48.encoding
wrap: ('a -> Base58.data) ->
'a Base58.encoding
end)
(Name : PrefixedName) : HASH

View File

@ -1,238 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
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
Bytes.set str (int_of_char alphabet.[i]) (char_of_int i) ;
done ;
Bytes.to_string str
let default_alphabet =
"eE2NXaQvHPqDdTJxfF36jb7VRmp9tAyMgG4L5cS8CKrnksBh"
let default_decode_alphabet = decode_alphabet default_alphabet
let count_trailing_char s c =
let len = String.length s in
let rec loop i =
if i < 0 then len
else if String.get s i <> c then (len-i-1)
else loop (i-1) in
loop (len-1)
let of_char ?(alphabet=default_decode_alphabet) x =
let pos = String.get alphabet (int_of_char x) in
if pos = '\255' then failwith "Invalid data" ;
int_of_char pos
let to_char ?(alphabet=default_alphabet) x =
alphabet.[x]
let forty_eight = Z.of_int 48
let raw_encode ?alphabet s =
let zero, alphabet =
match alphabet with
| None -> default_alphabet.[0], default_alphabet
| Some alphabet ->
if String.length alphabet <> 48 then invalid_arg "Base48.encode" ;
alphabet.[0], decode_alphabet alphabet in
let zeros = count_trailing_char s '\000' in
let len = String.length s in
let res_len = (len * 8 + 4) / 5 in
let res = Bytes.make res_len '\000' in
let s = Z.of_bits s in
let rec loop s i =
if s = Z.zero then i else
let s, r = Z.div_rem s forty_eight in
Bytes.set res i (to_char ~alphabet (Z.to_int r));
loop s (i+1) in
let i = loop s 0 in
let res = Bytes.sub_string res 0 i in
res ^ String.make zeros zero
let raw_decode ?alphabet s =
let zero, alphabet =
match alphabet with
| None -> default_alphabet.[0], default_decode_alphabet
| Some alphabet ->
if String.length alphabet <> 48 then invalid_arg "Base48.decode" ;
alphabet.[0], decode_alphabet alphabet in
let zeros = count_trailing_char s zero in
let len = String.length s in
let rec loop res i =
if i < 0 then res else
let x = Z.of_int (of_char ~alphabet (String.get s i)) in
let res = Z.(add x (mul res forty_eight)) in
loop res (i-1)
in
let res = Z.to_bits @@ loop Z.zero (len - zeros - 1) in
let res_tzeros = count_trailing_char res '\000' in
String.sub res 0 (String.length res - res_tzeros) ^
String.make zeros '\000'
let checksum s =
let bytes = Bytes.of_string s in
let hash =
let open Sodium.Generichash in
let state = init ~size:32 () in
Bytes.update state bytes ;
Bytes.of_hash (final state) in
Bytes.sub_string hash 0 4
(* Prepend a 4 bytes cryptographic checksum before encoding string s *)
let safe_encode ?alphabet s =
raw_encode ?alphabet (s ^ checksum s)
let safe_decode ?alphabet s =
let s = raw_decode ?alphabet s in
let len = String.length s in
let msg = String.sub s 0 (len-4)
and msg_hash = String.sub s (len-4) 4 in
if msg_hash <> checksum msg then
invalid_arg "safe_decode" ;
msg
type data = ..
type 'a encoding = {
prefix: string;
to_raw: 'a -> string ;
of_raw: string -> 'a option ;
wrap: 'a -> data ;
}
let simple_decode ?alphabet { prefix ; of_raw } s =
safe_decode ?alphabet s |>
remove_prefix ~prefix |>
Utils.apply_option ~f:of_raw
let simple_encode ?alphabet { prefix ; to_raw } d =
safe_encode ?alphabet (prefix ^ to_raw d)
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
| [] -> None
| Encoding { prefix ; of_raw ; wrap } :: encodings ->
match remove_prefix ~prefix s with
| None -> find s encodings
| Some msg -> of_raw msg |> Utils.map_option ~f:wrap in
let s = safe_decode ?alphabet s in
find s !encodings
end
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
| [] -> 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
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 ed25519_public_key_hash = "\003"
let cryptobox_public_key_hash = "\004"
let ed25519_public_key = "\012"
let ed25519_secret_key = "\013"
let ed25519_signature = "\014"
let protocol_prefix = "\015"
end

312
src/utils/base58.ml Normal file
View File

@ -0,0 +1,312 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Utils
open Lwt.Infix
let base = 58
let zbase = Z.of_int base
let log2 x = log x /. log 2.
let log2_base = log2 (float_of_int base)
module Alphabet = struct
type t = { encode: string ; decode: string }
let make alphabet =
if String.length alphabet <> base then
invalid_arg "Base58: invalid alphabet (length)" ;
let str = Bytes.make 256 '\255' in
for i = 0 to String.length alphabet - 1 do
let char = int_of_char alphabet.[i] in
if Bytes.get str char <> '\255' then
Format.kasprintf invalid_arg
"Base58: invalid alphabet (dup '%c' %d %d)"
(char_of_int char) (int_of_char @@ Bytes.get str char) i ;
Bytes.set str char (char_of_int i) ;
done ;
{ encode = alphabet ; decode = Bytes.to_string str }
let bitcoin =
make "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
let ripple =
make "rpshnaf39wBUDNEGHJKLM4PQRST7VWXYZ2bcdeCg65jkm8oFqi1tuvAxyz"
let flickr =
make "123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ"
let default = bitcoin
end
let count_trailing_char s c =
let len = String.length s in
let rec loop i =
if i < 0 then len
else if String.get s i <> c then (len-i-1)
else loop (i-1) in
loop (len-1)
let count_leading_char s c =
let len = String.length s in
let rec loop i =
if i = len then len
else if String.get s i <> c then i
else loop (i+1) in
loop 0
let of_char ?(alphabet=Alphabet.default) x =
let pos = String.get alphabet.decode (int_of_char x) in
if pos = '\255' then failwith "Invalid data" ;
int_of_char pos
let to_char ?(alphabet=Alphabet.default) x =
alphabet.encode.[x]
let raw_encode ?(alphabet=Alphabet.default) s =
let len = String.length s in
let s = String.init len (fun i -> String.get s (len - i - 1)) in
let zero = alphabet.encode.[0] in
let zeros = count_trailing_char s '\000' in
let res_len = (len * 8 + 4) / 5 in
let res = Bytes.make res_len '\000' in
let s = Z.of_bits s in
let rec loop s =
if s = Z.zero then 0 else
let s, r = Z.div_rem s zbase in
let i = loop s in
Bytes.set res i (to_char ~alphabet (Z.to_int r)) ;
i + 1 in
let i = loop s in
let res = Bytes.sub_string res 0 i in
String.make zeros zero ^ res
let raw_decode ?(alphabet=Alphabet.default) s =
let zero = alphabet.encode.[0] in
let zeros = count_leading_char s zero in
let len = String.length s in
let rec loop res i =
if i = len then res else
let x = Z.of_int (of_char ~alphabet (String.get s i)) in
let res = Z.(add x (mul res zbase)) in
loop res (i+1)
in
let res = Z.to_bits @@ loop Z.zero zeros in
let res_tzeros = count_trailing_char res '\000' in
let len = String.length res - res_tzeros in
String.make zeros '\000' ^
String.init len (fun i -> String.get res (len - i - 1))
let checksum s =
let hash =
Nocrypto.Hash.digest `SHA256 @@
Nocrypto.Hash.digest `SHA256 @@
Cstruct.of_string s in
let res = Bytes.make 4 '\000' in
Cstruct.blit_to_bytes hash 0 res 0 4 ;
Bytes.to_string res
(* Append a 4-bytes cryptographic checksum before encoding string s *)
let safe_encode ?alphabet s =
raw_encode ?alphabet (s ^ checksum s)
let safe_decode ?alphabet s =
let s = raw_decode ?alphabet s in
let len = String.length s in
let msg = String.sub s 0 (len-4)
and msg_hash = String.sub s (len-4) 4 in
if msg_hash <> checksum msg then
invalid_arg "safe_decode" ;
msg
type data = ..
type 'a encoding = {
prefix: string ;
length: int ;
encoded_prefix: string ;
encoded_length: int ;
to_raw: 'a -> string ;
of_raw: string -> 'a option ;
wrap: 'a -> data ;
}
let simple_decode ?alphabet { prefix ; of_raw } s =
safe_decode ?alphabet s |>
remove_prefix ~prefix |>
Utils.apply_option ~f:of_raw
let simple_encode ?alphabet { prefix ; to_raw } d =
safe_encode ?alphabet (prefix ^ to_raw d)
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 check_ambiguous_prefix prefix encodings =
List.iter
(fun (Encoding { encoded_prefix = s }) ->
if remove_prefix s prefix <> None ||
remove_prefix prefix s <> None then
Format.ksprintf invalid_arg
"Base58.register_encoding: duplicate prefix: %S, %S." s prefix)
encodings
let make_encoded_prefix prefix len =
let zeros = safe_encode (prefix ^ String.make len '\000')
and ones = safe_encode (prefix ^ String.make len '\255') in
let len = String.length zeros in
if String.length ones <> len then
Format.ksprintf invalid_arg
"Base58.registred_encoding: variable length encoding." ;
let rec loop i =
if i = len then len
else if zeros.[i] = ones.[i] then loop (i+1)
else i in
let len = loop 0 in
if len = 0 then
invalid_arg
"Base58.register_encoding: not a unique prefix." ;
String.sub zeros 0 len, String.length zeros
let register_encoding ~prefix ~length ~to_raw ~of_raw ~wrap =
let to_raw x =
let s = to_raw x in assert (String.length s = length) ; s in
let of_raw s = assert (String.length s = length) ; of_raw s in
let encoded_prefix, encoded_length = make_encoded_prefix prefix length in
check_ambiguous_prefix encoded_prefix !encodings ;
let encoding =
{ prefix ; length ; encoded_prefix ; encoded_length ;
to_raw ; of_raw ; wrap } in
encodings := Encoding encoding :: !encodings ;
encoding
let check_encoded_prefix enc p l =
if enc.encoded_prefix <> p then
Format.kasprintf failwith
"Unexpected prefix %s (expected %s)"
p enc.encoded_prefix ;
if enc.encoded_length <> l then
Format.kasprintf failwith
"Unexpected encoded length %d for %s (expected %d)"
l p enc.encoded_length
let decode ?alphabet s =
let rec find s = function
| [] -> None
| Encoding { prefix ; of_raw ; wrap } :: encodings ->
match remove_prefix ~prefix s with
| None -> find s encodings
| Some msg -> of_raw msg |> Utils.map_option ~f:wrap in
let s = safe_decode ?alphabet s in
find s !encodings
end
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) =
resolvers := Resolver { encoding ; resolver } :: !resolvers
type context = R.context
let partial_decode ?(alphabet=Alphabet.default) request len =
let zero = alphabet.encode.[0] in
let last = alphabet.encode.[base-1] in
let n = String.length request in
let min = raw_decode ~alphabet (request ^ String.make (len - n) zero) in
let max = raw_decode ~alphabet (request ^ String.make (len - n) last) in
let prefix_len = Utils.common_prefix min max in
String.sub min 0 prefix_len
let complete ?alphabet context request =
let rec find s = function
| [] -> Lwt.return_nil
| Resolver { encoding ; resolver } :: resolvers ->
if not (has_prefix ~prefix:encoding.encoded_prefix s) then
find s resolvers
else
let prefix =
partial_decode ?alphabet request encoding.encoded_length in
let len = String.length prefix in
let ignored = String.length encoding.prefix in
if len <= ignored then
Lwt.return_nil
else begin
assert (String.sub prefix 0 ignored = encoding.prefix) ;
let msg = String.sub prefix ignored (len - ignored) in
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
end in
find request !resolvers
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
(* 32 *)
let block_hash = "\001\052" (* B(51) *)
let operation_hash = "\005\116" (* o(51) *)
let protocol_hash = "\002\170" (* P(51) *)
(* 20 *)
let ed25519_public_key_hash = "\006\161\159" (* tz1(36) *)
(* 16 *)
let cryptobox_public_key_hash = "\153\103" (* id(30) *)
(* 32 *)
let ed25519_public_key = "\013\015\037\217" (* edpk(54) *)
(* 64 *)
let ed25519_secret_key = "\043\246\078\007" (* edsk(98) *)
let ed25519_signature = "\009\245\205\134\018" (* edsig(99) *)
end

View File

@ -7,51 +7,18 @@
(* *)
(**************************************************************************)
(** {1 Prefixed Base48Check encodings} *)
(** {1 Prefixed Base58Check 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 cryptobox_public_key_hash: string
(** Prefix for Ed25519 public key hashes: "\004". *)
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
@ -63,7 +30,10 @@ 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;
prefix: string ;
length: int ;
encoded_prefix: string ;
encoded_length: int ;
to_raw: 'a -> string ;
of_raw: string -> 'a option ;
wrap: 'a -> data ;
@ -77,33 +47,44 @@ type 'a encoding = private {
the generic function [decode]). *)
val register_encoding:
prefix: string ->
length: int ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> data) ->
'a encoding
val check_encoded_prefix: 'a encoding -> string -> int -> unit
module Alphabet : sig
type t
val bitcoin: t
val ripple: t
val flickr: t
val make: string -> t
end
(** Encoder for a given kind of data. *)
val simple_encode: ?alphabet:string -> 'a encoding -> 'a -> string
val simple_encode: ?alphabet:Alphabet.t -> '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
val simple_decode: ?alphabet:Alphabet.t -> '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
val decode: ?alphabet:Alphabet.t -> string -> data option
(** {2 Completion of partial Base48Check value} *)
(** {2 Completion of partial Base58Check 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
(** Try to complete a prefix of a Base58Check 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
data. Note that a prefix of [n] characters of a Base58-encoded
value provides at least [n/2] bytes of a prefix of the original value. *)
val complete: ?alphabet:string -> string -> string list Lwt.t
val complete: ?alphabet:Alphabet.t -> string -> string list Lwt.t
(** {1 Low-level: distinct registering function for economical protocol} *)
@ -113,28 +94,33 @@ module Make(C: sig type context end) : sig
val register_encoding:
prefix: string ->
length: int ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> data) ->
'a encoding
val decode: ?alphabet:string -> string -> data option
val decode: ?alphabet:Alphabet.t -> 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
?alphabet:Alphabet.t -> C.context -> string -> string list Lwt.t
end
(** {2 Low-level Base48Check encodings} *)
(** {2 Low-level Base58Check encodings} *)
(** Base48Check-encoding/decoding functions (with error detections). *)
val safe_encode: ?alphabet:string -> string -> string
val safe_decode: ?alphabet:string -> string -> string
(** Base58Check-encoding/decoding functions (with error detections). *)
val safe_encode: ?alphabet:Alphabet.t -> string -> string
val safe_decode: ?alphabet:Alphabet.t -> string -> string
(** Base48-encoding/decoding functions (without error detections). *)
val raw_encode: ?alphabet:string -> string -> string
val raw_decode: ?alphabet:string -> string -> string
(** Base58-encoding/decoding functions (without error detections). *)
val raw_encode: ?alphabet:Alphabet.t -> string -> string
val raw_decode: ?alphabet:Alphabet.t -> string -> string
(**/**)
val partial_decode: ?alphabet:Alphabet.t -> string -> int -> string
val make_encoded_prefix: string -> int -> string * int

View File

@ -18,13 +18,16 @@ type nonce = Sodium.Box.nonce
type target = Z.t
exception TargetNot256Bit
module Public_key_hash = Hash.Make_Blake2B (Base48) (struct
module Public_key_hash = Hash.Make_Blake2B (Base58) (struct
let name = "Crypto_box.Public_key_hash"
let title = "A Cryptobox public key ID"
let b48check_prefix = Base48.Prefix.cryptobox_public_key_hash
let b58check_prefix = Base58.Prefix.cryptobox_public_key_hash
let size = Some 16
end)
let () =
Base58.check_encoded_prefix Public_key_hash.b58check_encoding "id" 30
let hash pk =
Public_key_hash.hash_bytes [Sodium.Box.Bigbytes.of_public_key pk]

View File

@ -57,14 +57,14 @@ module type HASH = sig
include MINIMAL_HASH
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val of_b58check: string -> t
val to_b58check: t -> string
val to_short_b58check: 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
type Base58.data += Hash of t
val b58check_encoding: t Base58.encoding
end
@ -76,7 +76,7 @@ end
module type PrefixedName = sig
include Name
val b48check_prefix: string
val b58check_prefix: string
end
(*-- Type specific Hash builder ---------------------------------------------*)
@ -188,31 +188,34 @@ end
module Make_Blake2B (R : sig
val register_encoding:
prefix: string ->
length:int ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> Base48.data) ->
'a Base48.encoding
wrap: ('a -> Base58.data) ->
'a Base58.encoding
end) (K : PrefixedName) = struct
include Make_minimal_Blake2B(K)
(* Serializers *)
type Base48.data += Hash of t
type Base58.data += Hash of t
let b48check_encoding =
let b58check_encoding =
R.register_encoding
~prefix: K.b48check_prefix
~prefix: K.b58check_prefix
~length:size
~wrap: (fun s -> Hash s)
~of_raw:(fun h -> Some (of_string h)) ~to_raw:to_string
let of_b48check s =
match Base48.simple_decode b48check_encoding s with
let of_b58check s =
match Base58.simple_decode b58check_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_b58check s = Base58.simple_encode b58check_encoding s
let to_short_b48check s = String.sub (to_b48check s) 0 12
let to_short_b58check s =
String.sub (to_b58check s) 0 (10 + 2 * String.length K.b58check_prefix)
let encoding =
let open Data_encoding in
@ -220,17 +223,17 @@ module Make_Blake2B (R : sig
~binary:
(conv to_bytes of_bytes (Fixed.bytes size))
~json:
(describe ~title: (K.title ^ " (Base48Check-encoded Sha256)") @@
conv to_b48check (Data_encoding.Json.wrap_error of_b48check) string)
(describe ~title: (K.title ^ " (Base58Check-encoded Sha256)") @@
conv to_b58check (Data_encoding.Json.wrap_error of_b58check) string)
let param ?(name=K.name) ?(desc=K.title) t =
Cli_entries.param ~name ~desc (fun _ str -> Lwt.return (of_b48check str)) t
Cli_entries.param ~name ~desc (fun _ str -> Lwt.return (of_b58check str)) t
let pp ppf t =
Format.pp_print_string ppf (to_b48check t)
Format.pp_print_string ppf (to_b58check t)
let pp_short ppf t =
Format.pp_print_string ppf (to_short_b48check t)
Format.pp_print_string ppf (to_short_b58check t)
end
@ -268,10 +271,10 @@ module Hash_table (Hash : MINIMAL_HASH)
(*-- Pre-instanciated hashes ------------------------------------------------*)
module Block_hash =
Make_Blake2B (Base48) (struct
Make_Blake2B (Base58) (struct
let name = "Block_hash"
let title = "A Tezos block ID"
let b48check_prefix = Base48.Prefix.block_hash
let b58check_prefix = Base58.Prefix.block_hash
let size = None
end)
@ -280,10 +283,10 @@ module Block_hash_map = Hash_map (Block_hash)
module Block_hash_table = Hash_table (Block_hash)
module Operation_hash =
Make_Blake2B (Base48) (struct
Make_Blake2B (Base58) (struct
let name = "Operation_hash"
let title = "A Tezos operation ID"
let b48check_prefix = Base48.Prefix.operation_hash
let b58check_prefix = Base58.Prefix.operation_hash
let size = None
end)
@ -292,10 +295,10 @@ module Operation_hash_map = Hash_map (Operation_hash)
module Operation_hash_table = Hash_table (Operation_hash)
module Protocol_hash =
Make_Blake2B (Base48) (struct
Make_Blake2B (Base58) (struct
let name = "Protocol_hash"
let title = "A Tezos protocol ID"
let b48check_prefix = Base48.Prefix.protocol_hash
let b58check_prefix = Base58.Prefix.protocol_hash
let size = None
end)
@ -310,3 +313,7 @@ module Generic_hash =
let size = None
end)
let () =
Base58.check_encoded_prefix Block_hash.b58check_encoding "B" 51 ;
Base58.check_encoded_prefix Operation_hash.b58check_encoding "o" 51 ;
Base58.check_encoded_prefix Protocol_hash.b58check_encoding "P" 51

View File

@ -49,14 +49,14 @@ module type HASH = sig
include MINIMAL_HASH
val of_b48check: string -> t
val to_b48check: t -> string
val to_short_b48check: t -> string
val of_b58check: string -> t
val to_b58check: t -> string
val to_short_b58check: 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
type Base58.data += Hash of t
val b58check_encoding: t Base58.encoding
end
@ -74,7 +74,7 @@ end
module type PrefixedName = sig
include Name
val b48check_prefix : string
val b58check_prefix : string
end
(** Builds a new Hash type using Sha256. *)
@ -83,10 +83,11 @@ module Make_Blake2B
(Register : sig
val register_encoding:
prefix: string ->
length: int ->
to_raw: ('a -> string) ->
of_raw: (string -> 'a option) ->
wrap: ('a -> Base48.data) ->
'a Base48.encoding
wrap: ('a -> Base58.data) ->
'a Base58.encoding
end)
(Name : PrefixedName) : HASH

View File

@ -293,6 +293,12 @@ bisect:
#####
generate_hash: ../src/minutils/utils.cmx ../src/minutils/compare.cmx ../src/minutils/mBytes.cmx ../src/utils/base58.cmx ../src/minutils/hex_encode.cmx ../src/minutils/data_encoding.cmx ../src/utils/cli_entries.cmx ../src/utils/hash.cmx generate_hash.ml
ocamlfind ocamlopt -o $@ -linkpkg -package cstruct -package zarith -package ezjsonm -package sodium -package ocplib-json-typed.bson -package lwt.unix -package nocrypto -I ../src/utils/ -I ../src/minutils $^
#####
lib/assert.cmx: lib/assert.cmi
lib/assert.cmi: ../src/node/db/persist.cmi

63
test/generate_hash.ml Normal file
View File

@ -0,0 +1,63 @@
open Base58
open Hash
open Lwt.Infix
type generator =
Generator : {
encoding: 'h encoding ;
generator: string -> 'h list ;
} -> generator
let generators = ref []
let register_generator
(type a)
(encoding : a encoding)
(generator : string -> a list) =
generators := Generator { encoding ; generator } :: !generators
let register (type t) (enc: t Base58.encoding) =
register_generator enc
(fun s ->
match
enc.of_raw
(s ^
Sodium.Random.Bytes.generate (enc.length - String.length s)) with
| Some x -> [x]
| None -> [])
let generate ?alphabet request =
let rec find s = function
| [] -> []
| Generator { encoding ; generator } :: generators ->
if not (Utils.has_prefix ~prefix:encoding.encoded_prefix s) then
find s generators
else
let prefix =
partial_decode ?alphabet request encoding.encoded_length in
let len = String.length prefix in
let ignored = String.length encoding.prefix in
if len <= ignored then
[]
else begin
(* assert (String.sub prefix 0 ignored = encoding.prefix) ; *)
let msg = String.sub prefix ignored (len - ignored) in
let msgs = generator msg in
List.map
(fun msg -> simple_encode encoding ?alphabet msg)
msgs
end in
find request !generators
let () =
register Hash.Block_hash.b58check_encoding ;
register Hash.Protocol_hash.b58check_encoding ;
if not (!Sys.interactive) then begin
for i = 1 to Array.length Sys.argv - 1 do
List.iter
(Format.printf "%S@.")
(generate Sys.argv.(i))
done
end

View File

@ -34,7 +34,7 @@ let equal_persist_list ?msg 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
let pr_block_hash = Block_hash.to_short_b58check in
Assert.make_equal_list ?msg Block_hash.equal pr_block_hash l1 l2
let equal_string_list ?msg l1 l2 =

View File

@ -17,12 +17,12 @@ let (//) = Filename.concat
(** Basic blocks *)
let genesis_block =
Block_hash.of_b48check
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
Block_hash.of_b58check
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let genesis_protocol =
Protocol_hash.of_b48check
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
Protocol_hash.of_b58check
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let genesis_time =
Time.of_seconds 0L

View File

@ -15,12 +15,12 @@ let (//) = Filename.concat
(** Basic blocks *)
let genesis_block =
Block_hash.of_b48check
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
Block_hash.of_b58check
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let genesis_protocol =
Protocol_hash.of_b48check
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
Protocol_hash.of_b58check
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let genesis_time =
Time.of_seconds 0L

View File

@ -17,12 +17,12 @@ let (//) = Filename.concat
(** Basic blocks *)
let genesis_block =
Block_hash.of_b48check
"eeeeeeeeeeeeeeefcF2dFpTjGjPAxRM3TqDrKkJf7DdkNHpX3DmaD"
Block_hash.of_b58check
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let genesis_protocol =
Protocol_hash.of_b48check
"2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3"
Protocol_hash.of_b58check
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let genesis_time =
Time.of_seconds 0L
@ -121,12 +121,13 @@ let test_expand (s: Store.store) =
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] ;
Base58.complete (Block_hash.to_short_b58check bh1) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b58check bh1] ;
Base58.complete (Block_hash.to_short_b58check bh2) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b58check bh2] ;
Base58.complete (Block_hash.to_short_b58check bh3) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res
[Block_hash.to_b58check bh3' ; Block_hash.to_b58check bh3] ;
Lwt.return_unit)