commit 63797dd9a35ff77f0e01c77c03b4b0716fddb1a0 · anil.recoil.org/slop

+208

stack/zulip/lib/zulip/lib/jsonu.ml

···

       1
       1
       +
       (** JSON utility functions for Zulip API *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Error

     

       4
       4
       +
       

     

       5
       5
       +
       type json = Error.json

     

       6
       6
       +
       

     

       7
       7
       +
       (** {1 Field extraction utilities} *)

     

       8
       8
       +
       

     

       9
       9
       +
       let get_string fields key =

     

       10
       10
       +
         match List.assoc_opt key fields with

     

       11
       11
       +
         | Some (`String s) -> Ok s

     

       12
       12
       +
         | Some _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' is not a string" key) ())

     

       13
       13
       +
         | None -> Error (Error.create ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Field '%s' not found" key) ())

     

       14
       14
       +
       

     

       15
       15
       +
       let get_string_default fields key default =

     

       16
       16
       +
         match get_string fields key with

     

       17
       17
       +
         | Ok s -> s

     

       18
       18
       +
         | Error _ -> default

     

       19
       19
       +
       

     

       20
       20
       +
       let get_string_opt fields key =

     

       21
       21
       +
         match List.assoc_opt key fields with

     

       22
       22
       +
         | Some (`String s) -> Some s

     

       23
       23
       +
         | _ -> None

     

       24
       24
       +
       

     

       25
       25
       +
       let to_int_flex = function

     

       26
       26
       +
         | `Float f -> int_of_float f

     

       27
       27
       +
         | `String s -> (try int_of_string s with _ -> failwith "Invalid integer string")

     

       28
       28
       +
         | json -> failwith (Printf.sprintf "Expected int or float, got %s" (match json with

     

       29
       29
       +
           | `Null -> "null"

     

       30
       30
       +
           | `Bool _ -> "bool"

     

       31
       31
       +
           | `O _ -> "object"

     

       32
       32
       +
           | `A _ -> "array"

     

       33
       33
       +
           | _ -> "unknown"))

     

       34
       34
       +
       

     

       35
       35
       +
       let get_int fields key =

     

       36
       36
       +
         match List.assoc_opt key fields with

     

       37
       37
       +
         | Some json ->

     

       38
       38
       +
             (try Ok (to_int_flex json) with

     

       39
       39
       +
              | Failure msg -> Error (Error.create ~code:(Other "json_type_error") ~msg ()))

     

       40
       40
       +
         | None -> Error (Error.create ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Field '%s' not found" key) ())

     

       41
       41
       +
       

     

       42
       42
       +
       let get_int_default fields key default =

     

       43
       43
       +
         match get_int fields key with

     

       44
       44
       +
         | Ok i -> i

     

       45
       45
       +
         | Error _ -> default

     

       46
       46
       +
       

     

       47
       47
       +
       let get_int_opt fields key =

     

       48
       48
       +
         match List.assoc_opt key fields with

     

       49
       49
       +
         | Some json -> (try Some (to_int_flex json) with _ -> None)

     

       50
       50
       +
         | None -> None

     

       51
       51
       +
       

     

       52
       52
       +
       let get_float fields key =

     

       53
       53
       +
         match List.assoc_opt key fields with

     

       54
       54
       +
         | Some (`Float f) -> Ok f

     

       55
       55
       +
         | Some (`String s) ->

     

       56
       56
       +
             (try Ok (float_of_string s) with

     

       57
       57
       +
              | _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' is not a valid float" key) ()))

     

       58
       58
       +
         | Some _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' is not a float" key) ())

     

       59
       59
       +
         | None -> Error (Error.create ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Field '%s' not found" key) ())

     

       60
       60
       +
       

     

       61
       61
       +
       let get_float_default fields key default =

     

       62
       62
       +
         match get_float fields key with

     

       63
       63
       +
         | Ok f -> f

     

       64
       64
       +
         | Error _ -> default

     

       65
       65
       +
       

     

       66
       66
       +
       let get_bool fields key =

     

       67
       67
       +
         match List.assoc_opt key fields with

     

       68
       68
       +
         | Some (`Bool b) -> Ok b

     

       69
       69
       +
         | Some _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' is not a boolean" key) ())

     

       70
       70
       +
         | None -> Error (Error.create ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Field '%s' not found" key) ())

     

       71
       71
       +
       

     

       72
       72
       +
       let get_bool_default fields key default =

     

       73
       73
       +
         match get_bool fields key with

     

       74
       74
       +
         | Ok b -> b

     

       75
       75
       +
         | Error _ -> default

     

       76
       76
       +
       

     

       77
       77
       +
       let get_bool_opt fields key =

     

       78
       78
       +
         match List.assoc_opt key fields with

     

       79
       79
       +
         | Some (`Bool b) -> Some b

     

       80
       80
       +
         | _ -> None

     

       81
       81
       +
       

     

       82
       82
       +
       let get_object fields key =

     

       83
       83
       +
         match List.assoc_opt key fields with

     

       84
       84
       +
         | Some (`O obj) -> Ok obj

     

       85
       85
       +
         | Some _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' is not an object" key) ())

     

       86
       86
       +
         | None -> Error (Error.create ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Field '%s' not found" key) ())

     

       87
       87
       +
       

     

       88
       88
       +
       let get_object_opt fields key =

     

       89
       89
       +
         match List.assoc_opt key fields with

     

       90
       90
       +
         | Some (`O obj) -> Some obj

     

       91
       91
       +
         | _ -> None

     

       92
       92
       +
       

     

       93
       93
       +
       let get_array fields key =

     

       94
       94
       +
         match List.assoc_opt key fields with

     

       95
       95
       +
         | Some (`A arr) -> Ok arr

     

       96
       96
       +
         | Some _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' is not an array" key) ())

     

       97
       97
       +
         | None -> Error (Error.create ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Field '%s' not found" key) ())

     

       98
       98
       +
       

     

       99
       99
       +
       let get_array_opt fields key =

     

       100
       100
       +
         match List.assoc_opt key fields with

     

       101
       101
       +
         | Some (`A arr) -> Some arr

     

       102
       102
       +
         | _ -> None

     

       103
       103
       +
       

     

       104
       104
       +
       (** {1 Type conversion utilities} *)

     

       105
       105
       +
       

     

       106
       106
       +
       let to_int_safe = function

     

       107
       107
       +
         | `Float f -> Some (int_of_float f)

     

       108
       108
       +
         | `String s -> (try Some (int_of_string s) with _ -> None)

     

       109
       109
       +
         | _ -> None

     

       110
       110
       +
       

     

       111
       111
       +
       let to_string_safe = function

     

       112
       112
       +
         | `String s -> Some s

     

       113
       113
       +
         | _ -> None

     

       114
       114
       +
       

     

       115
       115
       +
       let to_bool_safe = function

     

       116
       116
       +
         | `Bool b -> Some b

     

       117
       117
       +
         | _ -> None

     

       118
       118
       +
       

     

       119
       119
       +
       let to_float_safe = function

     

       120
       120
       +
         | `Float f -> Some f

     

       121
       121
       +
         | `String s -> (try Some (float_of_string s) with _ -> None)

     

       122
       122
       +
         | _ -> None

     

       123
       123
       +
       

     

       124
       124
       +
       (** {1 Object parsing utilities} *)

     

       125
       125
       +
       

     

       126
       126
       +
       let with_object context f = function

     

       127
       127
       +
         | `O fields -> f fields

     

       128
       128
       +
         | _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "%s: expected JSON object" context) ())

     

       129
       129
       +
       

     

       130
       130
       +
       let with_array context f json =

     

       131
       131
       +
         match json with

     

       132
       132
       +
         | `A items ->

     

       133
       133
       +
             let rec process acc = function

     

       134
       134
       +
               | [] -> Ok (List.rev acc)

     

       135
       135
       +
               | item :: rest ->

     

       136
       136
       +
                   match f item with

     

       137
       137
       +
                   | Ok v -> process (v :: acc) rest

     

       138
       138
       +
                   | Error e -> Error e

     

       139
       139
       +
             in

     

       140
       140
       +
             process [] items

     

       141
       141
       +
         | _ -> Error (Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "%s: expected JSON array" context) ())

     

       142
       142
       +
       

     

       143
       143
       +
       (** {1 Construction utilities} *)

     

       144
       144
       +
       

     

       145
       145
       +
       let optional_field key encoder = function

     

       146
       146
       +
         | Some value -> Some (key, encoder value)

     

       147
       147
       +
         | None -> None

     

       148
       148
       +
       

     

       149
       149
       +
       let optional_fields fields =

     

       150
       150
       +
         List.filter_map (fun x -> x) fields

     

       151
       151
       +
       

     

       152
       152
       +
       let string_array strings =

     

       153
       153
       +
         `A (List.map (fun s -> `String s) strings)

     

       154
       154
       +
       

     

       155
       155
       +
       let int_array ints =

     

       156
       156
       +
         `A (List.map (fun i -> `Float (float_of_int i)) ints)

     

       157
       157
       +
       

     

       158
       158
       +
       (** {1 Error handling} *)

     

       159
       159
       +
       

     

       160
       160
       +
       let json_error msg =

     

       161
       161
       +
         Error.create ~code:(Other "json_error") ~msg ()

     

       162
       162
       +
       

     

       163
       163
       +
       let field_missing_error field =

     

       164
       164
       +
         Error.create ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Required field '%s' not found" field) ()

     

       165
       165
       +
       

     

       166
       166
       +
       let type_mismatch_error field expected =

     

       167
       167
       +
         Error.create ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' type mismatch: expected %s" field expected) ()

     

       168
       168
       +
       

     

       169
       169
       +
       let parse_with_error context f =

     

       170
       170
       +
         try f ()

     

       171
       171
       +
         with

     

       172
       172
       +
         | Failure msg -> Error (Error.create ~code:(Other "json_parse_error") ~msg:(Printf.sprintf "%s: %s" context msg) ())

     

       173
       173
       +
         | exn -> Error (Error.create ~code:(Other "json_parse_error") ~msg:(Printf.sprintf "%s: %s" context (Printexc.to_string exn)) ())

     

       174
       174
       +
       

     

       175
       175
       +
       

     

       176
       176
       +
       (** {1 Debugging utilities} *)

     

       177
       177
       +
       

     

       178
       178
       +
       let to_string_pretty json =

     

       179
       179
       +
         let rec aux indent = function

     

       180
       180
       +
           | `Null -> "null"

     

       181
       181
       +
           | `Bool b -> string_of_bool b

     

       182
       182
       +
           | `Float f ->

     

       183
       183
       +
               if float_of_int (int_of_float f) = f then

     

       184
       184
       +
                 string_of_int (int_of_float f)

     

       185
       185
       +
               else

     

       186
       186
       +
                 string_of_float f

     

       187
       187
       +
           | `String s -> Printf.sprintf "%S" s

     

       188
       188
       +
           | `A [] -> "[]"

     

       189
       189
       +
           | `A lst ->

     

       190
       190
       +
               let items = List.map (aux (indent ^ "  ")) lst in

     

       191
       191
       +
               Printf.sprintf "[\n%s%s\n%s]"

     

       192
       192
       +
                 (indent ^ "  ")

     

       193
       193
       +
                 (String.concat (",\n" ^ indent ^ "  ") items)

     

       194
       194
       +
                 indent

     

       195
       195
       +
           | `O [] -> "{}"

     

       196
       196
       +
           | `O fields ->

     

       197
       197
       +
               let items = List.map (fun (k, v) ->

     

       198
       198
       +
                 Printf.sprintf "%S: %s" k (aux (indent ^ "  ") v)

     

       199
       199
       +
               ) fields in

     

       200
       200
       +
               Printf.sprintf "{\n%s%s\n%s}"

     

       201
       201
       +
                 (indent ^ "  ")

     

       202
       202
       +
                 (String.concat (",\n" ^ indent ^ "  ") items)

     

       203
       203
       +
                 indent

     

       204
       204
       +
         in

     

       205
       205
       +
         aux "" json

     

       206
       206
       +
       

     

       207
       207
       +
       let pp fmt json =

     

       208
       208
       +
         Format.pp_print_string fmt (to_string_pretty json)

+117

stack/zulip/lib/zulip/lib/jsonu.mli

···

       1
       1
       +
       (** JSON utility functions for Zulip API

     

       2
       2
       +
       

     

       3
       3
       +
           This module provides common utilities for working with JSON in the Zulip API,

     

       4
       4
       +
           reducing boilerplate and providing consistent error handling. *)

     

       5
       5
       +
       

     

       6
       6
       +
       (** {1 Type definitions} *)

     

       7
       7
       +
       

     

       8
       8
       +
       type json = Error.json

     

       9
       9
       +
       

     

       10
       10
       +
       (** {1 Field extraction utilities} *)

     

       11
       11
       +
       

     

       12
       12
       +
       (** Extract a string field from a JSON object *)

     

       13
       13
       +
       val get_string : (string * json) list -> string -> (string, Error.t) result

     

       14
       14
       +
       

     

       15
       15
       +
       (** Extract a string field with a default value *)

     

       16
       16
       +
       val get_string_default : (string * json) list -> string -> string -> string

     

       17
       17
       +
       

     

       18
       18
       +
       (** Extract an optional string field *)

     

       19
       19
       +
       val get_string_opt : (string * json) list -> string -> string option

     

       20
       20
       +
       

     

       21
       21
       +
       (** Extract an integer field (handles both int and float representations) *)

     

       22
       22
       +
       val get_int : (string * json) list -> string -> (int, Error.t) result

     

       23
       23
       +
       

     

       24
       24
       +
       (** Extract an integer field with a default value *)

     

       25
       25
       +
       val get_int_default : (string * json) list -> string -> int -> int

     

       26
       26
       +
       

     

       27
       27
       +
       (** Extract an optional integer field *)

     

       28
       28
       +
       val get_int_opt : (string * json) list -> string -> int option

     

       29
       29
       +
       

     

       30
       30
       +
       (** Extract a float field *)

     

       31
       31
       +
       val get_float : (string * json) list -> string -> (float, Error.t) result

     

       32
       32
       +
       

     

       33
       33
       +
       (** Extract a float field with a default value *)

     

       34
       34
       +
       val get_float_default : (string * json) list -> string -> float -> float

     

       35
       35
       +
       

     

       36
       36
       +
       (** Extract a boolean field *)

     

       37
       37
       +
       val get_bool : (string * json) list -> string -> (bool, Error.t) result

     

       38
       38
       +
       

     

       39
       39
       +
       (** Extract a boolean field with a default value *)

     

       40
       40
       +
       val get_bool_default : (string * json) list -> string -> bool -> bool

     

       41
       41
       +
       

     

       42
       42
       +
       (** Extract an optional boolean field *)

     

       43
       43
       +
       val get_bool_opt : (string * json) list -> string -> bool option

     

       44
       44
       +
       

     

       45
       45
       +
       (** Extract a JSON object field *)

     

       46
       46
       +
       val get_object : (string * json) list -> string -> ((string * json) list, Error.t) result

     

       47
       47
       +
       

     

       48
       48
       +
       (** Extract an optional JSON object field *)

     

       49
       49
       +
       val get_object_opt : (string * json) list -> string -> (string * json) list option

     

       50
       50
       +
       

     

       51
       51
       +
       (** Extract a JSON array field *)

     

       52
       52
       +
       val get_array : (string * json) list -> string -> (json list, Error.t) result

     

       53
       53
       +
       

     

       54
       54
       +
       (** Extract an optional JSON array field *)

     

       55
       55
       +
       val get_array_opt : (string * json) list -> string -> json list option

     

       56
       56
       +
       

     

       57
       57
       +
       (** {1 Type conversion utilities} *)

     

       58
       58
       +
       

     

       59
       59
       +
       (** Convert JSON to int, handling both int and float representations *)

     

       60
       60
       +
       val to_int_flex : json -> int

     

       61
       61
       +
       

     

       62
       62
       +
       (** Safely convert JSON to int *)

     

       63
       63
       +
       val to_int_safe : json -> int option

     

       64
       64
       +
       

     

       65
       65
       +
       (** Convert JSON to string *)

     

       66
       66
       +
       val to_string_safe : json -> string option

     

       67
       67
       +
       

     

       68
       68
       +
       (** Convert JSON to bool *)

     

       69
       69
       +
       val to_bool_safe : json -> bool option

     

       70
       70
       +
       

     

       71
       71
       +
       (** Convert JSON to float *)

     

       72
       72
       +
       val to_float_safe : json -> float option

     

       73
       73
       +
       

     

       74
       74
       +
       (** {1 Object parsing utilities} *)

     

       75
       75
       +
       

     

       76
       76
       +
       (** Parse a JSON value as an object, applying a function to its fields *)

     

       77
       77
       +
       val with_object : string -> ((string * json) list -> ('a, Error.t) result) -> json -> ('a, Error.t) result

     

       78
       78
       +
       

     

       79
       79
       +
       (** Parse a JSON value as an array, applying a function to each element *)

     

       80
       80
       +
       val with_array : string -> (json -> ('a, Error.t) result) -> json -> ('a list, Error.t) result

     

       81
       81
       +
       

     

       82
       82
       +
       (** {1 Construction utilities} *)

     

       83
       83
       +
       

     

       84
       84
       +
       (** Create an optional field for JSON object construction *)

     

       85
       85
       +
       val optional_field : string -> ('a -> json) -> 'a option -> (string * json) option

     

       86
       86
       +
       

     

       87
       87
       +
       (** Create a list of optional fields, filtering out None values *)

     

       88
       88
       +
       val optional_fields : (string * json) option list -> (string * json) list

     

       89
       89
       +
       

     

       90
       90
       +
       (** Convert a string list to a JSON array *)

     

       91
       91
       +
       val string_array : string list -> json

     

       92
       92
       +
       

     

       93
       93
       +
       (** Convert an int list to a JSON array *)

     

       94
       94
       +
       val int_array : int list -> json

     

       95
       95
       +
       

     

       96
       96
       +
       (** {1 Error handling} *)

     

       97
       97
       +
       

     

       98
       98
       +
       (** Create a JSON parsing error *)

     

       99
       99
       +
       val json_error : string -> Error.t

     

       100
       100
       +
       

     

       101
       101
       +
       (** Create a field missing error *)

     

       102
       102
       +
       val field_missing_error : string -> Error.t

     

       103
       103
       +
       

     

       104
       104
       +
       (** Create a type mismatch error *)

     

       105
       105
       +
       val type_mismatch_error : string -> string -> Error.t

     

       106
       106
       +
       

     

       107
       107
       +
       (** Wrap a parsing function with exception handling *)

     

       108
       108
       +
       val parse_with_error : string -> (unit -> ('a, Error.t) result) -> ('a, Error.t) result

     

       109
       109
       +
       

     

       110
       110
       +
       

     

       111
       111
       +
       (** {1 Debugging utilities} *)

     

       112
       112
       +
       

     

       113
       113
       +
       (** Convert JSON to a pretty-printed string *)

     

       114
       114
       +
       val to_string_pretty : json -> string

     

       115
       115
       +
       

     

       116
       116
       +
       (** Print JSON value for debugging *)

     

       117
       117
       +
       val pp : Format.formatter -> json -> unit

+6 -21

stack/zulip/lib/zulip/lib/message_response.ml

···

       7
       7
        
       let automatic_new_visibility_policy t = t.automatic_new_visibility_policy

     

       8
       8
        
       

     

       9
       9
        
       let of_json json =

     

       10
       10
       -
         match json with

     

       11
       11
       -
         | `O fields ->

     

       12
       12
       -
             (try

     

       13
       13
       -
               let id = match List.assoc "id" fields with

     

       14
       14
       -
                 | `Float f -> int_of_float f

     

       15
       15
       -
                 | `String s -> int_of_string s

     

       16
       16
       -
                 | _ -> failwith "id not found or not a number" in

     

       17
       17
       -
               let automatic_new_visibility_policy = 

     

       18
       18
       -
                 try Some (match List.assoc "automatic_new_visibility_policy" fields with

     

       19
       19
       -
                   | `String s -> s

     

       20
       20
       -
                   | _ -> failwith "invalid visibility policy")

     

       21
       21
       -
                 with Not_found -> None in

     

       10
       10
       +
         Jsonu.with_object "message_response" (fun fields ->

     

       11
       11
       +
           match Jsonu.get_int fields "id" with

     

       12
       12
       +
           | Error e -> Error e

     

       13
       13
       +
           | Ok id ->

     

       14
       14
       +
               let automatic_new_visibility_policy = Jsonu.get_string_opt fields "automatic_new_visibility_policy" in

     

       22
       15
        
               Ok { id; automatic_new_visibility_policy }

     

       23
       23
       -
             with

     

       24
       24
       -
             | Failure msg ->

     

       25
       25
       -
                 Error (Error.create ~code:(Other "parse_error") ~msg:("Failed to parse message response: " ^ msg) ())

     

       26
       26
       -
             | Not_found ->

     

       27
       27
       -
                 Error (Error.create ~code:(Other "parse_error") ~msg:"Failed to parse message response: missing field" ())

     

       28
       28
       -
             | _ ->

     

       29
       29
       -
                 Error (Error.create ~code:(Other "parse_error") ~msg:"Failed to parse message response" ()))

     

       30
       30
       -
         | _ ->

     

       31
       31
       -
             Error (Error.create ~code:(Other "parse_error") ~msg:"Expected JSON object for message response" ())

     

       16
       16
       +
         ) json

     

       32
       17
        
       

     

       33
       18
        
       let pp fmt t = Format.fprintf fmt "MessageResponse{id=%d}" t.id

+9 -25

stack/zulip/lib/zulip/lib/user.ml

···

       24
       24
        
           ("is_bot", `Bool t.is_bot);

     

       25
       25
        
         ]

     

       26
       26
        
       

     

       27
       27
       -
       let of_json json = 

     

       28
       28
       -
         try

     

       29
       29
       -
           match json with

     

       30
       30
       -
           | `O fields ->

     

       31
       31
       -
               let get_string key = 

     

       32
       32
       -
                 match List.assoc key fields with 

     

       33
       33
       -
                 | `String s -> s 

     

       34
       34
       -
                 | _ -> failwith ("Expected string for " ^ key) in

     

       35
       35
       -
               let get_bool key default = 

     

       36
       36
       -
                 match List.assoc_opt key fields with 

     

       37
       37
       -
                 | Some (`Bool b) -> b 

     

       38
       38
       -
                 | None -> default

     

       39
       39
       -
                 | _ -> failwith ("Expected bool for " ^ key) in

     

       40
       40
       -
               

     

       41
       41
       -
               let email = get_string "email" in

     

       42
       42
       -
               let full_name = get_string "full_name" in

     

       43
       43
       -
               let is_active = get_bool "is_active" true in

     

       44
       44
       -
               let is_admin = get_bool "is_admin" false in

     

       45
       45
       -
               let is_bot = get_bool "is_bot" false in

     

       46
       46
       -
               

     

       27
       27
       +
       let of_json json =

     

       28
       28
       +
         Jsonu.with_object "user" (fun fields ->

     

       29
       29
       +
           match Jsonu.get_string fields "email", Jsonu.get_string fields "full_name" with

     

       30
       30
       +
           | Ok email, Ok full_name ->

     

       31
       31
       +
               let is_active = Jsonu.get_bool_default fields "is_active" true in

     

       32
       32
       +
               let is_admin = Jsonu.get_bool_default fields "is_admin" false in

     

       33
       33
       +
               let is_bot = Jsonu.get_bool_default fields "is_bot" false in

     

       47
       34
        
               Ok { email; full_name; is_active; is_admin; is_bot }

     

       48
       48
       -
           | _ -> 

     

       49
       49
       -
               Error (Error.create ~code:(Other "json_parse_error") ~msg:"User JSON must be an object" ())

     

       50
       50
       -
         with

     

       51
       51
       -
         | exn ->

     

       52
       52
       -
             Error (Error.create ~code:(Other "json_parse_error") ~msg:("User JSON parsing failed: " ^ Printexc.to_string exn) ())

     

       35
       35
       +
           | Error e, _ | _, Error e -> Error e

     

       36
       36
       +
         ) json

     

       53
       37
        
       

     

       54
       38
        
       let pp fmt t = Format.fprintf fmt "User{email=%s, full_name=%s}" t.email t.full_name

+3 -11

stack/zulip/lib/zulip_bot/lib/bot_runner.ml

···

       11
       11
        
           (* Generator not initialized - this will be done by applications using the library *)

     

       12
       12
        
           ()

     

       13
       13
        
       

     

       14
       14
       -
       (* Convert Zulip.Error.json to Yojson.Safe.t *)

     

       15
       15
       -
       let rec convert_json : Zulip.Error.json -> Yojson.Safe.t = function

     

       16
       16
       -
         | `Null -> `Null

     

       17
       17
       -
         | `Bool b -> `Bool b

     

       18
       18
       -
         | `Float f -> `Float f

     

       19
       19
       -
         | `String s -> `String s

     

       20
       20
       -
         | `A lst -> `List (List.map convert_json lst)

     

       21
       21
       -
         | `O pairs -> `Assoc (List.map (fun (k, v) -> (k, convert_json v)) pairs)

     

       22
       14
        
       

     

       23
       15
        
       type 'env t = {

     

       24
       16
        
         client : Zulip.Client.t;

     
···

       67
       59
        
             in

     

       68
       60
        
       

     

       69
       61
        
             (* Parse the message JSON into Message.t *)

     

       70
       70
       -
             (match Message.of_json (convert_json message_json) with

     

       62
       62
       +
             (match Message.of_json message_json with

     

       71
       63
        
              | Error err ->

     

       72
       64
        
                  Log.err (fun m -> m "Failed to parse message JSON: %s" err);

     

       73
       65
        
                  (* Show raw JSON for debugging *)

     

       74
       74
       -
                  Log.debug (fun m -> m "@[%a@]" Message.pp_json_debug (convert_json message_json));

     

       66
       66
       +
                  Log.debug (fun m -> m "@[%a@]" Message.pp_json_debug message_json);

     

       75
       67
        
              | Ok message ->

     

       76
       68
        
                  (* Log the parsed message with colors *)

     

       77
       69
        
                  Log.info (fun m -> m "@[<h>%a@]" (Message.pp_ansi ~show_json:false) message);

     
···

       225
       217
        
       let handle_webhook t ~webhook_data =

     

       226
       218
        
         (* Process webhook data and route to handler *)

     

       227
       219
        
         (* Parse the webhook data into Message.t first *)

     

       228
       228
       -
         match Message.of_json (convert_json webhook_data) with

     

       220
       220
       +
         match Message.of_json webhook_data with

     

       229
       221
        
         | Error err -> Error (Zulip.Error.create ~code:(Zulip.Error.Other "parse_error") ~msg:("Failed to parse webhook message: " ^ err) ())

     

       230
       222
        
         | Ok message ->

     

       231
       223
        
             match Bot_handler.handle_message_with_env t.handler t.env message with

+22 -28

stack/zulip/lib/zulip_bot/lib/bot_storage.ml

···

       19
       19
        
                 ~path:"/api/v1/bot_storage"

     

       20
       20
        
                 () with

     

       21
       21
        
         | Ok json ->

     

       22
       22
       -
             (match json with

     

       23
       23
       -
              | `O fields ->

     

       24
       24
       -
                  (match List.assoc_opt "storage" fields with

     

       25
       25
       -
                   | Some (`O storage_fields) ->

     

       26
       26
       -
                       List.iter (fun (k, v) ->

     

       27
       27
       -
                         match v with

     

       28
       28
       -
                         | `String value ->

     

       29
       29
       -
                             Log.debug (fun m -> m "Loaded key from server: %s" k);

     

       30
       30
       -
                             Hashtbl.add cache k value

     

       31
       31
       -
                         | _ -> ()

     

       32
       32
       -
                       ) storage_fields

     

       33
       33
       -
                   | _ -> ())

     

       34
       34
       -
              | _ -> ())

     

       22
       22
       +
             (match Zulip.Jsonu.get_object_opt (match json with `O f -> f | _ -> []) "storage" with

     

       23
       23
       +
              | Some storage_fields ->

     

       24
       24
       +
                  List.iter (fun (k, v) ->

     

       25
       25
       +
                    match Zulip.Jsonu.to_string_safe v with

     

       26
       26
       +
                    | Some value ->

     

       27
       27
       +
                        Log.debug (fun m -> m "Loaded key from server: %s" k);

     

       28
       28
       +
                        Hashtbl.add cache k value

     

       29
       29
       +
                    | None -> ()

     

       30
       30
       +
                  ) storage_fields

     

       31
       31
       +
              | None -> ())

     

       35
       32
        
         | Error e ->

     

       36
       33
        
             Log.warn (fun m -> m "Failed to load existing storage: %s" (Zulip.Error.message e)));

     

       37
       34
        
       

     
···

       96
       93
        
                     ~path:"/api/v1/bot_storage"

     

       97
       94
        
                     ~params () with

     

       98
       95
        
             | Ok json ->

     

       99
       99
       -
                 (match json with

     

       100
       100
       -
                  | `O fields ->

     

       101
       101
       -
                      (match List.assoc_opt "storage" fields with

     

       102
       102
       -
                       | Some (`O storage_fields) ->

     

       103
       103
       -
                           (match List.assoc_opt key storage_fields with

     

       104
       104
       -
                            | Some (`String value) ->

     

       105
       105
       -
                                (* Cache the value *)

     

       106
       106
       -
                                Log.debug (fun m -> m "Retrieved key from API: %s" key);

     

       107
       107
       -
                                Hashtbl.add t.cache key value;

     

       108
       108
       -
                                Some value

     

       109
       109
       -
                            | _ ->

     

       110
       110
       -
                                Log.debug (fun m -> m "Key not found in API: %s" key);

     

       111
       111
       -
                                None)

     

       112
       112
       -
                       | _ -> None)

     

       113
       113
       -
                  | _ -> None)

     

       96
       96
       +
                 (match Zulip.Jsonu.get_object_opt (match json with `O f -> f | _ -> []) "storage" with

     

       97
       97
       +
                  | Some storage_fields ->

     

       98
       98
       +
                      (match Zulip.Jsonu.get_string_opt storage_fields key with

     

       99
       99
       +
                       | Some value ->

     

       100
       100
       +
                           (* Cache the value *)

     

       101
       101
       +
                           Log.debug (fun m -> m "Retrieved key from API: %s" key);

     

       102
       102
       +
                           Hashtbl.add t.cache key value;

     

       103
       103
       +
                           Some value

     

       104
       104
       +
                       | None ->

     

       105
       105
       +
                           Log.debug (fun m -> m "Key not found in API: %s" key);

     

       106
       106
       +
                           None)

     

       107
       107
       +
                  | None -> None)

     

       114
       108
        
             | Error e ->

     

       115
       109
        
                 Log.warn (fun m -> m "Error fetching key %s: %s" key (Zulip.Error.message e));

     

       116
       110
        
                 None

+116 -119

stack/zulip/lib/zulip_bot/lib/message.ml

···

       1
       1
       -
       open Yojson.Safe.Util

     

       1
       1
       +
       (* Use Jsonm exclusively via Zulip.Jsonu utilities *)

     

       2
       2
        
       

     

       3
       3
        
       let logs_src = Logs.Src.create "zulip_bot.message"

     

       4
       4
        
       module Log = (val Logs.src_log logs_src : Logs.LOG)

     

       5
       5
        
       

     

       6
       6
       -
       (** Helper to convert JSON number to int, handling float representation *)

     

       7
       7
       -
       let to_int_flex json =

     

       8
       8
       -
         match json with

     

       9
       9
       -
         | `Int i -> i

     

       10
       10
       -
         | `Float f -> int_of_float f

     

       11
       11
       -
         | _ -> raise (Type_error ("Expected int or float", json))

     

       12
       12
       -
       

     

       13
       6
        
       (** User representation *)

     

       14
       7
        
       module User = struct

     

       15
       8
        
         type t = {

     
···

       25
       18
        
         let short_name t = t.short_name

     

       26
       19
        
       

     

       27
       20
        
         let of_json json =

     

       28
       28
       -
           try

     

       21
       21
       +
           Zulip.Jsonu.with_object "user" (fun fields ->

     

       29
       22
        
             (* Handle both "user_id" and "id" field names *)

     

       30
       30
       -
             let user_id =

     

       31
       31
       -
               try json |> member "user_id" |> to_int_flex

     

       32
       32
       -
               with _ -> json |> member "id" |> to_int_flex

     

       33
       33
       -
             in

     

       34
       34
       -
             let email = json |> member "email" |> to_string in

     

       35
       35
       -
             let full_name = json |> member "full_name" |> to_string in

     

       36
       36
       -
             let short_name =

     

       37
       37
       -
               try json |> member "short_name" |> to_string_option

     

       38
       38
       -
               with _ -> None

     

       23
       23
       +
             let user_id_result =

     

       24
       24
       +
               match Zulip.Jsonu.get_int fields "user_id" with

     

       25
       25
       +
               | Ok id -> Ok id

     

       26
       26
       +
               | Error _ -> Zulip.Jsonu.get_int fields "id"

     

       39
       27
        
             in

     

       40
       40
       -
             Ok { user_id; email; full_name; short_name }

     

       41
       41
       -
           with

     

       42
       42
       -
           | Type_error (msg, _) -> Error ("User JSON parse error: " ^ msg)

     

       43
       43
       -
           | exn -> Error ("User JSON parse error: " ^ Printexc.to_string exn)

     

       28
       28
       +
             match user_id_result, Zulip.Jsonu.get_string fields "email", Zulip.Jsonu.get_string fields "full_name" with

     

       29
       29
       +
             | Ok user_id, Ok email, Ok full_name ->

     

       30
       30
       +
                 let short_name = Zulip.Jsonu.get_string_opt fields "short_name" in

     

       31
       31
       +
                 Ok { user_id; email; full_name; short_name }

     

       32
       32
       +
             | Error e, _, _ | _, Error e, _ | _, _, Error e -> Error e

     

       33
       33
       +
           ) json

     

       44
       34
        
       end

     

       45
       35
        
       

     

       46
       36
        
       (** Reaction representation *)

     
···

       58
       48
        
         let user_id t = t.user_id

     

       59
       49
        
       

     

       60
       50
        
         let of_json json =

     

       61
       61
       -
           try

     

       62
       62
       -
             let emoji_name = json |> member "emoji_name" |> to_string in

     

       63
       63
       -
             let emoji_code = json |> member "emoji_code" |> to_string in

     

       64
       64
       -
             let reaction_type = json |> member "reaction_type" |> to_string in

     

       65
       65
       -
             let user_id = json |> member "user" |> member "user_id" |> to_int_flex in

     

       66
       66
       -
             Ok { emoji_name; emoji_code; reaction_type; user_id }

     

       67
       67
       -
           with

     

       68
       68
       -
           | Type_error (msg, _) -> Error ("Reaction JSON parse error: " ^ msg)

     

       69
       69
       -
           | exn -> Error ("Reaction JSON parse error: " ^ Printexc.to_string exn)

     

       51
       51
       +
           Zulip.Jsonu.with_object "reaction" (fun fields ->

     

       52
       52
       +
             match Zulip.Jsonu.get_string fields "emoji_name",

     

       53
       53
       +
                   Zulip.Jsonu.get_string fields "emoji_code",

     

       54
       54
       +
                   Zulip.Jsonu.get_string fields "reaction_type" with

     

       55
       55
       +
             | Ok emoji_name, Ok emoji_code, Ok reaction_type ->

     

       56
       56
       +
                 (* Try both "user_id" and "user" -> "user_id" patterns *)

     

       57
       57
       +
                 let user_id_result =

     

       58
       58
       +
                   match Zulip.Jsonu.get_int fields "user_id" with

     

       59
       59
       +
                   | Ok id -> Ok id

     

       60
       60
       +
                   | Error _ ->

     

       61
       61
       +
                       match Zulip.Jsonu.get_object fields "user" with

     

       62
       62
       +
                       | Ok user_obj -> Zulip.Jsonu.get_int user_obj "user_id"

     

       63
       63
       +
                       | Error e -> Error e

     

       64
       64
       +
                 in

     

       65
       65
       +
                 (match user_id_result with

     

       66
       66
       +
                  | Ok user_id -> Ok { emoji_name; emoji_code; reaction_type; user_id }

     

       67
       67
       +
                  | Error e -> Error e)

     

       68
       68
       +
             | Error e, _, _ | _, Error e, _ | _, _, Error e -> Error e

     

       69
       69
       +
           ) json

     

       70
       70
        
       end

     

       71
       71
        
       

     

       72
       72
        
       (** Common message fields *)

     
···

       80
       80
        
         content: string;

     

       81
       81
        
         content_type: string;

     

       82
       82
        
         reactions: Reaction.t list;

     

       83
       83
       -
         submessages: Yojson.Safe.t list;

     

       83
       83
       +
         submessages: Zulip.Error.json list;

     

       84
       84
        
         flags: string list;

     

       85
       85
        
         is_me_message: bool;

     

       86
       86
        
         client: string;

     
···

       102
       102
        
           }

     

       103
       103
        
         | Unknown of {

     

       104
       104
        
             common: common;

     

       105
       105
       -
             raw_json: Yojson.Safe.t;

     

       105
       105
       +
             raw_json: Zulip.Error.json;

     

       106
       106
        
           }

     

       107
       107
        
       

     

       108
       108
        
       (** Helper function to parse common fields *)

     

       109
       109
        
       let parse_common json =

     

       110
       110
       -
         try

     

       111
       111
       -
           let id = json |> member "id" |> to_int_flex in

     

       112
       112
       -
           let sender_id = json |> member "sender_id" |> to_int_flex in

     

       113
       113
       -
           let sender_email = json |> member "sender_email" |> to_string in

     

       114
       114
       -
           let sender_full_name = json |> member "sender_full_name" |> to_string in

     

       115
       115
       -
           let sender_short_name = json |> member "sender_short_name" |> to_string_option in

     

       116
       116
       -
           let timestamp = json |> member "timestamp" |> to_float in

     

       117
       117
       -
           let content = json |> member "content" |> to_string in

     

       118
       118
       -
           let content_type = json |> member "content_type" |> to_string_option |> Option.value ~default:"text/html" in

     

       110
       110
       +
         Zulip.Jsonu.parse_with_error "common fields" (fun () ->

     

       111
       111
       +
           Zulip.Jsonu.with_object "message" (fun fields ->

     

       112
       112
       +
             match Zulip.Jsonu.get_int fields "id",

     

       113
       113
       +
                   Zulip.Jsonu.get_int fields "sender_id",

     

       114
       114
       +
                   Zulip.Jsonu.get_string fields "sender_email",

     

       115
       115
       +
                   Zulip.Jsonu.get_string fields "sender_full_name" with

     

       116
       116
       +
             | Ok id, Ok sender_id, Ok sender_email, Ok sender_full_name ->

     

       117
       117
       +
                 let sender_short_name = Zulip.Jsonu.get_string_opt fields "sender_short_name" in

     

       118
       118
       +
                 let timestamp = Zulip.Jsonu.get_float_default fields "timestamp" 0.0 in

     

       119
       119
       +
                 let content = Zulip.Jsonu.get_string_default fields "content" "" in

     

       120
       120
       +
                 let content_type = Zulip.Jsonu.get_string_default fields "content_type" "text/html" in

     

       119
       121
        
       

     

       120
       120
       -
           let reactions =

     

       121
       121
       -
             try

     

       122
       122
       -
               json |> member "reactions" |> to_list |> List.map (fun r ->

     

       123
       123
       -
                 match Reaction.of_json r with

     

       124
       124
       -
                 | Ok reaction -> reaction

     

       125
       125
       -
                 | Error err ->

     

       126
       126
       -
                   Log.warn (fun m -> m "Failed to parse reaction: %s" err);

     

       127
       127
       -
                   failwith "reaction parse error"

     

       128
       128
       -
               )

     

       129
       129
       -
             with

     

       130
       130
       -
             | Type_error _ -> []

     

       131
       131
       -
             | _ -> []

     

       132
       132
       -
           in

     

       122
       122
       +
                 let reactions =

     

       123
       123
       +
                   match Zulip.Jsonu.get_array_opt fields "reactions" with

     

       124
       124
       +
                   | Some reactions_json ->

     

       125
       125
       +
                       List.filter_map (fun r ->

     

       126
       126
       +
                         match Reaction.of_json r with

     

       127
       127
       +
                         | Ok reaction -> Some reaction

     

       128
       128
       +
                         | Error err ->

     

       129
       129
       +
                             Log.warn (fun m -> m "Failed to parse reaction: %s" (Zulip.Error.message err));

     

       130
       130
       +
                             None

     

       131
       131
       +
                       ) reactions_json

     

       132
       132
       +
                   | None -> []

     

       133
       133
       +
                 in

     

       133
       134
        
       

     

       134
       134
       -
           let submessages =

     

       135
       135
       -
             try json |> member "submessages" |> to_list

     

       136
       136
       -
             with Type_error _ -> []

     

       137
       137
       -
           in

     

       135
       135
       +
                 let submessages = Zulip.Jsonu.get_array_opt fields "submessages" |> Option.value ~default:[] in

     

       138
       136
        
       

     

       139
       139
       -
           let flags =

     

       140
       140
       -
             try json |> member "flags" |> to_list |> List.map to_string

     

       141
       141
       -
             with Type_error _ -> []

     

       142
       142
       -
           in

     

       137
       137
       +
                 let flags =

     

       138
       138
       +
                   match Zulip.Jsonu.get_array_opt fields "flags" with

     

       139
       139
       +
                   | Some flags_json ->

     

       140
       140
       +
                       List.filter_map Zulip.Jsonu.to_string_safe flags_json

     

       141
       141
       +
                   | None -> []

     

       142
       142
       +
                 in

     

       143
       143
        
       

     

       144
       144
       -
           let is_me_message =

     

       145
       145
       -
             try json |> member "is_me_message" |> to_bool

     

       146
       146
       -
             with Type_error _ -> false

     

       147
       147
       -
           in

     

       144
       144
       +
                 let is_me_message = Zulip.Jsonu.get_bool_default fields "is_me_message" false in

     

       145
       145
       +
                 let client = Zulip.Jsonu.get_string_default fields "client" "" in

     

       146
       146
       +
                 let gravatar_hash = Zulip.Jsonu.get_string_default fields "gravatar_hash" "" in

     

       147
       147
       +
                 let avatar_url = Zulip.Jsonu.get_string_opt fields "avatar_url" in

     

       148
       148
        
       

     

       149
       149
       -
           let client =

     

       150
       150
       -
             try json |> member "client" |> to_string

     

       151
       151
       -
             with Type_error _ -> ""

     

       152
       152
       -
           in

     

       153
       153
       -
       

     

       154
       154
       -
           let gravatar_hash =

     

       155
       155
       -
             try json |> member "gravatar_hash" |> to_string

     

       156
       156
       -
             with Type_error _ -> ""

     

       157
       157
       -
           in

     

       158
       158
       -
       

     

       159
       159
       -
           let avatar_url = json |> member "avatar_url" |> to_string_option in

     

       160
       160
       -
       

     

       161
       161
       -
           Ok {

     

       162
       162
       -
             id; sender_id; sender_email; sender_full_name; sender_short_name;

     

       163
       163
       -
             timestamp; content; content_type; reactions; submessages; flags;

     

       164
       164
       -
             is_me_message; client; gravatar_hash; avatar_url;

     

       165
       165
       -
           }

     

       166
       166
       -
         with

     

       167
       167
       -
         | Type_error (msg, _) -> Error ("Common fields parse error: " ^ msg)

     

       168
       168
       -
         | exn -> Error ("Common fields parse error: " ^ Printexc.to_string exn)

     

       149
       149
       +
                 Ok {

     

       150
       150
       +
                   id; sender_id; sender_email; sender_full_name; sender_short_name;

     

       151
       151
       +
                   timestamp; content; content_type; reactions; submessages;

     

       152
       152
       +
                   flags; is_me_message; client; gravatar_hash; avatar_url

     

       153
       153
       +
                 }

     

       154
       154
       +
             | Error e, _, _, _ | _, Error e, _, _ | _, _, Error e, _ | _, _, _, Error e -> Error e

     

       155
       155
       +
           ) json

     

       156
       156
       +
         )

     

       169
       157
        
       

     

       170
       158
        
       (** JSON parsing *)

     

       171
       159
        
       let of_json json =

     

       172
       172
       -
         Log.debug (fun m -> m "Parsing message JSON: %s" (Yojson.Safe.pretty_to_string json));

     

       160
       160
       +
         Log.debug (fun m -> m "Parsing message JSON: %s" (Zulip.Jsonu.to_string_pretty json));

     

       173
       161
        
       

     

       174
       162
        
         match parse_common json with

     

       175
       175
       -
         | Error err -> Error err

     

       163
       163
       +
         | Error err -> Error (Zulip.Error.message err)

     

       176
       164
        
         | Ok common ->

     

       177
       177
       -
           try

     

       178
       178
       -
             let msg_type = json |> member "type" |> to_string in

     

       179
       179
       -
             match msg_type with

     

       180
       180
       -
             | "private" ->

     

       181
       181
       -
               let display_recipient_json = json |> member "display_recipient" |> to_list in

     

       182
       182
       -
               let users = List.map (fun user_json ->

     

       183
       183
       -
                 Log.debug (fun m -> m "Parsing user in display_recipient: %s" (Yojson.Safe.to_string user_json));

     

       184
       184
       -
                 match User.of_json user_json with

     

       185
       185
       -
                 | Ok user -> user

     

       186
       186
       -
                 | Error err ->

     

       187
       187
       -
                   Log.warn (fun m -> m "Failed to parse user in display_recipient: %s" err);

     

       188
       188
       -
                   Log.warn (fun m -> m "User JSON was: %s" (Yojson.Safe.to_string user_json));

     

       189
       189
       -
                   failwith "user parse error"

     

       190
       190
       -
               ) display_recipient_json in

     

       191
       191
       -
               Ok (Private { common; display_recipient = users })

     

       165
       165
       +
             Zulip.Jsonu.parse_with_error "message type" (fun () ->

     

       166
       166
       +
               Zulip.Jsonu.with_object "message" (fun fields ->

     

       167
       167
       +
                 match Zulip.Jsonu.get_string fields "type" with

     

       168
       168
       +
                 | Ok "private" ->

     

       169
       169
       +
                     (match Zulip.Jsonu.get_array fields "display_recipient" with

     

       170
       170
       +
                      | Ok recipient_json ->

     

       171
       171
       +
                          let users_results = List.map User.of_json recipient_json in

     

       172
       172
       +
                          let users = List.fold_left (fun acc result ->

     

       173
       173
       +
                            match result with

     

       174
       174
       +
                            | Ok user -> user :: acc

     

       175
       175
       +
                            | Error err ->

     

       176
       176
       +
                                Log.warn (fun m -> m "Failed to parse user in display_recipient: %s" (Zulip.Error.message err));

     

       177
       177
       +
                                acc

     

       178
       178
       +
                          ) [] (List.rev users_results) in

     

       192
       179
        
       

     

       193
       193
       -
             | "stream" ->

     

       194
       194
       -
               let display_recipient = json |> member "display_recipient" |> to_string in

     

       195
       195
       -
               let stream_id = json |> member "stream_id" |> to_int_flex in

     

       196
       196
       -
               let subject = json |> member "subject" |> to_string in

     

       197
       197
       -
               Ok (Stream { common; display_recipient; stream_id; subject })

     

       180
       180
       +
                          if List.length users = 0 && List.length users_results > 0 then

     

       181
       181
       +
                            Error (Zulip.Jsonu.json_error "Failed to parse any users in display_recipient")

     

       182
       182
       +
                          else

     

       183
       183
       +
                            Ok (Private { common; display_recipient = users })

     

       184
       184
       +
                      | Error e -> Error e)

     

       198
       185
        
       

     

       199
       199
       -
             | unknown_type ->

     

       200
       200
       -
               Log.warn (fun m -> m "Unknown message type: %s" unknown_type);

     

       201
       201
       -
               Ok (Unknown { common; raw_json = json })

     

       186
       186
       +
                 | Ok "stream" ->

     

       187
       187
       +
                     (match Zulip.Jsonu.get_string fields "display_recipient",

     

       188
       188
       +
                            Zulip.Jsonu.get_int fields "stream_id",

     

       189
       189
       +
                            Zulip.Jsonu.get_string fields "subject" with

     

       190
       190
       +
                      | Ok display_recipient, Ok stream_id, Ok subject ->

     

       191
       191
       +
                          Ok (Stream { common; display_recipient; stream_id; subject })

     

       192
       192
       +
                      | Error e, _, _ | _, Error e, _ | _, _, Error e -> Error e)

     

       193
       193
       +
       

     

       194
       194
       +
                 | Ok unknown_type ->

     

       195
       195
       +
                     Log.warn (fun m -> m "Unknown message type: %s" unknown_type);

     

       196
       196
       +
                     Ok (Unknown { common; raw_json = json })

     

       202
       197
        
       

     

       203
       203
       -
           with

     

       204
       204
       -
           | Type_error (msg, _) -> Error ("Message type parse error: " ^ msg)

     

       205
       205
       -
           | exn -> Error ("Message type parse error: " ^ Printexc.to_string exn)

     

       198
       198
       +
                 | Error _ ->

     

       199
       199
       +
                     Log.warn (fun m -> m "No message type field found");

     

       200
       200
       +
                     Ok (Unknown { common; raw_json = json })

     

       201
       201
       +
               ) json

     

       202
       202
       +
             ) |> Result.map_error Zulip.Error.message

     

       206
       203
        
       

     

       207
       204
        
       (** Accessor functions *)

     

       208
       205
        
       let get_common = function

     
···

       245
       242
        
         | Private { display_recipient; _ } ->

     

       246
       243
        
           display_recipient

     

       247
       244
        
           |> List.map User.email

     

       248
       248
       -
           |> String.concat ","

     

       245
       245
       +
           |> String.concat ", "

     

       249
       246
        
         | Stream { display_recipient; _ } -> display_recipient

     

       250
       247
        
         | Unknown _ -> ""

     

       251
       248
        
       

     
···

       312
       309
        
       let parse_command msg =

     

       313
       310
        
         match extract_command msg with

     

       314
       311
        
         | None -> None

     

       315
       315
       -
         | Some cmd_text ->

     

       316
       316
       -
           let parts = String.split_on_char ' ' cmd_text |> List.filter (fun s -> s <> "") in

     

       312
       312
       +
         | Some cmd_string ->

     

       313
       313
       +
           let parts = String.split_on_char ' ' (String.trim cmd_string) in

     

       317
       314
        
           match parts with

     

       318
       315
        
           | [] -> None

     

       319
       316
        
           | cmd :: args -> Some (cmd, args)

     
···

       386
       383
        
       (** Pretty print JSON for debugging *)

     

       387
       384
        
       let pp_json_debug ppf json =

     

       388
       385
        
         let open Fmt in

     

       389
       389
       -
         let json_str = Yojson.Safe.pretty_to_string json in

     

       386
       386
       +
         let json_str = Zulip.Jsonu.to_string_pretty json in

     

       390
       387
        
         pf ppf "@[<v>%a@.%a@]"

     

       391
       388
        
           (styled `Bold (styled (`Fg `Blue) string)) "Raw JSON:"

     

       392
       389
        
           (styled (`Fg `Black) string) json_str

+5 -5

stack/zulip/lib/zulip_bot/lib/message.mli

···

       41
       41
        
         content: string;

     

       42
       42
        
         content_type: string;

     

       43
       43
        
         reactions: Reaction.t list;

     

       44
       44
       -
         submessages: Yojson.Safe.t list;

     

       44
       44
       +
         submessages: Zulip.Error.json list;

     

       45
       45
        
         flags: string list;

     

       46
       46
        
         is_me_message: bool;

     

       47
       47
        
         client: string;

     
···

       63
       63
        
           }

     

       64
       64
        
         | Unknown of {

     

       65
       65
        
             common: common;

     

       66
       66
       -
             raw_json: Yojson.Safe.t;

     

       66
       66
       +
             raw_json: Zulip.Error.json;

     

       67
       67
        
           }

     

       68
       68
        
       

     

       69
       69
        
       (** Accessor functions *)

     
···

       76
       76
        
       val content : t -> string

     

       77
       77
        
       val content_type : t -> string

     

       78
       78
        
       val reactions : t -> Reaction.t list

     

       79
       79
       -
       val submessages : t -> Yojson.Safe.t list

     

       79
       79
       +
       val submessages : t -> Zulip.Error.json list

     

       80
       80
        
       val flags : t -> string list

     

       81
       81
        
       val is_me_message : t -> bool

     

       82
       82
        
       val client : t -> string

     
···

       97
       97
        
       val parse_command : t -> (string * string list) option

     

       98
       98
        
       

     

       99
       99
        
       (** JSON parsing *)

     

       100
       100
       -
       val of_json : Yojson.Safe.t -> (t, string) result

     

       100
       100
       +
       val of_json : Zulip.Error.json -> (t, string) result

     

       101
       101
        
       

     

       102
       102
        
       (** Pretty printing *)

     

       103
       103
        
       val pp : Format.formatter -> t -> unit

     
···

       106
       106
        
       val pp_ansi : ?show_json:bool -> Format.formatter -> t -> unit

     

       107
       107
        
       

     

       108
       108
        
       (** Pretty print JSON for debugging *)

     

       109
       109
       -
       val pp_json_debug : Format.formatter -> Yojson.Safe.t -> unit
     

       109
       109
       +
       val pp_json_debug : Format.formatter -> Zulip.Error.json -> unit