Client: a bit of Error_monad in Hash

This commit is contained in:
Grégoire Henry 2017-04-05 09:54:21 +02:00 committed by Benjamin Canou
parent f5e2f7b481
commit cfb7e35914
22 changed files with 102 additions and 69 deletions

View File

@ -8,7 +8,7 @@
(**************************************************************************)
let genesis =
Block_hash.of_b58check
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let get_block_hash config = function

View File

@ -12,9 +12,7 @@ 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 =
try return (Ed25519.Public_key_hash.of_b58check s)
with exn -> Lwt.return (Error_monad.error_exn exn)
let of_source _ s = Lwt.return (Ed25519.Public_key_hash.of_b58check s)
let to_source _ p = return (Ed25519.Public_key_hash.to_b58check p)
let name = "public key hash"
end)
@ -22,9 +20,7 @@ module Public_key_hash = Client_aliases.Alias (struct
module Public_key = Client_aliases.Alias (struct
type t = Ed25519.Public_key.t
let encoding = Ed25519.Public_key.encoding
let of_source _ s =
try return (Ed25519.Public_key.of_b58check s)
with exn -> Lwt.return (Error_monad.error_exn exn)
let of_source _ s = Lwt.return (Ed25519.Public_key.of_b58check s)
let to_source _ p = return (Ed25519.Public_key.to_b58check p)
let name = "public key"
end)
@ -32,9 +28,7 @@ module Public_key = Client_aliases.Alias (struct
module Secret_key = Client_aliases.Alias (struct
type t = Ed25519.Secret_key.t
let encoding = Ed25519.Secret_key.encoding
let of_source _ s =
try return (Ed25519.Secret_key.of_b58check s)
with exn -> Lwt.return (Error_monad.error_exn exn)
let of_source _ s = Lwt.return (Ed25519.Secret_key.of_b58check s)
let to_source _ p = return (Ed25519.Secret_key.to_b58check p)
let name = "secret key"
end)

View File

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

View File

@ -359,11 +359,11 @@ let commands () =
command ~desc: "Activate a protocol" begin
prefixes [ "activate" ; "protocol" ] @@
param ~name:"version" ~desc:"Protocol version (b58check)"
(fun _ p -> Lwt.return @@ Protocol_hash.of_b58check p) @@
(fun _ p -> Lwt.return @@ Protocol_hash.of_b58check_exn p) @@
prefixes [ "with" ; "key" ] @@
param ~name:"password" ~desc:"Dictator's key"
(fun _ key ->
Lwt.return (Environment.Ed25519.Secret_key.of_b58check key))
Lwt.return (Environment.Ed25519.Secret_key.of_b58check_exn key))
stop
end
(fun hash seckey cctxt ->
@ -372,11 +372,11 @@ let commands () =
command ~desc: "Fork a test protocol" begin
prefixes [ "fork" ; "test" ; "protocol" ] @@
param ~name:"version" ~desc:"Protocol version (b58check)"
(fun _ p -> Lwt.return (Protocol_hash.of_b58check p)) @@
(fun _ p -> Lwt.return (Protocol_hash.of_b58check_exn p)) @@
prefixes [ "with" ; "key" ] @@
param ~name:"password" ~desc:"Dictator's key"
(fun _ key ->
Lwt.return (Environment.Ed25519.Secret_key.of_b58check key))
Lwt.return (Environment.Ed25519.Secret_key.of_b58check_exn key))
stop
end
(fun hash seckey cctxt ->

View File

@ -8,7 +8,7 @@
(**************************************************************************)
let protocol =
Protocol_hash.of_b58check
Protocol_hash.of_b58check_exn
"ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"
let () =

View File

@ -8,7 +8,7 @@
(**************************************************************************)
let protocol =
Protocol_hash.of_b58check
Protocol_hash.of_b58check_exn
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let demo cctxt =

View File

@ -10,7 +10,7 @@
open Client_commands
let protocol =
Protocol_hash.of_b58check
Protocol_hash.of_b58check_exn
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
let call_service1 cctxt s block a1 =
@ -57,7 +57,7 @@ let commands () =
command ~args ~desc: "Activate a protocol" begin
prefixes [ "activate" ; "protocol" ] @@
param ~name:"version" ~desc:"Protocol version (b58check)"
(fun _ p -> Lwt.return @@ Protocol_hash.of_b58check p) @@
(fun _ p -> Lwt.return @@ Protocol_hash.of_b58check_exn p) @@
prefixes [ "with" ; "fitness" ] @@
param ~name:"fitness"
~desc:"Hardcoded fitness of the first block (integer)"
@ -77,7 +77,7 @@ let commands () =
command ~args ~desc: "Fork a test protocol" begin
prefixes [ "fork" ; "test" ; "protocol" ] @@
param ~name:"version" ~desc:"Protocol version (b58check)"
(fun _ p -> Lwt.return (Protocol_hash.of_b58check p)) @@
(fun _ p -> Lwt.return (Protocol_hash.of_b58check_exn p)) @@
prefixes [ "with" ; "fitness" ] @@
param ~name:"fitness"
~desc:"Hardcoded fitness of the first block (integer)"
@ -85,7 +85,7 @@ let commands () =
prefixes [ "and" ; "key" ] @@
param ~name:"password" ~desc:"Dictator's key"
(fun _ key ->
Lwt.return (Environment.Ed25519.Secret_key.of_b58check key)) @@
Lwt.return (Environment.Ed25519.Secret_key.of_b58check_exn key)) @@
stop
end begin fun hash fitness seckey cctxt ->
let timestamp = !timestamp in

View File

@ -271,7 +271,7 @@ 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_b58check %S)\n\
\ let hash = (%s.Protocol_hash.of_b58check_exn %S)\n\
\ type error = %s.error = ..\n\
\ type 'a tzresult = 'a %s.tzresult\n\
\ include %s.%s\n\

View File

@ -13,10 +13,10 @@ let genesis : State.Net.genesis = {
time =
Time.of_notation_exn "2016-11-01T00:00:00Z" ;
block =
Block_hash.of_b58check
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z" ;
protocol =
Protocol_hash.of_b58check
Protocol_hash.of_b58check_exn
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ;
}

View File

@ -192,7 +192,7 @@ module RPC = struct
Lwt.fail Not_found
let prevalidation_hash =
Block_hash.of_b58check
Block_hash.of_b58check_exn
"BLockPrevaLidationPrevaLidationPrevaLidationPrZ4mr6"
let get_net node = function

View File

@ -108,7 +108,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_b58check h))
| [h] -> Ok (`Hash (Block_hash.of_b58check_exn h))
| _ -> raise Exit
with _ -> Error "Cannot parse block identifier."
@ -412,7 +412,7 @@ module Operations = struct
String.concat "," (List.map Operation_hash.to_b58check ops) in
let destruct h =
let ops = split ',' h in
try Ok (List.map Operation_hash.of_b58check ops)
try Ok (List.map Operation_hash.of_b58check_exn ops)
with _ -> Error "Can't parse hash" in
RPC.Arg.make ~name ~descr ~construct ~destruct ()
@ -462,7 +462,7 @@ module Protocols = struct
"A protocol identifier in hexadecimal." in
let construct = Protocol_hash.to_b58check in
let destruct h =
try Ok (Protocol_hash.of_b58check h)
try Ok (Protocol_hash.of_b58check_exn h)
with _ -> Error "Can't parse hash" in
RPC.Arg.make ~name ~descr ~construct ~destruct ()
@ -513,7 +513,7 @@ module Network = struct
~name:"peer_id"
~descr:"A network global identifier, also known as an identity."
~destruct:(fun s -> try
Ok (Crypto_box.Public_key_hash.of_b58check s)
Ok (Crypto_box.Public_key_hash.of_b58check_exn s)
with Failure msg -> Error msg)
~construct:Crypto_box.Public_key_hash.to_b58check
()

View File

@ -45,10 +45,15 @@ module Ed25519 = struct
with _ -> None)
~wrap:(fun x -> Public_key x)
let of_b58check s =
let of_b58check_opt s = Base58.simple_decode b58check_encoding s
let of_b58check_exn s =
match Base58.simple_decode b58check_encoding s with
| Some x -> x
| None -> Pervasives.failwith "Unexpected hash (ed25519 public key)"
let of_b58check s =
match Base58.simple_decode b58check_encoding s with
| Some x -> Ok x
| None -> generic_error "Unexpected hash (ed25519 public key)"
let to_b58check s = Base58.simple_encode b58check_encoding s
let of_bytes s = Sodium.Sign.Bytes.to_public_key s
@ -99,10 +104,15 @@ module Ed25519 = struct
with _ -> None)
~wrap:(fun x -> Secret_key x)
let of_b58check s =
let of_b58check_opt s = Base58.simple_decode b58check_encoding s
let of_b58check_exn s =
match Base58.simple_decode b58check_encoding s with
| Some x -> x
| None -> Pervasives.failwith "Unexpected hash (ed25519 secret key)"
let of_b58check s =
match Base58.simple_decode b58check_encoding s with
| Some x -> Ok x
| None -> generic_error "Unexpected hash (ed25519 public key)"
let to_b58check s = Base58.simple_encode b58check_encoding s
let of_bytes s = Sodium.Sign.Bytes.to_secret_key s
@ -150,10 +160,15 @@ module Ed25519 = struct
~of_raw:(fun s -> Some (MBytes.of_string s))
~wrap:(fun x -> Signature x)
let of_b58check s =
let of_b58check_opt s = Base58.simple_decode b58check_encoding s
let of_b58check_exn s =
match Base58.simple_decode b58check_encoding s with
| Some x -> x
| None -> Pervasives.failwith "Unexpected hash (ed25519 signature)"
let of_b58check s =
match Base58.simple_decode b58check_encoding s with
| Some x -> Ok x
| None -> generic_error "Unexpected hash (ed25519 public key)"
let to_b58check s = Base58.simple_encode b58check_encoding s
let of_bytes s = MBytes.of_string (Bytes.to_string s)

View File

@ -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_b58check s)
return (Ed25519.Public_key_hash.of_b58check_exn s)
with _ -> fail (error ())
end
| Key_t, expr ->

View File

@ -172,9 +172,9 @@ module Context = struct
let public_key_hash_arg =
let construct = Ed25519.Public_key_hash.to_b58check in
let destruct hash =
match Ed25519.Public_key_hash.of_b58check hash with
| exception _ -> Error "Cannot parse public key hash"
| public_key_hash -> Ok public_key_hash in
match Ed25519.Public_key_hash.of_b58check_opt hash with
| None -> Error "Cannot parse public key hash"
| Some public_key_hash -> Ok public_key_hash in
RPC.Arg.make
~descr:"A public key hash"
~name: "public_key_hash"

View File

@ -18,7 +18,8 @@ module Public_key : sig
type Base58.data +=
| Public_key of t
val of_b58check: string -> t
val of_b58check_exn: string -> t
val of_b58check_opt: string -> t option
val to_b58check: t -> string
val of_bytes: Bytes.t -> t
@ -33,7 +34,8 @@ module Secret_key : sig
type Base58.data +=
| Secret_key of t
val of_b58check: string -> t
val of_b58check_exn: string -> t
val of_b58check_opt: string -> t option
val to_b58check: t -> string
val of_bytes: Bytes.t -> t
@ -48,7 +50,8 @@ module Signature : sig
type Base58.data +=
| Signature of t
val of_b58check: string -> t
val of_b58check_exn: string -> t
val of_b58check_opt: string -> t option
val to_b58check: t -> string
val of_bytes: Bytes.t -> t

View File

@ -50,7 +50,8 @@ module type HASH = sig
include MINIMAL_HASH
val of_b58check: string -> t
val of_b58check_exn: string -> t
val of_b58check_opt: string -> t option
val to_b58check: t -> string
val to_short_b58check: t -> string
val encoding: t Data_encoding.t

View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
open Error_monad
let (//) = Filename.concat
let (>>=) = Lwt.bind
let (>|=) = Lwt.(>|=)
@ -72,7 +74,8 @@ module type HASH = sig
include MINIMAL_HASH
val of_b58check: string -> t
val of_b58check_exn: string -> t
val of_b58check_opt: string -> t option
val to_b58check: t -> string
val to_short_b58check: t -> string
val encoding: t Data_encoding.t
@ -95,6 +98,7 @@ end
module type INTERNAL_HASH = sig
include HASH
val of_b58check: string -> t tzresult
module Table : Hashtbl.S with type key = t
end
@ -278,10 +282,16 @@ module Make_Blake2B (R : sig
~wrap: (fun s -> Hash s)
~of_raw:(fun h -> of_string h) ~to_raw:to_string
let of_b58check s =
let of_b58check_opt s =
Base58.simple_decode b58check_encoding s
let of_b58check_exn s =
match Base58.simple_decode b58check_encoding s with
| Some x -> x
| None -> Format.kasprintf failwith "Unexpected hash (%s)" K.name
| None -> Format.kasprintf Pervasives.failwith "Unexpected hash (%s)" K.name
let of_b58check s =
match Base58.simple_decode b58check_encoding s with
| Some x -> Ok x
| None -> generic_error "Unexpected hash (%s)" K.name
let to_b58check s = Base58.simple_encode b58check_encoding s
let to_short_b58check s =
@ -294,10 +304,10 @@ module Make_Blake2B (R : sig
(conv to_bytes of_bytes_exn (Fixed.bytes size))
~json:
(describe ~title: (K.title ^ " (Base58Check-encoded Sha256)") @@
conv to_b58check (Data_encoding.Json.wrap_error of_b58check) string)
conv to_b58check (Data_encoding.Json.wrap_error of_b58check_exn) string)
let param ?(name=K.name) ?(desc=K.title) t =
Cli_entries.param ~name ~desc (fun _ str -> Lwt.return (of_b58check str)) t
Cli_entries.param ~name ~desc (fun _ str -> Lwt.return (of_b58check_exn str)) t
let pp ppf t =
Format.pp_print_string ppf (to_b58check t)
@ -579,10 +589,16 @@ module Net_id = struct
~wrap: (fun s -> Hash s)
~of_raw:of_string ~to_raw: (fun h -> h)
let of_b58check s =
let of_b58check_opt s =
Base58.simple_decode b58check_encoding s
let of_b58check_exn s =
match Base58.simple_decode b58check_encoding s with
| Some x -> x
| None -> Format.kasprintf failwith "Unexpected hash (%s)" name
| None -> Format.kasprintf Pervasives.failwith "Unexpected hash (%s)" name
let of_b58check s =
match Base58.simple_decode b58check_encoding s with
| Some x -> Ok x
| None -> generic_error "Unexpected hash (%s)" name
let to_b58check s = Base58.simple_encode b58check_encoding s
let to_short_b58check = to_b58check
@ -592,7 +608,7 @@ module Net_id = struct
~binary: (Fixed.string size)
~json:
(describe ~title: (title ^ " (Base58Check-encoded Sha256)") @@
conv to_b58check (Data_encoding.Json.wrap_error of_b58check) string)
conv to_b58check (Data_encoding.Json.wrap_error of_b58check_exn) string)
let param ?(name=name) ?(desc=title) t =
Cli_entries.param ~name ~desc (fun _ str -> Lwt.return (of_b58check str)) t

View File

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
open Error_monad
(** Tezos - Manipulation and creation of hashes *)
@ -64,7 +66,8 @@ module type HASH = sig
include MINIMAL_HASH
val of_b58check: string -> t
val of_b58check_exn: string -> t
val of_b58check_opt: string -> t option
val to_b58check: t -> string
val to_short_b58check: t -> string
val encoding: t Data_encoding.t
@ -87,6 +90,7 @@ end
module type INTERNAL_HASH = sig
include HASH
val of_b58check: string -> t tzresult
module Table : Hashtbl.S with type key = t
end

View File

@ -78,38 +78,38 @@ type account = {
}
let genesis_sk =
Environment.Ed25519.Secret_key.of_b58check
Environment.Ed25519.Secret_key.of_b58check_exn
"edskRhxswacLW6jF6ULavDdzwqnKJVS4UcDTNiCyiH6H8ZNnn2pmNviL7pRNz9kRxxaWQFzEQEcZExGHKbwmuaAcoMegj5T99z"
let bootstrap1_pk =
Environment.Ed25519.Public_key.of_b58check
Environment.Ed25519.Public_key.of_b58check_exn
"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"
let bootstrap2_pk =
Environment.Ed25519.Public_key.of_b58check
Environment.Ed25519.Public_key.of_b58check_exn
"edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9"
let bootstrap3_pk =
Environment.Ed25519.Public_key.of_b58check
Environment.Ed25519.Public_key.of_b58check_exn
"edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV"
let bootstrap4_pk =
Environment.Ed25519.Public_key.of_b58check
Environment.Ed25519.Public_key.of_b58check_exn
"edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU"
let bootstrap5_pk =
Environment.Ed25519.Public_key.of_b58check
Environment.Ed25519.Public_key.of_b58check_exn
"edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n"
let bootstrap1_sk =
Environment.Ed25519.Secret_key.of_b58check
Environment.Ed25519.Secret_key.of_b58check_exn
"edskRuR1azSfboG86YPTyxrQgosh5zChf5bVDmptqLTb5EuXAm9rsnDYfTKhq7rDQujdn5WWzwUMeV3agaZ6J2vPQT58jJAJPi"
let bootstrap2_sk =
Environment.Ed25519.Secret_key.of_b58check
Environment.Ed25519.Secret_key.of_b58check_exn
"edskRkJz4Rw2rM5NtabEWMbbg2bF4b1nfFajaqEuEk4SgU7eeDbym9gVQtBTbYo32WUg2zb5sNBkD1whRN7zX43V9bftBbtaKc"
let bootstrap3_sk =
Environment.Ed25519.Secret_key.of_b58check
Environment.Ed25519.Secret_key.of_b58check_exn
"edskS3qsqsNgdjUqeMsVcEwBn8dkZ5iDRz6aF21KhcCtRiAkWBypUSbicccR4Vgqm9UdW2Vabuos6seezqgbXTrmcbLUG4rdAC"
let bootstrap4_sk =
Environment.Ed25519.Secret_key.of_b58check
Environment.Ed25519.Secret_key.of_b58check_exn
"edskRg9qcPqaVQa6jXWNMU5p71tseSuR7NzozgqZ9URsVDi81wTyPJdFSBdeakobyHUi4Xgu61jgKRQvkhXrPmEdEUfiqfiJFL"
let bootstrap5_sk =
Environment.Ed25519.Secret_key.of_b58check
Environment.Ed25519.Secret_key.of_b58check_exn
"edskS7rLN2Df3nbS1EYvwJbWo4umD7yPM1SUeX7gp1WhCVpMFXjcCyM58xs6xsnTsVqHQmJQ2RxoAjJGedWfvFmjQy6etA3dgZ"
let switch_protocol () =
@ -165,7 +165,7 @@ let transfer ?(block = `Prevalidation) ?(fee = 5L) ~src ~target amount =
~amount ~fee ()
let check_balance ?(block = `Prevalidation) account expected =
Client_proto_rpcs.Context.Contract.balance cctxt
Client_proto_rpcs.Context.Contract.balance cctxt.rpc_config
block account.contract >>=? fun balance ->
let balance = Tez.to_cents balance in
Assert.equal_int64 ~msg:__LOC__ expected balance ;
@ -173,9 +173,9 @@ let check_balance ?(block = `Prevalidation) account expected =
let mine contract =
let block = `Head 0 in
Client_proto_rpcs.Context.level cctxt block >>=? fun level ->
Client_proto_rpcs.Context.level cctxt.rpc_config block >>=? fun level ->
let seed_nonce = Client_mining_forge.generate_seed_nonce () in
Client_mining_forge.forge_block cctxt
Client_mining_forge.forge_block cctxt.rpc_config
~timestamp:(Time.now ()) ~seed_nonce ~src_sk:contract.secret_key
block ~priority:(`Auto (contract.public_key_hash, None)) () >>=? fun block_hash ->
return ()

View File

@ -17,11 +17,11 @@ let (//) = Filename.concat
(** Basic blocks *)
let genesis_block =
Block_hash.of_b58check
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let genesis_protocol =
Protocol_hash.of_b58check
Protocol_hash.of_b58check_exn
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let genesis_time =

View File

@ -15,11 +15,11 @@ let (//) = Filename.concat
(** Basic blocks *)
let genesis_block =
Block_hash.of_b58check
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let genesis_protocol =
Protocol_hash.of_b58check
Protocol_hash.of_b58check_exn
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let genesis_time =

View File

@ -18,11 +18,11 @@ let (//) = Filename.concat
(** Basic blocks *)
let genesis_block =
Block_hash.of_b58check
Block_hash.of_b58check_exn
"BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
let genesis_protocol =
Protocol_hash.of_b58check
Protocol_hash.of_b58check_exn
"ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
let genesis_time =