Revision 9279f79af3e7122c100e53fce89fa0dab17d1e5f authored by Julien Tesson on 17 December 2019, 21:09:14 UTC, committed by Pierre Boutillier on 19 December 2019, 14:11:26 UTC
To detect the presence of a "default" entrypoint and get its type, the current implementation uses the entrypoint typechecking RPC. If it fails, it assumes that the entrypoint doesn't exists. This patch discriminate the 404 Not Found error that indicates the absence of such entrypoint with other error that can happen, for example Forbidden access in presence of RPC filters, or internal error in case of proxy malfunction.
1 parent 686bb91
binary_schema.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.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. *)
(* *)
(*****************************************************************************)
let may_cons xs x = match x with None -> xs | Some x -> x :: xs
let filter_map f l =
List.rev @@ List.fold_left (fun acc x -> may_cons acc (f x)) [] l
open Encoding
type integer_extended = [Binary_size.integer | `Int32 | `Int64]
type field_descr =
| Named_field of string * Kind.t * layout
| Anonymous_field of Kind.t * layout
| Dynamic_size_field of string option * int * Binary_size.unsigned_integer
| Optional_field of string
and layout =
| Zero_width
| Int of integer_extended
| Bool
| RangedInt of int * int
| RangedFloat of float * float
| Float
| Bytes
| String
| Enum of Binary_size.integer * string
| Seq of layout * int option (* For arrays and lists *)
| Ref of string
| Padding
and fields = field_descr list
and toplevel_encoding =
| Obj of {fields : fields}
| Cases of {
kind : Kind.t;
tag_size : Binary_size.tag_size;
cases : (int * string option * fields) list;
}
| Int_enum of {size : Binary_size.integer; cases : (int * string) list}
and description = {title : string; description : string option}
type t = {
toplevel : toplevel_encoding;
fields : (description * toplevel_encoding) list;
}
module Printer_ast = struct
type table = {headers : string list; body : string list list}
type t =
| Table of table
| Union of Binary_size.tag_size * (description * table) list
let pp_size ppf = function
| `Fixed size ->
Format.fprintf ppf "%d byte%s" size (if size = 1 then "" else "s")
| `Variable ->
Format.fprintf ppf "Variable"
| `Dynamic ->
Format.fprintf ppf "Determined from data"
let pp_int ppf (int : integer_extended) =
Format.fprintf
ppf
"%s"
( match int with
| `Int16 ->
"signed 16-bit integer"
| `Int31 ->
"signed 31-bit integer"
| `Uint30 ->
"unsigned 30-bit integer"
| `Int32 ->
"signed 32-bit integer"
| `Int64 ->
"signed 64-bit integer"
| `Int8 ->
"signed 8-bit integer"
| `Uint16 ->
"unsigned 16-bit integer"
| `Uint8 ->
"unsigned 8-bit integer" )
let rec pp_layout ppf = function
| Zero_width ->
()
| Int integer ->
Format.fprintf ppf "%a" pp_int integer
| Bool ->
Format.fprintf ppf "boolean (0 for false, 255 for true)"
| RangedInt (minimum, maximum) when minimum <= 0 ->
Format.fprintf
ppf
"%a in the range %d to %d"
pp_int
(Binary_size.range_to_size ~minimum ~maximum :> integer_extended)
minimum
maximum
| RangedInt (minimum, maximum) (* when minimum > 0 *) ->
Format.fprintf
ppf
"%a in the range %d to %d (shifted by %d)"
pp_int
(Binary_size.range_to_size ~minimum ~maximum :> integer_extended)
minimum
maximum
minimum
| RangedFloat (minimum, maximum) ->
Format.fprintf
ppf
"double-precision floating-point number, in the range %f to %f"
minimum
maximum
| Float ->
Format.fprintf ppf "double-precision floating-point number"
| Bytes ->
Format.fprintf ppf "bytes"
| String ->
Format.fprintf ppf "bytes"
| Ref reference ->
Format.fprintf ppf "$%s" reference
| Padding ->
Format.fprintf ppf "padding"
| Enum (size, reference) ->
Format.fprintf
ppf
"%a encoding an enumeration (see %s)"
pp_int
(size :> integer_extended)
reference
| Seq (data, len) -> (
Format.fprintf ppf "sequence of " ;
( match len with
| None ->
()
| Some len ->
Format.fprintf ppf "at most %d " len ) ;
match data with
| Ref reference ->
Format.fprintf ppf "$%s" reference
| _ ->
pp_layout ppf data )
let pp_tag_size ppf tag =
Format.fprintf ppf "%s"
@@ match tag with `Uint8 -> "8-bit" | `Uint16 -> "16-bit"
let field_descr () =
let reference = ref 0 in
let string_of_layout = Format.asprintf "%a" pp_layout in
let anon_num () =
let value = !reference in
reference := value + 1 ;
string_of_int value
in
let is_zero_size_kind = function `Fixed 0 -> true | _ -> false in
function
| Named_field (name, kind, desc) ->
Some [name; Format.asprintf "%a" pp_size kind; string_of_layout desc]
| Dynamic_size_field (Some name, 1, size) ->
Some
[ Format.asprintf "# bytes in field \"%s\"" name;
Format.asprintf
"%a"
pp_size
(`Fixed (Binary_size.integer_to_size size));
string_of_layout (Int (size :> integer_extended)) ]
| Dynamic_size_field (None, 1, size) ->
Some
[ Format.asprintf "# bytes in next field";
Format.asprintf
"%a"
pp_size
(`Fixed (Binary_size.integer_to_size size));
string_of_layout (Int (size :> integer_extended)) ]
| Dynamic_size_field (_, i, size) ->
Some
[ Format.asprintf "# bytes in next %d fields" i;
Format.asprintf
"%a"
pp_size
(`Fixed (Binary_size.integer_to_size size));
string_of_layout (Int (size :> integer_extended)) ]
| Anonymous_field (kind, desc) ->
if not (is_zero_size_kind kind) then
Some
[ "Unnamed field " ^ anon_num ();
Format.asprintf "%a" pp_size kind;
string_of_layout desc ]
else None
| Optional_field name ->
Some
[ Format.asprintf "? presence of field \"%s\"" name;
Format.asprintf "%a" pp_size (`Fixed 1);
string_of_layout Bool ]
let binary_table_headers = ["Name"; "Size"; "Contents"]
let enum_headers = ["Case number"; "Encoded string"]
let toplevel (descr, encoding) =
match encoding with
| Obj {fields} ->
( descr,
Table
{
headers = binary_table_headers;
body = filter_map (field_descr ()) fields;
} )
| Cases {kind; tag_size; cases} ->
( {
title =
Format.asprintf
"%s (%a, %a tag)"
descr.title
pp_size
kind
pp_tag_size
tag_size;
description = descr.description;
},
Union
( tag_size,
List.map
(fun (tag, name, fields) ->
( {
title =
( match name with
| Some name ->
Format.asprintf "%s (tag %d)" name tag
| None ->
Format.asprintf "Tag %d" tag );
description = None;
},
{
headers = binary_table_headers;
body = filter_map (field_descr ()) fields;
} ))
cases ) )
| Int_enum {size; cases} ->
( {
title =
Format.asprintf
"%s (Enumeration: %a):"
descr.title
pp_int
(size :> integer_extended);
description = descr.description;
},
Table
{
headers = enum_headers;
body =
List.map (fun (num, str) -> [string_of_int num; str]) cases;
} )
end
module Printer = struct
let rec pad char ppf = function
| 0 ->
()
| n ->
Format.pp_print_char ppf char ;
pad char ppf (n - 1)
let pp_title level ppf title =
let char = if level = 1 then '*' else if level = 2 then '=' else '`' in
let sub = String.map (fun _ -> char) title in
Format.fprintf ppf "%s@ %s@\n@\n" title sub
let pp_table ppf {Printer_ast.headers; body} =
let max_widths =
List.fold_left
(List.map2 (fun len str -> max (String.length str) len))
(List.map String.length headers)
body
in
let pp_row pad_char ppf =
Format.fprintf ppf "|%a" (fun ppf ->
List.iter2
(fun width str ->
Format.fprintf
ppf
" %s%a |"
str
(pad pad_char)
(width - String.length str))
max_widths)
in
let pp_line c ppf =
Format.fprintf ppf "+%a" (fun ppf ->
List.iter2
(fun width _str -> Format.fprintf ppf "%a+" (pad c) (width + 2))
max_widths)
in
Format.fprintf
ppf
"%a@\n%a@\n%a@\n%a@\n@\n"
(pp_line '-')
headers
(pp_row ' ')
headers
(pp_line '=')
headers
(Format.pp_print_list
~pp_sep:(fun ppf () -> Format.fprintf ppf "@\n")
(fun ppf s ->
Format.fprintf ppf "%a@\n%a" (pp_row ' ') s (pp_line '-') s))
body
let pp_option_nl ppf = function
| Some s ->
Format.fprintf ppf "%s@\n@\n" s
| None ->
()
let pp_toplevel ppf = function
| Printer_ast.Table table ->
pp_table ppf table
| Union (_tag_size, tables) ->
Format.fprintf
ppf
"%a"
(fun ppf ->
Format.pp_print_list
~pp_sep:(fun ppf () -> Format.fprintf ppf "@\n")
(fun ppf (descr, table) ->
Format.fprintf
ppf
"%a%a%a"
(pp_title 2)
descr.title
pp_option_nl
descr.description
pp_table
table)
ppf)
tables
let pp ppf {toplevel; fields} =
let (_, toplevel) =
Printer_ast.toplevel ({title = ""; description = None}, toplevel)
in
Format.fprintf
ppf
"%a@\n%a"
pp_toplevel
toplevel
(Format.pp_print_list
~pp_sep:(fun ppf () -> Format.fprintf ppf "@\n")
(fun ppf (descr, toplevel) ->
Format.fprintf
ppf
"%a%a%a"
(pp_title 1)
descr.title
pp_option_nl
descr.description
pp_toplevel
toplevel))
(List.map Printer_ast.toplevel fields)
end
module Encoding = struct
let description_encoding =
conv
(fun {title; description} -> (title, description))
(fun (title, description) -> {title; description})
(obj2 (req "title" string) (opt "description" string))
let integer_cases =
[("Int16", `Int16); ("Int8", `Int8); ("Uint16", `Uint16); ("Uint8", `Uint8)]
let integer_encoding : Binary_size.integer encoding =
string_enum integer_cases
let integer_extended_encoding =
string_enum (("Int64", `Int64) :: ("Int32", `Int32) :: integer_cases)
let layout_encoding =
mu "layout" (fun layout ->
union
[ case
~title:"Zero_width"
(Tag 0)
(obj1 (req "kind" (constant "Zero_width")))
(function Zero_width -> Some () | _ -> None)
(fun () -> Zero_width);
case
~title:"Int"
(Tag 1)
(obj2
(req "size" integer_extended_encoding)
(req "kind" (constant "Int")))
(function Int integer -> Some (integer, ()) | _ -> None)
(fun (integer, _) -> Int integer);
case
~title:"Bool"
(Tag 2)
(obj1 (req "kind" (constant "Bool")))
(function Bool -> Some () | _ -> None)
(fun () -> Bool);
case
~title:"RangedInt"
(Tag 3)
(obj3
(req "min" int31)
(req "max" int31)
(req "kind" (constant "RangedInt")))
(function
| RangedInt (min, max) -> Some (min, max, ()) | _ -> None)
(fun (min, max, _) -> RangedInt (min, max));
case
~title:"RangedFloat"
(Tag 4)
(obj3
(req "min" float)
(req "max" float)
(req "kind" (constant "RangedFloat")))
(function
| RangedFloat (min, max) -> Some (min, max, ()) | _ -> None)
(fun (min, max, ()) -> RangedFloat (min, max));
case
~title:"Float"
(Tag 5)
(obj1 (req "kind" (constant "Float")))
(function Float -> Some () | _ -> None)
(fun () -> Float);
case
~title:"Bytes"
(Tag 6)
(obj1 (req "kind" (constant "Bytes")))
(function Bytes -> Some () | _ -> None)
(fun () -> Bytes);
case
~title:"String"
(Tag 7)
(obj1 (req "kind" (constant "String")))
(function String -> Some () | _ -> None)
(fun () -> String);
case
~title:"Enum"
(Tag 8)
(obj3
(req "size" integer_encoding)
(req "reference" string)
(req "kind" (constant "Enum")))
(function
| Enum (size, cases) -> Some (size, cases, ()) | _ -> None)
(fun (size, cases, _) -> Enum (size, cases));
case
~title:"Seq"
(Tag 9)
(obj3
(req "layout" layout)
(req "kind" (constant "Seq"))
(opt "max_length" int31))
(function
| Seq (layout, len) -> Some (layout, (), len) | _ -> None)
(fun (layout, (), len) -> Seq (layout, len));
case
~title:"Ref"
(Tag 10)
(obj2 (req "name" string) (req "kind" (constant "Ref")))
(function Ref layout -> Some (layout, ()) | _ -> None)
(fun (name, ()) -> Ref name);
case
~title:"Padding"
(Tag 11)
(obj1 (req "kind" (constant "Padding")))
(function Padding -> Some () | _ -> None)
(fun () -> Padding) ])
let kind_enum_cases () =
[ case
~title:"Dynamic"
(Tag 0)
(obj1 (req "kind" (constant "Dynamic")))
(function `Dynamic -> Some () | _ -> None)
(fun () -> `Dynamic);
case
~title:"Variable"
(Tag 1)
(obj1 (req "kind" (constant "Variable")))
(function `Variable -> Some () | _ -> None)
(fun () -> `Variable) ]
let kind_t_encoding =
def "schema.kind"
@@ union
( case
~title:"Fixed"
(Tag 2)
(obj2 (req "size" int31) (req "kind" (constant "Float")))
(function `Fixed n -> Some (n, ()) | _ -> None)
(fun (n, _) -> `Fixed n)
:: kind_enum_cases () )
let unsigned_integer_encoding =
string_enum [("Uint30", `Uint30); ("Uint16", `Uint16); ("Uint8", `Uint8)]
let field_descr_encoding =
let dynamic_layout_encoding = dynamic_size layout_encoding in
def "schema.field"
@@ union
[ case
~title:"Named_field"
(Tag 0)
(obj4
(req "name" string)
(req "layout" dynamic_layout_encoding)
(req "data_kind" kind_t_encoding)
(req "kind" (constant "named")))
(function
| Named_field (name, kind, layout) ->
Some (name, layout, kind, ())
| _ ->
None)
(fun (name, kind, layout, _) -> Named_field (name, layout, kind));
case
~title:"Anonymous_field"
(Tag 1)
(obj3
(req "layout" dynamic_layout_encoding)
(req "kind" (constant "anon"))
(req "data_kind" kind_t_encoding))
(function
| Anonymous_field (kind, layout) ->
Some (layout, (), kind)
| _ ->
None)
(fun (kind, _, layout) -> Anonymous_field (layout, kind));
case
~title:"Dynamic_field"
(Tag 2)
(obj4
(req "kind" (constant "dyn"))
(opt "name" string)
(req "num_fields" int31)
(req "size" unsigned_integer_encoding))
(function
| Dynamic_size_field (name, i, size) ->
Some ((), name, i, size)
| _ ->
None)
(fun ((), name, i, size) -> Dynamic_size_field (name, i, size));
case
~title:"Optional_field"
(Tag 3)
(obj2
(req "kind" (constant "option_indicator"))
(req "name" string))
(function Optional_field s -> Some ((), s) | _ -> None)
(fun ((), s) -> Optional_field s) ]
let tag_size_encoding = string_enum [("Uint16", `Uint16); ("Uint8", `Uint8)]
let binary_description_encoding =
union
[ case
~title:"Obj"
(Tag 0)
(obj1 (req "fields" (list (dynamic_size field_descr_encoding))))
(function Obj {fields} -> Some fields | _ -> None)
(fun fields -> Obj {fields});
case
~title:"Cases"
(Tag 1)
(obj3
(req "tag_size" tag_size_encoding)
(req "kind" (dynamic_size kind_t_encoding))
(req
"cases"
(list
( def "union case"
@@ conv
(fun (tag, name, fields) -> (tag, fields, name))
(fun (tag, fields, name) -> (tag, name, fields))
@@ obj3
(req "tag" int31)
(req
"fields"
(list (dynamic_size field_descr_encoding)))
(opt "name" string) ))))
(function
| Cases {kind; tag_size; cases} ->
Some (tag_size, kind, cases)
| _ ->
None)
(fun (tag_size, kind, cases) -> Cases {kind; tag_size; cases});
case
~title:"Int_enum"
(Tag 2)
(obj2
(req "size" integer_encoding)
(req "cases" (list (tup2 int31 string))))
(function Int_enum {size; cases} -> Some (size, cases) | _ -> None)
(fun (size, cases) -> Int_enum {size; cases}) ]
let encoding =
conv
(fun {toplevel; fields} -> (toplevel, fields))
(fun (toplevel, fields) -> {toplevel; fields})
@@ obj2
(req "toplevel" binary_description_encoding)
(req
"fields"
(list
(obj2
(req "description" description_encoding)
(req "encoding" binary_description_encoding))))
end
let encoding = Encoding.encoding
let pp = Printer.pp
Computing file changes ...