Revision a365c55931004630064261aed22e96c1910637a4 authored by Marge Bot on 05 February 2024, 08:58:04 UTC, committed by Marge Bot on 05 February 2024, 08:58:04 UTC
Co-authored-by: pecornilleau <pe.cornilleau@marigold.dev> Approved-by: Pierrick Couderc <pierrick.couderc@nomadic-labs.com> Approved-by: Emma Turner <1623821-emturner@users.noreply.gitlab.com> See merge request https://gitlab.com/tezos/tezos/-/merge_requests/11815
commands.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com> *)
(* *)
(* 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. *)
(* *)
(*****************************************************************************)
open Tezos_clic
let group = {name = "encoding"; title = "Commands to handle encodings"}
let id_parameter =
parameter (fun (cctxt : #Client_context.printer) id ->
match Data_encoding.Registration.find id with
| Some record -> Lwt.return_ok record
| None -> cctxt#error "Unknown encoding id: %s" id)
let json_parameter =
let open Lwt_syntax in
parameter (fun (cctxt : #Client_context.printer) file_or_data ->
let* data =
let* file_exists = Lwt_unix.file_exists file_or_data in
if file_exists then
Tezos_stdlib_unix.Lwt_utils_unix.read_file file_or_data
else Lwt.return file_or_data
in
match Json.from_string data with
| Ok json -> return_ok json
| Error err -> cctxt#error "%s" err)
let bytes_parameter =
parameter (fun (cctxt : #Client_context.printer) hex ->
let hex =
if Sys.file_exists hex then (
let ic = open_in hex in
let contents =
let rec loop acc =
match input_line ic with
| s -> loop (s :: acc)
| exception End_of_file -> String.concat "" (List.rev acc)
in
loop []
in
close_in ic ;
contents)
else hex
in
match Hex.to_bytes (`Hex hex) with
| Some s -> Lwt.return_ok s
| None -> cctxt#error "Invalid hex string: %s" hex)
let full_bytes_parameter =
param
~name:"data"
~desc:"Hex-encoded binary-encoded data or name of file containing the data"
bytes_parameter
let format_arg =
default_arg
~doc:"The format to print the output in: json, pretty, or waterfall."
~long:"format"
~placeholder:"FORMAT"
~default:"pretty"
(parameter (fun (cctxt : #Client_context.printer) format ->
match format with
| "json" -> Lwt.return_ok `Json
| "pretty" -> Lwt.return_ok `Pp
| "waterfall" -> Lwt.return_ok `Waterfall
| _ ->
cctxt#error
"Cannot decode --format argument, use 'json', 'pretty', or \
'waterfall'."))
let slices_encoding =
let open Data_encoding in
list
(conv
(fun {Binary.Slicer.name; value; pretty_printed} ->
let pretty_printed =
if pretty_printed = "" then None else Some pretty_printed
in
let hex_slice = Format.asprintf "%a" Hex.pp (Hex.of_string value) in
(name, value, hex_slice, pretty_printed))
(fun (name, value, _, pretty_printed) ->
let pretty_printed = Option.value ~default:"" pretty_printed in
{Binary.Slicer.name; value; pretty_printed})
(obj4
(req "name" string)
(req "raw-slice" string)
(req "hex-slice" string)
(opt "pretty" string)))
let pp_slices format ppf slices =
match format with
| `Json ->
let j = Data_encoding.Json.construct slices_encoding slices in
let () = Data_encoding.Json.pp ppf j in
()
| `Pp ->
Format.pp_print_list
~pp_sep:Format.pp_print_newline
(fun ppf {Data_encoding.Binary.Slicer.name; value; pretty_printed} ->
let value = Format.asprintf "%a" Hex.pp (Hex.of_string value) in
if String.length value <= 18 then
Format.fprintf
ppf
"%s%s%s%a"
value
(String.make (20 - String.length value) ' ')
name
(fun ppf ppv ->
if ppv = "" then () else Format.fprintf ppf " = %s" ppv)
pretty_printed
else
Format.fprintf
ppf
"%s\n%s%s%a"
value
(String.make 20 ' ')
name
(fun ppf ppv ->
if ppv = "" then () else Format.fprintf ppf " = %s" ppv)
pretty_printed)
ppf
slices
| `Waterfall ->
let (_ : int) =
List.fold_left
(fun margin {Data_encoding.Binary.Slicer.name; value; pretty_printed} ->
let value = Format.asprintf "%a" Hex.pp (Hex.of_string value) in
Format.fprintf
ppf
"%s%s %s%a\n"
(String.make margin ' ')
value
name
(fun ppf ppv ->
if ppv = "" then () else Format.fprintf ppf " = %s" ppv)
pretty_printed ;
margin + String.length value)
0
slices
in
()
let commands () =
let open Lwt_syntax in
[
command
~group
~desc:"List the registered encoding in Tezos."
no_options
(fixed ["list"; "encodings"])
(fun () (cctxt : #Client_context.printer) ->
let bindings =
Data_encoding.Registration.list ()
|> List.map (fun (id, elem) ->
(id, Data_encoding.Registration.description elem))
in
let* () =
cctxt#message
"@[<v>%a@]@."
(Format.pp_print_list
~pp_sep:Format.pp_print_cut
(fun ppf (id, desc) ->
let desc =
Option.value ~default:"No description available." desc
in
Format.fprintf
ppf
"@[<v 2>%s:@ @[%a@]@]"
id
Format.pp_print_text
desc))
bindings
in
Lwt_result_syntax.return_unit);
command
~group
~desc:"Dump a JSON description of all registered encodings."
(args1
@@ switch
~doc:
"Output JSON descriptions without extraneous whitespace characters"
~long:"compact"
())
(fixed ["dump"; "encodings"])
(fun minify (cctxt : #Client_context.printer) ->
let* () =
cctxt#message
"%s"
(Json.to_string
~minify
(`A
(Registration.list ()
|> List.map (fun (id, enc) ->
`O
[
("id", `String id);
( "json",
Json.construct
Json.schema_encoding
(Registration.json_schema enc) );
( "binary",
Json.construct
Binary_schema.encoding
(Registration.binary_schema enc) );
]))))
in
Lwt_result_syntax.return_unit);
command
~group
~desc:"Dump a JSON description of a given registered encoding."
(args1
@@ switch
~doc:
"Output JSON description without extraneous whitespace characters"
~long:"compact"
())
(prefix "dump" @@ prefix "encoding"
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ stop)
(fun minify registered_encoding (cctxt : #Client_context.printer) ->
let* () =
cctxt#message
"%s"
(Json.to_string
~minify
(`O
[
( "json",
Json.construct
Json.schema_encoding
(Registration.json_schema registered_encoding) );
( "binary",
Json.construct
Binary_schema.encoding
(Registration.binary_schema registered_encoding) );
]))
in
Lwt_result_syntax.return_unit);
(* JSON -> Binary *)
command
~group
~desc:
"Encode the given JSON data into binary using the provided encoding \
identifier."
no_options
(prefix "encode"
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ prefix "from"
@@ param ~name:"data" ~desc:"JSON file or data" json_parameter
@@ stop)
(fun () registered_encoding data (cctxt : #Client_context.printer) ->
match
Data_encoding.Registration.bytes_of_json registered_encoding data
with
| exception exn ->
cctxt#error "%a" (fun ppf exn -> Json.print_error ppf exn) exn
| None ->
cctxt#error
"Impossible to the JSON convert to binary.@,\
This error should not happen."
| Some bytes ->
let* () = cctxt#message "%a" Hex.pp (Hex.of_bytes bytes) in
Lwt_result_syntax.return_unit);
(* Binary -> JSON *)
command
~group
~desc:
"Decode the binary encoded data into JSON using the provided encoding \
identifier."
no_options
(prefix "decode"
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ prefix "from" @@ full_bytes_parameter @@ stop)
(fun () registered_encoding bytes (cctxt : #Client_context.printer) ->
match
Data_encoding.Registration.json_of_bytes registered_encoding bytes
with
| None -> cctxt#error "Cannot parse the binary with the given encoding"
| Some bytes ->
let* () = cctxt#message "%a" Json.pp bytes in
Lwt_result_syntax.return_unit);
command
~group
~desc:
"Display the binary encoded data using the provided encoding \
identifier."
no_options
(prefix "display"
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ prefixes ["from"; "binary"]
@@ full_bytes_parameter @@ stop)
(fun () registered_encoding bytes (cctxt : #Client_context.printer) ->
let pp_bytes fmt bytes =
Data_encoding.Registration.binary_pretty_printer
registered_encoding
fmt
bytes
in
let* () = cctxt#message "%a" pp_bytes bytes in
Lwt_result_syntax.return_unit);
command
~group
~desc:
"Display the JSON encoded data using the provided encoding identifier."
no_options
(prefix "display"
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ prefixes ["from"; "json"]
@@ param ~name:"data" ~desc:"JSON file or data" json_parameter
@@ stop)
(fun () registered_encoding data (cctxt : #Client_context.printer) ->
let pp_json fmt json =
Data_encoding.Registration.json_pretty_printer
registered_encoding
fmt
json
in
let* () = cctxt#message "%a" pp_json data in
Lwt_result_syntax.return_unit);
command
~group
~desc:
"Describe the binary schema associated to the provided encoding \
identifier."
no_options
(prefix "describe"
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ prefixes ["binary"; "schema"]
@@ stop)
(fun () registered_encoding (cctxt : #Client_context.printer) ->
let schema =
Data_encoding.Registration.binary_schema registered_encoding
in
let* () = cctxt#message "%a" Data_encoding.Binary_schema.pp schema in
Lwt_result_syntax.return_unit);
command
~group
~desc:
"Describe the JSON schema associated to the provided encoding \
identifier."
no_options
(prefix "describe"
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ prefixes ["json"; "schema"]
@@ stop)
(fun () registered_encoding cctxt ->
let schema =
Data_encoding.Registration.json_schema registered_encoding
in
let* () = cctxt#message "%a" Json_schema.pp schema in
Lwt_result_syntax.return_unit);
command
~group
~desc:
"Attempts to slice an hex-encoded binary value with all known \
encodings."
no_options
(prefix "slice" @@ full_bytes_parameter @@ stop)
(fun () bytes cctxt ->
let bytes = Bytes.to_string bytes in
let all = Data_encoding.Registration.slice_all bytes in
match all with
| [] -> cctxt#error "No matching encoding found"
| _ ->
let* () =
List.iter_s
(fun (encoding_name, slices) ->
cctxt#message
"%s:\n%a\n\n"
encoding_name
(pp_slices `Pp)
slices)
all
in
Lwt_result_syntax.return_unit);
command
~group
~desc:"Slice an hex-encoded binary value with the specified encoding."
(args1 format_arg)
(prefix "slice"
@@ param
~name:"data"
~desc:
"Hex-encoded binary-encoded data or name of file containing the \
data"
bytes_parameter
@@ prefixes ["with"; "encoding"]
@@ param ~name:"id" ~desc:"Encoding identifier" id_parameter
@@ stop)
(fun format bytes encoding_id cctxt ->
let bytes = Bytes.to_string bytes in
match Data_encoding.Registration.slice encoding_id bytes with
| Error read_error ->
cctxt#error "%a" Data_encoding.Binary.pp_read_error read_error
| Ok slices ->
let* () = cctxt#message "%a\n" (pp_slices format) slices in
Lwt_result_syntax.return_unit);
]
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...