commit 8e4c1bfcd126a78787ca58216d55adf10cb1a7f6 · anil.recoil.org/slop

+16 -19

stack/zulip/lib/zulip/lib/event_queue.ml

···

       52
       52
        
       module Events_response = struct

     

       53
       53
        
         type t = { events : Event.t list }

     

       54
       54
        
       

     

       55
       55
       -
         (* Custom codec that handles Event.t which has its own of_json *)

     

       56
       55
        
         let codec =

     

       57
       57
       -
           let kind = "EventsResponse" in

     

       58
       58
       -
           let of_string s =

     

       59
       59
       -
             match Jsont_bytesrw.decode_string' Jsont.json s with

     

       60
       60
       -
             | Error e -> Error (Jsont.Error.to_string e)

     

       61
       61
       -
             | Ok (Jsont.Object (fields, _)) ->

     

       56
       56
       +
           (* Use keep_unknown pattern to handle the whole object and extract events manually *)

     

       57
       57
       +
           let make raw_json =

     

       58
       58
       +
             match raw_json with

     

       59
       59
       +
             | Jsont.Object (fields, _) ->

     

       62
       60
        
                 let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in

     

       63
       61
        
                 (match List.assoc_opt "events" assoc with

     

       64
       64
       -
                  | Some (Jsont.Array (event_list, _)) ->

     

       65
       65
       -
                      let events = List.fold_left (fun acc event_json ->

     

       66
       66
       -
                        match Event.of_json event_json with

     

       62
       62
       +
                  | Some (Jsont.Array (items, _)) ->

     

       63
       63
       +
                      (* Parse each event, skipping failures *)

     

       64
       64
       +
                      let events = List.fold_left (fun acc item ->

     

       65
       65
       +
                        match Event.of_json item with

     

       67
       66
        
                        | Ok event -> event :: acc

     

       68
       67
        
                        | Error _ -> acc

     

       69
       69
       -
                      ) [] event_list in

     

       70
       70
       -
                      Ok { events = List.rev events }

     

       71
       71
       -
                  | None -> Ok { events = [] }

     

       72
       72
       -
                  | _ -> Error "events field is not an array")

     

       73
       73
       -
             | Ok _ -> Error "Expected JSON object"

     

       68
       68
       +
                      ) [] items |> List.rev in

     

       69
       69
       +
                      { events }

     

       70
       70
       +
                  | Some _ -> { events = [] }

     

       71
       71
       +
                  | None -> { events = [] })

     

       72
       72
       +
             | _ -> { events = [] }

     

       74
       73
        
           in

     

       75
       75
       -
           let enc _t =

     

       76
       76
       -
             (* Not used for responses, but required by codec *)

     

       77
       77
       -
             Fmt.str "{\"events\": []}"

     

       78
       78
       -
           in

     

       79
       79
       -
           Jsont.of_of_string ~kind of_string ~enc

     

       74
       74
       +
           Jsont.Object.map ~kind:"EventsResponse" make

     

       75
       75
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ -> Jsont.Object ([], Jsont.Meta.none))

     

       76
       76
       +
           |> Jsont.Object.finish

     

       80
       77
        
       end

     

       81
       78
        
       

     

       82
       79
        
       let get_events t client ?last_event_id () =

+38 -123

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

···

       20
       20
        
       

     

       21
       21
        
         (* Jsont codec for User - handles both user_id and id fields *)

     

       22
       22
        
         let jsont : t Jsont.t =

     

       23
       23
       -
           let of_string s =

     

       24
       24
       -
             match Jsont_bytesrw.decode_string' Jsont.json s with

     

       25
       25
       -
             | Error _ -> Error "Failed to decode JSON"

     

       26
       26
       -
             | Ok json ->

     

       27
       27
       -
                 match json with

     

       28
       28
       -
                 | Jsont.Object (fields, _) ->

     

       29
       29
       -
                     let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in

     

       30
       30
       -
                     let user_id =

     

       31
       31
       -
                       match List.assoc_opt "user_id" assoc with

     

       32
       32
       -
                       | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       33
       33
       -
                       | _ ->

     

       34
       34
       -
                           match List.assoc_opt "id" assoc with

     

       35
       35
       -
                           | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       36
       36
       -
                           | _ -> None

     

       37
       37
       -
                     in

     

       38
       38
       -
                     let email =

     

       39
       39
       -
                       match List.assoc_opt "email" assoc with

     

       40
       40
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       41
       41
       -
                       | _ -> None

     

       42
       42
       -
                     in

     

       43
       43
       -
                     let full_name =

     

       44
       44
       -
                       match List.assoc_opt "full_name" assoc with

     

       45
       45
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       46
       46
       -
                       | _ -> None

     

       47
       47
       -
                     in

     

       48
       48
       -
                     let short_name =

     

       49
       49
       -
                       match List.assoc_opt "short_name" assoc with

     

       50
       50
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       51
       51
       -
                       | _ -> None

     

       52
       52
       -
                     in

     

       53
       53
       -
                     (match (user_id, email, full_name) with

     

       54
       54
       -
                      | (Some user_id, Some email, Some full_name) ->

     

       55
       55
       -
                          (* Keep unknown fields *)

     

       56
       56
       -
                          let unknown_fields = List.filter (fun (k, _) ->

     

       57
       57
       -
                            k <> "user_id" && k <> "id" && k <> "email" && k <> "full_name" && k <> "short_name"

     

       58
       58
       -
                          ) assoc in

     

       59
       59
       -
                          let unknown_mems = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) unknown_fields in

     

       60
       60
       -
                          let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in

     

       61
       61
       -
                          Ok { user_id; email; full_name; short_name; unknown }

     

       62
       62
       -
                      | _ -> Error "Missing required user fields")

     

       63
       63
       -
                 | _ -> Error "Expected JSON object for user"

     

       23
       23
       +
           let make email full_name short_name unknown =

     

       24
       24
       +
             (* user_id will be extracted in a custom way from the object *)

     

       25
       25
       +
             fun user_id_opt id_opt ->

     

       26
       26
       +
               let user_id = match user_id_opt, id_opt with

     

       27
       27
       +
                 | Some uid, _ -> uid

     

       28
       28
       +
                 | None, Some id -> id

     

       29
       29
       +
                 | None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id or id field"

     

       30
       30
       +
               in

     

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

     

       64
       32
        
           in

     

       65
       65
       -
           let to_string { user_id; email; full_name; short_name; unknown } =

     

       66
       66
       -
             let fields = [

     

       67
       67
       -
               (("user_id", Jsont.Meta.none), Jsont.Number (float_of_int user_id, Jsont.Meta.none));

     

       68
       68
       -
               (("email", Jsont.Meta.none), Jsont.String (email, Jsont.Meta.none));

     

       69
       69
       -
               (("full_name", Jsont.Meta.none), Jsont.String (full_name, Jsont.Meta.none));

     

       70
       70
       -
             ] in

     

       71
       71
       -
             let fields = match short_name with

     

       72
       72
       -
               | Some sn -> (("short_name", Jsont.Meta.none), Jsont.String (sn, Jsont.Meta.none)) :: fields

     

       73
       73
       -
               | None -> fields

     

       74
       74
       -
             in

     

       75
       75
       -
             let unknown_mems = match unknown with

     

       76
       76
       -
               | Jsont.Object (mems, _) -> mems

     

       77
       77
       -
               | _ -> []

     

       78
       78
       -
             in

     

       79
       79
       -
             let json = Jsont.Object (fields @ unknown_mems, Jsont.Meta.none) in

     

       80
       80
       -
             match Jsont_bytesrw.encode_string' Jsont.json json with

     

       81
       81
       -
             | Ok s -> s

     

       82
       82
       -
             | Error e -> failwith ("Failed to encode user: " ^ Jsont.Error.to_string e)

     

       83
       83
       -
           in

     

       84
       84
       -
           Jsont.of_of_string ~kind:"User" of_string ~enc:to_string

     

       33
       33
       +
           Jsont.Object.map ~kind:"User" make

     

       34
       34
       +
           |> Jsont.Object.mem "email" Jsont.string ~enc:email

     

       35
       35
       +
           |> Jsont.Object.mem "full_name" Jsont.string ~enc:full_name

     

       36
       36
       +
           |> Jsont.Object.opt_mem "short_name" Jsont.string ~enc:short_name

     

       37
       37
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       38
       38
       +
           |> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)

     

       39
       39
       +
           |> Jsont.Object.opt_mem "id" Jsont.int ~enc:(fun _ -> None)

     

       40
       40
       +
           |> Jsont.Object.finish

     

       85
       41
        
       

     

       86
       42
        
         let of_json (json : Zulip.json) : (t, Zulip.zerror) result =

     

       87
       43
        
           match Zulip.Encode.from_json jsont json with

     
···

       106
       62
        
       

     

       107
       63
        
         (* Jsont codec for Reaction - handles user_id in different locations *)

     

       108
       64
        
         let jsont : t Jsont.t =

     

       109
       109
       -
           let of_string s =

     

       110
       110
       -
             match Jsont_bytesrw.decode_string' Jsont.json s with

     

       111
       111
       -
             | Error _ -> Error "Failed to decode JSON"

     

       112
       112
       -
             | Ok json ->

     

       113
       113
       -
                 match json with

     

       114
       114
       -
                 | Jsont.Object (fields, _) ->

     

       115
       115
       -
                     let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in

     

       116
       116
       -
                     let emoji_name =

     

       117
       117
       -
                       match List.assoc_opt "emoji_name" assoc with

     

       118
       118
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       119
       119
       -
                       | _ -> None

     

       120
       120
       -
                     in

     

       121
       121
       -
                     let emoji_code =

     

       122
       122
       -
                       match List.assoc_opt "emoji_code" assoc with

     

       123
       123
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       124
       124
       -
                       | _ -> None

     

       125
       125
       -
                     in

     

       126
       126
       -
                     let reaction_type =

     

       127
       127
       -
                       match List.assoc_opt "reaction_type" assoc with

     

       128
       128
       -
                       | Some (Jsont.String (s, _)) -> Some s

     

       129
       129
       -
                       | _ -> None

     

       130
       130
       -
                     in

     

       131
       131
       -
                     (* user_id can be either directly in the object or nested in a "user" field *)

     

       132
       132
       -
                     let user_id =

     

       133
       133
       -
                       match List.assoc_opt "user_id" assoc with

     

       134
       134
       -
                       | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       135
       135
       -
                       | _ ->

     

       136
       136
       -
                           match List.assoc_opt "user" assoc with

     

       137
       137
       -
                           | Some (Jsont.Object (user_fields, _)) ->

     

       138
       138
       -
                               let user_assoc = List.map (fun ((k, _), v) -> (k, v)) user_fields in

     

       139
       139
       -
                               (match List.assoc_opt "user_id" user_assoc with

     

       140
       140
       -
                                | Some (Jsont.Number (f, _)) -> Some (int_of_float f)

     

       141
       141
       -
                                | _ -> None)

     

       142
       142
       -
                           | _ -> None

     

       143
       143
       -
                     in

     

       144
       144
       -
                     (match (emoji_name, emoji_code, reaction_type, user_id) with

     

       145
       145
       -
                      | (Some emoji_name, Some emoji_code, Some reaction_type, Some user_id) ->

     

       146
       146
       -
                          (* Keep unknown fields *)

     

       147
       147
       -
                          let unknown_fields = List.filter (fun (k, _) ->

     

       148
       148
       -
                            k <> "emoji_name" && k <> "emoji_code" && k <> "reaction_type" && k <> "user_id" && k <> "user"

     

       149
       149
       -
                          ) assoc in

     

       150
       150
       -
                          let unknown_mems = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) unknown_fields in

     

       151
       151
       -
                          let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in

     

       152
       152
       -
                          Ok { emoji_name; emoji_code; reaction_type; user_id; unknown }

     

       153
       153
       -
                      | _ -> Error "Missing required reaction fields")

     

       154
       154
       -
                 | _ -> Error "Expected JSON object for reaction"

     

       65
       65
       +
           (* Helper codec for nested user object - extracts just the user_id *)

     

       66
       66
       +
           let user_obj_codec =

     

       67
       67
       +
             Jsont.Object.map ~kind:"ReactionUser" Fun.id

     

       68
       68
       +
             |> Jsont.Object.mem "user_id" Jsont.int ~enc:Fun.id

     

       69
       69
       +
             |> Jsont.Object.finish

     

       155
       70
        
           in

     

       156
       156
       -
           let to_string { emoji_name; emoji_code; reaction_type; user_id; unknown } =

     

       157
       157
       -
             let fields = [

     

       158
       158
       -
               (("emoji_name", Jsont.Meta.none), Jsont.String (emoji_name, Jsont.Meta.none));

     

       159
       159
       -
               (("emoji_code", Jsont.Meta.none), Jsont.String (emoji_code, Jsont.Meta.none));

     

       160
       160
       -
               (("reaction_type", Jsont.Meta.none), Jsont.String (reaction_type, Jsont.Meta.none));

     

       161
       161
       -
               (("user_id", Jsont.Meta.none), Jsont.Number (float_of_int user_id, Jsont.Meta.none));

     

       162
       162
       -
             ] in

     

       163
       163
       -
             let unknown_mems = match unknown with

     

       164
       164
       -
               | Jsont.Object (mems, _) -> mems

     

       165
       165
       -
               | _ -> []

     

       166
       166
       -
             in

     

       167
       167
       -
             let json = Jsont.Object (fields @ unknown_mems, Jsont.Meta.none) in

     

       168
       168
       -
             match Jsont_bytesrw.encode_string' Jsont.json json with

     

       169
       169
       -
             | Ok s -> s

     

       170
       170
       -
             | Error e -> failwith ("Failed to encode reaction: " ^ Jsont.Error.to_string e)

     

       71
       71
       +
           let make emoji_name emoji_code reaction_type unknown =

     

       72
       72
       +
             fun user_id_direct user_obj_nested ->

     

       73
       73
       +
               let user_id = match user_id_direct, user_obj_nested with

     

       74
       74
       +
                 | Some uid, _ -> uid

     

       75
       75
       +
                 | None, Some uid -> uid

     

       76
       76
       +
                 | None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id field"

     

       77
       77
       +
               in

     

       78
       78
       +
               { emoji_name; emoji_code; reaction_type; user_id; unknown }

     

       171
       79
        
           in

     

       172
       172
       -
           Jsont.of_of_string ~kind:"Reaction" of_string ~enc:to_string

     

       80
       80
       +
           Jsont.Object.map ~kind:"Reaction" make

     

       81
       81
       +
           |> Jsont.Object.mem "emoji_name" Jsont.string ~enc:emoji_name

     

       82
       82
       +
           |> Jsont.Object.mem "emoji_code" Jsont.string ~enc:emoji_code

     

       83
       83
       +
           |> Jsont.Object.mem "reaction_type" Jsont.string ~enc:reaction_type

     

       84
       84
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       85
       85
       +
           |> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)

     

       86
       86
       +
           |> Jsont.Object.opt_mem "user" user_obj_codec ~enc:(fun _ -> None)

     

       87
       87
       +
           |> Jsont.Object.finish

     

       173
       88
        
       

     

       174
       89
        
         let of_json (json : Zulip.json) : (t, Zulip.zerror) result =

     

       175
       90
        
           match Zulip.Encode.from_json jsont json with