Micheline: add 255 character annotation length limit

src/bin_client/test/test_contracts.sh

@@ -438,6 +438,10 @@ bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 True)
 assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 False)'
 bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 False)'
 assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 True)'
+assert_fails $client typecheck data '3' against type \
+             '(int @aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)'
+$client typecheck data '3' against type \
+        '(int @aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)'
 
 init_with_transfer $contract_dir/big_map_get_add.tz $key1\
                    '(Pair { Elt 0 1 ; Elt 1 2 ; Elt 2 3 } Unit)' \

src/lib_micheline/micheline.ml

@@ -131,11 +131,12 @@ let canonical_encoding ~variant prim_encoding =
     case tag (list expr_encoding)
       (function Seq (_, v, _annot) -> Some v | _ -> None)
       (fun args -> Seq (0, args, None)) in
+  let byte_string = Bounded.string 255 in
   let application_encoding tag expr_encoding =
     case tag
       (obj3 (req "prim" prim_encoding)
          (req "args" (list expr_encoding))
-         (opt "annot" string))
+         (opt "annot" byte_string))
       (function Prim (_, prim, args, annot) -> Some (prim, args, annot)
               | _ -> None)
       (fun (prim, args, annot) -> Prim (0, prim, args, annot)) in
@@ -161,7 +162,7 @@ let canonical_encoding ~variant prim_encoding =
                      (* No args, with annot *)
                      case (Tag 4)
                        (obj2 (req "prim" prim_encoding)
-                          (req "annot" string))
+                          (req "annot" byte_string))
                        (function
                          | Prim (_, v, [], Some annot) -> Some (v, annot)
                          | _ -> None)
@@ -178,7 +179,7 @@ let canonical_encoding ~variant prim_encoding =
                      case (Tag 6)
                        (obj3 (req "prim" prim_encoding)
                           (req "arg" expr_encoding)
-                          (req "annot" string))
+                          (req "annot" byte_string))
                        (function
                          | Prim (_, prim, [ arg ], Some annot) -> Some (prim, arg, annot)
                          | _ -> None)
@@ -197,7 +198,7 @@ let canonical_encoding ~variant prim_encoding =
                        (obj4 (req "prim" prim_encoding)
                           (req "arg1" expr_encoding)
                           (req "arg2" expr_encoding)
-                          (req "annot" string))
+                          (req "annot" byte_string))
                        (function
                          | Prim (_, prim, [ arg1 ; arg2 ], Some annot) -> Some (prim, arg1, arg2, annot)
                          | _ -> None)

src/lib_micheline/micheline_parser.ml

@@ -95,6 +95,8 @@ type token =
   { token : token_value ;
     loc : location }
 
+let max_annot_length = 255
+
 type error += Invalid_utf8_sequence of point * string
 type error += Unexpected_character of point * string
 type error += Undefined_escape_sequence of point * string
@@ -102,6 +104,7 @@ type error += Missing_break_after_number of point
 type error += Unterminated_string of location
 type error += Unterminated_integer of location
 type error += Unterminated_comment of location
+type error += Annotation_length of location
 
 let tokenize source =
   let decoder = Uutf.decoder ~encoding:`UTF_8 (`String source) in
@@ -139,8 +142,13 @@ let tokenize source =
     | `End, _ -> List.rev acc
     | `Uchar c, start ->
         begin match uchar_to_char c with
-          | Some ('a'..'z' | 'A'..'Z') -> ident acc start (fun s -> Ident s)
+          | Some ('a'..'z' | 'A'..'Z') -> ident acc start (fun s _ -> Ident s)
-          | Some '@' -> ident acc start (fun s -> Annot s)
+          | Some '@' ->
+              ident acc start
+                (fun str stop ->
+                   if String.length str > max_annot_length
+                   then errors := (Annotation_length { start ; stop }) :: !errors ;
+                   Annot str)
           | Some '-' ->
               begin match next () with
                 | `End, stop ->
@@ -273,11 +281,11 @@ let tokenize source =
             let byte = Uutf.decoder_byte_count decoder in
             let s = String.sub source stop.byte (byte - stop.byte) in
             string acc (s :: sacc) start
-  and ident acc start ret =
+  and ident acc start (ret : string -> point -> token_value) =
     let tok stop =
       let name =
         String.sub source start.byte (stop.byte - start.byte) in
-      tok start stop (ret name) in
+      tok start stop (ret name stop) in
     match next () with
     | (`Uchar c, stop) as charloc ->
         begin match uchar_to_char c with
@@ -722,6 +730,18 @@ let () =
     Data_encoding.(obj1 (req "location" location_encoding))
     (function Unterminated_comment loc -> Some loc | _ -> None)
     (fun loc -> Unterminated_comment loc) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.annotation_exceeds_max_length"
+    ~title: "Micheline parser error: annotation exceeds max length"
+    ~description: (Format.sprintf
+                     "While parsing a piece of Micheline source, \
+                      an annotation exceeded the maximum length (%d)." max_annot_length)
+    ~pp:(fun ppf loc -> Format.fprintf ppf "%a, annotation exceeded maximum length (%d chars)"
+            print_location
+            loc max_annot_length)
+    Data_encoding.(obj1 (req "location" location_encoding))
+    (function Annotation_length loc -> Some loc | _ -> None)
+    (fun loc -> Annotation_length loc) ;
   register_error_kind `Permanent
     ~id: "micheline.parse_error.unclosed_token"
     ~title: "Micheline parser error: unclosed token"

src/lib_micheline/micheline_parser.mli

@@ -56,6 +56,8 @@ val min_point : node list -> point
 (** End of a sequence of consecutive primitives *)
 val max_point : node list -> point
 
+val max_annot_length : int
+
 val node_encoding : node Data_encoding.encoding
 
 type error += Invalid_utf8_sequence of point * string
@@ -70,6 +72,7 @@ type error += Unexpected of token
 type error += Extra of token
 type error += Misaligned of node
 type error += Empty
+type error += Annotation_length of location
 
 val parse_toplevel : ?check:bool -> token list -> node list parsing_result