Cap max string length to 512 characters

This is the limit for most Sentry attributes (the server will discard
everything past this), and this should help us stay under the 200 KB
event size limit.

See #20

src/capped_string.ml

@@ -0,0 +1,24 @@
+open Base
+open Sexplib.Conv
+
+type t = string [@@deriving sexp_of]
+
+let unwrap t =
+  Util.cap_string_length t
+
+let wrap t = t
+
+let%test_unit "round-trip" =
+  let expect = "adsfasdfsdsd131" in
+  expect
+  |> wrap
+  |> unwrap
+  |> [%test_result: string] ~expect
+
+let%test_unit "long string round trip" =
+  let input = String.init 1000 ~f:(Fn.const 'a') in
+  let expect = String.sub ~pos:0 ~len:512 input in
+  input
+  |> wrap
+  |> unwrap
+  |> [%test_result: string] ~expect

src/capped_string.mli

@@ -0,0 +1,8 @@
+(** The Sentry API discards anything after the first 512 characters of most
+    string attributes, so avoid sending them in the first place, so we can
+    also avoid sending events that are too big.
+    https://docs.sentry.io/accounts/quotas/#attributes-limits *)
+type t = string [@@deriving sexp_of]
+
+val wrap : string -> t
+val unwrap : t -> string

src/event.ml

@@ -116,3 +116,18 @@ let%expect_test "to_json_string everything" =
     |> print_endline
   end;
   [%expect {| {"event_id":"ad2579b4f62f486498781636c1450148","timestamp":"2014-12-23T22:44:21.230900","logger":"test","platform":"python","sdk":{"name":"test-sdk","version":"10.5"},"level":"error","culprit":"the tests","server_name":"example.com","release":"5","tags":{"a":"b","c":"d"},"environment":"dev","extra":{"a thing":"value"},"fingerprint":["039432409","asdf"],"exception":{"values":[{"type":"Failure","value":"test","stacktrace":{"frames":[{"filename":"src/event.ml","lineno":95,"colno":4}]}}]},"sentry.interfaces.Message":{"message":"Testy test test"},"breadcrumbs":[{"timestamp":"2014-12-23T22:44:21.230900","type":"default","message":"test crumb","level":"info"}]} |}]
+
+let%expect_test "to_json_string really long message" =
+  (* String_capped.t should ensure that the message is capped to 512 characters.
+     which will keep the length of the total string at 708 chars *)
+  let event_id = Uuid.wrap "bce345569e7548a384bac4512a9ad909" in
+  let timestamp = Time.of_string "2018-08-03T11:44:21.298019Z" in
+  let message = Message.make ~message:(String.init 1000 ~f:(Fn.const 'a')) () in
+  let output =
+    make ~event_id ~timestamp ~message ()
+    |> to_json_string
+  in
+  String.length output
+  |> [%test_result: int] ~expect:708;
+  print_endline output;
+  [%expect {| {"event_id":"bce345569e7548a384bac4512a9ad909","timestamp":"2018-08-03T11:44:21.298019","platform":"other","sdk":{"name":"sentry-ocaml","version":"0.1"},"sentry.interfaces.Message":{"message":"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"}} |}]

src/payloads.atd

@@ -1,81 +1,82 @@
 type json <ocaml module="Yojson.Basic"> = abstract
 
+type capped_string = string wrap <ocaml module="Capped_string">
 type datetime = string wrap <ocaml module="Datetime">
 type platform = string wrap <ocaml module="Platform">
 type severity_level = string wrap <ocaml module="Severity_level">
 type uuid = string wrap <ocaml module="Uuid">
 
 type sdk_info =
-  { name : string
-  ; version: string
-  ; ?integrations : string list nullable }
+  { name : capped_string
+  ; version: capped_string
+  ; ?integrations : capped_string list nullable }
 
 type mechanism =
-  { type_ <json name="type"> : string
-  ; ?description : string nullable
-  ; ?help_link : string nullable
+  { type_ <json name="type"> : capped_string
+  ; ?description : capped_string nullable
+  ; ?help_link : capped_string nullable
   ; ?handled : bool nullable
   (* TODO: meta *)
-  ; ?data : (string * string) list nullable <json repr="object"> }
+  ; ?data : (capped_string * capped_string) list nullable <json repr="object"> }
 
 type stackframe =
-  { ?filename : string nullable
-  ; ?function_ <json name="function"> : string nullable
-  ; ?module_ <json name="module"> : string nullable
+  { ?filename : capped_string nullable
+  ; ?function_ <json name="function"> : capped_string nullable
+  ; ?module_ <json name="module"> : capped_string nullable
   ; ?lineno : int nullable
   ; ?colno : int nullable
-  ; ?abs_path : string nullable
-  ; ?context_line : string nullable
-  ; ?pre_context : string list nullable
-  ; ?post_context : string list nullable
+  ; ?abs_path : capped_string nullable
+  ; ?context_line : capped_string nullable
+  ; ?pre_context : capped_string list nullable
+  ; ?post_context : capped_string list nullable
   ; ?in_app : bool nullable
-  ; ?vars : (string * string) list nullable <json repr="object">
-  ; ?package : string nullable
+  ; ?vars : (capped_string * capped_string) list nullable <json repr="object">
+  ; ?package : capped_string nullable
   ; ?platform : platform nullable
   (* TODO: image_addr, instruction_addr, symbol_addr, instruction_offset *) }
 
 type stacktrace =
   { frames : stackframe list }
 
 type exception_value =
-  { type_ <json name="type"> : string
-  ; ?value : string nullable
-  ; ?module_ <json name="module"> : string nullable
-  ; ?thread_id : string nullable
+  { type_ <json name="type"> : capped_string
+  ; ?value : capped_string nullable
+  ; ?module_ <json name="module"> : capped_string nullable
+  ; ?thread_id : capped_string nullable
   ; ?mechanism : mechanism nullable
   ; ?stacktrace : stacktrace nullable }
 
 type exception_ =
   { values : exception_value list }
 
 type message =
-  { message : string
-  ; ?params : string list nullable
-  ; ?formatted : string nullable }
+  { message : capped_string
+  ; ?params : capped_string list nullable
+  ; ?formatted : capped_string nullable }
 
 type breadcrumb =
   { timestamp : datetime
-  ; ?type_ <json name="type"> : string nullable
-  ; ?message : string nullable
-  ; ?data : (string *  json) list <json repr="object"> nullable
-  ; ?category : string nullable
-  ; ?level : string nullable }
+  ; ?type_ <json name="type"> : capped_string nullable
+  ; ?message : capped_string nullable
+  ; ?data : (capped_string *  json) list <json repr="object"> nullable
+  ; ?category : capped_string nullable
+  ; ?level : capped_string nullable }
 
 type event =
   { event_id : uuid
   ; timestamp : datetime
-  ; ?logger : string nullable
+  ; ?logger : capped_string nullable
   ; platform : platform
   ; sdk : sdk_info
   ; ?level : severity_level nullable
-  ; ?culprit : string nullable
-  ; ?server_name : string nullable
-  ; ?release : string nullable
-  ; ?tags : (string * string) list <json repr="object"> nullable
-  ; ?environment : string nullable
-  ; ?modules : (string * string) list <json repr="object"> nullable
-  ; ?extra : (string * json) list <json repr="object"> nullable
-  ; ?fingerprint : string list nullable
+  ; ?culprit : capped_string nullable
+  ; ?server_name : capped_string nullable
+  ; ?release : capped_string nullable
+  ; ?tags : (capped_string * capped_string) list <json repr="object"> nullable
+  ; ?environment : capped_string nullable
+  ; ?modules : (capped_string * capped_string) list <json repr="object"> nullable
+  ; ?extra : (capped_string * json) list <json repr="object"> nullable
+  ; ?fingerprint : capped_string list nullable
   ; ?exception_ <json name="exception"> : exception_ nullable
   ; ?message <json name="sentry.interfaces.Message"> : message nullable
   ; ?breadcrumbs : breadcrumb list nullable }

src/util.ml

@@ -1,6 +1,12 @@
 open Core_kernel
 open Async
 
+let cap_string_length ?(max_len=512) str =
+  if String.length str > max_len then
+    String.sub ~pos:0 ~len:max_len str
+  else
+    str
+
 let empty_list_option l =
   match l with
   | [] -> None

src/util.mli

@@ -1,5 +1,10 @@
 open Core_kernel
 
+(** [cap_string_length ?max_len str] creates a substring of [str] of length
+    [max_len] if [str] is longer than [max_len]. Otherwise returns [str]
+    unchanged. *)
+val cap_string_length : ?max_len:int -> string -> string
+
 (** [empty_list_option l] returns [None] if l is an empty list and returns
     [Some l] otherwise. This is useful for removing empty lists from our JSON
     payloads. *)