From 5ed07c158c742db7abd7728d09c4ed8e0187ed14 Mon Sep 17 00:00:00 2001 From: satos---jp Date: Thu, 4 Nov 2021 18:03:01 +0900 Subject: [PATCH 1/3] Shell: interface fix of Hex --- src/bin_codec/commands.ml | 6 +- src/bin_sandbox/command_ledger_wallet.ml | 2 +- src/lib_client_base/test/bip39_tests.ml | 4 +- src/lib_client_base/test/pbkdf_tests.ml | 4 +- src/lib_crypto/blake2B.ml | 18 +++- src/lib_crypto/chain_id.ml | 18 +++- src/lib_crypto/helpers.ml | 4 +- src/lib_crypto/test/test_hacl.ml | 2 +- src/lib_micheline/micheline_parser.ml | 31 ++++--- src/lib_micheline/micheline_parser.mli | 2 +- .../structs/v1.dune.inc | 1 + .../structs/v1/hex.ml | 25 ++++++ .../structs/v2.dune.inc | 1 + .../structs/v3.dune.inc | 1 + src/lib_sapling/dune | 1 - src/lib_sapling/rustzcash.ml | 2 +- src/lib_sapling/test/keys.ml | 2 +- src/lib_sapling/test/test_merkle.ml | 2 +- src/lib_sapling/test/test_rustzcash.ml | 8 +- src/lib_stdlib/tezos_stdlib.ml | 35 ++++++++ src/lib_stdlib/tzHex.ml | 28 ++++++ src/lib_stdlib/tzHex.mli | 88 +++++++++++++++++++ src/lib_stdlib/tzString.ml | 11 --- src/lib_stdlib/tzString.mli | 3 - .../lib_client/michelson_v1_emacs.ml | 2 +- .../client_proto_programs_commands.ml | 18 ++-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../client_proto_programs_commands.ml | 18 ++-- .../lib_client/client_proto_args.ml | 14 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../lib_client/client_proto_args.ml | 14 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../client_sapling_commands.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../client_sapling_commands.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../client_sapling_commands.ml | 2 +- .../lib_delegate/client_baking_pow.ml | 6 +- .../test/unit/test_alpha_context.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../client_sapling_commands.ml | 2 +- .../lib_delegate/client_baking_pow.ml | 6 +- .../test/unit/test_alpha_context.ml | 2 +- .../lib_client/client_proto_args.ml | 12 +-- .../lib_client/michelson_v1_emacs.ml | 2 +- .../client_proto_utils_commands.ml | 5 +- .../client_sapling_commands.ml | 2 +- src/proto_alpha/lib_delegate/baking_pow.ml | 6 +- .../test/unit/test_alpha_context.ml | 2 +- 60 files changed, 367 insertions(+), 155 deletions(-) create mode 100644 src/lib_protocol_environment/structs/v1/hex.ml create mode 100644 src/lib_stdlib/tezos_stdlib.ml create mode 100644 src/lib_stdlib/tzHex.ml create mode 100644 src/lib_stdlib/tzHex.mli diff --git a/src/bin_codec/commands.ml b/src/bin_codec/commands.ml index e0c34e05a1a1..342f4ff0cf49 100644 --- a/src/bin_codec/commands.ml +++ b/src/bin_codec/commands.ml @@ -44,7 +44,11 @@ let json_parameter = | Ok json -> return json | Error err -> cctxt#error "%s" err) -let bytes_parameter = parameter (fun _ hex -> return (Hex.to_bytes (`Hex hex))) +let bytes_parameter = + parameter (fun (cctxt : #Client_context.printer) hex -> + match Hex.to_bytes (`Hex hex) with + | Some s -> return s + | None -> cctxt#error "Invalid hex string: %s" hex) let commands () = [ diff --git a/src/bin_sandbox/command_ledger_wallet.ml b/src/bin_sandbox/command_ledger_wallet.ml index 83f1ccb4d8e9..eb870fefd8ea 100644 --- a/src/bin_sandbox/command_ledger_wallet.ml +++ b/src/bin_sandbox/command_ledger_wallet.ml @@ -1363,7 +1363,7 @@ let run state ~pp_error ~protocol ~protocol_kind ~node_exec ~client_exec >>= fun batch_transaction_bytes -> let bytes_hash = Tezos_crypto.( - `Hex batch_transaction_bytes |> Hex.to_bytes + `Hex batch_transaction_bytes |> Tezos_stdlib.Hex.to_bytes_exn |> (fun x -> [x]) |> Blake2B.hash_bytes |> Blake2B.to_string |> Base58.raw_encode) in diff --git a/src/lib_client_base/test/bip39_tests.ml b/src/lib_client_base/test/bip39_tests.ml index 6c29d558d0c6..b2ca8af8a74a 100644 --- a/src/lib_client_base/test/bip39_tests.ml +++ b/src/lib_client_base/test/bip39_tests.ml @@ -266,7 +266,7 @@ let pp_diff ppf (l1, l2) = let vectors () = ListLabels.iteri vectors ~f:(fun _ {entropy; words; seed} -> let words = String.split_on_char ' ' words in - let mnemonic = Bip39.of_entropy (Hex.to_bytes entropy) in + let mnemonic = Bip39.of_entropy (Tezos_stdlib.Hex.to_bytes_exn entropy) in let words_computed = Bip39.to_words mnemonic in if words <> words_computed then ( Format.printf "%a\n" pp_diff (words, words_computed) ; @@ -274,7 +274,7 @@ let vectors () = let seed_computed = Bip39.to_seed ~passphrase:(Bytes.of_string "TREZOR") mnemonic in - assert (Hex.to_bytes seed = seed_computed)) + assert (Tezos_stdlib.Hex.to_bytes_exn seed = seed_computed)) let basic = [("vectors", `Quick, vectors)] diff --git a/src/lib_client_base/test/pbkdf_tests.ml b/src/lib_client_base/test/pbkdf_tests.ml index 7ba5ae78b28e..5f43354e4a7f 100644 --- a/src/lib_client_base/test/pbkdf_tests.ml +++ b/src/lib_client_base/test/pbkdf_tests.ml @@ -11,8 +11,8 @@ open Tezos_crypto (* PBKDF2 *) let test_pbkdf2 (module A : Hacl.Hash.S) ~password ~salt ~count ~dk_len ~dk = let module P = Pbkdf.Make (A) in - let salt = Hex.to_bytes (`Hex salt) in - let dk = Hex.to_bytes (`Hex dk) in + let salt = Tezos_stdlib.Hex.to_bytes_exn (`Hex salt) in + let dk = Tezos_stdlib.Hex.to_bytes_exn (`Hex dk) in let password = Bytes.of_string password in fun () -> let edk = P.pbkdf2 ~password ~salt ~count ~dk_len in diff --git a/src/lib_crypto/blake2B.ml b/src/lib_crypto/blake2B.ml index c927a4fd6aa8..4022f5993b59 100644 --- a/src/lib_crypto/blake2B.ml +++ b/src/lib_crypto/blake2B.ml @@ -76,11 +76,23 @@ module Make_minimal (K : Name) = struct let to_string (Blake2b.Hash h) = Bytes.to_string h - let of_hex s = of_string (Hex.to_string s) + let of_hex s = + match Hex.to_string s with + | Some s -> of_string s + | None -> error_with "%s.of_hex: invalid hex string (%a)" K.name Hex.pp s - let of_hex_opt s = of_string_opt (Hex.to_string s) + let of_hex_opt s = Option.bind (Hex.to_string s) of_string_opt - let of_hex_exn s = of_string_exn (Hex.to_string s) + let of_hex_exn s = + match Hex.to_string s with + | Some s -> of_string_exn s + | None -> + Format.kasprintf + invalid_arg + "%s.of_hex_exn: invalid hex string (%a)" + K.name + Hex.pp + s let to_hex s = Hex.of_string (to_string s) diff --git a/src/lib_crypto/chain_id.ml b/src/lib_crypto/chain_id.ml index 6dd258a1e30c..260fb7d621eb 100644 --- a/src/lib_crypto/chain_id.ml +++ b/src/lib_crypto/chain_id.ml @@ -64,11 +64,23 @@ let of_string_exn s = let to_string s = s -let of_hex s = of_string (Hex.to_string s) +let of_hex s = + match Hex.to_string s with + | None -> error_with "%s.of_hex: invalid hex string (%a)" name Hex.pp s + | Some s -> of_string s -let of_hex_opt s = of_string_opt (Hex.to_string s) +let of_hex_opt s = Option.bind (Hex.to_string s) of_string_opt -let of_hex_exn s = of_string_exn (Hex.to_string s) +let of_hex_exn s = + match Hex.to_string s with + | None -> + Format.kasprintf + invalid_arg + "%s.of_hex_exn: invalid hex string (%a)" + name + Hex.pp + s + | Some s -> of_string_exn s let to_hex s = Hex.of_string (to_string s) diff --git a/src/lib_crypto/helpers.ml b/src/lib_crypto/helpers.ml index cf10cfd91d26..1a6bdf0f184a 100644 --- a/src/lib_crypto/helpers.ml +++ b/src/lib_crypto/helpers.ml @@ -59,10 +59,10 @@ struct let to_hex s = Hex.of_string (H.to_string s) - let of_hex_opt s = H.of_string_opt (Hex.to_string s) + let of_hex_opt s = Option.bind (Hex.to_string s) H.of_string_opt let of_hex_exn s = - match H.of_string_opt (Hex.to_string s) with + match of_hex_opt s with | Some x -> x | None -> Format.kasprintf invalid_arg "of_hex_exn (%s)" H.name diff --git a/src/lib_crypto/test/test_hacl.ml b/src/lib_crypto/test/test_hacl.ml index 7a2001952dbd..5fbad90fc2db 100644 --- a/src/lib_crypto/test/test_hacl.ml +++ b/src/lib_crypto/test/test_hacl.ml @@ -32,7 +32,7 @@ *) open Hacl -let hex s = Hex.to_bytes (`Hex s) +let hex s = Hex.to_bytes_exn (`Hex s) type vector = { data_in : Bytes.t list; diff --git a/src/lib_micheline/micheline_parser.ml b/src/lib_micheline/micheline_parser.ml index 2d00d05515c0..1416d4e52912 100644 --- a/src/lib_micheline/micheline_parser.ml +++ b/src/lib_micheline/micheline_parser.ml @@ -151,7 +151,7 @@ type error += Unterminated_string of location type error += Unterminated_integer of location -type error += Odd_lengthed_bytes of location +type error += Invalid_hex_bytes of location type error += Unterminated_comment of location @@ -614,13 +614,13 @@ let rec parse ?(check = true) errors tokens stack = | ( (Expression None | Sequence _ | Toplevel _) :: _, {token = Bytes contents; loc} :: (([] | {token = Semi | Close_brace; _} :: _) as rest) ) -> - let (errors, contents) = - if String.length contents mod 2 <> 0 then - (Odd_lengthed_bytes loc :: errors, contents ^ "0") - else (errors, contents) - in - let bytes = - Hex.to_bytes (`Hex (String.sub contents 2 (String.length contents - 2))) + let (errors, bytes) = + match + Hex.to_bytes + (`Hex (String.sub contents 2 (String.length contents - 2))) + with + | None -> (Invalid_hex_bytes loc :: errors, Bytes.empty) + | Some bytes -> (errors, bytes) in let expr : node = Bytes (loc, bytes) in let errors = @@ -842,17 +842,16 @@ let () = (fun loc -> Unterminated_integer loc) ; register_error_kind `Permanent - ~id:"micheline.parse_error.odd_lengthed_bytes" - ~title:"Micheline parser error: odd lengthed bytes" + ~id:"micheline.parse_error.invalid_hex_bytes" + ~title:"Micheline parser error: invalid hex bytes" ~description: - "While parsing a piece of Micheline source, the length of a byte \ - sequence (0x...) was not a multiple of two, leaving a trailing half \ - byte." + "While parsing a piece of Micheline source, a byte sequence (0x...) was \ + not valid as a hex byte." ~pp:(fun ppf loc -> - Format.fprintf ppf "%a, odd_lengthed bytes" print_location loc) + Format.fprintf ppf "%a, invalid hex bytes" print_location loc) Data_encoding.(obj1 (req "location" location_encoding)) - (function Odd_lengthed_bytes loc -> Some loc | _ -> None) - (fun loc -> Odd_lengthed_bytes loc) ; + (function Invalid_hex_bytes loc -> Some loc | _ -> None) + (fun loc -> Invalid_hex_bytes loc) ; register_error_kind `Permanent ~id:"micheline.parse_error.unterminated_comment" diff --git a/src/lib_micheline/micheline_parser.mli b/src/lib_micheline/micheline_parser.mli index 9fabc39db80c..38db8d2ea360 100644 --- a/src/lib_micheline/micheline_parser.mli +++ b/src/lib_micheline/micheline_parser.mli @@ -84,7 +84,7 @@ type error += Unterminated_string of location type error += Unterminated_integer of location -type error += Odd_lengthed_bytes of location +type error += Invalid_hex_bytes of location type error += Unterminated_comment of location diff --git a/src/lib_protocol_environment/structs/v1.dune.inc b/src/lib_protocol_environment/structs/v1.dune.inc index f78e97fa856f..8ef9fe0224f3 100644 --- a/src/lib_protocol_environment/structs/v1.dune.inc +++ b/src/lib_protocol_environment/structs/v1.dune.inc @@ -19,6 +19,7 @@ v1/option.ml v1/bls12_381.ml v1/error_monad_preallocated_values.ml + v1/hex.ml v0/error_monad_trace_eval.ml v0/error_monad_classification.ml ) diff --git a/src/lib_protocol_environment/structs/v1/hex.ml b/src/lib_protocol_environment/structs/v1/hex.ml new file mode 100644 index 000000000000..8b2091b5ec11 --- /dev/null +++ b/src/lib_protocol_environment/structs/v1/hex.ml @@ -0,0 +1,25 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Dailambda, Inc. *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) +include Hex diff --git a/src/lib_protocol_environment/structs/v2.dune.inc b/src/lib_protocol_environment/structs/v2.dune.inc index 64c983f107de..ff97ebdf4d95 100644 --- a/src/lib_protocol_environment/structs/v2.dune.inc +++ b/src/lib_protocol_environment/structs/v2.dune.inc @@ -18,6 +18,7 @@ v0/data_encoding.ml v1/bls12_381.ml v1/error_monad_preallocated_values.ml + v1/hex.ml v0/error_monad_trace_eval.ml v0/error_monad_classification.ml ) diff --git a/src/lib_protocol_environment/structs/v3.dune.inc b/src/lib_protocol_environment/structs/v3.dune.inc index f20b32df5d6b..f59402813c15 100644 --- a/src/lib_protocol_environment/structs/v3.dune.inc +++ b/src/lib_protocol_environment/structs/v3.dune.inc @@ -3,6 +3,7 @@ (deps v1/bls12_381.ml v1/error_monad_preallocated_values.ml + v1/hex.ml v0/error_monad_trace_eval.ml v0/error_monad_classification.ml ) diff --git a/src/lib_sapling/dune b/src/lib_sapling/dune index 9ed395e78c60..e04da04a955e 100644 --- a/src/lib_sapling/dune +++ b/src/lib_sapling/dune @@ -9,7 +9,6 @@ integers ctypes ctypes.stubs - hex data-encoding tezos-crypto tezos-stdlib diff --git a/src/lib_sapling/rustzcash.ml b/src/lib_sapling/rustzcash.ml index 00add8d732cf..78dd74f0b11b 100644 --- a/src/lib_sapling/rustzcash.ml +++ b/src/lib_sapling/rustzcash.ml @@ -541,7 +541,7 @@ let verification_ctx_free ctx = RS.verification_ctx_free ctx let tree_uncommitted = to_hash - (Hex.to_bytes + (Hex.to_bytes_exn (`Hex "0100000000000000000000000000000000000000000000000000000000000000")) let merkle_hash ~height a b = diff --git a/src/lib_sapling/test/keys.ml b/src/lib_sapling/test/keys.ml index 41ec909bc1d8..6dfbf7d5742d 100644 --- a/src/lib_sapling/test/keys.ml +++ b/src/lib_sapling/test/keys.ml @@ -4,7 +4,7 @@ module R = Rustzcash module Sk = Core.Raw.Spending_key module Vk = Core.Raw.Viewing_key -let ba_of_hex h = Hex.to_bytes (`Hex h) +let ba_of_hex h = Hex.to_bytes_exn (`Hex h) module Vector = struct type test_vector = { diff --git a/src/lib_sapling/test/test_merkle.ml b/src/lib_sapling/test/test_merkle.ml index c515bd700442..b0e3d07d88b8 100644 --- a/src/lib_sapling/test/test_merkle.ml +++ b/src/lib_sapling/test/test_merkle.ml @@ -2,7 +2,7 @@ module R = Rustzcash module Core = Core.Client module Storage = Storage.Make_Storage (Core) -let ba_of_hex h = Hex.to_bytes (`Hex h) +let ba_of_hex h = Hex.to_bytes_exn (`Hex h) (* Some test vectors are in bigendian *) let ba_of_hex_be h = diff --git a/src/lib_sapling/test/test_rustzcash.ml b/src/lib_sapling/test/test_rustzcash.ml index 2b8f309da3fd..475c544326fc 100644 --- a/src/lib_sapling/test/test_rustzcash.ml +++ b/src/lib_sapling/test/test_rustzcash.ml @@ -420,8 +420,8 @@ let test_ivk_to_pkd () = Tezos_sapling.Rustzcash.( of_pkd (ivk_to_pkd - (to_ivk (Hex.to_bytes ivk)) - (Option.get (to_diversifier (Hex.to_bytes diversifier))))) + (to_ivk (Hex.to_bytes_exn ivk)) + (Option.get (to_diversifier (Hex.to_bytes_exn diversifier))))) in let res = Hex.show (Hex.of_bytes result) in if not (res = expected_pkd_hex) then @@ -446,8 +446,8 @@ let test_failing_ivk_to_pkd () = (ignore @@ Tezos_sapling.Rustzcash.( ivk_to_pkd - (to_ivk (Hex.to_bytes ivk)) - (Option.get (to_diversifier (Hex.to_bytes diversifier))))) ; + (to_ivk (Hex.to_bytes_exn ivk)) + (Option.get (to_diversifier (Hex.to_bytes_exn diversifier))))) ; assert ( Alcotest.failf "ivk_to_pkd should have failed on ivk input %s. The first 5 bits \ diff --git a/src/lib_stdlib/tezos_stdlib.ml b/src/lib_stdlib/tezos_stdlib.ml new file mode 100644 index 000000000000..4483328d3d6a --- /dev/null +++ b/src/lib_stdlib/tezos_stdlib.ml @@ -0,0 +1,35 @@ +(* + * Copyright (c) 2021 Dailambda, Inc. + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +module Bits = Bits +module Bloomer = Bloomer +module Bounded_heap = Bounded_heap +module Circular_buffer = Circular_buffer +module Compare = Compare +module FallbackArray = FallbackArray +module FunctionalArray = FunctionalArray +module Hex = TzHex +module Lwt_dropbox = Lwt_dropbox +module Lwt_idle_waiter = Lwt_idle_waiter +module Lwt_pipe = Lwt_pipe +module Lwt_utils = Lwt_utils +module Memory = Memory +module Tag = Tag +module TzEndian = TzEndian +module TzFilename = TzFilename +module TzList = TzList +module TzString = TzString +module Utils = Utils diff --git a/src/lib_stdlib/tzHex.ml b/src/lib_stdlib/tzHex.ml new file mode 100644 index 000000000000..91372c16e86b --- /dev/null +++ b/src/lib_stdlib/tzHex.ml @@ -0,0 +1,28 @@ +(* + * Copyright (c) 2021 Dailambda, Inc. + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +include Hex + +let to_char x y = + try Some (Hex.to_char x y) with Stdlib.Invalid_argument _ -> None + +let to_string h = + try Some (Hex.to_string h) with Stdlib.Invalid_argument _ -> None + +let to_bytes_exn = Hex.to_bytes + +let to_bytes h = + try Some (Hex.to_bytes h) with Stdlib.Invalid_argument _ -> None diff --git a/src/lib_stdlib/tzHex.mli b/src/lib_stdlib/tzHex.mli new file mode 100644 index 000000000000..8aef415ac521 --- /dev/null +++ b/src/lib_stdlib/tzHex.mli @@ -0,0 +1,88 @@ +(* + * Copyright (c) 2015 Trevor Summers Smith + * Copyright (c) 2014 Thomas Gazagnaire + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +(** Hexadecimal encoding. + +[TzHex] defines hexadecimal encodings for {{!char}characters}, +{{!string}strings} and {{!cstruct}Cstruct.t} buffers. *) +type t = [`Hex of string] +(** The type var hexadecimal values. *) + +(** {1:char Characters} *) + +(** [of_char c] is the the hexadecimal encoding of the character + [c]. *) +val of_char : char -> char * char + +(** [to_char x y] is the character correspondong to the [xy] + hexadecimal encoding. + + Returns [None] if [x] or [y] are not in the ranges ['0'..'9'], + ['a'..'f'], or ['A'..'F']. *) +val to_char : char -> char -> char option + +(** {1:string Strings} *) + +(** [of_string s] is the hexadecimal representation of the binary + string [s]. If [ignore] is set, skip the characters in the list + when converting. Eg [of_string ~ignore:[' '] "a f"]. The default + value of [ignore] is [[]]). *) +val of_string : ?ignore:char list -> string -> t + +(** [to_string t] is the binary string [s] such that [of_string s] is + [t]. + + Returns [None] if [t] contains a character that is not in the range ['0'..'9'], + ['a'..'f'], or ['A'..'F']. *) +val to_string : t -> string option + +(** {1:byte Bytes} *) + +(** [of_bytes s] is the hexadecimal representation of the binary + string [s]. If [ignore] is set, skip the characters in the list + when converting. Eg [of_bytes ~ignore:[' '] "a f"]. The default + value of [ignore] is [[]]). *) +val of_bytes : ?ignore:char list -> bytes -> t + +(** [to_bytes t] is the binary string [s] such that [of_bytes s] is + [t]. + + Returns [None] if [t] contains a character that is not in the range ['0'..'9'], + ['a'..'f'], or ['A'..'F']. *) +val to_bytes : t -> bytes option + +(** [to_bytes_exn t] is the binary string [s] such that [of_bytes s] is + [t]. + + @raise [Invalid_argument] instead of returning [None]. *) +val to_bytes_exn : t -> bytes + +(** {1 Debugging} *) + +(** Same as [hexdump] except returns a string. *) +val hexdump_s : ?print_row_numbers:bool -> ?print_chars:bool -> t -> string + +(** {1 Pretty printing} *) + +(** [pp fmt t] will output a human-readable hex representation of [t] + to the formatter [fmt]. *) +val pp : Format.formatter -> t -> unit + [@@ocaml.toplevel_printer] + +(** [show t] will return a human-readable hex representation of [t] as + a string. *) +val show : t -> string diff --git a/src/lib_stdlib/tzString.ml b/src/lib_stdlib/tzString.ml index 70c9ff0cbc20..826a1cbc3e47 100644 --- a/src/lib_stdlib/tzString.ml +++ b/src/lib_stdlib/tzString.ml @@ -75,15 +75,4 @@ let fold_left f init s = String.iter (fun c -> acc := f !acc c) s ; !acc -let is_hex s = - let len = String.length s in - len mod 2 = 0 - && - try - String.iter - (function '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> () | _ -> raise Exit) - s ; - true - with Exit -> false - let pp_bytes_hex fmt bytes = Hex.(of_bytes bytes |> pp fmt) diff --git a/src/lib_stdlib/tzString.mli b/src/lib_stdlib/tzString.mli index cb6c12cf9613..d1fa915186f7 100644 --- a/src/lib_stdlib/tzString.mli +++ b/src/lib_stdlib/tzString.mli @@ -56,8 +56,5 @@ val mem_char : string -> char -> bool (** Functional iteration over the characters of a string from first to last *) val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a -(** Test whether a string is a valid hexadecimal value *) -val is_hex : string -> bool - (** Pretty print bytes as hexadecimal string. *) val pp_bytes_hex : Format.formatter -> bytes -> unit diff --git a/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml b/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml index fa3799f63d14..1134064e68b1 100644 --- a/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml +++ b/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml @@ -209,7 +209,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc} | Unexpected {loc} | Extra {loc} -> diff --git a/src/proto_001_PtCJ7pwo/lib_client_commands/client_proto_programs_commands.ml b/src/proto_001_PtCJ7pwo/lib_client_commands/client_proto_programs_commands.ml index 2d31ce0595f4..b8c55499e607 100644 --- a/src/proto_001_PtCJ7pwo/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_001_PtCJ7pwo/lib_client_commands/client_proto_programs_commands.ml @@ -91,15 +91,15 @@ let commands () = ~name ~desc (parameter (fun (_cctxt : Alpha_client_context.full) s -> - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then - raise Exit - else - return - (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith - "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)")) + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith + "Invalid bytes, expecting hexadecimal notation (e.g. \ + 0x1234abcd)")) in let signature_parameter = Clic.parameter (fun _cctxt s -> diff --git a/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml b/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml index fa3799f63d14..1134064e68b1 100644 --- a/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml +++ b/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml @@ -209,7 +209,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc} | Unexpected {loc} | Extra {loc} -> diff --git a/src/proto_002_PsYLVpVv/lib_client_commands/client_proto_programs_commands.ml b/src/proto_002_PsYLVpVv/lib_client_commands/client_proto_programs_commands.ml index 410f93f252de..c1bc0a607cd5 100644 --- a/src/proto_002_PsYLVpVv/lib_client_commands/client_proto_programs_commands.ml +++ b/src/proto_002_PsYLVpVv/lib_client_commands/client_proto_programs_commands.ml @@ -91,15 +91,15 @@ let commands () = ~name ~desc (parameter (fun (_cctxt : Alpha_client_context.full) s -> - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then - raise Exit - else - return - (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith - "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)")) + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith + "Invalid bytes, expecting hexadecimal notation (e.g. \ + 0x1234abcd)")) in let signature_parameter = Clic.parameter (fun _cctxt s -> diff --git a/src/proto_003_PsddFKi3/lib_client/client_proto_args.ml b/src/proto_003_PsddFKi3/lib_client/client_proto_args.ml index c9a268edbc12..cb413711ea8f 100644 --- a/src/proto_003_PsddFKi3/lib_client/client_proto_args.ml +++ b/src/proto_003_PsddFKi3/lib_client/client_proto_args.ml @@ -57,12 +57,14 @@ let int_parameter = let bytes_parameter = parameter (fun _ s -> - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith - "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)") + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith + "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)") let tez_parameter param = parameter (fun _ s -> diff --git a/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml b/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml index 9342451ec25b..5bb2f158f68d 100644 --- a/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml +++ b/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml @@ -209,7 +209,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_004_Pt24m4xi/lib_client/client_proto_args.ml b/src/proto_004_Pt24m4xi/lib_client/client_proto_args.ml index 64bf323afa4c..4d13de22fd79 100644 --- a/src/proto_004_Pt24m4xi/lib_client/client_proto_args.ml +++ b/src/proto_004_Pt24m4xi/lib_client/client_proto_args.ml @@ -53,12 +53,14 @@ let tez_sym = "\xEA\x9C\xA9" let bytes_parameter = parameter (fun _ s -> - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith - "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)") + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith + "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)") let tez_parameter param = parameter (fun _ s -> diff --git a/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml b/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml index 9342451ec25b..5bb2f158f68d 100644 --- a/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml +++ b/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml @@ -209,7 +209,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_005_PsBabyM1/lib_client/client_proto_args.ml b/src/proto_005_PsBabyM1/lib_client/client_proto_args.ml index 01ab81f11b09..c54b449ff615 100644 --- a/src/proto_005_PsBabyM1/lib_client/client_proto_args.ml +++ b/src/proto_005_PsBabyM1/lib_client/client_proto_args.ml @@ -58,11 +58,13 @@ let int_parameter = try return (int_of_string p) with _ -> failwith "Cannot read int") let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml b/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml index 18340f076ab8..a8170db46ac3 100644 --- a/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml +++ b/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml @@ -210,7 +210,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml b/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml index ef8bad76ee14..367dc1a0ac80 100644 --- a/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml +++ b/src/proto_006_PsCARTHA/lib_client/client_proto_args.ml @@ -130,11 +130,13 @@ let int_parameter = try return (int_of_string p) with _ -> failwith "Cannot read int") let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml b/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml index 18340f076ab8..a8170db46ac3 100644 --- a/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml +++ b/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml @@ -210,7 +210,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml b/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml index 774bf2bb485e..86150ea197ed 100644 --- a/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml +++ b/src/proto_007_PsDELPH1/lib_client/client_proto_args.ml @@ -130,11 +130,13 @@ let int_parameter = try return (int_of_string p) with _ -> failwith "Cannot read int") let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml index 18340f076ab8..a8170db46ac3 100644 --- a/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml @@ -210,7 +210,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_008_PtEdo2Zk/lib_client/client_proto_args.ml b/src/proto_008_PtEdo2Zk/lib_client/client_proto_args.ml index 281df521148d..9944dc8aea92 100644 --- a/src/proto_008_PtEdo2Zk/lib_client/client_proto_args.ml +++ b/src/proto_008_PtEdo2Zk/lib_client/client_proto_args.ml @@ -130,11 +130,13 @@ let int_parameter = try return (int_of_string p) with _ -> failwith "Cannot read int") let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_008_PtEdo2Zk/lib_client/michelson_v1_emacs.ml b/src/proto_008_PtEdo2Zk/lib_client/michelson_v1_emacs.ml index aaed4a26d0bc..2721fa702d46 100644 --- a/src/proto_008_PtEdo2Zk/lib_client/michelson_v1_emacs.ml +++ b/src/proto_008_PtEdo2Zk/lib_client/michelson_v1_emacs.ml @@ -212,7 +212,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml b/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml index 42898457821d..0dc68c8e480a 100644 --- a/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_008_PtEdo2Zk/lib_client_sapling/client_sapling_commands.ml @@ -497,7 +497,7 @@ let submit_shielded_cmd = return @@ Data_encoding.Binary.of_bytes_exn UTXO.transaction_encoding - Hex.(to_bytes (`Hex hex))) + Hex.(to_bytes_exn (`Hex hex))) >>=? fun transaction -> return Shielded_tez_contract_input.(as_arg (create transaction)) >>=? fun contract_input -> diff --git a/src/proto_009_PsFLoren/lib_client/client_proto_args.ml b/src/proto_009_PsFLoren/lib_client/client_proto_args.ml index 7b984e43ec08..80f9357f22d4 100644 --- a/src/proto_009_PsFLoren/lib_client/client_proto_args.ml +++ b/src/proto_009_PsFLoren/lib_client/client_proto_args.ml @@ -130,11 +130,13 @@ let int_parameter = try return (int_of_string p) with _ -> failwith "Cannot read int") let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_009_PsFLoren/lib_client/michelson_v1_emacs.ml b/src/proto_009_PsFLoren/lib_client/michelson_v1_emacs.ml index aaed4a26d0bc..2721fa702d46 100644 --- a/src/proto_009_PsFLoren/lib_client/michelson_v1_emacs.ml +++ b/src/proto_009_PsFLoren/lib_client/michelson_v1_emacs.ml @@ -212,7 +212,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml b/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml index b12de505a37a..5165ce4701b5 100644 --- a/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_009_PsFLoren/lib_client_sapling/client_sapling_commands.ml @@ -497,7 +497,7 @@ let submit_shielded_cmd = return @@ Data_encoding.Binary.of_bytes_exn UTXO.transaction_encoding - Hex.(to_bytes (`Hex hex))) + Hex.(to_bytes_exn (`Hex hex))) >>=? fun transaction -> return Shielded_tez_contract_input.(as_arg (create transaction)) >>=? fun contract_input -> diff --git a/src/proto_010_PtGRANAD/lib_client/client_proto_args.ml b/src/proto_010_PtGRANAD/lib_client/client_proto_args.ml index 550ca23f215e..8a2a475e4fe5 100644 --- a/src/proto_010_PtGRANAD/lib_client/client_proto_args.ml +++ b/src/proto_010_PtGRANAD/lib_client/client_proto_args.ml @@ -130,11 +130,13 @@ let int_parameter = try return (int_of_string p) with _ -> failwith "Cannot read int") let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_010_PtGRANAD/lib_client/michelson_v1_emacs.ml b/src/proto_010_PtGRANAD/lib_client/michelson_v1_emacs.ml index aaed4a26d0bc..2721fa702d46 100644 --- a/src/proto_010_PtGRANAD/lib_client/michelson_v1_emacs.ml +++ b/src/proto_010_PtGRANAD/lib_client/michelson_v1_emacs.ml @@ -212,7 +212,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_010_PtGRANAD/lib_client_sapling/client_sapling_commands.ml b/src/proto_010_PtGRANAD/lib_client_sapling/client_sapling_commands.ml index cfe8e01e77a5..3a268e4a37a3 100644 --- a/src/proto_010_PtGRANAD/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_010_PtGRANAD/lib_client_sapling/client_sapling_commands.ml @@ -500,7 +500,7 @@ let submit_shielded_cmd = return @@ Data_encoding.Binary.of_bytes_exn UTXO.transaction_encoding - Hex.(to_bytes (`Hex hex))) + Hex.(to_bytes_exn (`Hex hex))) >>=? fun transaction -> return Shielded_tez_contract_input.(as_arg (create transaction)) >>=? fun contract_input -> diff --git a/src/proto_010_PtGRANAD/lib_delegate/client_baking_pow.ml b/src/proto_010_PtGRANAD/lib_delegate/client_baking_pow.ml index fd7c820402d3..d7f4e2b92384 100644 --- a/src/proto_010_PtGRANAD/lib_delegate/client_baking_pow.ml +++ b/src/proto_010_PtGRANAD/lib_delegate/client_baking_pow.ml @@ -29,9 +29,9 @@ let default_constant = "\x00\x00\x00\x05" let is_updated_constant = let commit_hash = - if TzString.is_hex Tezos_version.Current_git_info.commit_hash then - Hex.to_string (`Hex Tezos_version.Current_git_info.commit_hash) - else Tezos_version.Current_git_info.commit_hash + match Hex.to_string (`Hex Tezos_version.Current_git_info.commit_hash) with + | None -> Tezos_version.Current_git_info.commit_hash + | Some s -> s in if String.length commit_hash >= 4 then String.sub commit_hash 0 4 else default_constant diff --git a/src/proto_010_PtGRANAD/lib_protocol/test/unit/test_alpha_context.ml b/src/proto_010_PtGRANAD/lib_protocol/test/unit/test_alpha_context.ml index 64824a7f6ae4..ef7f84ba9a0e 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/test/unit/test_alpha_context.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/test/unit/test_alpha_context.ml @@ -60,7 +60,7 @@ module Test_Script = struct "script serialised incorrectly" mbytes_pp bytes - (`Hex "030b" |> Hex.to_bytes) + (`Hex "030b" |> Hex.to_bytes_exn) end module Test_Big_map = struct diff --git a/src/proto_011_PtHangz2/lib_client/client_proto_args.ml b/src/proto_011_PtHangz2/lib_client/client_proto_args.ml index 793b95cfd1b8..0a0595b6f1f6 100644 --- a/src/proto_011_PtHangz2/lib_client/client_proto_args.ml +++ b/src/proto_011_PtHangz2/lib_client/client_proto_args.ml @@ -130,11 +130,13 @@ let int_parameter = try return (int_of_string p) with _ -> failwith "Cannot read int") let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_011_PtHangz2/lib_client/michelson_v1_emacs.ml b/src/proto_011_PtHangz2/lib_client/michelson_v1_emacs.ml index aaed4a26d0bc..2721fa702d46 100644 --- a/src/proto_011_PtHangz2/lib_client/michelson_v1_emacs.ml +++ b/src/proto_011_PtHangz2/lib_client/michelson_v1_emacs.ml @@ -212,7 +212,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_011_PtHangz2/lib_client_sapling/client_sapling_commands.ml b/src/proto_011_PtHangz2/lib_client_sapling/client_sapling_commands.ml index cfe8e01e77a5..3a268e4a37a3 100644 --- a/src/proto_011_PtHangz2/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_011_PtHangz2/lib_client_sapling/client_sapling_commands.ml @@ -500,7 +500,7 @@ let submit_shielded_cmd = return @@ Data_encoding.Binary.of_bytes_exn UTXO.transaction_encoding - Hex.(to_bytes (`Hex hex))) + Hex.(to_bytes_exn (`Hex hex))) >>=? fun transaction -> return Shielded_tez_contract_input.(as_arg (create transaction)) >>=? fun contract_input -> diff --git a/src/proto_011_PtHangz2/lib_delegate/client_baking_pow.ml b/src/proto_011_PtHangz2/lib_delegate/client_baking_pow.ml index fd7c820402d3..d7f4e2b92384 100644 --- a/src/proto_011_PtHangz2/lib_delegate/client_baking_pow.ml +++ b/src/proto_011_PtHangz2/lib_delegate/client_baking_pow.ml @@ -29,9 +29,9 @@ let default_constant = "\x00\x00\x00\x05" let is_updated_constant = let commit_hash = - if TzString.is_hex Tezos_version.Current_git_info.commit_hash then - Hex.to_string (`Hex Tezos_version.Current_git_info.commit_hash) - else Tezos_version.Current_git_info.commit_hash + match Hex.to_string (`Hex Tezos_version.Current_git_info.commit_hash) with + | None -> Tezos_version.Current_git_info.commit_hash + | Some s -> s in if String.length commit_hash >= 4 then String.sub commit_hash 0 4 else default_constant diff --git a/src/proto_011_PtHangz2/lib_protocol/test/unit/test_alpha_context.ml b/src/proto_011_PtHangz2/lib_protocol/test/unit/test_alpha_context.ml index 64824a7f6ae4..ef7f84ba9a0e 100644 --- a/src/proto_011_PtHangz2/lib_protocol/test/unit/test_alpha_context.ml +++ b/src/proto_011_PtHangz2/lib_protocol/test/unit/test_alpha_context.ml @@ -60,7 +60,7 @@ module Test_Script = struct "script serialised incorrectly" mbytes_pp bytes - (`Hex "030b" |> Hex.to_bytes) + (`Hex "030b" |> Hex.to_bytes_exn) end module Test_Big_map = struct diff --git a/src/proto_alpha/lib_client/client_proto_args.ml b/src/proto_alpha/lib_client/client_proto_args.ml index d66a090b1cf8..ef75fd573aa6 100644 --- a/src/proto_alpha/lib_client/client_proto_args.ml +++ b/src/proto_alpha/lib_client/client_proto_args.ml @@ -132,11 +132,13 @@ let int_parameter = let uri_parameter = parameter (fun _ x -> return (Uri.of_string x)) let bytes_of_prefixed_string s = - try - if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then raise Exit - else return (Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2)))) - with _ -> - failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" + match + if String.length s < 2 || s.[0] <> '0' || s.[1] <> 'x' then None + else Hex.to_bytes (`Hex (String.sub s 2 (String.length s - 2))) + with + | Some s -> return s + | None -> + failwith "Invalid bytes, expecting hexadecimal notation (e.g. 0x1234abcd)" let bytes_parameter = parameter (fun _ s -> bytes_of_prefixed_string s) diff --git a/src/proto_alpha/lib_client/michelson_v1_emacs.ml b/src/proto_alpha/lib_client/michelson_v1_emacs.ml index aaed4a26d0bc..2721fa702d46 100644 --- a/src/proto_alpha/lib_client/michelson_v1_emacs.ml +++ b/src/proto_alpha/lib_client/michelson_v1_emacs.ml @@ -212,7 +212,7 @@ let report_errors ppf (parsed, errs) = | Unterminated_string loc | Unterminated_integer loc | Unterminated_comment loc - | Odd_lengthed_bytes loc + | Invalid_hex_bytes loc | Unclosed {loc; _} | Unexpected {loc; _} | Extra {loc; _} -> diff --git a/src/proto_alpha/lib_client_commands/client_proto_utils_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_utils_commands.ml index fe4b0a4c33a4..7f57941fb389 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_utils_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_utils_commands.ml @@ -33,9 +33,10 @@ let unsigned_block_header_param = ~name:"unsigned block header" ~desc:"A hex or JSON encoded unsigned block header" @@ parameter (fun _ s -> - let bytes = `Hex s |> Hex.to_bytes in + let bytes_opt = `Hex s |> Hex.to_bytes in let enc = Protocol.Alpha_context.Block_header.unsigned_encoding in - Data_encoding.Binary.of_bytes_opt enc bytes |> function + Option.bind bytes_opt (Data_encoding.Binary.of_bytes_opt enc) + |> function | Some s -> return s | None -> ( let error = diff --git a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml index cfe8e01e77a5..3a268e4a37a3 100644 --- a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml @@ -500,7 +500,7 @@ let submit_shielded_cmd = return @@ Data_encoding.Binary.of_bytes_exn UTXO.transaction_encoding - Hex.(to_bytes (`Hex hex))) + Hex.(to_bytes_exn (`Hex hex))) >>=? fun transaction -> return Shielded_tez_contract_input.(as_arg (create transaction)) >>=? fun contract_input -> diff --git a/src/proto_alpha/lib_delegate/baking_pow.ml b/src/proto_alpha/lib_delegate/baking_pow.ml index bf641b0554d1..5637988fb52b 100644 --- a/src/proto_alpha/lib_delegate/baking_pow.ml +++ b/src/proto_alpha/lib_delegate/baking_pow.ml @@ -29,9 +29,9 @@ let default_constant = "\x00\x00\x00\x05" let is_updated_constant = let commit_hash = - if TzString.is_hex Tezos_version.Current_git_info.commit_hash then - Hex.to_string (`Hex Tezos_version.Current_git_info.commit_hash) - else Tezos_version.Current_git_info.commit_hash + match Hex.to_string (`Hex Tezos_version.Current_git_info.commit_hash) with + | None -> Tezos_version.Current_git_info.commit_hash + | Some s -> s in if String.length commit_hash >= 4 then String.sub commit_hash 0 4 else default_constant diff --git a/src/proto_alpha/lib_protocol/test/unit/test_alpha_context.ml b/src/proto_alpha/lib_protocol/test/unit/test_alpha_context.ml index 64824a7f6ae4..ef7f84ba9a0e 100644 --- a/src/proto_alpha/lib_protocol/test/unit/test_alpha_context.ml +++ b/src/proto_alpha/lib_protocol/test/unit/test_alpha_context.ml @@ -60,7 +60,7 @@ module Test_Script = struct "script serialised incorrectly" mbytes_pp bytes - (`Hex "030b" |> Hex.to_bytes) + (`Hex "030b" |> Hex.to_bytes_exn) end module Test_Big_map = struct -- GitLab From 0fd13a2d1cde27c3b89076a39ac2c033bfdb2e58 Mon Sep 17 00:00:00 2001 From: satos---jp Date: Fri, 10 Dec 2021 17:50:58 +0900 Subject: [PATCH 2/3] fix typo --- src/lib_stdlib/tzHex.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_stdlib/tzHex.mli b/src/lib_stdlib/tzHex.mli index 8aef415ac521..fd915e517406 100644 --- a/src/lib_stdlib/tzHex.mli +++ b/src/lib_stdlib/tzHex.mli @@ -28,7 +28,7 @@ type t = [`Hex of string] [c]. *) val of_char : char -> char * char -(** [to_char x y] is the character correspondong to the [xy] +(** [to_char x y] is the character corresponding to the [xy] hexadecimal encoding. Returns [None] if [x] or [y] are not in the ranges ['0'..'9'], -- GitLab From da73079af9933e73fff1d9b1e18b0342b5170c05 Mon Sep 17 00:00:00 2001 From: satos---jp Date: Fri, 10 Dec 2021 20:54:04 +0900 Subject: [PATCH 3/3] fix typos --- src/lib_protocol_environment/sigs/v1/hex.mli | 2 +- src/lib_protocol_environment/sigs/v2/hex.mli | 2 +- src/lib_protocol_environment/sigs/v3/hex.mli | 2 +- src/lib_protocol_environment/sigs/v4/hex.mli | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/lib_protocol_environment/sigs/v1/hex.mli b/src/lib_protocol_environment/sigs/v1/hex.mli index 9a7b01176e1f..9a25d2c5c638 100644 --- a/src/lib_protocol_environment/sigs/v1/hex.mli +++ b/src/lib_protocol_environment/sigs/v1/hex.mli @@ -30,7 +30,7 @@ val of_char: char -> char * char [c]. *) val to_char: char -> char -> char -(** [to_char x y] is the character correspondong to the [xy] +(** [to_char x y] is the character corresponding to the [xy] hexadecimal encoding. *) (** {1:string Strings} *) diff --git a/src/lib_protocol_environment/sigs/v2/hex.mli b/src/lib_protocol_environment/sigs/v2/hex.mli index 9a7b01176e1f..9a25d2c5c638 100644 --- a/src/lib_protocol_environment/sigs/v2/hex.mli +++ b/src/lib_protocol_environment/sigs/v2/hex.mli @@ -30,7 +30,7 @@ val of_char: char -> char * char [c]. *) val to_char: char -> char -> char -(** [to_char x y] is the character correspondong to the [xy] +(** [to_char x y] is the character corresponding to the [xy] hexadecimal encoding. *) (** {1:string Strings} *) diff --git a/src/lib_protocol_environment/sigs/v3/hex.mli b/src/lib_protocol_environment/sigs/v3/hex.mli index 9a7b01176e1f..9a25d2c5c638 100644 --- a/src/lib_protocol_environment/sigs/v3/hex.mli +++ b/src/lib_protocol_environment/sigs/v3/hex.mli @@ -30,7 +30,7 @@ val of_char: char -> char * char [c]. *) val to_char: char -> char -> char -(** [to_char x y] is the character correspondong to the [xy] +(** [to_char x y] is the character corresponding to the [xy] hexadecimal encoding. *) (** {1:string Strings} *) diff --git a/src/lib_protocol_environment/sigs/v4/hex.mli b/src/lib_protocol_environment/sigs/v4/hex.mli index f53cb343ee74..3bc46cf1a71b 100644 --- a/src/lib_protocol_environment/sigs/v4/hex.mli +++ b/src/lib_protocol_environment/sigs/v4/hex.mli @@ -30,7 +30,7 @@ val of_char: char -> char * char [c]. *) val to_char: char -> char -> char option -(** [to_char x y] is the character correspondong to the [xy] +(** [to_char x y] is the character corresponding to the [xy] hexadecimal encoding. Returns [None] if [x] or [y] are not in the ranges ['0'..'9'], -- GitLab